[MLton-commit] r6425
Matthew Fluet
fluet at mlton.org
Sun Mar 2 12:50:55 PST 2008
OS.Process.status should not be exposed as an equality type
----------------------------------------------------------------------
U mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
U mlton/trunk/basis-library/mlton/exit.sml
U mlton/trunk/basis-library/mlton/exn.sml
U mlton/trunk/basis-library/posix/process.sml
U mlton/trunk/basis-library/system/pre-os.sml
U mlton/trunk/basis-library/system/process.sml
U mlton/trunk/lib/mlton/basic/process.sml
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig 2008-03-02 20:50:54 UTC (rev 6425)
@@ -717,7 +717,7 @@
where type NetHostDB.in_addr = NetHostDB.in_addr
where type NetHostDB.addr_family = NetHostDB.addr_family
where type OS.IO.iodesc = OS.IO.iodesc
- where type OS.Process.status = OS.Process.status (* UNIX *)
+ where type OS.Process.status = OS.Process.status (* UNIX, POSIX_PROCESS *)
where type Position.int = Position.int
where type Posix.IO.file_desc = Posix.IO.file_desc
where type Posix.Signal.signal = Posix.Signal.signal
Modified: mlton/trunk/basis-library/mlton/exit.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exit.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/mlton/exit.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -9,9 +9,9 @@
struct
structure Status =
struct
- type t = C_Status.t
- val fromInt = C_Status.fromInt
- val toInt = C_Status.toInt
+ open OS.Process.Status
+ val fromInt = fromC o C_Status.fromInt
+ val toInt = C_Status.toInt o toC
val failure = fromInt 1
val success = fromInt 0
end
@@ -23,6 +23,9 @@
then ()
else Cleaner.addNew (Cleaner.atExit, f)
+ fun halt (status: Status.t) =
+ Primitive.MLton.halt (Status.toC status)
+
fun exit (status: Status.t): 'a =
if !exiting
then raise Fail "exit"
@@ -33,7 +36,7 @@
in
if 0 <= i andalso i < 256
then (let open Cleaner in clean atExit end
- ; Primitive.MLton.halt status
+ ; halt status
; raise Fail "exit")
else raise Fail (concat ["exit must have 0 <= status < 256: saw ",
Int.toString i])
Modified: mlton/trunk/basis-library/mlton/exn.sml
===================================================================
--- mlton/trunk/basis-library/mlton/exn.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/mlton/exn.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -48,7 +48,7 @@
; message "Top-level handler returned.\n"
; Exit.exit Exit.Status.failure)
handle _ => (message "Top-level handler raised exception.\n"
- ; Primitive.MLton.halt Exit.Status.failure
+ ; Exit.halt Exit.Status.failure
; raise Fail "MLton.Exn.wrapHandler")
in
val getTopLevelHandler = Primitive.TopLevel.getHandler
Modified: mlton/trunk/basis-library/posix/process.sml
===================================================================
--- mlton/trunk/basis-library/posix/process.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/posix/process.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -72,7 +72,7 @@
| W_SIGNALED of signal
| W_STOPPED of signal
- fun fromStatus status =
+ fun fromStatus' status =
if Prim.ifExited status <> C_Int.zero
then (case Prim.exitStatus status of
0 => W_EXITED
@@ -82,6 +82,8 @@
else if Prim.ifStopped status <> C_Int.zero
then W_STOPPED (Prim.stopSig status)
else raise Fail "Posix.Process.fromStatus"
+ fun fromStatus status =
+ fromStatus' (PreOS.Process.Status.toC status)
structure W =
struct
@@ -118,7 +120,7 @@
pid
end)
end
- fun getStatus () = fromStatus (!status)
+ fun getStatus () = fromStatus' (!status)
in
fun waitpid (wa, flags) =
let
Modified: mlton/trunk/basis-library/system/pre-os.sml
===================================================================
--- mlton/trunk/basis-library/system/pre-os.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/system/pre-os.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -7,11 +7,31 @@
structure OS =
struct
- structure Process =
+ structure Process :>
+ sig
+ type status
+ structure Status :
+ sig
+ type t = status
+ val equals: t * t -> bool
+ val fromC: C_Status.t -> t
+ val toC: t -> C_Status.t
+ end
+ end =
struct
- type status = C_Status.t
+ structure Status =
+ struct
+ type t = C_Status.t
+ fun equals (x1: t, x2: t) = x1 = x2
+ val fromC = fn x => x
+ val toC = fn x => x
+ end
+ type status = Status.t
end
- structure IO =
+ structure IO :
+ sig
+ eqtype iodesc
+ end =
struct
type iodesc = C_Fd.t
end
Modified: mlton/trunk/basis-library/system/process.sml
===================================================================
--- mlton/trunk/basis-library/system/process.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/basis-library/system/process.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -17,14 +17,8 @@
structure Status =
struct
- type t = C_Status.t
+ open MLtonProcess.Status
- val fromInt = C_Status.fromInt
- val toInt = C_Status.toInt
-
- val failure = fromInt 1
- val success = fromInt 0
-
val fromPosix =
fn es =>
let
@@ -32,7 +26,8 @@
in
case es of
W_EXITED => success
- | W_EXITSTATUS w => C_Status.castFromSysWord (Word8.castToSysWord w)
+ | W_EXITSTATUS w =>
+ fromC (C_Status.castFromSysWord (Word8.castToSysWord w))
| W_SIGNALED _ => failure
| W_STOPPED _ => failure
end
@@ -42,10 +37,10 @@
val failure = Status.failure
val success = Status.success
- fun isSuccess st = st = success
+ fun isSuccess st = Status.equals (st, success)
fun system cmd =
- Posix.Error.SysCall.simpleResult
+ (Status.fromC o Posix.Error.SysCall.simpleResult)
(fn () =>
PrimitiveFFI.Posix.Process.system (NullString.nullTerm cmd))
Modified: mlton/trunk/lib/mlton/basic/process.sml
===================================================================
--- mlton/trunk/lib/mlton/basic/process.sml 2008-02-29 17:04:22 UTC (rev 6424)
+++ mlton/trunk/lib/mlton/basic/process.sml 2008-03-02 20:50:54 UTC (rev 6425)
@@ -18,11 +18,9 @@
let
val status = OS.Process.system s
in
- if status = OS.Process.success
+ if OS.Process.isSuccess status
then ()
- else if status = OS.Process.failure
- then Error.bug (concat ["Process.system: command failed: ", s])
- else Error.bug (concat ["Process.system: strange return: ", s])
+ else Error.bug (concat ["Process.system: command failed: ", s])
end
structure Command =
More information about the MLton-commit
mailing list