[MLton-commit] r4397
Matthew Fluet
MLton@mlton.org
Tue, 18 Apr 2006 18:19:37 -0700
Merge trunk revisions r4363:4396 into x86_64 branch
----------------------------------------------------------------------
U mlton/branches/on-20050822-x86_64-branch/Makefile
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
A mlton/branches/on-20050822-x86_64-branch/basis-library/misc/one.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/array.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/cont.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/pointer.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
U mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig
U mlton/branches/on-20050822-x86_64-branch/doc/license/README
U mlton/branches/on-20050822-x86_64-branch/lib/cml/core-cml/event.sml
A mlton/branches/on-20050822-x86_64-branch/lib/mlrisc-lib/
A mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/inet-sock.sml
A mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/socket.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.fun
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word.sml
A mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word16.sml
A mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word8-array-slice.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/pervasive/pervasive.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.mlb
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/array.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/bin-io.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/pointer.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/proc-env.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/text-io.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/vector.sig
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/array.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/open-int32.sml
A mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/socket.sml
U mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
U mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
U mlton/branches/on-20050822-x86_64-branch/mlton/ssa/redundant-tests.fun
U mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb-map
U mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050822-x86_64-branch/Makefile
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/Makefile 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/Makefile 2006-04-19 01:19:31 UTC (rev 4397)
@@ -168,17 +168,19 @@
# do not change "make" to "$(MAKE)" in the following line
cd $(BSDSRC)/package/freebsd && MAINTAINER_MODE=yes make build-package
-LIBRARIES = ckit-lib cml mlnlffi-lib mlyacc-lib smlnj-lib
+LIBRARIES = ckit-lib cml mlnlffi-lib mlrisc-lib mlyacc-lib smlnj-lib
.PHONY: libraries-no-check
libraries-no-check:
mkdir -p $(LIB)/sml
cd $(LIB)/sml && rm -rf $(LIBRARIES)
$(MAKE) -C $(SRC)/lib/ckit-lib
+ $(MAKE) -C $(SRC)/lib/mlrisc-lib
$(MAKE) -C $(SRC)/lib/smlnj-lib
$(CP) $(SRC)/lib/cml/. $(LIB)/sml/cml
$(CP) $(SRC)/lib/ckit-lib/ckit/. $(LIB)/sml/ckit-lib
$(CP) $(SRC)/lib/mlnlffi/. $(LIB)/sml/mlnlffi-lib
+ $(CP) $(SRC)/lib/mlrisc-lib/MLRISC/. $(LIB)/sml/mlrisc-lib
$(CP) $(SRC)/lib/mlyacc/. $(LIB)/sml/mlyacc-lib
$(CP) $(SRC)/lib/smlnj-lib/smlnj-lib/. $(LIB)/sml/smlnj-lib
find $(LIB)/sml -type d -name .svn | xargs rm -rf
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -40,17 +40,11 @@
structure ArraySlice: ARRAY_SLICE_EXTRA
- val rawArray: int -> 'a array
- val unsafeSub: 'a array * int -> 'a
- val unsafeUpdate: 'a array * int * 'a -> unit
-
val concat: 'a array list -> 'a array
val duplicate: 'a array -> 'a array
+ val rawArray: int -> 'a array
val toList: 'a array -> 'a list
- val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b array
-
- (* Deprecated *)
- val checkSlice: 'a array * int * int option -> int
- (* Deprecated *)
- val checkSliceMax: int * int option * int -> int
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
+ val unsafeSub: 'a array * int -> 'a
+ val unsafeUpdate: 'a array * int * 'a -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/array2.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -28,10 +28,28 @@
nrows: int option,
ncols: int option}
+ fun checkSliceMax (start: int, num: int option, max: int): int =
+ case num of
+ NONE =>
+ if Primitive.safe andalso (start < 0 orelse start > max) then
+ raise Subscript
+ else
+ max
+ | SOME num =>
+ if Primitive.safe
+ andalso (start < 0
+ orelse num < 0
+ orelse start > max -? num) then
+ raise Subscript
+ else
+ start +? num
+
fun checkRegion {base, row, col, nrows, ncols} =
- let val (rows, cols) = dimensions base
- in {stopRow = Array.checkSliceMax (row, nrows, rows),
- stopCol = Array.checkSliceMax (col, ncols, cols)}
+ let
+ val (rows, cols) = dimensions base
+ in
+ {stopRow = checkSliceMax (row, nrows, rows),
+ stopCol = checkSliceMax (col, ncols, cols)}
end
fun wholeRegion (a: 'a array): 'a region =
@@ -142,72 +160,12 @@
fun modify trv f a = modifyi trv (f o #3) (wholeRegion a)
fun tabulate trv (rows, cols, f) =
- if !Primitive.usesCallcc
- then
- (* All this mess is careful to construct a list representing
- * the array and then convert the list to the array after all
- * the calls to f have been made, in case f uses callcc.
- *)
- let
- val size =
- if Primitive.safe andalso (rows < 0 orelse cols < 0)
- then raise Size
- else rows * cols handle Overflow => raise Size
- val (rows', cols', f) =
- case trv of
- RowMajor => (rows, cols, f)
- | ColMajor => (cols, rows, fn (c, r) => f (r, c))
- fun loopr (r, l) =
- if r >= rows'
- then l
- else
- let
- fun loopc (c, l) =
- if c >= cols'
- then l
- else loopc (c + 1, f (r, c) :: l)
- in loopr (r + 1, loopc (0, l))
- end
- val l = loopr (0, [])
- val a = Primitive.Array.array size
- in case trv of
- RowMajor =>
- (* The list holds the elements in row major order,
- * but reversed.
- *)
- let
- val _ =
- List.foldl (fn (x, i) =>
- (Primitive.Array.update (a, i, x)
- ; i -? 1))
- (size -? 1) l
- in
- ()
- end
- | ColMajor =>
- (* The list holds the elements in column major order,
- * but reversed.
- *)
- let
- val _ =
- List.foldl (fn (x, (spot, r)) =>
- (Primitive.Array.update (a, spot, x)
- ; if r = 0
- then (spot -? 1 +? size -? cols,
- rows -? 1)
- else (spot -? cols, r -? 1)))
- (size -? 1, rows -? 1)
- l
- in
- ()
- end
- ; {rows = rows, cols = cols, array = a}
- end
- else
- let val a = arrayUninit (rows, cols)
- in modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
- ; a
- end
+ let
+ val a = arrayUninit (rows, cols)
+ val () = modifyi trv (fn (r, c, _) => f (r, c)) (wholeRegion a)
+ in
+ a
+ end
fun copy {src = src as {base, row, col, ...}: 'a region,
dst, dst_row, dst_col} =
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -45,7 +45,7 @@
val rawArray: int -> array
val toList: array -> elem list
val toPoly: array -> elem Array.array
- val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array
+ val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array * 'a
val unsafeSub: array * int -> elem
val unsafeUpdate: array * int * elem -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-vector.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/mono-vector.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -41,7 +41,7 @@
val toList: vector -> elem list
val tokens: (elem -> bool) -> vector -> vector list
val translate: (elem -> vector) -> vector -> vector
- val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> vector
+ val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> vector * 'a
val unsafeSub: vector * int -> elem
val vector: int * elem -> vector
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun 2006-04-19 01:19:31 UTC (rev 4397)
@@ -32,55 +32,28 @@
fun seq0 () = fromArray (array 0)
+ (* unfoldi depends on the fact that the runtime system fills in the array
+ * with reasonable bogus values.
+ *)
fun unfoldi (n, b, f) =
let
val a = array n
fun loop (i, b) =
- if i >= n
- then ()
+ if i >= n then
+ b
else
let
val (x, b') = f (i, b)
- val _ = Array.update (a, i, x)
+ val () = Array.update (a, i, x)
in
loop (i +? 1, b')
end
- val _ = loop (0, b)
+ val b = loop (0, b)
in
- fromArray a
+ (fromArray a, b)
end
- (* Tabulate depends on the fact that the runtime system fills in the array
- * with reasonable bogus values.
- *)
- fun tabulate (n, f) =
-(*
- if !Primitive.usesCallcc
- then
- (* This code is careful to use a list to accumulate the
- * components of the array in case f uses callcc.
- *)
- let
- fun loop (i, l) =
- if i >= n
- then l
- else loop (i + 1, f i :: l)
- val l = loop (0, [])
- val a = array n
- fun loop (l, i) =
- case l of
- [] => ()
- | x :: l =>
- let val i = i -? 1
- in Array.update (a, i, x)
- ; loop (l, i)
- end
- in loop (l, n)
- ; fromArray a
- end
- else
-*)
- unfoldi (n, (), fn (i, ()) => (f i, ()))
+ fun tabulate (n, f) = #1 (unfoldi (n, (), fn (i, ()) => (f i, ())))
fun new (n, x) = tabulate (n, fn _ => x)
@@ -218,25 +191,26 @@
in loop (min1, min2)
end
fun sequence (sl as T {seq, start, len}): 'a sequence =
- if isMutable orelse (start <> 0 orelse len <> S.length seq)
- then map (fn x => x) sl
- else seq
+ if isMutable orelse (start <> 0 orelse len <> S.length seq) then
+ map (fn x => x) sl
+ else
+ seq
fun append (sl1: 'a slice, sl2: 'a slice): 'a sequence =
- if length sl1 = 0
- then sequence sl2
- else if length sl2 = 0
- then sequence sl1
+ if length sl1 = 0 then
+ sequence sl2
+ else if length sl2 = 0 then
+ sequence sl1
else
let
val l1 = length sl1
val l2 = length sl2
val n = l1 + l2 handle Overflow => raise Size
in
- unfoldi (n, (0, sl1),
- fn (_, (i, sl)) =>
- if i < length sl
- then (unsafeSub (sl, i), (i +? 1, sl))
- else (unsafeSub (sl2, 0), (1, sl2)))
+ #1 (unfoldi (n, (0, sl1),
+ fn (_, (i, sl)) =>
+ if i < length sl then
+ (unsafeSub (sl, i), (i +? 1, sl))
+ else (unsafeSub (sl2, 0), (1, sl2))))
end
fun concat (sls: 'a slice list): 'a sequence =
case sls of
@@ -247,17 +221,19 @@
val n = List.foldl (fn (sl, s) => s + length sl) 0 sls'
handle Overflow => raise Size
in
- unfoldi (n, (0, sl, sls),
- fn (_, ac) =>
- let
- fun loop (i, sl, sls) =
- if i < length sl
- then (unsafeSub (sl, i), (i +? 1, sl, sls))
- else case sls of
- [] => raise Fail "concat bug"
- | sl :: sls => loop (0, sl, sls)
- in loop ac
- end)
+ #1 (unfoldi (n, (0, sl, sls),
+ fn (_, ac) =>
+ let
+ fun loop (i, sl, sls) =
+ if i < length sl then
+ (unsafeSub (sl, i),
+ (i +? 1, sl, sls))
+ else case sls of
+ [] => raise Fail "concat bug"
+ | sl :: sls => loop (0, sl, sls)
+ in
+ loop ac
+ end))
end
fun concatWith (sep: 'a sequence) (sls: 'a slice list): 'a sequence =
let val sep = full sep
@@ -480,18 +456,4 @@
fun duplicate seq = make Slice.sequence seq
fun toList seq = make Slice.toList seq
end
-
- (* Deprecated *)
- fun checkSliceMax (start: int, num: int option, max: int): int =
- case num of
- NONE => if Primitive.safe andalso (start < 0 orelse start > max)
- then raise Subscript
- else max
- | SOME num =>
- if Primitive.safe
- andalso (start < 0 orelse num < 0 orelse start > max -? num)
- then raise Subscript
- else start +? num
- (* Deprecated *)
- fun checkSlice (s, i, opt) = checkSliceMax (i, opt, length s)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -62,10 +62,5 @@
val duplicate: 'a sequence -> 'a sequence
val new: int * 'a elt -> 'a sequence
val toList: 'a sequence -> 'a elt list
- val unfoldi: int * 'a * (int * 'a -> 'b elt * 'a) -> 'b sequence
-
- (* Deprecated *)
- val checkSlice: 'a sequence * int * int option -> int
- (* Deprecated *)
- val checkSliceMax: int * int option * int -> int
+ val unfoldi: int * 'a * (int * 'a -> 'b elt * 'a) -> 'b sequence * 'a
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -34,24 +34,24 @@
include VECTOR
structure VectorSlice: VECTOR_SLICE_EXTRA
- val unsafeSub: 'a vector * int -> 'a
-
- (* Used to implement Substring/String functions *)
+ val append: 'a vector * 'a vector -> 'a vector
+ (* concatWith is used to implement Substring/String functions *)
val concatWith: 'a vector -> 'a vector list -> 'a vector
+ val create:
+ int
+ * ({sub: int -> 'a, update: int * 'a -> unit}
+ -> (int -> 'a) * (unit -> unit))
+ -> 'a vector
+ val duplicate: 'a vector -> 'a vector
+ val fields: ('a -> bool) -> 'a vector -> 'a vector list
+ val fromArray: 'a array -> 'a vector
val isPrefix: ('a * 'a -> bool) -> 'a vector -> 'a vector -> bool
val isSubvector: ('a * 'a -> bool) -> 'a vector -> 'a vector -> bool
val isSuffix: ('a * 'a -> bool) -> 'a vector -> 'a vector -> bool
+ val toList: 'a vector -> 'a list
+ val tokens: ('a -> bool) -> 'a vector -> 'a vector list
val translate: ('a -> 'a vector) -> 'a vector -> 'a vector
- val tokens: ('a -> bool) -> 'a vector -> 'a vector list
- val fields: ('a -> bool) -> 'a vector -> 'a vector list
-
- val append: 'a vector * 'a vector -> 'a vector
- val duplicate: 'a vector -> 'a vector
- val fromArray: 'a array -> 'a vector
- val toList: 'a vector -> 'a list
- val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b vector
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
+ val unsafeSub: 'a vector * int -> 'a
val vector: int * 'a -> 'a vector
-
- (* Deprecated *)
- val checkSlice: 'a vector * int * int option -> int
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -42,9 +42,37 @@
val fromArray = Primitive.Vector.fromArray
val vector = new
+
+ fun create (n, f) =
+ let
+ val a = Primitive.Array.array n
+ val subLim = ref 0
+ fun sub i =
+ if Primitive.safe andalso Primitive.Int.geu (i, !subLim) then
+ raise Subscript
+ else
+ Primitive.Array.sub (a, i)
+ val updateLim = ref 0
+ fun update (i, x) =
+ if Primitive.safe andalso Primitive.Int.geu (i, !updateLim) then
+ raise Subscript
+ else
+ Primitive.Array.update (a, i, x)
+ val (tab, finish) = f {sub = sub, update = update}
+ val () =
+ Util.naturalForeach
+ (n, fn i =>
+ (Primitive.Array.update (a, i, tab i);
+ subLim := i + 1;
+ updateLim := i + 1))
+ val () = finish ()
+ val () = updateLim := 0
+ in
+ fromArray a
+ end
end
structure VectorSlice: VECTOR_SLICE_EXTRA = Vector.VectorSlice
-
+
structure VectorGlobal: VECTOR_GLOBAL = Vector
open VectorGlobal
val vector = Vector.fromList
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/integer/int.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -119,40 +119,42 @@
* The most that will be required is for minInt in binary.
*)
val maxNumDigits = PI.+ (precision', 1)
- val buf = CharArray.array (maxNumDigits, #"\000")
+ val one = One.make (fn () => CharArray.array (maxNumDigits, #"\000"))
in
fun fmt radix (n: int): string =
- let
- val radix = fromInt (StringCvt.radixToInt radix)
- fun loop (q, i: Int.int) =
- let
- val _ =
- CharArray.update
- (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
- val q = quot (q, radix)
- in
- if q = zero
- then
- let
- val start =
- if n < zero
- then
- let
- val i = PI.- (i, 1)
- val () = CharArray.update (buf, i, #"~")
- in
- i
- end
- else i
- in
- CharArraySlice.vector
- (CharArraySlice.slice (buf, start, NONE))
- end
- else loop (q, PI.- (i, 1))
- end
- in
- loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
- end
+ One.use
+ (one, fn buf =>
+ let
+ val radix = fromInt (StringCvt.radixToInt radix)
+ fun loop (q, i: Int.int) =
+ let
+ val _ =
+ CharArray.update
+ (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
+ val q = quot (q, radix)
+ in
+ if q = zero
+ then
+ let
+ val start =
+ if n < zero
+ then
+ let
+ val i = PI.- (i, 1)
+ val () = CharArray.update (buf, i, #"~")
+ in
+ i
+ end
+ else i
+ in
+ CharArraySlice.vector
+ (CharArraySlice.slice (buf, start, NONE))
+ end
+ else loop (q, PI.- (i, 1))
+ end
+ in
+ loop (if n < zero then n else ~? n, PI.- (maxNumDigits, 1))
+ end)
end
val toString = fmt StringCvt.DEC
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-04-19 01:19:31 UTC (rev 4397)
@@ -20,6 +20,7 @@
../../misc/dynamic-wind.sml
../../general/general.sig
../../general/general.sml
+ ../../misc/one.sml
../../misc/util.sml
../../general/option.sig
../../general/option.sml
Copied: mlton/branches/on-20050822-x86_64-branch/basis-library/misc/one.sml (from rev 4396, mlton/trunk/basis-library/misc/one.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/array.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/array.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -10,5 +10,5 @@
signature MLTON_ARRAY =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/cont.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/cont.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -12,54 +12,44 @@
structure Thread = Primitive.Thread
val gcState = Primitive.GCState.gcState
-(* 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 () => ())
-
type 'a t = (unit -> 'a) -> unit
fun callcc (f: 'a t -> 'a): 'a =
- (dummy ()
- ; if MLtonThread.amInSignalHandler ()
- then die "callcc can not be used in a signal handler\n"
- else
- let
- datatype 'a state =
- Original of 'a t -> 'a
- | Copy of unit -> 'a
- | Clear
- val r: 'a state ref = ref (Original f)
- val _ = Thread.atomicBegin () (* Match 1 *)
- val _ = Thread.copyCurrent ()
- in
- case (!r before r := Clear) of
- Clear => raise Fail "callcc saw Clear"
- | Copy v => (Thread.atomicEnd () (* Match 2 *)
- ; v ())
- | Original f =>
- let
- val t = Thread.savedPre gcState
- in
- Thread.atomicEnd () (* Match 1 *)
- ; f (fn v =>
- let
- val _ = Thread.atomicBegin () (* Match 2 *)
- val _ = r := Copy v
- val new = Thread.copy t
- (* The following Thread.atomicBegin ()
- * is matched by Thread.switchTo.
- *)
- val _ = Thread.atomicBegin ()
- in
- Thread.switchTo new
- end)
- end
- end)
+ if MLtonThread.amInSignalHandler () then
+ die "callcc can not be used in a signal handler\n"
+ else
+ let
+ datatype 'a state =
+ Original of 'a t -> 'a
+ | Copy of unit -> 'a
+ | Clear
+ val r: 'a state ref = ref (Original f)
+ val _ = Thread.atomicBegin () (* Match 1 *)
+ val _ = Thread.copyCurrent ()
+ in
+ case (!r before r := Clear) of
+ Clear => raise Fail "callcc saw Clear"
+ | Copy v => (Thread.atomicEnd () (* Match 2 *)
+ ; v ())
+ | Original f =>
+ let
+ val t = Thread.savedPre gcState
+ in
+ Thread.atomicEnd () (* Match 1 *)
+ ; f (fn v =>
+ let
+ val _ = Thread.atomicBegin () (* Match 2 *)
+ val _ = r := Copy v
+ val new = Thread.copy t
+ (* The following Thread.atomicBegin ()
+ * is matched by Thread.switchTo.
+ *)
+ val _ = Thread.atomicBegin ()
+ in
+ Thread.switchTo new
+ 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/mlton/pointer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/pointer.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/pointer.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -5,6 +5,9 @@
* See the file MLton-LICENSE for details.
*)
+type int = Int.int
+type word = Word.word
+
signature MLTON_POINTER =
sig
eqtype t
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -10,6 +10,10 @@
signature MLTON_VECTOR =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector
+ val create:
+ int * ({sub: int -> 'a, update: int * 'a -> unit}
+ -> (int -> 'a) * (unit -> unit))
+ -> 'a vector
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/pack-real.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -24,10 +24,16 @@
then (subVec, update)
else (subVecRev, updateRev)
+fun check (size, i) =
+ if Int.< (i, 0) orelse Int.> (i, size -? bytesPerElem) then
+ raise Subscript
+ else
+ ()
+
fun update (a, i, r) =
let
+ val () = check (Word8Array.length a, i)
val a = Word8Array.toPoly a
- val _ = Array.checkSlice (a, i, SOME bytesPerElem)
in
up (a, i, r)
end
@@ -42,8 +48,8 @@
fun subVec (v, i) =
let
+ val () = check (Word8Vector.length v, i)
val v = Word8Vector.toPoly v
- val _ = Vector.checkSlice (v, i, SOME bytesPerElem)
in
sub (v, i)
end
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.fun 2006-04-19 01:19:31 UTC (rev 4397)
@@ -63,10 +63,11 @@
val nan = posInf + negInf
+ structure Class = Primitive.Real64.Class
local
val classes =
let
- open Primitive.Real64.Class
+ open Class
in
(* order here is chosen based on putting the more commonly used
* classes at the front.
@@ -103,21 +104,15 @@
INF => false
| NAN => false
| _ => true
-
- fun isNan r = class r = NAN
- fun isNormal r = class r = NORMAL
+ val op == = Prim.==
- val op == =
- fn (x, y) =>
- case (class x, class y) of
- (NAN, _) => false
- | (_, NAN) => false
- | (ZERO, ZERO) => true
- | _ => Prim.== (x, y)
-
val op != = not o op ==
+ fun isNan r = r != r
+
+ fun isNormal r = class r = NORMAL
+
val op ?= =
if MLton.Codegen.isNative
then Prim.?=
Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/real/real.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -27,7 +27,7 @@
val ?= : real * real -> bool
val ~ : real -> real
val abs: real -> real
- val class: real -> int
+ val class: real -> Primitive.Real64.Class.t
val frexp: real * int ref -> real
val gdtoa: real * int * int * int ref -> Primitive.CString.t
val fromInt: int -> real
Modified: mlton/branches/on-20050822-x86_64-branch/doc/license/README
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/doc/license/README 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/doc/license/README 2006-04-19 01:19:31 UTC (rev 4397)
@@ -12,6 +12,7 @@
Concurrent ML Library
CKit Library
mlnlffigen and MLNLFFI Library
+ MLRISC Library
SML/NJ Lib SMLNJ-LIB-LICENSE (BSD-style) SML/NJ Library
Modified: mlton/branches/on-20050822-x86_64-branch/lib/cml/core-cml/event.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/cml/core-cml/event.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/cml/core-cml/event.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -421,7 +421,7 @@
(* walk the event group tree, collecting the base events (with associated
* ack flags), and a list of flag sets. A flag set is a (cvar * ack flag list)
- * pairs, where the flags are those associated with the events covered by the
+ * pair, where the flags are those associated with the events covered by the
* nack cvar.
*)
type ack_flg = bool ref
@@ -590,10 +590,7 @@
extRdy (backs, {prio = prio, doitFn = (doitFn, ackFlg)}::doitFns)
| _ => extRdy (backs, doitFns))
end
- val x =
- case backs of
- [(bevt, _)] => syncOnBEvt bevt
- | _ => (S.atomicBegin (); ext (backs, []))
+ val x = (S.atomicBegin (); ext (backs, []))
val () = debug' "syncOnGrp(4)" (* NonAtomic *)
val () = Assert.assertNonAtomic' "Event.syncOnGrp(4)"
in
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlrisc-lib (from rev 4396, mlton/trunk/lib/mlrisc-lib)
Property changes on: mlton/branches/on-20050822-x86_64-branch/lib/mlrisc-lib
___________________________________________________________________
Name: svn:ignore
+ MLRISC
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/inet-sock.sml (from rev 4396, mlton/trunk/lib/mlton/basic/inet-sock.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/socket.sml (from rev 4396, mlton/trunk/lib/mlton/basic/socket.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.cm 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.cm 2006-04-19 01:19:31 UTC (rev 4397)
@@ -27,6 +27,7 @@
signature SUM
signature T
signature UNIQUE_ID
+signature VECTOR
structure AppendList
structure Array
@@ -36,6 +37,7 @@
structure BinarySearch
structure Bool
structure Buffer
+structure Byte
structure Char
structure CharArray
structure CharBuffer
@@ -70,6 +72,7 @@
structure Int32
structure IntInf
structure InsertionSort
+structure INetSock
structure Iterate
structure Itimer
structure Justify
@@ -117,6 +120,7 @@
structure SMLofNJ
structure Sexp
structure Signal
+structure Socket
structure Stream
structure String
structure StringCvt
@@ -124,18 +128,22 @@
structure SysWord
structure Thread
structure Time
+structure Timer
structure Trace
structure Tree
structure TwoListQueue
structure Unimplemented
structure Unit
structure Unsafe
+structure Url
structure Vector
structure Word
structure Word32
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
functor AlphaBeta
functor Control
@@ -326,6 +334,10 @@
escape.sml
buffer.sig
buffer.sml
+socket.sml
+word16.sml
+inet-sock.sml
+word8-array-slice.sml
# if ( defined(SMLNJ_VERSION) )
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.mlb 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/sources.mlb 2006-04-19 01:19:31 UTC (rev 4397)
@@ -198,6 +198,7 @@
signature STRING
signature T
signature UNIQUE_ID
+ signature VECTOR
structure AppendList
structure Array
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -26,6 +26,7 @@
val baseName: t * t -> t
val compare: t * t -> Relation.t
val concat: t list -> t
+ val concatV: t vector -> t
val concatWith: t list * t -> t
val contains: t * char -> bool
val deleteSurroundingWhitespace: t -> t
@@ -41,6 +42,7 @@
val escapeC: t -> t
val escapeSML: t -> t
val existsi: t * (int * char -> bool) -> bool
+ val exists: t * (char -> bool) -> bool
val explode: t -> char list
(* extract (s, i, SOME j)
* returns the substring of s of length j starting at i.
@@ -103,6 +105,7 @@
val toUpper: t -> t
val tokens: t * (char -> bool) -> t list
val translate: t * (char -> t) -> t
+ val unfold: int * 'a * ('a -> char * 'a) -> t
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/string.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -11,8 +11,42 @@
struct
open String1
+ fun unfold (n, a, f) =
+ let
+ val r = ref a
+ in
+ tabulate (n, fn _ =>
+ let
+ val (b, a) = f (!r)
+ val () = r := a
+ in
+ b
+ end)
+ end
+
+ fun concatV ss =
+ case Vector.length ss of
+ 0 => ""
+ | 1 => Vector.sub (ss, 0)
+ | _ =>
+ let
+ val n =
+ Vector.fold (ss, 0, fn (s, n) => n + size s)
+ val a = Array.new (n, #"a")
+ val _ =
+ Vector.fold
+ (ss, 0, fn (s, i) =>
+ fold (s, i, fn (c, i) =>
+ (Array.update (a, i, c);
+ i + 1)))
+ in
+ tabulate (n, fn i => Array.sub (a, i))
+ end
+
fun existsi (s, f) = Int.exists (0, size s, fn i => f (i, sub (s, i)))
+ fun exists (s, f) = existsi (s, f o #2)
+
fun keepAll (s: t, f: char -> bool): t =
implode (List.rev
(fold (s, [], fn (c, ac) => if f c then c :: ac else ac)))
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.fun 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.fun 2006-04-19 01:19:31 UTC (rev 4397)
@@ -13,9 +13,11 @@
open S
+val size = length
+
fun unfold (n, a, f) = unfoldi (n, a, f o #2)
-fun tabulate (n, f) = unfoldi (n, (), fn (i, ()) => (f i, ()))
+fun tabulate (n, f) = #1 (unfoldi (n, (), fn (i, ()) => (f i, ())))
fun fromArray a =
tabulate (Pervasive.Array.length a, fn i => Pervasive.Array.sub (a, i))
@@ -455,36 +457,37 @@
let
val n = List.fold (vs, 0, fn (v, s) => s + length v)
in
- unfold (n, (0, v, vs'),
- let
- fun loop (i, v, vs) =
- if i < length v
- then (sub (v, i), (i + 1, v, vs))
- else
- case vs of
- [] => Error.bug "Vector.concat"
- | v :: vs => loop (0, v, vs)
- in loop
- end)
+ #1 (unfold (n, (0, v, vs'),
+ let
+ fun loop (i, v, vs) =
+ if i < length v
+ then (sub (v, i), (i + 1, v, vs))
+ else
+ case vs of
+ [] => Error.bug "Vector.concat"
+ | v :: vs => loop (0, v, vs)
+ in loop
+ end))
end
fun concatV vs =
- if 0 = length vs
- then new0 ()
+ if 0 = length vs then
+ new0 ()
else
let
val n = fold (vs, 0, fn (v, s) => s + length v)
fun state i = (i, sub (vs, i), 0)
in
- unfold (n, state 0,
- let
- fun loop (i, v, j) =
- if j < length v
- then (sub (v, j), (i, v, j + 1))
- else loop (state (i + 1))
- in loop
- end)
- end
+ #1 (unfold (n, state 0,
+ let
+ fun loop (i, v, j) =
+ if j < length v then
+ (sub (v, j), (i, v, j + 1))
+ else
+ loop (state (i + 1))
+ in loop
+ end))
+ end
fun splitLast v =
let
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/vector.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -14,7 +14,7 @@
val length: 'a t -> int
val sub: 'a t * int -> 'a
- val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a t * 'b
end
signature VECTOR =
@@ -111,6 +111,7 @@
val removeDuplicates: 'a t * ('a * 'a -> bool) -> 'a t
val removeFirst: 'a t * ('a -> bool) -> 'a t
val rev: 'a t -> 'a t
+ val size: 'a t -> int
val splitLast: 'a t -> 'a t * 'a
val tabulate: int * (int -> 'a) -> 'a t
val tabulator: int * (('a -> unit) -> unit) -> 'a t
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -23,15 +23,7 @@
orb (w (2, 0w16), w (3, 0w24)))
end
- local
- val wordSize = fromInt wordSize
- in
- fun rotateLeft (w: t, n: t) =
- let val l = n mod wordSize
- val r = wordSize - l
- in orb (<< (w, l), >> (w, r))
- end
- end
+ val rotateLeft = MLton.Word.rol
val fromWord = fn x => x
val toWord = fn x => x
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word16.sml (from rev 4396, mlton/trunk/lib/mlton/basic/word16.sml)
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlton/basic/word8-array-slice.sml (from rev 4396, mlton/trunk/lib/mlton/basic/word8-array-slice.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/pervasive/pervasive.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/pervasive/pervasive.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/pervasive/pervasive.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -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/branches/on-20050822-x86_64-branch/lib/mlton/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.cm 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.cm 2006-04-19 01:19:31 UTC (rev 4397)
@@ -46,6 +46,7 @@
signature SUM
signature T
signature UNIQUE_ID
+signature VECTOR
structure AppendList
structure Array
@@ -55,6 +56,7 @@
structure BinarySearch
structure Bool
structure Buffer
+structure Byte
structure Char
structure CharArray
structure CharBuffer
@@ -90,6 +92,7 @@
structure Int32
structure IntInf
structure InsertionSort
+structure INetSock
structure Iterate
structure Itimer
structure Justify
@@ -138,6 +141,7 @@
structure Sexp
structure Signal
structure SMLofNJ
+structure Socket
structure Stream
structure String
structure StringCvt
@@ -145,17 +149,21 @@
structure SysWord
structure Thread
structure Time
+structure Timer
structure Trace
structure Tree
structure TwoListQueue
structure Unimplemented
structure Unit
structure Unsafe
+structure Url
structure Vector
structure Word
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
structure Word32
functor AlphaBeta
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.mlb
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.mlb 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton/sources.mlb 2006-04-19 01:19:31 UTC (rev 4397)
@@ -32,6 +32,7 @@
signature STRING
signature T
signature UNIQUE_ID
+ signature VECTOR
structure AppendList
structure Array
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/array.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/array.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/array.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
@@ -9,5 +10,5 @@
signature MLTON_ARRAY =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a array * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/bin-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/bin-io.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/bin-io.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -5,7 +5,5 @@
* See the file MLton-LICENSE for details.
*)
-signature MLTON_BIN_IO =
- MLTON_IO
- where type instream = BinIO.instream
- where type outstream = BinIO.outstream
+signature MLTON_BIN_IO = MLTON_IO
+
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/mlton.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -59,14 +59,16 @@
fun unfoldi (n, a, f) =
let
val r = ref a
+ val a =
+ tabulate (n, fn i =>
+ let
+ val (b, a') = f (i, !r)
+ val _ = r := a'
+ in
+ b
+ end)
in
- tabulate (n, fn i =>
- let
- val (b, a') = f (i, !r)
- val _ = r := a'
- in
- b
- end)
+ (a, !r)
end
end
@@ -277,6 +279,8 @@
structure ProcEnv =
struct
+ type gid = Posix.ProcEnv.gid
+
fun setenv _ = raise Fail "setenv"
fun setgroups _ = raise Fail "setgroups"
end
@@ -568,17 +572,55 @@
struct
open Vector
+ fun create (n, f) =
+ let
+ val r = ref (Array.fromList [])
+ val lim = ref 0
+ fun check i =
+ if 0 <= i andalso i < !lim then () else raise Subscript
+ val sub = fn i => (check i; Array.sub (!r, i))
+ val update = fn (i, x) => (check i; Array.update (!r, i, x))
+ val (tab, finish) = f {sub = sub, update = update}
+ in
+ if 0 = n then
+ (finish (); Vector.fromList [])
+ else
+ let
+ val init = tab 0
+ val a = Array.array (n, init)
+ val () = r := a
+ val () =
+ Array.modifyi (fn (i, _) =>
+ let
+ val res =
+ if i = 0 then
+ init
+ else
+ tab i
+ val () = lim := i + 1
+ in
+ res
+ end)
+ a
+ val () = finish ()
+ in
+ Array.vector a
+ end
+ end
+
fun unfoldi (n, a, f) =
let
val r = ref a
+ val v =
+ tabulate (n, fn i =>
+ let
+ val (b, a') = f (i, !r)
+ val _ = r := a'
+ in
+ b
+ end)
in
- tabulate (n, fn i =>
- let
- val (b, a') = f (i, !r)
- val _ = r := a'
- in
- b
- end)
+ (v, !r)
end
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/pointer.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/pointer.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/pointer.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -5,6 +5,9 @@
* See the file MLton-LICENSE for details.
*)
+type int = Int.int
+type word = Word.word
+
signature MLTON_POINTER =
sig
eqtype t
@@ -12,7 +15,7 @@
val add: t * word -> t
val compare: t * t -> order
val diff: t * t -> word
- val free: t -> unit
+(* val free: t -> unit *)
val getInt8: t * int -> Int8.int
val getInt16: t * int -> Int16.int
val getInt32: t * int -> Int32.int
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/proc-env.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/proc-env.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/proc-env.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
@@ -7,5 +8,8 @@
signature MLTON_PROC_ENV =
sig
+ type gid
+
val setenv: {name: string, value: string} -> unit
+ val setgroups: gid list -> unit
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/sources.cm 2006-04-19 01:19:31 UTC (rev 4397)
@@ -29,6 +29,7 @@
structure Int32
structure Int64
structure IntInf
+structure INetSock
structure IO
structure LargeInt
structure LargeReal
@@ -49,19 +50,23 @@
structure RealVector
structure SML90
structure SMLofNJ
+structure Socket
structure String
structure StringCvt
structure Substring
structure SysWord
structure TextIO
structure Time
+structure Timer
structure Unix
structure Unsafe
structure Vector
structure Word
structure Word8
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
+structure Word16
structure Word32
structure Word64
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/text-io.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/text-io.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/text-io.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1,11 +1,9 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
*)
-signature MLTON_TEXT_IO =
- MLTON_IO
- where type instream = TextIO.instream
- where type outstream = TextIO.outstream
+signature MLTON_TEXT_IO = MLTON_IO
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/vector.sig 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs/vector.sig 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1,5 +1,6 @@
-(* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
+ * Copyright (C) 1997-2000 NEC Research Institute.
*
* MLton is released under a BSD-style license.
* See the file MLton-LICENSE for details.
@@ -9,6 +10,10 @@
signature MLTON_VECTOR =
sig
- val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector
+ val create:
+ int * ({sub: int -> 'a, update: int * 'a -> unit}
+ -> (int -> 'a) * (unit -> unit))
+ -> 'a vector
+ val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
end
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/array.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/array.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/array.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -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/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/open-int32.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/open-int32.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/open-int32.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -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)
Copied: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/socket.sml (from rev 4396, mlton/trunk/lib/mlton-stubs-in-smlnj/socket.sml)
Modified: mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/lib/mlton-stubs-in-smlnj/sources.cm 2006-04-19 01:19:31 UTC (rev 4397)
@@ -31,6 +31,7 @@
structure Int32
structure Int64
structure IntInf
+structure INetSock
structure IO
structure LargeInt
structure LargeReal
@@ -58,6 +59,7 @@
structure SysWord
structure TextIO
structure Time
+structure Timer
structure Unix
structure Unsafe
structure Vector
@@ -67,6 +69,7 @@
structure Word32
structure Word64
structure Word8Array
+structure Word8ArraySlice
structure Word8Vector
is
@@ -91,6 +94,7 @@
other.sml
posix.sml
real.sml
+socket.sml
string-cvt.sml
string.sml
substring.sml
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/atoms/prim.fun 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1507,7 +1507,6 @@
| MLton_equal => t
| Real_lt _ => f
| Real_le _ => t
- | Real_equal _ => t
| Real_qequal _ => t
| Word_andb _ => Var x
| Word_equal _ => t
Modified: mlton/branches/on-20050822-x86_64-branch/mlton/ssa/redundant-tests.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/mlton/ssa/redundant-tests.fun 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/mlton/ssa/redundant-tests.fun 2006-04-19 01:19:31 UTC (rev 4397)
@@ -192,11 +192,12 @@
facts = ref [],
inDeg = ref 0}))
(* Set up inDeg. *)
+ fun inc l = Int.inc (#inDeg (labelInfo l))
+ val () = inc start
val _ =
Vector.foreach
(blocks, fn Block.T {transfer, ...} =>
- Transfer.foreachLabel
- (transfer, Int.inc o #inDeg o labelInfo))
+ Transfer.foreachLabel (transfer, inc))
(* Perform analysis, set up facts, and set up ancestor. *)
fun loop (Tree.T (Block.T {label, statements, transfer, ...},
children),
Modified: mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb-map
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb-map 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb-map 2006-04-19 01:19:31 UTC (rev 4397)
@@ -1,8 +1,11 @@
+$SMLNJ-BASIS $(SML_LIB)/basis
$basis.cm $(SML_LIB)/basis
$basis.cm/basis.cm $(SML_LIB)/basis/basis.mlb
-$ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib
-$ml-yacc-lib.cm/ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+$SMLNJ-ML-YACC-LIB $(SML_LIB)/mlyacc-lib
+$SMLNJ-ML-YACC-LIB/ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
+$ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib
+$ml-yacc-lib.cm/ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb
$cml $(SML_LIB)/cml
$cml/cml.cm $(SML_LIB)/cml/cml.mlb
@@ -10,6 +13,7 @@
$c $(SML_LIB)/mlnlffi-lib
$c/c.cm $(SML_LIB)/mlnlffi-lib/mlnlffi-lib.mlb
+$SMLNJ-LIB $(SML_LIB)/smlnj-lib
$smlnj-lib.cm $(SML_LIB)/smlnj-lib/Util
$controls-lib.cm $(SML_LIB)/smlnj-lib/Controls
$hash-cons-lib.cm $(SML_LIB)/smlnj-lib/HashCons
@@ -22,3 +26,5 @@
$ckit-lib.cm $(SML_LIB)/ckit-lib
$ckit-lib.cm/ckit-lib.cm $(SML_LIB)/ckit-lib/ckit-lib.mlb
+
+$SMLNJ-MLRISC $(SML_LIB)/mlrisc-lib/mlb
Modified: mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb.sml 2006-04-19 00:53:39 UTC (rev 4396)
+++ mlton/branches/on-20050822-x86_64-branch/util/cm2mlb/cm2mlb.sml 2006-04-19 01:19:31 UTC (rev 4397)
@@ -175,6 +175,16 @@
then case String.fields (fn #"/" => true | _ => false) cmLibDescr of
"$" :: (arcs as (arc0 :: _)) =>
doitAnchoredPath (("$" ^ arc0) :: arcs)
+ | arc0 :: arcs =>
+ let
+ val arc0 =
+ case CharVector.findi (fn (_, #"(") => true | _ => false) arc0 of
+ SOME (i, _) =>
+ String.extract (arc0, i + 2, SOME (String.size arc0 - i - 3))
+ | NONE => arc0
+ in
+ doitAnchoredPath (arc0 :: arcs)
+ end
| arcs => doitAnchoredPath arcs
else concat ["(* ", cmLibOSString, " ===> *) ", mlbLibDef ()]
in