[MLton-commit] r4380
Stephen Weeks
MLton@mlton.org
Fri, 24 Mar 2006 15:33:22 -0800
Exported some structures from MLton lib:
Byte, INetSock, Socket, Word8ArraySlice, Word16
A couple of these (Socket, Word8ArraySlice) required wrapping in our
SML/NJ stubs so they deal with 32-bit ints instead of 31-bit.
----------------------------------------------------------------------
A mlton/trunk/lib/mlton/basic/inet-sock.sml
A mlton/trunk/lib/mlton/basic/socket.sml
U mlton/trunk/lib/mlton/basic/sources.cm
A mlton/trunk/lib/mlton/basic/word16.sml
A mlton/trunk/lib/mlton/basic/word8-array-slice.sml
U mlton/trunk/lib/mlton/pervasive/pervasive.sml
U mlton/trunk/lib/mlton/sources.cm
U mlton/trunk/lib/mlton-stubs/sources.cm
U mlton/trunk/lib/mlton-stubs-in-smlnj/array.sml
U mlton/trunk/lib/mlton-stubs-in-smlnj/open-int32.sml
A mlton/trunk/lib/mlton-stubs-in-smlnj/socket.sml
U mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm
----------------------------------------------------------------------
Added: mlton/trunk/lib/mlton/basic/inet-sock.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/inet-sock.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/basic/inet-sock.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -0,0 +1 @@
+structure INetSock = INetSock
Added: mlton/trunk/lib/mlton/basic/socket.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/socket.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/basic/socket.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -0,0 +1 @@
+structure Socket = Pervasive.Socket
Modified: mlton/trunk/lib/mlton/basic/sources.cm
===================================================================
--- mlton/trunk/lib/mlton/basic/sources.cm 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/basic/sources.cm 2006-03-24 23:33:21 UTC (rev 4380)
@@ -37,6 +37,7 @@
structure BinarySearch
structure Bool
structure Buffer
+structure Byte
structure Char
structure CharArray
structure CharBuffer
@@ -71,6 +72,7 @@
structure Int32
structure IntInf
structure InsertionSort
+structure INetSock
structure Iterate
structure Itimer
structure Justify
@@ -118,6 +120,7 @@
structure SMLofNJ
structure Sexp
structure Signal
+structure Socket
structure Stream
structure String
structure StringCvt
@@ -137,7 +140,9 @@
structure Word32
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
functor AlphaBeta
functor Control
@@ -328,6 +333,10 @@
escape.sml
buffer.sig
buffer.sml
+socket.sml
+word16.sml
+inet-sock.sml
+word8-array-slice.sml
# if ( defined(SMLNJ_VERSION) )
Added: mlton/trunk/lib/mlton/basic/word16.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/word16.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/basic/word16.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -0,0 +1 @@
+structure Word16 = Pervasive.Word16
Added: mlton/trunk/lib/mlton/basic/word8-array-slice.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/word8-array-slice.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/basic/word8-array-slice.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -0,0 +1 @@
+structure Word8ArraySlice = Word8ArraySlice
Modified: mlton/trunk/lib/mlton/pervasive/pervasive.sml
===================================================================
--- mlton/trunk/lib/mlton/pervasive/pervasive.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/pervasive/pervasive.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -36,6 +36,7 @@
structure Real = Real
structure Real32 = Real32
structure Real64 = Real64
+ structure Socket = Socket
structure String = String
structure StringCvt = StringCvt
structure Substring = Substring
@@ -47,6 +48,7 @@
structure Word = Word
structure Word32 = Word32
structure Word8 = Word8
+ structure Word16 = Word16
structure Word8Array = Word8Array
type unit = General.unit
Modified: mlton/trunk/lib/mlton/sources.cm
===================================================================
--- mlton/trunk/lib/mlton/sources.cm 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton/sources.cm 2006-03-24 23:33:21 UTC (rev 4380)
@@ -56,6 +56,7 @@
structure BinarySearch
structure Bool
structure Buffer
+structure Byte
structure Char
structure CharArray
structure CharBuffer
@@ -91,6 +92,7 @@
structure Int32
structure IntInf
structure InsertionSort
+structure INetSock
structure Iterate
structure Itimer
structure Justify
@@ -139,6 +141,7 @@
structure Sexp
structure Signal
structure SMLofNJ
+structure Socket
structure Stream
structure String
structure StringCvt
@@ -157,7 +160,9 @@
structure Word
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
structure Word32
functor AlphaBeta
Modified: mlton/trunk/lib/mlton-stubs/sources.cm
===================================================================
--- mlton/trunk/lib/mlton-stubs/sources.cm 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton-stubs/sources.cm 2006-03-24 23:33:21 UTC (rev 4380)
@@ -29,6 +29,7 @@
structure Int32
structure Int64
structure IntInf
+structure INetSock
structure IO
structure LargeInt
structure LargeReal
@@ -49,6 +50,7 @@
structure RealVector
structure SML90
structure SMLofNJ
+structure Socket
structure String
structure StringCvt
structure Substring
@@ -62,7 +64,9 @@
structure Word
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
structure Word32
structure Word64
Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/array.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/array.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/array.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -100,3 +100,77 @@
structure RealArray = MonoArray (RealArray)
structure Real64Array = RealArray
structure Word8Array = MonoArray (Word8Array)
+
+functor MonoArraySlice (S: MONO_ARRAY_SLICE) =
+ let
+ open OpenInt32
+ in
+ struct
+ type array = S.array
+ type elem = S.elem
+ type slice = S.slice
+ type vector = S.vector
+ type vector_slice = S.vector_slice
+
+ val all = S.all
+
+ val app = S.app
+
+ fun appi f = S.appi (fn (i, e) => f (fromInt i, e))
+
+ fun base s =
+ let
+ val (a, i, j) = S.base s
+ in
+ (a, fromInt i, fromInt j)
+ end
+
+ val collate = S.collate
+
+ fun copy {di, dst, src} = S.copy {di = toInt di, dst = dst, src = src}
+
+ fun copyVec {di, dst, src} =
+ S.copyVec {di = toInt di, dst = dst, src = src}
+
+ val exists = S.exists
+
+ val find = S.find
+
+ fun findi f s =
+ case S.findi (fn (i, e) => f (fromInt i, e)) s of
+ NONE => NONE
+ | SOME (i, e) => SOME (fromInt i, e)
+
+ val foldl = S.foldl
+
+ fun foldli f = S.foldli (fn (i, e, b) => f (fromInt i, e, b))
+
+ val foldr = S.foldr
+
+ fun foldri f = S.foldri (fn (i, e, b) => f (fromInt i, e, b))
+
+ val full = S.full
+
+ val getItem = S.getItem
+
+ val isEmpty = S.isEmpty
+
+ val length = fromInt o S.length
+
+ val modify = S.modify
+
+ fun modifyi f = S.modifyi (fn (i, e) => f (fromInt i, e))
+
+ fun slice (a, i, j) = S.slice (a, toInt i, toIntOpt j)
+
+ fun sub (s, i) = S.sub (s, toInt i)
+
+ fun subslice (s, i, j) = S.subslice (s, toInt i, toIntOpt j)
+
+ fun update (s, i, e) = S.update (s, toInt i, e)
+
+ val vector = S.vector
+ end
+ end
+
+structure Word8ArraySlice = MonoArraySlice (Word8ArraySlice)
Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/open-int32.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/open-int32.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/open-int32.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -10,6 +10,9 @@
struct
val toInt = Pervasive.Int32.toInt
val fromInt = Pervasive.Int32.fromInt
+ val fromIntOpt =
+ fn NONE => NONE
+ | SOME i => SOME (fromInt i)
val toIntOpt =
fn NONE => NONE
| SOME i => SOME (toInt i)
Added: mlton/trunk/lib/mlton-stubs-in-smlnj/socket.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/socket.sml 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/socket.sml 2006-03-24 23:33:21 UTC (rev 4380)
@@ -0,0 +1,83 @@
+structure Socket =
+ let
+ structure S = Socket
+ open OpenInt32
+ in
+ struct
+ open Socket
+
+ structure Ctl =
+ struct
+ open Ctl
+
+ val getNREAD = fn z => (fromInt o getNREAD) z
+
+ val getRCVBUF = fn z => (fromInt o getRCVBUF) z
+
+ val getSNDBUF = fn z => (fromInt o getSNDBUF) z
+
+ val setRCVBUF =
+ fn z => (setRCVBUF o (fn (s, i) => (s, toInt i))) z
+
+ val setSNDBUF =
+ fn z => (setSNDBUF o (fn (s, i) => (s, toInt i))) z
+ end
+
+ val listen = fn z => (listen o (fn (s, i) => (s, toInt i))) z
+
+ val recvArr = fn z => (fromInt o recvArr) z
+
+ val recvArr' = fn z => (fromInt o recvArr') z
+
+ val recvArrFrom =
+ fn z => ((fn (i, a) => (fromInt i, a)) o recvArrFrom) z
+
+ val recvArrFrom' =
+ fn z => ((fn (i, a) => (fromInt i, a)) o recvArrFrom') z
+
+ val recvArrFromNB =
+ fn z => ((fn NONE => NONE | SOME (i, a) => SOME (fromInt i, a))
+ o recvArrFromNB) z
+
+ val recvArrFromNB' =
+ fn z => ((fn NONE => NONE | SOME (i, a) => SOME (fromInt i, a))
+ o recvArrFromNB') z
+
+ val recvArrNB = fn z => (fromIntOpt o recvArrNB) z
+
+ val recvArrNB' = fn z => (fromIntOpt o recvArrNB') z
+
+ val recvVec = fn z => (recvVec o (fn (s, i) => (s, toInt i))) z
+
+ val recvVec' = fn z => (recvVec' o (fn (s, i, f) => (s, toInt i, f))) z
+
+ val recvVecFrom = fn z => (recvVecFrom o (fn (s, i) => (s, toInt i))) z
+
+ val recvVecFrom' =
+ fn z => (recvVecFrom' o (fn (s, i, f) => (s, toInt i, f))) z
+
+ val recvVecFromNB =
+ fn z => (recvVecFromNB o (fn (s, i) => (s, toInt i))) z
+
+ val recvVecFromNB' =
+ fn z => (recvVecFromNB' o (fn (s, i, f) => (s, toInt i, f))) z
+
+ val recvVecNB = fn z => (recvVecNB o (fn (s, i) => (s, toInt i))) z
+
+ val sendArr = fn z => (fromInt o sendArr) z
+
+ val sendArr' = fn z => (fromInt o sendArr') z
+
+ val sendArrNB = fn z => (fromIntOpt o sendArrNB) z
+
+ val sendArrNB' = fn z => (fromIntOpt o sendArrNB') z
+
+ val sendVec = fn z => (fromInt o sendVec) z
+
+ val sendVec' = fn z => (fromInt o sendVec') z
+
+ val sendVecNB = fn z => (fromIntOpt o sendVecNB) z
+
+ val sendVecNB' = fn z => (fromIntOpt o sendVecNB') z
+ end
+ end
Modified: mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2006-03-13 22:27:22 UTC (rev 4379)
+++ mlton/trunk/lib/mlton-stubs-in-smlnj/sources.cm 2006-03-24 23:33:21 UTC (rev 4380)
@@ -31,6 +31,7 @@
structure Int32
structure Int64
structure IntInf
+structure INetSock
structure IO
structure LargeInt
structure LargeReal
@@ -68,6 +69,7 @@
structure Word32
structure Word64
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
is
@@ -92,6 +94,7 @@
other.sml
posix.sml
real.sml
+socket.sml
string-cvt.sml
string.sml
substring.sml