[MLton-commit] r4430
Matthew Fluet
MLton@mlton.org
Sun, 30 Apr 2006 15:19:01 -0700
Refactored System (complete)
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
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/config/c/misc/c-types.weird.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/Makefile 2006-04-30 22:18:59 UTC (rev 4430)
@@ -23,8 +23,7 @@
OBJPTR_REP_MAPS = objptr-rep32.map objptr-rep64.map
HEADER_MAPS = header-word32.map header-word64.map
SEQ_INDEX_MAPS = seqindex-int32.map seqindex-int64.map
-# CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
-CTYPES_MAPS = c-types.m32.map c-types.m64.map
+CTYPES_MAPS = c-types.m32.map c-types.m64.map c-types.weird.map
DEFAULT_CHAR_MAPS = default-char8.map
DEFAULT_INT_MAPS = default-int32.map default-int64.map default-int-inf.map
DEFAULT_REAL_MAPS = default-real32.map default-real64.map
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-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-04-30 22:18:59 UTC (rev 4430)
@@ -279,18 +279,18 @@
../mlton/rusage.sig
../mlton/rusage.sml
+ ../system/process.sig
+ ../system/process.sml
+ ../system/io.sig
+ ../system/io.sml
+ ../system/os.sig
+ ../system/os.sml
+ ../system/unix.sig
+ ../system/unix.sml
+ ../system/timer.sig
+ ../system/timer.sml
+
(*
- ../../system/process.sig
- ../../system/process.sml
- ../../system/io.sig
- ../../system/io.sml
- ../../system/os.sig
- ../../system/os.sml
- ../../system/unix.sig
- ../../system/unix.sml
- ../../system/timer.sig
- ../../system/timer.sml
-
../../net/net.sig
../../net/net.sml
../../net/net-host-db.sig
@@ -307,7 +307,9 @@
../../net/inet-sock.sml
../../net/unix-sock.sig
../../net/unix-sock.sml
+*)
+(*
../../mlton/array.sig
../../mlton/cont.sig
../../mlton/cont.sml
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/config/c/misc/c-types.weird.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -44,9 +44,12 @@
structure C_Size = struct open Word16 type t = word end
functor C_Size_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word16 (A)
-structure C_Pointer = Pointer
-structure C_String = Pointer
-structure C_StringArray = Pointer
+structure C_Pointer = struct open Word32 type t = word end
+functor C_Pointer_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_String = struct open Word32 type t = word end
+functor C_String_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_StringArray = struct open Word32 type t = word end
+functor C_StringArray_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* Generic integers *)
structure C_Fd = C_Int
@@ -65,6 +68,10 @@
functor C_Intmax_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
structure C_UIntmax = struct open Word32 type t = word end
functor C_UIntmax_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
+structure C_Intptr = struct open Int32 type t = int end
+functor C_Intptr_ChooseIntN (A: CHOOSE_INTN_ARG) = ChooseIntN_Int32 (A)
+structure C_UIntptr = struct open Word32 type t = word end
+functor C_UIntptr_ChooseWordN (A: CHOOSE_WORDN_ARG) = ChooseWordN_Word32 (A)
(* from <dirent.h> *)
structure C_DirP = struct open Word16 type t = word end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/posix/file-sys.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -33,10 +33,10 @@
type uid = C_UId.t
type gid = C_GId.t
- val fdToWord = SysWord.fromLargeInt o C_Fd.toLarge
- val wordToFD = C_Fd.fromLarge o SysWord.toLargeInt
- val fdToIOD = OS.IO.fromFD
- val iodToFD = SOME o OS.IO.toFD
+ val fdToWord = C_Fd.toSysWord
+ val wordToFD = C_Fd.fromSysWord
+ val fdToIOD = fn x => x
+ val iodToFD = SOME o (fn x => x)
(*------------------------------------*)
(* dirstream *)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/io.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -1,6 +1,7 @@
(* modified from SML/NJ sources by Stephen Weeks 1998-6-25 *)
(* modified by Matthew Fluet 2002-10-11 *)
(* modified by Matthew Fluet 2002-11-21 *)
+(* modified by Matthew Fluet 2006-04-30 *)
(* os-io.sml
*
@@ -22,25 +23,18 @@
datatype iodesc_kind = K of string
- type file_desc = Primitive.FileDesc.t
+ type file_desc = Posix.FileSys.file_desc
- fun toFD (iod: iodesc): file_desc =
- valOf (Posix.FileSys.iodToFD iod)
+ val iodToFd = fn x => x
+ val fdToIod = fn x => x
- val FD = Primitive.FileDesc.fromInt
- val unFD = Primitive.FileDesc.toInt
+ val iodescToWord = C_Fd.toSysWord
- fun fromInt i = Posix.FileSys.fdToIOD (FD i)
-
- val toInt: iodesc -> int = unFD o toFD
-
- val toWord = Posix.FileSys.fdToWord o toFD
-
(* return a hash value for the I/O descriptor. *)
- val hash = toWord
+ val hash = SysWord.toWord o iodescToWord
(* compare two I/O descriptors *)
- fun compare (i, i') = Word.compare (toWord i, toWord i')
+ fun compare (i, i') = SysWord.compare (iodescToWord i, iodescToWord i')
structure Kind =
struct
@@ -55,7 +49,7 @@
(* return the kind of I/O descriptor *)
fun kind (iod) = let
- val stat = Posix.FileSys.fstat (toFD iod)
+ val stat = Posix.FileSys.fstat (iodToFd iod)
in
if (Posix.FileSys.ST.isReg stat) then Kind.file
else if (Posix.FileSys.ST.isDir stat) then Kind.dir
@@ -96,26 +90,23 @@
local
structure Prim = PrimitiveFFI.OS.IO
fun join (false, _, w) = w
- | join (true, b, w) = Word16.orb(w, b)
- fun test (w, b) = (Word16.andb(w, b) <> 0w0)
- val rdBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLIN
- and wrBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLOUT
- and priBit : Word16.word = Primitive.Word16.fromInt16 PrimitiveFFI.OS.IO.POLLPRI
+ | join (true, b, w) = C_Short.orb(w, b)
+ fun test (w, b) = (C_Short.andb(w, b) <> 0)
+ val rdBit = PrimitiveFFI.OS.IO.POLLIN
+ and wrBit = PrimitiveFFI.OS.IO.POLLOUT
+ and priBit = PrimitiveFFI.OS.IO.POLLPRI
fun fromPollDesc (PollDesc (iod, {rd, wr, pri})) =
- ( toInt iod,
- Primitive.Word16.toInt16 (
+ ( iodToFd iod,
join (rd, rdBit,
join (wr, wrBit,
- join (pri, priBit, 0w0))))
+ join (pri, priBit, 0)))
)
fun toPollInfo (fd, i) =
- let val w = Primitive.Word16.fromInt16 i
- in PollInfo (fromInt fd, {
- rd = test(w, rdBit),
- wr = test(w, wrBit),
- pri = test(w, priBit)
+ PollInfo (fdToIod fd, {
+ rd = test(i, rdBit),
+ wr = test(i, wrBit),
+ pri = test(i, priBit)
})
- end
in
fun poll (pds, timeOut) = let
val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
@@ -128,7 +119,7 @@
| SOME t =>
if Time.< (t, Time.zeroTime)
then let open PosixError in raiseSys inval end
- else (Int.fromLarge (Time.toMilliseconds t)
+ else (C_Int.fromLarge (Time.toMilliseconds t)
handle Overflow => Error.raiseSys Error.inval)
val reventss = Array.array (n, 0)
val _ = Posix.Error.SysCall.simpleRestart
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/pre-os.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -11,17 +11,9 @@
struct
type status = C_Status.t
end
- structure IO :> sig
- eqtype iodesc
-
- val fromFD: C_Fd.t -> iodesc
- val toFD: iodesc -> C_Fd.t
- end =
+ structure IO =
struct
type iodesc = C_Fd.t
-
- val fromFD = fn z => z
- val toFD = fn z => z
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sig 2006-04-30 22:18:59 UTC (rev 4430)
@@ -19,7 +19,7 @@
structure Status:
sig
- type t
+ type t = status
val fromInt: int -> t
val fromPosix: Posix.Process.exit_status -> t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml 2006-04-30 21:32:15 UTC (rev 4429)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/system/process.sml 2006-04-30 22:18:59 UTC (rev 4430)
@@ -17,8 +17,14 @@
structure Status =
struct
- open Primitive.Status
+ type t = C_Status.t
+ val fromInt = C_Status.fromInt
+ val toInt = C_Status.toInt
+
+ val failure = fromInt 1
+ val success = fromInt 0
+
val fromPosix =
fn es =>
let
@@ -26,7 +32,7 @@
in
case es of
W_EXITED => success
- | W_EXITSTATUS w => fromInt (Word8.toInt w)
+ | W_EXITSTATUS w => C_Status.fromSysWord (Word8.toSysWord w)
| W_SIGNALED _ => failure
| W_STOPPED _ => failure
end
@@ -39,8 +45,9 @@
fun isSuccess st = st = success
fun system cmd =
- PrimitiveFFI.Posix.Process.system (NullString.fromString
- (concat [cmd, "\000"]))
+ Posix.Error.SysCall.simpleResult
+ (fn () =>
+ PrimitiveFFI.Posix.Process.system (NullString.nullTerm cmd))
val atExit = MLtonProcess.atExit