[MLton-commit] r4431
Matthew Fluet
MLton@mlton.org
Sun, 30 Apr 2006 17:38:28 -0700
Refactored MLton (all but Socket)
----------------------------------------------------------------------
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/cont.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.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-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/build/sources.mlb 2006-05-01 00:38:26 UTC (rev 4431)
@@ -290,75 +290,73 @@
../system/timer.sig
../system/timer.sml
-(*
- ../../net/net.sig
- ../../net/net.sml
- ../../net/net-host-db.sig
- ../../net/net-host-db.sml
- ../../net/net-prot-db.sig
- ../../net/net-prot-db.sml
- ../../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/net.sig
+ ../net/net.sml
+ ../net/net-host-db.sig
+ ../net/net-host-db.sml
+ ../net/net-prot-db.sig
+ ../net/net-prot-db.sml
+ ../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
+ *)
+ ../mlton/array.sig
+ ../mlton/cont.sig
+ ../mlton/cont.sml
+ ../mlton/random.sig
+ ../mlton/random.sml
+ ../mlton/io.sig
+ ../mlton/io.fun
+ ../mlton/text-io.sig
+ ../mlton/bin-io.sig
+ ../mlton/itimer.sig
+ ../mlton/itimer.sml
+ ../mlton/ffi.sig
+ ann
+ "ffiStr MLtonFFI"
+ in
+ ../mlton/ffi.sml
+ end
+ ../mlton/int-inf.sig
+ ../mlton/platform.sig
+ ../mlton/platform.sml
+ ../mlton/proc-env.sig
+ ../mlton/proc-env.sml
+ ../mlton/profile.sig
+ ../mlton/profile.sml
+ (* ../mlton/ptrace.sig *)
+ (* ../mlton/ptrace.sml *)
+ ../mlton/rlimit.sig
+ ../mlton/rlimit.sml
+ (* ../mlton/socket.sig *)
+ (* ../mlton/socket.sml *)
+ ../mlton/syslog.sig
+ ../mlton/syslog.sml
+ ../mlton/vector.sig
+ ../mlton/weak.sig
+ ../mlton/weak.sml
+ ../mlton/finalizable.sig
+ ../mlton/finalizable.sml
+ ../mlton/word.sig
+ ../mlton/world.sig
+ ../mlton/world.sml
(*
- ../../mlton/array.sig
- ../../mlton/cont.sig
- ../../mlton/cont.sml
- ../../mlton/random.sig
- ../../mlton/random.sml
- ../../mlton/io.sig
- ../../mlton/io.fun
- ../../mlton/text-io.sig
- ../../mlton/bin-io.sig
- ../../mlton/itimer.sig
- ../../mlton/itimer.sml
- ../../mlton/ffi.sig
- ann
- "ffiStr MLtonFFI"
- in
- ../../mlton/ffi.sml
- end
- ../../mlton/int-inf.sig
- ../../mlton/platform.sig
- ../../mlton/platform.sml
- ../../mlton/proc-env.sig
- ../../mlton/proc-env.sml
- ../../mlton/profile.sig
- ../../mlton/profile.sml
- (*
- # mlton/ptrace.sig
- # mlton/ptrace.sml
- *)
- ../../mlton/rlimit.sig
- ../../mlton/rlimit.sml
- ../../mlton/socket.sig
- ../../mlton/socket.sml
- ../../mlton/syslog.sig
- ../../mlton/syslog.sml
- ../../mlton/vector.sig
- ../../mlton/weak.sig
- ../../mlton/weak.sml
- ../../mlton/finalizable.sig
- ../../mlton/finalizable.sml
- ../../mlton/word.sig
- ../../mlton/world.sig
- ../../mlton/world.sml
- ../../mlton/mlton.sig
- ../../mlton/mlton.sml
+ ../mlton/mlton.sig
+ ../mlton/mlton.sml
- ../../sml-nj/sml-nj.sig
- ../../sml-nj/sml-nj.sml
- ../../sml-nj/unsafe.sig
- ../../sml-nj/unsafe.sml
+ ../sml-nj/sml-nj.sig
+ ../sml-nj/sml-nj.sml
+ ../sml-nj/unsafe.sig
+ ../sml-nj/unsafe.sml
top-level/basis.sig
ann
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/cont.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -9,18 +9,17 @@
structure MLtonCont:> MLTON_CONT =
struct
-structure Thread = Primitive.Thread
-val gcState = Primitive.GCState.gcState
+structure Thread = Primitive.MLton.Thread
-(* This mess with dummy is so that if callcc is ever used anywhere in the
- * program, then Primitive.usesCallcc is set to true during basis library
- * evaluation. This relies on the dead code elimination algorithm
- * (core-ml/dead-code.fun), which will keep dummy around only if callcc is used.
- *)
-val dummy =
- (Primitive.usesCallcc := true
- ; fn () => ())
+fun die (s: string): 'a =
+ (PrimitiveFFI.Stdio.print s
+ ; PrimitiveFFI.Posix.Process.exit 1
+ ; let exception DieFailed
+ in raise DieFailed
+ end)
+val gcState = Primitive.MLton.GCState.gcState
+
type 'a t = (unit -> 'a) -> unit
fun callcc (f: 'a t -> 'a): 'a =
@@ -58,7 +57,7 @@
Thread.switchTo new
end)
end
- end)
+ end
fun ('a, 'b) throw' (k: 'a t, v: unit -> 'a): 'b =
(k v; raise Fail "throw bug")
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -11,8 +11,10 @@
val atomicEnd: unit -> unit
val getBool: int -> bool
val getChar8: int -> Char.char
+(*
val getChar16: int -> Char16.char
val getChar32: int -> Char32.char
+*)
val getInt8: int -> Int8.int
val getInt16: int -> Int16.int
val getInt32: int -> Int32.int
@@ -27,8 +29,10 @@
val register: int * (unit -> unit) -> unit
val setBool: bool -> unit
val setChar8: Char.char -> unit
+(*
val setChar16: Char16.char -> unit
val setChar32: Char32.char -> unit
+*)
val setInt8: Int8.int -> unit
val setInt16: Int16.int -> unit
val setInt32: Int32.int -> unit
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/ffi.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,13 +8,14 @@
structure MLtonFFI: MLTON_FFI =
struct
-structure Prim = Primitive.FFI
+structure Prim = Primitive.MLton.FFI
-structure Pointer = Primitive.Pointer
+structure Pointer = Primitive.MLton.Pointer
local
fun make (p: Pointer.t, get, set) =
- (fn i => get (p, i), fn x => set (p, 0, x))
+ (fn i => get (p, C_Ptrdiff.fromInt i),
+ fn x => set (p, C_Ptrdiff.fromInt 0, x))
in
val (getInt8, setInt8) =
make (Prim.int8Array, Pointer.getInt8, Pointer.setInt8)
@@ -24,8 +25,8 @@
make (Prim.int32Array, Pointer.getInt32, Pointer.setInt32)
val (getInt64, setInt64) =
make (Prim.int64Array, Pointer.getInt64, Pointer.setInt64)
- fun getPointer i = Pointer.getPointer (Prim.pointerArray, i)
- fun setPointer x = Pointer.setPointer (Prim.pointerArray, 0, x)
+ fun getPointer i = Pointer.getPointer (Prim.pointerArray, C_Ptrdiff.fromInt i)
+ fun setPointer x = Pointer.setPointer (Prim.pointerArray, C_Ptrdiff.fromInt 0, x)
val (getReal32, setReal32) =
make (Prim.real32Array, Pointer.getReal32, Pointer.setReal32)
val (getReal64, setReal64) =
@@ -45,20 +46,20 @@
val register = MLtonThread.register
(* To the C-world, booleans and chars are signed integers. *)
-fun intToBool (i: int): bool = i <> 0
+fun intToBool (i: Int32.t): bool = i <> 0
val getBool = intToBool o getInt32
-val getChar8 = Primitive.Char.fromInt8 o getInt8
-val getChar16 = Primitive.Char2.fromInt16 o getInt16
-val getChar32 = Primitive.Char4.fromInt32 o getInt32
+val getChar8 = Primitive.Char8.fromInt8Unsafe o getInt8
+val getChar16 = Primitive.Char16.fromInt16Unsafe o getInt16
+val getChar32 = Primitive.Char32.fromInt32Unsafe o getInt32
-fun boolToInt (b: bool): int = if b then 1 else 0
+fun boolToInt (b: bool): Int32.t = if b then 1 else 0
val setBool = setInt32 o boolToInt
-val setChar8 = setInt8 o Primitive.Char.toInt8
-val setChar16 = setInt16 o Primitive.Char2.toInt16
-val setChar32 = setInt32 o Primitive.Char4.toInt32
+val setChar8 = setInt8 o Primitive.Char8.toInt8Unsafe
+val setChar16 = setInt16 o Primitive.Char16.toInt16Unsafe
+val setChar32 = setInt32 o Primitive.Char32.toInt32Unsafe
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/finalizable.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -21,7 +21,7 @@
finalizers: ('a -> unit) list ref,
value: 'a ref}
-fun touch (T {value, ...}) = Primitive.touch value
+fun touch (T {value, ...}) = Primitive.MLton.Finalizable.touch value
fun withValue (f as T {value, ...}, g) =
DynamicWind.wind (fn () => g (!value),
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/int-inf.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -5,18 +5,18 @@
* See the file MLton-LICENSE for details.
*)
-type int = Int.int
-type word = Word.word
-
signature MLTON_INT_INF =
sig
type t
+
+ structure BigWord : WORD
+ structure SmallInt : INTEGER
val areSmall: t * t -> bool
val gcd: t * t -> t
val isSmall: t -> bool
datatype rep =
- Big of word vector
- | Small of int
+ Big of BigWord.word vector
+ | Small of SmallInt.int
val rep: t -> rep
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/itimer.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -26,9 +26,10 @@
let
fun split t =
let
- val (q, r) = IntInf.quotRem (Time.toMicroseconds t, 1000000)
+ val q = LargeInt.quot (Time.toMicroseconds t, 1000000)
+ val r = LargeInt.rem (Time.toMicroseconds t, 1000000)
in
- (IntInf.toInt q, IntInf.toInt r)
+ (C_Time.fromLarge q, C_SUSeconds.fromLarge r)
end
val (s1, u1) = split interval
val (s2, u2) = split value
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/proc-env.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -25,6 +25,6 @@
val n = Vector.length v
in
PosixError.SysCall.simple
- (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (n, v))
+ (fn () => PrimitiveFFI.Posix.ProcEnv.setgroups (C_Int.fromInt n, v))
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/profile.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -10,7 +10,7 @@
structure P = Primitive.MLton.Profile
-val gcState = Primitive.GCState.gcState
+val gcState = Primitive.MLton.GCState.gcState
val isOn = P.isOn
@@ -81,7 +81,7 @@
creat (file,
flags [irusr, iwusr, irgrp, iwgrp, iroth, iwoth])
end
- val _ = P.Data.write (gcState, raw, Posix.FileSys.fdToWord fd)
+ val _ = P.Data.write (gcState, raw, fd)
val _ = Posix.IO.close fd
in
()
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/random.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -5,9 +5,6 @@
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
-
-type int = Int.int
-type word = Word.word
signature MLTON_RANDOM =
sig
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sig 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,9 +8,9 @@
signature MLTON_RLIMIT =
sig
- type rlim = Word64.word
+ structure RLim : WORD
- val infinity: rlim
+ val infinity: RLim.word
type t
@@ -27,7 +27,7 @@
val numProcesses: t (* NPROC max number of processes *)
val residentSetSize: t (* RSS max resident set size *)
*)
-
- val get: t -> {hard: rlim, soft: rlim}
- val set: t * {hard: rlim, soft: rlim} -> unit
+
+ val get: t -> {hard: RLim.word, soft: RLim.word}
+ val set: t * {hard: RLim.word, soft: RLim.word} -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/rlimit.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -9,14 +9,14 @@
structure MLtonRlimit: MLTON_RLIMIT =
struct
open PrimitiveFFI.MLton.Rlimit
- type rlim = C_RLim.t
+ structure RLim = C_RLim
type t = C_Int.t
val get =
fn (r: t) =>
PosixError.SysCall.syscall
(fn () =>
- (get r, fn () =>
+ (get r, fn _ =>
{hard = getHard (),
soft = getSoft ()}))
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/syslog.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -70,20 +70,17 @@
val WARNING = LOG_WARNING
end
-fun zt s = s ^ "\000"
-
val openlog = fn (s, opt, fac) =>
let
- val optf =
- Word32.toInt (foldl Word32.orb 0w0 (map Word32.fromInt opt))
+ val optf = foldl C_Int.orb 0 opt
in
- openlog (NullString.fromString (zt s), optf, fac)
+ openlog (NullString.nullTerm s, optf, fac)
end
val closelog = fn () =>
closelog ()
val log = fn (lev, msg) =>
- syslog (lev, NullString.fromString (zt msg))
+ syslog (lev, NullString.nullTerm msg)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/mlton/world.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -8,9 +8,9 @@
structure MLtonWorld: MLTON_WORLD =
struct
- structure Prim = Primitive.World
+ structure Prim = Primitive.MLton.World
- val gcState = Primitive.GCState.gcState
+ val gcState = Primitive.MLton.GCState.gcState
datatype status = Clone | Original
@@ -24,8 +24,7 @@
let
open Posix.FileSys
val flags =
- O.flags [O.trunc,
- SysWord.fromInt PrimitiveFFI.Posix.FileSys.O.BINARY]
+ O.flags [O.trunc, PrimitiveFFI.Posix.FileSys.O.BINARY]
val mode =
let
open S
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-04-30 22:18:59 UTC (rev 4430)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library.refactor/primitive/prim-mlton.sml 2006-05-01 00:38:26 UTC (rev 4431)
@@ -229,7 +229,7 @@
struct
type t = Pointer.t
- (* val dummy:t = 0w0 *)
+ val dummy = Pointer.null
val free = _import "GC_profileFree": GCState.t * t -> unit;
val malloc = _import "GC_profileMalloc": GCState.t -> t;
val write = _import "GC_profileWrite": GCState.t * t * C_Fd.t -> unit;