[MLton-commit] r4432
Matthew Fluet
MLton@mlton.org
Sun, 30 Apr 2006 19:06:29 -0700
Refactored everything but Net; starting on Net
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 02:06:27 UTC (rev 4432)
@@ -117,6 +117,7 @@
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
@@ -149,6 +150,8 @@
../config/bind/real-prim.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
+ ../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
../config/c/sys-word.sml
@@ -192,6 +195,8 @@
../config/bind/real-top.sml
../config/bind/word-top.sml
in ann "forceUsed" in
+ ../config/header/$(HEADER_WORD)
+ ../config/objptr/$(OBJPTR_REP)
../config/c/misc/$(CTYPES)
../config/c/position.sml
../config/c/sys-word.sml
@@ -290,7 +295,6 @@
../system/timer.sig
../system/timer.sml
- (*
../net/net.sig
../net/net.sml
../net/net-host-db.sig
@@ -300,14 +304,13 @@
../net/net-serv-db.sig
../net/net-serv-db.sml
../net/socket.sig
- ../net/socket.sml
- ../net/generic-sock.sig
- ../net/generic-sock.sml
- ../net/inet-sock.sig
- ../net/inet-sock.sml
- ../net/unix-sock.sig
- ../net/unix-sock.sml
- *)
+ (* ../net/socket.sml *)
+ (* ../net/generic-sock.sig *)
+ (* ../net/generic-sock.sml *)
+ (* ../net/inet-sock.sig *)
+ (* ../net/inet-sock.sml *)
+ (* ../net/unix-sock.sig *)
+ (* ../net/unix-sock.sml *)
../mlton/array.sig
../mlton/cont.sig
@@ -349,7 +352,6 @@
../mlton/word.sig
../mlton/world.sig
../mlton/world.sml
-(*
../mlton/mlton.sig
../mlton/mlton.sml
@@ -358,6 +360,7 @@
../sml-nj/unsafe.sig
../sml-nj/unsafe.sml
+(*
top-level/basis.sig
ann
"allowRebindEquals true"
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -42,7 +42,7 @@
structure Rlimit: MLTON_RLIMIT
structure Rusage: MLTON_RUSAGE
structure Signal: MLTON_SIGNAL
- structure Socket: MLTON_SOCKET
+(* structure Socket: MLTON_SOCKET *)
structure Syslog: MLTON_SYSLOG
structure TextIO: MLTON_TEXT_IO
structure Thread: MLTON_THREAD
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/mlton.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -27,16 +27,19 @@
; GC.collect ())
fun size x =
- let val refOverhead = 8 (* header + indirect *)
- in Primitive.MLton.size (ref x) - refOverhead
+ let
+ val refOverhead =
+ HeaderWord.wordSize + ObjptrWord.wordSize
+ in
+ C_Size.toInt (Primitive.MLton.size (ref x)) - refOverhead
end
(* fun cleanAtExit () = let open Cleaner in clean atExit end *)
-val debug = Primitive.debug
-val eq = Primitive.eq
+val debug = Primitive.Controls.debug
+val eq = Primitive.MLton.eq
(* val errno = Primitive.errno *)
-val safe = Primitive.safe
+val safe = Primitive.Controls.safe
structure Array = Array
structure BinIO = MLtonIO (BinIO)
@@ -60,7 +63,7 @@
structure Rlimit = MLtonRlimit
structure Rusage = MLtonRusage
structure Signal = MLtonSignal
-structure Socket = MLtonSocket
+(* structure Socket = MLtonSocket *)
structure Syslog = MLtonSyslog
structure TextIO = MLtonIO (TextIO)
structure Thread = MLtonThread
@@ -69,12 +72,12 @@
structure World = MLtonWorld
structure Word =
struct
- open Primitive.Word32
+ open Word32
type t = word
end
structure Word8 =
struct
- open Primitive.Word8
+ open Word8
type t = word
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/word.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -5,8 +5,6 @@
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
-
-type word = Word.word
signature MLTON_WORD =
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -23,11 +23,17 @@
type pre_in_addr
val addrFamilyToInt: addr_family -> int
+(*
val any: unit -> in_addr
+*)
val inAddrToWord8Vector: in_addr -> Word8.word vector
+(*
val inAddrToWord: in_addr -> word
+*)
val intToAddrFamily: int -> addr_family
val new_in_addr: unit -> pre_in_addr * (unit -> in_addr)
val preInAddrToWord8Array: pre_in_addr -> Word8.word array
+(*
val wordToInAddr: word -> in_addr
+*)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-host-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -15,16 +15,17 @@
val preInAddrToWord8Array = fn a => a
val inAddrToWord8Vector = fn v => v
-
+
structure PW = PackWord32Big
fun new_in_addr () =
let
- val inAddrLen = Word32.toIntX Prim.inAddrSize
+ val inAddrLen = C_Size.toInt Prim.inAddrSize
val ia: pre_in_addr = Array.array (inAddrLen, 0wx0: Word8.word)
fun finish () = Array.vector ia
in
(ia, finish)
end
+(*
fun inAddrToWord (ia: in_addr) =
Word.fromLargeWord (PW.subVec (Word8Vector.fromPoly ia, 0))
fun wordToInAddr w =
@@ -35,10 +36,11 @@
finish ()
end
fun any () = wordToInAddr (Word.fromInt Prim.INADDR_ANY)
+*)
+
type addr_family = C_Int.t
-
- val intToAddrFamily = fn z => z
- val addrFamilyToInt = fn z => z
+ val intToAddrFamily = C_Int.fromInt
+ val addrFamilyToInt = C_Int.toInt
datatype entry = T of {name: string,
aliases: string list,
@@ -59,15 +61,15 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
@@ -75,15 +77,15 @@
val length = Prim.getEntryLength ()
val numAddrs = Prim.getEntryAddrsNum ()
fun fill (n, addrs) =
- if n < numAddrs
+ if C_Int.< (n, numAddrs)
then let
- val addr = Word8Array.array (length, 0wx0)
+ val addr = Word8Array.array (C_Int.toInt length, 0wx0)
val _ =
Prim.getEntryAddrsN (n, Word8Array.toPoly addr)
val addr =
Word8Vector.toPoly (Word8Array.vector addr)
in
- fill (n + 1, addr::addrs)
+ fill (C_Int.+ (n, 1), addr::addrs)
end
else List.rev addrs
val addrs = fill (0, [])
@@ -145,8 +147,8 @@
end
val l = loop (4, state, [])
fun get1 w =
- (Word8.fromLarge (Word32.toLarge (Word32.andb (w, 0wxFF))),
- Word32.>>(w, 0w8))
+ (Word8.fromLarge (Word.toLarge (Word.andb (w, 0wxFF))),
+ Word.>>(w, 0w8))
fun get2 w =
let
val (a,w) = get1 w
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-prot-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -11,29 +11,29 @@
datatype entry = T of {name: string,
aliases: string list,
- protocol: int}
+ protocol: C_Int.t}
local
fun make s (T r) = s r
in
val name = make #name
val aliases = make #aliases
- val protocol = make #protocol
+ val protocol = C_Int.toInt o (make #protocol)
end
local
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
@@ -48,6 +48,6 @@
fun getByName name =
get (Prim.getByName (NullString.nullTerm name))
fun getByNumber proto =
- get (Prim.getByNumber proto)
+ get (Prim.getByNumber (C_Int.fromInt proto))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net-serv-db.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -11,7 +11,7 @@
datatype entry = T of {name: string,
aliases: string list,
- port: int,
+ port: C_Int.t,
protocol: string}
local
@@ -19,7 +19,7 @@
in
val name = make #name
val aliases = make #aliases
- val port = make #port
+ val port = C_Int.toInt o (make #port)
val protocol = make #protocol
end
@@ -27,20 +27,20 @@
fun get (b: bool): entry option =
if b
then let
- val name = COld.CS.toString (Prim.getEntryName ())
+ val name = CUtil.C_String.toString (Prim.getEntryName ())
val numAliases = Prim.getEntryAliasesNum ()
fun fill (n, aliases) =
- if n < numAliases
+ if C_Int.< (n, numAliases)
then let
val alias =
- COld.CS.toString (Prim.getEntryAliasesN n)
+ CUtil.C_String.toString (Prim.getEntryAliasesN n)
in
- fill (n + 1, alias::aliases)
+ fill (C_Int.+ (n, 1), alias::aliases)
end
else List.rev aliases
val aliases = fill (0, [])
- val port = Net.ntohl (Prim.getEntryPort ())
- val protocol = COld.CS.toString (Prim.getEntryProto ())
+ val port = Net.C_Int.ntoh (Prim.getEntryPort ())
+ val protocol = CUtil.C_String.toString (Prim.getEntryProto ())
in
SOME (T {name = name,
aliases = aliases,
@@ -56,7 +56,7 @@
| NONE => get (Prim.getByNameNull (NullString.nullTerm name))
fun getByPort (port, proto) =
let
- val port = Net.htonl port
+ val port = Net.C_Int.hton (C_Int.fromInt port)
in
case proto of
NONE => get (Prim.getByPortNull port)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -1,7 +1,15 @@
+(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+ * Jagannathan, and Stephen Weeks.
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
signature NET =
sig
- val htonl: Int32.int -> Int32.int
- val ntohl: Int32.int -> Int32.int
- val htons: Int16.int -> Int16.int
- val ntohs: Int16.int -> Int16.int
+ structure C_Int :
+ sig
+ val hton: C_Int.t -> C_Int.t
+ val ntoh: C_Int.t -> C_Int.t
+ end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/net.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -9,8 +9,51 @@
struct
structure Prim = PrimitiveFFI.Net
- val htonl = Primitive.Word32.toInt32 o Prim.htonl o Primitive.Word32.fromInt32
- val ntohl = Primitive.Word32.toInt32 o Prim.ntohl o Primitive.Word32.fromInt32
- val htons = Primitive.Word16.toInt16 o Prim.htons o Primitive.Word16.fromInt16
- val ntohs = Primitive.Word16.toInt16 o Prim.ntohs o Primitive.Word16.fromInt16
+ structure Word32 =
+ struct
+ val hton = Prim.htonl
+ val ntoh = Prim.ntohl
+ end
+ structure Word16 =
+ struct
+ val hton = Prim.htons
+ val ntoh = Prim.ntohs
+ end
+
+ structure Int32 =
+ struct
+ val hton = Primitive.Word32.toInt32Unsafe o Word32.hton o Primitive.Word32.fromInt32Unsafe
+ val ntoh = Primitive.Word32.toInt32Unsafe o Word32.ntoh o Primitive.Word32.fromInt32Unsafe
+ end
+ structure Int16 =
+ struct
+ val hton = Primitive.Word16.toInt16Unsafe o Word16.hton o Primitive.Word16.fromInt16Unsafe
+ val ntoh = Primitive.Word16.toInt16Unsafe o Word16.ntoh o Primitive.Word16.fromInt16Unsafe
+ end
+
+ structure C_Int =
+ struct
+ local
+ structure S =
+ C_Int_ChooseIntN
+ (type 'a t = 'a -> 'a
+ val fInt8 = fn _ => raise Fail "Net.C_Int.hton: fInt8"
+ val fInt16 = Int16.hton
+ val fInt32 = Int32.hton
+ val fInt64 = fn _ => raise Fail "Net.C_Int.hton: fInt64")
+ in
+ val hton = S.f
+ end
+ local
+ structure S =
+ C_Int_ChooseIntN
+ (type 'a t = 'a -> 'a
+ val fInt8 = fn _ => raise Fail "Net.C_Int.ntoh: fInt8"
+ val fInt16 = Int16.ntoh
+ val fInt32 = Int32.ntoh
+ val fInt64 = fn _ => raise Fail "Net.C_Int.ntoh: fInt64")
+ in
+ val ntoh = S.f
+ end
+ end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sig 2006-05-01 02:06:27 UTC (rev 4432)
@@ -175,29 +175,23 @@
structure CtlExtra:
sig
- type level = int
- type optname = int
- type request = int
+ type level = C_Int.int
+ type optname = C_Int.int
+ type request = C_Int.int
-(* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
-(* val setSockOptWord:
- * level * optname -> ('af, 'sock_type) sock * word -> unit
- *)
- val getERROR:
- ('af, 'sock_type) sock
- -> (string * Posix.Error.syserror option) option
+ (* val getSockOptWord: level * optname -> ('af, 'sock_type) sock -> word *)
+ (* val setSockOptWord: level * optname -> ('af, 'sock_type) sock * word -> unit *)
+ val getERROR: ('af, 'sock_type) sock -> (string * Posix.Error.syserror option) option
val getSockOptInt: level * optname -> ('af, 'sock_type) sock -> int
- val setSockOptInt:
- level * optname -> ('af, 'sock_type) sock * int -> unit
+ val setSockOptInt: level * optname -> ('af, 'sock_type) sock * int -> unit
val getSockOptBool: level * optname -> ('af, 'sock_type) sock -> bool
- val setSockOptBool:
- level * optname -> ('af, 'sock_type) sock * bool -> unit
+ val setSockOptBool: level * optname -> ('af, 'sock_type) sock * bool -> unit
-(* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
-(* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
+ (* val getIOCtlWord: request -> ('af, 'sock_type) sock -> word *)
+ (* val setIOCtlWord: request -> ('af, 'sock_type) sock * word -> unit *)
val getIOCtlInt: request -> ('af, 'sock_type) sock -> int
-(* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
+ (* val setIOCtlInt: request -> ('af, 'sock_type) sock * int -> unit *)
val getIOCtlBool: request -> ('af, 'sock_type) sock -> bool
-(* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
+ (* val setIOCtlBool: request -> ('af, 'sock_type) sock * bool -> unit *)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/net/socket.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -7,8 +7,7 @@
structure Socket:> SOCKET_EXTRA
where type SOCK.sock_type = C_Int.t
- where type pre_sock_addr = Word8.word array
-=
+ where type pre_sock_addr = Word8.word array =
struct
structure Prim = PrimitiveFFI.Socket
@@ -44,12 +43,11 @@
structure AF =
struct
type addr_family = NetHostDB.addr_family
- val i2a = NetHostDB.intToAddrFamily
val names = [
- ("UNIX", i2a Prim.AF.UNIX),
- ("INET", i2a Prim.AF.INET),
- ("INET6", i2a Prim.AF.INET6),
- ("UNSPEC", i2a Prim.AF.UNSPEC)
+ ("UNIX", Prim.AF.UNIX),
+ ("INET", Prim.AF.INET),
+ ("INET6", Prim.AF.INET6),
+ ("UNSPEC", Prim.AF.UNSPEC)
]
fun list () = names
fun toString af' =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml 2006-05-01 00:38:26 UTC (rev 4431)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/sml-nj/unsafe.sml 2006-05-01 02:06:27 UTC (rev 4432)
@@ -12,7 +12,7 @@
val sub = unsafeSub
val update = unsafeUpdate
- val create = fromPoly o Primitive.Array.array
+ val create = fromPoly o Array.arrayUninit
end
functor UnsafeMonoVector (V: MONO_VECTOR_EXTRA): UNSAFE_MONO_VECTOR =