Menu
▾
▴
[MLton-commit] r4671
|
From: Matthew F. <fl...@ml...> - 2006-07-03 14:19:14
|
Merge trunk revisions 4361:4670 into cmm branch
----------------------------------------------------------------------
U mlton/branches/on-20050420-cmm-branch/Makefile
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb
A mlton/branches/on-20050420-cmm-branch/basis-library/misc/one.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml
U mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun
U mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig
U mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml
U mlton/branches/on-20050420-cmm-branch/bin/mlton-script
U mlton/branches/on-20050420-cmm-branch/bin/platform
U mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis
U mlton/branches/on-20050420-cmm-branch/bytecode/Makefile
U mlton/branches/on-20050420-cmm-branch/doc/changelog
U mlton/branches/on-20050420-cmm-branch/doc/license/README
U mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/Makefile
U mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/ckit.patch
U mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/ckit.tgz
U mlton/branches/on-20050420-cmm-branch/lib/cml/core-cml/event.sml
A mlton/branches/on-20050420-cmm-branch/lib/mlrisc-lib/
A mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/inet-sock.sml
A mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/socket.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.cm
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/sources.mlb
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/string.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.fun
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/vector.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word.sml
A mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word16.sml
A mlton/branches/on-20050420-cmm-branch/lib/mlton/basic/word8-array-slice.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton/pervasive/pervasive.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.cm
U mlton/branches/on-20050420-cmm-branch/lib/mlton/sources.mlb
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/array.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/bin-io.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/mlton.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/platform.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/pointer.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/proc-env.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/sources.cm
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/text-io.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs/vector.sig
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/array.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/open-int32.sml
A mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/socket.sml
U mlton/branches/on-20050420-cmm-branch/lib/mlton-stubs-in-smlnj/sources.cm
U mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib/Makefile
U mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib/smlnj-lib.patch
U mlton/branches/on-20050420-cmm-branch/lib/smlnj-lib/smlnj-lib.tgz
U mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.fun
U mlton/branches/on-20050420-cmm-branch/mlton/atoms/prim.sig
U mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-codegen.fun
U mlton/branches/on-20050420-cmm-branch/mlton/codegen/x86-codegen/x86-generate-transfers.fun
U mlton/branches/on-20050420-cmm-branch/mlton/main/main.fun
U mlton/branches/on-20050420-cmm-branch/mlton/ssa/deep-flatten.fun
U mlton/branches/on-20050420-cmm-branch/mlton/ssa/redundant-tests.fun
U mlton/branches/on-20050420-cmm-branch/mlton/ssa/ref-flatten.fun
U mlton/branches/on-20050420-cmm-branch/package/debian/changelog
A mlton/branches/on-20050420-cmm-branch/regression/mlton.share.hppa-hpux.ok
A mlton/branches/on-20050420-cmm-branch/regression/mlton.share.sparc-solaris.ok
A mlton/branches/on-20050420-cmm-branch/regression/pack-real.2.ok
A mlton/branches/on-20050420-cmm-branch/regression/pack-real.2.sml
U mlton/branches/on-20050420-cmm-branch/runtime/Makefile
U mlton/branches/on-20050420-cmm-branch/runtime/Posix/ProcEnv/Uname.c
U mlton/branches/on-20050420-cmm-branch/runtime/basis/Int/Word.c
U mlton/branches/on-20050420-cmm-branch/runtime/basis/Net/Socket/Socket.c
U mlton/branches/on-20050420-cmm-branch/runtime/gc.c
A mlton/branches/on-20050420-cmm-branch/runtime/platform/aix.c
A mlton/branches/on-20050420-cmm-branch/runtime/platform/aix.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.c
U mlton/branches/on-20050420-cmm-branch/runtime/platform/cygwin.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/darwin.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/freebsd.h
A mlton/branches/on-20050420-cmm-branch/runtime/platform/hpux.c
A mlton/branches/on-20050420-cmm-branch/runtime/platform/hpux.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/linux.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/mingw.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/netbsd.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform/openbsd.h
A mlton/branches/on-20050420-cmm-branch/runtime/platform/recv.nonblock.c
A mlton/branches/on-20050420-cmm-branch/runtime/platform/setenv.putenv.c
U mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.c
U mlton/branches/on-20050420-cmm-branch/runtime/platform/solaris.h
U mlton/branches/on-20050420-cmm-branch/runtime/platform.h
U mlton/branches/on-20050420-cmm-branch/runtime/types.h
U mlton/branches/on-20050420-cmm-branch/util/cm2mlb/cm2mlb-map
U mlton/branches/on-20050420-cmm-branch/util/cm2mlb/cm2mlb.sml
----------------------------------------------------------------------
Modified: mlton/branches/on-20050420-cmm-branch/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/Makefile 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/Makefile 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-## Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+## Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
# Jagannathan, and Stephen Weeks.
# Copyright (C) 1997-2000 NEC Research Institute.
#
@@ -169,17 +169,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
@@ -409,7 +411,7 @@
cd $(TMAN) && $(GZIP) $(MAN_PAGES); \
fi
case "$(TARGET_OS)" in \
- cygwin|darwin|solaris) \
+ aix|cygwin|darwin|solaris) \
;; \
*) \
for f in $(TLIB)/$(AOUT)$(EXE) $(TBIN)/$(LEX)$(EXE) \
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/array2.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-array.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/mono-vector.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.fun 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/sequence.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/arrays-and-vectors/vector.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/integer/int.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/int.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/integer/pack-word32.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/integer/pack-word32.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -22,14 +22,16 @@
Primitive.Word8Array.updateWordRev,
Primitive.Word8Vector.subWordRev)
-fun start (i, n) =
+fun offset (i, n) =
let
val i = Int.* (bytesPerElem, i)
- val _ =
+ val () =
if Primitive.safe
- andalso Primitive.Int.geu (Int.+ (i, Int.- (bytesPerElem, 1)), n)
- then raise Subscript
- else ()
+ andalso (Primitive.Int.geu
+ (Int.+ (i, Int.- (bytesPerElem, 1)), n)) then
+ raise Subscript
+ else
+ ()
in
i
end handle Overflow => raise Subscript
@@ -37,7 +39,7 @@
local
fun make (sub, length, toPoly) (av, i) =
let
- val _ = start (i, length av)
+ val _ = offset (i, length av)
in
Word.toLarge (sub (toPoly av, i))
end
@@ -51,7 +53,7 @@
fun update (a, i, w) =
let
val a = Word8Array.toPoly a
- val _ = start (i, Array.length a)
+ val _ = offset (i, Array.length a)
in
up (a, i, Word.fromLarge w)
end
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/libs/basis-extra/basis-extra.mlb 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/misc/one.sml (from rev 4670, mlton/trunk/basis-library/misc/one.sml)
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/misc/primitive.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -215,7 +215,6 @@
_prim "MLton_installSignalHandler": unit -> unit;
val safe = _command_line_const "MLton.safe": bool = true;
val touch = _prim "MLton_touch": 'a -> unit;
- val usesCallcc: bool ref = ref false;
structure Stdio =
struct
@@ -966,9 +965,11 @@
structure OS =
struct
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
+ | HPUX
| Linux
| MinGW
| NetBSD
@@ -977,9 +978,11 @@
val host: t =
case _const "MLton_Platform_OS_host": string; of
- "cygwin" => Cygwin
+ "aix" => AIX
+ | "cygwin" => Cygwin
| "darwin" => Darwin
| "freebsd" => FreeBSD
+ | "hpux" => HPUX
| "linux" => Linux
| "mingw" => MinGW
| "netbsd" => NetBSD
@@ -1294,7 +1297,16 @@
struct
open Real64
- structure Class =
+ structure Class:>
+ sig
+ eqtype t
+
+ val inf: t
+ val nan: t
+ val normal: t
+ val subnormal: t
+ val zero: t
+ end =
struct
type t = int
@@ -1339,7 +1351,7 @@
val == = _prim "Real64_equal": real * real -> bool;
val ?= = _prim "Real64_qequal": real * real -> bool;
val abs = _prim "Real64_abs": real -> real;
- val class = _import "Real64_class": real -> int;
+ val class = _import "Real64_class": real -> Class.t;
val frexp = _import "Real64_frexp": real * int ref -> real;
val gdtoa =
_import "Real64_gdtoa": real * int * int * int ref -> CString.t;
@@ -1413,7 +1425,7 @@
val == = _prim "Real32_equal": real * real -> bool;
val ?= = _prim "Real32_qequal": real * real -> bool;
val abs = _prim "Real32_abs": real -> real;
- val class = _import "Real32_class": real -> int;
+ val class = _import "Real32_class": real -> Real64.Class.t;
fun frexp (r: real, ir: int ref): real =
fromLarge (Real64.frexp (toLarge r, ir))
val gdtoa =
@@ -2263,3 +2275,5 @@
"unhandled exception in Basis Library\000")))
in
end
+
+val op + = Primitive.Int.+
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/array.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/mlton/cont.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/cont.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -11,54 +11,44 @@
structure Thread = Primitive.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 () => ())
-
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 ()
- 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 ()
+ 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-20050420-cmm-branch/basis-library/mlton/platform.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2003-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -20,9 +20,11 @@
structure OS:
sig
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
+ | HPUX
| Linux
| MinGW
| NetBSD
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/platform.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2003-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2003-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
*
* MLton is released under a BSD-style license.
@@ -43,9 +43,11 @@
struct
open OS
- val all = [(Cygwin, "Cygwin"),
+ val all = [(AIX, "AIX"),
+ (Cygwin, "Cygwin"),
(Darwin, "Darwin"),
(FreeBSD, "FreeBSD"),
+ (HPUX, "HPUX"),
(Linux, "Linux"),
(MinGW, "MinGW"),
(NetBSD, "NetBSD"),
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/pointer.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/mlton/vector.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/mlton/vector.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/real/pack-real.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/pack-real.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -24,10 +24,24 @@
then (subVec, update)
else (subVecRev, updateRev)
+fun offset (i, n) =
+ let
+ val i = Int.* (bytesPerElem, i)
+ val () =
+ if Primitive.safe
+ andalso (Primitive.Int.geu
+ (Int.+ (i, Int.- (bytesPerElem, 1)), n)) then
+ raise Subscript
+ else
+ ()
+ in
+ i
+ end handle Overflow => raise Subscript
+
fun update (a, i, r) =
let
+ val i = offset (i, Word8Array.length a)
val a = Word8Array.toPoly a
- val _ = Array.checkSlice (a, i, SOME bytesPerElem)
in
up (a, i, r)
end
@@ -42,8 +56,8 @@
fun subVec (v, i) =
let
+ val i = offset (i, Word8Vector.length v)
val v = Word8Vector.toPoly v
- val _ = Vector.checkSlice (v, i, SOME bytesPerElem)
in
sub (v, i)
end
Modified: mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real.fun 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/real/real.sig
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/real/real.sig 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml
===================================================================
--- mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/basis-library/sml-nj/sml-nj.sml 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -30,9 +30,11 @@
open MLton.Platform.OS
in
case host of
- Cygwin => UNIX
+ AIX => UNIX
+ | Cygwin => UNIX
| Darwin => MACOS
| FreeBSD => UNIX
+ | HPUX => UNIX
| Linux => UNIX
| MinGW => WIN32
| NetBSD => UNIX
@@ -68,4 +70,3 @@
| Original => false
end
end
-
Modified: mlton/branches/on-20050420-cmm-branch/bin/mlton-script
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/mlton-script 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/bin/mlton-script 2006-07-03 21:18:36 UTC (rev 4671)
@@ -97,10 +97,12 @@
-malign-functions=5
-malign-jumps=2
-malign-loops=2' \
+ -target-link-opt aix '-lgmp' \
-target-link-opt amd64 '-m32' \
-target-link-opt cygwin '-lgmp' \
-target-link-opt darwin "$darwinLinkOpts -lgmp" \
-target-link-opt freebsd '-L/usr/local/lib/ -lgmp' \
+ -target-link-opt hpux '-lgmp' \
-target-link-opt linux '-lgmp' \
-target-link-opt mingw \
'-lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32' \
Modified: mlton/branches/on-20050420-cmm-branch/bin/platform
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/platform 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/bin/platform 2006-07-03 21:18:36 UTC (rev 4671)
@@ -24,8 +24,13 @@
esac
uname=`uname`
+arch_flag=-m
case "$uname" in
+AIX)
+ HOST_OS='aix'
+ arch_flag=-p
+;;
CYGWIN*)
HOST_OS='cygwin'
;;
@@ -35,6 +40,9 @@
FreeBSD*)
HOST_OS='freebsd'
;;
+HP-UX)
+ HOST_OS='hpux'
+;;
Linux)
HOST_OS='linux'
;;
@@ -55,7 +63,7 @@
;;
esac
-arch=`uname -m`
+arch=`uname $arch_flag`
case "$arch" in
alpha*)
@@ -74,6 +82,9 @@
parisc*)
HOST_ARCH=hppa
;;
+9000/*)
+ HOST_ARCH=hppa
+;;
ia64*)
HOST_ARCH=ia64
;;
@@ -84,6 +95,9 @@
# big-endian and little-endian detect via headers
HOST_ARCH=mips
;;
+powerpc)
+ HOST_ARCH=powerpc
+;;
ppc*)
HOST_ARCH=powerpc
;;
Modified: mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/bin/upgrade-basis 2006-07-03 21:18:36 UTC (rev 4671)
@@ -135,6 +135,9 @@
esac
case "$OS" in
+aix)
+ os='AIX'
+;;
cygwin)
os='Cygwin'
;;
@@ -144,6 +147,9 @@
freebsd)
os='FreeBSD'
;;
+hpux)
+ os="HPUX"
+;;
linux)
os='Linux'
;;
@@ -206,12 +212,14 @@
structure OS =
struct
- datatype t = Cygwin | Darwin | FreeBSD | Linux | MinGW | NetBSD
- | OpenBSD | Solaris
+ datatype t = AIX | Cygwin | Darwin | FreeBSD | HPUX | Linux
+ | MinGW | NetBSD | OpenBSD | Solaris
- val all = [(Cygwin, "Cygwin"),
+ val all = [(AIX, "AIX"),
+ (Cygwin, "Cygwin"),
(Darwin, "Darwin"),
(FreeBSD, "FreeBSD"),
+ (HPUX, "HPUX"),
(Linux, "Linux"),
(MinGW, "MinGW"),
(NetBSD, "NetBSD"),
Modified: mlton/branches/on-20050420-cmm-branch/bytecode/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/bytecode/Makefile 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/bytecode/Makefile 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,4 +1,4 @@
-## Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh
+## Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
# Jagannathan, and Stephen Weeks.
#
# MLton is released under a BSD-style license.
@@ -11,6 +11,13 @@
CC = gcc -std=gnu99
CFLAGS = -fomit-frame-pointer -I../runtime -I../include -Wall
+DEBUGFLAGS = $(CFLAGS)
+ifneq ($(TARGET_ARCH), ia64)
+ifneq ($(TARGET_ARCH), powerpc)
+DEBUGFLAGS += -gstabs+
+endif
+endif
+DEBUGFLAGS += -g2
ifeq ($(TARGET_ARCH), amd64)
CFLAGS += -mtune=opteron -m32
@@ -24,7 +31,7 @@
$(CC) $(CFLAGS) -c -O2 interpret.c
interpret-gdb.o: interpret.c interpret.h
- $(CC) $(CFLAGS) -c -o $@ -gstabs+ -g2 -DASSERT=1 interpret.c
+ $(CC) $(DEBUGFLAGS) -c -o $@ -DASSERT=1 interpret.c
print-opcodes: print-opcodes.c opcode.h
$(CC) $(CFLAGS) -o print-opcodes -I../runtime -L../runtime \
Modified: mlton/branches/on-20050420-cmm-branch/doc/changelog
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/changelog 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/doc/changelog 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,3 +1,62 @@
+Here are the changes since version 20051202.
+
+* 2006-06-24
+ - Fixed a bug in pass to flatten data structures. Thanks to Joe Hurd
+ for the bug report.
+
+* 2006-06-08
+ - Fixed a bug in the native codegen's implementation of the C-calling
+ convention.
+
+* 2006-05-11
+ - Ported to PowerPC-AIX.
+ - Fixed a bug in the runtime for the cases where nonblocking IO with
+ sockets was implemented using MSG_DONTWAIT. This flag does not
+ exist on AIX, Cygwin, HPUX, and MinGW and was previously just
+ ignored. Now the runtime simulates the flag for these platforms
+ (except MinGW, yet, where it's still ignored).
+
+* 2006-04-25
+ - Ported to HPPA-HPUX.
+ - Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library
+ specification.
+
+* 2006-04-19
+ - Fixed a bug in MLton.share that could cause a segfault.
+
+* 2006-03-30
+ - Changed MLton.Vector.unfoldi to return the state in addition to the
+ result vector.
+
+* 2006-03-30
+ - Added MLton.Vector.create, a more powerful vector-creation function
+ than is available in the basis library.
+
+* 2006-03-04
+ - Added MLRISC from SML/NJ 110.57 to standard distribution.
+
+* 2006-03-03
+ - Fixed bug in simplifier that could eliminate an irredundant test.
+
+* 2006-03-02
+ - Ported a bugfix from SML/NJ for a bug with the combination of withNack
+ and never in CML.
+
+* 2006-02-09
+ - Support compiler specific annotations in ML Basis files. If an
+ annotation contains ":", then the text preceding the ":" is meant to
+ denote a compiler. For MLton, if the text preceding the ":" is equal
+ to "mlton", then the remaining annotation is scanned as a normal
+ annotation. If the text preceding the ":" is not-equal to "mlton",
+ then the annotation is ignored, and no warning is issued.
+
+* 2006-02-04
+ - Fixed bug in elaboration of functors; a program with a very large
+ number of functors could exhibit the error
+ "ElaborateEnv.functorClosure: firstTycons".
+
+--------------------------------------------------------------------------------
+
Here are the changes from version 20041109 to version 20051202.
Summary:
@@ -61,7 +120,7 @@
* 2005-09-08
- Fixed bug in type inference of flexible records that would show up
- as "Type error: variable applied to wrong number of type args"
+ as "Type error: variable applied to wrong number of type args".
* 2005-09-06
- Fixed bug in Real.signBit, which had assumed that the underlying
Modified: mlton/branches/on-20050420-cmm-branch/doc/license/README
===================================================================
--- mlton/branches/on-20050420-cmm-branch/doc/license/README 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/doc/license/README 2006-07-03 21:18:36 UTC (rev 4671)
@@ -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-20050420-cmm-branch/lib/ckit-lib/Makefile
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/Makefile 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/Makefile 2006-07-03 21:18:36 UTC (rev 4671)
@@ -9,6 +9,7 @@
all: ckit/README.mlton
ckit/README.mlton: ckit.tgz ckit.patch
+ rm -rf ckit
gzip -dc ckit.tgz | tar xf -
chmod -R a+r ckit
chmod -R g-s ckit
Modified: mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/ckit.patch
===================================================================
--- mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/ckit.patch 2006-06-26 08:23:18 UTC (rev 4670)
+++ mlton/branches/on-20050420-cmm-branch/lib/ckit-lib/ckit.patch 2006-07-03 21:18:36 UTC (rev 4671)
@@ -1,11 +1,11 @@
diff -Naur ckit/ckit-lib.mlb ckit-mlton/ckit-lib.mlb
--- ckit/ckit-lib.mlb 1969-12-31 19:00:00.000000000 -0500
-+++ ckit-mlton/ckit-lib.mlb 2005-08-18 09:31:14.000000000 -0400
++++ ckit-mlton/ckit-lib.mlb 2006-05-02 22:38:21.000000000 -0400
@@ -0,0 +1 @@
+src/ckit-lib.mlb
diff -Naur ckit/README.mlton ckit-mlton/README.mlton
--- ckit/README.mlton 1969-12-31 19:00:00.000000000 -0500
-+++ ckit-mlton/README.mlton 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/README.mlton 2006-05-02 22:38:21.000000000 -0400
@@ -0,0 +1,13 @@
+The following changes were made to the ckit Library, in addition to
+deriving the {{{.mlb}}} file from the {{{.cm}}} files:
@@ -22,7 +22,7 @@
+ * {{{ast/build-ast.sml}}} (modified): Rewrote use of ''or-patterns''.
diff -Naur ckit/src/ast/ast-sig.sml ckit-mlton/src/ast/ast-sig.sml
--- ckit/src/ast/ast-sig.sml 2001-10-31 15:22:41.000000000 -0500
-+++ ckit-mlton/src/ast/ast-sig.sml 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/src/ast/ast-sig.sml 2006-05-02 22:38:21.000000000 -0400
@@ -67,7 +67,12 @@
datatype declaration
= TypeDecl of {shadow: {strct:bool} option, tid:tid}
@@ -99,7 +99,7 @@
location : SourceMap.location,
diff -Naur ckit/src/ast/build-ast.sml ckit-mlton/src/ast/build-ast.sml
--- ckit/src/ast/build-ast.sml 2003-08-28 17:58:39.000000000 -0400
-+++ ckit-mlton/src/ast/build-ast.sml 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/src/ast/build-ast.sml 2006-05-02 22:38:21.000000000 -0400
@@ -290,7 +290,8 @@
of SOME{ntype=NONE,...} => true
| _ => false
@@ -225,7 +225,7 @@
else if repeated_declarations_ok
diff -Naur ckit/src/ast/initializer-normalizer.sml ckit-mlton/src/ast/initializer-normalizer.sml
--- ckit/src/ast/initializer-normalizer.sml 2003-08-28 17:58:39.000000000 -0400
-+++ ckit-mlton/src/ast/initializer-normalizer.sml 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/src/ast/initializer-normalizer.sml 2006-05-02 22:38:21.000000000 -0400
@@ -156,7 +156,13 @@
feed (unionNorm (ctype, fields), inits)
| SOME _ => fail "Incomplete type for union ref"
@@ -243,7 +243,7 @@
| Ast.Ellipses => fail "Cannot initialize ellipses"
diff -Naur ckit/src/ast/pp/pp-ast-adornment-sig.sml ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml
--- ckit/src/ast/pp/pp-ast-adornment-sig.sml 2000-04-05 14:34:56.000000000 -0400
-+++ ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/src/ast/pp/pp-ast-adornment-sig.sml 2006-05-02 22:38:21.000000000 -0400
@@ -1,14 +1,14 @@
(* Copyright (c) 1998 by Lucent Technologies *)
@@ -264,7 +264,7 @@
+(* end *)
diff -Naur ckit/src/ast/pp/pp-ast-ext-sig.sml ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml
--- ckit/src/ast/pp/pp-ast-ext-sig.sml 2000-04-05 14:34:56.000000000 -0400
-+++ ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml 2005-08-17 19:41:36.000000000 -0400
++++ ckit-mlton/src/ast/pp/pp-ast-ext-sig.sml 2006-05-02 22:38:21.000000000 -0400
@@ -1,13 +1,13 @@
(* Cop...
[truncated message content] |
