Cleanup and some renaming

basis/DATE.sig

@@ -13,7 +13,7 @@ signature DATE =
 		hour : int,
 		minute : int,
 		second : int,
-		offset : Time.time option} 
+		offset : Time.time option}
 	-> date
 
     val year    : date -> int
@@ -153,27 +153,42 @@ toString date
 
     The former formats the date according to the format string s,
     following the semantics of the ISO C function strftime. In
-    particular, fmt is locale-dependent. The allowed formats are: %a
-    locale's abbreviated weekday name %A locale's full weekday name %b
-    locale's abbreviated month name %B locale's full month name %c
-    locale's date and time representation (e.g., "Dec 2 06:55:15
-    1979") %d day of month [01-31] %H hour [00-23] %I hour [01-12] %j
-    day of year [001-366] %m month number [01-12] %M minutes [00-59]
-    %p locale's equivalent of the AM/PM designation %S seconds [00-61]
-    %U week number of year [00-53], with the first Sunday as the first
-    day of week 01 %w day of week [0-6], with 0 representing Sunday %W
-    week number of year [00-53], with the first Monday as the first
-    day of week 01 %x locale's appropriate date representation %X
-    locale's appropriate time representation %y year of century
-    [00-99] %Y year including century (e.g., 1997) %Z time zone name
-    or abbreviation, or the empty string if no time zone information
-    exists %% the percent character %c the character c, if c is not
-    one of the format characters listed above For instance, fmt "%A"
-    date returns the full name of the weekday specified by date (e.g.,
-    "Monday"). For a full description of the format-string syntax,
-    consult a description of strftime. Note, however, that unlike
-    strftime, the behavior of fmt is defined for the directive %c for
-    any character c.
+    particular, fmt is locale-dependent. The allowed formats are:
+
+     %a locale's abbreviated weekday name
+     %A locale's full weekday name
+     %b locale's abbreviated month name
+     %B locale's full month name
+     %c locale's date and time representation
+        (e.g., "Dec 2 06:55:15 1979")
+     %d day of month [01-31]
+     %H hour [00-23]
+     %I hour [01-12]
+     %j day of year [001-366]
+     %m month number [01-12]
+     %M minutes [00-59]
+     %p locale's equivalent of the AM/PM designation
+     %S seconds [00-61]
+     %U week number of year [00-53], with the first Sunday as the first
+        day of week 01
+     %w day of week [0-6], with 0 representing Sunday
+     %W week number of year [00-53], with the first Monday as the first
+        day of week 01
+     %x locale's appropriate date representation
+     %X locale's appropriate time representation
+     %y year of century [00-99]
+     %Y year including century (e.g., 1997)
+     %Z time zone name or abbreviation, or the empty string if no time
+        zone information exists
+     %% the percent character
+     %c the character c, if c is not one of the format characters listed
+        above
+
+    For instance, fmt "%A" date returns the full name of the weekday
+    specified by date (e.g., "Monday"). For a full description of the
+    format-string syntax, consult a description of strftime. Note,
+    however, that unlike strftime, the behavior of fmt is defined for
+    the directive %c for any character c.
 
     toString returns a 24-character string representing the date date
     in the following format:

basis/INET_SOCK.sig

@@ -10,12 +10,12 @@ signature INET_SOCK = sig
   type 'st sock = (inet,'st) Socket.sock
   type 'm stream_sock = 'm Socket.stream sock
   type sock_addr = inet Socket.sock_addr
+
   val inetAF : Socket.AF.addr_family
-(*
   val toAddr : NetHostDB.in_addr * int -> sock_addr
   val fromAddr : sock_addr -> NetHostDB.in_addr * int
-*)
   val any : int -> sock_addr
+
   structure TCP : sig
     val socket : unit -> 'm stream_sock
 (*

basis/NetHostDB.sml

@@ -0,0 +1,235 @@
+structure NetHostDB : NET_HOST_DB = struct
+
+fun not_impl s = raise Fail ("not implemented: " ^ s)
+
+fun isNull s = prim("__is_null",s : string) : bool
+
+(* error utilities *)
+
+fun failure s =
+    let fun errno () : int = prim("sml_errno",())
+        fun errmsg (i : int) : string = prim("sml_errormsg", i)
+    in raise Fail (s ^ ": " ^ errmsg(errno()))
+    end
+
+type in_addr = int (* IPv4 *)
+
+type addr_family = int
+
+type entry =
+     { addrType : addr_family,
+       addrs    : in_addr list,
+       aliases  : string list,
+       name     : string,
+       xerr     : int }
+
+fun name (e:entry) = #name e
+
+fun aliases (e:entry) = #aliases e
+
+fun addrType (e:entry) = #addrType e
+
+fun addrs (e:entry) = #addrs e
+fun addr (e:entry) =
+    case #addrs e of
+        a :: _ => a
+      | _ => raise Fail "NetHostDb.addr: impossible"
+
+fun repair ({addrType,addrs,aliases,name,xerr}:entry) : entry option =
+    if xerr < 0 then NONE
+    else SOME {addrType=addrType,
+               addrs=List.rev addrs,
+               aliases=List.rev aliases,
+               name=name,
+               xerr=xerr}
+
+fun getByName (n:string) : entry option =
+    let val e : entry = prim("sml_gethostbyname", n)
+    in repair e
+    end
+
+fun getByAddr (a: in_addr) : entry option =
+    let val e : entry = prim("sml_gethostbyaddr", a)
+    in repair e
+    end
+
+fun getHostName () : string =
+    let val res = prim("sml_gethostname",())
+    in if isNull res then failure "NetHostDb.getHostName"
+       else res
+    end
+
+fun toString (a:in_addr) : string =
+    let val res = prim("sml_inaddr_tostring",a)
+    in if isNull res then failure "NetHostDb.toString"
+       else res
+    end
+
+(* The scan function below is copied from MLton
+   https://github.com/MLton/mlton/blob/master/basis-library/net/net-host-db.sml
+   together with StringCvtfunctionality from
+   https://github.com/MLton/mlton/blob/master/basis-library/text/string-cvt.sml
+   (slightly modified)
+
+   MLton is released under an HPND-style license; see
+   ../doc/license/MLton-HPND-LICENSE for details.
+*)
+
+val radixToInt: StringCvt.radix -> int =
+ fn StringCvt.BIN => 2
+  | StringCvt.OCT => 8
+  | StringCvt.DEC => 10
+  | StringCvt.HEX => 16
+
+val radixToWord: StringCvt.radix -> word = Word.fromInt o radixToInt
+
+fun radixFn off l h c =
+    if c < l orelse c > h then NONE
+    else SOME (Char.ord c - off)
+
+fun charToDigit (radix: StringCvt.radix): char -> int option =
+    case radix of
+        StringCvt.BIN => radixFn 48 #"0" #"1"
+      | StringCvt.OCT => radixFn 48 #"0" #"7"
+      | StringCvt.DEC => radixFn 48 #"0" #"9"
+      | StringCvt.HEX => fn c => case radixFn 48 #"0" #"9" c of
+                                     NONE =>
+                                     (case radixFn 65 #"A" #"F" c of
+                                          NONE => radixFn 97 #"a" #"f" c
+                                        | res => res)
+                                   | res => res
+
+fun charToWDigit radix = (Option.map Word.fromInt) o (charToDigit radix)
+
+fun wdigits radix reader state =
+    let
+      val op + = Word.+
+      val op * = Word.*
+      val r = radixToWord radix
+      fun loop (accum, state) =
+          case reader state of
+              NONE => SOME (accum, state)
+            | SOME (c, state') =>
+              case charToWDigit radix c of
+                  NONE => SOME (accum, state)
+                | SOME n => loop (n + accum * r, state')
+    in case reader state of
+           NONE => NONE
+         | SOME (c, state) =>
+           case charToWDigit radix c of
+               NONE => NONE
+             | SOME n => loop (n, state)
+    end
+
+fun scan0 reader state =
+    let
+      fun scanW state =
+          case reader state of
+              SOME (#"0", state') =>
+              (case reader state' of
+                   NONE => SOME (0w0, state')
+                 | SOME (c, state'') =>
+                   if Char.isDigit c
+                   then wdigits StringCvt.OCT reader state'
+                   else if c = #"x" orelse c = #"X"
+                   then wdigits StringCvt.HEX reader state''
+                   else SOME (0w0, state'))
+            | _ => wdigits StringCvt.DEC reader state
+      fun loop (n, state, acc) =
+          if n <= 0
+          then List.rev acc
+          else let
+            fun finish (w, state) =
+                case reader state of
+                    SOME (#".", state') =>
+                    loop (n - 1, state', (w, state)::acc)
+                  | _ => List.rev ((w, state)::acc)
+          in
+            case scanW state of
+                SOME (w, state') => finish (w, state')
+              | NONE => List.rev acc
+          end
+      val l = loop (4, state, [])
+      fun get1 w =
+          (Word8.fromLarge (Word.toLarge (Word.andb (w, 0wxFF))),
+           Word.>>(w, 0w8))
+      fun get2 w =
+          let
+            val (a,w) = get1 w
+            val (b,w) = get1 w
+          in (a,b,w)
+          end
+      fun get3 w =
+          let
+            val (a,b,w) = get2 w
+            val (c,w) = get1 w
+            in (a,b,c,w)
+          end
+      fun get4 w =
+          let
+            val (a,b,c,w) = get3 w
+            val (d,w) = get1 w
+          in (a,b,c,d,w)
+          end
+      fun try l =
+          case l of
+              [] => NONE
+            | [(w, statew)] =>
+              let
+                val (d,c,b,a,w) = get4 w
+              in
+                if w = 0wx0
+                then SOME (Vector.fromList [a,b,c,d], statew)
+                else NONE
+              end
+            | [(x, statex), (w, statew)] =>
+              let
+                val (d,c,b,w) = get3 w
+                val (a,x) = get1 x
+              in
+                if w = 0wx0 andalso x = 0wx0
+                then SOME (Vector.fromList [a,b,c,d], statew)
+                else try [(x, statex)]
+              end
+            | [(y, statey), (x, statex), (w, statew)] =>
+              let
+                val (d,c,w) = get2 w
+                val (b,x) = get1 x
+                val (a,y) = get1 y
+              in
+                if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0
+                then SOME (Vector.fromList [a,b,c,d], statew)
+                else try [(y, statey), (x, statex)]
+              end
+            | [(z, statez), (y, statey), (x, statex), (w, statew)] =>
+              let
+                val (d,w) = get1 w
+                val (c,x) = get1 x
+                val (b,y) = get1 y
+                val (a,z) = get1 z
+              in
+                if w = 0wx0 andalso x = 0wx0 andalso y = 0wx0 andalso z = 0wx0
+                then SOME (Vector.fromList [a,b,c,d], statew)
+                else try [(z, statez), (y, statey), (x, statex)]
+              end
+            | _ => NONE
+    in
+      try l
+    end
+
+fun scan (reader: (char,'a)StringCvt.reader) : (in_addr,'a)StringCvt.reader =
+    fn (a : 'a) =>
+       case scan0 reader a of
+           NONE => NONE
+         | SOME(v,a) =>
+           if Vector.length v > 4 then
+             failure "NetHostDb.scan"
+           else
+             let val toW = Word.fromLarge o Word8.toLarge
+                 val w = Vector.foldl (fn (w8,w) => Word.orb(Word.<<(w,0w8),toW w8)) 0w0 v
+             in SOME(Word.toInt w, a)
+             end
+
+fun fromString s = StringCvt.scanString scan s
+
+end

basis/SOCKET.sml

@@ -291,8 +291,16 @@ local
     type 'm stream_sock = 'm Socket.stream sock
     type sock_addr = inet Socket.sock_addr
     val inetAF = Socket.AF_INET
+
+    fun toAddr (ia:int, port:int) =
+        Socket.Inet_sa {addr=ia,port=port}
+
     fun any (p:int) : sock_addr =
-        Socket.Inet_sa {addr=Socket.INADDR_ANY,port=p}
+        toAddr (Socket.INADDR_ANY,p)
+
+    fun fromAddr (Socket.Inet_sa{addr,port}) = (addr,port)
+      | fromAddr _ = raise Fail "INetSock.fromAddr: impossible"
+
     structure TCP = struct
     fun socket () : 'm stream_sock =
         let val res = prim("sml_sock_socket", (Socket.AF_INET,Socket.SOCK_STREAM))
@@ -311,8 +319,12 @@ local
                           type 'st sock = (inet,'st) Socket.sock
                           type 'm stream_sock = 'm Socket.stream sock
                           type sock_addr = inet Socket.sock_addr
+
                           val inetAF : Socket.AF.addr_family
+                          val toAddr : NetHostDB.in_addr * int -> sock_addr
+                          val fromAddr : sock_addr -> NetHostDB.in_addr * int
                           val any : int -> sock_addr
+
                           structure TCP :
                                     sig
                                       val socket : unit -> 'm stream_sock

basis/socket.mlb

@@ -7,5 +7,4 @@ in
   SOCKET.sig
   Socket.sml
   INET_SOCK.sig
-
 end