[MLton-devel] cvs commit: marge of basis-2002 branch

Matthew Fluet fluet@users.sourceforge.net
Sat, 23 Nov 2002 17:19:46 -0800


fluet       02/11/23 17:19:45

  Modified:    basis-library/arrays-and-vectors array.sig array.sml
                        array2.sig mono-array.sig mono-array.sml
                        mono-array2.sig mono-array2.sml mono-vector.sig
                        mono-vector.sml sequence.fun sequence.sig
                        vector.sig vector.sml
               basis-library/general bool.sig bool.sml general.sig
                        general.sml option.sig option.sml
               basis-library/integer int-inf.sig int-inf.sml int32.sml
                        integer.sig pack32.sml word.sig
               basis-library/io bin-io.sig bin-io.sml bin-or-text-io.fun
                        bin-stream-io.sig io.sig stream-io.sig text-io.sig
                        text-io.sml text-stream-io.sig
               basis-library/list list-pair.sig list-pair.sml list.sig
                        list.sml
               basis-library/misc cleaner.sml primitive.sml
               basis-library/mlton exn.sml signal.sml
               basis-library/posix error.sig error.sml file-sys.sig
                        file-sys.sml flags.sig flags.sml io.sig io.sml
                        posix.sig posix.sml primitive.sml proc-env.sig
                        proc-env.sml process.sig process.sml signal.sig
                        tty.sig tty.sml
               basis-library/real IEEE-real.sig IEEE-real.sml math.sig
                        pack-real.sig pack-real.sml real.sig real.sml
               basis-library/sml-nj unsafe.sml
               basis-library/system date.sig date.sml file-sys.sig
                        file-sys.sml io.sig io.sml os.sig os.sml path.sig
                        path.sml process.sig process.sml time.sig time.sml
                        timer.sig timer.sml unix.sig unix.sml
               basis-library/text char.sig char.sml string-cvt.sig
                        string-cvt.sml string.sig string.sml string0.sml
                        substring.sig substring.sml
               basis-library/top-level infixes.sml overloads.sml
               benchmark Makefile benchmark-stubs.cm
               benchmark/tests md5.sml tensor.sml
               bin      check-basis
               doc      changelog
               doc/user-guide basis.tex extensions.tex man-page.tex
               include  ccodegen.h
               lib/mlton/basic dir.sml init-script.sml process.sig
                        string0.sml
               lib/mlton/pervasive pervasive.sml
               lib/mlton-stubs sources.cm
               lib/mlton-stubs-in-smlnj import.cm os.sml pervasive.sml
               mllex    Makefile mllex-stubs.cm
               mlprof   Makefile mlprof-stubs.cm
               mlton    Makefile mlton-stubs.cm
               mlton/ast ast.fun ast.sig prim-tycons.fun prim-tycons.sig
               mlton/atoms const.fun const.sig hash-type.fun prim.fun
                        prim.sig type-ops.fun type-ops.sig
               mlton/backend backend.fun c-function.fun c-function.sig
                        representation.fun rssa.fun ssa-to-rssa.fun
               mlton/codegen/x86-codegen x86-mlton.fun
               mlton/control control.sig control.sml
               mlton/core-ml lookup-constant.fun
               mlton/elaborate elaborate-env.fun elaborate-env.sig
               mlton/main compile.sml main.sml
               mlton/ssa common-subexp.fun constant-propagation.fun
                        poly-equal.fun ssa-tree.fun ssa-tree.sig
               mlton/type-inference infer.fun
               mlyacc   Makefile mlyacc-stubs.cm
               regression array.ok array.sml array6.sml bytechar.sml
                        filesys.sml parse.sml prodcons.sml real6.ok
                        real6.sml size.ok vector.sml word.sml
                        word8array.sml word8vector.sml
               runtime  IntInf.h Makefile posix-constants.h
               runtime/basis IntInf.c
  Added:       basis-library notes.txt
               basis-library/arrays-and-vectors array-slice.sig
                        mono-array-slice.sig mono-array.fun mono-array2.fun
                        mono-vector-slice.sig mono-vector.fun slice.sig
                        vector-slice.sig
               basis-library/io bin-prim-io.sml buffer-i.fun buffer-i.sig
                        fast-imperative-io.fun fast-imperative-io.sig
                        imperative-io.fun imperative-io.sig prim-io.fun
                        prim-io.sig stream-io.fun text-prim-io.sml
               basis-library/libs build
               basis-library/libs/basis-1997 bind prefix suffix
               basis-library/libs/basis-1997/arrays-and-vectors array.sig
                        mono-array.sig mono-array2.sig
                        mono-vector-array-array2-convert.fun
                        mono-vector.sig vector-array-convert.fun vector.sig
               basis-library/libs/basis-1997/io bin-io-convert.fun
                        bin-io.sig bin-stream-io.sig io-convert.fun io.sig
                        stream-io.sig text-io-convert.fun text-io.sig
                        text-stream-io.sig
               basis-library/libs/basis-1997/posix file-sys-convert.fun
                        file-sys.sig flags-convert.fun flags.sig
                        io-convert.fun io.sig posix-convert.fun posix.sig
                        process-convert.fun process.sig tty-convert.fun
                        tty.sig
               basis-library/libs/basis-1997/real IEEE-real-convert.fun
                        IEEE-real.sig real-convert.fun real.sig
               basis-library/libs/basis-1997/system file-sys-convert.fun
                        file-sys.sig os-convert.fun os.sig
                        process-convert.fun process.sig timer-convert.fun
                        timer.sig unix-convert.fun unix.sig
               basis-library/libs/basis-1997/text string.sig substring.sig
                        text-convert.fun
               basis-library/libs/basis-1997/top-level basis-funs.sml
                        basis-sigs.sml basis.sig basis.sml infixes.sml
                        overloads.sml top-level.sml
               basis-library/libs/basis-2002 bind prefix suffix
               basis-library/libs/basis-2002/top-level basis-funs.sml
                        basis-sigs.sml basis.sig basis.sml infixes.sml
                        overloads.sml top-level.sml
               basis-library/libs/basis-2002-strict bind prefix suffix
               basis-library/libs/basis-2002-strict/top-level top-level.sml
               basis-library/libs/none bind prefix suffix
               basis-library/libs/none/top-level infixes.sml
               basis-library/system pre-os.sml
               basis-library/text text.sig text.sml
               lib/basis-stubs Makefile basis-2002.sml os.sml sources.cm
               lib/mlton-stubs int-inf.sml
               regression 1.ok 2.ok command-line.ok conv.ok conv2.ok
                        fast.ok fast2.ok hello-world.ok int-inf.bitops.ok
                        int-inf.bitops.sml slow.ok slow2.ok slower.ok
                        substring.ok testdyn2.ok thread-switch.ok
               runtime/basis/OS/IO poll.c
  Removed:     basis-library bind-basis
               regression conv.sml.ok conv2.sml.ok fast.sml.ok fast2.sml.ok
                        format.sml.ok slow.sml.ok slow2.sml.ok
                        slower.sml.ok
               runtime/basis/String equal.c
  Log:
  This merges in the basis-2002 branch.
  
  Added -basis option to choose a basis library.  Currently supported
  basis libraries are basis-2002, basis-2002-strict, basis-1997, none.
  See the user guide for caveats on basis-1997.  Removed
  -use-basis-library option, as -basis none subsumes it.
  
  I'm still not quite happy with the "new" IO, so I went ahead and used
  the bin-or-text-io.fun functor to build up TextIO and BinIO.  All the
  code for the new IO is there, and you can switch to the new IO by
  editting /basis-library/io/{bin,text}{-stream-io.sig,-io.{sig,sml}}.
  Should be self-evident how to switch the commented out code.
  Comparing the IO code just before and after the merge, I get:
  
  MLton0 -- mlton.cvs.HEAD
  MLton1 -- mlton.cvs.HEAD.basis-2002
  run time ratio
  benchmark     MLton1
  wc-input1       0.90
  wc-scanStream   0.99
  
  So, something in the basis is speeding up wc-input1.  Too bad I can't
  get it in the new IO.
  (The IMPERATIVE_IO, STREAM_IO signatures match the basis spec, but the
  TextIO and BinIO structures respectively match TEXT_IO and BIN_IO.
  So, you get type errors with
  structure S : IMPERATIVE_IO = TextIO
  because TextIO is missing some functionality.  This isn't any
  different than what was there before.)
  
  Bootstrapping is a little tricky.  Luckily /lib/mlton doesn't depend
  that much on the aspects of the basis library that have changed.  I've
  set things up so that we assume that SML/NJ is using basis1997, while
  MLton is using basis2002.  This means that you can compile
  mlton,mlyacc,mllex,mlprof, benchmark with any reasonably recent
  version of SML/NJ without any changes.
  
  However, no existing MLton executable will compile the code right out
  of the box.  The problem is OS.FileSys.readDir (which has changed
  types) and is used in /lib/mlton/basic/dir.sml.  In order to compile
  with an existing mlton executable, first edit this file, switching the
  commented code in the fold function.  Then you should be able to
  compile a new mlton-compile and build the world.  Then switch the
  /lib/mlton/basic/dir.sml code back before trying to bootstrap with
  this new mlton.  So, the procedure should be as follows:
  
  G0 == mlton-20020923 (for example)
  edit /lib/mlton/basic/dir.sml
  make (yielding G1)
  edit /lib/mlton/basic/dir.sml
  make (yielding G2)
  make (yielding G3)
  G2 == G3 and fixed-point reached.
  
  I can't see any way to hack mlton-stubs in order to patch
  OS.FileSys.readDir in a mlton with basis1997 and a mlton with
  basis2002.  (In order to distinguish them, we need to run them and
  check the type for OS.FileSys.readDir.)  Anyways, I needed to choose
  one of these two options, so I went with the latter since it was
  easier.

Revision  Changes    Path
1.2       +449 -0    mlton/basis-library/notes.txt




1.4       +35 -25    mlton/basis-library/arrays-and-vectors/array.sig

Index: array.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/array.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- array.sig	1 Aug 2001 20:04:01 -0000	1.3
+++ array.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -8,42 +8,52 @@
       include ARRAY_GLOBAL
 
       type 'a vector
-
-      val app: ('a -> unit) -> 'a array -> unit 
-      val appi: (int * 'a -> unit) -> 'a array * int * int option -> unit 
+      val maxLen: int 
       val array: int * 'a -> 'a array 
-      val copy:
-	 {src: 'a array, si: int, len: int option, dst: 'a array, di: int}
-	 -> unit 
-      val copyVec:
-	 {src: 'a vector, si: int, len: int option, dst: 'a array, di: int}
-	 -> unit 
-      val extract: 'a array * int * int option -> 'a vector 
-      val foldl: ('a * 'b -> 'b) -> 'b -> 'a array -> 'b 
-      val foldli:
-	 (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
-      val foldr: ('a * 'b -> 'b) -> 'b -> 'a array -> 'b 
-      val foldri:
-	 (int * 'a * 'b -> 'b) -> 'b -> 'a array * int * int option -> 'b
       val fromList: 'a list -> 'a array 
+      val tabulate: int * (int -> 'a) -> 'a array 
       val length: 'a array -> int 
-      val maxLen: int 
-      val modify: ('a -> 'a) -> 'a array -> unit 
-      val modifyi: (int * 'a -> 'a) -> 'a array * int * int option -> unit 
       val sub: 'a array * int -> 'a 
-      val tabulate: int * (int -> 'a) -> 'a array 
       val update: 'a array * int * 'a -> unit 
+      val vector: 'a array -> 'a vector
+      val copy: {src: 'a array, dst: 'a array, di: int} -> unit 
+      val copyVec: {src: 'a vector, dst: 'a array, di: int} -> unit 
+      val appi: (int * 'a -> unit) -> 'a array -> unit 
+      val app: ('a -> unit) -> 'a array -> unit 
+      val modifyi: (int * 'a -> 'a) -> 'a array -> unit 
+      val modify: ('a -> 'a) -> 'a array -> unit 
+      val foldli: (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+      val foldri: (int * 'a * 'b -> 'b) -> 'b -> 'a array -> 'b
+      val foldl: ('a * 'b -> 'b) -> 'b -> 'a array -> 'b 
+      val foldr: ('a * 'b -> 'b) -> 'b -> 'a array -> 'b 
+      val findi: (int * 'a -> bool) -> 'a array -> (int * 'a) option
+      val find: ('a -> bool) -> 'a array -> 'a option
+      val exists: ('a -> bool) -> 'a array -> bool
+      val all: ('a -> bool) -> 'a array -> bool
+      val collate: ('a * 'a -> order) -> 'a array * 'a array -> order
    end
 
 signature ARRAY_EXTRA =
    sig
       include ARRAY
+      type 'a vector_slice
+      structure ArraySlice: ARRAY_SLICE_EXTRA 
+	where type 'a array = 'a array
+	  and type 'a vector = 'a vector
+	  and type 'a vector_slice = 'a vector_slice
 
-      val checkSlice: 'a array * int * int option -> int
-      val checkSliceMax: int * int option * int -> int
-      val prefixToList: 'a array * int -> 'a list
-      val toList: 'a array -> 'a list
-      val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b 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 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
+      (* Deprecated *)
+      val extract: 'a array * int * int option -> 'a vector
    end



1.4       +57 -38    mlton/basis-library/arrays-and-vectors/array.sml

Index: array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/array.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- array.sml	10 Apr 2002 07:02:15 -0000	1.3
+++ array.sml	24 Nov 2002 01:19:35 -0000	1.4
@@ -11,57 +11,76 @@
 			      type 'a elt = 'a
 			      val fromArray = fn a => a
 			      val isMutable = true
-			      open Primitive.Array)
+			      val length = Primitive.Array.length
+			      val sub = Primitive.Array.sub)
       open A
       open Primitive.Int
 
-      local open Primitive.Array
-      in val unsafeSub = sub
-	 val unsafeUpdate = update
-      end
-
       type 'a array = 'a array
-      type 'a vector = 'a vector
+      type 'a vector = 'a Vector.vector
+      type 'a vector_slice = 'a Vector.VectorSlice.slice
 
-      val array = new
+      structure ArraySlice =
+	 struct
+	    open Slice
+	    type 'a array = 'a array
+	    type 'a vector = 'a Vector.vector
+	    type 'a vector_slice = 'a Vector.VectorSlice.slice
+	    fun update (arr, i, x) = 
+	       update' Primitive.Array.update (arr, i, x)
+	    fun unsafeUpdate (arr, i, x) = 
+	       unsafeUpdate' Primitive.Array.update (arr, i, x)
+	    fun vector sl = create Vector.tabulate (fn x => x) sl
+	    fun modifyi f sl = 
+	       appi (fn (i, x) => unsafeUpdate (sl, i, f (i, unsafeSub (sl, i)))) sl
+	    fun modify f sl = modifyi (f o #2) sl
+	    local
+	       fun make (length, sub) {src, dst, di} =
+		  modifyi (fn (i, _) => sub (src, i)) 
+		          (slice (dst, di, SOME (length src)))
+	    in
+	       fun copy (arg as {src, dst, di}) =
+		  let val (src', si', len') = base src
+		  in
+		    if src' = dst andalso si' < di andalso si' +? len' >= di
+		       then let val sl = slice (dst, di, SOME (length src))
+			    in 
+			       foldri (fn (i, _, _) => 
+				       unsafeUpdate (sl, i, unsafeSub (src, i)))
+			       () sl
+			    end
+		    else make (length, unsafeSub) arg
+		  end
 
-      (* can't use o because of value restriction *)
-      val extract = fn arg => Primitive.Vector.fromArray (extract arg)
+	       fun copyVec arg =
+		  make (Vector.VectorSlice.length, Vector.VectorSlice.unsafeSub) arg
+	    end
 
-      fun modifyi f (slice as (a, _, _)) =
-	 appi (fn (i, x) => unsafeUpdate (a, i, f (i, x))) slice
+	    val array = sequence
+	 end
 
-      fun modify f a = modifyi (f o #2) (wholeSlice a)
+      val array = new
 
       local
-	 fun make (checkSlice, sub) {src, si, len, dst, di} =
-	    let
-	       val sm = checkSlice (src, si, len)
-	       val diff = si -? di
-	    in modifyi
-	       (fn (i, _) => sub (src, i +? diff))
-	       (dst, di, SOME (sm -? si))
-	    end
+	fun make f arr = f (ArraySlice.full arr)
       in
-	 fun copy (arg as {src, si, len, dst, di}) =
-	    if src = dst andalso si < di
-	       then
-		  (* Must go right-to-left *)
-		  let
-		     val sm = checkSlice (src, si, len)
-		     val dm = checkSlice (dst, di, SOME (sm -? si))
-		     fun loop i =
-			if i < si then ()
-			else (unsafeUpdate (dst, di +? i, unsafeSub (src, i))
-			      ; loop (i -? 1))
-		  in loop (sm -? 1)
-		  end
-	    else make (checkSlice, unsafeSub) arg
-	       
-	 fun copyVec arg =
-	    make (Vector.checkSlice, Primitive.Vector.sub) arg
+	fun vector arr = make (ArraySlice.vector) arr
+	fun modifyi f = make (ArraySlice.modifyi f)
+	fun modify f = make (ArraySlice.modify f)
+	fun copy {src, dst, di} = ArraySlice.copy {src = ArraySlice.full src,
+						   dst = dst, di = di}
+	fun copyVec {src, dst, di} = ArraySlice.copyVec {src = VectorSlice.full src,
+							 dst = dst, di = di}
       end
+
+      val unsafeSub = Primitive.Array.sub
+      fun update (arr, i, x) = update' Primitive.Array.update (arr, i, x)
+      val unsafeUpdate = Primitive.Array.update
+
+      (* Deprecated *)
+      fun extract args = ArraySlice.vector (ArraySlice.slice args)
    end
+structure ArraySlice: ARRAY_SLICE_EXTRA = Array.ArraySlice
 
 structure ArrayGlobal: ARRAY_GLOBAL = Array
 open ArrayGlobal



1.2       +13 -14    mlton/basis-library/arrays-and-vectors/array2.sig

Index: array2.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/array2.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- array2.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ array2.sig	24 Nov 2002 01:19:35 -0000	1.2
@@ -10,25 +10,24 @@
 
       datatype traversal = RowMajor | ColMajor
 
-      val app: traversal -> ('a -> unit) -> 'a array -> unit 
-      val appi: traversal -> (int * int * 'a -> unit) -> 'a region -> unit 
       val array: int * int * 'a -> 'a array 
-      val column: ('a array * int) -> 'a vector 
+      val fromList: 'a list list -> 'a array 
+      val tabulate: traversal -> (int * int * (int * int -> 'a)) -> 'a array 
+      val sub: 'a array * int * int -> 'a 
+      val update: 'a array * int * int * 'a -> unit 
+      val dimensions: 'a array -> int * int
+      val nRows: 'a array -> int 
+      val nCols: 'a array -> int 
+      val row: 'a array * int -> 'a vector 
+      val column: 'a array * int -> 'a vector 
       val copy: {src: 'a region,
 		 dst: 'a array,
 		 dst_row: int,
 		 dst_col: int} -> unit
-      val dimensions: 'a array -> (int * int) 
+      val appi: traversal -> (int * int * 'a -> unit) -> 'a region -> unit 
+      val app: traversal -> ('a -> unit) -> 'a array -> unit 
+      val foldi: traversal -> (int * int * 'a * 'b -> 'b) -> 'b -> 'a region -> 'b 
       val fold: traversal -> ('a * 'b -> 'b) -> 'b -> 'a array -> 'b
-      val foldi:
-	 traversal -> (int * int * 'a * 'b -> 'b) -> 'b -> 'a region -> 'b 
-      val fromList: 'a list list -> 'a array 
-      val modify: traversal -> ('a -> 'a) -> 'a array -> unit 
       val modifyi: traversal -> (int * int * 'a -> 'a) -> 'a region -> unit 
-      val nCols: 'a array -> int 
-      val nRows: 'a array -> int 
-      val row: ('a array * int) -> 'a vector 
-      val sub: 'a array * int * int -> 'a 
-      val tabulate: traversal -> (int * int * (int * int -> 'a)) -> 'a array 
-      val update: 'a array * int * int * 'a -> unit 
+      val modify: traversal -> ('a -> 'a) -> 'a array -> unit 
    end



1.2       +44 -29    mlton/basis-library/arrays-and-vectors/mono-array.sig

Index: mono-array.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- mono-array.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ mono-array.sig	24 Nov 2002 01:19:35 -0000	1.2
@@ -2,35 +2,50 @@
    sig
       eqtype array
       type elem
-	 
-      structure Vector: MONO_VECTOR
-	 
-      val app: (elem -> unit) -> array -> unit 
-      val appi: ((int * elem) -> unit) -> (array * int * int option) -> unit 
-      val array: (int * elem) -> array 
-      val copy: {src: array,
-		 si: int,
-		 len: int option,
-		 dst: array,
-		 di: int} -> unit 
-      val copyVec: {src: Vector.vector,
-		    si: int,
-		    len: int option,
-		    dst: array,
-		    di: int} -> unit 
-      val extract: (array * int * int option) -> Vector.vector 
-      val foldl: ((elem * 'b) -> 'b) -> 'b -> array -> 'b 
-      val foldli:
-	 ((int * elem * 'b) -> 'b) -> 'b -> (array * int * int option) -> 'b 
-      val foldr: ((elem * 'b) -> 'b) -> 'b -> array -> 'b 
-      val foldri:
-	 ((int * elem * 'b) -> 'b) -> 'b -> (array * int * int option) -> 'b 
-      val fromList: elem list -> array 
-      val length: array -> int 
+      type vector
       val maxLen: int 
+      val array: int * elem -> array 
+      val fromList: elem list -> array
+      val tabulate: int * (int -> elem) -> array
+      val length: array -> int
+      val sub: array * int -> elem
+      val update: array * int * elem -> unit
+      val vector: array -> vector
+      val copy: {src: array, dst: array, di: int} -> unit
+      val copyVec: {src: vector, dst: array, di: int} -> unit
+      val appi: (int * elem -> unit) -> array -> unit
+      val app: (elem -> unit) -> array -> unit
+      val modifyi: (int * elem -> elem) -> array -> unit
       val modify: (elem -> elem) -> array -> unit
-      val modifyi: ((int * elem) -> elem) -> (array * int * int option) -> unit 
-      val sub: (array * int) -> elem 
-      val tabulate: (int * (int -> elem)) -> array 
-      val update: (array * int * elem) -> unit 
+      val foldli: (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+      val foldri: (int * elem * 'b -> 'b) -> 'b -> array -> 'b
+      val foldl: (elem * 'b -> 'b) -> 'b -> array -> 'b
+      val foldr: (elem * 'b -> 'b) -> 'b -> array -> 'b
+      val findi: (int * elem -> bool) -> array -> (int * elem) option
+      val find: (elem -> bool) -> array -> elem option
+      val exists: (elem -> bool) -> array -> bool
+      val all: (elem -> bool) -> array -> bool
+      val collate: (elem * elem -> order) -> array * array -> order
+   end
+
+signature MONO_ARRAY_EXTRA =
+   sig
+      include MONO_ARRAY
+      type vector_slice
+      structure MonoArraySlice: MONO_ARRAY_SLICE_EXTRA 
+	where type elem = elem
+	  and type array = array
+	  and type vector = vector
+	  and type vector_slice = vector_slice
+
+      val unsafeSub: array * int -> elem
+      val unsafeUpdate: array * int * elem -> unit
+
+      val concat: array list -> array
+      val duplicate: array -> array
+      val toList: array -> elem list
+      val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> array
+
+      (* Deprecated *)
+      val extract: array * int * int option -> vector
    end



1.3       +23 -25    mlton/basis-library/arrays-and-vectors/mono-array.sml

Index: mono-array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mono-array.sml	10 Apr 2002 07:02:15 -0000	1.2
+++ mono-array.sml	24 Nov 2002 01:19:35 -0000	1.3
@@ -5,30 +5,28 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-functor MonoArray (V: CONCRETE_MONO_VECTOR): MONO_ARRAY =
-   struct
-      structure Vector = V
-      type elem = V.elem
-      open Array
-      type array = elem array
-   end
+structure Word8Array = MonoArray (type elem = Word8.word
+				  structure V = Word8Vector)
+structure Word8ArraySlice = Word8Array.MonoArraySlice
+structure CharArray = MonoArray(type elem = char
+				structure V = CharVector)
+structure CharArraySlice = CharArray.MonoArraySlice
 
-structure Word8Array = MonoArray (Word8Vector)
-(* Can't use MonoArray to create CharArray because Basis Library spec requires
- * type CharVector.vector = string, not char vector.
- *)
-structure CharArray: MONO_ARRAY =
-   struct
-      structure Vector = CharVector
-      type elem = char
-      open Array
-      type array = elem array
-      val extract = Primitive.String.fromCharVector o extract
-      fun copyVec {src, dst, si, len, di} =
-	 Array.copyVec {src = Primitive.String.toCharVector src,
-			dst = dst, si = si, len = len, di = di}
-   end
-structure BoolArray = MonoArray (BoolVector)
-structure IntArray = MonoArray (IntVector)
-structure RealArray = MonoArray (RealVector)
+structure BoolArray = MonoArray (type elem = bool
+				 structure V = BoolVector)
+structure BoolArraySlice = BoolArray.MonoArraySlice
+structure IntArray = MonoArray (type elem = int
+				structure V = IntVector)
+structure IntArraySlice = IntArray.MonoArraySlice
+structure Int32Array = IntArray
+structure Int32ArraySlice = Int32Array.MonoArraySlice
+structure RealArray = MonoArray (type elem = real
+				 structure V = RealVector)
+structure RealArraySlice = RealArray.MonoArraySlice
 structure Real64Array = RealArray
+structure Real64ArraySlice = Real64Array.MonoArraySlice
+structure WordArray = MonoArray (type elem = word
+				 structure V = WordVector)
+structure WordArraySlice = WordArray.MonoArraySlice
+structure Word32Array = WordArray
+structure Word32ArraySlice = Word32Array.MonoArraySlice



1.2       +10 -15    mlton/basis-library/arrays-and-vectors/mono-array2.sig

Index: mono-array2.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array2.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- mono-array2.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ mono-array2.sig	24 Nov 2002 01:19:35 -0000	1.2
@@ -3,6 +3,7 @@
       eqtype array
 
       type elem
+      type vector
 
       type region = {base: array,
 		     row: int,
@@ -12,8 +13,6 @@
 	 
       datatype traversal = datatype Array2.traversal
 
-      structure Vector: MONO_VECTOR
-
       val array: int * int * elem -> array 
       val fromList: elem list list -> array 
       val tabulate: traversal -> int * int * (int * int -> elem) -> array 
@@ -22,17 +21,13 @@
       val dimensions: array -> int * int 
       val nCols: array -> int 
       val nRows: array -> int 
-      val row: array * int -> Vector.vector 
-      val column: array * int -> Vector.vector 
-(*      val copy:
-	 {src: region, dst: array, dst_row: int, dst_col: int} -> unit  *)
-      val appi :
-	 Array2.traversal -> (int * int * elem -> unit) -> region -> unit 
-      val app: Array2.traversal -> (elem -> unit) -> array -> unit 
-      val modifyi :
-	 Array2.traversal -> (int * int * elem -> elem) -> region -> unit 
-      val modify: Array2.traversal -> (elem -> elem) -> array -> unit 
-      val foldi :
-	 Array2.traversal -> (int * int * elem * 'b -> 'b) -> 'b -> region -> 'b 
-      val fold: Array2.traversal -> (elem * 'b -> 'b) -> 'b -> array -> 'b
+      val row: array * int -> vector 
+      val column: array * int -> vector 
+      val copy: {src: region, dst: array, dst_row: int, dst_col: int} -> unit
+      val appi: traversal -> (int * int * elem -> unit) -> region -> unit 
+      val app: traversal -> (elem -> unit) -> array -> unit 
+      val foldi: traversal -> (int * int * elem * 'b -> 'b) -> 'b -> region -> 'b 
+      val fold: traversal -> (elem * 'b -> 'b) -> 'b -> array -> 'b
+      val modifyi: traversal -> (int * int * elem -> elem) -> region -> unit 
+      val modify: traversal -> (elem -> elem) -> array -> unit 
    end



1.3       +15 -32    mlton/basis-library/arrays-and-vectors/mono-array2.sml

Index: mono-array2.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-array2.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mono-array2.sml	10 Apr 2002 07:02:15 -0000	1.2
+++ mono-array2.sml	24 Nov 2002 01:19:35 -0000	1.3
@@ -5,35 +5,18 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-functor MonoArray2 (V: CONCRETE_MONO_VECTOR): MONO_ARRAY2 =
-   struct
-      structure Vector = V
-      type elem = V.elem
-      open Array2
-      type array = elem array
-      type region = {base: array,
-		     row: int,
-		     col: int,
-		     nrows: int option,
-		     ncols: int option}
-   end
-
-structure Word8Array2 = MonoArray2 (Word8Vector)
-structure CharArray2: MONO_ARRAY2 =
-   struct
-      structure Vector = CharVector
-      type elem = char
-      open Array2
-      type array = elem array
-      type region = {base: array,
-		     row: int,
-		     col: int,
-		     nrows: int option,
-		     ncols: int option}
-      val row = Primitive.String.fromCharVector o row
-      val column = Primitive.String.fromCharVector o column
-   end
-structure BoolArray2 = MonoArray2 (BoolVector)
-structure IntArray2 = MonoArray2 (IntVector)
-structure RealArray2 = MonoArray2 (RealVector)
-
+structure BoolArray2 = MonoArray2 (type elem = bool
+				   structure V = BoolVector)
+structure CharArray2 = MonoArray2 (type elem = char
+				   structure V = CharVector)
+structure IntArray2 = MonoArray2 (type elem = int
+				  structure V = IntVector)
+structure Int32Array2 = IntArray2
+structure RealArray2 = MonoArray2 (type elem = real
+				   structure V = RealVector)
+structure Real64Array2 = RealArray2
+structure WordArray2 = MonoArray2 (type elem = word
+				   structure V = WordVector)
+structure Word8Array2 = MonoArray2 (type elem = Word8.word
+				    structure V = Word8Vector)
+structure Word32Array2 = WordArray2



1.2       +46 -52    mlton/basis-library/arrays-and-vectors/mono-vector.sig

Index: mono-vector.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-vector.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- mono-vector.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ mono-vector.sig	24 Nov 2002 01:19:35 -0000	1.2
@@ -7,66 +7,60 @@
       val tabulate: int * (int -> elem) -> vector 
       val length: vector -> int 
       val sub: vector * int -> elem 
-      val extract: vector * int * int option -> vector 
+      val update: vector * int * elem -> vector
       val concat: vector list -> vector 
-      val mapi: (int * elem -> elem) -> vector * int * int option -> vector 
-      val map: (elem -> elem) -> vector -> vector 
-      val appi: (int * elem -> unit) -> vector * int * int option -> unit 
+      val appi: (int * elem -> unit) -> vector -> unit 
       val app: (elem -> unit) -> vector -> unit 
-      val foldli:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
-      val foldri:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
+      val mapi: (int * elem -> elem) -> vector -> vector 
+      val map: (elem -> elem) -> vector -> vector 
+      val foldli: (int * elem * 'a -> 'a) -> 'a -> vector -> 'a 
+      val foldri: (int * elem * 'a -> 'a) -> 'a -> vector -> 'a 
       val foldl: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
       val foldr: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
+      val findi: (int * elem -> bool) -> vector -> (int * elem) option
+      val exists: (elem -> bool) -> vector -> bool
+      val all: (elem -> bool) -> vector -> bool
+      val collate: (elem * elem -> order) -> vector * vector -> order
    end
 
-(* The only difference between CONCRETE_MONO_VECTOR and MONO_VECTOR is that
- * the former specifies the type of vector.  I couldn't figure out a way to do
- * this in SML using sharing/with, so I had to duplicate the signature.
- *)
-signature CONCRETE_MONO_VECTOR =
+signature MONO_VECTOR_EXTRA_PRE = 
    sig
-      type elem
-      type vector = elem Vector.vector
-      val maxLen: int 
-      val fromList: elem list -> vector 
-      val tabulate: int * (int -> elem) -> vector 
-      val length: vector -> int 
-      val sub: vector * int -> elem 
-      val extract: vector * int * int option -> vector 
-      val concat: vector list -> vector 
-      val mapi: (int * elem -> elem) -> vector * int * int option -> vector 
-      val map: (elem -> elem) -> vector -> vector 
-      val appi: (int * elem -> unit) -> vector * int * int option -> unit 
-      val app: (elem -> unit) -> vector -> unit 
-      val foldli:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
-      val foldri:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
-      val foldl: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
-      val foldr: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
+      include MONO_VECTOR
+
+      val unsafeSub: vector * int -> elem
+
+      (* Used to implement Substring/String functions *)
+      val append: vector * vector -> vector
+      val concatWith: vector -> vector list -> vector
+      val isPrefix: (elem * elem -> bool) -> vector -> vector -> bool
+      val isSubvector: (elem * elem -> bool) -> vector -> vector -> bool
+      val isSuffix: (elem * elem -> bool) -> vector -> vector -> bool
+      val translate: (elem -> vector) -> vector -> vector
+      val tokens: (elem -> bool) -> vector -> vector list
+      val fields: (elem -> bool) -> vector -> vector list
+
+      val duplicate: vector -> vector
+      val fromArray: elem array -> vector
+      val toList: vector -> elem list
+      val unfoldi: int * 'a * (int * 'a -> elem * 'a) -> vector
+      val vector: int * elem -> vector
+
+      (* Deprecated *)
+      val extract: vector * int * int option -> vector
    end
 
-signature EQTYPE_MONO_VECTOR =
+signature MONO_VECTOR_EXTRA =
    sig
-      type elem
-      type vector = elem Vector.vector
-      val maxLen: int 
-      val fromList: elem list -> vector 
-      val tabulate: int * (int -> elem) -> vector 
-      val length: vector -> int 
-      val sub: vector * int -> elem 
-      val extract: vector * int * int option -> vector 
-      val concat: vector list -> vector 
-      val mapi: (int * elem -> elem) -> vector * int * int option -> vector 
-      val map: (elem -> elem) -> vector -> vector 
-      val appi: (int * elem -> unit) -> vector * int * int option -> unit 
-      val app: (elem -> unit) -> vector -> unit 
-      val foldli:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
-      val foldri:
-	 (int * elem * 'a -> 'a) -> 'a -> vector * int * int option -> 'a 
-      val foldl: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
-      val foldr: (elem * 'a -> 'a) -> 'a -> vector -> 'a 
+      include MONO_VECTOR_EXTRA_PRE
+      structure MonoVectorSlice: MONO_VECTOR_SLICE_EXTRA 
+	where type elem = elem
+	  and type vector = vector
+   end
+
+signature EQTYPE_MONO_VECTOR_EXTRA =
+   sig
+      include MONO_VECTOR_EXTRA_PRE
+      structure MonoVectorSlice: EQTYPE_MONO_VECTOR_SLICE_EXTRA 
+	where type elem = elem
+	  and type vector = vector
    end



1.3       +19 -18    mlton/basis-library/arrays-and-vectors/mono-vector.sml

Index: mono-vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/mono-vector.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mono-vector.sml	10 Apr 2002 07:02:15 -0000	1.2
+++ mono-vector.sml	24 Nov 2002 01:19:35 -0000	1.3
@@ -5,24 +5,25 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-functor MonoVector(type elem): MONO_VECTOR =
-   struct
-      open Vector
-      type elem = elem
-      type vector = elem vector
-   end
+structure Word8Vector = EqtypeMonoVector(type elem = Word8.word)
+structure Word8VectorSlice = Word8Vector.MonoVectorSlice
 
-structure Word8Vector = MonoVector(type elem = Word8.word)
+(* Moved to text/string0.sml
+structure CharVector = MonoVector(type elem = char)
+structure CharVectorSlice = CharVector.MonoVectorSlice
+*)
 
-(* Basis Library spec requires type CharVector.vector = string *)
-structure CharVector =
-   struct
-      open String0
-      type vector = string
-      type elem = char
-   end
-
-structure BoolVector = MonoVector(type elem = bool)
-structure IntVector = MonoVector(type elem = int)
+structure BoolVector = EqtypeMonoVector(type elem = bool)
+structure BoolVectorSlice = BoolVector.MonoVectorSlice
+structure IntVector = EqtypeMonoVector(type elem = int)
+structure IntVectorSlice = IntVector.MonoVectorSlice
+structure Int32Vector = IntVector
+structure Int32VectorSlice = Int32Vector.MonoVectorSlice
 structure RealVector = MonoVector(type elem = real)
-
+structure RealVectorSlice = RealVector.MonoVectorSlice
+structure Real64Vector = RealVector
+structure Real64VectorSlice = Real64Vector.MonoVectorSlice
+structure WordVector = EqtypeMonoVector(type elem = word)
+structure WordVectorSlice = WordVector.MonoVectorSlice
+structure Word32Vector = WordVector
+structure Word32VectorSlice = Word32Vector.MonoVectorSlice



1.12      +399 -122  mlton/basis-library/arrays-and-vectors/sequence.fun

Index: sequence.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/sequence.fun,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- sequence.fun	14 Nov 2002 22:27:03 -0000	1.11
+++ sequence.fun	24 Nov 2002 01:19:35 -0000	1.12
@@ -28,16 +28,7 @@
 	 if not isMutable andalso n = 0
 	    then Array.array0Const ()
 	 else Array.array n
-
-      fun sub (s, i) =
-	 if Primitive.safe andalso Primitive.Int.geu (i, length s)
-	    then raise Subscript
-	 else S.sub (s, i)
-
-      fun update (a, i, x) =
-	 if Primitive.safe andalso Primitive.Int.geu (i, Array.length a)
-	    then raise Subscript
-	 else Array.update (a, i, x)
+      val seq0 = fn () => fromArray (array 0)
 
       fun unfoldi (n, b, f) =
 	 let
@@ -50,7 +41,7 @@
 		     val (x, b') = f (i, b)
 		     val _ = Array.update (a, i, x)
 		  in
-		     loop (i + 1, b')
+		     loop (i +? 1, b')
 		  end
 	    val _ = loop (0, b)
 	 in
@@ -61,6 +52,7 @@
        * with reasonable bogus values.
        *)
       fun tabulate (n, f) =
+(*
 	 if !Primitive.usesCallcc
 	    then
 	       (* This code is careful to use a list to accumulate the 
@@ -85,30 +77,406 @@
 		  ; fromArray a
 	       end
 	 else
+*)
 	    unfoldi (n, (), fn (i, ()) => (f i, ()))
 
       fun new (n, x) = tabulate (n, fn _ => x)
 
-      fun fromListOfLength (l, n) =
-	 let 
-	    val a = array n
-	    fun loop (l, i) =
-	       if i < n
-		  then (case l of
-			   [] => raise Fail "fromListOfLength bug"
-			 | x :: l => (Array.update (a, i, x)
-				      ; loop (l, i + 1)))
-	       else ()
-	 in loop (l, 0)
-	    ; fromArray a
+      fun fromList l =
+	 let val a = array (List.length l)
+	 in List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l ;
+	    fromArray a
 	 end
 
-      fun fromList l = fromListOfLength (l, List.length l)
-
-      type 'a slice = 'a sequence * int * int option
-	 
-      fun 'a wholeSlice (a: 'a sequence): 'a slice = (a, 0, NONE)
+      structure Slice =
+	 struct
+	    type 'a sequence = 'a sequence
+	    type 'a elt = 'a elt
+	    type 'a slice = {seq: 'a sequence, start: int, len: int}
+
+	    fun length (sl: 'a slice as {len, ...}) = len
+	    fun sub (sl: 'a slice as {seq, start, len}, i) =
+	       if Primitive.safe andalso Primitive.Int.geu (i, len)
+		  then raise Subscript
+	       else S.sub (seq, start +? i)
+	    fun unsafeSub (sl: 'a slice as {seq, start, ...}, i) =
+	       S.sub (seq, start +? i)
+	    fun update' update (sl: 'a slice as {seq, start, len}, i, x) =
+	       if Primitive.safe andalso Primitive.Int.geu (i, len)
+		  then raise Subscript
+	       else update (seq, start +? i, x)
+	    fun unsafeUpdate' update (sl: 'a slice as {seq, start, ...}, i, x) =
+	       update (seq, start +? i, x)
+	    fun full (seq: 'a sequence) : 'a slice = 
+	       {seq = seq, start = 0, len = S.length seq}
+	    fun subslice (sl: 'a slice as {seq, start, len}, start', len') = 
+	       case len' of
+		  NONE => if Primitive.safe andalso
+		             (start' < 0 orelse start' > len)
+			     then raise Subscript
+			  else {seq = seq,
+				start = start +? start',
+				len = len -? start'}
+		| SOME len' => if Primitive.safe andalso
+			          (start' < 0 orelse start' > len orelse
+				   len' < 0 orelse len' > len -? start')
+				  then raise Subscript
+			       else {seq = seq,
+				     start = start +? start',
+				     len = len'}
+	    fun unsafeSubslice (sl: 'a slice as {seq, start, len}, start', len') = 
+	       {seq = seq, 
+		start = start +? start',
+		len = case len' of
+		        NONE => len -? start'
+		      | SOME len' => len'}
+	    fun slice (seq: 'a sequence, start, len) =
+	       subslice (full seq, start, len)
+	    fun unsafeSlice (seq: 'a sequence, start, len) =
+	       unsafeSubslice (full seq, start, len)
+	    fun base (sl: 'a slice as {seq, start, len}) = (seq, start, len)
+	    fun isEmpty sl = length sl = 0
+	    fun getItem (sl: 'a slice as {seq, start, len}) =
+	       if isEmpty sl
+		  then NONE
+	       else SOME (S.sub (seq, start), 
+			  {seq = seq, 
+			   start = start +? 1, 
+			   len = len -? 1})
+	    fun foldli f b (sl: 'a slice as {seq, start, len}) =
+	       let
+		  val min = start
+		  val max = start +? len
+		  fun loop (i, b) =
+		     if i >= max then b
+		     else loop (i +? 1, f (i -? min, S.sub (seq, i), b))
+	       in loop (min, b)
+	       end
+	    fun foldri f b (sl: 'a slice as {seq, start, len}) =
+	       let
+		  val min = start
+		  val max = start +? len
+		  fun loop (i, b) =
+		     if i < min then b
+		     else loop (i -? 1, f (i -? min, S.sub (seq, i), b))
+	       in loop (max -? 1, b)
+	       end
+	    local
+	       fun make foldi f b sl = foldi (fn (_, x, b) => f (x, b)) b sl
+	    in
+	       fun foldl f = make foldli f
+	       fun foldr f = make foldri f
+	    end
+	    fun appi f sl = foldli (fn (i, x, ()) => f (i, x)) () sl
+	    fun app f sl = appi (f o #2) sl
+	    fun createi tabulate f (sl: 'a slice as {seq, start, len}) =
+	       tabulate (len, fn i => f (i, S.sub (seq, start +? i)))
+	    fun create tabulate f sl = createi tabulate (f o #2) sl
+	    fun mapi f sl = createi tabulate f sl
+	    fun map f sl = mapi (f o #2) sl
+	    fun findi p (sl: 'a slice as {seq, start, len}) = 
+	       let
+		  val min = start
+		  val max = start +? len
+		  fun loop i =
+		     if i >= max
+		        then NONE
+		     else let val z = (i -? min, S.sub (seq, i))
+			  in if p z
+			        then SOME z
+			     else loop (i +? 1)
+			  end
+	       in loop min
+	       end
+	    fun find p sl = Option.map #2 (findi (p o #2) sl)
+	    fun existsi p sl = Option.isSome (findi p sl)
+	    fun exists p sl = existsi (p o #2) sl
+	    fun alli p sl = not (existsi (not o p) sl)
+	    fun all p sl = alli (p o #2) sl
+	    fun collate cmp (sl1 as {seq = seq1, start = start1, len = len1},
+			     sl2 as {seq = seq2, start = start2, len = len2}) =
+	       let
+		  val min1 = start1
+		  val min2 = start2
+		  val max1 = start1 +? len1
+		  val max2 = start2 +? len2
+		  fun loop (i, j) =
+		     case (i >= max1, j >= max2) of
+		        (true, true) => EQUAL
+		      | (true, false) => LESS
+		      | (false, true) => GREATER
+		      | (false, false) => 
+			   (case cmp (S.sub (seq1, i), S.sub (seq2, j)) of
+			      EQUAL => loop (i +? 1, j +? 1)
+			    | ans => ans)
+	       in loop (min1, min2)
+	       end
+	    fun sequence (sl: 'a slice as {seq, start, len}): 'a sequence =
+	       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
+	       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)))
+		  end
+	    fun concat (sls: 'a slice list): 'a sequence =
+	       case sls of
+		  [] => seq0 ()
+		| [sl] => sequence sl
+		| sls' as sl::sls =>
+		     let
+		        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)
+		     end
+	    fun concatWith (sep: 'a sequence) (sls: 'a slice list): 'a sequence =
+	       let val sep = full sep
+	       in case sls of
+		     [] => seq0 ()
+		   | [sl] => sequence sl
+		   | sl::sls =>
+		       List.foldl (fn (sl,seq) => 
+				   concat [full seq, sep, full (sequence sl)])
+		                  (sequence sl) sls
+	       end
+	    fun triml k =
+	       if Primitive.safe andalso k < 0
+		  then raise Subscript
+	       else
+		  (fn (sl as {seq, start, len}) =>
+		   if k > len
+		      then unsafeSlice (seq, start +? len, SOME 0)
+		   else unsafeSlice (seq, start +? k, SOME (len -? k)))
+	    fun trimr k =
+	       if Primitive.safe andalso k < 0
+		  then raise Subscript
+	       else 
+		  (fn (sl as {seq, start, len}) =>
+		   unsafeSlice (seq, start, SOME (if k > len then 0 else len -? k)))
+	    fun isSubsequence (eq: 'a elt * 'a elt -> bool)
+	                      (seq: 'a sequence)
+			      (sl: 'a slice) =
+	       let
+		  val n = S.length seq
+		  val n' = length sl
+	       in
+		  if n <= n'
+		     then let
+			     val n'' = n' -? n
+			     fun loop (i, j) =
+			        if i > n''
+				   then false
+				else if j >= n
+				   then true
+				else if eq (S.sub (seq, j), unsafeSub (sl, i +? j))
+				   then loop (i, j +? 1)
+				else loop (i +? 1, 0)
+			  in
+			     loop (0, 0)
+			  end
+		  else false
+	       end
+	    fun isPrefix (eq: 'a elt * 'a elt -> bool)
+	                 (seq: 'a sequence)
+			 (sl: 'a slice) =
+	       let
+		  val n = S.length seq
+		  val n' = length sl
+	       in
+		  if n <= n'
+		     then let
+			     fun loop (j) =
+			        if j >= n
+				   then true
+				else if eq (S.sub (seq, j), unsafeSub (sl, j))
+				   then loop (j +? 1)
+				else false
+			  in
+			     loop (0)
+			  end
+		  else false
+	       end
+	    fun isSuffix (eq: 'a elt * 'a elt -> bool)
+	                 (seq: 'a sequence)
+			 (sl: 'a slice) =
+	       let
+		  val n = S.length seq
+		  val n' = length sl
+	       in
+		  if n <= n'
+		     then let
+			     val n'' = n' -? n
+			     fun loop (j) =
+			        if j >= n
+				   then true
+				else if eq (S.sub (seq, j), unsafeSub (sl, n'' +? j))
+				   then loop (j +? 1)
+				else false
+			  in
+			     loop (0)
+			  end
+		  else false
+	       end
+	    fun split (sl: 'a slice as {seq, start, len}, i) =
+	       (unsafeSlice (seq, start, SOME (i -? start)),
+		unsafeSlice (seq, i, SOME (len -? (i -? start))))
+	    fun splitl f (sl: 'a slice as {seq, start, len}) =
+	       let
+		  val stop = start +? len
+		  fun loop i =
+		     if i >= stop
+		        then i
+		     else if f (S.sub (seq, i))
+		             then loop (i +? 1)
+			  else i
+	       in split (sl, loop start)
+	       end
+	    fun splitr f (sl: 'a slice as {seq, start, len}) =
+	       let
+		  fun loop i =
+		     if i < start
+		        then start
+		     else if f (S.sub (seq, i))
+		             then loop (i -? 1)
+			  else i +? 1
+	       in split (sl, loop (start +? len -? 1))
+	       end
+	    fun splitAt (sl: 'a slice as {seq, start, len}, i) =
+	       if Primitive.safe andalso Primitive.Int.gtu (i, len)
+		  then raise Subscript
+	       else (unsafeSlice (seq, start, SOME i),
+		     unsafeSlice (seq, start +? i, SOME (len -? i)))
+	    fun dropl p s = #2 (splitl p s)
+	    fun dropr p s = #1 (splitr p s)
+	    fun takel p s = #1 (splitl p s)
+	    fun taker p s = #2 (splitr p s)
+	    fun position (eq: 'a elt * 'a elt -> bool)
+	                 (seq': 'a sequence)
+			 (sl: 'a slice as {seq, start, len}) =
+	       let
+		  val len' = S.length seq'
+		  val max = start +? len -? len' +? 1
+		  (* loop returns the index of the front of the suffix. *)
+		  fun loop i =
+		     if i >= max
+		        then start +? len
+		     else let
+			     fun loop' j =
+			        if j >= len'
+				   then i
+				else if eq (S.sub (seq, i +? j), 
+					    S.sub (seq', j))
+				        then loop' (j +? 1)
+				     else loop (i +? 1)
+			  in loop' 0
+			  end
+	       in split (sl, loop start)
+	       end
+	    fun span (eq: 'a sequence * 'a sequence -> bool)
+	             (sl: 'a slice as {seq, start, len},
+		      sl': 'a slice as {seq = seq', start = start', len = len'}) =
+	       if Primitive.safe andalso 
+		  (not (eq (seq, seq')) orelse start' +? len' < start)
+		  then raise Span
+	       else unsafeSlice (seq, start, SOME ((start' +? len') -? start))
+	    fun translate f (sl: 'a slice) =
+	       concat (List.rev (foldl (fn (c, l) => (full (f c)) :: l) [] sl))
+	    local
+	       fun make finish p (sl: 'a slice as {seq, start, len}) =
+		  let
+		     val max = start +? len
+		     fun loop (i, start, sls) =
+		        if i >= max
+			   then List.rev (finish (seq, start, i, sls))
+			else
+			   if p (S.sub (seq, i))
+			      then loop (i +? 1, i +? 1, finish (seq, start, i, sls))
+			   else loop (i +? 1, start, sls)
+		  in loop (start, start, []) 
+		  end
+	    in
+	       fun tokens p sl =
+		  make (fn (seq, start, stop, sls) =>
+			if start = stop
+			   then sls
+			else
+			   (unsafeSlice (seq, start, SOME (stop -? start)))
+			   :: sls)
+		       p sl
+	       fun fields p sl = 
+		  make (fn (seq, start, stop, sls) =>
+			(unsafeSlice (seq, start, SOME (stop -? start)))
+			:: sls)
+		       p sl
+	    end
+	    fun toList (sl: 'a slice) = foldr (fn (a,l) => a::l) [] sl
+	 end
 
+      local
+	fun make f seq = f (Slice.full seq)
+	fun make2 f (seq1, seq2) = f (Slice.full seq1, Slice.full seq2)
+      in
+	fun sub (seq, i) = Slice.sub (Slice.full seq, i)
+	fun unsafeSub (seq, i) = Slice.unsafeSub (Slice.full seq, i)
+	fun update' update (seq, i, x) = 
+	   Slice.update' update (Slice.full seq, i, x)
+	fun unsafeUpdate' update (seq, i, x) = 
+	   Slice.unsafeUpdate' update (Slice.full seq, i, x)
+	fun append seqs = make2 Slice.append seqs
+	fun concat seqs = Slice.concat (List.map Slice.full seqs)
+	fun appi f = make (Slice.appi f)
+	fun app f = make (Slice.app f)
+	fun mapi f = make (Slice.mapi f)
+	fun map f = make (Slice.map f)
+	fun foldli f b = make (Slice.foldli f b)
+	fun foldri f b = make (Slice.foldri f b)
+	fun foldl f b = make (Slice.foldl f b)
+	fun foldr f b = make (Slice.foldr f b)
+	fun findi p = make (Slice.findi p)
+	fun find p = make (Slice.find p)
+	fun existsi p = make (Slice.existsi p)
+	fun exists p = make (Slice.exists p)
+	fun alli p = make (Slice.alli p)
+	fun all p = make (Slice.all p)
+	fun collate cmp = make2 (Slice.collate cmp)
+	fun concatWith sep seqs = Slice.concatWith sep (List.map Slice.full seqs)
+	fun isPrefix eq seq = make (Slice.isPrefix eq seq)
+	fun isSubsequence eq seq = make (Slice.isSubsequence eq seq)
+	fun isSuffix eq seq = make (Slice.isSuffix eq seq)
+	fun translate f = make (Slice.translate f)
+	fun tokens f seq = List.map Slice.sequence (make (Slice.tokens f) seq)
+	fun fields f seq = List.map Slice.sequence (make (Slice.fields f) seq)
+	fun createi tabulate f seq = make (Slice.createi tabulate f) seq
+	fun create tabulate f seq = make (Slice.create tabulate f) seq
+	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)
@@ -119,99 +487,8 @@
 		  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)
-
-      fun foldli f b (slice as (s, min, _)) =
-	 let
-	    val max = checkSlice slice
-	    fun loop (i, b) =
-	       if i >= max then b
-	       else loop (i + 1, f (i, S.sub (s, i), b))
-	 in loop (min, b)
-	 end
-
-      fun appi f slice = foldli (fn (i, x, ()) => f (i, x)) () slice
-
-      fun app f s = appi (f o #2) (wholeSlice s)
-
-      fun foldri f b (slice as (s, min, _)) =
-	 let
-	    val max = checkSlice slice
-	    fun loop (i, b) =
-	       if i < min
-		  then b
-	       else loop (i -? 1, f (i, S.sub (s, i), b))
-	 in loop (max -? 1, b)
-	 end
-
-      local
-	 fun make foldi f b s = foldi (fn (_, x, b) => f (x, b)) b (wholeSlice s)
-      in
-	 fun foldl f = make foldli f
-	 fun foldr f = make foldri f
-      end
-
-      fun mapi f (slice as (s, min, _)) =
-	 let val max = checkSlice slice
-	 in tabulate (max -? min, fn i => let val j = i +? min
-					  in f (j, S.sub (s, j))
-					  end)
-	 end
-
-      fun map f s = mapi (f o #2) (wholeSlice s)
-
-      val extract =
-	 fn (s, 0, NONE) => s
-	  | slice => mapi #2 slice
-
-      fun copy s = map (fn x => x) s
-
-      fun 'a concat (vs: 'a sequence list): 'a sequence =
-	 case vs of
-	    [] => fromArray (array 0)
-	  | [v] => if isMutable then copy v else v
-	  | v :: vs' => 
-	       let
-		  val n = List.foldl (fn (v, s) => s + length v) 0 vs
-	       in
-		  unfoldi (n, (0, v, vs'),
-			   fn (_, ac) =>
-			   let
-			      fun loop (i, v, vs) =
-				 if i < length v
-				    then (sub (v, i), (i + 1, v, vs))
-				 else
-				    case vs of
-				       [] => raise Fail "concat bug"
-				     | v :: vs => loop (0, v, vs)
-			   in loop ac
-			   end)
-	       end
- 
-      fun prefixToList (s, n) =
-	 let
-	    fun loop (i, l) =
-	       if i < 0
-		  then l
-	       else loop (i - 1, S.sub (s, i) :: l)
-	 in loop (n - 1, [])
-	 end
-
-      fun toList a = prefixToList (a, length a)
-	 
-      fun find (s, p) =
-	 let
-	    val max = length s
-	    fun loop i =
-	       if i >= max
-		  then NONE
-	       else let
-		       val x = S.sub (s, i)
-		    in if p x
-			  then SOME x
-		       else loop (i + 1)
-		    end
-	 in loop 0
-	 end
+      (* Deprecated *)
+      fun extract args = Slice.sequence (Slice.slice args)
    end



1.5       +56 -25    mlton/basis-library/arrays-and-vectors/sequence.sig

Index: sequence.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/sequence.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- sequence.sig	10 Apr 2002 07:02:15 -0000	1.4
+++ sequence.sig	24 Nov 2002 01:19:35 -0000	1.5
@@ -5,40 +5,71 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
+
 signature SEQUENCE =
    sig
       type 'a sequence
       type 'a elt
 
-      val app: ('a elt -> unit) -> 'a sequence -> unit 
-      val appi: (int * 'a elt -> unit) -> 'a sequence * int * int option -> unit 
-      (* checkSlice returns max where the slice is from min (inclusive)
-       * to max (exclusive).  Raises Subscript if invalid slice.
+      structure Slice : SLICE where type 'a sequence = 'a sequence
+	                        and type 'a elt = 'a elt
+
+      val maxLen: int
+      val fromList: 'a elt list -> 'a sequence
+      val tabulate: int * (int -> 'a elt) -> 'a sequence
+      val length: 'a sequence -> int
+      val sub: 'a sequence * int -> 'a elt
+      val unsafeSub: 'a sequence * int -> 'a elt
+      (* ('a sequence * int * 'a elt -> unit  should be an unsafe update. 
        *)
-      val checkSlice: 'a sequence * int * int option -> int
-      val checkSliceMax: int * int option * int -> int
-      val concat: 'a sequence list -> 'a sequence
-      val extract: 'a sequence * int * int option -> 'a sequence
-      val find: 'a sequence * ('a elt -> bool) -> 'a elt option
+      val update': ('a sequence * int * 'a elt -> unit) ->
+                   ('a sequence * int * 'a elt) -> unit
+      val unsafeUpdate': ('a sequence * int * 'a elt -> unit) ->
+	                 ('a sequence * int * 'a elt) -> unit
+      val concat: 'a sequence list -> 'a sequence 
+      val appi: (int * 'a elt -> unit) -> 'a sequence -> unit 
+      val app: ('a elt -> unit) -> 'a sequence -> unit 
+      val mapi : (int * 'a elt -> 'b elt) -> 'a sequence -> 'b sequence 
+      val map: ('a elt -> 'b elt) -> 'a sequence -> 'b sequence 
+      val foldli: (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b 
+      val foldri: (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b 
       val foldl: ('a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b 
-      val foldli:
-	 (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence * int * int option -> 'b 
       val foldr: ('a elt * 'b -> 'b) -> 'b -> 'a sequence -> 'b
-      val foldri:
-	 (int * 'a elt * 'b -> 'b) -> 'b -> 'a sequence * int * int option -> 'b 
-      val fromList: 'a elt list -> 'a sequence 
-      val length: 'a sequence -> int 
-      val map: ('a elt -> 'b elt) -> 'a sequence -> 'b sequence
-      val mapi:
-	 (int * 'a elt -> 'b elt)
-	 -> 'a sequence * int * int option -> 'b sequence 
-      val maxLen: int 
+      val findi: (int * 'a elt -> bool) -> 'a sequence -> (int * 'a elt) option
+      val find: ('a elt -> bool) -> 'a sequence -> 'a elt option
+      val existsi: (int * 'a elt -> bool) -> 'a sequence -> bool
+      val exists: ('a elt -> bool) -> 'a sequence -> bool
+      val alli: (int * 'a elt -> bool) -> 'a sequence -> bool
+      val all: ('a elt -> bool) -> 'a sequence -> bool
+      val collate: ('a elt * 'a elt -> order) -> 'a sequence * 'a sequence -> order
+
+      (* Used to implement Substring/String functions *)
+      val concatWith: 'a sequence -> 'a sequence list -> 'a sequence
+      val isPrefix: ('a elt * 'a elt -> bool) -> 'a sequence -> 'a sequence -> bool
+      val isSubsequence: ('a elt * 'a elt -> bool) -> 'a sequence -> 'a sequence -> bool
+      val isSuffix: ('a elt * 'a elt -> bool) -> 'a sequence -> 'a sequence -> bool
+      val translate: ('a elt -> 'a sequence) -> 'a sequence -> 'a sequence
+      val tokens: ('a elt -> bool) -> 'a sequence -> 'a sequence list
+      val fields: ('a elt -> bool) -> 'a sequence -> 'a sequence list
+
+      (* Extra *)
+      val append: 'a sequence * 'a sequence -> 'a sequence
+      (* createi,create:
+       * (int * (int -> 'b elt) -> 'c  should be a tabulate function.
+       *)
+      val createi: (int * (int -> 'b elt) -> 'c) ->
+                   (int * 'a elt -> 'b elt) -> 'a sequence -> 'c
+      val create: (int * (int -> 'b elt) -> 'c) ->
+                  ('a elt -> 'b elt) -> 'a sequence -> 'c
+      val duplicate: 'a sequence -> 'a sequence
       val new: int * 'a elt -> 'a sequence
-      val prefixToList: 'a sequence * int -> 'a elt list
-      val sub: 'a sequence * int -> 'a elt 
-      val tabulate: int * (int -> 'a elt) -> 'a sequence 
       val toList: 'a sequence -> 'a elt list
       val unfoldi: int * 'a * (int * 'a -> 'b elt * 'a) -> 'b sequence
-      val update: 'a elt array * int * 'a elt -> unit
-      val wholeSlice: 'a sequence -> 'a sequence * int * int option
+
+      (* Deprecated *)
+      val checkSlice: 'a sequence * int * int option -> int
+      (* Deprecated *)
+      val checkSliceMax: int * int option * int -> int
+      (* Deprecated *)
+      val extract: 'a sequence * int * int option -> 'a sequence
    end



1.4       +33 -10    mlton/basis-library/arrays-and-vectors/vector.sig

Index: vector.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/vector.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- vector.sig	1 Aug 2001 20:04:01 -0000	1.3
+++ vector.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -12,26 +12,49 @@
       val tabulate: int * (int -> 'a) -> 'a vector 
       val length: 'a vector -> int 
       val sub: 'a vector * int -> 'a 
-      val extract: 'a vector * int * int option -> 'a vector 
+      val update: 'a vector * int * 'a -> 'a vector
       val concat: 'a vector list -> 'a vector 
-      val mapi : (int * 'a -> 'b) -> 'a vector * int * int option -> 'b vector 
-      val map: ('a -> 'b) -> 'a vector -> 'b vector 
-      val appi: (int * 'a -> unit) -> 'a vector * int * int option -> unit 
+      val appi: (int * 'a -> unit) -> 'a vector -> unit 
       val app: ('a -> unit) -> 'a vector -> unit 
-      val foldli :
-	 (int * 'a * 'b -> 'b) -> 'b -> 'a vector * int * int option -> 'b 
-      val foldri :
-	 (int * 'a * 'b -> 'b) -> 'b -> 'a vector * int * int option -> 'b 
+      val mapi : (int * 'a -> 'b) -> 'a vector -> 'b vector 
+      val map: ('a -> 'b) -> 'a vector -> 'b vector 
+      val foldli: (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b 
+      val foldri: (int * 'a * 'b -> 'b) -> 'b -> 'a vector -> 'b 
       val foldl: ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b 
       val foldr: ('a * 'b -> 'b) -> 'b -> 'a vector -> 'b
+      val findi: (int * 'a -> bool) -> 'a vector -> (int * 'a) option
+      val find: ('a -> bool) -> 'a vector -> 'a option
+      val exists: ('a -> bool) -> 'a vector -> bool
+      val all: ('a -> bool) -> 'a vector -> bool
+      val collate: ('a * 'a -> order) -> 'a vector * 'a vector -> order
    end
 
 signature VECTOR_EXTRA =
    sig
       include VECTOR
+      structure VectorSlice: VECTOR_SLICE_EXTRA 
+	where type 'a vector = 'a vector
 
-      val checkSlice: 'a vector * int * int option -> int
+      val unsafeSub: 'a vector * int -> 'a
+
+      (* Used to implement Substring/String functions *)
+      val concatWith: 'a vector -> 'a vector list -> '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 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 unsafeSub: 'a vector * int -> 'a
+      val vector: int * 'a -> 'a vector
+
+      (* Deprecated *)
+      val checkSlice: 'a vector * int * int option -> int
+      (* Deprecated *)
+      val extract: 'a vector * int * int option -> 'a vector
    end



1.4       +25 -2     mlton/basis-library/arrays-and-vectors/vector.sml

Index: vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/vector.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- vector.sml	10 Apr 2002 07:02:15 -0000	1.3
+++ vector.sml	24 Nov 2002 01:19:35 -0000	1.4
@@ -11,14 +11,37 @@
 			      type 'a elt = 'a
 			      val fromArray = Primitive.Vector.fromArray
 			      val isMutable = false
-			      open Primitive.Vector)
+			      val length = Primitive.Vector.length
+			      val sub = Primitive.Vector.sub)
       open V
 
       type 'a vector = 'a vector
 
-      val fromArray = Primitive.Vector.fromArray
+      structure VectorSlice = 
+	 struct
+	    open Slice
+	    type 'a vector = 'a vector
+	    val vector = sequence
+
+	    val isSubvector = isSubsequence
+	    val span = fn (sl, sl') => 
+	       span (op = : ''a vector * ''a vector -> bool) (sl, sl')
+	 end
+
+      fun update (v, i, x) = 
+	tabulate (length v,
+		  fn j => if i = j 
+			     then x
+			  else unsafeSub (v, j))
+
       val unsafeSub = Primitive.Vector.sub
+
+      val isSubvector = isSubsequence
+
+      val fromArray = Primitive.Vector.fromArray
+      val vector = new
    end
+structure VectorSlice: VECTOR_SLICE_EXTRA = Vector.VectorSlice
 
 structure VectorGlobal: VECTOR_GLOBAL = Vector
 open VectorGlobal



1.2       +54 -0     mlton/basis-library/arrays-and-vectors/array-slice.sig




1.2       +48 -0     mlton/basis-library/arrays-and-vectors/mono-array-slice.sig




1.2       +27 -0     mlton/basis-library/arrays-and-vectors/mono-array.fun




1.2       +22 -0     mlton/basis-library/arrays-and-vectors/mono-array2.fun




1.2       +66 -0     mlton/basis-library/arrays-and-vectors/mono-vector-slice.sig




1.2       +36 -0     mlton/basis-library/arrays-and-vectors/mono-vector.fun




1.2       +83 -0     mlton/basis-library/arrays-and-vectors/slice.sig




1.2       +67 -0     mlton/basis-library/arrays-and-vectors/vector-slice.sig




1.4       +2 -2      mlton/basis-library/general/bool.sig

Index: bool.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/bool.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- bool.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ bool.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -1,6 +1,6 @@
 signature BOOL_GLOBAL =
    sig
-      datatype bool = false | true
+      datatype bool = datatype bool
 
       val not: bool -> bool
    end
@@ -9,7 +9,7 @@
    sig
       include BOOL_GLOBAL
 
-      val toString: bool -> string
       val fromString: string -> bool option 
       val scan: (char, 'a) StringCvt.reader -> (bool, 'a) StringCvt.reader
+      val toString: bool -> string
    end



1.5       +4 -4      mlton/basis-library/general/bool.sml

Index: bool.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/bool.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- bool.sml	20 Jul 2002 23:14:01 -0000	1.4
+++ bool.sml	24 Nov 2002 01:19:35 -0000	1.5
@@ -11,10 +11,6 @@
 
       val not = not
 
-      val toString =
-	 fn true => "true"
-	  | false => "false"
-
       fun scan reader state =
 	 case reader state of
 	    NONE => NONE
@@ -31,6 +27,10 @@
 		| _ => NONE
 	       
       val fromString = StringCvt.scanString scan
+
+      val toString =
+	 fn true => "true"
+	  | false => "false"
    end
 
 structure BoolGlobal: BOOL_GLOBAL = Bool



1.4       +3 -1      mlton/basis-library/general/general.sig

Index: general.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/general.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- general.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ general.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -4,18 +4,20 @@
 
      type exn
      exception Bind
+     exception Match
      exception Chr
      exception Div
      exception Domain
      exception Fail of string 
-     exception Match
      exception Overflow
      exception Size
      exception Span
      exception Subscript
      val exnName: exn -> string 
      val exnMessage: exn -> string
+
      datatype order = LESS | EQUAL | GREATER
+
      val ! : 'a ref -> 'a 
      val := : ('a ref * 'a) -> unit 
      val o : (('b -> 'c) * ('a -> 'b)) -> 'a -> 'c 



1.6       +6 -7      mlton/basis-library/general/general.sml

Index: general.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/general.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- general.sml	20 Jul 2002 23:14:01 -0000	1.5
+++ general.sml	24 Nov 2002 01:19:35 -0000	1.6
@@ -8,29 +8,28 @@
 structure General: GENERAL =
    struct
       type unit = unit
+
       type exn = exn
-	 
       exception Bind = Bind
+      exception Match = Match
       exception Chr
       exception Div
       exception Domain
       exception Fail = Fail
-      exception Match = Match
       exception Overflow = Overflow
       exception Size = Size
       exception Span
       exception Subscript
-
-      datatype order = LESS | EQUAL | GREATER
-
       val exnName = Primitive.Exn.name
       val exnMessage = exnName
  
+      datatype order = LESS | EQUAL | GREATER
+
+      val ! = Primitive.Ref.deref
+      val op := = Primitive.Ref.assign
       fun (f o g) x = f (g x)
       fun x before () = x
       fun ignore _ = ()
-      val op := = Primitive.Ref.assign
-      val ! = Primitive.Ref.deref
    end
 
 structure GeneralGlobal: GENERAL_GLOBAL = General



1.4       +1 -0      mlton/basis-library/general/option.sig

Index: option.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/option.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- option.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ option.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -13,6 +13,7 @@
       
       val filter: ('a -> bool) -> 'a -> 'a option 
       val join: 'a option option -> 'a option 
+      val app: ('a -> unit) -> 'a option -> unit
       val map: ('a -> 'b) -> 'a option -> 'b option 
       val mapPartial: ('a -> 'b option) -> 'a option -> 'b option 
       val compose: ('a -> 'b) * ('c -> 'a option) -> 'c -> 'b option 



1.4       +6 -1      mlton/basis-library/general/option.sml

Index: option.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/option.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- option.sml	20 Jul 2002 23:14:01 -0000	1.3
+++ option.sml	24 Nov 2002 01:19:35 -0000	1.4
@@ -1,4 +1,5 @@
 (* Modified from SML/NJ sources by sweeks@research.nj.nec.com on 4/18/98. *)
+(* Modified by fluet@cs.cornell.edu on 7/19/02. *)
 
 (* option.sml
  *
@@ -29,8 +30,12 @@
 	fn SOME opt => opt
 	 | NONE => NONE
 
+     fun app f =
+        fn SOME x => f x
+	 | NONE => ()
+
      fun map f =
-	fn SOME x => SOME(f x)
+	fn SOME x => SOME (f x)
 	 | NONE => NONE
 
      fun mapPartial f =



1.7       +9 -42     mlton/basis-library/integer/int-inf.sig

Index: int-inf.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int-inf.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- int-inf.sig	20 Jul 2002 23:14:01 -0000	1.6
+++ int-inf.sig	24 Nov 2002 01:19:35 -0000	1.7
@@ -1,50 +1,17 @@
 signature INT_INF =
    sig
-      eqtype int
+      include INTEGER
 
-      val * : int * int -> int
-      val + : int * int -> int
-      val - : int * int -> int
-      val < : int * int -> bool
-      val <= : int * int -> bool
-      val > : int * int -> bool
-      val >= : int * int -> bool
-      val abs: int -> int
-      val compare: int * int -> order
-      val div: int * int -> int
       val divMod: int * int -> int * int
-      val fmt: StringCvt.radix -> int -> string
-      val fromInt: Int.int -> int
-      val fromLarge: LargeInt.int -> int
-      val fromString: string -> int option
-      val log2: int -> Int.int
-      val max: int * int -> int
-      val maxInt: int option
-      val min: int * int -> int
-      val minInt: int option
-      val mod: int * int -> int
-      val pow: int * Int.int -> int
-      val precision: Int.int option
-      val quot: int * int -> int
       val quotRem: int * int -> int * int
-      val rem: int * int -> int
-      val sameSign: int * int -> bool
-      val scan:
-	 StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (int, 'a) StringCvt.reader
-      val sign: int -> Int.int
-      val toInt: int -> Int.int
-      val toLarge: int -> LargeInt.int
-      val toString: int -> string
-      val ~ : int -> int
-(*      val orb: int * int -> int
- *      val xorb: int * int -> int
- *      val andb: int * int -> int
- *      val notb: int -> int
- *      val << : int * Word.word -> int
- *      val ~>> : int * Word.word -> int
- *)
+      val pow: int * Int.int -> int
+      val log2: int -> Int.int
+      val orb: int * int -> int
+      val xorb: int * int -> int
+      val andb: int * int -> int
+      val notb: int -> int
+      val << : int * Word.word -> int
+      val ~>> : int * Word.word -> int
    end
 
 signature INT_INF_EXTRA =



1.10      +69 -7     mlton/basis-library/integer/int-inf.sml

Index: int-inf.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int-inf.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- int-inf.sml	14 Nov 2002 22:27:04 -0000	1.9
+++ int-inf.sml	24 Nov 2002 01:19:35 -0000	1.10
@@ -43,15 +43,9 @@
       val one = bigIntConstant 1
       val negOne = bigIntConstant ~1
 	 
-      (*
-       * Return the number of `limbs' in a bignum bigInt.
-       *)
-      fun bigSize (arg: bigInt): smallInt =
-	 Vector.length (Prim.toVector arg) -? 1
-
       (* Check if an IntInf.int is small (i.e., a fixnum). *)
       fun isSmall (i: bigInt): bool =
-	 0w0 <> Word.andb (0w1, Prim.toWord i)
+	 0w0 <> Word.andb (Prim.toWord i, 0w1)
 
       (* Check if two IntInf.int's are both small (i.e., fixnums).
        * This is a gross hack, but uses only one test.
@@ -65,6 +59,8 @@
        * where x is size arg.  If arg is small, then it is in
        * [ - 2^30, 2^30 ).
        *)
+      fun bigSize (arg: bigInt): smallInt =
+	 Vector.length (Prim.toVector arg) -? 1
       fun size (arg: bigInt): smallInt =
 	 if isSmall arg
 	    then 1
@@ -845,6 +841,66 @@
 			    Word.log2 (Vector.sub (v, Int.- (Vector.length v, 1))))
 		| Small w => Word.log2 w
       end
+
+      (* 
+       * bigInt bit operations.
+       *)
+      local fun make (wordOp, bigIntOp): bigInt * bigInt -> bigInt =
+	 let fun expensive (lhs: bigInt, rhs: bigInt): bigInt =
+	    let val tsize = Int.max (size lhs, size rhs)
+	    in bigIntOp (lhs, rhs, reserve tsize)
+	    end
+	 in fn (lhs: bigInt, rhs: bigInt) =>
+	    if areSmall (lhs, rhs)
+	       then let val ansv = wordOp (stripTag lhs, stripTag rhs)
+			val ans = addTag ansv
+		    in Prim.fromWord ans
+		    end
+	    else expensive (lhs, rhs)
+	 end
+      in
+	val bigAndb = make (Word.andb, Prim.andb)
+	val bigOrb = make (Word.orb, Prim.orb)
+	val bigXorb = make (Word.xorb, Prim.xorb)
+      end
+
+      local fun expensive (arg: bigInt): bigInt =
+	 let val tsize = size arg
+	 in Prim.notb (arg, reserve tsize)
+	 end
+      in fun bigNotb (arg: bigInt): bigInt =
+	 if isSmall arg
+	    then let val ansv = Word.notb (stripTag arg)
+	             val ans = addTag ansv
+		 in Prim.fromWord ans
+		 end
+	 else expensive arg
+      end
+
+      local
+	 val bitsPerLimb : Word.word = 0w32
+	 fun shiftSize shift = Word.toIntX (Word.div (shift, bitsPerLimb))
+      in
+      local fun expensive (arg: bigInt, shift: word): bigInt =
+	 let val tsize = Int.max (1, (size arg) -? (shiftSize shift))
+	 in Prim.~>> (arg, shift, reserve tsize)
+	 end
+      in fun bigArshift (arg: bigInt, shift: word): bigInt =
+	 if shift = 0wx0
+	    then arg
+	 else expensive (arg, shift)
+      end
+
+      local fun expensive (arg: bigInt, shift: word): bigInt =
+	 let val tsize = (size arg) +? (shiftSize shift) +? 1
+	 in Prim.<< (arg, shift, reserve tsize)
+	 end
+      in fun bigLshift (arg: bigInt, shift: word): bigInt =
+	 if shift = 0wx0
+	    then arg
+	 else expensive (arg, shift)
+      end
+      end
    
       type int = bigInt
       val abs = bigAbs
@@ -883,6 +939,12 @@
       val toLarge = fn x => x
       val toString = bigToString
       val ~ = bigNegate
+      val andb = bigAndb
+      val notb = bigNotb
+      val orb = bigOrb
+      val xorb = bigXorb
+      val ~>> = bigArshift
+      val << = bigLshift
    end
 
 structure LargeInt = IntInf



1.3       +1 -0      mlton/basis-library/integer/int32.sml

Index: int32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/int32.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- int32.sml	10 Apr 2002 07:02:17 -0000	1.2
+++ int32.sml	24 Nov 2002 01:19:35 -0000	1.3
@@ -176,3 +176,4 @@
 structure IntGlobal: INTEGER_GLOBAL = Int
 open IntGlobal
 structure Position = Int
+structure FixedInt = Int
\ No newline at end of file



1.4       +28 -23    mlton/basis-library/integer/integer.sig

Index: integer.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/integer.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- integer.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ integer.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -17,37 +17,37 @@
    sig
       include INTEGER_GLOBAL
 
-      val * : int * int -> int 
+      val toLarge: int -> LargeInt.int 
+      val fromLarge: LargeInt.int -> int 
+      val toInt: int -> Int.int 
+      val fromInt: Int.int -> int 
+      val precision: Int.int option 
+      val minInt: int option 
+      val maxInt: int option 
       val + : int * int -> int 
       val - : int * int -> int 
-      val < : int * int -> bool 
-      val <= : int * int -> bool 
-      val > : int * int -> bool 
-      val >= : int * int -> bool 
-      val abs: int -> int 
-      val compare: int * int -> order 
+      val * : int * int -> int 
       val div: int * int -> int 
-      val fmt: StringCvt.radix -> int -> string 
-      val fromInt: Int.int -> int 
-      val fromLarge: LargeInt.int -> int 
-      val fromString: string -> int option 
-      val max: int * int -> int 
-      val maxInt: int option 
-      val min: int * int -> int 
-      val minInt: int option 
       val mod: int * int -> int 
-      val precision: Int.int option 
       val quot: int * int -> int 
       val rem: int * int -> int
-      val sameSign: int * int -> bool 
-      val scan: StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (int, 'a) StringCvt.reader
+      val compare: int * int -> order 
+      val > : int * int -> bool 
+      val >= : int * int -> bool 
+      val < : int * int -> bool 
+      val <= : int * int -> bool 
+      val ~ : int -> int 
+      val abs: int -> int 
+      val min: int * int -> int 
+      val max: int * int -> int 
       val sign: int -> Int.int 
-      val toInt: int -> Int.int 
-      val toLarge: int -> LargeInt.int 
+      val sameSign: int * int -> bool 
+      val fmt: StringCvt.radix -> int -> string 
       val toString: int -> string 
-      val ~ : int -> int 
+      val scan: StringCvt.radix
+	        -> (char, 'a) StringCvt.reader
+	        -> (int, 'a) StringCvt.reader
+      val fromString: string -> int option 
    end
 
 signature INTEGER_EXTRA =
@@ -59,4 +59,9 @@
       val maxInt': int
       val minInt': int
       val power: {base: int, exp: int} -> int
+   end
+
+signature INTEGER32_EXTRA =
+   sig
+      include INTEGER_EXTRA
    end



1.5       +1 -1      mlton/basis-library/integer/pack32.sml

Index: pack32.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/pack32.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- pack32.sml	20 Jul 2002 23:14:01 -0000	1.4
+++ pack32.sml	24 Nov 2002 01:19:35 -0000	1.5
@@ -76,7 +76,7 @@
  *)
 
 (* Depends on being on a little-endian machine. *)
-structure Pack32Little: PACK_WORD =
+structure Pack32Little: PACK_WORD_EXTRA =
    struct
       val start = Pack32Big.start
       val _ = if Primitive.isLittleEndian



1.4       +32 -30    mlton/basis-library/integer/word.sig

Index: word.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/integer/word.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ word.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -1,10 +1,12 @@
-structure Word32 =
+structure Word =
    struct
       type word = word
    end
 
-structure Word = Word32
-structure LargeWord = Word32
+structure LargeWord = 
+   struct
+      type word = word
+   end
 
 signature WORD_GLOBAL =
    sig
@@ -15,48 +17,48 @@
    sig
       include WORD_GLOBAL
 
-      val * : word * word -> word 
+      val wordSize: int 
+      val toLargeWord: word -> LargeWord.word 
+      val toLargeWordX: word -> LargeWord.word 
+      val fromLargeWord: LargeWord.word -> word 
+      val toInt: word -> Int.int 
+      val toIntX: word -> Int.int 
+      val fromInt: Int.int -> word 
+      val orb: word * word -> word 
+      val xorb: word * word -> word 
+      val andb: word * word -> word 
+      val notb: word -> word 
+      val << : word * Word.word -> word 
+      val >> : word * Word.word -> word 
+      val ~>> : word * Word.word -> word 
       val + : word * word -> word 
       val - : word * word -> word 
+      val * : word * word -> word 
+      val div: word * word -> word 
+      val mod: word * word -> word
+      val ~ : word -> word
+      val compare: word * word -> order 
       val < : word * word -> bool 
-      val << : word * Word.word -> word 
-      val <= : word * word -> bool 
       val > : word * word -> bool 
       val >= : word * word -> bool 
-      val >> : word * Word.word -> word 
-      val andb: word * word -> word 
-      val compare: word * word -> order 
-      val div: word * word -> word 
-      val fromInt: Int.int -> word 
-      val fromLargeWord: LargeWord.word -> word 
-      val max: word * word -> word
+      val <= : word * word -> bool 
       val min: word * word -> word 
-      val mod: word * word -> word
-      val notb: word -> word 
-      val orb: word * word -> word 
-      val toInt: word -> Int.int 
-      val toIntX: word -> Int.int 
-      val toLargeWord: word -> LargeWord.word 
-      val toLargeWordX: word -> LargeWord.word 
-      val wordSize: int 
-      val xorb: word * word -> word 
-      val ~>> : word * Word.word -> word 
+      val max: word * word -> word
    end
 
 signature WORD =
    sig
       include PRE_WORD
 	 
-      val fmt: StringCvt.radix -> word -> string 
-      val fromLargeInt: LargeInt.int -> word
-      val fromString: string -> word option 
-      val scan:
-	 StringCvt.radix
-	 -> (char, 'a) StringCvt.reader
-	 -> (word, 'a) StringCvt.reader
       val toLargeInt: word -> LargeInt.int 
       val toLargeIntX: word -> LargeInt.int 
+      val fromLargeInt: LargeInt.int -> word
+      val fmt: StringCvt.radix -> word -> string 
       val toString: word -> string 
+      val scan: StringCvt.radix
+	        -> (char, 'a) StringCvt.reader
+	        -> (word, 'a) StringCvt.reader
+      val fromString: string -> word option 
    end
 
 signature WORD_EXTRA =



1.4       +51 -11    mlton/basis-library/io/bin-io.sig

Index: bin-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-io.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- bin-io.sig	17 Jun 2002 06:28:56 -0000	1.3
+++ bin-io.sig	24 Nov 2002 01:19:35 -0000	1.4
@@ -1,3 +1,40 @@
+(*
+signature BIN_IO =
+   sig
+      structure StreamIO: BIN_STREAM_IO
+
+      (* IMPERATIVE_IO *)
+      type vector = StreamIO.vector
+      type elem = StreamIO.elem
+      type instream
+      type outstream
+      val input: instream -> vector
+      val input1: instream -> elem option
+      val inputN: instream * int -> vector
+      val inputAll: instream -> vector
+      val canInput: instream * int -> int option
+      val lookahead: instream -> elem option
+      val closeIn: instream -> unit
+      val endOfStream: instream -> bool
+      val output: outstream * vector -> unit
+      val output1: outstream * elem -> unit
+      val flushOut: outstream -> unit
+      val closeOut: outstream -> unit
+      val mkInstream: StreamIO.instream -> instream
+      val getInstream: instream -> StreamIO.instream
+      val setInstream: instream * StreamIO.instream -> unit
+      val mkOutstream: StreamIO.outstream -> outstream
+      val getOutstream: outstream -> StreamIO.outstream
+      val setOutstream: outstream * StreamIO.outstream -> unit
+      val getPosOut: outstream -> StreamIO.out_pos
+      val setPosOut: outstream * StreamIO.out_pos -> unit
+
+      val openIn: string -> instream
+      val openOut: string -> outstream
+      val openAppend: string -> outstream
+   end
+*)
+
 signature BIN_IO =
    sig
       structure StreamIO: BIN_STREAM_IO
@@ -17,15 +54,17 @@
       val lookahead: instream -> elem option
       val mkInstream: StreamIO.instream -> instream
       val openIn: string -> instream 
-      (*
+(*
       val scanStream:
  	 ((Char.char, StreamIO.instream) StringCvt.reader
 	  -> ('a, StreamIO.instream) StringCvt.reader)
-	 -> instream -> 'a option *)
+	 -> instream -> 'a option 
+*)
       val setInstream: (instream * StreamIO.instream) -> unit
-(*       val getPosIn: instream -> StreamIO.in_pos 
- *       val setPosIn: (instream * StreamIO.in_pos) -> unit 
- *)
+(* 
+      val getPosIn: instream -> StreamIO.in_pos 
+      val setPosIn: (instream * StreamIO.in_pos) -> unit 
+*)
 
       type outstream
       val closeOut: outstream -> unit 
@@ -38,22 +77,23 @@
       val output1: outstream * elem -> unit 
       val output: outstream * vector -> unit 
       val setOutstream: outstream * StreamIO.outstream -> unit 
-(*       val setPosOut: outstream * StreamIO.out_pos -> unit  *)
+(*       
+      val setPosOut: outstream * StreamIO.out_pos -> unit  
+*)
    end
 
 signature BIN_IO_EXTRA =
    sig
       include BIN_IO
 
-(*      val equalsIn: instream * instream -> bool *)
-(*      val equalsOut: outstream * outstream -> bool *)
-      val inFd: instream -> Posix.IO.file_desc
+      val equalsIn: instream * instream -> bool
+      val equalsOut: outstream * outstream -> bool
       val newIn: Posix.IO.file_desc -> instream
       val newOut: Posix.IO.file_desc -> outstream
+      val inFd: instream -> Posix.IO.file_desc
       val outFd: outstream -> Posix.IO.file_desc
-(*      val setIn: instream * instream -> unit *)
+
       val stdIn: instream
       val stdErr: outstream
       val stdOut: outstream
    end
-   



1.5       +35 -1     mlton/basis-library/io/bin-io.sml

Index: bin-io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-io.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- bin-io.sml	17 Jun 2002 06:28:56 -0000	1.4
+++ bin-io.sml	24 Nov 2002 01:19:36 -0000	1.5
@@ -1,3 +1,38 @@
+(*
+structure BinIO: BIN_IO_EXTRA =
+   struct
+      structure S = struct
+		      structure PrimIO = BinPrimIO
+		      structure Array = Word8Array
+		      structure Vector = Word8Vector
+		      val someElem = (0wx0: Word8.word)
+		      val lineElem = (0wx0: Word8.word)
+		      fun isLine _ = false
+		      fun hasLine _ = false
+		      structure Cleaner = Cleaner
+		    end
+      structure StreamIO = StreamIOExtraFile(open S)
+      structure SIO = StreamIO
+      structure S = struct 
+		      open S 
+		      structure StreamIO = StreamIO
+		    end
+      structure BufferI = BufferIExtraFile(open S)
+      structure BI = BufferI
+      structure S = struct
+		      open S
+		      structure BufferI = BufferI
+		      val chunkSize = Primitive.TextIO.bufSize
+		      val fileTypeFlags = [PosixPrimitive.FileSys.O.binary]
+		      val mkReader = Posix.IO.mkBinReader
+		      val mkWriter = Posix.IO.mkBinWriter
+		    end
+      structure ImperativeIO = ImperativeIOExtraFile(open S)
+      structure FastImperativeIO = FastImperativeIOExtraFile(open S)
+      open FastImperativeIO
+   end
+*)
+
 structure BinIO: BIN_IO_EXTRA =
    BinOrTextIO
    (val fileTypeFlags = [PosixPrimitive.FileSys.O.binary]
@@ -23,4 +58,3 @@
        end
     structure Primitive = Primitive
     structure String = String)
-



1.3       +10 -8     mlton/basis-library/io/bin-or-text-io.fun

Index: bin-or-text-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-or-text-io.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- bin-or-text-io.fun	17 Jun 2002 06:28:56 -0000	1.2
+++ bin-or-text-io.fun	24 Nov 2002 01:19:36 -0000	1.3
@@ -117,6 +117,8 @@
 	   bufStyle: bufStyle}
 type outstream = outstream' ref
 
+fun equalsOut (os1, os2) = os1 = os2
+
 fun outFd (ref (Out {fd, ...})) = fd
 
 val mkOutstream = ref
@@ -240,8 +242,7 @@
 	       if newSize >= Array.length array orelse maybe ()
 		  then (flush (fd, b); put ())
 	       else
-		  (Array.copyVec {src = v, si = 0, len = NONE,
-				  dst = array, di = curSize}
+		  (Array.copyVec {src = v, dst = array, di = curSize}
 		   ; size := newSize)
 	    end
       in
@@ -435,8 +436,9 @@
 		  let
 		     val dst = Primitive.Array.array bytesToRead
 		     val _ =
-			(Array.copy {src = buf, si = !first,
-				     len = SOME size, dst = dst, di = 0}
+			(ArraySlice.copy 
+			 {src = ArraySlice.slice (buf, !first, SOME size),
+			  dst = dst, di = 0}
 			 ; first := !last)
 		     fun loop (bytesRead: int): int =
 			if bytesRead = bytesToRead
@@ -651,7 +653,7 @@
 		 else NONE
 	 end
       
-      fun inputAll' (s: t): vector * t =
+      fun inputAll (s: t): vector * t =
 	 let
 	    fun loop (s, ac) =
 	       let val (v, s) = input s
@@ -661,8 +663,6 @@
 	       end
 	 in loop (s, [])
 	 end
-
-      val inputAll = #1 o inputAll'
    end
 
 datatype t' =
@@ -671,6 +671,8 @@
 datatype t = T of t' ref
 type instream = t
 
+fun equalsIn (T is1, T is2) = is1 = is2
+
 fun inFd (T r) =
    case !r of
       Buf b => Buf.fd b
@@ -729,7 +731,7 @@
 fun inputAll (T r) =
    case !r of
       Buf b => Buf.inputAll b
-    | Stream s => let val (res, s) = StreamIO.inputAll' s
+    | Stream s => let val (res, s) = StreamIO.inputAll s
 		  in r := Stream s; res
 		  end
 



1.2       +44 -2     mlton/basis-library/io/bin-stream-io.sig

Index: bin-stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-stream-io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- bin-stream-io.sig	29 Mar 2002 00:08:31 -0000	1.1
+++ bin-stream-io.sig	24 Nov 2002 01:19:36 -0000	1.2
@@ -1,6 +1,48 @@
+(*
 signature BIN_STREAM_IO =
    sig
       include STREAM_IO
-	 where type vector = Word8Vector.vector 
-	 where type elem = Word8Vector.elem
+              where type vector = Word8Vector.vector 
+              where type elem = Word8Vector.elem
+   end
+*)
+
+signature BIN_STREAM_IO =
+   sig
+      (* STREAM_IO *)
+      type elem = Word8Vector.elem
+      type vector = Word8Vector.vector 
+(*       
+      type reader
+      type writer
+*)
+      
+      type instream
+      type outstream
+ 
+      type out_pos
+      type pos = int
+
+      val canInput: instream * int -> int option
+      val closeIn: instream -> unit
+      val endOfStream: instream -> bool 
+      val filePosOut: out_pos -> pos
+      val input1: instream -> (elem * instream) option 
+      val input: instream -> vector * instream 
+      val inputAll: instream -> vector * instream
+      val inputN: instream * int -> vector * instream 
+(*      
+      val mkInstream: reader * vector -> instream  (* need to update this *)
+      val getReader: instream -> reader * vector 
+      val output: outstream * vector -> unit 
+      val output1: outstream * elem -> unit 
+      val flushOut: outstream -> unit 
+      val closeOut: outstream -> unit 
+      val setBufferMode: outstream * IO.buffer_mode -> unit 
+      val getBufferMode: outstream -> IO.buffer_mode 
+      val mkOutstream: writer * IO.buffer_mode -> outstream 
+      val getWriter: outstream -> writer * IO.buffer_mode 
+      val getPosOut: outstream -> out_pos 
+      val setPosOut: out_pos -> outstream 
+*)
    end



1.2       +3 -4      mlton/basis-library/io/io.sig

Index: io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ io.sig	24 Nov 2002 01:19:36 -0000	1.2
@@ -1,12 +1,11 @@
 signature IO =
    sig
-      exception Io of {cause: exn,
-		       function: string,
-		       name: string}
+      exception Io of {name : string,
+		       function : string,
+		       cause : exn}
       exception BlockingNotSupported
       exception NonblockingNotSupported
       exception RandomAccessNotSupported
-      exception TerminatedStream
       exception ClosedStream
       datatype buffer_mode = NO_BUF | LINE_BUF | BLOCK_BUF
    end



1.3       +59 -25    mlton/basis-library/io/stream-io.sig

Index: stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- stream-io.sig	3 Feb 2002 18:57:17 -0000	1.2
+++ stream-io.sig	24 Nov 2002 01:19:36 -0000	1.3
@@ -2,35 +2,69 @@
    sig
       type elem
       type vector
-(*       type reader
- *       type writer
- *)
-      
       type instream
       type outstream
- 
       type out_pos
-      type pos = int
-
+      type reader
+      type writer
+      type pos
+      val input: instream -> vector * instream
+      val input1: instream -> (elem * instream) option
+      val inputN: instream * int -> vector * instream
+      val inputAll: instream -> vector * instream
       val canInput: instream * int -> int option
       val closeIn: instream -> unit
-      val endOfStream: instream -> bool 
+      val endOfStream: instream -> bool
+      val output: outstream * vector -> unit
+      val output1: outstream * elem -> unit
+      val flushOut: outstream -> unit
+      val closeOut: outstream -> unit
+      val mkInstream: reader * vector -> instream
+      val getReader: instream -> reader * vector
+      val filePosIn: instream -> pos
+      val setBufferMode: outstream * IO.buffer_mode -> unit
+      val getBufferMode: outstream -> IO.buffer_mode
+      val mkOutstream: writer * IO.buffer_mode -> outstream
+      val getWriter: outstream -> writer * IO.buffer_mode
+      val getPosOut: outstream -> out_pos
+      val setPosOut: out_pos -> outstream
       val filePosOut: out_pos -> pos
-      val input1: instream -> (elem * instream) option 
-      val input: instream -> vector * instream 
-      val inputAll: instream -> vector 
-      val inputN: instream * int -> vector * instream 
-(*       val mkInstream: reader * vector -> instream  (* need to update this *)
- *       val getReader: instream -> reader * vector 
- *       val output: outstream * vector -> unit 
- *       val output1: outstream * elem -> unit 
- *       val flushOut: outstream -> unit 
- *       val closeOut: outstream -> unit 
- *       val setBufferMode: outstream * IO.buffer_mode -> unit 
- *       val getBufferMode: outstream -> IO.buffer_mode 
- *       val mkOutstream: writer * IO.buffer_mode -> outstream 
- *       val getWriter: outstream -> writer * IO.buffer_mode 
- *       val getPosOut: outstream -> out_pos 
- *       val setPosOut: out_pos -> outstream 
- *)
    end
+
+signature STREAM_IO_EXTRA =
+   sig
+      include STREAM_IO
+
+      val equalsIn: instream * instream -> bool
+      val instreamReader: instream -> reader
+      val mkInstream': {reader: reader,
+			closed: bool,
+			buffer_contents: vector option} -> instream
+
+      val equalsOut: outstream * outstream -> bool
+      val outstreamWriter: outstream -> writer
+      val mkOutstream': {writer: writer,
+			 closed: bool,
+			 buffer_mode: IO.buffer_mode} -> outstream
+
+      val openVector: vector -> instream
+      val inputLine: instream -> (vector * instream)
+      val outputSlice: outstream * (vector * int * int option) -> unit
+   end
+
+signature STREAM_IO_EXTRA_FILE =
+   sig
+      include STREAM_IO_EXTRA
+
+      val mkInstream'': {reader: reader,
+			 closed: bool,
+			 buffer_contents: vector option,
+			 atExit: {close: bool}} -> instream
+      val mkOutstream'': {writer: writer,
+			  closed: bool,
+			  buffer_mode: IO.buffer_mode,
+			  atExit: {close: bool}} -> outstream
+
+      val inFd: instream -> Posix.IO.file_desc
+      val outFd: outstream -> Posix.IO.file_desc
+  end



1.3       +61 -9     mlton/basis-library/io/text-io.sig

Index: text-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-io.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- text-io.sig	3 Feb 2002 18:57:17 -0000	1.2
+++ text-io.sig	24 Nov 2002 01:19:36 -0000	1.3
@@ -3,6 +3,57 @@
       val print: string -> unit
    end
 
+(*
+signature TEXT_IO =
+   sig
+      include TEXT_IO_GLOBAL
+
+      structure StreamIO : TEXT_STREAM_IO
+			   where type reader = TextPrimIO.reader
+			   where type writer = TextPrimIO.writer
+			   where type pos = TextPrimIO.pos
+
+      (* IMPERATIVE_IO *)
+      type vector = StreamIO.vector
+      type elem = StreamIO.elem
+      type instream
+      type outstream
+      val input: instream -> vector
+      val input1: instream -> elem option
+      val inputN: instream * int -> vector
+      val inputAll: instream -> vector
+      val canInput: instream * int -> int option
+      val lookahead: instream -> elem option
+      val closeIn: instream -> unit
+      val endOfStream: instream -> bool
+      val output: outstream * vector -> unit
+      val output1: outstream * elem -> unit
+      val flushOut: outstream -> unit
+      val closeOut: outstream -> unit
+      val mkInstream: StreamIO.instream -> instream
+      val getInstream: instream -> StreamIO.instream
+      val setInstream: instream * StreamIO.instream -> unit
+      val mkOutstream: StreamIO.outstream -> outstream
+      val getOutstream: outstream -> StreamIO.outstream
+      val setOutstream: outstream * StreamIO.outstream -> unit
+      val getPosOut: outstream -> StreamIO.out_pos
+      val setPosOut: outstream * StreamIO.out_pos -> unit
+
+      val inputLine: instream -> string
+      val outputSubstr: outstream * substring -> unit
+      val openIn: string -> instream
+      val openOut: string -> outstream
+      val openAppend: string -> outstream
+      val openString: string -> instream
+      val stdIn: instream
+      val stdOut: outstream
+      val stdErr: outstream
+      val scanStream: ((Char.char, StreamIO.instream) StringCvt.reader -> 
+		       ('a, StreamIO.instream) StringCvt.reader) -> 
+	              instream -> 'a option
+   end
+*)
+
 signature TEXT_IO =
    sig
       include TEXT_IO_GLOBAL
@@ -31,10 +82,11 @@
 	 -> instream -> 'a option
       val setInstream: (instream * StreamIO.instream) -> unit
       val stdIn: instream
-(*       val openString: string -> instream
- *       val getPosIn: instream -> StreamIO.in_pos 
- *       val setPosIn: (instream * StreamIO.in_pos) -> unit 
- *)
+(*
+      val openString: string -> instream
+      val getPosIn: instream -> StreamIO.in_pos 
+      val setPosIn: (instream * StreamIO.in_pos) -> unit 
+*)
 
       type outstream
       val closeOut: outstream -> unit 
@@ -50,19 +102,19 @@
       val setOutstream: outstream * StreamIO.outstream -> unit
       val stdErr: outstream 
       val stdOut: outstream 
-(*       val setPosOut: outstream * StreamIO.out_pos -> unit  *)
+(*
+      val setPosOut: outstream * StreamIO.out_pos -> unit
+*)
    end
 
 signature TEXT_IO_EXTRA =
    sig
       include TEXT_IO
 
-(*      val equalsIn: instream * instream -> bool *)
-(*      val equalsOut: outstream * outstream -> bool *)
+      val equalsIn: instream * instream -> bool
+      val equalsOut: outstream * outstream -> bool
       val inFd: instream -> Posix.IO.file_desc
       val newIn: Posix.IO.file_desc -> instream
       val newOut: Posix.IO.file_desc -> outstream
       val outFd: outstream -> Posix.IO.file_desc
-(*      val setIn: instream * instream -> unit *)
    end
-   



1.10      +54 -7     mlton/basis-library/io/text-io.sml

Index: text-io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-io.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- text-io.sml	17 Jun 2002 06:28:56 -0000	1.9
+++ text-io.sml	24 Nov 2002 01:19:36 -0000	1.10
@@ -1,10 +1,57 @@
-(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
- *    Jagannathan, and Stephen Weeks.
- * Copyright (C) 1997-1999 NEC Research Institute.
- *
- * MLton is released under the GNU General Public License (GPL).
- * Please see the file MLton-LICENSE for license information.
- *)
+(*
+structure TextIO: TEXT_IO_EXTRA =
+   struct
+      structure S = struct
+		      structure PrimIO = TextPrimIO
+		      structure Array = CharArray
+		      structure Vector = CharVector
+		      val someElem = (#"\000": Char.char)
+		      val lineElem = (#"\n": Char.char)
+		      fun isLine c = c = lineElem
+		      val hasLine = CharVector.exists isLine
+		      structure Cleaner = Cleaner
+		    end
+      structure StreamIO = StreamIOExtraFile(open S)
+      structure SIO = StreamIO
+      structure S = struct 
+		      open S 
+		      structure StreamIO = StreamIO
+		    end
+      structure BufferI = BufferIExtraFile(open S)
+      structure BI = BufferI
+      structure S = struct
+		      open S
+		      structure BufferI = BufferI
+		      val chunkSize = Primitive.TextIO.bufSize
+		      val fileTypeFlags = [PosixPrimitive.FileSys.O.text]
+		      val mkReader = Posix.IO.mkTextReader
+		      val mkWriter = Posix.IO.mkTextWriter
+		    end
+      structure ImperativeIO = ImperativeIOExtraFile(open S)
+      structure FastImperativeIO = FastImperativeIOExtraFile(open S)
+      open FastImperativeIO
+
+      structure StreamIO =
+	 struct
+	    open SIO
+	    val outputSubstr = fn (os, ss) => 
+	      let
+		val (s, i, sz) = Substring.base ss
+	      in
+		outputSlice (os, (s, i, SOME sz))
+	      end
+	 end
+
+      val outputSubstr = fn (os, ss) => 
+	let
+	  val (s, i, sz) = Substring.base ss
+	in
+	  outputSlice (os, (s, i, SOME sz))
+	end
+      val openString = openVector
+      fun print (s: string) = (output (stdOut, s); flushOut stdOut)
+   end
+*)
 
 structure TextIO : TEXT_IO_EXTRA =
    struct



1.2       +50 -4     mlton/basis-library/io/text-stream-io.sig

Index: text-stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-stream-io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- text-stream-io.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ text-stream-io.sig	24 Nov 2002 01:19:36 -0000	1.2
@@ -1,10 +1,56 @@
+(*
 signature TEXT_STREAM_IO =
    sig
       include STREAM_IO
-	 where type vector = CharVector.vector 
-	 where type elem = Char.char
+              where type vector = CharVector.vector 
+	      where type elem = Char.char
 
       val inputLine: instream -> string * instream
-(*       val outputSubstr: outstream * substring -> unit
- *)
+      val outputSubstr: outstream * substring -> unit
+   end
+*)
+
+signature TEXT_STREAM_IO =
+   sig
+      (* STREAM_IO *)
+      type elem = Char.char
+      type vector = CharVector.vector 
+(*       
+      type reader
+      type writer
+*)
+      
+      type instream
+      type outstream
+ 
+      type out_pos
+      type pos (* = int *)
+
+      val canInput: instream * int -> int option
+      val closeIn: instream -> unit
+      val endOfStream: instream -> bool 
+      val filePosOut: out_pos -> pos
+      val input1: instream -> (elem * instream) option 
+      val input: instream -> vector * instream 
+      val inputAll: instream -> vector * instream
+      val inputN: instream * int -> vector * instream 
+(*      
+      val mkInstream: reader * vector -> instream  (* need to update this *)
+      val getReader: instream -> reader * vector 
+      val output: outstream * vector -> unit 
+      val output1: outstream * elem -> unit 
+      val flushOut: outstream -> unit 
+      val closeOut: outstream -> unit 
+      val setBufferMode: outstream * IO.buffer_mode -> unit 
+      val getBufferMode: outstream -> IO.buffer_mode 
+      val mkOutstream: writer * IO.buffer_mode -> outstream 
+      val getWriter: outstream -> writer * IO.buffer_mode 
+      val getPosOut: outstream -> out_pos 
+      val setPosOut: out_pos -> outstream 
+*)
+
+      val inputLine: instream -> string * instream
+(*       
+      val outputSubstr: outstream * substring -> unit
+*)
    end



1.2       +11 -0     mlton/basis-library/io/bin-prim-io.sml




1.2       +580 -0    mlton/basis-library/io/buffer-i.fun




1.2       +55 -0     mlton/basis-library/io/buffer-i.sig




1.2       +282 -0    mlton/basis-library/io/fast-imperative-io.fun




1.2       +41 -0     mlton/basis-library/io/fast-imperative-io.sig




1.2       +250 -0    mlton/basis-library/io/imperative-io.fun




1.2       +61 -0     mlton/basis-library/io/imperative-io.sig




1.2       +353 -0    mlton/basis-library/io/prim-io.fun




1.2       +59 -0     mlton/basis-library/io/prim-io.sig




1.2       +762 -0    mlton/basis-library/io/stream-io.fun




1.2       +10 -0     mlton/basis-library/io/text-prim-io.sml




1.2       +272 -0    mlton/basis-library/libs/build




1.2       +5 -0      mlton/basis-library/libs/basis-1997/bind




1.2       +0 -0      mlton/basis-library/libs/basis-1997/prefix

	<<Binary file>>


1.2       +1 -0      mlton/basis-library/libs/basis-1997/suffix




1.2       +26 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/array.sig




1.2       +26 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/mono-array.sig




1.2       +27 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/mono-array2.sig




1.2       +60 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector-array-array2-convert.fun




1.2       +20 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/mono-vector.sig




1.2       +45 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/vector-array-convert.fun




1.2       +19 -0     mlton/basis-library/libs/basis-1997/arrays-and-vectors/vector.sig




1.2       +12 -0     mlton/basis-library/libs/basis-1997/io/bin-io-convert.fun




1.2       +46 -0     mlton/basis-library/libs/basis-1997/io/bin-io.sig




1.2       +6 -0      mlton/basis-library/libs/basis-1997/io/bin-stream-io.sig




1.2       +7 -0      mlton/basis-library/libs/basis-1997/io/io-convert.fun




1.2       +12 -0     mlton/basis-library/libs/basis-1997/io/io.sig




1.2       +38 -0     mlton/basis-library/libs/basis-1997/io/stream-io.sig




1.2       +12 -0     mlton/basis-library/libs/basis-1997/io/text-io-convert.fun




1.2       +51 -0     mlton/basis-library/libs/basis-1997/io/text-io.sig




1.2       +11 -0     mlton/basis-library/libs/basis-1997/io/text-stream-io.sig




1.2       +22 -0     mlton/basis-library/libs/basis-1997/posix/file-sys-convert.fun




1.2       +124 -0    mlton/basis-library/libs/basis-1997/posix/file-sys.sig




1.2       +7 -0      mlton/basis-library/libs/basis-1997/posix/flags-convert.fun




1.2       +10 -0     mlton/basis-library/libs/basis-1997/posix/flags.sig




1.2       +19 -0     mlton/basis-library/libs/basis-1997/posix/io-convert.fun




1.2       +75 -0     mlton/basis-library/libs/basis-1997/posix/io.sig




1.2       +10 -0     mlton/basis-library/libs/basis-1997/posix/posix-convert.fun




1.2       +11 -0     mlton/basis-library/libs/basis-1997/posix/posix.sig




1.2       +12 -0     mlton/basis-library/libs/basis-1997/posix/process-convert.fun




1.2       +45 -0     mlton/basis-library/libs/basis-1997/posix/process.sig




1.2       +31 -0     mlton/basis-library/libs/basis-1997/posix/tty-convert.fun




1.2       +165 -0    mlton/basis-library/libs/basis-1997/posix/tty.sig




1.2       +48 -0     mlton/basis-library/libs/basis-1997/real/IEEE-real-convert.fun




1.2       +23 -0     mlton/basis-library/libs/basis-1997/real/IEEE-real.sig




1.2       +10 -0     mlton/basis-library/libs/basis-1997/real/real-convert.fun




1.2       +68 -0     mlton/basis-library/libs/basis-1997/real/real.sig




1.2       +10 -0     mlton/basis-library/libs/basis-1997/system/file-sys-convert.fun




1.2       +37 -0     mlton/basis-library/libs/basis-1997/system/file-sys.sig




1.2       +8 -0      mlton/basis-library/libs/basis-1997/system/os-convert.fun




1.2       +15 -0     mlton/basis-library/libs/basis-1997/system/os.sig




1.2       +6 -0      mlton/basis-library/libs/basis-1997/system/process-convert.fun




1.2       +16 -0     mlton/basis-library/libs/basis-1997/system/process.sig




1.2       +14 -0     mlton/basis-library/libs/basis-1997/system/timer-convert.fun




1.2       +11 -0     mlton/basis-library/libs/basis-1997/system/timer.sig




1.2       +7 -0      mlton/basis-library/libs/basis-1997/system/unix-convert.fun




1.2       +11 -0     mlton/basis-library/libs/basis-1997/system/unix.sig




1.2       +30 -0     mlton/basis-library/libs/basis-1997/text/string.sig




1.2       +39 -0     mlton/basis-library/libs/basis-1997/text/substring.sig




1.2       +28 -0     mlton/basis-library/libs/basis-1997/text/text-convert.fun




1.2       +8 -0      mlton/basis-library/libs/basis-1997/top-level/basis-funs.sml




1.2       +62 -0     mlton/basis-library/libs/basis-1997/top-level/basis-sigs.sml




1.2       +195 -0    mlton/basis-library/libs/basis-1997/top-level/basis.sig




1.2       +95 -0     mlton/basis-library/libs/basis-1997/top-level/basis.sml




1.2       +13 -0     mlton/basis-library/libs/basis-1997/top-level/infixes.sml




1.2       +103 -0    mlton/basis-library/libs/basis-1997/top-level/overloads.sml




1.2       +13 -0     mlton/basis-library/libs/basis-1997/top-level/top-level.sml




1.2       +5 -0      mlton/basis-library/libs/basis-2002/bind




1.2       +0 -0      mlton/basis-library/libs/basis-2002/prefix

	<<Binary file>>


1.2       +1 -0      mlton/basis-library/libs/basis-2002/suffix




1.2       +6 -0      mlton/basis-library/libs/basis-2002/top-level/basis-funs.sml




1.2       +76 -0     mlton/basis-library/libs/basis-2002/top-level/basis-sigs.sml




1.2       +413 -0    mlton/basis-library/libs/basis-2002/top-level/basis.sig




1.2       +149 -0    mlton/basis-library/libs/basis-2002/top-level/basis.sml




1.2       +13 -0     mlton/basis-library/libs/basis-2002/top-level/infixes.sml




1.2       +104 -0    mlton/basis-library/libs/basis-2002/top-level/overloads.sml




1.2       +23 -0     mlton/basis-library/libs/basis-2002/top-level/top-level.sml




1.2       +5 -0      mlton/basis-library/libs/basis-2002-strict/bind




1.2       +0 -0      mlton/basis-library/libs/basis-2002-strict/prefix

	<<Binary file>>


1.2       +1 -0      mlton/basis-library/libs/basis-2002-strict/suffix




1.2       +10 -0     mlton/basis-library/libs/basis-2002-strict/top-level/top-level.sml




1.2       +1 -0      mlton/basis-library/libs/none/bind




1.2       +0 -0      mlton/basis-library/libs/none/prefix

	<<Binary file>>


1.2       +0 -0      mlton/basis-library/libs/none/suffix

	<<Binary file>>


1.1                  mlton/basis-library/libs/none/top-level/infixes.sml

Index: infixes.sml
===================================================================
(* Copyright (C) 1999-2002 Henry Cejtin, Matthew Fluet, Suresh
 *    Jagannathan, and Stephen Weeks.
 * Copyright (C) 1997-1999 NEC Research Institute.
 *
 * MLton is released under the GNU General Public License (GPL).
 * Please see the file MLton-LICENSE for license information.
 *)
infix  4 = 



1.4       +12 -5     mlton/basis-library/list/list-pair.sig

Index: list-pair.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/list/list-pair.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- list-pair.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ list-pair.sig	24 Nov 2002 01:19:39 -0000	1.4
@@ -1,11 +1,18 @@
 signature LIST_PAIR =
    sig
-      val all: ('a * 'b -> bool) -> 'a list * 'b list -> bool 
+      exception UnequalLengths
+      val zip: 'a list * 'b list -> ('a * 'b) list 
+      val zipEq: 'a list * 'b list -> ('a * 'b) list 
+      val unzip: ('a * 'b) list -> 'a list * 'b list
       val app: ('a * 'b -> unit) -> 'a list * 'b list -> unit 
-      val exists: ('a * 'b -> bool) -> 'a list * 'b list -> bool 
+      val appEq: ('a * 'b -> unit) -> 'a list * 'b list -> unit 
+      val map: ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list 
+      val mapEq: ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list 
       val foldl: ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c 
       val foldr: ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c 
-      val map: ('a * 'b -> 'c) -> 'a list * 'b list -> 'c list 
-      val unzip: ('a * 'b) list -> 'a list * 'b list
-      val zip: 'a list * 'b list -> ('a * 'b) list 
+      val foldlEq: ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c 
+      val foldrEq: ('a * 'b * 'c -> 'c) -> 'c -> 'a list * 'b list -> 'c 
+      val all: ('a * 'b -> bool) -> 'a list * 'b list -> bool 
+      val exists: ('a * 'b -> bool) -> 'a list * 'b list -> bool 
+      val allEq: ('a * 'b -> bool) -> 'a list * 'b list -> bool 
    end



1.5       +32 -8     mlton/basis-library/list/list-pair.sml

Index: list-pair.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/list/list-pair.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- list-pair.sml	20 Jul 2002 23:14:01 -0000	1.4
+++ list-pair.sml	24 Nov 2002 01:19:39 -0000	1.5
@@ -7,32 +7,46 @@
  *)
 structure ListPair: LIST_PAIR =
    struct
+      exception UnequalLengths
+      fun id x = x
+      fun ul _ = raise UnequalLengths
+
       fun unzip l =
 	 List.foldr (fn ((x, y), (xs, ys)) => (x :: xs, y :: ys)) ([], []) l
 
-      fun foldl f b (l1, l2) =
+      fun foldl' w f b (l1, l2) =
 	 let
 	    fun loop(l1, l2, b) =
 	       case (l1, l2) of
 		  (x1 :: l1, x2 :: l2) => loop(l1, l2, f(x1, x2, b))
-		| _ => b
+		| _ => w b
 	 in loop(l1, l2, b)
 	 end
+      fun foldl f = foldl' id f
+      fun foldlEq f = foldl' ul f
 
-      fun foldr f b (l1, l2) =
+      fun foldr' w f b (l1, l2) =
 	 let
 	    fun loop(l1, l2) =
 	       case (l1, l2) of
 		  (x1 :: l1, x2 :: l2) => f(x1, x2, loop(l1, l2))
-		| _ => b
+		| _ => w b
 	 in loop(l1, l2)
 	 end
+      fun foldr f = foldr' id f
+      fun foldrEq f = foldr' ul f
 
-      fun zip(l1, l2) = rev(foldl (fn (x, x', l) => (x, x') :: l) [] (l1, l2))
+      fun zip' w (l1, l2) = rev(foldl' w (fn (x, x', l) => (x, x') :: l) [] (l1, l2))
+      fun zip(l1, l2) = zip' id (l1, l2)
+      fun zipEq(l1, l2) = zip' ul (l1, l2)
 	 
-      fun map f = rev o (foldl (fn (x1, x2, l) => f(x1, x2) :: l) [])
+      fun map' w f = rev o (foldl' w (fn (x1, x2, l) => f(x1, x2) :: l) [])
+      fun map f = map' id f
+      fun mapEq f = map' ul f
 	 
-      fun app f = foldl (fn (x1, x2, ()) => f(x1, x2)) ()
+      fun app' w f = foldl' w (fn (x1, x2, ()) => f(x1, x2)) ()
+      fun app f = app' id f
+      fun appEq f = app' ul f
 
       fun exists p (l1, l2) =
 	 let
@@ -42,6 +56,16 @@
 		| _ => false
 	 in loop(l1, l2)
 	 end
-
+       
       fun all p ls = not(exists (not o p) ls)
+
+      fun allEq p =
+	 let
+	    fun loop(l1, l2) =
+	       case (l1, l2) of
+		  ([], []) => true
+		| (x1 :: l1, x2 :: l2) => p(x1, x2) andalso loop(l1, l2)
+		| _ => false
+	 in loop
+	 end
    end



1.4       +18 -17    mlton/basis-library/list/list.sig

Index: list.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/list/list.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- list.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ list.sig	24 Nov 2002 01:19:39 -0000	1.4
@@ -1,37 +1,38 @@
 signature LIST_GLOBAL =
    sig
-      datatype 'a list = nil | :: of 'a * 'a list
+      datatype list = datatype list
 
       exception Empty
 
+      val null: 'a list -> bool 
+      val length: 'a list -> int 
       val @ : 'a list * 'a list -> 'a list 
+      val hd: 'a list -> 'a 
+      val tl: 'a list -> 'a list 
+      val rev: 'a list -> 'a list 
       val app: ('a -> unit) -> 'a list -> unit 
+      val map: ('a -> 'b) -> 'a list -> 'b list 
       val foldl: ('a * 'b -> 'b) -> 'b -> 'a list -> 'b 
       val foldr: ('a * 'b -> 'b) -> 'b -> 'a list -> 'b 
-      val hd: 'a list -> 'a 
-      val length: 'a list -> int 
-      val map: ('a -> 'b) -> 'a list -> 'b list 
-      val null: 'a list -> bool 
-      val rev: 'a list -> 'a list 
-      val tl: 'a list -> 'a list 
    end
 
 signature LIST =
    sig
       include LIST_GLOBAL
       
-      val all: ('a -> bool) -> 'a list -> bool 
-      val concat: 'a list list -> 'a list 
-      val drop: 'a list * int -> 'a list 
-      val exists: ('a -> bool) -> 'a list -> bool 
-      val filter: ('a -> bool) -> 'a list -> 'a list 
-      val find: ('a -> bool) -> 'a list -> 'a option 
-      val getItem: 'a list -> ('a * 'a list) option 
       val last: 'a list -> 'a 
-      val mapPartial: ('a -> 'b option) -> 'a list -> 'b list 
+      val getItem: 'a list -> ('a * 'a list) option 
       val nth: 'a list * int -> 'a 
-      val partition: ('a -> bool) -> 'a list -> 'a list * 'a list
+      val take: 'a list * int -> 'a list 
+      val drop: 'a list * int -> 'a list 
+      val concat: 'a list list -> 'a list 
       val revAppend: 'a list * 'a list -> 'a list 
+      val mapPartial: ('a -> 'b option) -> 'a list -> 'b list 
+      val find: ('a -> bool) -> 'a list -> 'a option 
+      val filter: ('a -> bool) -> 'a list -> 'a list 
+      val partition: ('a -> bool) -> 'a list -> 'a list * 'a list
+      val exists: ('a -> bool) -> 'a list -> bool 
+      val all: ('a -> bool) -> 'a list -> bool 
       val tabulate: int * (int -> 'a) -> 'a list 
-      val take: 'a list * int -> 'a list 
+      val collate: ('a * 'a -> order) -> 'a list * 'a list -> order
    end



1.7       +12 -0     mlton/basis-library/list/list.sml

Index: list.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/list/list.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- list.sml	14 Nov 2002 22:27:04 -0000	1.6
+++ list.sml	24 Nov 2002 01:19:39 -0000	1.7
@@ -152,6 +152,18 @@
 	      then raise Subscript
 	   else loop (l, n)
 	end
+
+     fun collate cmp =
+        let
+	   val rec loop =
+	     fn ([], []) => EQUAL
+	      | ([], _) => LESS
+	      | (_, []) => GREATER
+	      | (x1::l1,x2::l2) => (case cmp (x1, x2) of
+				      EQUAL => loop (l1, l2)
+				    | ans => ans)
+	in loop
+	end
   end
 
 structure ListGlobal: LIST_GLOBAL = List



1.4       +21 -1     mlton/basis-library/misc/cleaner.sml

Index: cleaner.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/cleaner.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- cleaner.sml	10 Apr 2002 07:02:17 -0000	1.3
+++ cleaner.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -28,5 +28,25 @@
    
 val atExit = new ()
 val atLoadWorld = new ()
-   
+
 end
+
+structure EmptyCleaner: CLEANER =
+struct
+
+structure UniqueId = UniqueId()
+structure Id = UniqueId
+
+type t = unit
+
+fun new (): t = ()
+
+fun add _ = ()
+fun addNew _ = ()
+fun remove _ = ()
+fun clean _ = ()
+
+val atExit = new ()
+val atLoadWorld = new ()
+
+end
\ No newline at end of file



1.39      +13 -8     mlton/basis-library/misc/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/misc/primitive.sml,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- primitive.sml	2 Nov 2002 03:37:34 -0000	1.38
+++ primitive.sml	24 Nov 2002 01:19:39 -0000	1.39
@@ -20,17 +20,17 @@
 type int = int
 type intInf = intInf
 datatype list = datatype list
-type nullString = string
 type pointer = pointer (* C integer, not SML heap pointer *)
 type real = real
 datatype ref = datatype ref
-type string = string
 type preThread = preThread
 type thread = thread
 type word = word
 type word8 = word8
 type word32 = word
 type 'a vector = 'a vector
+type string = char vector
+type nullString = string
 
 exception Bind = Bind
 exception Fail of string
@@ -255,12 +255,17 @@
 	    type int = intInf
 
 	    val + = _prim "IntInf_add": int * int * word -> int;
+	    val andb = _prim "IntInf_andb": int * int * word -> int;
+	    val ~>> = _prim "IntInf_arshift": int * word * word -> int;
 	    val compare = _prim "IntInf_compare": int * int -> Int.int;
 	    val fromVector = _prim "IntInf_fromVector": word vector -> int;
 	    val fromWord = _prim "IntInf_fromWord": word -> int;
 	    val gcd = _prim "IntInf_gcd": int * int * word -> int;
+	    val << = _prim "IntInf_lshift": int * word * word -> int;
 	    val * = _prim "IntInf_mul": int * int * word -> int;
 	    val ~ = _prim "IntInf_neg": int * word -> int;
+	    val notb = _prim "IntInf_notb": int * word -> int;
+	    val orb = _prim "IntInf_orb": int * int * word -> int;
 	    val quot = _prim "IntInf_quot": int * int * word -> int;
 	    val rem = _prim "IntInf_rem": int * int * word -> int;
 	    val smallMul =
@@ -270,6 +275,7 @@
 	       = _prim "IntInf_toString": int * Int.int * word -> string;
 	    val toVector = _prim "IntInf_toVector": int -> word vector;
 	    val toWord = _prim "IntInf_toWord": int -> word;
+	    val xorb = _prim "IntInf_xorb": int * int * word -> int;
 	 end
 
       structure Itimer =
@@ -418,6 +424,11 @@
 	       struct
 		  val tmpnam = _ffi "OS_FileSys_tmpnam": unit -> cstring;
 	       end
+	    structure IO =
+	       struct
+		  val poll = _ffi "OS_IO_poll": int vector * word vector * 
+                                                int * int * word array -> int;
+	       end
 	 end
 
       structure PackReal =
@@ -562,16 +573,10 @@
 
       structure String =
 	 struct
-	    val fromCharVector =
-	       _prim "String_fromCharVector": char vector -> string;
 	    val fromWord8Vector =
 	       _prim "String_fromWord8Vector": word8 vector -> string;
-	    val size = _prim "String_size": string -> int;
-	    val toCharVector =
-	       _prim "String_toCharVector": string -> char vector;
 	    val toWord8Vector =
 	       _prim "String_toWord8Vector": string -> word8 vector;
-	    val sub = _prim "String_sub": string * int -> char;
 	 end
 
       structure TextIO =



1.4       +9 -5      mlton/basis-library/mlton/exn.sml

Index: exn.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/exn.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- exn.sml	25 Aug 2002 22:23:58 -0000	1.3
+++ exn.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -19,11 +19,15 @@
 	     ; let
 		  fun loop e =
 		     case e of
-			Fail s => (message "Fail "; message s)
-		      | IO.Io {cause, function, ...} => (message "IO "
-							 ; message function
-							 ; message ": "
-							 ; loop cause)
+			Fail s => 
+			  (message "Fail "; message s)
+		      | IO.Io {name, function, cause, ...} => 
+			  (message "IO "
+			   ; message function
+			   ; message " on "
+			   ; message name
+			   ; message ": "
+			   ; loop cause)
 		      | PosixError.SysErr (s, _) =>
 			   (message "SysErr "; message s)
 		      | _ => message (exnName e)



1.15      +2 -2      mlton/basis-library/mlton/signal.sml

Index: signal.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/signal.sml,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- signal.sml	2 Nov 2002 03:37:34 -0000	1.14
+++ signal.sml	24 Nov 2002 01:19:39 -0000	1.15
@@ -86,7 +86,7 @@
       val _ =
 	 Cleaner.addNew
 	 (Cleaner.atLoadWorld, fn () =>
-	  Array.modifyi (defaultOrIgnore o #1) (handlers, 0, NONE))
+	  Array.modifyi (defaultOrIgnore o #1) handlers)
    in
       (fn s => Array.sub (handlers, s),
        fn (s, h) => if Primitive.MLton.ProfileTime.isOn andalso s = prof
@@ -147,7 +147,7 @@
 		    Handler f => if Prim.isPending s then f t else t
 		  | _ => t)
 		t
-		(handlers, 0, NONE))
+		handlers)
 	 in
 	    Handler
 	 end



1.2       +46 -45    mlton/basis-library/posix/error.sig

Index: error.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- error.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ error.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -2,56 +2,57 @@
    sig
       eqtype syserror
 
-      val toWord: syserror -> SysWord.word 
-      val fromWord: SysWord.word -> syserror 
+      val toWord: syserror -> SysWord.word
+      val fromWord: SysWord.word -> syserror
 
       val errorMsg: syserror -> string
-      val errorName: syserror -> string 
-      val syserror: string -> syserror option 
+      val errorName: syserror -> string
+      val syserror: string -> syserror option
 
-      val toobig: syserror 
-      val acces: syserror 
-      val again: syserror 
-      val badf: syserror 
-      val badmsg: syserror 
-      val busy: syserror 
+      val acces: syserror
+      val again: syserror
+      val badf: syserror
+      val badmsg: syserror
+      val busy: syserror
       val canceled: syserror
-      val child: syserror 
-      val deadlk: syserror 
-      val dom: syserror 
-      val exist: syserror 
-      val fault: syserror 
-      val fbig: syserror 
-      val inprogress: syserror 
-      val intr: syserror 
-      val inval: syserror 
-      val io: syserror 
-      val isdir: syserror 
-      val loop: syserror 
-      val mfile: syserror 
-      val mlink: syserror 
-      val msgsize: syserror 
-      val nametoolong: syserror 
-      val nfile: syserror 
-      val nodev: syserror 
-      val noent: syserror 
-      val noexec: syserror 
-      val nolck: syserror 
-      val nomem: syserror 
-      val nospc: syserror 
-      val nosys: syserror 
-      val notdir: syserror 
-      val notempty: syserror 
-      val notsup: syserror 
-      val notty: syserror 
-      val nxio: syserror 
-      val perm: syserror 
-      val pipe: syserror 
-      val range: syserror 
-      val rofs: syserror 
-      val spipe: syserror 
-      val srch: syserror 
+      val child: syserror
+      val deadlk: syserror
+      val dom: syserror
+      val exist: syserror
+      val fault: syserror
+      val fbig: syserror
+      val inprogress: syserror
+      val intr: syserror
+      val inval: syserror
+      val io: syserror
+      val isdir: syserror
+      val loop: syserror
+      val mfile: syserror
+      val mlink: syserror
+      val msgsize: syserror
+      val nametoolong: syserror
+      val nfile: syserror
+      val nodev: syserror
+      val noent: syserror
+      val noexec: syserror
+      val nolck: syserror
+      val nomem: syserror
+      val nospc: syserror
+      val nosys: syserror
+      val notdir: syserror
+      val notempty: syserror
+      val notsup: syserror
+      val notty: syserror
+      val nxio: syserror
+      val perm: syserror
+      val pipe: syserror
+      val range: syserror
+      val rofs: syserror
+      val spipe: syserror
+      val srch: syserror
+      val toobig: syserror
       val xdev: syserror
+
    end
 
 signature POSIX_ERROR_EXTRA =



1.3       +2 -17     mlton/basis-library/posix/error.sml

Index: error.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- error.sml	10 Apr 2002 07:02:17 -0000	1.2
+++ error.sml	24 Nov 2002 01:19:39 -0000	1.3
@@ -12,8 +12,8 @@
 	 
       exception SysErr of string * syserror option
 
-      val toWord = Word.fromInt
-      val fromWord = Word.toInt
+      val toWord = SysWord.fromInt
+      val fromWord = SysWord.toInt
 
       fun errorName n =
 	 case List.find (fn (m, _) => n = m) errorNames of
@@ -33,22 +33,7 @@
 	 end
 
       fun raiseSys n = raise SysErr (errorMsg n, SOME n)
-
-      fun restart (f: 'a -> int) (a: 'a): int =
-	 let
-	    fun loop () =
-	       case f a of
-		  ~1 => let val errno = getErrno ()
-			in if errno = intr
-			      then loop ()
-			   else raiseSys errno
-			end
-		| n => n
-	 in loop ()
-	 end
-      
       fun error () = raiseSys (getErrno ())
-
       fun checkReturnResult (n: int) = if n = ~1 then error () else n
       fun checkResult n = (checkReturnResult n; ())
    end



1.2       +100 -104  mlton/basis-library/posix/file-sys.sig

Index: file-sys.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- file-sys.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ file-sys.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -1,132 +1,128 @@
-signature POSIX_FILESYS =
+signature POSIX_FILE_SYS =
    sig
       eqtype uid
       eqtype gid
-      eqtype file_desc
 
-      val fdToWord: file_desc -> SysWord.word 
-      val wordToFD: SysWord.word -> file_desc 
+      eqtype file_desc
+      val fdToWord: file_desc -> SysWord.word
+      val wordToFD: SysWord.word -> file_desc
 
       (* identity functions *)
-      val fdToIOD: file_desc -> file_desc (* OS.IO.iodesc *)
-      val iodToFD: file_desc (* OS.IO.iodesc *) -> file_desc option
-	 
+      val fdToIOD: file_desc -> OS.IO.iodesc
+      val iodToFD: OS.IO.iodesc -> file_desc option
+
       type dirstream
       val opendir: string -> dirstream
-      val readdir: dirstream -> string
+      val readdir: dirstream -> string option
       val rewinddir: dirstream -> unit
       val closedir: dirstream -> unit
 
       val chdir: string -> unit
       val getcwd: unit -> string
-	 
-      val stdin: file_desc 
-      val stdout: file_desc 
+
+      val stdin: file_desc
+      val stdout: file_desc
       val stderr: file_desc
-	 
-      structure S:
+
+      structure S: 
 	 sig
-	    type mode
-	    include POSIX_FLAGS where type flags = mode 
+	    eqtype mode
+	    include BIT_FLAGS where type flags = mode
 
-	    val irwxu: mode 
-	    val irusr: mode 
-	    val iwusr: mode 
-	    val ixusr: mode 
-	    val irwxg: mode 
-	    val irgrp: mode 
-	    val iwgrp: mode 
-	    val ixgrp: mode 
-	    val irwxo: mode 
-	    val iroth: mode 
-	    val iwoth: mode 
-	    val ixoth: mode 
-	    val isuid: mode 
-	    val isgid: mode 
+	    val irwxu: mode
+	    val irusr: mode
+	    val iwusr: mode
+	    val ixusr: mode
+	    val irwxg: mode
+	    val irgrp: mode
+	    val iwgrp: mode
+	    val ixgrp: mode
+	    val irwxo: mode
+	    val iroth: mode
+	    val iwoth: mode
+	    val ixoth: mode
+	    val isuid: mode
+	    val isgid: mode
 	 end
 
-      structure O:
+      structure O: 
 	 sig
-	    include POSIX_FLAGS
+	   include BIT_FLAGS
 
-            val append: flags 
-	    val excl: flags 
-	    val noctty: flags 
-	    val nonblock: flags 
-	    val sync: flags 
-	    val trunc: flags 
+           val append: flags
+	   val excl: flags
+	   val noctty: flags
+	   val nonblock: flags
+	   val sync: flags
+	   val trunc: flags
 	 end
-	 
-       datatype open_mode  = O_RDONLY  | O_WRONLY  | O_RDWR
 
-       val openf: string * open_mode * O.flags -> file_desc 
-       val createf: string * open_mode * O.flags * S.mode -> file_desc 
-       val creat: string * S.mode -> file_desc 
-       val umask: S.mode -> S.mode
-       val link: {old: string, new: string} -> unit
-       val mkdir: string * S.mode -> unit
-       val mkfifo: string * S.mode -> unit
-       val unlink: string -> unit
-       val rmdir: string -> unit
-       val rename: {old: string, new: string} -> unit
-       val symlink: {old: string, new: string} -> unit
-       val readlink: string -> string
-
-       eqtype dev
-       val wordToDev: SysWord.word -> dev 
-       val devToWord: dev -> SysWord.word 
-
-       eqtype ino
-       val wordToIno: SysWord.word -> ino 
-       val inoToWord: ino -> SysWord.word 
-
-       structure ST:
-	  sig
-	     type stat
-
-	     val isDir: stat -> bool 
-	     val isChr: stat -> bool 
-	     val isBlk: stat -> bool 
-	     val isReg: stat -> bool 
-	     val isFIFO: stat -> bool 
-	     val isLink: stat -> bool 
-	     val isSock: stat -> bool 
-	     val mode: stat -> S.mode 
-	     val ino: stat -> ino 
-	     val dev: stat -> dev 
-	     val nlink: stat -> int 
-	     val uid: stat -> uid 
-	     val gid: stat -> gid 
-	     val size: stat -> Position.int 
-	     val atime: stat -> Time.time 
-	     val mtime: stat -> Time.time 
-	     val ctime: stat -> Time.time 
-	  end
-
-       val stat: string -> ST.stat
-       val lstat: string -> ST.stat
-       val fstat: file_desc -> ST.stat
-
-       datatype access_mode =
-	  A_READ
-	| A_WRITE
-	| A_EXEC
-	  
-       val access: string * access_mode list -> bool
-       val chmod: string * S.mode -> unit
-       val fchmod: file_desc * S.mode -> unit
-       val chown: string * uid * gid -> unit
-       val fchown: file_desc * uid * gid -> unit
-       val utime: string * {actime: Time.time, modtime: Time.time} option -> unit
-       val ftruncate: file_desc * Position.int -> unit
-       val pathconf: string * string -> SysWord.word option
-       val fpathconf: file_desc * string -> SysWord.word option
-   end
+      datatype open_mode = O_RDONLY | O_WRONLY | O_RDWR
 
+      val openf: string * open_mode * O.flags -> file_desc
+      val createf: string * open_mode * O.flags * S.mode -> file_desc
+      val creat: string * S.mode -> file_desc
+      val umask: S.mode -> S.mode
+      val link: {old: string, new: string} -> unit
+      val mkdir: string * S.mode -> unit
+      val mkfifo: string * S.mode -> unit
+      val unlink: string -> unit
+      val rmdir: string -> unit
+      val rename: {old: string, new: string} -> unit
+      val symlink: {old: string, new: string} -> unit
+      val readlink: string -> string
+
+      eqtype dev
+      val wordToDev: SysWord.word -> dev
+      val devToWord: dev -> SysWord.word
+
+      eqtype ino
+      val wordToIno: SysWord.word -> ino
+      val inoToWord: ino -> SysWord.word
+
+      structure ST: 
+	 sig
+	    type stat
+
+	    val isDir: stat -> bool
+	    val isChr: stat -> bool
+	    val isBlk: stat -> bool
+	    val isReg: stat -> bool
+	    val isFIFO: stat -> bool
+	    val isLink: stat -> bool
+	    val isSock: stat -> bool
+	    val mode: stat -> S.mode
+	    val ino: stat -> ino
+	    val dev: stat -> dev
+	    val nlink: stat -> int
+	    val uid: stat -> uid
+	    val gid: stat -> gid
+	    val size: stat -> Position.int
+	    val atime: stat -> Time.time
+	    val mtime: stat -> Time.time
+	    val ctime: stat -> Time.time
+	 end
+
+      val stat: string -> ST.stat
+      val lstat: string -> ST.stat
+      val fstat: file_desc -> ST.stat
+
+      datatype access_mode = A_READ | A_WRITE | A_EXEC
+
+      val access: string * access_mode list -> bool
+      val chmod: string * S.mode -> unit
+      val fchmod: file_desc * S.mode -> unit
+      val chown: string * uid * gid -> unit
+      val fchown: file_desc * uid * gid -> unit
+      val utime: string * {actime: Time.time, modtime: Time.time} option -> unit
+      val ftruncate: file_desc * Position.int -> unit
+      val pathconf: string * string -> SysWord.word option
+      val fpathconf: file_desc * string -> SysWord.word option
+   end
 
-signature POSIX_FILESYS_EXTRA =
+signature POSIX_FILE_SYS_EXTRA =
    sig
-      include POSIX_FILESYS
+      include POSIX_FILE_SYS
 
       val wordToOpenMode: SysWord.word -> open_mode
    end



1.4       +19 -16    mlton/basis-library/posix/file-sys.sml

Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/file-sys.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- file-sys.sml	10 Apr 2002 07:02:17 -0000	1.3
+++ file-sys.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -5,7 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure PosixFileSys: POSIX_FILESYS_EXTRA =
+structure PosixFileSys: POSIX_FILE_SYS_EXTRA =
    struct
       (* Patch to make Time look like it deals with Int.int
        * instead of LargeInt.int.
@@ -21,7 +21,7 @@
       structure Prim = PosixPrimitive.FileSys
       open Prim
       structure Stat = Prim.Stat
-      structure Flags = PosixFlags
+      structure Flags = BitFlags
 
       val checkResult = Error.checkResult
 
@@ -66,12 +66,16 @@
 		     val cs = Prim.readdir d
 		  in if Primitive.Cpointer.isNull cs
 			then if Error.getErrno () = 0
-				then ""
+				then NONE
 			     else Error.error ()
-		     else (case C.CS.toString cs of
-			      "." => loop ()
-			    | ".." => loop ()
-			    | s => s)
+		     else
+			let
+			   val s = C.CS.toString cs
+			in
+			   if s = "." orelse s = ".."
+			      then loop ()
+			   else SOME s
+			end
 		  end
 	    in loop ()
 	    end
@@ -117,7 +121,7 @@
 	       then (size := 2 * !size
 		     ; buffer := make ()
 		     ; getcwd ())
-	    else Primitive.String.fromCharVector (extract (!buffer))
+	    else extract (!buffer)
       end
 	 
       val stdin = FD 0
@@ -153,8 +157,8 @@
 	 let
 	    val fd =
 	       Prim.openn (String.nullTerm pathname,
-			  Flags.flags [openModeToWord openMode, flags, O.creat],
-			  mode)
+			   Flags.flags [openModeToWord openMode, flags, O.creat],
+			   mode)
 	 in if fd = ~1
 	       then error ()
 	    else FD fd
@@ -162,8 +166,8 @@
 
       fun openf (pathname, openMode, flags) =
 	 let val fd = Prim.openn (String.nullTerm pathname,
-				 Flags.flags [openModeToWord openMode, flags],
-				 Flags.empty)
+				  Flags.flags [openModeToWord openMode, flags],
+				  Flags.empty)
 	 in if fd = ~1
 	       then error ()
 	    else FD fd
@@ -293,7 +297,7 @@
 	 structure U = Prim.Utimbuf
       in
 	 fun utime (f: string, opt: {actime: Time.time,
-				    modtime: Time.time} option): unit =
+				     modtime: Time.time} option): unit =
 	    let
 	       val (a, m) =
 		  case opt of
@@ -315,13 +319,12 @@
 	       NONE => Error.raiseSys Error.inval
 	     | SOME (n, _) => n
 
+	 (* QUESTION: is this o.k.? *)
 	 fun make prim (f, s) =
 	    let val n = prim (f, convertProperty s)
 	    in if n < 0
 		  then Error.error ()
-	       else if n = 0
-		       then NONE
-		    else SOME (SysWord.fromInt n)
+	       else SOME (SysWord.fromInt n)
 	    end
 	       
       in



1.2       +7 -4      mlton/basis-library/posix/flags.sig

Index: flags.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/flags.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- flags.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ flags.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -1,16 +1,19 @@
-signature POSIX_FLAGS =
+signature BIT_FLAGS =
    sig
       eqtype flags
 
       val toWord: flags -> SysWord.word 
-      val wordTo: SysWord.word -> flags 
+      val fromWord: SysWord.word -> flags 
+      val all: flags
       val flags: flags list -> flags 
+      val intersect: flags list -> flags
+      val clear: flags * flags -> flags
       val allSet: flags * flags -> bool 
       val anySet: flags * flags -> bool
    end
 
-signature POSIX_FLAGS_EXTRA =
+signature BIT_FLAGS_EXTRA =
    sig
-      include POSIX_FLAGS
+      include BIT_FLAGS
       val empty: flags
    end



1.3       +16 -9     mlton/basis-library/posix/flags.sml

Index: flags.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/flags.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- flags.sml	10 Apr 2002 07:02:17 -0000	1.2
+++ flags.sml	24 Nov 2002 01:19:39 -0000	1.3
@@ -5,18 +5,25 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure PosixFlags: POSIX_FLAGS_EXTRA =
+functor BitFlags(val all: SysWord.word): BIT_FLAGS_EXTRA =
    struct
-      type flags = word
+      type flags = SysWord.word
 	 
+      val all: flags = all
+      val empty: flags = 0w0
+
       fun toWord f = f
-      fun wordTo f = f
-	 
-      val flags: flags list -> flags = List.foldl Word.orb 0w0
-	 
-      fun anySet(f, f') = Word.andb(f, f') <> 0w0
+      fun fromWord f = SysWord.andb(f, all)
 
-      fun allSet(f, f') = Word.andb(f, f') = f
+      val flags: flags list -> flags = List.foldl SysWord.orb empty
+
+      val intersect: flags list -> flags = List.foldl SysWord.andb all
+
+      fun clear(f, f') = SysWord.andb(SysWord.notb f, f')
+
+      fun allSet(f, f') = SysWord.andb(f, f') = f
+
+      fun anySet(f, f') = SysWord.andb(f, f') <> 0w0
 
-      val empty: flags = 0w0
    end
+structure BitFlags = BitFlags(val all = 0wxFFFF: SysWord.word)



1.2       +22 -10    mlton/basis-library/posix/io.sig

Index: io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ io.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -23,14 +23,14 @@
 
       structure FD:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 
             val cloexec: flags 
 	 end
       
       structure O:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 
             val append: flags 
 	    val nonblock: flags 
@@ -47,21 +47,16 @@
       val lseek: file_desc * Position.int * whence -> Position.int 
       val fsync: file_desc -> unit
 	 
-      datatype lock_type =
-	 F_RDLCK
-       | F_WRLCK
-       | F_UNLCK
+      datatype lock_type = F_RDLCK | F_WRLCK | F_UNLCK
 	 
       structure FLock:
 	 sig
 	    type flock
-	    val flock: {
-			ltype: lock_type,
+	    val flock: {ltype: lock_type,
 			whence: whence,
 			start: Position.int,
 			len: Position.int,
-			pid: pid option
-			} -> flock 
+			pid: pid option} -> flock 
 	    val ltype: flock -> lock_type 
 	    val whence: flock -> whence 
 	    val start: flock -> Position.int 
@@ -72,4 +67,21 @@
       val getlk: file_desc * FLock.flock -> FLock.flock 
       val setlk: file_desc * FLock.flock -> FLock.flock 
       val setlkw: file_desc * FLock.flock -> FLock.flock
+
+      val mkBinReader: {fd: file_desc,
+			name: string,
+			initBlkMode: bool} -> BinPrimIO.reader
+      val mkTextReader: {fd: file_desc,
+			 name: string,
+			 initBlkMode: bool} -> TextPrimIO.reader
+      val mkBinWriter: {fd: file_desc,
+			name: string,
+			appendMode: bool,
+			initBlkMode: bool,
+			chunkSize: int} -> BinPrimIO.writer
+      val mkTextWriter: {fd: file_desc,
+			 name: string,
+			 appendMode: bool,
+			 initBlkMode: bool,
+			 chunkSize: int} -> TextPrimIO.writer
    end



1.4       +196 -27   mlton/basis-library/posix/io.sml

Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/io.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- io.sml	10 Apr 2002 07:02:17 -0000	1.3
+++ io.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -33,36 +33,48 @@
 
       fun close (FD fd) = checkResult (Prim.close fd)
 
-      fun readArr (FD fd, {buf, i, sz}): int =
-	 let
-	    val max = Array.checkSlice (buf, i, sz)
-	 in
-	    checkReturnResult (Prim.read (fd, buf, i, max -? i))
-	 end
-
-      fun readVec (fd, n): Word8Vector.vector =
-	 let
-	    val a = Primitive.Array.array n
-	    val bytesRead = readArr (fd, {buf = a, i = 0, sz = SOME n})
-	 in
-	    if n = bytesRead
-	       then Vector.fromArray a
-	    else Array.extract (a, 0, SOME bytesRead)
-	 end
-	 
-      fun writeVec (FD fd, {buf, i, sz}) =
-	 let
-	    val max = Vector.checkSlice (buf, i, sz)
-	 in
-	    checkReturnResult (Prim.write (fd, buf, i, max -? i))
-	 end
-
-      fun writeArr (fd, {buf, i, sz}) =
-	 writeVec (fd, {buf = Vector.fromArray buf, i = i, sz = sz})
+      local
+	fun make {read, write} =
+	  let
+	    fun readArr (FD fd, {buf, i, sz}): int =
+	      let
+		val max = Array.checkSlice (buf, i, sz)
+	      in
+		checkReturnResult (read (fd, buf, i, max -? i))
+	      end
+	    
+	       fun readVec (fd, n) =
+		 let
+		   val a = Primitive.Array.array n
+		   val bytesRead = readArr (fd, {buf = a, i = 0, sz = SOME n})
+		 in 
+		   if n = bytesRead
+		     then Vector.fromArray a
+		     else Array.extract (a, 0, SOME bytesRead)
+		  end
+		
+	       fun writeVec (FD fd, {buf, i, sz}) =
+		 let
+		   val max = Vector.checkSlice (buf, i, sz)
+		 in
+		   checkReturnResult (write (fd, buf, i, max -? i))
+		 end
+	       
+	       fun writeArr (fd, {buf, i, sz}) =
+		  writeVec (fd, {buf = Vector.fromArray buf, i = i, sz = sz})
+	  in
+	    {readArr = readArr, readVec = readVec,
+	     writeVec = writeVec, writeArr = writeArr}
+	  end
+      in
+	val rwChar = make {read = readChar, write = writeChar}
+	val rwWord8 = make {read = readWord8, write = writeWord8}
+      end
+      val {readArr, readVec, writeVec, writeArr} = rwWord8
 		      
       structure FD =
 	 struct
-	    open FD PosixFlags
+	    open FD BitFlags
 	 end
 
       structure O = PosixFileSys.O
@@ -168,5 +180,162 @@
 	 val getlk = make (F_GETLK, true)
 	 val setlk = make (F_SETLK, false)
 	 val setlkw = make (F_SETLKW, false)
+      end
+
+      (* Adapted from SML/NJ sources. *)
+      (* posix-bin-prim-io.sml
+       *
+       * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
+       *
+       * This implements the UNIX version of the OS specific binary primitive
+       * IO structure.  The Text IO version is implemented by a trivial translation
+       * of these operations (see posix-text-prim-io.sml).
+       *
+       *)
+      local
+	val pos0 = Position.fromInt 0
+	fun isReg fd = FS.ST.isReg(FS.fstat fd)
+	fun posFns (closed, fd) = 
+	  if (isReg fd)
+	    then let
+		   val pos = ref pos0
+		   fun getPos () = !pos
+		   fun setPos p = (if !closed 
+				     then raise IO.ClosedStream 
+				     else ();
+				   pos := lseek(fd,p,SEEK_SET))
+		   fun endPos () = (if !closed 
+				      then raise IO.ClosedStream 
+				      else ();
+				    FS.ST.size(FS.fstat fd))
+		   fun verifyPos () = let
+					val curPos = lseek(fd, pos0, SEEK_CUR)
+				      in
+					pos := curPos; curPos
+				      end
+		 in
+		   verifyPos ();
+		   {pos = pos,
+		    getPos = SOME getPos,
+		    setPos = SOME setPos,
+		    endPos = SOME endPos,
+		    verifyPos = SOME verifyPos}
+		 end
+	    else {pos = ref pos0,
+		  getPos = NONE, 
+		  setPos = NONE, 
+		  endPos = NONE, 
+		  verifyPos = NONE}
+
+	fun make {readArr, readVec, writeVec, writeArr} (RD, WR) =
+	  let
+	    fun mkReader {fd, name, initBlkMode} =
+	      let
+		val closed = ref false
+		val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
+		val blocking = ref initBlkMode
+		fun blockingOn () = 
+		  (setfl(fd, O.flags[]); blocking := true)
+		fun blockingOff () = 
+		  (setfl(fd, O.nonblock); blocking := false)
+		fun ensureOpen () = 
+		  if !closed then raise IO.ClosedStream else ()
+		fun incPos k = pos := Position.+ (!pos, Position.fromInt k)
+		val readVec = fn n => 
+		  let val v = readVec (fd, n)
+		  in incPos (Vector.length v); v
+		  end
+		val readArr = fn x => 
+		  let val k = readArr (fd, x)
+		  in incPos k; k
+		  end
+		fun blockWrap f x =
+		  (ensureOpen ();
+		   if !blocking then () else blockingOn ();
+		   f x)
+		fun noBlockWrap f x =
+		  (ensureOpen ();
+		   if !blocking then blockingOff () else ();
+		   (SOME (f x)
+		    handle (e as PosixError.SysErr (_, SOME cause)) =>
+		    if cause = PosixError.again then NONE else raise e))
+		val close = 
+		  fn () => if !closed then () else (closed := true; close fd)
+		val avail = 
+		  if isReg fd
+		    then fn () => if !closed 
+				    then SOME 0
+				    else SOME(Position.-(FS.ST.size(FS.fstat fd), !pos))
+		    else fn () => if !closed then SOME 0 else NONE
+	      in
+		RD {name = name,
+		    chunkSize = Primitive.TextIO.bufSize,
+		    readVec = SOME (blockWrap readVec),
+		    readArr = SOME (blockWrap readArr),
+		    readVecNB = SOME (noBlockWrap readVec),
+		    readArrNB = SOME (noBlockWrap readArr),
+		    block = NONE,
+		    canInput = NONE,
+		    avail = avail,
+		    getPos = getPos,
+		    setPos = setPos,
+		    endPos = endPos,
+		    verifyPos = verifyPos,
+		    close = close,
+		    ioDesc = SOME (FS.fdToIOD fd)}
+	      end
+	    fun mkWriter {fd, name, initBlkMode, appendMode, chunkSize} =
+	      let
+		val closed = ref false
+		val {pos, getPos, setPos, endPos, verifyPos} = posFns (closed, fd)
+		fun incPos k = (pos := Position.+ (!pos, Position.fromInt k); k)
+		val blocking = ref initBlkMode
+		val appendFlgs = O.flags(if appendMode then [O.append] else [])
+		fun updateStatus () = 
+		  let
+		    val flgs = if !blocking
+				 then appendFlgs
+				 else O.flags [O.nonblock, appendFlgs]
+		  in
+		    setfl(fd, flgs)
+		  end
+		fun ensureOpen () = 
+		  if !closed then raise IO.ClosedStream else ()
+		fun ensureBlock x = 
+		  if !blocking then () else (blocking := x; updateStatus ())
+		fun putV x = incPos(writeVec x)
+		fun putA x = incPos(writeArr x)
+		fun write (put, block) arg = 
+		  (ensureOpen (); ensureBlock block; put (fd, arg))
+		fun handleBlock writer arg = 
+		  SOME(writer arg)
+		  handle (e as PosixError.SysErr (_, SOME cause)) =>
+		    if cause = PosixError.again then NONE else raise e
+		val close = 
+		  fn () => if !closed then () else (closed := true; close fd)
+	      in
+		WR {name = name,
+		    chunkSize = chunkSize,
+		    writeVec = SOME (write (putV, true)),
+		    writeArr = SOME (write (putA, true)),
+		    writeVecNB = SOME (handleBlock (write (putV, false))),
+		    writeArrNB = SOME (handleBlock (write (putA, false))),
+		    block = NONE,
+		    canOutput = NONE,
+		    getPos = getPos,
+		    setPos = setPos,
+		    endPos = endPos,
+		    verifyPos = verifyPos,
+		    close = close,
+		    ioDesc = SOME (FS.fdToIOD fd)}
+	      end
+	  in
+	    {mkReader = mkReader, mkWriter = mkWriter}
+	  end
+      in
+	val {mkReader = mkBinReader, mkWriter = mkBinWriter} =
+	  make rwWord8 (BinPrimIO.RD, BinPrimIO.WR)
+	val {mkReader = mkTextReader, mkWriter = mkTextWriter} =
+	  make rwChar (TextPrimIO.RD, TextPrimIO.WR)
       end
    end



1.2       +33 -1     mlton/basis-library/posix/posix.sig

Index: posix.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/posix.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- posix.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ posix.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -3,9 +3,41 @@
       structure Error: POSIX_ERROR
       structure Signal: POSIX_SIGNAL
       structure Process: POSIX_PROCESS
+	where type signal = Signal.signal
       structure ProcEnv: POSIX_PROC_ENV
-      structure FileSys: POSIX_FILESYS
+	where type pid = Process.pid
+      structure FileSys: POSIX_FILE_SYS
+	where type file_desc = ProcEnv.file_desc
+	where type uid = ProcEnv.uid
+	where type gid = ProcEnv.gid
       structure IO: POSIX_IO
+	where type open_mode = FileSys.open_mode
       structure SysDB: POSIX_SYS_DB
+	where type uid = ProcEnv.uid
+	where type gid = ProcEnv.gid
       structure TTY: POSIX_TTY
+	where type pid = Process.pid
+	where type file_desc = ProcEnv.file_desc
+   end
+
+signature POSIX_EXTRA =
+   sig
+      structure Error: POSIX_ERROR_EXTRA
+      structure Signal: POSIX_SIGNAL
+      structure Process: POSIX_PROCESS_EXTRA
+	where type signal = Signal.signal
+      structure ProcEnv: POSIX_PROC_ENV
+	where type pid = Process.pid
+      structure FileSys: POSIX_FILE_SYS_EXTRA
+	where type file_desc = ProcEnv.file_desc
+	where type uid = ProcEnv.uid
+	where type gid = ProcEnv.gid
+      structure IO: POSIX_IO
+	where type open_mode = FileSys.open_mode
+      structure SysDB: POSIX_SYS_DB
+	where type uid = ProcEnv.uid
+	where type gid = ProcEnv.gid
+      structure TTY: POSIX_TTY
+	where type pid = Process.pid
+	where type file_desc = ProcEnv.file_desc
    end



1.3       +1 -1      mlton/basis-library/posix/posix.sml

Index: posix.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/posix.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- posix.sml	10 Apr 2002 07:02:17 -0000	1.2
+++ posix.sml	24 Nov 2002 01:19:39 -0000	1.3
@@ -5,7 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure Posix =
+structure Posix : POSIX_EXTRA =
    struct
       structure Error = PosixError
 



1.9       +178 -171  mlton/basis-library/posix/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- primitive.sml	10 Sep 2002 16:08:04 -0000	1.8
+++ primitive.sml	24 Nov 2002 01:19:39 -0000	1.9
@@ -122,6 +122,171 @@
 		]
 	 end
       
+      structure Signal =
+	 struct
+	    type signal = signal
+      	    type how = int
+
+	    val abrt = _const "Posix_Signal_abrt": signal;
+	    val alrm = _const "Posix_Signal_alrm": signal;
+	    val bus = _const "Posix_Signal_bus": signal;
+	    val chld = _const "Posix_Signal_chld": signal;
+	    val cont = _const "Posix_Signal_cont": signal;
+	    val fpe = _const "Posix_Signal_fpe": signal;
+	    val hup = _const "Posix_Signal_hup": signal;
+	    val ill = _const "Posix_Signal_ill": signal;
+	    val int = _const "Posix_Signal_int": signal;
+	    val kill = _const "Posix_Signal_kill": signal;
+	    val pipe = _const "Posix_Signal_pipe": signal;
+	    val prof = _const "Posix_Signal_prof": signal;
+	    val quit = _const "Posix_Signal_quit": signal;
+	    val segv = _const "Posix_Signal_segv": signal;
+	    val stop = _const "Posix_Signal_stop": signal;
+	    val term = _const "Posix_Signal_term": signal;
+	    val tstp = _const "Posix_Signal_tstp": signal;
+	    val ttin = _const "Posix_Signal_ttin": signal;
+	    val ttou = _const "Posix_Signal_ttou": signal;
+	    val usr1 = _const "Posix_Signal_usr1": signal;
+	    val usr2 = _const "Posix_Signal_usr2": signal;
+	    val vtalrm = _const "Posix_Signal_vtalrm": signal;
+	       
+	    val block = _const "Posix_Signal_block": how;
+	    val default = _ffi "Posix_Signal_default": signal -> int;
+	    val handlee = _ffi "Posix_Signal_handle": signal -> int;
+	    val ignore = _ffi "Posix_Signal_ignore": signal -> int;
+	    val isDefault = _ffi "Posix_Signal_isDefault": signal * bool ref -> int;
+	    val isPending = _ffi "Posix_Signal_isPending": signal -> bool;
+	    val numSignals = _const "Posix_Signal_numSignals": int;
+	    val setmask = _const "Posix_Signal_setmask": how;
+	    val sigaddset = _ffi "Posix_Signal_sigaddset": signal -> int;
+	    val sigdelset = _ffi "Posix_Signal_sigdelset": signal -> int;
+	    val sigemptyset = _ffi "Posix_Signal_sigemptyset": unit -> int;
+	    val sigfillset = _ffi "Posix_Signal_sigfillset": unit -> int;
+	    val sigprocmask = _ffi "Posix_Signal_sigprocmask": how -> int;
+	    val suspend = _ffi "Posix_Signal_suspend": unit -> int;
+	    val unblock = _const "Posix_Signal_unblock": how;
+	 end
+      
+      structure Process =
+	 struct
+	    val wnohang = _const "Posix_Process_wnohang": word;
+	    structure W =
+	       struct
+		  type flags = word
+		  val untraced = _const "Posix_Process_W_untraced": flags;
+	       end
+	    
+	    type pid = pid
+	    type status = int
+
+	    val alarm = _ffi "Posix_Process_alarm": int -> int;
+	    val exece =
+	       _ffi "Posix_Process_exece"
+	       : nullString * nullString array * nullString array -> int;
+	    val execp =
+	       _ffi "Posix_Process_execp": nullString * nullString array -> int;
+	    val exit = _ffi "Posix_Process_exit": int -> unit;
+	    val exitStatus = _ffi "Posix_Process_exitStatus": status -> int;
+	    val fork = _ffi "Posix_Process_fork": unit -> pid;
+	    val ifExited = _ffi "Posix_Process_ifExited": status -> bool;
+	    val ifSignaled = _ffi "Posix_Process_ifSignaled": status -> bool;
+	    val ifStopped = _ffi "Posix_Process_ifStopped": status -> bool;
+	    val kill = _ffi "Posix_Process_kill": pid * signal -> int;
+	    val pause = _ffi "Posix_Process_pause": unit -> int;
+	    val sleep = _ffi "Posix_Process_sleep": int -> int;
+	    val stopSig = _ffi "Posix_Process_stopSig": status -> signal;
+	    val termSig = _ffi "Posix_Process_termSig": status -> signal;
+	    val waitpid =
+	       _ffi "Posix_Process_waitpid": pid * status ref * int -> pid;
+	 end
+
+      structure ProcEnv =
+	 struct
+	    val numgroups = _const "Posix_ProcEnv_numgroups": int;
+	    val sysconfNames =
+	       [
+		(* Required *)
+		(_const "Posix_ProcEnv_ARG_MAX": int;, "ARG_MAX"),
+		(_const "Posix_ProcEnv_CHILD_MAX": int;, "CHILD_MAX"),
+		(_const "Posix_ProcEnv_CLK_TCK": int;, "CLK_TCK"),
+		(_const "Posix_ProcEnv_NGROUPS_MAX": int;, "NGROUPS_MAX"),
+		(_const "Posix_ProcEnv_OPEN_MAX": int;, "OPEN_MAX"),
+		(_const "Posix_ProcEnv_STREAM_MAX": int;, "STREAM_MAX"),
+		(_const "Posix_ProcEnv_TZNAME_MAX": int;, "TZNAME_MAX"),
+		(_const "Posix_ProcEnv_JOB_CONTROL": int;, "JOB_CONTROL"),
+		(_const "Posix_ProcEnv_SAVED_IDS": int;, "SAVED_IDS"),
+		(_const "Posix_ProcEnv_VERSION": int;, "VERSION"),
+		(* Optional *)
+		(_const "Posix_ProcEnv_BC_BASE_MAX": int;, "BC_BASE_MAX"),
+		(_const "Posix_ProcEnv_BC_DIM_MAX": int;, "BC_DIM_MAX"),
+		(_const "Posix_ProcEnv_BC_SCALE_MAX": int;, "BC_SCALE_MAX"),
+		(_const "Posix_ProcEnv_BC_STRING_MAX": int;, "BC_STRING_MAX"),
+		(_const "Posix_ProcEnv_COLL_WEIGHTS_MAX": int;, "COLL_WEIGHTS_MAX"),
+		(_const "Posix_ProcEnv_EXPR_NEST_MAX": int;, "EXPR_NEST_MAX"),
+		(_const "Posix_ProcEnv_LINE_MAX": int;, "LINE_MAX"),
+		(_const "Posix_ProcEnv_RE_DUP_MAX": int;, "RE_DUP_MAX"),
+		(_const "Posix_ProcEnv_2_VERSION": int;, "2_VERSION"),
+		(_const "Posix_ProcEnv_2_FORT_DEV": int;, "2_FORT_DEV"),
+		(_const "Posix_ProcEnv_2_FORT_RUN": int;, "2_FORT_RUN"),
+		(_const "Posix_ProcEnv_2_SW_DEV": int;, "2_SW_DEV")
+		]
+	       
+	    type pid = pid
+	    type gid = gid
+	    type uid = uid
+	    datatype file_desc = datatype file_desc
+
+	    val getegid = _ffi "Posix_ProcEnv_getegid": unit -> gid;
+	    val geteuid = _ffi "Posix_ProcEnv_geteuid": unit -> uid;
+	    val getgid = _ffi "Posix_ProcEnv_getgid": unit -> gid;
+	    val getgroups = _ffi "Posix_ProcEnv_getgroups": gid array -> int;
+	    val getlogin = _ffi "Posix_ProcEnv_getlogin": unit -> cstring;
+	    val getpgrp = _ffi "Posix_ProcEnv_getpgrp": unit -> pid;
+	    val getpid = _ffi "Posix_ProcEnv_getpid": unit -> pid;
+	    val getppid = _ffi "Posix_ProcEnv_getppid": unit -> pid;
+	    val getuid = _ffi "Posix_ProcEnv_getuid": unit -> uid;
+	    val setenv = _ffi "Posix_ProcEnv_setenv": nullString * nullString -> int;
+	    val setgid = _ffi "Posix_ProcEnv_setgid": gid -> int;
+	    val setpgid = _ffi "Posix_ProcEnv_setpgid": pid * pid -> int;
+	    val setsid = _ffi "Posix_ProcEnv_setsid": unit -> pid;
+	    val setuid = _ffi "Posix_ProcEnv_setuid": uid -> int;
+
+	    structure Uname =
+	       struct
+		  type uname = pointer
+
+		  val uname = _ffi "Posix_ProcEnv_Uname_uname": unit -> int;
+		  val sysname =
+		     _ffi "Posix_ProcEnv_Uname_sysname": unit -> cstring;
+		  val nodename =
+		     _ffi "Posix_ProcEnv_Uname_nodename": unit -> cstring;
+		  val release =
+		     _ffi "Posix_ProcEnv_Uname_release": unit -> cstring;
+		  val version =
+		     _ffi "Posix_ProcEnv_Uname_version": unit -> cstring;
+		  val machine =
+		     _ffi "Posix_ProcEnv_Uname_machine": unit -> cstring;
+	       end
+
+	    type clock_t = word
+	       
+	    structure Tms =
+	       struct
+		  val utime = _ffi "Posix_ProcEnv_Tms_utime": unit -> clock_t;
+		  val stime = _ffi "Posix_ProcEnv_Tms_stime": unit -> clock_t;
+		  val cutime = _ffi "Posix_ProcEnv_Tms_cutime": unit -> clock_t;
+		  val cstime = _ffi "Posix_ProcEnv_Tms_cstime": unit -> clock_t;
+	       end
+
+	    val ctermid = _ffi "Posix_ProcEnv_ctermid" : unit -> cstring;
+	    val environ = _ffi "Posix_ProcEnv_environ" : cstringArray;
+	    val getenv = _ffi "Posix_ProcEnv_getenv" : nullString -> cstring;
+	    val isatty = _ffi "Posix_ProcEnv_isatty" : fd -> bool;
+	    val sysconf = _ffi "Posix_ProcEnv_sysconf" : int -> int;
+	    val times = _ffi "Posix_ProcEnv_times" : unit -> clock_t;
+	    val ttyname = _ffi "Posix_ProcEnv_ttyname" : fd -> cstring;
+	 end 
+      
       structure FileSys =
 	 struct
 	    datatype file_desc = datatype file_desc
@@ -181,16 +346,19 @@
 
 	    val properties =
 	       [
+		(_const "Posix_FileSys_CHOWN_RESTRICTED": int;,
+		 "CHOWN_RESTRICTED"),
 		(_const "Posix_FileSys_LINK_MAX": int;, "LINK_MAX"),
 		(_const "Posix_FileSys_MAX_CANON": int;, "MAX_CANON"),
 		(_const "Posix_FileSys_MAX_INPUT": int;, "MAX_INPUT"),
 		(_const "Posix_FileSys_NAME_MAX": int;, "NAME_MAX"),
+		(_const "Posix_FileSys_NO_TRUNC": int;, "NO_TRUNC"),
 		(_const "Posix_FileSys_PATH_MAX": int;, "PATH_MAX"),
 		(_const "Posix_FileSys_PIPE_BUF": int;, "PIPE_BUF"),
-		(_const "Posix_FileSys_CHOWN_RESTRICTED": int;,
-		 "CHOWN_RESTRICTED"),
-		(_const "Posix_FileSys_NO_TRUNC": int;, "NO_TRUNC"),
-		(_const "Posix_FileSys_VDISABLE": int;, "VDISABLE")
+		(_const "Posix_FileSys_VDISABLE": int;, "VDISABLE"),
+		(_const "Posix_FileSys_ASYNC_IO": int;, "ASYNC_IO"), 
+		(_const "Posix_FileSys_SYNC_IO": int;, "SYNC_IO"), 
+		(_const "Posix_FileSys_PRIO_IO": int;, "PRIO_IO")
 		]
 
 	    structure Dirstream =
@@ -350,177 +518,16 @@
 	    val fsync = _ffi "Posix_IO_fsync": fd -> int;
 	    val lseek = _ffi "Posix_IO_lseek": fd * int * int -> int;
 	    val pipe = _ffi "Posix_IO_pipe": fd array -> int;
-	    val read = _ffi "Posix_IO_read":
+	    val readChar = _ffi "Posix_IO_read":
+	       fd * char array * int * size -> ssize;
+	    val writeChar = _ffi "Posix_IO_write":
+	       fd * char vector * int * size -> ssize;
+	    val readWord8 = _ffi "Posix_IO_read":
 	       fd * word8 array * int * size -> ssize;
-	    val write = _ffi "Posix_IO_write":
+	    val writeWord8 = _ffi "Posix_IO_write":
 	       fd * word8 vector * int * size -> ssize;
 	 end	       
 
-      structure ProcEnv =
-	 struct
-	    val numgroups = _const "Posix_ProcEnv_numgroups": int;
-	    val sysconfNames =
-	       [
-		(_const "Posix_ProcEnv_ARG_MAX": int;, "ARG_MAX"),
-		(_const "Posix_ProcEnv_CHILD_MAX": int;, "CHILD_MAX"),
-		(_const "Posix_ProcEnv_CLK_TCK": int;, "CLK_TCK"),
-		(_const "Posix_ProcEnv_STREAM_MAX": int;, "STREAM_MAX"),
-		(_const "Posix_ProcEnv_TZNAME_MAX": int;, "TZNAME_MAX"),
-		(_const "Posix_ProcEnv_OPEN_MAX": int;, "OPEN_MAX"),
-		(_const "Posix_ProcEnv_JOB_CONTROL": int;, "JOB_CONTROL"),
-		(_const "Posix_ProcEnv_SAVED_IDS": int;, "SAVED_IDS"),
-		(_const "Posix_ProcEnv_VERSION": int;, "VERSION"),
-		(_const "Posix_ProcEnv_BC_BASE_MAX": int;, "BC_BASE_MAX"),
-		(_const "Posix_ProcEnv_BC_DIM_MAX": int;, "BC_DIM_MAX"),
-		(_const "Posix_ProcEnv_BC_SCALE_MAX": int;, "BC_SCALE_MAX"),
-		(_const "Posix_ProcEnv_BC_STRING_MAX": int;, "BC_STRING_MAX"),
-		(_const "Posix_ProcEnv_COLL_WEIGHTS_MAX": int;,
-		 "COLL_WEIGHTS_MAX"),
-		(_const "Posix_ProcEnv_EXPR_NEST_MAX": int;, "EXPR_NEST_MAX"),
-		(_const "Posix_ProcEnv_LINE_MAX": int;, "LINE_MAX"),
-		(_const "Posix_ProcEnv_RE_DUP_MAX": int;, "RE_DUP_MAX"),
-		(_const "Posix_ProcEnv_2_VERSION": int;, "2_VERSION"),
-		(_const "Posix_ProcEnv_2_FORT_DEV": int;, "2_FORT_DEV"),
-		(_const "Posix_ProcEnv_2_FORT_RUN": int;, "2_FORT_RUN"),
-		(_const "Posix_ProcEnv_2_SW_DEV": int;, "2_SW_DEV")
-		]
-	       
-	    type pid = pid
-	    type gid = gid
-	    type uid = uid
-	    datatype file_desc = datatype file_desc
-
-	    val getegid = _ffi "Posix_ProcEnv_getegid": unit -> gid;
-	    val geteuid = _ffi "Posix_ProcEnv_geteuid": unit -> uid;
-	    val getgid = _ffi "Posix_ProcEnv_getgid": unit -> gid;
-	    val getgroups = _ffi "Posix_ProcEnv_getgroups": gid array -> int;
-	    val getlogin = _ffi "Posix_ProcEnv_getlogin": unit -> cstring;
-	    val getpgrp = _ffi "Posix_ProcEnv_getpgrp": unit -> pid;
-	    val getpid = _ffi "Posix_ProcEnv_getpid": unit -> pid;
-	    val getppid = _ffi "Posix_ProcEnv_getppid": unit -> pid;
-	    val getuid = _ffi "Posix_ProcEnv_getuid": unit -> uid;
-	    val setenv =
-	       _ffi "Posix_ProcEnv_setenv": nullString * nullString -> int;
-	    val setgid = _ffi "Posix_ProcEnv_setgid": gid -> int;
-	    val setpgid = _ffi "Posix_ProcEnv_setpgid": pid * pid -> int;
-	    val setsid = _ffi "Posix_ProcEnv_setsid": unit -> pid;
-	    val setuid = _ffi "Posix_ProcEnv_setuid": uid -> int;
-
-	    structure Uname =
-	       struct
-		  type uname = pointer
-
-		  val uname = _ffi "Posix_ProcEnv_Uname_uname": unit -> int;
-		  val sysname =
-		     _ffi "Posix_ProcEnv_Uname_sysname": unit -> cstring;
-		  val nodename =
-		     _ffi "Posix_ProcEnv_Uname_nodename": unit -> cstring;
-		  val release =
-		     _ffi "Posix_ProcEnv_Uname_release": unit -> cstring;
-		  val version =
-		     _ffi "Posix_ProcEnv_Uname_version": unit -> cstring;
-		  val machine =
-		     _ffi "Posix_ProcEnv_Uname_machine": unit -> cstring;
-	       end
-
-	    type clock_t = word
-	       
-	    structure Tms =
-	       struct
-		  val utime = _ffi "Posix_ProcEnv_Tms_utime": unit -> clock_t;
-		  val stime = _ffi "Posix_ProcEnv_Tms_stime": unit -> clock_t;
-		  val cutime = _ffi "Posix_ProcEnv_Tms_cutime": unit -> clock_t;
-		  val cstime = _ffi "Posix_ProcEnv_Tms_cstime": unit -> clock_t;
-	       end
-
-	    val ctermid = _ffi "Posix_ProcEnv_ctermid" : unit -> cstring;
-	    val environ = _ffi "Posix_ProcEnv_environ" : cstringArray;
-	    val getenv = _ffi "Posix_ProcEnv_getenv" : nullString -> cstring;
-	    val isatty = _ffi "Posix_ProcEnv_isatty" : fd -> bool;
-	    val sysconf = _ffi "Posix_ProcEnv_sysconf" : int -> int;
-	    val times = _ffi "Posix_ProcEnv_times" : unit -> clock_t;
-	    val ttyname = _ffi "Posix_ProcEnv_ttyname" : fd -> cstring;
-	 end 
-
-      structure Process =
-	 struct
-	    val wnohang = _const "Posix_Process_wnohang": word;
-	    structure W =
-	       struct
-		  type flags = word
-		  val untraced = _const "Posix_Process_W_untraced": flags;
-	       end
-	    
-	    type pid = pid
-	    type status = int
-
-	    val alarm = _ffi "Posix_Process_alarm": int -> int;
-	    val exece =
-	       _ffi "Posix_Process_exece"
-	       : nullString * nullString array * nullString array -> int;
-	    val execp =
-	       _ffi "Posix_Process_execp": nullString * nullString array -> int;
-	    val exit = _ffi "Posix_Process_exit": int -> unit;
-	    val exitStatus = _ffi "Posix_Process_exitStatus": status -> int;
-	    val fork = _ffi "Posix_Process_fork": unit -> pid;
-	    val ifExited = _ffi "Posix_Process_ifExited": status -> bool;
-	    val ifSignaled = _ffi "Posix_Process_ifSignaled": status -> bool;
-	    val ifStopped = _ffi "Posix_Process_ifStopped": status -> bool;
-	    val kill = _ffi "Posix_Process_kill": pid * signal -> int;
-	    val pause = _ffi "Posix_Process_pause": unit -> int;
-	    val sleep = _ffi "Posix_Process_sleep": int -> int;
-	    val stopSig = _ffi "Posix_Process_stopSig": status -> signal;
-	    val termSig = _ffi "Posix_Process_termSig": status -> signal;
-	    val waitpid =
-	       _ffi "Posix_Process_waitpid": pid * status ref * int -> pid;
-	 end
-      
-      structure Signal =
-	 struct
-	    type signal = signal
-      	    type how = int
-
-	    val abrt = _const "Posix_Signal_abrt": signal;
-	    val alrm = _const "Posix_Signal_alrm": signal;
-	    val bus = _const "Posix_Signal_bus": signal;
-	    val chld = _const "Posix_Signal_chld": signal;
-	    val cont = _const "Posix_Signal_cont": signal;
-	    val fpe = _const "Posix_Signal_fpe": signal;
-	    val hup = _const "Posix_Signal_hup": signal;
-	    val ill = _const "Posix_Signal_ill": signal;
-	    val int = _const "Posix_Signal_int": signal;
-	    val kill = _const "Posix_Signal_kill": signal;
-	    val pipe = _const "Posix_Signal_pipe": signal;
-	    val prof = _const "Posix_Signal_prof": signal;
-	    val quit = _const "Posix_Signal_quit": signal;
-	    val segv = _const "Posix_Signal_segv": signal;
-	    val stop = _const "Posix_Signal_stop": signal;
-	    val term = _const "Posix_Signal_term": signal;
-	    val tstp = _const "Posix_Signal_tstp": signal;
-	    val ttin = _const "Posix_Signal_ttin": signal;
-	    val ttou = _const "Posix_Signal_ttou": signal;
-	    val usr1 = _const "Posix_Signal_usr1": signal;
-	    val usr2 = _const "Posix_Signal_usr2": signal;
-	    val vtalrm = _const "Posix_Signal_vtalrm": signal;
-	       
-	    val block = _const "Posix_Signal_block": how;
-	    val default = _ffi "Posix_Signal_default": signal -> int;
-	    val handlee = _ffi "Posix_Signal_handle": signal -> int;
-	    val ignore = _ffi "Posix_Signal_ignore": signal -> int;
-	    val isDefault =
-	       _ffi "Posix_Signal_isDefault": signal * bool ref -> int;
-	    val isPending = _ffi "Posix_Signal_isPending": signal -> bool;
-	    val numSignals = _const "Posix_Signal_numSignals": int;
-	    val setmask = _const "Posix_Signal_setmask": how;
-	    val sigaddset = _ffi "Posix_Signal_sigaddset": signal -> int;
-	    val sigdelset = _ffi "Posix_Signal_sigdelset": signal -> int;
-	    val sigemptyset = _ffi "Posix_Signal_sigemptyset": unit -> int;
-	    val sigfillset = _ffi "Posix_Signal_sigfillset": unit -> int;
-	    val sigprocmask = _ffi "Posix_Signal_sigprocmask": how -> int;
-	    val suspend = _ffi "Posix_Signal_suspend": unit -> unit;
-	    val unblock = _const "Posix_Signal_unblock": how;
-	 end
-      
       structure SysDB =
 	 struct
 	    type gid = gid



1.2       +22 -22    mlton/basis-library/posix/proc-env.sig

Index: proc-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/proc-env.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- proc-env.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ proc-env.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -1,38 +1,38 @@
 signature POSIX_PROC_ENV =
    sig
-      eqtype file_desc
-      eqtype gid
       eqtype pid
       eqtype uid
+      eqtype gid
+      eqtype file_desc
 
-      val ctermid: unit -> string
-      val environ: unit -> string list 
-      val getegid: unit -> gid 
-      val getenv: string -> string option 
-      val geteuid: unit -> uid 
-      val getgid: unit -> gid 
+      val uidToWord: uid -> SysWord.word
+      val wordToUid: SysWord.word -> uid
+      val gidToWord: gid -> SysWord.word
+      val wordToGid: SysWord.word -> gid
+      val getpid : unit -> pid
+      val getppid: unit -> pid
+      val getuid : unit -> uid
+      val geteuid: unit -> uid
+      val getgid : unit -> gid
+      val getegid: unit -> gid
+      val setuid: uid -> unit
+      val setgid: gid -> unit
       val getgroups: unit -> gid list
       val getlogin: unit -> string
-      val getpgrp: unit -> pid 
-      val getpid: unit -> pid 
-      val getppid: unit -> pid 
-      val getuid: unit -> uid 
-      val gidToWord: gid -> SysWord.word 
-      val isatty: file_desc -> bool 
-      val setgid: gid -> unit
-      val setpgid: {pid: pid option, pgid: pid option} -> unit
+      val getpgrp: unit -> pid
       val setsid: unit -> pid
-      val setuid: uid -> unit
-      val sysconf: string -> SysWord.word
+      val setpgid: {pid: pid option, pgid: pid option} -> unit
+      val uname: unit -> (string * string) list
       val time: unit -> Time.time
       val times: unit -> {elapsed: Time.time,
 			  utime: Time.time,
 			  stime: Time.time,
 			  cutime: Time.time,
 			  cstime: Time.time}
+      val getenv: string -> string option
+      val environ: unit -> string list
+      val ctermid: unit -> string
       val ttyname: file_desc -> string
-      val uidToWord: uid -> SysWord.word 
-      val uname: unit -> (string * string) list
-      val wordToGid: SysWord.word -> gid 
-      val wordToUid: SysWord.word -> uid 
+      val isatty: file_desc -> bool
+      val sysconf: string -> SysWord.word
    end



1.4       +7 -19     mlton/basis-library/posix/proc-env.sml

Index: proc-env.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/proc-env.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- proc-env.sml	10 Apr 2002 07:02:17 -0000	1.3
+++ proc-env.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -29,22 +29,22 @@
 	 val setuid = Error.checkResult o setuid
       end
 
+      fun id x = x
+      val uidToWord = id 
+      val wordToUid = id
+      val gidToWord = id
+      val wordToGid = id
+
       local
 	 val a: word array = Primitive.Array.array Prim.numgroups
       in
 	 fun getgroups () =
 	    let val n = Prim.getgroups a
 	    in Error.checkResult n
-	       ; Array.prefixToList (a, n)
+	       ; ArraySlice.toList (ArraySlice.slice (a, 0, SOME n))
 	    end
       end
 
-      fun id x = x
-      val uidToWord = id 
-      val wordToUid = id
-      val gidToWord = id
-      val wordToGid = id
-
       fun getlogin () =
 	 let val cs = Prim.getlogin ()
 	 in if Primitive.Cpointer.isNull cs
@@ -86,18 +86,6 @@
       local
 	 structure Tms = Prim.Tms
 
-(*
-	 val ticksPerSecond: LargeInt.int =
-	    SysWord.toLargeInt (sysconf "CLK_TCK")
-
-	 val millisecondsPerSecond: LargeInt.int = 1000
-	    
-	 fun cvt (ticks: int): Time.time =
-	    Time.fromMilliseconds
-	    (LargeInt.div
-	     (LargeInt.fromInt ticks * millisecondsPerSecond,
-	      ticksPerSecond))
-*)
 	 val ticksPerSec = Real.fromInt (SysWord.toIntX (sysconf "CLK_TCK"))
 	 
 	 fun cvt (ticks: word) =



1.2       +9 -1      mlton/basis-library/posix/process.sig

Index: process.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- process.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ process.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -22,9 +22,11 @@
        | W_SIGNALED of signal
        | W_STOPPED of signal 
 
+      val fromStatus: OS.Process.status -> exit_status
+
       structure W :
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
             val untraced: flags 
 	 end
 
@@ -43,3 +45,9 @@
       val pause: unit -> unit 
       val sleep: Time.time -> Time.time 
    end
+
+signature POSIX_PROCESS_EXTRA = 
+   sig
+      include POSIX_PROCESS
+      type status
+   end
\ No newline at end of file



1.10      +23 -20    mlton/basis-library/posix/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- process.sml	10 Apr 2002 07:02:18 -0000	1.9
+++ process.sml	24 Nov 2002 01:19:39 -0000	1.10
@@ -5,7 +5,7 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure PosixProcess: POSIX_PROCESS =
+structure PosixProcess: POSIX_PROCESS_EXTRA =
    struct
       structure Prim = PosixPrimitive.Process
       open Prim
@@ -93,15 +93,27 @@
        | W_SAME_GROUP
        | W_GROUP of pid 
 
+      type status = status
       datatype exit_status =
 	 W_EXITED
        | W_EXITSTATUS of Word8.word
        | W_SIGNALED of signal
        | W_STOPPED of signal 
 
+      fun fromStatus status =
+	 if Prim.ifExited status
+	    then (case Prim.exitStatus status of
+		     0 => W_EXITED
+		   | n => W_EXITSTATUS (Word8.fromInt n))
+	 else if Prim.ifSignaled status
+	    then W_SIGNALED (Prim.termSig status)
+	 else if Prim.ifStopped status
+	    then W_STOPPED (Prim.stopSig status)
+	 else raise Fail "Posix.Process.fromStatus"
+
       structure W =
 	 struct
-	    open W PosixFlags
+	    open W BitFlags
 	 end
 
       local
@@ -113,31 +125,21 @@
 	    
 	 val status: status ref = ref 0
 
-	 fun getStatus () =
-	    let val status = !status
-	    in if Prim.ifExited status
-		  then (case Prim.exitStatus status of
-			   0 => W_EXITED
-			 | n => W_EXITSTATUS (Word8.fromInt n))
-	       else if Prim.ifSignaled status
-		       then W_SIGNALED (Prim.termSig status)
-	       else if Prim.ifStopped status
-		       then W_STOPPED (Prim.stopSig status)
-		    else raise Fail "Posix.Process.waitpid"
-	    end
+	 fun getStatus () = fromStatus (!status)
       in
 	 fun waitpid (wa, flags) =
 	    let val pid = Prim.waitpid (convertwa wa, status,
-				       SysWord.toInt (W.flags flags))
+					SysWord.toInt 
+					(W.flags flags))
 	    in Error.checkResult pid
 	       ; (pid, getStatus ())
 	    end
 
 	 fun waitpid_nh (wa, flags) =
 	    let
-	       val pid =
-		  Prim.waitpid (convertwa wa, status,
-			       SysWord.toInt (W.flags (wnohang :: flags)))
+	       val pid = Prim.waitpid (convertwa wa, status,
+				       SysWord.toInt 
+				       (W.flags (wnohang :: flags)))
 	    in Error.checkResult pid
 	       ; if pid = 0
 		    then NONE
@@ -169,8 +171,9 @@
 
       local
 	 fun wrap prim (t: Time.time): Time.time =
-	    Time.fromSeconds
-	    (LargeInt.fromInt (prim (LargeInt.toInt (Time.toSeconds t))))
+	    (Time.fromSeconds (LargeInt.fromInt 
+	    (prim 
+	    (LargeInt.toInt (Time.toSeconds t)))))
       in
 	 val alarm = wrap Prim.alarm
 	 val sleep = wrap Prim.sleep



1.2       +22 -21    mlton/basis-library/posix/signal.sig

Index: signal.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/signal.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- signal.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ signal.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -2,26 +2,27 @@
    sig
       eqtype signal
 
-      val toWord: signal -> SysWord.word 
-      val fromWord: SysWord.word -> signal 
-      val abrt: signal 
-      val alrm: signal 
-      val bus: signal 
-      val chld: signal 
-      val cont: signal 
-      val fpe: signal 
-      val hup: signal 
-      val ill: signal 
-      val int: signal 
-      val kill: signal 
-      val pipe: signal 
-      val quit: signal 
-      val segv: signal 
-      val term: signal 
-      val usr1: signal 
-      val usr2: signal 
-      val stop: signal 
-      val tstp: signal 
-      val ttin: signal 
+      val toWord: signal -> SysWord.word
+      val fromWord: SysWord.word -> signal
+
+      val abrt: signal
+      val alrm: signal
+      val bus: signal
+      val fpe: signal
+      val hup: signal
+      val ill: signal
+      val int: signal
+      val kill: signal
+      val pipe: signal
+      val quit: signal
+      val segv: signal
+      val term: signal
+      val usr1: signal
+      val usr2: signal
+      val chld: signal
+      val cont: signal
+      val stop: signal
+      val tstp: signal
+      val ttin: signal
       val ttou: signal
    end



1.2       +15 -15    mlton/basis-library/posix/tty.sig

Index: tty.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/tty.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- tty.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ tty.sig	24 Nov 2002 01:19:39 -0000	1.2
@@ -26,7 +26,7 @@
 
       structure I:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 	    val brkint: flags 
 	    val icrnl: flags 
 	    val ignbrk: flags 
@@ -42,13 +42,13 @@
 
       structure O:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 	    val opost: flags 
 	 end
 
       structure C:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 	    val clocal: flags 
 	    val cread: flags 
 	    val cs5: flags 
@@ -64,7 +64,7 @@
 
       structure L:
 	 sig
-	    include POSIX_FLAGS
+	    include BIT_FLAGS
 	    val echo: flags 
 	    val echoe: flags 
 	    val echok: flags 
@@ -150,16 +150,16 @@
 	    val iflush: queue_sel 
 	    val oflush: queue_sel 
 	    val ioflush: queue_sel 
-	 end
 
-      val getattr: file_desc -> termios
-      val setattr: file_desc * TC.set_action * termios -> unit
-	 
-      val sendbreak: file_desc * int -> unit
-      val drain: file_desc -> unit
-      val flush: file_desc * TC.queue_sel -> unit
-      val flow: file_desc * TC.flow_action -> unit
-       
-      val getpgrp: file_desc -> pid 
-      val setpgrp: file_desc * pid -> unit
+	    val getattr: file_desc -> termios
+	    val setattr: file_desc * set_action * termios -> unit
+
+	    val sendbreak: file_desc * int -> unit
+	    val drain: file_desc -> unit
+	    val flush: file_desc * queue_sel -> unit
+	    val flow: file_desc * flow_action -> unit
+
+	    val getpgrp: file_desc -> pid 
+	    val setpgrp: file_desc * pid -> unit
+	 end
    end



1.4       +44 -40    mlton/basis-library/posix/tty.sml

Index: tty.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/tty.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- tty.sml	10 Apr 2002 07:02:18 -0000	1.3
+++ tty.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -33,8 +33,7 @@
 
 	    fun update (a, l) =
 	       let val a' = new ()
-	       in Array.copy {src = a, si = 0, len = NONE,
-			     dst = a', di = 0}
+	       in Array.copy {src = a, dst = a', di = 0}
 		  ; updates (a', l)
 		  ; a'
 	       end
@@ -44,22 +43,22 @@
       
       structure I =
 	 struct
-	    open I PosixFlags
+	    open I BitFlags
 	 end
       
       structure O =
 	 struct
-	    open O PosixFlags
+	    open O BitFlags
 	 end
       
       structure C =
 	 struct
-	    open C PosixFlags
+	    open C BitFlags
 	 end
       
       structure L =
 	 struct
-	    open L PosixFlags
+	    open L BitFlags
 	 end
 
       type speed = Prim.speed
@@ -114,39 +113,44 @@
       
       structure Termios = Prim.Termios
 	 
-      fun getattr (FD fd) =
-	 (Error.checkResult (Prim.getattr (fd))
-	  ; {iflag = Termios.iflag (),
-	     oflag = Termios.oflag (),
-	     cflag = Termios.cflag (),
-	     lflag = Termios.lflag (),
-	     cc = Cstring.toCharArrayOfLength (Termios.cc (), V.nccs),
-	     ispeed = Termios.ispeed (),
-	     ospeed = Termios.ospeed ()})
-
-      fun setattr (FD fd, a, {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
-	 (Termios.setiflag iflag
-	  ; Termios.setoflag oflag
-	  ; Termios.setcflag cflag
-	  ; Termios.setlflag lflag
-	  ; Termios.setospeed ospeed
-	  ; Termios.setispeed ispeed
-	  ; let val cs = Termios.cc () 
-	    in Util.naturalForeach
-	       (V.nccs, fn i => Cstring.update (cs, i, V.sub (cc, i)))
-	    end
-	  ; Error.checkResult (Prim.setattr (fd, a)))
-
-      fun sendbreak (FD fd, n) =
-	 Error.checkResult (Prim.sendbreak (fd, n))
+      structure TC =
+	 struct
+	    open Prim.TC 
 
-      fun drain (FD fd) = Error.checkResult (Prim.drain fd)
-	 
-      fun flush (FD fd, n) = Error.checkResult (Prim.flush (fd, n))
-	 
-      fun flow (FD fd, n) = Error.checkResult (Prim.flow (fd, n))
-	 
-      fun getpgrp (FD fd) = Error.checkReturnResult (Prim.getpgrp fd)
-	 
-      fun setpgrp (FD fd, pid) = Error.checkResult (Prim.setpgrp (fd, pid))
+	    fun getattr (FD fd) =
+	       (Error.checkResult (Prim.getattr (fd))
+		; {iflag = Termios.iflag (),
+		   oflag = Termios.oflag (),
+		   cflag = Termios.cflag (),
+		   lflag = Termios.lflag (),
+		   cc = Cstring.toCharArrayOfLength (Termios.cc (), V.nccs),
+		   ispeed = Termios.ispeed (),
+		   ospeed = Termios.ospeed ()})
+	       
+	    fun setattr (FD fd, a, {iflag, oflag, cflag, lflag, cc, ispeed, ospeed}) =
+	       (Termios.setiflag iflag
+		; Termios.setoflag oflag
+		; Termios.setcflag cflag
+		; Termios.setlflag lflag
+		; Termios.setospeed ospeed
+		; Termios.setispeed ispeed
+		; let val cs = Termios.cc () 
+		  in Util.naturalForeach
+		     (V.nccs, fn i => Cstring.update (cs, i, V.sub (cc, i)))
+		  end
+		; Error.checkResult (Prim.setattr (fd, a)))
+
+	    fun sendbreak (FD fd, n) =
+	       Error.checkResult (Prim.sendbreak (fd, n))
+
+	    fun drain (FD fd) = Error.checkResult (Prim.drain fd)
+	      
+	    fun flush (FD fd, n) = Error.checkResult (Prim.flush (fd, n))
+	      
+	    fun flow (FD fd, n) = Error.checkResult (Prim.flow (fd, n))
+	      
+	    fun getpgrp (FD fd) = Error.checkReturnResult (Prim.getpgrp fd)
+	      
+	    fun setpgrp (FD fd, pid) = Error.checkResult (Prim.setpgrp (fd, pid))
+	 end
    end



1.4       +5 -5      mlton/basis-library/real/IEEE-real.sig

Index: IEEE-real.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/IEEE-real.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- IEEE-real.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ IEEE-real.sig	24 Nov 2002 01:19:39 -0000	1.4
@@ -4,10 +4,8 @@
       
       datatype real_order = LESS | EQUAL | GREATER | UNORDERED
 	 
-      datatype nan_mode = QUIET | SIGNALLING
-	 
       datatype float_class =
-	 NAN of nan_mode 
+	 NAN
        | INF
        | ZERO
        | NORMAL
@@ -22,12 +20,14 @@
       val setRoundingMode: rounding_mode -> unit 
       val getRoundingMode: unit -> rounding_mode
 	 
-      type decimal_approx = {kind: float_class,
+      type decimal_approx = {class: float_class,
 			     sign: bool,
 			     digits: int list,
 			     exp: int}
 	 
       val toString: decimal_approx -> string 
-(*      val fromString: string -> decimal_approx option*)
+      val scan: (char, 'a) StringCvt.reader 
+                -> (decimal_approx, 'a) StringCvt.reader
+      val fromString: string -> decimal_approx option
    end
 



1.5       +8 -6      mlton/basis-library/real/IEEE-real.sml

Index: IEEE-real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/IEEE-real.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- IEEE-real.sml	20 Jul 2002 23:14:01 -0000	1.4
+++ IEEE-real.sml	24 Nov 2002 01:19:39 -0000	1.5
@@ -9,10 +9,9 @@
    struct
       exception Unordered
       datatype real_order = LESS | EQUAL | GREATER | UNORDERED
-      datatype nan_mode = QUIET | SIGNALLING
 
       datatype float_class =
-	 NAN of nan_mode 
+	 NAN
        | INF
        | ZERO
        | NORMAL
@@ -42,12 +41,12 @@
       val setRoundingMode = Prim.setRoundingMode o rounding_modeToInt
       val getRoundingMode = intToRounding_mode o Prim.getRoundingMode
 	       
-      type decimal_approx = {kind: float_class,
+      type decimal_approx = {class: float_class,
 			     sign: bool,
 			     digits: int list,
 			     exp: int}
 
-      fun toString{kind, sign, digits, exp}: string =
+      fun toString {class, sign, digits, exp}: string =
 	 let
 	    fun digitStr() = implode(map StringCvt.digitToChar digits)
 	    fun norm() =
@@ -57,15 +56,18 @@
 		  else concat[num, "E", Int.toString exp]
 	       end
 	    val num =
-	       case kind of
+	       case class of
 		  ZERO => "0.0"
 		| NORMAL => norm()
 		| SUBNORMAL => norm()
 		| INF => "inf"
-		| NAN _ => concat["nan(", digitStr(), ")"]
+		| NAN => "nan"
 	 in if sign
 	       then "~" ^ num
 	    else num
 	 end
+
+      val scan = fn _ => raise (Fail "<IEEEReal.scan not implemented>")
+      fun fromString s = StringCvt.scanString scan s
    end
 



1.5       +10 -10    mlton/basis-library/real/math.sig

Index: math.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/math.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- math.sig	20 Jul 2002 23:14:01 -0000	1.4
+++ math.sig	24 Nov 2002 01:19:39 -0000	1.5
@@ -2,21 +2,21 @@
    sig
       type real
 	
-      val acos: real -> real 
+      val pi: real 
+      val e: real
+      val sqrt: real -> real 
+      val sin: real -> real 
+      val cos: real -> real 
+      val tan: real -> real 
       val asin: real -> real 
-      val atan2: real * real -> real 
+      val acos: real -> real 
       val atan: real -> real 
-      val cos: real -> real 
-      val cosh: real -> real 
-      val e: real
+      val atan2: real * real -> real 
       val exp: real -> real 
+      val pow: real * real -> real 
       val ln: real -> real 
       val log10: real -> real 
-      val pi: real 
-      val pow: real * real -> real 
-      val sin: real -> real 
       val sinh: real -> real 
-      val sqrt: real -> real 
-      val tan: real -> real 
+      val cosh: real -> real 
       val tanh: real -> real 
    end



1.4       +3 -3      mlton/basis-library/real/pack-real.sig

Index: pack-real.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/pack-real.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- pack-real.sig	20 Jul 2002 23:14:01 -0000	1.3
+++ pack-real.sig	24 Nov 2002 01:19:39 -0000	1.4
@@ -3,10 +3,10 @@
       type real
 
       val bytesPerElem: int 
-      val fromBytes: Word8Vector.vector -> real 
       val isBigEndian: bool 
-      val subArr: Word8Array.array * int -> real 
-      val subVec: Word8Vector.vector * int -> real 
       val toBytes: real -> Word8Vector.vector 
+      val fromBytes: Word8Vector.vector -> real 
+      val subVec: Word8Vector.vector * int -> real 
+      val subArr: Word8Array.array * int -> real 
       val update: Word8Array.array * int * real -> unit
    end



1.4       +2 -0      mlton/basis-library/real/pack-real.sml

Index: pack-real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/pack-real.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- pack-real.sml	20 Jul 2002 23:14:01 -0000	1.3
+++ pack-real.sml	24 Nov 2002 01:19:39 -0000	1.4
@@ -29,3 +29,5 @@
 fun subArr (a, i) = subVec (Primitive.Vector.fromArray a, i)
    
 end
+
+structure PackRealLittle = PackReal64Little



1.5       +62 -57    mlton/basis-library/real/real.sig

Index: real.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- real.sig	2 Nov 2002 03:37:35 -0000	1.4
+++ real.sig	24 Nov 2002 01:19:39 -0000	1.5
@@ -1,3 +1,8 @@
+structure Real =
+   struct
+      type real = real
+   end
+
 structure LargeReal =
    struct
       type real = real
@@ -5,74 +10,74 @@
 
 signature REAL_GLOBAL =
    sig
-     structure Math: MATH
      type real
+     structure Math: MATH where type real = real
 
-     val ceil: real -> Int.int
-     val floor: real -> Int.int 
      val round: real -> Int.int
      val trunc: real -> Int.int 
+     val ceil: real -> Int.int
+     val floor: real -> Int.int 
    end
 
 signature REAL =
    sig
       include REAL_GLOBAL
 
-      val != : real * real -> bool 
-      val * : real * real -> real 
-      val *+ : real * real * real -> real 
-      val *- : real * real * real -> real 
-      val + : real * real -> real 
-      val - : real * real -> real 
-      val / : real * real -> real 
-      val < : real * real -> bool 
-      val <= : real * real -> bool 
-      val == : real * real -> bool 
-      val > : real * real -> bool 
-      val >= : real * real -> bool 
-      val ?= : real * real -> bool 
-      val abs: real -> real 
-      val checkFloat: real -> real 
-      val class: real -> IEEEReal.float_class 
-      val compare: real * real -> order 
-      val compareReal: real * real -> IEEEReal.real_order
-      val copySign: real * real -> real 
-      val fmt: StringCvt.realfmt -> real -> string 
-      val fromInt: int -> real 
-      val fromLarge: IEEEReal.rounding_mode -> LargeReal.real -> real 
-      val fromLargeInt: LargeInt.int -> real
-      val fromManExp: {man: real, exp: int} -> real 
-      val fromString: string -> real option
-      val isFinite: real -> bool 
-      val isNan: real -> bool 
-      val isNormal: real -> bool 
-      val max: real * real -> real 
-      val maxFinite: real 
-      val min: real * real -> real 
-      val minNormalPos: real 
-      val minPos: real 
+      val radix: int
+      val precision: int
+      val maxFinite: real
+      val minPos: real
+      val minNormalPos: real
+      val posInf: real
       val negInf: real
-      val posInf: real 
-      val precision: int 
-      val radix: int 
-      val realCeil: real -> real 
-      val realFloor: real -> real 
-      val realMod: real -> real 
-      val realTrunc: real -> real 
-      val rem: real * real -> real 
-      val sameSign: real * real -> bool 
+      val + : real * real -> real
+      val - : real * real -> real
+      val * : real * real -> real
+      val / : real * real -> real
+      val rem: real * real -> real
+      val *+ : real * real * real -> real
+      val *- : real * real * real -> real
+      val ~ : real -> real
+      val abs: real -> real
+      val min: real * real -> real
+      val max: real * real -> real
+      val sign: real -> int
+      val signBit: real -> bool
+      val sameSign: real * real -> bool
+      val copySign: real * real -> real
+      val compare: real * real -> order
+      val compareReal: real * real -> IEEEReal.real_order
+      val <  : real * real -> bool
+      val <= : real * real -> bool
+      val >  : real * real -> bool
+      val >= : real * real -> bool
+      val == : real * real -> bool
+      val != : real * real -> bool
+      val ?= : real * real -> bool
+      val unordered: real * real -> bool
+      val isFinite: real -> bool
+      val isNan: real -> bool
+      val isNormal: real -> bool
+      val class: real -> IEEEReal.float_class
+      val fmt: StringCvt.realfmt -> real -> string
+      val toString: real -> string
       val scan: (char, 'a) StringCvt.reader -> (real, 'a) StringCvt.reader
-      val sign: real -> int 
-      val signBit: real -> bool 
-      val split: real -> {whole: real, frac: real} 
-      val toInt: IEEEReal.rounding_mode -> real -> int 
-      val toLarge: real -> LargeReal.real 
+      val fromString: string -> real option
+      val toManExp: real -> {man: real, exp: int}
+      val fromManExp: {man: real, exp: int} -> real
+      val split: real -> {whole: real, frac: real}
+      val realMod: real -> real
+      val nextAfter: real * real -> real
+      val checkFloat: real -> real
+      val realFloor: real -> real
+      val realCeil: real -> real
+      val realTrunc: real -> real
+      val toInt: IEEEReal.rounding_mode -> real -> int
       val toLargeInt: IEEEReal.rounding_mode -> real -> LargeInt.int
-      val toManExp: real -> {man: real, exp: int} 
-      val toString: real -> string 
-      val unordered: real * real -> bool 
-      val ~ : real -> real 
-(*     val nextAfter: real * real -> real *)
-(*     val toDecimal: real -> IEEEReal.decimal_approx  *)
-(*     val fromDecimal: IEEEReal.decimal_approx -> real *)
+      val fromInt: int -> real
+      val fromLargeInt: LargeInt.int -> real
+      val toLarge: real -> LargeReal.real
+      val fromLarge: IEEEReal.rounding_mode -> LargeReal.real -> real
+      val toDecimal: real -> IEEEReal.decimal_approx
+      val fromDecimal: IEEEReal.decimal_approx -> real option
    end



1.15      +34 -12    mlton/basis-library/real/real.sml

Index: real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/real.sml,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- real.sml	2 Nov 2002 03:37:35 -0000	1.14
+++ real.sml	24 Nov 2002 01:19:39 -0000	1.15
@@ -7,7 +7,7 @@
  *
  *)
 
-structure Real: REAL =
+structure Real64: REAL =
    struct
       structure Real = Primitive.Real
       open Real IEEEReal
@@ -81,8 +81,8 @@
       (* See runtime/basis/Real.c for the integers returned by class. *)
       fun class x =
 	 case Real.class x of
-	    0 => NAN QUIET
-	  | 1 => NAN SIGNALLING
+	    0 => NAN (* QUIET *)
+	  | 1 => NAN (* SIGNALLING *)
 	  | 2 => INF
 	  | 3 => ZERO
 	  | 4 => NORMAL
@@ -145,7 +145,7 @@
 					    Real.toInt (Real.round x))
 	 in
 	    case class x of
-	       NAN _ => raise Domain
+	       NAN => raise Domain
 	     | INF => raise Overflow
 	     | ZERO => 0
 	     | NORMAL =>
@@ -188,7 +188,7 @@
       local
 	 fun round mode x =
 	    case class x of
-	       NAN _ => x
+	       NAN => x
 	     | INF => x
 	     | _ => withRoundingMode (mode, fn () => Real.round x)
       in
@@ -251,7 +251,7 @@
 		   | EXACT => raise Fail "Real.fmt EXACT unimplemented"
 	    in fn x =>
 	       case class x of
-		  NAN _ => "nan" (* this is wrong *)
+		  NAN => "nan"
 		| INF => if x > 0.0 then "inf" else "~inf"
 		| ZERO => "0.0"
 		| _ => 
@@ -266,8 +266,7 @@
 			val res = 
 			   String.translate
 			   (fn #"-" => "~" | c => str c)
-			   (Primitive.String.fromCharVector
-			    (Array.extract (buffer, 0, SOME len)))
+			   (Array.extract (buffer, 0, SOME len))
 		     in res
 		     end
 	    end
@@ -330,6 +329,23 @@
 		| SOME (#"~", rest) => (false, rest)
 		| _                => (true,  src )
 
+	    fun sym src =
+	       case getc src of
+		  SOME (#"i", restA) => 
+		    (case Reader.reader2 getc restA of
+		       SOME ((#"n", #"f"), restB) =>
+			 SOME (posInf, 
+			       case Reader.readerN (getc, 5) restB of
+				 SOME ([#"i", #"n", #"i", #"t", #"y"], restC) => restC
+			       | _ => restB)
+		     | _ => NONE)
+		| SOME (#"n", restA) =>
+		    (case Reader.reader2 getc restA of
+		       SOME ((#"a", #"n"), restB) =>
+			 SOME (nan, restB)
+		     | _ => NONE)
+		| _ => NONE
+
 	    val src = StringCvt.dropl Char.isSpace getc source
 	    val (manpos, src1) = sign src
 	    val (intg,   src2) = getint src1
@@ -358,7 +374,9 @@
 	     | (SOME ival, true,  NONE     ) => mkres ival src2
 	     | (SOME ival, false, NONE     ) => expopt ival src2
 	     | (SOME ival, _    , SOME fval) => expopt (ival+fval) src4
-	     | _                             => NONE 
+	     | _                             => (case sym src1 of
+						   SOME (v, rest) => mkres v rest
+						 | NONE => NONE)
 	 end
 
       fun fromString s = StringCvt.scanString scan s
@@ -481,10 +499,14 @@
 		      else IntInf.~ (pos (~ x, negateMode mode))
 		   end)
       end
-   end
 
+      val toDecimal = fn _ => raise (Fail "<Real.toDecimal not implemented>")
+      val fromDecimal = fn _ => raise (Fail "<Real.fromDecimal not implemented>")
+      val nextAfter = fn _ => raise (Fail "<Real.nextAfter not implemented>")
+  end
+
+structure Real = Real64   
+structure LargeReal = Real64
 structure RealGlobal: REAL_GLOBAL = Real
 open RealGlobal
 val real = Real.fromInt
-   
-structure LargeReal: REAL = Real



1.3       +1 -6      mlton/basis-library/sml-nj/unsafe.sml

Index: unsafe.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/sml-nj/unsafe.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- unsafe.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ unsafe.sml	24 Nov 2002 01:19:40 -0000	1.3
@@ -18,12 +18,7 @@
 	    val update = Primitive.Array.update
 	    val create = Array.array
 	 end
-      structure CharVector =
-	 struct
-	    type vector = string
-	    type elem = char
-	    val sub = Primitive.String.sub
-	 end
+      structure CharVector = UnsafeMonoVector(type elem = char)
       structure Word8Vector = UnsafeMonoVector(type elem = word8)
       structure CharArray = UnsafeMonoArray(type elem = char)
       structure Word8Array = UnsafeMonoArray(type elem = word8)



1.2       +1 -1      mlton/basis-library/system/date.sig

Index: date.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/date.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- date.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ date.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -35,6 +35,6 @@
       val toString: date -> string 
       val fmt: string -> date -> string 
       val fromString: string -> date option 
-      val scan: (char, 'a) StringCvt.reader -> 'a -> (date * 'a) option
+      val scan: (char, 'a) StringCvt.reader -> (date, 'a) StringCvt.reader
       val compare: date * date -> order
    end



1.6       +62 -14    mlton/basis-library/system/date.sml

Index: date.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/date.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- date.sml	16 Oct 2001 20:13:35 -0000	1.5
+++ date.sml	24 Nov 2002 01:19:40 -0000	1.6
@@ -34,8 +34,8 @@
 	wday   : weekday,
 	yday   : int,		        (* 0-365 *)
 	isDst  : bool option,		(* daylight savings time in force *)
-	offset : int option			(* signed seconds East of UTC: this 
-					       zone = UTC+t; ~43200 < t <= 43200 *)
+	offset : int option		(* signed seconds East of UTC:
+				           this zone = UTC+t; ~82800 < t <= 82800 *)
       }
 
     exception Date
@@ -307,8 +307,7 @@
 					    concat ["%", str fmtChar, "\000"])
 		in if len = 0
 		      then raise Fail "Date.fmt"
-		   else Primitive.String.fromCharVector (Array.extract
-							 (buf, 0, SOME len))
+		   else Array.extract (buf, 0, SOME len)
 		end
 	     val max = size fmtStr
 	     fun loop (i, start, accum) =
@@ -358,15 +357,64 @@
 	fun drop p     = StringCvt.dropl p getc
 	fun isColon c  = (c = #":")
 
-	val getMonth = fn "Jan" => Jan | "Feb" => Feb | "Mar" => Mar
-                     | "Apr" => Apr | "May" => May | "Jun" => Jun
-		     | "Jul" => Jul | "Aug" => Aug | "Sep" => Sep
-		     | "Oct" => Oct | "Nov" => Nov | "Dec" => Dec 
-		     | _ => raise BadFormat
-	val getWday  = fn "Sun" => Sun | "Mon" => Mon | "Tue" => Tue
-		     | "Wed" => Wed | "Thu" => Thu | "Fri" => Fri
-		     | "Sat" => Sat 
-		     | _ => raise BadFormat
+	local
+	   fun err () = raise BadFormat
+	   fun check1 (s, c1, r) = if String.sub(s,1) = c1
+	                              then r
+				   else err ()
+	   fun check2 (s, c2, r) = if String.sub(s,2) = c2
+	                              then r
+				   else err ()
+	   fun check12 (s, c1, c2, r) = if String.sub(s,1) = c1
+	                                   andalso 
+					   String.sub(s,2) = c2
+					   then r
+					else err ()
+ 	in
+	  val getMonth = fn m =>
+	     if String.size m <> 3
+	        then err ()
+	     else
+	        (case String.sub (m, 0) of
+		    #"J" => (case String.sub (m, 1) of
+			        #"a" => check2 (m, #"n", Jan)
+			      | #"u" => (case String.sub (m, 2) of
+					    #"n" => Jun
+					  | #"l" => Jul
+					  | _ => err ())
+			      | _ => err ())
+		  | #"F" => check12 (m, #"e", #"b", Feb)
+		  | #"M" => check1 (m, #"a", case String.sub (m, 2) of
+				                #"r" => Mar
+					      | #"y" => May
+					      | _ => err ())
+		  | #"A" => (case String.sub (m, 1) of
+			        #"p" => check2 (m, #"r", Apr)
+			      | #"u" => check2 (m, #"g", Aug)
+			      | _ => err ())
+		  | #"S" => check12 (m, #"e", #"p", Sep)
+		  | #"O" => check12 (m, #"c", #"t", Oct)
+		  | #"N" => check12 (m, #"o", #"v", Nov)
+		  | #"D" => check12 (m, #"e", #"c", Dec)
+		  | _ => err ())
+	  val getWday = fn w =>
+	     if String.size w <> 3
+	        then err ()
+	     else
+	        (case String.sub (w, 0) of
+		    #"S" => (case String.sub (w,1) of
+			        #"u" => check2 (w, #"n", Sun)
+			      | #"a" => check2 (w, #"t", Sat)
+			      | _ => err ())
+		  | #"M" => check12 (w, #"o", #"n", Mon)
+		  | #"T" => (case String.sub (w,1) of
+			        #"u" => check2 (w, #"e", Tue)
+			      | #"h" => check2 (w, #"u", Thu)
+			      | _ => err ())
+		  | #"W" => check12 (w, #"e", #"d", Wed)
+		  | #"F" => check12 (w, #"r", #"i", Fri)
+		  | _ => err ())
+	end
 
 	val (wday, src1)  = getstring src
 	val (month, src2) = getstring (drop Char.isSpace src1)
@@ -414,7 +462,7 @@
 		  | SOME time => 
 			let val secs      = Time.toSeconds time
 			    val secoffset = 
-				if secs <= 43200 then ~secs else 86400 - secs
+				if secs <= 82800 then ~secs else 86400 - secs
 			in (Int.quot (secs, 86400), SOME secoffset) end
 		val day' = day + dayoffset
 	    in



1.2       +24 -26    mlton/basis-library/system/file-sys.sig

Index: file-sys.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/file-sys.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- file-sys.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ file-sys.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -2,36 +2,34 @@
    sig
       type dirstream
 
-      val openDir: string -> dirstream 
-      val readDir: dirstream -> string 
-      val rewindDir: dirstream -> unit 
-      val closeDir: dirstream -> unit 
+      val openDir: string -> dirstream
+      val readDir: dirstream -> string option
+      val rewindDir: dirstream -> unit
+      val closeDir: dirstream -> unit
       val chDir: string -> unit
 
-      val getDir: unit -> string 
-      val mkDir: string -> unit 
-      val rmDir: string -> unit 
-      val isDir: string -> bool 
-      val isLink: string -> bool 
-      val readLink: string -> string 
-      val fullPath: string -> string 
-      val realPath: string -> string 
-      val modTime: string -> Time.time 
-      val fileSize: string -> Position.int 
-      val setTime: string * Time.time option -> unit 
-      val remove: string -> unit 
+      val getDir: unit -> string
+      val mkDir: string -> unit
+      val rmDir: string -> unit
+      val isDir: string -> bool
+      val isLink: string -> bool
+      val readLink: string -> string
+      val fullPath: string -> string
+      val realPath: string -> string
+      val modTime: string -> Time.time
+      val fileSize: string -> Position.int
+      val setTime: string * Time.time option -> unit
+      val remove: string -> unit
       val rename: {old: string, new: string} -> unit
-	 
-      datatype access_mode =
-	 A_READ
-       | A_WRITE
-       | A_EXEC
-	 
-      val access: string * access_mode list -> bool 
-      val tmpName: unit -> string 
+
+      datatype access_mode = A_READ | A_WRITE | A_EXEC
+
+      val access: string * access_mode list -> bool
+      val tmpName: unit -> string
 
       eqtype file_id
-      val fileId: string -> file_id 
-      val hash: file_id -> word 
+      val fileId: string -> file_id
+      val hash: file_id -> word
       val compare: file_id * file_id -> order
    end
+



1.2       +25 -22    mlton/basis-library/system/file-sys.sml

Index: file-sys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/file-sys.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- file-sys.sml	18 Jul 2001 05:51:02 -0000	1.1
+++ file-sys.sml	24 Nov 2002 01:19:40 -0000	1.2
@@ -46,26 +46,30 @@
 	    val oldCWD = getDir()
 	    fun mkPath pathFromRoot =
 	       P.toString{isAbs=true, vol="", arcs=List.rev pathFromRoot}
-	    fun walkPath (0, _, _) =
-	       raise PosixError.SysErr("too many links", NONE)
-	      | walkPath (n, pathFromRoot, []) =
-		mkPath pathFromRoot
-	      | walkPath (n, pathFromRoot, "" :: al) =
-		walkPath (n, pathFromRoot, al)
-	      | walkPath (n, pathFromRoot, "." :: al) =
-		walkPath (n, pathFromRoot, al)
-	      | walkPath (n, [], ".." :: al) =
-		walkPath (n, [], al)
-	      | walkPath (n, _ :: r, ".." :: al) =
-		(chDir ".."; walkPath (n, r, al))
-	      | walkPath (n, pathFromRoot, [arc]) =
-		if (isLink arc)
-		   then expandLink (n, pathFromRoot, arc, [])
-		else mkPath (arc :: pathFromRoot)
-	      | walkPath (n, pathFromRoot, arc :: al) =
-		if (isLink arc)
-		   then expandLink (n, pathFromRoot, arc, al)
-		else (chDir arc; walkPath (n, arc :: pathFromRoot, al))
+	    fun walkPath (n, pathFromRoot, arcs) =
+	       if n = 0
+		  then raise PosixError.SysErr ("too many links", NONE)
+	       else
+		  case arcs of
+		     [] => mkPath pathFromRoot
+		   | arc :: al =>
+			if arc = "" orelse arc = "."
+			   then walkPath (n, pathFromRoot, al)
+			else if arc = ".."
+				then
+				   (case pathFromRoot of
+				       [] => walkPath (n, [], al)
+				     | _ :: r =>
+					  (chDir ".."; walkPath (n, r, al)))
+		        else
+			   if isLink arc
+			      then expandLink (n, pathFromRoot, arc, [])
+			   else
+			      case al of
+				 [] => mkPath (arc :: pathFromRoot)
+			       | _ =>
+				    (chDir arc
+				     ; walkPath (n, arc :: pathFromRoot, al))
 	    and expandLink (n, pathFromRoot, link, rest) =
 	       (
 		case (P.fromString(readLink link))
@@ -133,8 +137,7 @@
 				}
 			 end
 
-      fun hash (FID{dev, ino}) = sysWordToWord(
-					       SysWord.+(SysWord.<<(dev, 0w16), ino))
+      fun hash (FID{dev, ino}) = sysWordToWord(SysWord.+(SysWord.<<(dev, 0w16), ino))
 
       fun compare (FID{dev=d1, ino=i1}, FID{dev=d2, ino=i2}) =
 	 if (SysWord.<(d1, d2))



1.2       +22 -30    mlton/basis-library/system/io.sig

Index: io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ io.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,40 +1,32 @@
 signature OS_IO =
    sig
       eqtype iodesc
-
-      val hash: iodesc -> word 
-      val compare: (iodesc * iodesc) -> order 
-
+      val hash: iodesc -> word
+      val compare: iodesc * iodesc -> order
       eqtype iodesc_kind
-
-      val kind: iodesc -> iodesc_kind 
-
-      structure Kind:
+      val kind: iodesc -> iodesc_kind
+      structure Kind: 
 	 sig
-	    val file: iodesc_kind 
-	    val dir: iodesc_kind 
-	    val symlink: iodesc_kind 
-	    val tty: iodesc_kind 
-	    val pipe: iodesc_kind 
-	    val socket: iodesc_kind 
-	    val device: iodesc_kind 
+	    val file: iodesc_kind
+	    val dir: iodesc_kind
+	    val symlink: iodesc_kind
+	    val tty: iodesc_kind
+	    val pipe: iodesc_kind
+	    val socket: iodesc_kind
+	    val device: iodesc_kind
 	 end
-(*		    
-      type poll_desc
-      type poll_info
-
-      val pollDesc: iodesc -> poll_desc option 
-      val pollToIODesc: poll_desc -> iodesc 
 
+      eqtype poll_desc
+      type poll_info
+      val pollDesc: iodesc -> poll_desc option
+      val pollToIODesc: poll_desc -> iodesc
       exception Poll
-
-      val pollIn: poll_desc -> poll_desc 
-      val pollOut: poll_desc -> poll_desc 
-      val pollPri: poll_desc -> poll_desc 
-      val poll: poll_desc list * Time.time option -> poll_info list 
-      val isIn: poll_info -> bool 
-      val isOut: poll_info -> bool 
-      val isPri: poll_info -> bool 
+      val pollIn: poll_desc -> poll_desc
+      val pollOut: poll_desc -> poll_desc
+      val pollPri: poll_desc -> poll_desc
+      val poll: poll_desc list * Time.time option -> poll_info list
+      val isIn: poll_info -> bool
+      val isOut: poll_info -> bool
+      val isPri: poll_info -> bool
       val infoToPollDesc: poll_info -> poll_desc
-*)
    end



1.2       +36 -21    mlton/basis-library/system/io.sml

Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/io.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sml	18 Jul 2001 05:51:02 -0000	1.1
+++ io.sml	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,4 +1,6 @@
 (* modified from SML/NJ sources by Stephen Weeks 1998-6-25 *)
+(* modified by Matthew Fluet 2002-10-11 *)
+(* modified by Matthew Fluet 2002-11-21 *)
 
 (* os-io.sml
  *
@@ -15,15 +17,15 @@
   (* an iodesc is an abstract descriptor for an OS object that
    * supports I/O (e.g., file, tty device, socket, ...).
    *)
-    type iodesc = int (* sweeks OS.IO.iodesc *)
+    datatype iodesc = datatype PreOS.IO.iodesc
 
     datatype iodesc_kind = K of string
 
   (* return a hash value for the I/O descriptor. *)
-    fun hash (fd) = Word.fromInt fd
+    fun hash (FD fd) = Word.fromInt fd
 
   (* compare two I/O descriptors *)
-    fun compare (fd1, fd2) = Int.compare(fd1, fd2)
+    fun compare (FD fd1, FD fd2) = Int.compare(fd1, fd2)
 
     structure Kind =
       struct
@@ -38,7 +40,6 @@
 
   (* return the kind of I/O descriptor *)
     fun kind (fd) = let
-	  val fd = Posix.FileSys.wordToFD(SysWord.fromInt fd)
 	  val stat = Posix.FileSys.fstat fd
 	  in
 	    if      (Posix.FileSys.ST.isReg stat) then Kind.file
@@ -50,7 +51,7 @@
 	    else if (Posix.FileSys.ST.isSock stat) then Kind.socket
 	    else K "UNKNOWN"
 	  end
-(*
+
     type poll_flags = {rd: bool, wr: bool, pri: bool}
     datatype poll_desc = PollDesc of (iodesc * poll_flags)
     datatype poll_info = PollInfo of (iodesc * poll_flags)
@@ -78,30 +79,45 @@
 
   (* polling function *)
     local
-      val poll': ((int * word) list * (Int32.int * int) option) -> (int * word) list =
-	    CInterface.c_function "POSIX-OS" "poll"
+      structure Prim = Primitive.OS.IO
       fun join (false, _, w) = w
         | join (true, b, w) = Word.orb(w, b)
       fun test (w, b) = (Word.andb(w, b) <> 0w0)
-      val rdBit = 0w1 and wrBit = 0w2 and priBit = 0w4
-      fun fromPollDesc (PollDesc(fd, {rd, wr, pri})) =
+      val rdBit : Word.word = 0w1 
+      and wrBit : Word.word = 0w2 
+      and priBit : Word.word = 0w4
+      fun fromPollDesc (PollDesc(FD fd, {rd, wr, pri})) =
 	    ( fd,
-	      join (rd, rdBit, join (wr, wrBit, join (pri, priBit, 0w0)))
+	      join (rd, rdBit, 
+	      join (wr, wrBit, 
+              join (pri, priBit, 0w0)))
 	    )
-      fun toPollInfo (fd, w) = PollInfo(fd, {
-	      rd = test(w, rdBit), wr = test(w, wrBit), pri = test(w, priBit)
+      fun toPollInfo (fd, w) = PollInfo(FD fd, {
+	      rd = test(w, rdBit), 
+	      wr = test(w, wrBit), 
+              pri = test(w, priBit)
 	    })
     in
     fun poll (pds, timeOut) = let
-	  val timeOut =
+	  val (fds, eventss) = ListPair.unzip (List.map fromPollDesc pds)
+	  val fds = Vector.fromList fds
+	  val n = Vector.length fds
+	  val eventss = Vector.fromList eventss
+          val timeOut =
 	     case timeOut of
-		(* sweeks *)
-		SOME(Time.T{sec, usec}) => SOME(sec, Int.fromLarge usec)
-		  | NONE => NONE
-		(* end case *))
-	  val info = poll' (List.map fromPollDesc pds, timeOut)
+	        SOME t => Int.fromLarge (Time.toMilliseconds t)
+	      | NONE => ~1
+	  val reventss = Array.array (n, 0w0)
+	  val _ = Posix.Error.checkResult 
+                  (Prim.poll (fds, eventss, n, timeOut, reventss))
 	  in
-	    List.map toPollInfo info
+	    Array.foldri
+	    (fn (i, w, l) => 
+	     if w <> 0w0
+	       then (toPollInfo (Vector.sub (fds, i), w))::l
+	       else l)
+	    []
+	    reventss
 	  end
     end (* local *)
 
@@ -109,8 +125,7 @@
     fun isIn (PollInfo(_, flgs)) = #rd flgs
     fun isOut (PollInfo(_, flgs)) = #wr flgs
     fun isPri (PollInfo(_, flgs)) = #pri flgs
-    fun infoToPollDesc  (PollInfo arg) = PollDesc arg
-*)
+    fun infoToPollDesc (PollInfo arg) = PollDesc arg
   end (* OS_IO *)
 
 



1.2       +5 -8      mlton/basis-library/system/os.sig

Index: os.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/os.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- os.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ os.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,15 +1,12 @@
 signature OS =
    sig
-      eqtype syserror
-
-      exception SysErr of string * syserror option
-
-      val errorMsg: syserror -> string 
-      val errorName: syserror -> string
-      val syserror: string -> syserror option
-	 
       structure FileSys: OS_FILE_SYS
       structure Path: OS_PATH
       structure Process: OS_PROCESS
       structure IO: OS_IO
+      eqtype syserror
+      exception SysErr of string * syserror option
+      val errorMsg: syserror -> string
+      val errorName: syserror -> string
+      val syserror: string -> syserror option
    end



1.3       +1 -2      mlton/basis-library/system/os.sml

Index: os.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/os.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- os.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ os.sml	24 Nov 2002 01:19:40 -0000	1.3
@@ -7,10 +7,9 @@
  *)
 structure OS: OS =
    struct
-      open PosixError
-
       structure FileSys = OS_FileSys
       structure Path = OS_Path
       structure Process = OS_Process
       structure IO = OS_IO
+      open PosixError
    end



1.4       +26 -30    mlton/basis-library/system/path.sig

Index: path.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/path.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- path.sig	4 Jun 2002 21:21:19 -0000	1.3
+++ path.sig	24 Nov 2002 01:19:40 -0000	1.4
@@ -1,35 +1,31 @@
 signature OS_PATH =
    sig
       exception Path
-(*      exception InvalidArc *)
+      exception InvalidArc
+      val parentArc: string
+      val currentArc: string
+      val validVolume: {isAbs: bool, vol: string} -> bool
+      val fromString: string -> {isAbs: bool, vol: string, arcs: string list}
+      val toString: {isAbs: bool, vol: string, arcs: string list} -> string
+      val getVolume: string -> string
+      val getParent: string -> string
+      val splitDirFile: string -> {dir: string, file: string}
+      val joinDirFile: {dir: string, file: string} -> string
+      val dir: string -> string
+      val file: string -> string
+      val splitBaseExt: string -> {base: string, ext: string option}
+      val joinBaseExt: {base: string, ext: string option} -> string
+      val base: string -> string
+      val ext: string -> string option
+      val mkCanonical: string -> string
+      val isCanonical: string -> bool
+      val mkAbsolute: {path: string, relativeTo: string} -> string
+      val mkRelative: {path: string, relativeTo: string} -> string
+      val isAbsolute: string -> bool
+      val isRelative: string -> bool
+      val isRoot: string -> bool
+      val concat: string * string -> string
 
-      val parentArc: string 
-      val currentArc: string 
-      val validVolume: {isAbs: bool, vol: string} -> bool 
-      val fromString: string -> {isAbs: bool,
-				  vol: string,
-				  arcs: string list} 
-      val toString: {isAbs: bool, vol: string, arcs: string list} -> string 
-      val getVolume: string -> string 
-      val getParent: string -> string 
-      val splitDirFile: string -> {dir: string, file: string} 
-      val joinDirFile: {dir: string, file: string} -> string 
-      val dir: string -> string 
-      val file: string -> string 
-      val splitBaseExt: string -> {base: string, ext: string option} 
-      val joinBaseExt: {base: string, ext: string option} -> string 
-      val base: string -> string 
-      val ext: string -> string option 
-      val mkCanonical: string -> string 
-      val isCanonical: string -> bool 
-      val mkAbsolute: {path:string, relativeTo:string} -> string
-      val mkRelative: {path:string, relativeTo:string} -> string
-
-      val isAbsolute: string -> bool 
-      val isRelative: string -> bool 
-      val isRoot: string -> bool 
-      val concat: (string * string) -> string 
-(*      val toUnixPath: string -> string 
- *      val fromUnixPath: string -> string
- *)
+      val fromUnixPath: string -> string
+      val toUnixPath: string -> string
    end



1.4       +83 -41    mlton/basis-library/system/path.sml

Index: path.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/path.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- path.sml	4 Jun 2002 21:21:19 -0000	1.3
+++ path.sml	24 Nov 2002 01:19:40 -0000	1.4
@@ -6,6 +6,7 @@
 
 structure OS_Path : OS_PATH = struct
   exception Path
+  exception InvalidArc
 
   (* It would make sense to use substrings for internal versions of
    * fromString and toString, and to allocate new strings only when
@@ -50,15 +51,22 @@
   fun isRelative p = not (isAbsolute p);
 
   fun fromString p =
-      case splitabsvolrest p of
-	  (false, v,   "") => {isAbs=false, vol = v, arcs = []}
-	| (isAbs, v, rest) => {isAbs=isAbs, vol = v,
-			       arcs = String.fields isslash rest};
+     let
+	val (isAbs, v, rest) = splitabsvolrest p
+     in
+	if not isAbs andalso rest = ""
+	   then {isAbs = false, vol = v, arcs = []}
+	else {arcs = String.fields isslash rest,
+	      isAbs = isAbs,
+	      vol = v}
+     end
 
   fun isRoot p =
-      case splitabsvolrest p of
-	  (true, _, "") => true
-	| _             => false;
+     let
+	val (isAbs, _, rest) = splitabsvolrest p
+     in
+	isAbs andalso rest = ""
+     end
 
   fun getVolume p = #2 (splitabsvolrest p);
   fun validVolume{isAbs, vol} = validVol vol;
@@ -67,16 +75,22 @@
       let fun h []        res = res
 	    | h (a :: ar) res = h ar (a :: slash :: res)
       in
-	  if validVolume{isAbs=isAbs, vol=vol} then
-	      case (isAbs, arcs) of
-		  (false, []         ) => vol
-		| (false, "" :: _    ) => raise Path
-		| (false, a1 :: arest) =>
-		      String.concat (vol :: List.rev (h arest [a1]))
-
-		| (true,  []         ) => vol ^ volslash
-		| (true, a1 :: arest ) =>
-		      String.concat (List.rev (h arest [a1, volslash, vol]))
+	  if validVolume {isAbs = isAbs, vol = vol}
+	     then
+		if isAbs
+		   then
+		      (case arcs of
+			  [] => vol ^ volslash
+			| a1 :: arest =>
+			     String.concat
+			     (List.rev (h arest [a1, volslash, vol])))
+		else
+		   case arcs of
+		      [] => vol
+		    | a1 :: arest =>
+			 if a1 = ""
+			    then raise Path
+			 else String.concat (vol :: List.rev (h arest [a1]))
 	  else
 	      raise Path
       end;
@@ -89,11 +103,18 @@
       in
 	  if isAbsolute p2 then raise Path
 	  else
-	      case splitabsvolrest p1 of
-		  (false, "",   "") => p2
-		| (false, v,  path) => v ^ stripslash path ^ slash ^ p2
-		| (true,  v,  ""  ) => v ^ volslash ^ p2
-		| (true,  v,  path) => v ^ volslash ^ stripslash path ^ slash ^ p2
+	     let
+		val (isAbs, v, path) = splitabsvolrest p1
+	     in
+		if isAbs
+		    then if path = ""
+			    then v ^ volslash ^ p2
+			 else String.concat [v, volslash, stripslash path,
+					     slash, p2]
+		else if v = "" andalso path = ""
+			then p2
+		     else String.concat [v, stripslash path, slash, p2]
+	     end
       end
 
   fun getParent p =
@@ -101,12 +122,16 @@
 	  val {isAbs, vol, arcs} = fromString p
 	  fun getpar xs =
 	      rev (case rev xs of
-		       []              => [parentArc]
-		     | [""]            => if isAbs then [] else [parentArc]
-		     | ""   :: revrest => parentArc :: revrest
-		     | "."  :: revrest => parentArc :: revrest
-		     | ".." :: revrest => parentArc :: parentArc :: revrest
-		     | last :: revrest => revrest)
+		       [] => [parentArc]
+		     | last :: revrest =>
+			  if last = ""
+			     andalso (case revrest of [] => true | _ => false)
+			     then if isAbs then [] else [parentArc]
+			  else if last = "" orelse last = "."
+			     then parentArc :: revrest
+			  else if last = ".."
+		             then parentArc :: parentArc :: revrest
+			  else revrest)
       in
 	  case getpar arcs of
 	      []   =>
@@ -117,16 +142,26 @@
 
   fun mkCanonical p =
       let val {isAbs, vol, arcs} = fromString p
-	  fun backup []          = if isAbs then [] else [parentArc]
-	    | backup (".."::res) = parentArc :: parentArc :: res
-	    | backup ( _ :: res) = res
+	  fun backup l =
+	     case l of
+		[] => if isAbs then [] else [parentArc]
+	      | first :: res =>
+		   if first = ".."
+		      then parentArc :: parentArc :: res
+		   else res
 	  fun reduce arcs =
-	      let fun h []         []  = if isAbs then [""] else [currentArc]
-		    | h []         res = res
-		    | h (""::ar)   res = h ar res
-		    | h ("."::ar)  res = h ar res
-		    | h (".."::ar) res = h ar (backup res)
-		    | h (a1::ar)   res = h ar (a1 :: res)
+	      let
+		 fun h l res =
+		    case l of
+		       [] => (case res of
+				 [] => if isAbs then [""] else [currentArc]
+			       | _ => res)
+		     | a1 :: ar =>
+			  if a1 = "" orelse a1 = "."
+			     then h ar res
+			  else if a1 = ".."
+			     then h ar (backup res)
+		          else h ar (a1 :: res)
 	      in h arcs [] end
       in
 	  toString {isAbs=isAbs, vol=vol, arcs=List.rev (reduce arcs)}
@@ -176,9 +211,13 @@
   fun dir s  = #dir (splitDirFile s);
   fun file s = #file(splitDirFile s);
 
-  fun joinBaseExt {base, ext = NONE}    = base
-    | joinBaseExt {base, ext = SOME ""} = base
-    | joinBaseExt {base, ext = SOME ex} = base ^ "." ^ ex;
+  fun joinBaseExt {base, ext} =
+     case ext of
+	NONE => base
+      | SOME ex =>
+	   if ex = ""
+	      then base
+	   else String.concat [base, ".", ex]
 
   fun splitBaseExt s =
       let val {dir, file} = splitDirFile s
@@ -200,9 +239,12 @@
 
   fun isRoot path =
      case fromString path of
-	{isAbs = true, arcs= [""], ...} => true
+	{isAbs = true, arcs= [a], ...} => a = ""
       | _ => false
   end
+
+  fun fromUnixPath _ = raise (Fail "<Path.fromUnixPath not implemented>")
+  fun toUnixPath _ = raise (Fail "<Path.toUnixPath not implemented>")
 end (*structure Path*)
 
 



1.2       +9 -8      mlton/basis-library/system/process.sig

Index: process.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/process.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- process.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ process.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,14 +1,15 @@
 signature OS_PROCESS =
    sig
-      eqtype status
-
-      val atExit: (unit -> unit) -> unit 
-      val exit: status -> 'a 
-      val failure: status 
+      type status
+      val success: status
+      val failure: status
+      val isSuccess: status -> bool
+      val system: string -> status
+      val atExit: (unit -> unit) -> unit
+      val exit: status -> 'a
+      val terminate: status -> 'a
       val getEnv: string -> string option
-      val success: status 
-      val system: string -> status 
-      val terminate: status -> 'a 
+      val sleep: Time.time -> unit
    end
 
 signature OS_PROCESS_EXTRA =



1.7       +10 -4     mlton/basis-library/system/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/process.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- process.sml	10 Apr 2002 07:44:18 -0000	1.6
+++ process.sml	24 Nov 2002 01:19:40 -0000	1.7
@@ -16,11 +16,13 @@
       open Posix.Process
 
       structure Signal = MLton.Signal
-      type status = int
+      type status = PreOS.Process.status
 
       val success: status = 0
       val failure: status = 1
 
+      fun isSuccess st = st = success
+
       fun wait pid =
 	 case #2 (waitpid (W_CHILD pid, [])) of
 	    W_EXITED => success
@@ -47,10 +49,14 @@
 	 end
 
       fun atExit f = Cleaner.addNew (Cleaner.atExit, f)
-
-      fun terminate x = exit (Word8.fromInt x)
-
+ 
       val exit = MLton.Process.exit
 
+      fun terminate x = Posix.Process.exit (Word8.fromInt x)
+
       val getEnv = Posix.ProcEnv.getenv
+
+      fun sleep t = if Time.<=(t, Time.zeroTime)
+		       then ()
+		    else (Posix.Process.sleep t; ())
    end



1.2       +1 -2      mlton/basis-library/system/time.sig

Index: time.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/time.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- time.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ time.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,7 +1,6 @@
 signature TIME =
    sig
       eqtype time
-
       exception Time
 
       val zeroTime: time 
@@ -24,7 +23,7 @@
       val fmt: int -> time -> string 
       val toString: time -> string 
       val fromString: string -> time option 
-      val scan: (char, 'a) StringCvt.reader -> 'a -> (time * 'a) option
+      val scan: (char, 'a) StringCvt.reader -> (time, 'a) StringCvt.reader
    end
 
 signature TIME_EXTRA =



1.5       +106 -99   mlton/basis-library/system/time.sml

Index: time.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/time.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- time.sml	19 Sep 2002 16:58:42 -0000	1.4
+++ time.sml	24 Nov 2002 01:19:40 -0000	1.5
@@ -8,28 +8,30 @@
 structure Time: TIME_EXTRA =
    struct
       structure Prim = Primitive.Time
-	 
-      (* Inv: sec >= 0 and 0 <= usec < 1000000 *)
+
+      (* Inv: 0 <= usec < 1000000 *)
       datatype time = T of {sec: Int.int,
-			    usec: Int.int}
+                            usec: Int.int}
       datatype time' = datatype time
 
       exception Time
+      val thousand'': IntInf.int = 1000
+      val thousand': LargeInt.int = 1000
       val thousand: int = 1000
+      val million'': IntInf.int = 1000000
+      val million': LargeInt.int = 1000000
       val million: int = 1000000
       
       val zeroTime = T {sec = 0,
 			usec = 0}
-	 
-      fun fromReal (r: LargeReal.real): time  =
-	 if r < 0.0
-	    then raise Time
-	 else let
-		 val sec = LargeReal.floor r
-		 val usec = LargeReal.floor (1E6 * (r - (LargeReal.fromInt sec)))
-	      in T {sec = sec, usec = usec}
-	      end handle Overflow => raise Time
-		 
+
+      fun fromReal (r: LargeReal.real): time =
+         let
+	    val sec = LargeReal.floor r
+	    val usec = LargeReal.floor (1E6 * (r - (LargeReal.fromInt sec)))
+	 in T {sec = sec, usec = usec}
+	 end handle Overflow => raise Time
+
       fun toReal (T {sec, usec}): LargeReal.real =
 	 LargeReal.fromInt sec + (LargeReal.fromInt usec / 1E6)
 	 
@@ -37,41 +39,37 @@
 	 LargeInt.fromInt sec
 
       fun toMilliseconds (T {sec, usec}): LargeInt.int =
-	 1000 * LargeInt.fromInt sec
+	 thousand' * LargeInt.fromInt sec
 	 + LargeInt.fromInt (Int.quot (usec, thousand))
 	 
       fun toMicroseconds (T {sec, usec}): LargeInt.int =
-	 1000000 * LargeInt.fromInt sec + LargeInt.fromInt usec
+	 million' * LargeInt.fromInt sec + LargeInt.fromInt usec
 
       fun convert (s: LargeInt.int): int =
 	 LargeInt.toInt s handle Overflow => raise Time
 	    
       fun fromSeconds (s: LargeInt.int): time =
-	 if Primitive.safe andalso s < 0
-	    then raise Time
-	 else T {sec = convert s, usec = 0}
-      
-      fun fromMilliseconds (ms: LargeInt.int): time =
-	 if Primitive.safe andalso ms < 0
-	    then raise Time
-	 else
-	    let
-	       val (sec, ms) = IntInf.quotRem (ms, 1000)
-	    in
-	       T {sec = convert sec,
-		  usec = LargeInt.toInt ms * 1000}
-	    end
-	    
+	 T {sec = convert s, usec = 0}
+
+      fun fromMilliseconds (msec: LargeInt.int): time =
+	let
+	  val msec = IntInf.fromLarge msec
+	  val (sec, msec) = IntInf.divMod (msec, thousand'')
+	  val (sec, msec) = (IntInf.toLarge sec, IntInf.toLarge msec)
+	in
+	  T {sec = convert sec,
+	     usec = (LargeInt.toInt msec) * thousand}
+	end
+ 
       fun fromMicroseconds (usec: LargeInt.int): time =
-	 if Primitive.safe andalso usec < 0
-	    then raise Time
-	 else
-	    let
-	       val (sec, usec) = IntInf.quotRem (usec, 1000000)
-	    in
-	       T {sec = convert sec,
-		  usec = LargeInt.toInt usec}
-	    end
+	let
+	  val usec = IntInf.fromLarge usec
+	  val (sec, usec) = IntInf.divMod (usec, million'')
+	  val (sec, usec) = (IntInf.toLarge sec, IntInf.toLarge usec)
+	in
+	  T {sec = convert sec,
+	     usec = LargeInt.toInt usec}
+	end
 	 
       val add =
 	 fn (T {sec = s, usec = u}, T {sec = s', usec = u'}) =>
@@ -87,22 +85,21 @@
 	 end
       (* Basis spec says Overflow, not Time, should be raised. *)
       (* handle Overflow => raise Time *) 
-		 
+
       val sub =
-	 fn (t1 as T {sec = s, usec = u}, t2 as T {sec = s', usec = u'}) =>
-	 if s < s' orelse (s = s' andalso u < u')
-	    then raise Time
-	 else
-	    let
-	       val s'' = s -? s'
-	       val u'' = u -? u'
-	    in
+         fn (T {sec = s, usec = u}, T {sec = s', usec = u'}) =>
+         let
+	    val s'' = s - s' (* overflow possible *)
+	    val u'' = u -? u'
+	    val (s'', u'') =
 	       if u'' < 0
-		  then T {sec = s'' -? 1,
-			  usec = u'' +? million}
-	       else T {sec = s'',
-		       usec = u''}
-	    end
+		  then (s'' - 1, (* overflow possible *)
+			u'' +? million)
+	       else (s'', u'')
+	 in T {sec = s'', usec = u''}
+	 end
+      (* Basis spec says Overflow, not Time, should be raised. *)
+      (* handle Overflow => raise Time *) 
 
       fun compare (T {sec = s, usec = u}, T {sec = s', usec = u'}) =
 	 if s > s'
@@ -140,54 +137,64 @@
 
       val toString = fmt 3
 
-      (* Copied from MLKitV3 basislib/Time.sml*)
-      fun scan getc source =
+      (* Adapted from MLKitV3 basislib/Time.sml*)
+      fun scan getc src =
 	 let
-	    fun skipWSget getc source = 
-	       getc (StringCvt.dropl Char.isSpace getc source)
-	     fun decval c = Char.ord c -? 48;
-	     fun pow10 0 = 1
-	       | pow10 n = 10 * pow10 (n-1)
-	     fun mktime intgv decs fracv =
-		let val usecs = (pow10 (7-decs) * fracv + 5) div 10
-		in
-		   T {sec = floor (intgv + 0.5) + usecs div 1000000, 
-		     usec = usecs mod 1000000}
-		end
-	     fun skipdigs src =
-		case getc src of 
-		   NONE          => src
-		 | SOME (c, rest) => if Char.isDigit c then skipdigs rest 
-				    else src
-	     fun frac intgv decs fracv src =
-		if decs >= 7 then SOME (mktime intgv decs fracv, skipdigs src)
-		else case getc src of
-		   NONE          => SOME (mktime intgv decs fracv, src)
-		 | SOME (c, rest) => 
-		      if Char.isDigit c then 
-			 frac intgv (decs+1) (10 * fracv + decval c) rest
-		      else 
-			 SOME (mktime intgv decs fracv, src)
-	     fun intg intgv src = 
-		case getc src of
-		   NONE              => SOME (mktime intgv 6 0, src)
-		 | SOME (#".", rest) => frac intgv 0 0 rest
-		 | SOME (c, rest)    => 
-		      if Char.isDigit c then 
-			 intg (10.0 * intgv + real (decval c)) rest 
-		      else SOME (mktime intgv 6 0, src)
-	 in case skipWSget getc source of
-	    NONE             => NONE
-	  | SOME (#".", rest) => 
-	       (case getc rest of
-		   NONE          => NONE
-		 | SOME (c, rest) => 
-		      if Char.isDigit c then frac 0.0 1 (decval c) rest
-		      else NONE)
-	  | SOME (c, rest)    => 
-	       if Char.isDigit c then intg (real (decval c)) rest else NONE
+	    val charToDigit = StringCvt.charToDigit StringCvt.DEC
+	    fun pow10 0 = 1
+	      | pow10 n = 10 * pow10 (n-1)
+	    fun mkTime sign intv fracv decs =
+	       let
+		  val sec = intv
+		  val usec = (pow10 (7-decs) * fracv + 5) div 10
+		  val t = T {sec = intv, usec = usec}
+	       in 
+		 if sign then t else sub (zeroTime, t)
+	       end
+	    fun frac' sign intv fracv decs src =
+	       if decs >= 7 
+		  then SOME (mkTime sign intv fracv decs, 
+			     StringCvt.dropl Char.isDigit getc src)
+	       else case getc src of
+		       NONE           => SOME (mkTime sign intv fracv decs, src)
+		     | SOME (c, rest) =>
+                         (case charToDigit c of
+			     NONE   => SOME (mkTime sign intv fracv decs, src)
+			   | SOME d => frac' sign intv (10 * fracv + d) (decs + 1) rest)
+	    fun frac sign intv src =
+	       case getc src of
+		 NONE           => NONE
+	       | SOME (c, rest) =>
+		   (case charToDigit c of
+		      NONE   => NONE
+		    | SOME d => frac' sign intv d 1 rest)
+	    fun int' sign intv src =
+	       case getc src of
+		  NONE              => SOME (mkTime sign intv 0 7, src)
+		| SOME (#".", rest) => frac sign intv rest
+		| SOME (c, rest)    =>
+		    (case charToDigit c of
+		       NONE   => SOME (mkTime sign intv 0 7, src)
+		     | SOME d => int' sign (10 * intv + d) rest)
+	    fun int sign src =
+	      case getc src of
+		NONE           => NONE
+	      | SOME (c, rest) => 
+		  (case charToDigit c of
+		     NONE   => NONE
+		   | SOME d => int' sign d rest)
+	 in 
+	    case getc (StringCvt.skipWS getc src) of
+	      NONE              => NONE
+	    | SOME (#"+", rest) => int true rest
+	    | SOME (#"~", rest) => int false rest
+	    | SOME (#"-", rest) => int false rest
+	    | SOME (#".", rest) => frac true 0 rest
+	    | SOME (c, rest)    => 
+                (case charToDigit c of
+		   NONE => NONE
+		 | SOME d => int' true d rest)
 	 end
-
       val fromString = StringCvt.scanString scan
 
       val op + = add



1.2       +7 -9      mlton/basis-library/system/timer.sig

Index: timer.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/timer.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- timer.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ timer.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -2,13 +2,11 @@
    sig
       type cpu_timer
       type real_timer
-
-      val checkCPUTimer: cpu_timer -> {gc: Time.time,
-				       sys: Time.time,
-				       usr: Time.time}
-      val checkRealTimer: real_timer -> Time.time 
-      val startCPUTimer: unit -> cpu_timer 
-      val startRealTimer: unit -> real_timer 
-      val totalCPUTimer: unit -> cpu_timer 
-      val totalRealTimer: unit -> real_timer 
+      val startCPUTimer: unit -> cpu_timer
+      val checkCPUTimer: cpu_timer -> {usr: Time.time, sys: Time.time}
+      val checkGCTime: cpu_timer -> Time.time
+      val totalCPUTimer: unit -> cpu_timer
+      val startRealTimer: unit -> real_timer
+      val checkRealTimer: real_timer -> Time.time
+      val totalRealTimer: unit -> real_timer
   end



1.2       +14 -10    mlton/basis-library/system/timer.sml

Index: timer.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/timer.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- timer.sml	18 Jul 2001 05:51:02 -0000	1.1
+++ timer.sml	24 Nov 2002 01:19:40 -0000	1.2
@@ -15,9 +15,9 @@
 	     usr = selfu}
 	 end
 
-      fun checkCPUTimer ({gc, sys, usr}: cpu_timer) =
+      fun checkCPUTimer ({gc, sys, usr, ...}: cpu_timer) =
 	 let
-	    val {gc = g, sys = s, usr = u} = startCPUTimer ()
+	    val {gc = g, sys = s, usr = u, ...} = startCPUTimer ()
 	    val op - = Time.-
 	 in
 	    {gc = g - gc,
@@ -26,22 +26,26 @@
 	 end
 
       val totalCPUTimer =
-	 let
-	    val t = startCPUTimer ()
+	 let val t = startCPUTimer ()
 	 in fn () => checkCPUTimer t
 	 end
 
+      val checkGCTime = fn t => let val {gc, ...} = checkCPUTimer t
+				in gc
+				end
+      val checkCPUTimer = fn t => let val {usr, sys, ...} = checkCPUTimer t
+				  in {usr = usr, sys = sys}
+				  end
+
       type real_timer = Time.time
 
-      fun startRealTimer (): real_timer = Posix.ProcEnv.time ()
+      fun startRealTimer (): real_timer = Time.now ()
 
       fun checkRealTimer (t: real_timer): Time.time =
-	 Time.- (Posix.ProcEnv.time (), t)
+	 Time.- (startRealTimer (), t)
 	 
       val totalRealTimer =
-	 let
-	    val t = startRealTimer ()
-	 in
-	    fn () => checkRealTimer t
+	 let val t = startRealTimer ()
+	 in fn () => checkRealTimer t
 	 end
    end



1.2       +18 -7     mlton/basis-library/system/unix.sig

Index: unix.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/unix.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- unix.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ unix.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -1,11 +1,22 @@
 signature UNIX =
    sig
-      type proc
+      type ('a, 'b) proc
       type signal
-	 
-      val executeInEnv: string * string list * string list -> proc 
-      val execute: string * string list -> proc 
-      val streamsOf: proc -> TextIO.instream * TextIO.outstream 
-      val reap: proc -> OS.Process.status 
-      val kill: proc * signal -> unit
+      datatype exit_status = 
+	 W_EXITED
+       | W_EXITSTATUS of Word8.word
+       | W_SIGNALED of signal
+       | W_STOPPED of signal
+      val fromStatus: OS.Process.status -> exit_status
+      val executeInEnv: string * string list * string list -> ('a, 'b) proc 
+      val execute: string * string list -> ('a, 'b) proc
+      val textInstreamOf: (TextIO.instream, 'a) proc -> TextIO.instream
+      val binInstreamOf: (BinIO.instream, 'a) proc -> BinIO.instream
+      val textOutstreamOf: ('a, TextIO.outstream) proc -> TextIO.outstream
+      val binOutstreamOf: ('a, BinIO.outstream) proc -> BinIO.outstream
+      val streamsOf: (TextIO.instream, TextIO.outstream) proc -> 
+	             TextIO.instream * TextIO.outstream
+      val reap: ('a, 'b) proc -> OS.Process.status
+      val kill: ('a, 'b) proc * signal -> unit
+      val exit: Word8.word -> 'a
    end



1.2       +66 -30    mlton/basis-library/system/unix.sml

Index: unix.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/unix.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- unix.sml	18 Jul 2001 05:51:02 -0000	1.1
+++ unix.sml	24 Nov 2002 01:19:40 -0000	1.2
@@ -3,6 +3,8 @@
  *         2. IO
  * Further modified by sweeks@acm.org on 1999-12-10.
  *         1. Put back support for Signals
+ * Further modified by fluet@cs.cornell.edu on 2002-10-15.
+ *         1. Adapted for new Basis Library specification.
  *)
 
 (* unix.sml
@@ -14,13 +16,16 @@
 structure Unix: UNIX =
   struct
 
-    structure P = Posix.Process
-    structure PE = Posix.ProcEnv
-    structure PF = Posix.FileSys
+    structure OSP = OS_Process
+    structure PP = Posix.Process
+    structure PPE = Posix.ProcEnv
+    structure PFS = Posix.FileSys
     structure PIO = Posix.IO
     structure SS = Substring
 
     type signal = Posix.Signal.signal
+    datatype exit_status = datatype Posix.Process.exit_status
+    val fromStatus = Posix.Process.fromStatus
 
     structure Mask = MLton.Signal.Mask
 
@@ -28,15 +33,20 @@
        let val _ = Mask.block Mask.all
        in DynamicWind.wind(fn () => f x, fn () => Mask.unblock Mask.all)
        end
-       
-    datatype proc = PROC of {
-        pid: P.pid,
-        ins: TextIO.instream,
-        outs: TextIO.outstream
-      }
+
+    datatype 'a str = FD of PFS.file_desc | STR of 'a * ('a -> unit)
+    fun close str =
+      case str of
+	FD file_desc => PIO.close file_desc
+      | STR (str, close) => close str
+      
+    datatype ('a, 'b) proc = PROC of {pid: PP.pid,
+				      status: OSP.status option ref,
+				      ins: 'a str ref,
+				      outs: 'b str ref}
 
     fun executeInEnv (cmd, argv, env) =
-       if not(PF.access(cmd, [PF.A_EXEC]))
+       if not(PFS.access(cmd, [PFS.A_EXEC]))
 	  then PosixError.raiseSys PosixError.noent
        else
 	  let
@@ -48,13 +58,13 @@
 			      PIO.close (#infd p2))
 	     val base = SS.string(SS.taker (fn c => c <> #"/") (SS.all cmd))
 	     fun startChild () =
-		case protect P.fork () of
-		   SOME pid =>  pid           (* parent *)
+		case protect PP.fork () of
+		   SOME pid => pid (* parent *)
 		 | NONE => let
 			      val oldin = #infd p1
-			      val newin = PF.stdin
 			      val oldout = #outfd p2
-			      val newout = PF.stdout
+			      val newin = PFS.stdin
+			      val newout = PFS.stdout
 			   in
 			      PIO.close (#outfd p1);
 			      PIO.close (#infd p2);
@@ -64,13 +74,11 @@
 			      if (oldout = newout) then ()
 			      else (PIO.dup2{old = oldout, new = newout};
 				    PIO.close oldout);
-			      P.exece (cmd, base :: argv, env)
+			      PP.exece (cmd, base :: argv, env)
 			   end
 	     (* end case *)
 	     val _ = TextIO.flushOut TextIO.stdOut
 	     val pid = (startChild ()) handle ex => (closep(); raise ex)
-	     val ins = TextIO.newIn(#infd p2)
-	     val outs = TextIO.newOut(#outfd p1)
           in
 	     (* close the child-side fds *)
 	     PIO.close (#outfd p2);
@@ -80,23 +88,51 @@
 	     PIO.setfd (#outfd p1, PIO.FD.flags [PIO.FD.cloexec]);
 	     PROC {
 		   pid = pid,
-		   ins = ins,
-		   outs = outs
+		   status = ref NONE,
+		   ins = ref (FD (#infd p2)),
+		   outs = ref (FD (#outfd p1))
 		   }
           end
 
-    fun execute (cmd, argv) = executeInEnv (cmd, argv, PE.environ())
-
-    fun streamsOf (PROC{ins, outs, ...}) = (ins, outs)
+    fun execute (cmd, argv) = executeInEnv (cmd, argv, PPE.environ())
 
-    fun kill (PROC{pid, ...}, signal) = P.kill (P.K_PROC pid, signal)
+    local
+      fun mkInstreamOf (newIn, closeIn) (PROC {ins, ...}) =
+	case !ins of
+	  FD file_desc => let val str' = newIn file_desc
+			  in ins := STR (str', closeIn); str'
+			  end
+	| STR (str, _) => str
+      fun mkOutstreamOf (newOut, closeOut) (PROC {outs, ...}) =
+	case !outs of
+	  FD file_desc => let val str' = newOut file_desc
+			  in outs := STR (str', closeOut); str'
+			  end
+	| STR (str, _) => str
+    in
+      fun textInstreamOf proc = mkInstreamOf (TextIO.newIn, TextIO.closeIn) proc
+      fun textOutstreamOf proc = mkOutstreamOf (TextIO.newOut, TextIO.closeOut) proc
+      fun binInstreamOf proc = mkInstreamOf (BinIO.newIn, BinIO.closeIn) proc
+      fun binOutstreamOf proc = mkOutstreamOf (BinIO.newOut, BinIO.closeOut) proc
+    end
+    fun streamsOf pr = (textInstreamOf pr, textOutstreamOf pr)
+
+    fun reap (PROC{pid, status, ins, outs}) =
+      case !status of
+	SOME status => status
+      | NONE => let
+		  val _ = close (!ins)
+		  val _ = close (!outs)
+		  (* protect is probably too much; typically, one
+		   * would only mask SIGINT, SIGQUIT and SIGHUP
+		   *)
+		  val st = protect OSP.wait pid
+		  val _ = status := SOME st
+		in
+		  st
+		end
 
-    fun reap (PROC{pid, ins, outs}) =
-       (TextIO.closeIn ins
-	; TextIO.closeOut outs
-	; (* protect is probably too much; typically, one
-	   * would only mask SIGINT, SIGQUIT and SIGHUP
-	   *)
-	protect OS_Process.wait pid)
+    fun kill (PROC{pid, ...}, signal) = PP.kill (PP.K_PROC pid, signal)
 
+    fun exit st = OSP.exit (Word8.toInt st)
   end (* structure Unix *)



1.2       +15 -0     mlton/basis-library/system/pre-os.sml




1.2       +13 -13    mlton/basis-library/text/char.sig

Index: char.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/char.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- char.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ char.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -12,37 +12,37 @@
 
       eqtype string
 
+      val minChar: char 
+      val maxChar: char 
+      val maxOrd: int 
+      val succ: char -> char 
+      val pred: char -> char 
       val < : char * char -> bool 
       val <= : char * char -> bool 
       val > : char * char -> bool 
       val >= : char * char -> bool 
       val compare: char * char -> order 
       val contains: string -> char -> bool 
-      val fromCString: string -> char option
-      val fromString: string -> char option 
+      val notContains: string -> char -> bool 
+      val toLower: char -> char 
+      val toUpper: char -> char 
+      val isAscii: char -> bool 
       val isAlpha: char -> bool 
       val isAlphaNum: char -> bool 
-      val isAscii: char -> bool 
       val isCntrl: char -> bool 
       val isDigit: char -> bool 
       val isGraph: char -> bool 
       val isHexDigit: char -> bool 
       val isLower: char -> bool 
+      val isUpper: char -> bool 
       val isPrint: char -> bool 
       val isPunct: char -> bool 
       val isSpace: char -> bool 
-      val isUpper: char -> bool 
-      val maxChar: char 
-      val maxOrd: int 
-      val minChar: char 
-      val notContains: string -> char -> bool 
-      val pred: char -> char 
+      val fromString: string -> char option 
       val scan: (char, 'a) StringCvt.reader -> (char, 'a) StringCvt.reader
-      val succ: char -> char 
-      val toCString: char -> string
-      val toLower: char -> char 
       val toString: char -> string 
-      val toUpper: char -> char 
+      val fromCString: string -> char option
+      val toCString: char -> string
    end
 
 signature CHAR_EXTRA =



1.3       +3 -6      mlton/basis-library/text/char.sml

Index: char.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/char.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- char.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ char.sml	24 Nov 2002 01:19:40 -0000	1.3
@@ -86,19 +86,15 @@
 		      | #"v" => yes #"\v"
 		      | #"f" => yes #"\f"
 		      | #"r" => yes #"\r"
+		      | #"?" => yes #"?"
 		      | #"\\" => yes #"\\"
 		      | #"\"" => yes #"\""
-		      | #"?" => yes #"?"
 		      | #"'" => yes #"'"
 		      | #"^" => control reader state'
 		      | #"x" =>
 			   Reader.mapOpt chrOpt
 			   (StringCvt.digits StringCvt.HEX reader)
 			   state'
-		      | #"u" =>
-			   Reader.mapOpt chrOpt
-			   (StringCvt.digitsExact (StringCvt.HEX, 4) reader)
-			   state'
 		      | _ =>
 			   Reader.mapOpt chrOpt
 			   (StringCvt.digitsPlus (StringCvt.OCT, 3) reader)
@@ -151,7 +147,8 @@
 		   if c < #" "
 		      then (String.concat
 			    ["\\^", String0.str (chr (ord c +? ord #"@"))])
-		   else String.concat ["\\", padLeft (Int.toString (ord c), 3)])
+		   else String.concat 
+		        ["\\", padLeft (Int.fmt StringCvt.DEC (ord c), 3)])
       
       val toCString =
 	 memoize



1.2       +3 -4      mlton/basis-library/text/string-cvt.sig

Index: string-cvt.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/string-cvt.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- string-cvt.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ string-cvt.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -15,13 +15,12 @@
 
       val splitl: (char -> bool) -> (char, 'a) reader -> 'a -> string * 'a
 
-      val takel: (char -> bool) -> (char, 'a) reader ->'a -> string 
-      val dropl: (char -> bool) -> (char, 'a) reader ->'a -> 'a 
+      val takel: (char -> bool) -> (char, 'a) reader -> 'a -> string 
+      val dropl: (char -> bool) -> (char, 'a) reader -> 'a -> 'a 
       val skipWS: (char, 'a) reader -> 'a -> 'a
 
       type cs
-      val scanString :
-	 ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
+      val scanString : ((char, cs) reader -> ('a, cs) reader) -> string -> 'a option
    end
 
 signature STRING_CVT_EXTRA =



1.3       +1 -1      mlton/basis-library/text/string-cvt.sml

Index: string-cvt.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/string-cvt.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- string-cvt.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ string-cvt.sml	24 Nov 2002 01:19:40 -0000	1.3
@@ -34,7 +34,7 @@
 	 fun pad f c i s =
 	    let val n = String.size s
 	    in if n >= i then s
-	       else f (s, String0.new (i -? n, c))
+	       else f (s, String0.vector (i -? n, c))
 	    end
       in
 	 val padLeft = pad (fn (s, pad) => String.^ (pad, s))



1.2       +20 -17    mlton/basis-library/text/string.sig

Index: string.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/string.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- string.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ string.sig	24 Nov 2002 01:19:40 -0000	1.2
@@ -2,39 +2,42 @@
    sig
       eqtype string
 	 
+      val size: string -> int 
+      val substring: string * int * int -> string 
       val ^ : string * string -> string 
       val concat: string list -> string 
-      val explode: string -> Char.char list 
-      val implode: Char.char list -> string 
-      val size: string -> int 
       val str: Char.char -> string 
-      val substring: string * int * int -> string 
+      val implode: Char.char list -> string 
+      val explode: string -> Char.char list 
    end
 
 signature STRING =
    sig
       include STRING_GLOBAL
 
-      structure Char: CHAR
+      eqtype char
 	 
+      val maxSize: int 
+      val sub: string * int -> char 
+      val extract: string * int * int option -> string
+      val concatWith: string -> string list -> string
+      val map: (Char.char -> Char.char) -> string -> string 
+      val translate: (Char.char -> string) -> string -> string 
+      val tokens: (Char.char -> bool) -> string -> string list 
+      val fields: (Char.char -> bool) -> string -> string list
+      val isPrefix: string -> string -> bool
+      val isSubstring: string -> string -> bool
+      val isSuffix: string -> string -> bool
+      val compare: string * string -> order
+      val collate: (char * char -> order) -> string * string -> order
       val < : string * string -> bool 
       val <= : string * string -> bool 
       val > : string * string -> bool 
       val >= : string * string -> bool 
-      val collate: (Char.char * Char.char -> order) -> string * string -> order
-      val compare: string * string -> order
-      val extract: string * int * int option -> string
-      val fields: (Char.char -> bool) -> string -> string list
-      val fromCString: string -> string option 
       val fromString: string -> string option 
-      val isPrefix: string -> string -> bool
-      val map: (Char.char -> Char.char) -> string -> string 
-      val maxSize: int 
-      val sub: string * int -> Char.char 
-      val toCString: string -> string
       val toString: string -> string 
-      val tokens: (Char.char -> bool) -> string -> string list 
-      val translate: (Char.char -> string) -> string -> string 
+      val fromCString: string -> string option 
+      val toCString: string -> string
    end
 
 signature STRING_EXTRA =



1.3       +4 -46     mlton/basis-library/text/string.sml

Index: string.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/string.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- string.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ string.sml	24 Nov 2002 01:19:40 -0000	1.3
@@ -9,56 +9,14 @@
    struct
       open String0
 
-      structure Char = Char
-
-      fun explode s =
-	 let
-	    fun loop (i, l) =
-	       if i < 0 then l
-	       else loop (i - 1, sub (s, i) :: l)
-	 in loop (size s - 1, [])
-	 end
-
-      fun translate f s = concat (List.map f (explode s))
-
-      fun isPrefix s s' =
-	 let
-	    val n = size s
-	    val n' = size s'
-	    fun loop i =
-	       i >= n orelse (sub (s, i) = sub (s', i)
-			      andalso loop (i + 1))
-	 in n <= n' andalso loop 0
-	 end
-
       local
-	 fun make (tokens,name) p s =
-	    case StringCvt.scanString (tokens p) s of
-	       SOME l => List.map implode l
-	     | NONE => raise Fail ("String." ^ name)
+	 fun make f = f (op = : char * char -> bool)
       in
-	 val tokens = make (Reader.tokens, "tokens")
-	 val fields = make (Reader.fields, "fields")
+	val isPrefix = make isPrefix
+	val isSubstring = make isSubvector
+	val isSuffix = make isSuffix
       end
-   
-      fun collate comp (s, s') =
-	 let val n = size s
-	    val n' = size s'
-	    fun loop i =
-	       if i >= n
-		  then if i >= n'
-			  then EQUAL
-		       else LESS
-	       else if i >= n'
-		       then GREATER
-		    else (case comp (sub (s, i), sub (s', i)) of
-			     EQUAL => loop (i + 1)
-			   | r => r)
-	 in loop 0
-	 end
-
       val compare = collate Char.compare
-
       val {<, <=, >, >=} = Util.makeOrder compare
 
       val toString = translate Char.toString



1.4       +22 -34    mlton/basis-library/text/string0.sml

Index: string0.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/string0.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- string0.sml	10 Apr 2002 07:02:18 -0000	1.3
+++ string0.sml	24 Nov 2002 01:19:40 -0000	1.4
@@ -5,42 +5,30 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-structure String0 =
-   struct
-      val fromArray =
-	 Primitive.String.fromCharVector o Primitive.Vector.fromArray
-
-      structure S = Sequence (type 'a sequence = string
-			      type 'a elt = char
-			      val fromArray = fromArray
-			      val isMutable = false
-			      open Primitive.String
-			      val length = size)
-      open S
-
-      open Primitive.Int
-	 
-      type string = string
-      type array = string
 
+structure CharVector = EqtypeMonoVector(type elem = char)
+structure CharVectorSlice = CharVector.MonoVectorSlice
+structure String0 = 
+   struct
+      open CharVector
+      type char = elem
+      type string = vector
+      structure Substring0 =
+	 struct
+	    open CharVectorSlice
+	    type char = elem
+	    type string = vector
+	    type substring = slice
+	 end
       val maxSize = maxLen
-
       val size = length
-
-      fun substring (s, i, j) = extract (s, i, SOME j)
-
-      fun copy s = tabulate (length s, fn i => sub (s, i))
-	 
-      fun map f s =
-	 fromArray (Array.tabulate (size s, fn i => f (sub (s, i))))
-
-      fun s ^ s' = concat [s, s']
-
-      fun implode cs =
-	 let val a = Primitive.Array.array (List.length cs)
-	 in List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 cs ;
-	    fromArray a
-	 end
-
+      fun extract (s, start, len) = 
+	 CharVectorSlice.vector (CharVectorSlice.slice (s, start, len))
+      fun substring (s, start, len) = extract (s, start, SOME len)
+      val op ^ = append
+      val new = vector
       fun str c = new (1, c)
+      val implode = fromList
+      val explode = toList
    end
+structure Substring0 = String0.Substring0



1.2       +37 -38    mlton/basis-library/text/substring.sig

Index: substring.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/substring.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- substring.sig	18 Jul 2001 05:51:02 -0000	1.1
+++ substring.sig	24 Nov 2002 01:19:41 -0000	1.2
@@ -6,45 +6,44 @@
 signature SUBSTRING =
    sig
       include SUBSTRING_GLOBAL
-      
-      structure String: STRING
+      eqtype char
+      eqtype string
 
-      val all: String.string -> substring 
-      val app: (String.Char.char -> unit) -> substring -> unit
-      val base: substring -> String.string * int * int
-      val collate:
-	 (String.Char.char * String.Char.char -> order)
-	 -> substring * substring -> order 
-      val compare: substring * substring -> order 
-      val concat: substring list -> String.string 
-      val dropl: (String.Char.char -> bool) -> substring -> substring 
-      val dropr: (String.Char.char -> bool) -> substring -> substring 
-      val explode: substring -> String.Char.char list 
-      val extract: String.string * int * int option -> substring 
-      val fields: (String.Char.char -> bool) -> substring -> substring list
-      val first: substring -> String.Char.char option 
-      val foldl: (String.Char.char * 'a -> 'a) -> 'a -> substring -> 'a 
-      val foldr: (String.Char.char * 'a -> 'a) -> 'a -> substring -> 'a 
-      val getc: substring -> (String.Char.char * substring) option 
-      val isEmpty: substring -> bool 
-      val isPrefix: String.string -> substring -> bool 
-      val position: String.string -> substring -> substring * substring 
-      val size: substring -> int 
+      val sub: substring * int -> char
+      val size: substring -> int
+      val base: substring -> string * int * int
+      val extract: string * int * int option -> substring
+      val substring: string * int * int -> substring
+      val full: string -> substring
+      val all: string -> substring
+      val string: substring -> string
+      val isEmpty: substring -> bool
+      val getc: substring -> (char * substring) option
+      val first: substring -> char option
+      val triml: int -> substring -> substring
+      val trimr: int -> substring -> substring
       val slice: substring * int * int option -> substring
+      val concat: substring list -> string
+      val concatWith: string -> substring list -> string
+      val explode: substring -> char list
+      val isPrefix: string -> substring -> bool
+      val isSubstring: string -> substring -> bool
+      val isSuffix: string -> substring -> bool
+      val compare: substring * substring -> order
+      val collate: (char * char -> order) -> substring * substring -> order
+      val splitl: (char -> bool) -> substring -> substring * substring
+      val splitr: (char -> bool) -> substring -> substring * substring
+      val splitAt: substring * int -> substring * substring
+      val dropl: (char -> bool) -> substring -> substring
+      val dropr: (char -> bool) -> substring -> substring
+      val takel: (char -> bool) -> substring -> substring
+      val taker: (char -> bool) -> substring -> substring
+      val position: string -> substring -> substring * substring
       val span: substring * substring -> substring
-      val splitAt: substring * int -> substring * substring 
-      val splitl:
-	 (String.Char.char -> bool) -> substring -> substring * substring 
-      val splitr:
-	 (String.Char.char -> bool) -> substring -> substring * substring 
-      val string: substring -> String.string 
-      val sub: substring * int -> char 
-      val substring: String.string * int * int -> substring 
-      val takel: (String.Char.char -> bool) -> substring -> substring 
-      val taker: (String.Char.char -> bool) -> substring -> substring 
-      val tokens: (String.Char.char -> bool) -> substring -> substring list
-      val translate:
-	 (String.Char.char -> String.string) -> substring -> String.string 
-      val triml: int -> substring -> substring 
-      val trimr: int -> substring -> substring 
+      val translate: (char -> string) -> substring -> string
+      val tokens: (char -> bool) -> substring -> substring list
+      val fields: (char -> bool) -> substring -> substring list
+      val app: (char -> unit) -> substring -> unit
+      val foldl: (char * 'a -> 'a) -> 'a -> substring -> 'a
+      val foldr: (char * 'a -> 'a) -> 'a -> substring -> 'a
    end



1.3       +20 -241   mlton/basis-library/text/substring.sml

Index: substring.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/text/substring.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- substring.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ substring.sml	24 Nov 2002 01:19:41 -0000	1.3
@@ -7,210 +7,27 @@
  *)
 structure Substring: SUBSTRING =
    struct
-      open Int
-	 
-      structure String = String
-
-      datatype t = T of {str: string,
-			 start: int,
-			 size: int}
-      type substring = t
-
-      fun base (T {str, start, size}) = (str, start, size)
-	 
-      val string = String.substring o base
-
-      fun extract (slice as (str, start, _)): t =
-	 let val max = String0.checkSlice slice
-	 in T {str = str,
-	       start = start,
-	       size = max -? start}
-	 end
-      
-      fun substring (s, i, j) = extract (s, i, SOME j)
-
-      fun all s = substring (s, 0, String.size s)
-
-      fun isEmpty (T {size, ...}) = size = 0
-
-      fun getc (T {str, start, size}) =
-	 if size = 0
-	    then NONE
-	 else SOME (String.sub (str, start),
-		    T {str = str,
-		       start = start +? 1,
-		       size = size -? 1})
-
-      fun first ss =
-	 case getc ss of
-	    NONE => NONE
-	  | SOME (c, _) => SOME c
-
-      fun triml k =
-	 if Primitive.safe andalso k < 0
-	    then raise Subscript
-	 else
-	    (fn T {str, start, size} =>
-	     if k > size
-		then T {str = str, start = start +? size, size = 0}
-	     else T {str = str, start = start +? k, size = size -? k})
-
-      fun trimr k =
-	 if Primitive.safe andalso k < 0
-	    then raise Subscript
-	 else
-	    (fn T {str, start, size} =>
-	     T {str = str,
-	       start = start,
-	       size = if k > size then 0 else size -? k})
-
-      fun slice (T {str, start, size}, i, opt) =
-	 case opt of
-	    SOME m =>
-	       if Primitive.safe andalso 0 <= i
-		  andalso 0 <= m
-		  andalso i <= size -? m
-		  then T {str = str, start = start +? i, size = m}
-	       else raise Subscript
-	  | NONE =>
-	       if Primitive.safe andalso 0 <= i andalso i <= size
-		  then T {str = str, start = start +? i, size = size -? i}
-	       else raise Subscript
-		
-      fun sub (T {str, start, size}, i) =
-	 if Primitive.safe andalso Int.geu (i, size)
-	    then raise Subscript
-	 else String.sub (str, start +? i)
-
-      fun size (T {size, ...}) = size
-
-      fun concat substrings =
-	 let
-	    val size = List.foldl (fn (ss, n) => n +? size ss) 0 substrings
-	    val dst = Primitive.Array.array size
-	 in
-	    List.foldl (fn (T {str, start, size}, n) =>
-			let
-			   fun loop i =
-			      if i >= size then ()
-			      else (Array.update (dst, n +? i,
-						  String.sub (str, start +? i))
-				    ; loop (i + 1))
-			in loop 0;
-			   n +? size
-			end)
-	    0 substrings
-	    ; String.fromArray dst
-	 end
-
-      val explode = String.explode o string
-
-      fun explode (T {str, start, size}) =
-	 let
-	    fun loop (i, l) =
-	       if i < start
-		  then l
-	       else loop (i -? 1, String.sub (str, i) :: l)
-	 in
-	    loop (start +? size -? 1, [])
-	 end
-
-      fun isPrefix str' (T {str, start, size}) =
-	 let
-	    val size' = String.size str'
-	    fun loop (i, i') =
-	       i' >= size'
-	       orelse (String.sub (str, i) = String.sub (str', i')
-		       andalso loop (i +? 1, i' + 1))
-	 in
-	    size' <= size andalso loop (start, 0)
-	 end
-
-      fun collate comp (T {str, start, size},
-			T {str=str', start=start', size=size'}) =
-	 let
-	    val max = start +? size
-	    val max' = start' +? size'
-	    fun loop (i, i') =
-	       if i >= max
-		  then if i' = max'
-			  then EQUAL
-		       else LESS
-	       else if i' >= max'
-		       then GREATER
-		    else (case comp (String.sub (str, i),
-				     String.sub (str', i')) of
-			     EQUAL => loop (i + 1, i' + 1)
-			   | r => r)
-	 in loop (start, start')
-	 end
+      open Substring0
 
+      val size = length
+      val extract = slice
+      fun substring (s, start, len) = extract (s, start, SOME len)
+      val all = full
+      val string = vector
+      val getc = getItem
+      fun first ss = Option.map #1 (getItem ss)
+      val slice = subslice
+      val explode = toList
+      local
+	 fun make f = f (op = : char * char -> bool)
+      in
+	val isPrefix = make isPrefix
+	val isSubstring = make isSubvector
+	val isSuffix = make isSuffix
+	val position = make position
+      end
       val compare = collate Char.compare
-
-      fun split (T {str, start, size}, i) =
-	 (T {str = str, start = start, size = i -? start},
-	  T {str = str, start = i, size = size -? (i -? start)})
-
-      fun splitl f (ss as T {str, start, size}) =
-	 let
-	    val stop = start +? size
-	    fun loop i =
-	       if i >= stop
-		  then i
-	       else if f (String.sub (str, i))
-		       then loop (i + 1)
-		    else i
-	 in split (ss, loop start)
-	 end
-
-      fun splitr f (ss as T {str, start, size}) =
-	 let
-	    fun loop i =
-	       if i < start
-		  then start
-	       else if f (String.sub (str, i))
-		       then loop (i -? 1)
-		    else i +? 1
-	 in split (ss, loop (start +? size -? 1))
-	 end
-   
-      fun splitAt (T {str, start, size}, i) =
-	 if Primitive.safe andalso Int.gtu (i, size)
-	    then raise Subscript
-	 else (T {str = str, start = start, size = i},
-	       T {str = str, start = start +? i, size = size -? i})
-
-      fun takel p s = #1 (splitl p s)
-      fun dropl p s = #2 (splitl p s)
-      fun taker p s = #2 (splitr p s)
-      fun dropr p s = #1 (splitr p s)
-	     
-      fun position s' (ss as T {str=s, start, size}) =
-	 let
-	    val size' = String.size s'
-	    val max = start +? size -? size' +? 1
-	    (* loop returns the index of the front of suffix. *)
-	    fun loop i =
-	       if i >= max
-		  then start +? size
-	       else let
-		       fun loop' j =
-			  if j >= size'
-			     then i
-			  else if String.sub (s, i +? j) = String.sub (s', j)
-				  then loop' (j + 1)
-			       else loop (i + 1)
-		    in loop' 0
-		    end
-	 in split (ss, loop start)
-	 end
-
-      fun span (T {str = s, start = i, size = n},
-	       T {str = s', start = i', size = n'}) =
-	 if s = s' andalso i' +? n' >= i
-	    then T {str = s, start = i, size = i' +? n' -? i}
-	 else raise Span
-
+(*
       type cs = int
 	 
       fun reader (T {str, start, size}): (char, cs) Reader.reader =
@@ -224,45 +41,7 @@
 	 case f (reader ss) 0 of
 	    NONE => NONE
 	  | SOME (a, _) => SOME a
-
-      local
-	 fun make finish p (T {str, start, size}) =
-	    let
-	       val max = start +? size
-	       fun loop (i, start, sss) =
-		  if i >= max
-		     then rev (finish (str, start, i, sss))
-		  else
-		     if p (String.sub (str, i))
-			then loop (i + 1, i + 1, finish (str, start, i, sss))
-		     else loop (i + 1, start, sss)
-	    in loop (start, start, []) 
-	    end
-      in
-	 val tokens = make (fn (str, start, stop, sss) =>
-			   if start = stop
-			      then sss
-			   else
-			      T {str = str, start = start, size = stop -? start}
-			      :: sss)
-	 val fields = make (fn (str, start, stop, sss) =>
-			   T {str = str, start = start, size = stop -? start}
-			   :: sss)
-      end
-
-      local
-	 fun make naturalFold f b (T {str, size, start}) =
-	    naturalFold (size, b, fn (i, b) => 
-			 f (String.sub (str, start +? i), b))
-      in
-	 fun foldl f = make Util.naturalFold f
-	 fun foldr f = make Util.naturalFoldDown f
-      end
-
-      fun app f ss = foldl (f o #1) () ss
-
-      fun translate f ss =
-	 String.concat (rev (foldl (fn (c, l) => f c :: l) [] ss))
+*)
    end
 
 structure SubstringGlobal: SUBSTRING_GLOBAL = Substring



1.2       +12 -0     mlton/basis-library/text/text.sig




1.2       +8 -0      mlton/basis-library/text/text.sml




1.3       +5 -5      mlton/basis-library/top-level/infixes.sml

Index: infixes.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/top-level/infixes.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- infixes.sml	10 Apr 2002 07:02:18 -0000	1.2
+++ infixes.sml	24 Nov 2002 01:19:41 -0000	1.3
@@ -5,9 +5,9 @@
  * MLton is released under the GNU General Public License (GPL).
  * Please see the file MLton-LICENSE for license information.
  *)
-infix 7  * / mod div
-infix 6 ^ + -
-infix 3 := o
-infix 4 > < >= <= = <>
+infix  7 * / mod div
+infix  6 + - ^
 infixr 5 :: @
-infix 0 before
+infix  4 = <> > >= < <=
+infix  3 := o
+infix  0 before



1.4       +2 -0      mlton/basis-library/top-level/overloads.sml

Index: overloads.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/top-level/overloads.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- overloads.sml	31 May 2002 16:23:35 -0000	1.3
+++ overloads.sml	24 Nov 2002 01:19:41 -0000	1.4
@@ -9,6 +9,8 @@
 _overload ~ :   ('a -> 'a)
 as  Int.~
 and IntInf.~
+and Word.~
+and Word8.~
 and Real.~
 
 _overload + :   ('a * 'a -> 'a)



1.38      +4 -4      mlton/benchmark/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/Makefile,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- Makefile	6 Nov 2002 22:00:59 -0000	1.37
+++ Makefile	24 Nov 2002 01:19:41 -0000	1.38
@@ -2,7 +2,7 @@
 BUILD = $(SRC)/build
 BIN = $(BUILD)/bin
 LIB = $(BUILD)/lib
-MLTON = mlton
+MLTON = $(BIN)/mlton
 HOST = self
 FLAGS = -host $(HOST)
 NAME = benchmark
@@ -27,7 +27,8 @@
 $(NAME)-stubs_cm: 
 	(								\
 		echo 'Group is'&&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' &&	\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' &&		\
 		echo 'call-main.sml';					\
 	) >$(NAME)-stubs.cm
 
@@ -55,8 +56,7 @@
 test: $(NAME)
 	export PATH=$(PATH):$$PATH && cd tests && ../benchmark $(BFLAGS) $(BENCH)
 
-QBENCH = $(BENCH)
-
+QBENCH = $(BFLAGS)
 QBFLAGS = -mlton "mlton"
 
 .PHONY: qtest



1.3       +1 -0      mlton/benchmark/benchmark-stubs.cm

Index: benchmark-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/benchmark-stubs.cm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- benchmark-stubs.cm	7 Nov 2002 01:36:52 -0000	1.2
+++ benchmark-stubs.cm	24 Nov 2002 01:19:41 -0000	1.3
@@ -1,5 +1,6 @@
 Group is
 ../lib/mlton-stubs/thread.sml
+../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/random.sig
 ../lib/mlton-stubs/random.sml
 ../lib/mlton-stubs/world.sig



1.3       +6 -1      mlton/benchmark/tests/md5.sml

Index: md5.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/md5.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- md5.sml	27 Sep 2002 23:46:29 -0000	1.2
+++ md5.sml	24 Nov 2002 01:19:41 -0000	1.3
@@ -17,7 +17,12 @@
 structure MD5 :> MD5 =
   struct
     structure W32 = Word32
-    structure W8V = Word8Vector
+    structure W8V = 
+      struct
+	open Word8Vector
+	fun extract (vec, s, l) = 
+	  Word8VectorSlice.vector (Word8VectorSlice.slice (vec, s, l))
+      end
     type word64  = {hi:W32.word,lo:W32.word}
     type word128 = {A:W32.word, B:W32.word, C:W32.word,  D:W32.word}
     type md5state = {digest:word128,



1.3       +26 -5     mlton/benchmark/tests/tensor.sml

Index: tensor.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/tensor.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- tensor.sml	27 Sep 2002 23:46:29 -0000	1.2
+++ tensor.sml	24 Nov 2002 01:19:41 -0000	1.3
@@ -1,4 +1,26 @@
 (* Obtained at http://www.arrakis.es/~worm/ *)
+
+signature MONO_VECTOR =
+  sig
+    type vector
+    type elem
+    val maxLen : int
+    val fromList : elem list -> vector
+    val tabulate : (int * (int -> elem)) -> vector
+    val length : vector -> int
+    val sub : (vector * int) -> elem
+    val extract : (vector * int * int option) -> vector
+    val concat : vector list -> vector
+    val mapi : ((int * elem) -> elem) -> (vector * int * int option) -> vector
+    val map : (elem -> elem) -> vector -> vector
+    val appi : ((int * elem) -> unit) -> (vector * int * int option) -> unit
+    val app : (elem -> unit) -> vector -> unit
+    val foldli : ((int * elem * 'a) -> 'a) -> 'a -> (vector * int * int option) -> 'a
+    val foldri : ((int * elem * 'a) -> 'a) -> 'a -> (vector * int * int option) -> 'a
+    val foldl : ((elem * 'a) -> 'a) -> 'a -> vector -> 'a
+    val foldr : ((elem * 'a) -> 'a) -> 'a -> vector -> 'a 
+  end
+
 (*
  Copyright (c) Juan Jose Garcia Ripoll.
  All rights reserved.
@@ -645,7 +667,7 @@
 		    raise Match
 	end
 
-	fun appi f tensor = Array.appi f (toArray tensor, 0, NONE)
+	fun appi f tensor = Array.appi f (toArray tensor)
 
 	fun app f tensor = Array.app f (toArray tensor)
 
@@ -1382,7 +1404,6 @@
 
 	fun foldl f init a = foldli (fn (_, a, x) => f(a,x)) init (a,0,NONE)
 	fun foldr f init a = foldri (fn (_, x, a) => f(x,a)) init (a,0,NONE)
-
     end
 end (* BasicCNumberArray *)
 
@@ -1658,7 +1679,7 @@
 	    fun print_one (i,x) =
 		(print(cvt x); if not(i = length) then print ", " else ())
 	in
-	    Array.appi print_one (a, 0, NONE)
+	    Array.appi print_one a
 	end
     fun boolArray a = array Bool.toString a
     fun intArray a = array Int.toString a
@@ -1982,7 +2003,7 @@
 		else
 		    raise Match
 	end
-	fun appi f tensor = Array.appi f (toArray tensor, 0, NONE)
+	fun appi f tensor = Array.appi f (toArray tensor)
 	fun app f tensor = Array.app f (toArray tensor)
 	fun all f tensor =
 	    let val a = toArray tensor
@@ -2267,7 +2288,7 @@
 		else
 		    raise Match
 	end
-	fun appi f tensor = Array.appi f (toArray tensor, 0, NONE)
+	fun appi f tensor = Array.appi f (toArray tensor)
 	fun app f tensor = Array.app f (toArray tensor)
 	fun all f tensor =
 	    let val a = toArray tensor



1.9       +282 -24   mlton/bin/check-basis

Index: check-basis
===================================================================
RCS file: /cvsroot/mlton/mlton/bin/check-basis,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- check-basis	29 Oct 2002 06:08:23 -0000	1.8
+++ check-basis	24 Nov 2002 01:19:41 -0000	1.9
@@ -7,14 +7,62 @@
 
 name=`basename $0`
 
-usage () {
-	echo >&2 "usage: $name"
+function usage() {
+	echo >&2 "usage: $name lib [file.sml | file.cm]"
 	exit 1
 }
 
+function rewrite() {
+	sed 's/_build_const\(.*\);/(PRIM\1)/' |
+	sed 's/_build_const/PRIM/' |
+	sed 's/_const\(.*\);/(PRIM\1)/' |
+	sed 's/_const/PRIM/' |
+	sed 's/_prim\(.*\);/(PRIM\1)/' |
+	sed 's/_prim/PRIM/' |
+	sed 's/_ffi\(.*\);/(PRIM\1)/' |
+	sed 's/_ffi/PRIM/' |
+	sed 's/fun bigIntConstant x = x/fun bigIntConstant(x:smallInt):bigInt = raise Fail "bigIntConstant"/' |
+	sed 's/#"\([^"\]*\(\\.[^"\]*\)*\)"/#ZZZ\1ZZZ/g' |
+	sed 's/\([^\]\)"\([^"\]*\(\\.[^"\]*\)*\)"/\1(STRING_CONST "\2")/g' |
+	sed 's/#ZZZ\(\(.\)\|\(..\)\|\([^Z][^Z][^Z].*\)\)ZZZ/#"\1"/g' |
+        sed 's/(\*#line 0.0 \(.*\)\*)/(*#line 0.0 "\1"*)/'
+}
+
+REWRITE_FILE=""
+function rewrite_file() {
+(
+	echo "(*#line 0.0 $REWRITE_FILE*)"
+	cat $REWRITE_FILE 
+) | rewrite
+}
+
+REWRITE_FILES=""
+function rewrite_files() {
+for f in `cat $REWRITE_FILES | grep -v "^#" | grep -v overload | grep -v Group`; do
+	echo "(*#line 0.0 $f*)"
+        cat $f
+done | rewrite
+}
+
+SML_FILE=""
+CM_FILE=""
+LIB=""
 case "$#" in
 0)
+	usage
+	;;
+1)
+	LIB=$1
 	;;
+2)
+	LIB=$1
+	if [ "$2" == "`basename $2 .sml`.sml" -a -r "$2" ]; then
+		SML_FILE=$2
+	elif [ "$2" == "`basename $2 .cm`.cm" -a -r "$2" ]; then
+		CM_FILE=$2
+	else usage
+        fi
+        ;;
 *)
 	usage
 	;;
@@ -22,37 +70,247 @@
 
 dir=`dirname $0`
 root=`cd $dir/.. && pwd`
+here=`pwd`
 basis="$root/basis-library/basis.sml"
 
-cd $root/basis-library
 rm -f $basis
 (
 cat <<-EOF
 	val _ = SMLofNJ.Internals.GC.messages false;
-	fun PRIM x = raise Fail "_prim"
-	datatype pointer = T
-        datatype preThread = T
-	datatype thread = T
-	type word8 = Word8.word
-	type word = Word32.word
-	type int = Int32.int
-	type intInf = int
+	fun PRIM (x:char vector) = raise Fail "_prim"
+	fun STRING_CONST (x:string) : char vector = raise Fail "<string constant>"
+        structure Types = struct
+          type 'a array = 'a array
+          datatype bool = datatype bool
+          type char = char
+          type exn = exn
+          type int = Int32.int
+          type intInf = int
+          datatype list = datatype list
+          datatype pointer = T
+          type real = real
+          datatype ref = datatype ref
+          datatype preThread = T
+          datatype thread = T
+          type word = Word32.word
+          type word8 = Word8.word
+          type 'a vector = 'a vector
+          
+          datatype 'a option = T
+        end
+        signature GENERAL = sig end
+        structure General = struct end
+        signature OPTION = sig end
+        structure Option = struct end
+        signature BOOL = sig end
+        structure Bool = struct end
+        signature SML90 = sig end
+        structure SML90 = struct end
+        signature CHAR = sig end
+        structure Char = struct end
+        structure WideChar = struct end
+        signature STRING = sig end
+        structure String = struct end
+        structure WideString = struct end
+        signature SUBSTRING = sig end
+        structure Substring = struct end
+        structure WideSubstring = struct end
+        signature STRING_CVT = sig end
+        structure StringCvt = struct end
+        signature BYTE = sig end
+        structure Byte = struct end
+        signature INTEGER = sig end
+        structure Int = struct end
+        structure Int8 = struct end
+        structure Int16 = struct end
+        structure Int32 = struct end
+        structure Int64 = struct end
+        structure FixedInt = struct end
+        structure LargeInt = struct end
+        structure Position = struct end
+        signature INT_INF = sig end
+        structure IntInf = struct end
+        signature WORD = sig end
+        structure Word = struct end
+        structure Word8 = struct end
+        structure Word16 = struct end
+        structure Word32 = struct end
+        structure Word64 = struct end
+        structure LargeWord = struct end
+        structure SysWord = struct end
+        signature PACK_WORD = sig end
+        structure Pack8Big = struct end
+        structure Pack8Little = struct end
+        structure Pack16Big = struct end
+        structure Pack16Little = struct end
+        structure Pack32Big = struct end
+        structure Pack32Little = struct end
+        structure Pack64Big = struct end
+        structure Pack64Little = struct end
+        signature REAL = sig end
+        structure Real = struct end
+        structure Real32 = struct end
+        structure Real64 = struct end
+        structure Real128 = struct end
+        structure LargeReal = struct end
+        signature MATH = sig end
+        structure Math = struct end
+        signature IEEE_REAL = sig end
+        structure IEEEReal = struct end
+        signature PACK_REAL = sig end
+        structure PackRealBig = struct end
+        structure PackRealLittle = struct end
+        structure PackReal32Big = struct end
+        structure PackReal32Little = struct end
+        structure PackReal64Big = struct end
+        structure PackReal64Little = struct end
+        structure PackReal128Big = struct end
+        structure PackReal128Little = struct end
+        signature LIST = sig end
+        structure List = struct end
+        signature LIST_PAIR = sig end
+        structure ListPair = struct end
+        signature VECTOR = sig end
+        structure Vector = struct end
+        signature MONO_VECTOR = sig end
+        structure CharVector = struct end
+        structure WideCharVector = struct end
+        structure BoolVector = struct end
+        structure IntVector = struct end
+        structure RealVector = struct end
+        structure WordVector = struct end
+        structure Int8Vector = struct end
+        structure Int16Vector = struct end
+        structure Int32Vector = struct end
+        structure Int64Vector = struct end
+        structure Real32Vector = struct end
+        structure Real64Vector = struct end
+        structure Real128Vector = struct end
+        structure Word8Vector = struct end
+        structure Word16Vector = struct end
+        structure Word32Vector = struct end
+        structure Word64Vector = struct end
+        signature ARRAY = sig end
+        structure Array = struct end
+        signature MONO_ARRAY = sig end
+        structure CharArray = struct end
+        structure WideCharArray = struct end
+        structure BoolArray = struct end
+        structure IntArray = struct end
+        structure RealArray = struct end
+        structure WordArray = struct end
+        structure Int8Array = struct end
+        structure Int16Array = struct end
+        structure Int32Array = struct end
+        structure Int64Array = struct end
+        structure Real32Array = struct end
+        structure Real64Array = struct end
+        structure Real128Array = struct end
+        structure Word8Array = struct end
+        structure Word16Array = struct end
+        structure Word32Array = struct end
+        structure Word64Array = struct end
+        signature ARRAY2 = sig end
+        structure Array2 = struct end
+        signature MONO_ARRAY2 = sig end
+        structure CharArray2 = struct end
+        structure WideCharArray2 = struct end
+        structure BoolArray2 = struct end
+        structure IntArray2 = struct end
+        structure RealArray2 = struct end
+        structure WordArray2 = struct end
+        structure Int8Array2 = struct end
+        structure Int16Array2 = struct end
+        structure Int32Array2 = struct end
+        structure Int64Array2 = struct end
+        structure Real32Array2 = struct end
+        structure Real64Array2 = struct end
+        structure Real128Array2 = struct end
+        structure Word8Array2 = struct end
+        structure Word16Array2 = struct end
+        structure Word32Array2 = struct end
+        structure Word64Array2 = struct end
+        signature IO = sig end
+        structure IO = struct end
+        signature TEXT_IO = sig end
+        structure TextIO = struct end
+        signature TEXT_STREAM_IO = sig end
+        signature BIN_IO = sig end
+        structure BinIO = struct end
+        signature IMPERATIVE_IO = sig end
+        functor ImperativeIO () = struct end
+        signature STREAM_IO = sig end
+        functor StreamIO () = struct end
+        signature PRIM_IO = sig end
+        structure BinPrimIO = struct end
+        structure TextPrimIO = struct end
+        structure WideTextPrimIO = struct end
+        functor PrimIO () = struct end
+        signature OS = sig end
+        structure OS = struct end
+        signature OS_FILE_SYS = sig end
+        signature OS_IO = sig end
+        signature OS_PATH = sig end
+        signature OS_PROCESS = sig end
+        signature COMMAND_LINE = sig end
+        structure CommandLine = struct end
+        signature UNIX = sig end
+        structure Unix = struct end
+        signature DATE = sig end
+        structure Date = struct end
+        signature TIME = sig end
+        structure Time = struct end
+        signature TIMER = sig end
+        structure Timer = struct end
+        signature POSIX = sig end
+        structure Posix = struct end
+        signature POSIX_ERROR = sig end
+        signature POSIX_FILE_SYS = sig end
+        signature POSIX_FLAGS = sig end
+        signature POSIX_IO = sig end
+        signature POSIX_PROC_ENV = sig end
+        signature POSIX_PROCESS = sig end
+        signature POSIX_SIGNAL = sig end
+        signature POSIX_SYS_DB = sig end
+        signature POSIX_TTY = sig end
 	nonfix * / mod div ^ + - := o > < >= <= = <> :: @ before
+
+        open Types
 EOF
-for f in `(cat build-basis; cat bind-basis) | grep -v overload`; do
-	echo "(*#line 1.0 \"$f\"*)"
-	cat $f
-done |
-	sed 's/_build_const\(.*\);/(PRIM\1)/' |
-	sed 's/_build_const/PRIM/' |
-	sed 's/_const\(.*\);/(PRIM\1)/' |
-	sed 's/_const/PRIM/' |
-	sed 's/_prim\(.*\);/(PRIM\1)/' |
-	sed 's/_prim/PRIM/' |
-	sed 's/_ffi\(.*\);/(PRIM\1)/' |
-	sed 's/_ffi/PRIM/' |
-	sed 's/fun bigIntConstant x = x/fun bigIntConstant(x:smallInt):bigInt = raise Fail "bigIntConstant"/'
 cat <<-EOF
+	local
+EOF
+cd $root/basis-library
+REWRITE_FILES="libs/build"
+rewrite_files
+cat <<-EOF
+	in
+EOF
+cd $root/basis-library
+REWRITE_FILES="libs/$LIB/bind"
+rewrite_files
+cat <<-EOF
+	end
+EOF
+cd $here
+case "$SML_FILE" in
+"")
+	;;
+*)
+	REWRITE_FILE=$SML_FILE
+	rewrite_file
+	;;
+esac
+case "$CM_FILE" in
+"")
+	;;
+*)
+	REWRITE_FILES=$CM_FILE
+	rewrite_files
+	;;
+esac
+cat <<-EOF
+	(*#line 0.0 "check-basis"*)
 	val _ = () ()
 EOF
 ) >$basis



1.9       +5 -0      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- changelog	22 Nov 2002 22:46:15 -0000	1.8
+++ changelog	24 Nov 2002 01:19:41 -0000	1.9
@@ -1,5 +1,10 @@
 Here are the changes from version 20020923.
 
+* 2002-11-23
+  - Added support for the latest Basis Library specification.
+  - Added option -basis to choose Basis Library version.  Currently available
+    basis libraries are basis-2002, basis-2002-strict, basis-1997, and none.
+	
 * 2002-11-22
   - Fixed bug that caused time profiling to fail (with a segfault) when resuming
     a saved world. 



1.11      +71 -30    mlton/doc/user-guide/basis.tex

Index: basis.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/basis.tex,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- basis.tex	2 Nov 2002 03:37:35 -0000	1.10
+++ basis.tex	24 Nov 2002 01:19:41 -0000	1.11
@@ -2,7 +2,7 @@
 
 This section describes the portion that {\mlton} implements of the Standard ML
 Basis Library specified at
-\link{http://cm.bell-labs.com/cm/cs/what/smlnj/doc/basis/index.html}.
+\link{http://SML.sourceforge.net/Basis/index.html}.
 
 \subsection{Top level values}
 
@@ -25,6 +25,7 @@
 
 \begin{longtable}{lll}
 \fullmodule{Array}{ARRAY}
+\fullmodule{ArraySlice}{ARRAY\_SLICE}
 \fullmodule{Array2}{ARRAY2}
 \module{BinIO}{BIN\_IO}
        {Missing:
@@ -32,15 +33,35 @@
  {\tt scanStream},
  {\tt setPosIn},
  {\tt setPosOut}.}
+\extra{Missing: 
+ {\tt StreamIO.reader},
+ {\tt StreamIO.writer},
+ {\tt StreamIO.mkInstream},
+ {\tt StreamIO.getReader},
+ {\tt StreamIO.output},
+ {\tt StreamIO.output1},
+ {\tt StreamIO.flushOut},
+ {\tt StreamIO.closeOut},
+ {\tt StreamIO.setBufferMode},
+ {\tt StreamIO.getBufferMode},
+ {\tt StreamIO.mkOutstream},
+ {\tt StreamIO.getWriter},
+ {\tt StreamIO.getPosOut},
+ {\tt StreamIO.setPosOut}}
+\fullmodule{BinPrimIO}{PRIM\_IO}
 \fullmodule{Bool}{BOOL}
 \fullmodule{BoolArray}{MONO\_ARRAY}
-\fullmodule{BoolArray2}{MONO\_ARRAY2}
+\fullmodule{BoolArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{BoolVector}{MONO\_VECTOR}
+\fullmodule{BoolVectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{BoolArray2}{MONO\_ARRAY2}
 \fullmodule{Byte}{BYTE}
 \fullmodule{Char}{CHAR}
 \fullmodule{CharArray}{MONO\_ARRAY}
-\fullmodule{CharArray2}{MONO\_ARRAY2}
+\fullmodule{CharArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{CharVector}{MONO\_VECTOR}
+\fullmodule{CharVectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{CharArray2}{MONO\_ARRAY2}
 \fullmodule{CommandLine}{COMMAND\_LINE}
 \fullmodule{Date}{DATE}
 \fullmodule{FixedInt}{INTEGER}
@@ -48,13 +69,18 @@
 \fullmodule{IEEEReal}{IEEE\_REAL}
 \fullmodule{IO}{IO}
 \fullmodule{Int}{INTEGER}
-\fullmodule{Int32}{INTEGER}
 \fullmodule{IntArray}{MONO\_ARRAY}
-\fullmodule{IntArray2}{MONO\_ARRAY2}
-\module{IntInf}{INT\_INF}
-       {Missing: {\tt orb}, {\tt xorb}, {\tt andb},
-         {\tt notb}, {\tt <<}, {\tt \~{}>>}}
+\fullmodule{IntArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{IntVector}{MONO\_VECTOR}
+\fullmodule{IntVectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{IntArray2}{MONO\_ARRAY2}
+\fullmodule{Int32}{INTEGER}
+\fullmodule{Int32Array}{MONO\_ARRAY}
+\fullmodule{Int32ArraySlice}{MONO\_ARRAY\_SLICE}
+\fullmodule{Int32Vector}{MONO\_VECTOR}
+\fullmodule{Int32VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Int32Array2}{MONO\_ARRAY2}
+\fullmodule{IntInf}{INT\_INF}
 \fullmodule{LargeInt}{INTEGER}
 \module{LargeReal}{REAL}{Same as {\tt Real}}
 \fullmodule{LargeWord}{WORD}
@@ -65,25 +91,9 @@
 \fullmodule{OS.FileSys}{OS\_FILE\_SYS}
 \extra{Use of {\tt OS.FileSys.tmpName} causes a link-time warning.}
 \extra{You can use {\tt MLton.TextIO.mkstemp} instead.}
-\module{OS.IO}
-       {OS\_IO}
-       {Missing: {\tt type poll\_desc},
-                 {\tt type poll\_info},
-                 {\tt exception Poll},}
-\extra{
-  {\tt infoToPollDesc},
-  {\tt isIn},
-  {\tt isOut},
-  {\tt isPri},
-  {\tt pollDesc},
-  {\tt pollIn},}
-\extra{
-  {\tt pollOut},
-  {\tt pollPri},
-  {\tt pollToIODesc},
-  {\tt poll}.}
+\fullmodule{OS.IO}{OS\_IO}
 \module{OS.Path}{OS\_PATH}
-       {Missing: {\tt exception InvalidArc}, {\tt toUnixPath},
+       {Missing: {\tt toUnixPath},
         {\tt fromUnixPath}.}
 \fullmodule{OS.Process}{OS\_PROCESS}
 \fullmodule{Pack32Big}{PACK\_WORD}
@@ -96,29 +106,60 @@
        {Missing: {\tt nextAfter}, {\tt toDecimal}, {\tt fromDecimal}.}
 \extra{Do not match spec: {\tt scan}, {\tt fmt}, {\tt toString}, {\tt
         fromString}.}
-\fullmodule{Real64Array}{MONO\_ARRAY}
 \fullmodule{RealArray}{MONO\_ARRAY}
-\fullmodule{RealArray2}{MONO\_ARRAY2}
+\fullmodule{RealArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{RealVector}{MONO\_VECTOR}
-\fullmodule{SML90}{SML90}
+\fullmodule{RealVectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{RealArray2}{MONO\_ARRAY2}
+\module{Real64}{REAL}{Same as {\tt Real}}
+\fullmodule{Real64Array}{MONO\_ARRAY}
+\fullmodule{Real64ArraySlice}{MONO\_ARRAY\_SLICE}
+\fullmodule{Real64Vector}{MONO\_VECTOR}
+\fullmodule{Real64VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Real64Array2}{MONO\_ARRAY2}
 \fullmodule{String}{STRING}
 \fullmodule{StringCvt}{STRING\_CVT}
 \fullmodule{Substring}{SUBSTRING}
 \fullmodule{SysWord}{WORD}
+\fullmodule{Text}{TEXT}
 \module{TextIO}{TEXT\_IO}
        {Missing:
  {\tt getPosIn},
  {\tt openString},
  {\tt setPosIn},
  {\tt setPosOut}.}
+\extra{Missing: 
+ {\tt StreamIO.reader},
+ {\tt StreamIO.writer},
+ {\tt StreamIO.mkInstream},
+ {\tt StreamIO.getReader},
+ {\tt StreamIO.output},
+ {\tt StreamIO.output1},
+ {\tt StreamIO.flushOut},
+ {\tt StreamIO.closeOut},
+ {\tt StreamIO.setBufferMode},
+ {\tt StreamIO.getBufferMode},
+ {\tt StreamIO.mkOutstream},
+ {\tt StreamIO.getWriter},
+ {\tt StreamIO.getPosOut},
+ {\tt StreamIO.setPosOut}}
+\fullmodule{TextPrimIO}{PRIM\_IO}
 \fullmodule{Time}{TIME}
 \fullmodule{Timer}{TIMER}
 \fullmodule{Unix}{UNIX}
 \fullmodule{Vector}{VECTOR}
+\fullmodule{VectorSlice}{VECTOR\_SLICE}
 \fullmodule{Word}{WORD}
 \fullmodule{Word8}{WORD}
 \fullmodule{Word8Array}{MONO\_ARRAY}
-\fullmodule{Word8Array2}{MONO\_ARRAY2}
+\fullmodule{Word8ArraySlice}{MONO\_ARRAY\_SLICE}
 \fullmodule{Word8Vector}{MONO\_VECTOR}
+\fullmodule{Word8VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Word8Array2}{MONO\_ARRAY2}
 \fullmodule{Word32}{WORD}
+\fullmodule{Word32Array}{MONO\_ARRAY}
+\fullmodule{Word32ArraySlice}{MONO\_ARRAY\_SLICE}
+\fullmodule{Word32Vector}{MONO\_VECTOR}
+\fullmodule{Word32VectorSlice}{MONO\_VECTOR\_SLICE}
+\fullmodule{Word32Array2}{MONO\_ARRAY2}
 \end{longtable}



1.29      +19 -0     mlton/doc/user-guide/extensions.tex

Index: extensions.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/extensions.tex,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- extensions.tex	2 Nov 2002 03:37:35 -0000	1.28
+++ extensions.tex	24 Nov 2002 01:19:41 -0000	1.29
@@ -1044,3 +1044,22 @@
       where type elem = Real64Array.elem
   end
 \end{verbatim}
+
+\subsec{{\tt Basis1997: BASIS\_1997}}{basis1997}
+
+Opening this module at the top-level will, for the most part, simulate
+the Basis Library as implemented in previous versions of {\mlton}.
+However, there are two major caveats.  First, {\tt Basis1997} inherits
+much of the current Basis Library implementation.  Hence, some
+functions violate the stated semantics of the previous Basis Library
+specification.  For the most part, such violations are benign; the
+major exception is the {\tt Time} module which now supports negative
+time-values.  Second, since Standard ML does not support declaring
+signatures within structures, opening this module will not introduce
+signatures.  To recover such signatures, compile with {\tt -basis
+basis-1997}.
+
+\subsection{{\tt SML90: SML90}}
+
+This module has been removed from the latest Basis Library
+specification.  It is included for backwards compatiblility.



1.23      +10 -0     mlton/doc/user-guide/man-page.tex

Index: man-page.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/man-page.tex,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- man-page.tex	2 Nov 2002 03:37:35 -0000	1.22
+++ man-page.tex	24 Nov 2002 01:19:41 -0000	1.23
@@ -35,6 +35,16 @@
 
 \begin{description}
 
+\option{-basis \{basis-2002|basis-2002-strict|basis-1997|none\}}
+Selects a Basis Library to be used by the input program.  {\tt
+basis-2002} and {\tt basis-2002-strict} implement the current Basis
+Library specification; {\tt basis-2002-strict} removes all extensions
+described in \secref{mlton}.  {\tt basis-1997} implements a previous
+version of the Basis Library specification; see \secref{basis1997} for
+more information.  {\tt none} removes all Basis Library functionality;
+the only bound identifier is {\tt =} corresponding to polymorphic
+equality.
+
 \option{-detect-overflow \{true|false\}}
 This flag controls whether or not overflow checking is performed on integer
 arithmetic, in particular on {\tt Int.\{+,-,*,\~{},div,quot\}}.



1.41      +0 -3      mlton/include/ccodegen.h

Index: ccodegen.h
===================================================================
RCS file: /cvsroot/mlton/mlton/include/ccodegen.h,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- ccodegen.h	22 Nov 2002 02:48:20 -0000	1.40
+++ ccodegen.h	24 Nov 2002 01:19:41 -0000	1.41
@@ -647,10 +647,7 @@
 /*                      String                       */
 /* ------------------------------------------------- */
 
-#define String_size GC_arrayNumElements
-#define String_fromCharVector(x) x
 #define String_fromWord8Vector(x) x
-#define String_toCharVector(x) x
 #define String_toWord8Vector(x) x
 
 /* ------------------------------------------------- */



1.1                  mlton/lib/basis-stubs/Makefile

Index: Makefile
===================================================================

.PHONY: clean
clean:
	../../bin/clean



1.1                  mlton/lib/basis-stubs/basis-2002.sml

Index: basis-2002.sml
===================================================================
structure Basis2002 = 
   struct
      structure Array = Array
      structure Array2 = Array2
      structure BinIO = BinIO
      structure Bool = Bool
      structure Byte = Byte
      structure Char = Char
      structure CharArray = CharArray
      structure CharVector = CharVector
      structure CommandLine = CommandLine
      structure Date = Date
      structure General = General
      structure IEEEReal = IEEEReal
      structure Int = Int
      structure Int32 = Int32
      structure IntInf = IntInf
      structure IO = IO
      structure LargeInt = LargeInt
      structure LargeReal = LargeReal
      structure LargeWord = LargeWord
      structure List = List
      structure ListPair = ListPair
      structure Math = Math
      structure OS = OS
      structure Option = Option
      structure Pack32Big = Pack32Big
      structure Pack32Little = Pack32Little
      structure Position = Position
      structure Posix = Posix
      structure Real = Real
      structure Real64Array = Real64Array
      structure RealArray = RealArray
      structure RealVector = RealVector
      structure SML90 = SML90
      structure SMLofNJ = SMLofNJ
      structure String = String
      structure StringCvt = StringCvt
      structure Substring = Substring
      structure SysWord = SysWord
      structure TextIO = TextIO
      structure Time = Time
      structure Unix = Unix
      structure Unsafe = Unsafe
      structure Vector = Vector
      structure Word = Word
      structure Word32 = Word32
      structure Word8 = Word8
      structure Word8Array = Word8Array
      structure Word8Vector = Word8Vector
   end



1.1                  mlton/lib/basis-stubs/os.sml

Index: os.sml
===================================================================

structure OS =
   struct
      open OS
	
      structure FileSys =
	 struct
	    open FileSys

	    val readDir = fn d =>
	       case readDir d of
		  "" => NONE
		| s => SOME s
	 end
   end



1.1                  mlton/lib/basis-stubs/sources.cm

Index: sources.cm
===================================================================
Library

structure Basis2002

is

#if (SMLNJ_VERSION == 110) && (SMLNJ_MINOR_VERSION >= 20)
$/basis.cm
$/smlnj-lib.cm
#endif

basis-2002.sml
os.sml



1.3       +2 -5      mlton/lib/mlton/basic/dir.sml

Index: dir.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/dir.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- dir.sml	10 Apr 2002 07:50:30 -0000	1.2
+++ dir.sml	24 Nov 2002 01:19:42 -0000	1.3
@@ -45,10 +45,8 @@
       val stream = FS.openDir d
       fun loop a =
 	 case FS.readDir stream of
-	    "" => a
-	  | "." => raise Fail "read saw ."
-	  | ".." => raise Fail "read saw .."
-	  | s => loop (f (s, a))
+	    NONE => a
+	  | SOME s => loop (f (s, a))
    in DynamicWind.wind (fn () => loop a, fn () => FS.closeDir stream)
    end
 
@@ -91,5 +89,4 @@
       DynamicWind.wind (fn () => inDir (d, fn _ => thunk ()),
 			fn () => removeR d)
    end
-
 end



1.5       +0 -1      mlton/lib/mlton/basic/init-script.sml

Index: init-script.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/init-script.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- init-script.sml	10 Apr 2002 07:50:31 -0000	1.4
+++ init-script.sml	24 Nov 2002 01:19:42 -0000	1.5
@@ -88,5 +88,4 @@
     | "stop" => stop ()
     | _ => usage "must start|status|stop"
    end
-
 end



1.7       +2 -1      mlton/lib/mlton/basic/process.sig

Index: process.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/process.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- process.sig	7 Nov 2002 01:36:54 -0000	1.6
+++ process.sig	24 Nov 2002 01:19:42 -0000	1.7
@@ -100,6 +100,7 @@
 		       pid: Pid.t,
 		       ppid: Pid.t,
 		       state: State.t} list
+
    end
 
 functor TestProcess (S: PROCESS): sig end =
@@ -110,5 +111,5 @@
 open S
 
 val _ = ps ()
-   
+
 end



1.6       +1 -1      mlton/lib/mlton/basic/string0.sml

Index: string0.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/string0.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- string0.sml	14 Nov 2002 22:28:12 -0000	1.5
+++ string0.sml	24 Nov 2002 01:19:42 -0000	1.6
@@ -199,7 +199,7 @@
 fun alphabetize s = implode (sort (explode s, Char.<))
 
 fun fromCharArray (a: CharArray.array): t =
-   CharArray.extract (a, 0, NONE)
+   CharVector.tabulate (CharArray.length a, fn i => CharArray.sub (a, i))
 
 fun toString s = s
 



1.5       +2 -0      mlton/lib/mlton/pervasive/pervasive.sml

Index: pervasive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/pervasive/pervasive.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- pervasive.sml	20 Jul 2002 23:14:01 -0000	1.4
+++ pervasive.sml	24 Nov 2002 01:19:42 -0000	1.5
@@ -33,7 +33,9 @@
       structure Position = Position
       structure Posix = Posix
       structure Real = Real
+(*
       structure SML90 = SML90
+*)
       structure SMLofNJ = SMLofNJ
       structure String = String
       structure StringCvt = StringCvt



1.4       +1 -0      mlton/lib/mlton-stubs/sources.cm

Index: sources.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/sources.cm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- sources.cm	2 Nov 2002 03:37:37 -0000	1.3
+++ sources.cm	24 Nov 2002 01:19:42 -0000	1.4
@@ -66,6 +66,7 @@
 exn.sig
 gc.sig
 int-inf.sig
+int-inf.sml
 io.sig
 itimer.sig
 mlton.sig



1.1                  mlton/lib/mlton-stubs/int-inf.sml

Index: int-inf.sml
===================================================================

structure IntInf =
   struct
      open IntInf

      val orb: int * int -> int =
	 fn _ => raise Fail "IntInf.orb"
      val xorb: int * int -> int =
	 fn _ => raise Fail "IntInf.xorb"
      val andb: int * int -> int =
	 fn _ => raise Fail "IntInf.andb"
      val notb: int -> int =
	 fn _ => raise Fail "IntInf.notb"
      val << : int * Word.word -> int =
	 fn _ => raise Fail "IntInf.<<"
      val ~>> : int * Word.word -> int =
	 fn _ => raise Fail "IntInf.~>>"
   end


1.4       +1 -0      mlton/lib/mlton-stubs-in-smlnj/import.cm

Index: import.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/import.cm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- import.cm	3 Feb 2002 20:43:34 -0000	1.3
+++ import.cm	24 Nov 2002 01:19:42 -0000	1.4
@@ -8,4 +8,5 @@
 $/basis.cm
 $/smlnj-lib.cm
 #endif
+../basis-stubs/sources.cm
 pervasive.sml



1.3       +1 -1      mlton/lib/mlton-stubs-in-smlnj/os.sml

Index: os.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/os.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- os.sml	9 Oct 2001 00:17:49 -0000	1.2
+++ os.sml	24 Nov 2002 01:19:42 -0000	1.3
@@ -1,6 +1,6 @@
 structure OS =
    struct
-      open OS
+      open Pervasive.OS
 
       structure FileSys =
 	 struct



1.3       +1 -0      mlton/lib/mlton-stubs-in-smlnj/pervasive.sml

Index: pervasive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/pervasive.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- pervasive.sml	3 Feb 2002 20:43:34 -0000	1.2
+++ pervasive.sml	24 Nov 2002 01:19:42 -0000	1.3
@@ -1,5 +1,6 @@
 structure Pervasive =
    struct
+      open Basis2002
       structure Array = Array
       structure Array2 = Array2
       structure Bool = Bool



1.18      +3 -2      mlton/mllex/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/mllex/Makefile,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- Makefile	21 Nov 2002 02:49:21 -0000	1.17
+++ Makefile	24 Nov 2002 01:19:42 -0000	1.18
@@ -25,8 +25,9 @@
 .PHONY:	$(NAME)-stubs_cm
 $(NAME)-stubs_cm: 
 	(								\
-		echo 'Group is'&&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' &&	\
+		echo 'Group is' &&					\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' &&		\
 		echo 'call-main.sml';					\
 	) >$(NAME)-stubs.cm
 



1.3       +1 -0      mlton/mllex/mllex-stubs.cm

Index: mllex-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mllex/mllex-stubs.cm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mllex-stubs.cm	2 Nov 2002 03:37:37 -0000	1.2
+++ mllex-stubs.cm	24 Nov 2002 01:19:42 -0000	1.3
@@ -1,4 +1,5 @@
 Group is
+../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/real.sml
 ../lib/mlton/pervasive/pervasive.sml
 ../lib/mlton/basic/error.sig



1.19      +3 -2      mlton/mlprof/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/mlprof/Makefile,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- Makefile	21 Nov 2002 02:49:21 -0000	1.18
+++ Makefile	24 Nov 2002 01:19:43 -0000	1.19
@@ -25,8 +25,9 @@
 .PHONY:	$(NAME)-stubs_cm
 $(NAME)-stubs_cm: 
 	(								\
-		echo 'Group is'&&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' &&	\
+		echo 'Group is' &&					\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' &&		\
 		echo 'call-main.sml';					\
 	) >$(NAME)-stubs.cm
 



1.3       +1 -0      mlton/mlprof/mlprof-stubs.cm

Index: mlprof-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlprof/mlprof-stubs.cm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mlprof-stubs.cm	2 Nov 2002 03:37:37 -0000	1.2
+++ mlprof-stubs.cm	24 Nov 2002 01:19:43 -0000	1.3
@@ -1,4 +1,5 @@
 Group is
+../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/real.sml
 ../lib/mlton/pervasive/pervasive.sml
 ../lib/mlton/basic/dynamic-wind.sig



1.59      +5 -3      mlton/mlton/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/Makefile,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -r1.58 -r1.59
--- Makefile	22 Nov 2002 20:05:47 -0000	1.58
+++ Makefile	24 Nov 2002 01:19:43 -0000	1.59
@@ -33,10 +33,12 @@
 .PHONY:	$(NAME)-stubs_cm
 $(NAME)-stubs_cm: front-end/ml.lex.sml front-end/ml.grm.sig front-end/ml.grm.sml
 	(								\
-		echo 'Group is'&&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' |	\
+		echo 'Group is' &&					\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' |		\
 			grep mlyacc &&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' |	\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' |		\
 			grep -v mlyacc &&				\
 		echo 'call-main.sml';					\
 	) >$(NAME)-stubs.cm



1.7       +1 -0      mlton/mlton/mlton-stubs.cm

Index: mlton-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/mlton-stubs.cm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- mlton-stubs.cm	7 Nov 2002 01:36:55 -0000	1.6
+++ mlton-stubs.cm	24 Nov 2002 01:19:43 -0000	1.7
@@ -5,6 +5,7 @@
 ../lib/mlyacc/parser2.sml
 ../lib/mlyacc/join.sml
 ../lib/mlton-stubs/thread.sml
+../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/random.sig
 ../lib/mlton-stubs/random.sml
 ../lib/mlton-stubs/world.sig



1.6       +4 -0      mlton/mlton/ast/ast.fun

Index: ast.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/ast.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- ast.fun	10 Apr 2002 07:02:18 -0000	1.5
+++ ast.fun	24 Nov 2002 01:19:43 -0000	1.6
@@ -342,6 +342,10 @@
    struct
       datatype t = T of Topdec.t list
 
+      val empty = T []
+
+      fun append (T ds1, T ds2) = T (ds1 @ ds2)
+
       fun layout (T ds) = Layout.align (List.map (ds, Topdec.layout))
 
       fun size (T ds): int =



1.3       +2 -0      mlton/mlton/ast/ast.sig

Index: ast.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/ast.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- ast.sig	10 Apr 2002 07:02:18 -0000	1.2
+++ ast.sig	24 Nov 2002 01:19:43 -0000	1.3
@@ -171,6 +171,8 @@
 	 sig
 	    datatype t = T of Topdec.t list
 
+	    val append: t * t -> t
+	    val empty: t
 	    val size: t -> int
 	    val layout: t -> Layout.t
 	 end



1.4       +1 -2      mlton/mlton/ast/prim-tycons.fun

Index: prim-tycons.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- prim-tycons.fun	10 Apr 2002 07:02:18 -0000	1.3
+++ prim-tycons.fun	24 Nov 2002 01:19:43 -0000	1.4
@@ -25,7 +25,6 @@
       val real = fromString "real"
       val reff = fromString "ref"
       val thread = fromString "thread"
-      val string = fromString "string"
       val tuple = fromString "*"
       val vector = fromString "vector"
       val word = fromString "word"
@@ -33,7 +32,7 @@
 
       val prims =
 	 [array, arrow, bool, char, exn, int, intInf, list, pointer,
-	  preThread, real, reff, string, thread, tuple, vector, word, word8]
+	  preThread, real, reff, thread, tuple, vector, word, word8]
 
       val defaultInt = int
       val defaultWord = word



1.4       +0 -1      mlton/mlton/ast/prim-tycons.sig

Index: prim-tycons.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ast/prim-tycons.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- prim-tycons.sig	10 Apr 2002 07:02:18 -0000	1.3
+++ prim-tycons.sig	24 Nov 2002 01:19:43 -0000	1.4
@@ -28,7 +28,6 @@
       val preThread: tycon
       val real: tycon
       val reff: tycon
-      val string: tycon
       val thread: tycon
       val tuple: tycon
       val vector: tycon



1.6       +46 -21    mlton/mlton/atoms/const.fun

Index: const.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.fun,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- const.fun	6 Jul 2002 17:22:05 -0000	1.5
+++ const.fun	24 Nov 2002 01:19:43 -0000	1.6
@@ -14,6 +14,32 @@
 in structure Aconst = Const
 end
 
+structure Type =
+   struct
+      type t = Tycon.t * Tycon.t vector
+      fun equals ((tc1,tcs1), (tc2,tcs2)) =
+	 Tycon.equals (tc1, tc2)
+	 andalso
+	 Vector.equals (tcs1, tcs2, Tycon.equals)
+      fun toType ((tc,tcs), con) =
+	 con (tc, Vector.map (tcs, fn tc => con (tc, Vector.new0())))
+      val layout = Ast.Type.layout o (fn t => 
+				      toType (t, fn (t, ts) => 
+					      Ast.Type.con (Tycon.toAst t, ts)))
+      val toString = Layout.toString o layout
+      fun make (tc, tcs) : t = (tc, tcs)
+      fun unary (tc, tc') = make (tc, Vector.new1 tc')
+      fun nullary tc = make (tc, Vector.new0())
+      val bool = nullary Tycon.bool
+      val char = nullary Tycon.char
+      val int = nullary Tycon.defaultInt
+      val intInf = nullary Tycon.intInf
+      val real = nullary Tycon.real
+      val word = nullary Tycon.word
+      val word8 = nullary Tycon.word8
+      val string = unary (Tycon.vector, Tycon.char)
+   end
+
 structure Node =
    struct
       datatype t =
@@ -40,19 +66,19 @@
 
 datatype z = datatype Node.t
 datatype t = T of {node: Node.t,
-		   tycon: Tycon.t}
+		   ty: Type.t}
 
 local
    fun make sel (T r) = sel r
 in
    val node = make #node
-   val tycon = make #tycon
+   val ty = make #ty
 end
 
 val layout = Node.layout o node
 val toString = Layout.toString o layout
    
-fun make (n, t) = T {node = n, tycon = t}
+fun make (n, t) = T {node = n, ty = t}
 
 local
    val char = Random.word ()
@@ -74,12 +100,13 @@
       val make = fn n => make (Ast.Const.makeRegion (n, Region.bogus))
       fun maybeConstrain (defaultTycon, aconst) =
 	 let
-	    val t = tycon c
+	    val ty = ty c
+	    val con : Tycon.t * Ast.Type.t vector -> Ast.Type.t =
+	       fn (t, ts) => Ast.Type.con (Tycon.toAst t, ts)
 	 in
-	    if Tycon.equals (t, defaultTycon)
+	    if Type.equals (ty, Type.nullary defaultTycon)
 	       then make aconst
-	    else constrain (make aconst, Ast.Type.con (Tycon.toAst t,
-						       Vector.new0 ()))
+	    else constrain (make aconst, Type.toType (ty, con))
 	 end
       fun int s = maybeConstrain (Tycon.defaultInt, Aconst.Int s)
    in
@@ -96,7 +123,7 @@
 val toAstPat = toAst (Ast.Pat.const, Ast.Pat.constraint)
 
 fun equals (c, c') =
-   Tycon.equals (tycon c, tycon c')
+   Type.equals (ty c, ty c')
    andalso
    case (node c, node c') of
       (Char c, Char c') => c = c'
@@ -109,19 +136,17 @@
 
 val equals = Trace.trace2 ("Const.equals", layout, layout, Bool.layout) equals
 
-fun fromChar c = T {node = Char c, tycon = Tycon.char}
-   
-fun fromInt n = T {node = Int n, tycon = Tycon.defaultInt}
-
-fun fromIntInf i = T {node = IntInf i, tycon = Tycon.intInf}
-
-fun fromString s = T {node = String s, tycon = Tycon.string}
-
-fun fromReal s = T {node = Real s, tycon = Tycon.real}
-
-fun fromWord w = T {node = Word w, tycon = Tycon.word}
-   
-fun fromWord8 w = T {node = Word (Word.fromWord8 w), tycon = Tycon.word8}
+local
+   fun make c t x = T {node = c x, ty = t}
+in
+   val fromChar = make Char Type.char
+   val fromInt = make Int Type.int
+   val fromIntInf = make IntInf Type.intInf
+   val fromReal = make Real Type.real
+   val fromString = make String Type.string
+   val fromWord = make Word Type.word
+   val fromWord8 = make (fn w => Word (Word.fromWord8 w)) Type.word8
+end
 
 structure SmallIntInf =
    struct



1.5       +21 -2     mlton/mlton/atoms/const.sig

Index: const.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/const.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- const.sig	6 Jul 2002 17:22:05 -0000	1.4
+++ const.sig	24 Nov 2002 01:19:43 -0000	1.5
@@ -13,12 +13,31 @@
       structure Ast: AST
       structure Tycon: TYCON
       sharing Tycon.AstId = Ast.Tycon
+      sharing Tycon.AstId = Ast.Tycon
    end
 
 signature CONST = 
    sig
       include CONST_STRUCTS
 
+      structure Type:
+	 sig
+	    type t
+	    val make: Tycon.t * Tycon.t vector -> t
+	    val equals: t * t -> bool
+	    val layout: t -> Layout.t
+	    val toString: t -> string
+	    val toType: t * (Tycon.t * 'a vector -> 'a) -> 'a
+	    val bool: t
+	    val char: t
+	    val int: t
+	    val intInf: t
+	    val real: t
+	    val string: t
+	    val word: t
+	    val word8: t
+	 end
+
       structure SmallIntInf:
 	 sig
 	    val isSmall: IntInf.t -> bool
@@ -51,10 +70,10 @@
       val fromWord8: Word8.t -> t
       val hash: t -> word
       val layout: t -> Layout.t
-      val make: Node.t * Tycon.t -> t
+      val make: Node.t * Type.t -> t
       val node: t -> Node.t
       val toAstExp: t -> Ast.Exp.t
       val toAstPat: t -> Ast.Pat.t
       val toString: t -> string
-      val tycon: t -> Tycon.t
+      val ty: t -> Type.t
    end



1.3       +1 -1      mlton/mlton/atoms/hash-type.fun

Index: hash-type.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/hash-type.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- hash-type.fun	10 Apr 2002 07:02:18 -0000	1.2
+++ hash-type.fun	24 Nov 2002 01:19:43 -0000	1.3
@@ -177,7 +177,7 @@
 
 fun optionToAst z = Option.map (z, toAst)
 
-fun ofConst c = con (Const.tycon c, Vector.new0 ())
+fun ofConst c = Const.Type.toType (Const.ty c, con)
 
 fun isUnit t =
    case dest t of



1.41      +28 -35    mlton/mlton/atoms/prim.fun

Index: prim.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.fun,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- prim.fun	14 Nov 2002 22:25:41 -0000	1.40
+++ prim.fun	24 Nov 2002 01:19:43 -0000	1.41
@@ -61,20 +61,6 @@
        | GC_collect
        | GC_pack
        | GC_unpack
-       | IntInf_add
-       | IntInf_compare
-       | IntInf_equal
-       | IntInf_fromVector
-       | IntInf_fromWord
-       | IntInf_gcd
-       | IntInf_mul
-       | IntInf_neg
-       | IntInf_quot
-       | IntInf_rem
-       | IntInf_sub
-       | IntInf_toString
-       | IntInf_toVector
-       | IntInf_toWord
        | Int_add
        | Int_addCheck
        | Int_ge
@@ -91,6 +77,26 @@
        | Int_rem
        | Int_sub
        | Int_subCheck
+       | IntInf_add
+       | IntInf_andb
+       | IntInf_arshift
+       | IntInf_compare
+       | IntInf_equal
+       | IntInf_fromVector
+       | IntInf_fromWord
+       | IntInf_gcd
+       | IntInf_lshift
+       | IntInf_mul
+       | IntInf_notb
+       | IntInf_neg
+       | IntInf_orb
+       | IntInf_quot
+       | IntInf_rem
+       | IntInf_sub
+       | IntInf_toString
+       | IntInf_toVector
+       | IntInf_toWord
+       | IntInf_xorb
        | MLton_bogus
        | MLton_bug
        | MLton_deserialize
@@ -140,12 +146,7 @@
        | Ref_assign
        | Ref_deref
        | Ref_ref
-       | String_equal
-       | String_fromCharVector
        | String_fromWord8Vector
-       | String_size
-       | String_sub
-       | String_toCharVector
        | String_toWord8Vector
        | Thread_atomicBegin
        | Thread_atomicEnd
@@ -212,17 +213,16 @@
       val equals: t * t -> bool = op =
 
       val isCommutative =
-	 fn IntInf_equal => true
-	  | Int_add => true
+	 fn Int_add => true
 	  | Int_addCheck => true
 	  | Int_mul => true
 	  | Int_mulCheck => true
+	  | IntInf_equal => true
 	  | MLton_eq => true
 	  | MLton_equal => true
 	  | Real_add => true
 	  | Real_mul => true
 	  | Real_qequal => true
-	  | String_equal => true
 	  | Word32_add => true
 	  | Word32_addCheck => true
 	  | Word32_andb => true
@@ -282,19 +282,25 @@
 	  (GC_pack, SideEffect, "GC_pack"),
 	  (GC_unpack, SideEffect, "GC_unpack"),
 	  (IntInf_add, Functional, "IntInf_add"),
+	  (IntInf_andb, Functional, "IntInf_andb"),
+	  (IntInf_arshift, Functional, "IntInf_arshift"),
 	  (IntInf_compare, Functional, "IntInf_compare"),
 	  (IntInf_equal, Functional, "IntInf_equal"),
 	  (IntInf_fromVector, Functional, "IntInf_fromVector"),
 	  (IntInf_fromWord, Functional, "IntInf_fromWord"),
 	  (IntInf_gcd, Functional, "IntInf_gcd"),
+	  (IntInf_lshift, Functional, "IntInf_lshift"),
 	  (IntInf_mul, Functional, "IntInf_mul"),
+	  (IntInf_notb, Functional, "IntInf_notb"),
 	  (IntInf_neg, Functional, "IntInf_neg"),
+	  (IntInf_orb, Functional, "IntInf_orb"),
 	  (IntInf_quot, Functional, "IntInf_quot"),
 	  (IntInf_rem, Functional, "IntInf_rem"),
 	  (IntInf_sub, Functional, "IntInf_sub"),
 	  (IntInf_toString, Functional, "IntInf_toString"),
 	  (IntInf_toVector, Functional, "IntInf_toVector"),
 	  (IntInf_toWord, Functional, "IntInf_toWord"),
+	  (IntInf_xorb, Functional, "IntInf_xorb"),
 	  (Int_add, Functional, "Int_add"),
 	  (Int_addCheck, SideEffect, "Int_addCheck"),
 	  (Int_ge, Functional, "Int_ge"),
@@ -361,12 +367,7 @@
 	  (Ref_assign, SideEffect, "Ref_assign"),
 	  (Ref_deref, DependsOnState, "Ref_deref"),
 	  (Ref_ref, Moveable, "Ref_ref"),
-	  (String_equal, Functional, "String_equal"),
-	  (String_fromCharVector, Functional, "String_fromCharVector"),
 	  (String_fromWord8Vector, Functional, "String_fromWord8Vector"),
-	  (String_size, Functional, "String_size"),
-	  (String_sub, Functional, "String_sub"),
-	  (String_toCharVector, Functional, "String_toCharVector"),
 	  (String_toWord8Vector, Functional, "String_toWord8Vector"),
 	  (Thread_atomicBegin, SideEffect, "Thread_atomicBegin"),
 	  (Thread_atomicEnd, SideEffect, "Thread_atomicEnd"),
@@ -551,7 +552,6 @@
    val intInfNeg =
       new0 (Name.IntInf_neg, tuple [intInf, word] --> intInf)
    val intInfEqual = new0 (Name.IntInf_equal, tuple [intInf, intInf] --> bool)
-   val stringEqual = new0 (Name.String_equal, tuple [string, string] --> bool)
    val word8Neg = new0 (Name.Word8_neg, word8 --> word8)
    val word8Notb = new0 (Name.Word8_notb, word8 --> word8)
    val word32Notb = new0 (Name.Word32_notb, word --> word)
@@ -849,10 +849,6 @@
 		  | SOME w => word w)
 	   | (MLton_eq, [c1, c2]) => eq (c1, c2)
 	   | (MLton_equal, [c1, c2]) => equal (c1, c2)
-	   | (String_equal, [String s1, String s2]) =>
-		bool (String.equals (s1, s2))
-	   | (String_size, [String s]) => int (String.size s)
-	   | (String_sub, [String s, Int i]) => char (String.sub (s, i))
 	   | (Word8_mul, [Word w1, Word w2]) => w8o (Word8.*, w1, w2)
 	   | (Word8_add, [Word w1, Word w2]) => w8o (Word8.+, w1, w2)
 	   | (Word8_sub, [Word w1, Word w2]) => w8o (Word8.-, w1, w2)
@@ -1186,7 +1182,6 @@
 					| Real_gt => f
 					| Real_ge => t
 					| Real_qequal => t
-					| String_equal => t
 					| Word8_andb => Var x
 					| Word8_div => word8 0w1
 					| Word8_ge => t
@@ -1280,8 +1275,6 @@
        | Ref_assign => two ":="
        | Ref_deref => one "!"
        | Ref_ref => one "ref"
-       | String_equal => two "="
-       | String_size => one "size"
        | Vector_length => one "length"
        | Word32_add => two "+"
        | Word32_addCheck => two "+c"



1.33      +22 -22    mlton/mlton/atoms/prim.sig

Index: prim.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/prim.sig,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- prim.sig	14 Nov 2002 22:25:41 -0000	1.32
+++ prim.sig	24 Nov 2002 01:19:43 -0000	1.33
@@ -51,36 +51,42 @@
 	     | GC_collect
 	     | GC_pack
 	     | GC_unpack
-	     | Int_mul
-	     | Int_mulCheck
-	     | Int_add
-	     | Int_addCheck
-	     | Int_sub
-	     | Int_subCheck
-	     | Int_lt
-	     | Int_le
-	     | Int_gt
-	     | Int_ge
-	     | Int_geu
-	     | Int_gtu
-	     | Int_quot
-	     | Int_rem
-	     | Int_neg
-	     | Int_negCheck
+             | Int_add
+             | Int_addCheck
+             | Int_ge
+             | Int_geu
+             | Int_gt
+             | Int_gtu
+             | Int_le
+             | Int_lt
+             | Int_mul
+             | Int_mulCheck
+             | Int_neg
+             | Int_negCheck
+             | Int_quot
+             | Int_rem
+             | Int_sub
+             | Int_subCheck
 	     | IntInf_add
+	     | IntInf_andb
+	     | IntInf_arshift
 	     | IntInf_compare
 	     | IntInf_equal
 	     | IntInf_fromVector
 	     | IntInf_fromWord
 	     | IntInf_gcd
+	     | IntInf_lshift
 	     | IntInf_mul
+	     | IntInf_notb
 	     | IntInf_neg
+	     | IntInf_orb
 	     | IntInf_quot
 	     | IntInf_rem
 	     | IntInf_sub
 	     | IntInf_toString
 	     | IntInf_toVector
 	     | IntInf_toWord
+	     | IntInf_xorb
 	     | MLton_bogus (* of type unit -> 'a.
 			    * implemented in backend.
 			    * Makes a bogus value of any type.
@@ -145,12 +151,7 @@
 	     | Ref_assign (* implemented in backend *)
 	     | Ref_deref (* implemented in backend *)
 	     | Ref_ref (* implemented in backend *)
-	     | String_equal
-	     | String_fromCharVector
 	     | String_fromWord8Vector
-	     | String_size
-	     | String_sub (* implemented in backend *)
-	     | String_toCharVector
 	     | String_toWord8Vector
 	     | Thread_atomicBegin (* implemented in backend *)
 	     | Thread_atomicEnd (* implemented in backend *)
@@ -312,7 +313,6 @@
       val reff: t
       val scheme: t -> Scheme.t
       val serialize: t
-      val stringEqual: t
       val toString: t -> string
       val vectorLength: t
       val vectorSub: t



1.4       +18 -1     mlton/mlton/atoms/type-ops.fun

Index: type-ops.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/type-ops.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- type-ops.fun	10 Apr 2002 07:02:19 -0000	1.3
+++ type-ops.fun	24 Nov 2002 01:19:43 -0000	1.4
@@ -22,7 +22,6 @@
    val intInf = nullary Tycon.intInf
    val preThread = nullary Tycon.preThread
    val real = nullary Tycon.real
-   val string = nullary Tycon.string
    val thread = nullary Tycon.thread
    val word = nullary Tycon.word
    val word8 = nullary Tycon.word8
@@ -40,6 +39,8 @@
    val reff = unary Tycon.reff
 end
 
+val string = vector char
+
 local
    fun binary tycon (t1, t2) = con (tycon, Vector.new2 (t1, t2))
 in
@@ -94,6 +95,22 @@
    case deconOpt t of
       SOME (c, _) => c
     | NONE => Error.bug "detycon"
+
+fun deconConstOpt t =
+   case deconOpt t of
+      SOME (c, ts) => SOME (c, Vector.map (ts, fn t =>
+					   case deconOpt t of
+					      SOME (c, _) => c
+					    | NONE => Error.bug "deconConstOpt"))
+    | NONE => NONE
+fun deconConst t =
+   case deconOpt t of
+      SOME (c, ts) => (c, Vector.map (ts, fn t =>
+				      case deconOpt t of
+					 SOME (c, _) => c
+				       | NONE => Error.bug "deconConst"))
+    | NONE => Error.bug "deconConst"
+
 
 fun dearrowOpt t =
    case deconOpt t of



1.4       +2 -0      mlton/mlton/atoms/type-ops.sig

Index: type-ops.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/atoms/type-ops.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- type-ops.sig	10 Apr 2002 07:02:19 -0000	1.3
+++ type-ops.sig	24 Nov 2002 01:19:43 -0000	1.4
@@ -39,6 +39,8 @@
       val dearrow: t -> t * t
       val dearrowOpt: t -> (t * t) option
       val deconOpt: t -> (tycon * t vector) option
+      val deconConstOpt: t -> (tycon * tycon vector) option
+      val deconConst: t -> (tycon * tycon vector)
       val defaultInt: t
       val defaultWord: t
       val deref: t -> t



1.36      +3 -3      mlton/mlton/backend/backend.fun

Index: backend.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/backend.fun,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- backend.fun	2 Nov 2002 03:37:38 -0000	1.35
+++ backend.fun	24 Nov 2002 01:19:43 -0000	1.36
@@ -292,10 +292,10 @@
 		     else M.Operand.Float f
 		| String s => globalString s
 		| Word w =>
-		     let val t = Const.tycon c
-		     in if Tycon.equals (t, Tycon.word)
+		     let val ty = Const.ty c
+		     in if Const.Type.equals (ty, Const.Type.word)
 			   then M.Operand.Uint w
-			else if Tycon.equals (t, Tycon.word8)
+			else if Const.Type.equals (ty, Const.Type.word8)
 				then M.Operand.Char (Char.chr (Word.toInt w))
 			     else Error.bug "strange word"
 		     end



1.4       +0 -4      mlton/mlton/backend/c-function.fun

Index: c-function.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/c-function.fun,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- c-function.fun	2 Nov 2002 03:37:38 -0000	1.3
+++ c-function.fun	24 Nov 2002 01:19:43 -0000	1.4
@@ -123,8 +123,4 @@
 
 val size = vanilla {name = "MLton_size",
 		    returnTy = SOME Type.int}
-
-val stringEqual = vanilla {name = "String_equal",
-			   returnTy = SOME Type.bool}
-
 end



1.3       +0 -1      mlton/mlton/backend/c-function.sig

Index: c-function.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/c-function.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- c-function.sig	2 Nov 2002 03:37:38 -0000	1.2
+++ c-function.sig	24 Nov 2002 01:19:43 -0000	1.3
@@ -49,6 +49,5 @@
       val needsProfileAllocIndex: t -> bool
       val returnTy: t -> Type.t option
       val size: t
-      val stringEqual: t
       val vanilla: {name: string, returnTy: Type.t option} -> t
    end



1.8       +0 -2      mlton/mlton/backend/representation.fun

Index: representation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/representation.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- representation.fun	10 Apr 2002 07:02:19 -0000	1.7
+++ representation.fun	24 Nov 2002 01:19:43 -0000	1.8
@@ -126,7 +126,6 @@
 	     | PreThread => SOME Mtype.pointer
 	     | Real => SOME Mtype.double
 	     | Ref _ => SOME Mtype.pointer
-	     | String => SOME Mtype.pointer
 	     | Thread => SOME Mtype.pointer
 	     | Tuple ts => if Vector.isEmpty ts
 			      then NONE
@@ -189,7 +188,6 @@
 					   TyconRep.IndirectTag _ => true
 					 | _ => false)
 				  | Ref _ => true
-				  | String => true
 				  | Tuple _ => true
 				  | Vector _ => true
 				  | _ => false



1.19      +3 -3      mlton/mlton/backend/rssa.fun

Index: rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/rssa.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- rssa.fun	2 Nov 2002 03:37:38 -0000	1.18
+++ rssa.fun	24 Nov 2002 01:19:43 -0000	1.19
@@ -95,11 +95,11 @@
 		   | String _ => Type.pointer
 		   | Word _ =>
 			let
-			   val t = Const.tycon c
+			   val ty = Const.ty c
 			in
-			   if Tycon.equals (t, Tycon.word)
+			   if Const.Type.equals (ty, Const.Type.word)
 			      then Type.uint
-			   else if Tycon.equals (t, Tycon.word8)
+			   else if Const.Type.equals (ty, Const.Type.word8)
 				   then Type.char
 				else Error.bug "strange word"
 			end



1.25      +12 -3     mlton/mlton/backend/ssa-to-rssa.fun

Index: ssa-to-rssa.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/backend/ssa-to-rssa.fun,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- ssa-to-rssa.fun	2 Nov 2002 03:37:39 -0000	1.24
+++ ssa-to-rssa.fun	24 Nov 2002 01:19:43 -0000	1.25
@@ -49,13 +49,19 @@
 	       returnTy = SOME Type.pointer}
       in
 	 val intInfAdd = make ("IntInf_do_add", 2)
+	 val intInfAndb = make ("IntInf_do_andb", 2)
+	 val intInfArshift = make ("IntInf_do_arshift", 2)
 	 val intInfGcd = make ("IntInf_do_gcd", 2)
+	 val intInfLshift = make ("IntInf_do_lshift", 2)
 	 val intInfMul = make ("IntInf_do_mul", 2)
 	 val intInfNeg = make ("IntInf_do_neg", 1)
+	 val intInfNotb = make ("IntInf_do_notb", 1)
+	 val intInfOrb = make ("IntInf_do_orb", 2)
 	 val intInfQuot = make ("IntInf_do_quot", 2)
 	 val intInfRem = make ("IntInf_do_rem", 2)
 	 val intInfSub = make ("IntInf_do_sub", 2)
 	 val intInfToString = make ("IntInf_do_toString", 2)
+	 val intInfXorb = make ("IntInf_do_xorb", 2)
       end
 
       local
@@ -1009,18 +1015,24 @@
 				    ccall {args = Vector.new1 Operand.GCState,
 					   func = CFunction.unpack}
 			       | IntInf_add => simpleCCall CFunction.intInfAdd
+			       | IntInf_andb => simpleCCall CFunction.intInfAndb
+			       | IntInf_arshift => simpleCCall CFunction.intInfArshift
 			       | IntInf_compare =>
 				    simpleCCall CFunction.intInfCompare
 			       | IntInf_equal =>
 				    simpleCCall CFunction.intInfEqual
 			       | IntInf_gcd => simpleCCall CFunction.intInfGcd
+			       | IntInf_lshift => simpleCCall CFunction.intInfLshift
 			       | IntInf_mul => simpleCCall CFunction.intInfMul
 			       | IntInf_neg => simpleCCall CFunction.intInfNeg
+			       | IntInf_notb => simpleCCall CFunction.intInfNotb
+			       | IntInf_orb => simpleCCall CFunction.intInfOrb
 			       | IntInf_quot => simpleCCall CFunction.intInfQuot
 			       | IntInf_rem => simpleCCall CFunction.intInfRem
 			       | IntInf_sub => simpleCCall CFunction.intInfSub
 			       | IntInf_toString =>
 				    simpleCCall CFunction.intInfToString
+			       | IntInf_xorb => simpleCCall CFunction.intInfXorb
 			       | MLton_bogus =>
 				    (case toType ty of
 					NONE => none ()
@@ -1075,9 +1087,6 @@
 							Vector.new1 (SOME t))
 				    in allocate (ys, sortTypes (0, ts))
 				    end
-			       | String_equal =>
-				    simpleCCall CFunction.stringEqual
-			       | String_sub => sub Type.char
 			       | Thread_atomicBegin =>
 				    (* assert (s->canHandle >= 0);
 				     * s->canHandle++;



1.37      +0 -3      mlton/mlton/codegen/x86-codegen/x86-mlton.fun

Index: x86-mlton.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/codegen/x86-codegen/x86-mlton.fun,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- x86-mlton.fun	7 Aug 2002 01:02:43 -0000	1.36
+++ x86-mlton.fun	24 Nov 2002 01:19:43 -0000	1.37
@@ -1303,10 +1303,7 @@
 		end
 	     | Real_neg => funa Instruction.FCHS
 	     | Real_round => funa Instruction.FRNDINT
-	     | String_fromCharVector => mov ()
 	     | String_fromWord8Vector => mov ()
-	     | String_size => lengthArrayVectorString ()
-	     | String_toCharVector => mov ()
 	     | String_toWord8Vector => mov ()
 	     | Vector_length => lengthArrayVectorString ()
 	     | Word8_toInt => movx Instruction.MOVZX



1.56      +3 -0      mlton/mlton/control/control.sig

Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.55
retrieving revision 1.56
diff -u -r1.55 -r1.56
--- control.sig	14 Nov 2002 22:25:41 -0000	1.55
+++ control.sig	24 Nov 2002 01:19:43 -0000	1.56
@@ -18,6 +18,9 @@
       (*            Begin Flags             *)
       (*------------------------------------*)
 
+      val basisLibs: string list
+      val basisLibrary: string ref
+
       (* build identifies the machine on which this MLton was built. *)
       val build: string
 



1.71      +5 -0      mlton/mlton/control/control.sml

Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- control.sml	14 Nov 2002 22:25:41 -0000	1.70
+++ control.sml	24 Nov 2002 01:19:44 -0000	1.71
@@ -11,6 +11,11 @@
 structure C = Control ()
 open C
 
+val basisLibs = ["basis-2002", "basis-2002-strict", "basis-1997", "none"]
+val basisLibrary = control {name = "basis library",
+			    default = "basis-2002",
+			    toString = fn s => s}
+
 val cardSizeLog2 = control {name = "log2 (card size)",
 			    default = 8,
 			    toString = Int.toString}



1.15      +20 -18    mlton/mlton/core-ml/lookup-constant.fun

Index: lookup-constant.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/core-ml/lookup-constant.fun,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- lookup-constant.fun	2 Nov 2002 03:37:40 -0000	1.14
+++ lookup-constant.fun	24 Nov 2002 01:19:44 -0000	1.15
@@ -74,24 +74,26 @@
 			    Error.bug
 			    (concat ["constant with strange type: ", c])
 		      in case Prim.scheme p of
-			 Scheme.T {tyvars, ty = Type.Con (tc, ts)} =>
-			    if 0 = Vector.length ts
-			       andalso 0 = Vector.length tyvars
-			       then 
-				  let
-				     val tycons = [(Tycon.bool, Bool),
-						   (Tycon.int, Int),
-						   (Tycon.real, Real),
-						   (Tycon.string, String),
-						   (Tycon.word, Word)]
-				  in case (List.peek
-					   (tycons, fn (tc', _) =>
-					    Tycon.equals (tc, tc'))) of
-				     NONE => strange ()
-				   | SOME (_, t) => (c, t) :: ac
-				  end
-			    else strange ()
-				   | _ => strange ()
+			   Scheme.T {tyvars, ty as Type.Con (tc, ts)} =>
+			      if 0 = Vector.length tyvars
+				 then
+				    let
+				       val ty = Const.Type.make
+					        (Type.deconConst ty)
+				       val tys = [(Const.Type.bool, Bool),
+						  (Const.Type.int, Int),
+						  (Const.Type.real, Real),
+						  (Const.Type.string, String),
+						  (Const.Type.word, Word)]
+				    in case (List.peek
+					     (tys, fn (ty', _) =>
+					      Const.Type.equals (ty, ty'))) of
+				          NONE => strange ()
+					| SOME (_,t) => (c,t) :: ac
+
+				    end
+			      else strange ()
+			  | _ => strange ()
 		      end
 		 | _ => ac)
 	  | Record r => Record.fold (r, ac, loopExp)



1.8       +12 -8     mlton/mlton/elaborate/elaborate-env.fun

Index: elaborate-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-env.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- elaborate-env.fun	10 Apr 2002 07:02:20 -0000	1.7
+++ elaborate-env.fun	24 Nov 2002 01:19:44 -0000	1.8
@@ -1047,8 +1047,7 @@
 	 end
       end
 in
-   fun localTop (T {currentScope, fcts, fixs, sigs, strs, types, vals, ...},
-		 f1, f2) =
+   fun localTop (T {currentScope, fcts, fixs, sigs, strs, types, vals, ...}, f) =
       let
 	 val s0 = !currentScope
 	 val fcts = doit (fcts, s0)
@@ -1058,18 +1057,23 @@
 	 val types = doit (types, s0)
 	 val vals = doit (vals, s0)
 	 val _ = currentScope := Scope.new ()
-	 val a1 = f1 ()
+	 val a = f ()
 	 val fcts = fcts ()
 	 val fixs = fixs ()
 	 val sigs = sigs ()
 	 val strs = strs ()
 	 val types = types ()
 	 val vals = vals ()
-	 val _ = currentScope := Scope.new ()
-	 val a2 = f2 ()
-	 val _ = (fcts (); fixs (); sigs (); strs (); types (); vals ())
-	 val _ = currentScope := s0
-      in (a1, a2)
+	 fun finish g =
+	    let
+	       val _ = currentScope := Scope.new ()
+	       val b = g ()
+	       val _ = (fcts (); fixs (); sigs (); strs (); types (); vals ())
+	       val _ = currentScope := s0
+	    in
+	       b
+	    end
+      in (a, finish)
       end
 
    fun localModule (T {currentScope, fixs, strs, types, vals, ...},



1.4       +1 -1      mlton/mlton/elaborate/elaborate-env.sig

Index: elaborate-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-env.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- elaborate-env.sig	10 Apr 2002 07:02:20 -0000	1.3
+++ elaborate-env.sig	24 Nov 2002 01:19:44 -0000	1.4
@@ -109,7 +109,7 @@
       val layoutUsed: t -> Layout.t
       val localCore: t * (unit -> 'a) * (unit -> 'b) -> 'a * 'b
       val localModule: t * (unit -> 'a) * (unit -> 'b) -> 'a * 'b
-      val localTop: t * (unit -> 'a) * (unit -> 'b) -> 'a * 'b
+      val localTop: t * (unit -> 'a) -> ('a * ((unit -> 'b) -> 'b))
       val lookupFctid: t * Ast.Fctid.t -> FunctorClosure.t
       val lookupLongcon: t * Ast.Longcon.t -> CoreML.Con.t
       val lookupLongstrid: t * Ast.Longstrid.t -> Structure.t



1.38      +118 -81   mlton/mlton/main/compile.sml

Index: compile.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/compile.sml,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- compile.sml	2 Nov 2002 03:37:40 -0000	1.37
+++ compile.sml	24 Nov 2002 01:19:44 -0000	1.38
@@ -62,16 +62,26 @@
 val (lexAndParse, lexAndParseMsg) =
    Control.traceBatch (Control.Pass, "lex and parse") FrontEnd.lexAndParse
 
+fun lexAndParseFile (f: File.t): Ast.Program.t =
+   let
+      val ast = lexAndParse f
+      val _ = Control.checkForErrors "parse"
+   in ast
+   end
+
+fun lexAndParseFiles (fs: File.t list): Ast.Program.t =
+   List.fold
+   (fs, Ast.Program.empty, fn (f, ast) =>
+    Ast.Program.append (ast, lexAndParseFile f))
+
 val (elaborate, elaborateMsg) =
    Control.traceBatch (Control.Pass, "elaborate") Elaborate.elaborateProgram
 
-fun parseAndElaborateFile (f: File.t, E): Decs.t =
+fun elaborateProg (ast: Ast.Program.t, E: Env.t): Decs.t =
    let
-      val ast = lexAndParse f
-      val _ = Control.checkForErrors "parse"
-      val res = elaborate (ast, E)
+      val decs = elaborate (ast, E)
       val _ = Control.checkForErrors "elaborate"
-   in res
+   in decs
    end
 
 val displayDecs =
@@ -85,7 +95,8 @@
     suffix = "core-ml",
     style = Control.ML,
     thunk = fn () => List.fold (fs, Decs.empty, fn (f, ds) =>
-				Decs.append (ds, parseAndElaborateFile (f, E))),
+				Decs.append 
+				(ds, elaborateProg (lexAndParseFile f, E))),
     display = displayDecs}
 
 (* ------------------------------------------------- *)   
@@ -147,13 +158,6 @@
 		       let
 			  val resultType =
 			     Type.con (tycon, Vector.map (tyvars, Type.var))
-		       (* 		    val scheme =
-			* 		       Scheme.T
-			* 		       {tyvars = tyvars,
-			* 			ty = (case arg of
-			* 				 NONE => resultType
-			* 			       | SOME t => Type.arrow (t, resultType))}
-			*)
 		       in {name = Con.toAst con,
 			   con = con}
 		       end)
@@ -183,7 +187,12 @@
 in
    fun setBasisLibraryDir (d: Dir.t): unit =
       dir := SOME d
-   val basisLibrary =
+   val basisLibrary : unit -> {build: Decs.t,
+			       localTopFinish: (unit -> Decs.t) -> Decs.t,
+			       libs: {name: string,
+				      bind: Ast.Program.t,
+				      prefix: Ast.Program.t,
+				      suffix: Ast.Program.t} list} =
       Promise.lazy
       (fn () =>
        let
@@ -192,27 +201,44 @@
 		NONE => Error.bug "basis library dir not set"
 	      | SOME d => d
 	  fun basisFile f = String./ (d, f)
-	  fun files (f, E) =
-	     parseAndElaborateFiles
-	     (rev (File.foldLines (basisFile f, [], fn (s, ac) =>
-				   if s <> "\n" andalso #"#" <> String.sub (s, 0)
-				      then basisFile (String.dropLast s) :: ac
-				   else ac)),
-	      basisEnv)
-	  val (d1, (d2, d3)) =
+	  fun libsFile f = basisFile (String./ ("libs", f))
+	  fun withFiles (f, g) =
+	     let
+	        val fs = File.foldLines
+		         (f, [], fn (s, ac) =>
+			  if s <> "\n" andalso #"#" <> String.sub (s, 0)
+			     then basisFile (String.dropLast s) :: ac
+			  else ac)
+	     in
+	        g (List.rev fs)
+	     end
+
+	  val (build, localTopFinish) =
 	     Env.localTop
 	     (basisEnv,
 	      fn () => (Env.addPrim basisEnv
-			; files ("build-basis", basisEnv)),
-	      fn () =>
-	      (files ("bind-basis", basisEnv),
-	       (* Suffix is concatenated onto the end of the program for cleanup. *)
-	       parseAndElaborateFiles ([basisFile "misc/suffix.sml"], basisEnv)))
-	  val _ = Env.addEquals basisEnv
-	  val _ = Env.clean basisEnv
+			; withFiles (libsFile "build", 
+				     fn fs => parseAndElaborateFiles (fs, basisEnv))))
+	  val localTopFinish = fn g =>
+	     (localTopFinish g) before (Env.addEquals basisEnv
+					; Env.clean basisEnv)
+
+	  fun doit name =
+	    let
+	      fun libFile f = libsFile (String./ (name, f))
+	      val bind = withFiles (libFile "bind", lexAndParseFiles)
+	      val prefix = withFiles (libFile "prefix", lexAndParseFiles)
+	      val suffix = withFiles (libFile "suffix", lexAndParseFiles)
+	    in
+	      {name = name,
+	       bind = bind,
+	       prefix = prefix,
+	       suffix = suffix}
+	    end
        in
-	  {prefix = Decs.append (d1, d2),
-	   suffix = d3}
+	  {build = build,
+	   localTopFinish = localTopFinish,
+	   libs = List.map (Control.basisLibs, doit)}
        end)
 end
 
@@ -221,17 +247,37 @@
     ; basisLibrary ()
     ; ())
    
-fun basisDecs () =
+fun buildDecs () =
    let
-      val {prefix, ...} = basisLibrary ()
+      val {build, ...} = basisLibrary ()
    in
-      Decs.toVector prefix
+      Decs.toVector build
    end
    
 fun outputBasisConstants (out: Out.t): unit =
-   LookupConstant.build (basisDecs (), out)
+   LookupConstant.build (buildDecs (), out)
+
+fun selectBasisLibrary () =
+   let
+     val {build, localTopFinish, libs} = basisLibrary ()
+     val lib = !Control.basisLibrary
+   in
+      case List.peek (libs, fn {name, ...} => name = lib) of
+	 NONE => Error.bug ("Missing basis library: " ^ lib)
+       | SOME {bind, prefix, suffix, ...} =>
+	   let
+	     val bind = localTopFinish (fn () => elaborateProg (bind, basisEnv))
+	   in
+	     {basis = Decs.append (build, bind),
+	      prefix = prefix,
+	      suffix = suffix}
+	   end
+   end
 
-fun layoutBasisLibrary () = Env.layoutPretty basisEnv
+fun layoutBasisLibrary () = 
+   let val _ = selectBasisLibrary ()
+   in Env.layoutPretty basisEnv
+   end
 
 (* ------------------------------------------------- *)
 (*                      compile                      *)
@@ -251,50 +297,41 @@
 			    make (Exception {con = c, arg = NONE}))]
 	 end
       val decs =
-	 if !Control.useBasisLibrary
-	    then
-	       let
-		  val {prefix, suffix} = basisLibrary ()
-		  val basis = Decs.toList prefix
-		  val decs =
-		     if !Control.showBasisUsed
-			then
-			   let
-			      val decs = 
-				 Elaborate.Env.scopeAll
-				 (basisEnv, fn () =>
-				  parseAndElaborateFiles (input, basisEnv))
-			      val _ =
-				 Layout.outputl
-				 (Elaborate.Env.layoutUsed basisEnv,
-				  Out.standard)
-			   in
-			      Process.succeed ()
-			   end
-		     else
-			parseAndElaborateFiles (input, basisEnv)
-		  val user = Decs.toList (Decs.append (decs, suffix))
-		  val _ = parseElabMsg ()
-		  val basis =
-		     Control.pass
-		     {name = "dead",
-		      suffix = "basis",
-		      style = Control.ML,
-		      thunk = fn () => DeadCode.deadCode {basis = basis,
-							  user = user},
-		      display = Control.Layout (List.layout CoreML.Dec.layout)}
-	       in Vector.concat [primitiveDecs,
-				 Vector.fromList basis,
-				 Vector.fromList user]
-	       end
-	 else
-	    let
-	       val E = Env.empty ()
-	       val _ = Env.addPrim E
-	       val decs = parseAndElaborateFiles (input, E)
-	       val _ = parseElabMsg ()
-	    in Vector.concat [primitiveDecs, Decs.toVector decs]
-	    end
+	 let 
+	    val {basis, prefix, suffix, ...} = selectBasisLibrary ()
+	    val prefix = elaborateProg (prefix, basisEnv)
+	    val input =
+	       if !Control.showBasisUsed
+		  then let
+			  val input =
+			     Elaborate.Env.scopeAll
+			     (basisEnv, fn () =>
+			      parseAndElaborateFiles (input, basisEnv))
+			  val _ =
+			     Layout.outputl
+			     (Elaborate.Env.layoutUsed basisEnv,
+			      Out.standard)
+		       in
+			 Process.succeed ()
+		       end
+	       else parseAndElaborateFiles (input, basisEnv)
+	    val suffix = elaborateProg (suffix, basisEnv)
+	    val user = Decs.appends [prefix, input, suffix]
+	    val _ = parseElabMsg ()
+	    val basis = Decs.toList basis
+	    val user = Decs.toList user
+	    val basis = 
+	       Control.pass
+	       {name = "deadCode",
+		suffix = "basis",
+		style = Control.ML,
+		thunk = fn () => DeadCode.deadCode {basis = basis,
+						    user = user},
+		display = Control.Layout (List.layout CoreML.Dec.layout)}
+	 in Vector.concat [primitiveDecs,
+			   Vector.fromList basis,
+			   Vector.fromList user]
+	 end
       val coreML = CoreML.Program.T {decs = decs}
       val _ = Control.message (Control.Detail, fn () =>
 			       CoreML.Program.layoutStats coreML)
@@ -318,7 +355,7 @@
       val lookupConstant =
 	 File.withIn
 	 (concat [!Control.libDir, "/constants"], fn ins =>
-	  LookupConstant.load (basisDecs (), ins))
+	  LookupConstant.load (buildDecs (), ins))
       (* Set GC_state offsets. *)
       val _ =
 	 let



1.99      +9 -5      mlton/mlton/main/main.sml

Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.sml,v
retrieving revision 1.98
retrieving revision 1.99
diff -u -r1.98 -r1.99
--- main.sml	23 Nov 2002 00:02:15 -0000	1.98
+++ main.sml	24 Nov 2002 01:19:44 -0000	1.99
@@ -75,6 +75,13 @@
    in List.map
       (
        [
+       (Normal, "basis", " {basis-2002|...}",
+	"select basis library to prefix to the program",
+	SpaceString (fn s => 
+		     basisLibrary :=
+		     (if List.contains (Control.basisLibs, s, String.equals)
+			then s
+			else usage (concat ["invalid -basis flag: ", s])))),
        (Expert, "build-constants", "",
 	"output C file that prints basis constants",
 	trueRef buildConstants),
@@ -273,9 +280,6 @@
 	intRef textIOBufSize),
        (Expert, "type-check", " {false|true}", "type check ILs",
 	boolRef typeCheck),
-       (Expert, "use-basis-library", " {true|false}",
-	"prefix the basis library to the program",
-	boolRef useBasisLibrary),
        (Normal, "v", "[0123]", "how verbose to be about compiler passes",
 	String
 	(fn s =>
@@ -357,8 +361,8 @@
 		   then Layout.outputl (Compile.layoutBasisLibrary (),
 					Out.standard)
 		else if !buildConstants
-			then Compile.outputBasisConstants Out.standard
-		     else usage "must supply a file"
+		   then Compile.outputBasisConstants Out.standard
+	        else usage "must supply a file"
 	   | Top => printVersion ()
 	   | _ => (inputFile := ""
 		   ; outputHeader' (No, Out.standard)))



1.20      +3 -3      mlton/mlton/ssa/common-subexp.fun

Index: common-subexp.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/common-subexp.fun,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- common-subexp.fun	18 Nov 2002 00:18:34 -0000	1.19
+++ common-subexp.fun	24 Nov 2002 01:19:44 -0000	1.20
@@ -80,7 +80,10 @@
 		  else
 		     if (case Prim.name prim of
 			    IntInf_add => true
+			  | IntInf_andb => true
 			  | IntInf_mul => true
+			  | IntInf_orb => true
+			  | IntInf_xorb => true
 			  | _ => false)
 			then
 			   let 
@@ -204,11 +207,8 @@
 					      Array_array => knownLength (arg ())
 					    | Array_length => length ()
 					    | Vector_fromArray => conv ()
-					    | String_fromCharVector => conv ()
 					    | String_fromWord8Vector => conv ()
-					    | String_toCharVector => conv ()
 					    | String_toWord8Vector => conv ()
-					    | String_size => length ()
 					    | Vector_length => length ()
 					    | _ => if Prim.isFunctional prim
 						      then doit ()



1.11      +78 -22    mlton/mlton/ssa/constant-propagation.fun

Index: constant-propagation.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/constant-propagation.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- constant-propagation.fun	21 Aug 2002 04:48:31 -0000	1.10
+++ constant-propagation.fun	24 Nov 2002 01:19:44 -0000	1.11
@@ -39,6 +39,7 @@
 	  | _ => true
    end
 
+structure Sconst = Const
 open Exp Transfer
 
 structure Value =
@@ -391,7 +392,10 @@
       fun tuple vs =
 	 new (Tuple vs, Type.tuple (Vector.map (vs, ty)))
 
-      fun const c = new (Const (Const.const c), Type.ofConst c)
+      fun const' (c, ty) = new (Const c, ty)
+      fun const c = let val c' = Const.const c
+		    in new (Const c', Type.ofConst c)
+		    end
 
       val zero = const (S.Const.fromInt 0)
 
@@ -404,6 +408,28 @@
 	 fun make (err, sel) v =
 	    case value v of
 	       Vector fs => sel fs
+	     | Const (Const.T {const = ref (Const.Const c), coercedTo}) =>
+		  let
+		     val s = case Sconst.node c of
+		                Sconst.Node.String s => s
+			      | _ => Error.bug err 
+		     val n = String.length s
+		     val x = if n = 0
+			        then const' (Const.unknown(), Type.char)
+			     else let
+				     val c = String.sub (s, 0)
+				  in
+				     if String.forall (s, fn c' => c = c')
+				        then (const o Sconst.make)
+					     (Sconst.Node.Char c, 
+					      Sconst.Type.char)
+				     else const' (Const.unknown(), Type.char)
+				  end
+		     val n = (const o Sconst.make)
+		             (Sconst.Node.Int n, Sconst.Type.int)
+		  in
+		     sel {length = n, elt = x}
+		  end
 	     | _ => Error.bug err
       in val devector = make ("devector", #elt)
 	 val vectorLength = make ("vectorLength", #length)
@@ -470,8 +496,8 @@
 		    | Type.Vector t => Vector {length = loop Type.int,
 					       elt = loop t}
 		    | Type.Tuple ts => Tuple (Vector.map (ts, loop))
-		    | _ => Const (const ()),
-			 t)
+		    | _ => Const (const ()), 
+		   t)
 	    in loop
 	    end
       in
@@ -603,25 +629,55 @@
 	     if equals (from, to)
 		then ()
 	     else
-		case (value from, value to) of
-		   (Const from, Const to) => Const.coerce {from = from, to = to}
-		 | (Datatype from, Datatype to) =>
-		      coerceData {from = from, to = to}
-		 | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
-		      (Birth.coerce {from = birth, to = b'}
-		       ; unify (arg, a'))
-	         | (Array {birth = b, length = n, elt = x},
-		    Array {birth = b', length = n', elt = x'}) =>
-		      (Birth.coerce {from = b, to = b'}
-		       ; coerce {from = n, to = n'}
-		       ; unify (x, x'))
-	         | (Vector {length = n, elt = x},
-		    Vector {length = n', elt = x'}) =>
-		      (coerce {from = n, to = n'}
-		       ; coerce {from = x, to = x'})
-		 | (Tuple vs, Tuple vs') => coerces {froms = vs, tos = vs'}
-		 | _ => Error.bug "strange coerce") arg
-
+	        let 
+		   fun error () = 
+		      Error.bug ("strange coerce:" ^
+				 " from: " ^ (Layout.toString (Value.layout from)) ^
+				 " to: " ^ (Layout.toString (Value.layout to)))
+		in
+		  case (value from, value to) of
+		     (Const from, Const to) => Const.coerce {from = from, to = to}
+		   | (Datatype from, Datatype to) =>
+		        coerceData {from = from, to = to}
+		   | (Ref {birth, arg}, Ref {birth = b', arg = a'}) =>
+			(Birth.coerce {from = birth, to = b'}
+			 ; unify (arg, a'))
+		   | (Array {birth = b, length = n, elt = x},
+			Array {birth = b', length = n', elt = x'}) =>
+			(Birth.coerce {from = b, to = b'}
+			 ; coerce {from = n, to = n'}
+			 ; unify (x, x'))
+	           | (Vector {length = n, elt = x},
+		      Vector {length = n', elt = x'}) =>
+			(coerce {from = n, to = n'}
+			 ; coerce {from = x, to = x'})
+		   | (Tuple vs, Tuple vs') => coerces {froms = vs, tos = vs'}
+		   | (Const (Const.T {const = ref (Const.Const c), coercedTo}),
+		      Vector {length, elt}) =>
+			let
+			   val s = case Sconst.node c of
+			              Sconst.Node.String s => s
+				    | _ => error ()
+			   val n = String.length s
+			   val x = if n = 0
+			              then const' (Const.unknown(), Type.char)
+				   else let
+					   val c = String.sub (s, 0)
+					in
+					   if String.forall (s, fn c' => c = c')
+					      then (const o Sconst.make)
+						   (Sconst.Node.Char c, 
+						    Sconst.Type.char)
+					   else const' (Const.unknown(), Type.char)
+					end
+			   val n = (const o Sconst.make)
+			           (Sconst.Node.Int n, Sconst.Type.int)
+			in
+			   coerce {from = x, to = elt}
+			   ; coerce {from = n, to = length}
+			end
+		   | (_, _) => error ()
+		end) arg
 	 and unify (T s: t, T s': t): unit =
 	    if Set.equals (s, s')
 	       then ()



1.11      +1 -3      mlton/mlton/ssa/poly-equal.fun

Index: poly-equal.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/poly-equal.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- poly-equal.fun	5 Nov 2002 19:08:07 -0000	1.10
+++ poly-equal.fun	24 Nov 2002 01:19:44 -0000	1.11
@@ -284,8 +284,7 @@
 			     args = Vector.new2 (dx1, dx2),
 			     ty = Type.bool}
 	    fun eq () = prim (Prim.eq, Vector.new1 ty)
-	    fun hasConstArg () =
-	       #isConst (varInfo x1) orelse #isConst (varInfo x2)
+	    fun hasConstArg () = #isConst (varInfo x1) orelse #isConst (varInfo x2)
 	 in
 	    case Type.dest ty of
 	       Type.Array _ => eq ()
@@ -301,7 +300,6 @@
 				 then eq ()
 			      else prim (Prim.intInfEqual, Vector.new0 ())
 	     | Type.Ref _ => eq ()
-	     | Type.String => prim (Prim.stringEqual, Vector.new0 ())
 	     | Type.Tuple tys =>
 		  let
 		     val max = Vector.length tys - 1



1.45      +1 -4      mlton/mlton/ssa/ssa-tree.fun

Index: ssa-tree.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.fun,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- ssa-tree.fun	22 Nov 2002 19:58:13 -0000	1.44
+++ ssa-tree.fun	24 Nov 2002 01:19:44 -0000	1.45
@@ -22,7 +22,7 @@
 	  | _ => Error.bug "FirstOrderType.tyconArgs"
 	       
       datatype dest =
-	 Array of t
+	  Array of t
 	| Char
 	| Datatype of Tycon.t
 	| Int
@@ -31,7 +31,6 @@
 	| PreThread
 	| Real
 	| Ref of t
-	| String 
 	| Thread
 	| Tuple of t vector
 	| Vector of t
@@ -60,7 +59,6 @@
 	     (Tycon.pointer, nullary Pointer),
 	     (Tycon.preThread, nullary PreThread),
 	     (Tycon.real, nullary Real),
-	     (Tycon.string, nullary String),
 	     (Tycon.thread, nullary Thread),
 	     (Tycon.word8, nullary Word8),
 	     (Tycon.word, nullary Word),
@@ -97,7 +95,6 @@
 	       | PreThread => str "preThread"
 	       | Real => str "real"
 	       | Ref t => seq [layout t, str " ref"]
-	       | String => str "string"
 	       | Thread => str "thread"
 	       | Tuple ts =>
 		    if Vector.isEmpty ts



1.38      +0 -1      mlton/mlton/ssa/ssa-tree.sig

Index: ssa-tree.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/ssa/ssa-tree.sig,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- ssa-tree.sig	22 Nov 2002 19:58:13 -0000	1.37
+++ ssa-tree.sig	24 Nov 2002 01:19:44 -0000	1.38
@@ -31,7 +31,6 @@
 	     | PreThread
 	     | Real
 	     | Ref of t
-	     | String
 	     | Thread
 	     | Tuple of t vector
 	     | Vector of t



1.15      +8 -8      mlton/mlton/type-inference/infer.fun

Index: infer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/infer.fun,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- infer.fun	10 Apr 2002 07:02:21 -0000	1.14
+++ infer.fun	24 Nov 2002 01:19:44 -0000	1.15
@@ -170,7 +170,7 @@
 
 fun makeXconst (c: Aconst.t, ty: Type.t): Xconst.t =
    let
-      val tycon = Xtype.detycon (Type.toXml (ty, Aconst.region c))
+      val ty = Xconst.Type.make (Xtype.deconConst (Type.toXml (ty, Aconst.region c)))
       datatype z = datatype Xconst.Node.t
       fun error m =
 	 Control.error (Aconst.region c,
@@ -181,7 +181,7 @@
       (case Aconst.node c of
 	  Aconst.Char c => Char c
 	| Aconst.Int s =>
-	     if Tycon.equals (tycon, Tycon.intInf)
+	     if Xconst.Type.equals (ty, Xconst.Type.intInf)
 		then
 		   IntInf (stringToIntInf s)
 		   handle _ => (error "invalid IntInf";
@@ -198,10 +198,10 @@
 		    case StringCvt.scanString (Pervasive.Int32.scan radix) s of
 		       NONE => (error "invalid int constant"; ~1)
 		     | SOME n =>
-			  if Tycon.equals (tycon, Tycon.int)
+			  if Xconst.Type.equals (ty, Xconst.Type.int)
 			     then n
 			  else (error (concat ["int can't be of type ",
-					       Tycon.toString tycon])
+					       Xconst.Type.toString ty])
 				; ~1)
 		 end
 		    handle Overflow =>
@@ -209,15 +209,15 @@
 	| Aconst.Real r => Real r
 	| Aconst.String s => String s
 	| Aconst.Word w =>
-	     Word (if Tycon.equals (tycon, Tycon.word)
+	     Word (if Xconst.Type.equals (ty, Xconst.Type.word)
 		     then w
-		  else if Tycon.equals (tycon, Tycon.word8)
+		  else if Xconst.Type.equals (ty, Xconst.Type.word8)
 			  then if w = Word.andb (w, 0wxFF)
 				  then w
 			       else (error "word8 too big"; 0w0)
-		       else (error ("strange word " ^ Tycon.toString tycon)
+		       else (error ("strange word " ^ (Xconst.Type.toString ty))
 			     ; 0w0)),
-       tycon)
+       ty)
    end
 
 fun 'a sortByField (v: (Field.t * 'a) vector): 'a vector =



1.21      +3 -2      mlton/mlyacc/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/mlyacc/Makefile,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- Makefile	21 Nov 2002 02:49:21 -0000	1.20
+++ Makefile	24 Nov 2002 01:19:44 -0000	1.21
@@ -25,8 +25,9 @@
 .PHONY:	$(NAME)-stubs_cm
 $(NAME)-stubs_cm: src/yacc.lex.sml src/yacc.grm.sig src/yacc.grm.sml
 	(								\
-		echo 'Group is'&&					\
-		cmcat sources.cm | grep -v 'mlton-stubs-in-smlnj' &&	\
+		echo 'Group is' &&					\
+		cmcat sources.cm | grep -v 'basis-stubs' | 		\
+			grep -v 'mlton-stubs-in-smlnj' &&		\
 		echo 'call-main.sml';					\
 	) >$(NAME)-stubs.cm
 



1.3       +1 -0      mlton/mlyacc/mlyacc-stubs.cm

Index: mlyacc-stubs.cm
===================================================================
RCS file: /cvsroot/mlton/mlton/mlyacc/mlyacc-stubs.cm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mlyacc-stubs.cm	2 Nov 2002 03:37:40 -0000	1.2
+++ mlyacc-stubs.cm	24 Nov 2002 01:19:44 -0000	1.3
@@ -26,6 +26,7 @@
 src/yacc.sml
 src/absyn.sml
 src/link.sml
+../lib/mlton-stubs/int-inf.sml
 ../lib/mlton-stubs/real.sml
 ../lib/mlton/pervasive/pervasive.sml
 ../lib/mlton/basic/dynamic-wind.sig



1.2       +3 -0      mlton/regression/array.ok

Index: array.ok
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/array.ok,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- array.ok	18 Jul 2001 05:51:06 -0000	1.1
+++ array.ok	24 Nov 2002 01:19:44 -0000	1.2
@@ -40,6 +40,7 @@
 test11k    	OK
 test12a    	OK
 test12b    	OK
+test12c    	OK
 test12d    	OK
 test12e    	OK
 test13a    	OK
@@ -56,6 +57,8 @@
 test13l    	OK
 test13m    	OK
 test13n    	OK
+test14a    	OK
+test14b    	OK
 test15a    	OK
 test15b    	OK
 test15c    	OK



1.3       +18 -4     mlton/regression/array.sml

Index: array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/array.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- array.sml	10 Feb 2002 19:46:58 -0000	1.2
+++ array.sml	24 Nov 2002 01:19:44 -0000	1.3
@@ -28,6 +28,20 @@
     open Array 
     infix 9 sub
     val array0 : int array = fromList []
+    fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.slice (arr, s, l))
+    val copy = fn {src, si, len, dst, di} =>
+      ArraySlice.copy {src = ArraySlice.slice (src, si, len),
+		       dst = dst, di = di}
+    fun foldli f b (arr, s, l) = 
+      ArraySlice.foldli (fn (i,x,y) => f (i+s,x,y)) b (ArraySlice.slice (arr, s, l))
+    fun foldri f b (arr, s, l) = 
+      ArraySlice.foldri (fn (i,x,y) => f (i+s,x,y)) b (ArraySlice.slice (arr, s, l))
+    fun appi f (arr, s, l) = 
+      ArraySlice.appi (fn (i,x) => f (i+s,x)) (ArraySlice.slice (arr, s, l))
+    fun modifyi f (arr, s, l) = 
+      ArraySlice.modifyi (fn (i,x) => f (i+s,x)) (ArraySlice.slice (arr, s, l))
+    fun findi f (arr, s, l) = 
+      ArraySlice.findi (fn (i,x) => f (i+s,x)) (ArraySlice.slice (arr, s, l))
 in
 
 val a = fromList [1,11,21,31,41,51,61];
@@ -197,7 +211,6 @@
 	   andalso foldr cons [1,2] inp = [7,9,13,1,2]
 	   andalso (foldr (fn (x, _) => setv x) () inp; !v = 7));
 
-(*
 val test12c =
     tst' "test12c" (fn _ =>
 	           find (fn _ => true) array0 = NONE
@@ -205,7 +218,7 @@
 	   andalso find (fn x => x=7) inp = SOME 7
 	   andalso find (fn x => x=9) inp = SOME 9
 	   andalso (setv 0; find (fn x => (addv x; x=9)) inp; !v = 7+9));
-*)
+
 val test12d = 
     tst' "test12d" (fn _ =>
            (setv 117; app setv array0; !v = 117)
@@ -227,6 +240,7 @@
 	   andalso foldri consi [] (array0, 0, NONE) = []
 	   andalso foldli consi [] (inp, 0, NONE) = [(2,13),(1,9),(0,7)]
 	   andalso foldri consi [] (inp, 0, NONE) = [(0,7),(1,9),(2,13)])
+
 val test13b =
     tst' "test13b" (fn _ =>
 	           foldli consi [] (array0, 0, SOME 0) = []
@@ -269,7 +283,7 @@
            handle Subscript => "OK" | _ => "WRONG");
 val test13n = tst0 "test13n" ((foldri consi [] (inp, 2, SOME ~1) seq "WRONG")
            handle Subscript => "OK" | _ => "WRONG");
-(*
+
 val test14a =
     tst' "test14a" (fn _ =>
 	   findi (fn _ => true) (array0, 0, NONE) = NONE
@@ -296,7 +310,7 @@
            handle Subscript => "OK" | _ => "WRONG";
 val test14h = (findi (fn _ => true) (inp, 2, SOME ~1) seq "WRONG")
            handle Subscript => "OK" | _ => "WRONG";
-*)
+
 val test15a = 
     tst' "test15a" (fn _ =>
            (setvi (0,117); appi setvi (array0, 0, NONE); !v = 117)



1.2       +6 -0      mlton/regression/array6.sml

Index: array6.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/array6.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- array6.sml	2 Oct 2001 21:13:37 -0000	1.1
+++ array6.sml	24 Nov 2002 01:19:44 -0000	1.2
@@ -18,6 +18,12 @@
 
 local
    open Array
+   fun extract (arr, s, l) = ArraySlice.vector (ArraySlice.slice (arr, s, l))
+   val copy = fn {src, si, len, dst, di} =>
+      ArraySlice.copy {src = ArraySlice.slice (src, si, len),
+		       dst = dst, di = di}
+   fun appi f (arr, s, l) = 
+      ArraySlice.appi (fn (i,x) => f (i+s,x)) (ArraySlice.slice (arr, s, l))
 
    val a0 = array (0,())
       



1.2       +4 -6      mlton/regression/bytechar.sml

Index: bytechar.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/bytechar.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- bytechar.sml	18 Jul 2001 05:51:06 -0000	1.1
+++ bytechar.sml	24 Nov 2002 01:19:44 -0000	1.2
@@ -3,7 +3,7 @@
 infix 1 seq
 fun e1 seq e2 = e2;
 fun check b = if b then "OK" else "WRONG";
-fun check' f = (if f () then "OK" else "WRONG") handle _ => "EXN";
+fun check' f = (if f () then "OK" else "WRONG") (* handle _ => "EXN" *);
 
 fun range (from, to) p = 
     let open Int 
@@ -31,6 +31,7 @@
 local 
 
 in 
+
 val test1 = tstrange "test1" (0,255) (fn i => 
     (Word8.toInt o Byte.charToByte o Byte.byteToChar o Word8.fromInt) i = i);
 
@@ -370,7 +371,8 @@
 	     ("\\x0000000A2", "\162"),
 	     ("\\x0000000Ag", "\010"),
 	     ("\\x00000000000000000000000000000000000000000000000000000000000000011+",
-	      "\017")]
+	      "\017")
+	     ]
     in 
 	tst' "test42" (fn _ => List.all checkFromCStringSucc argResList)
     end;
@@ -393,7 +395,3 @@
 		"\\xG"])
     end;
 end
-
-
-
-



1.3       +2 -2      mlton/regression/filesys.sml

Index: filesys.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/filesys.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- filesys.sml	18 Jul 2001 22:41:25 -0000	1.2
+++ filesys.sml	24 Nov 2002 01:19:44 -0000	1.3
@@ -96,10 +96,10 @@
     val dstr = openDir "testdir";
 in
     val test7a = 
-	tst' "test7a" (fn _ => "" = readDir dstr);
+	tst' "test7a" (fn _ => NONE = readDir dstr);
     val _ = rewindDir dstr;
     val test7b = 
-	tst' "test7b" (fn _ => "" = readDir dstr);
+	tst' "test7b" (fn _ => NONE = readDir dstr);
     val _ = closeDir dstr;
     val test7c = tst0 "test7c" ((readDir dstr seq "WRONG")
 				handle OS.SysErr _ => "OK" | _ => "WRONG")



1.2       +13 -0     mlton/regression/parse.sml

Index: parse.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/parse.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- parse.sml	3 Apr 2002 19:15:12 -0000	1.1
+++ parse.sml	24 Nov 2002 01:19:44 -0000	1.2
@@ -278,6 +278,19 @@
                   (impOpenIn fileName)))
   end
 
+structure Word8Vector = 
+  struct
+     open Word8Vector
+     fun extract (arr, s, l) = 
+       Word8VectorSlice.vector (Word8VectorSlice.slice (arr, s, l))
+  end
+structure CharVector = 
+  struct
+     open CharVector
+     fun extract (arr, s, l) = 
+       CharVectorSlice.vector (CharVectorSlice.slice (arr, s, l))
+  end
+
 structure FuncBinIO =
   FFunctionalIO(type vec = Word8Vector.vector
                 type element = Word8.word



1.5       +2 -10     mlton/regression/prodcons.sml

Index: prodcons.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/prodcons.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- prodcons.sml	20 Jul 2002 00:07:47 -0000	1.4
+++ prodcons.sml	24 Nov 2002 01:19:44 -0000	1.5
@@ -1,13 +1,6 @@
 (* Translated from prodcons.ocaml. *)
 
 functor Z (S: sig
-		 structure Primitive:
-		    sig
-		       structure Stdio:
-			  sig
-			     val print: string -> unit
-			  end
-		    end
 		 structure MLton:
 		    sig
 		       structure Itimer:
@@ -54,7 +47,7 @@
       loop start
    end
 
-fun print s = () (* Primitive.Stdio.print s *)
+fun print s = ()
 
 structure Queue:
    sig
@@ -277,7 +270,6 @@
 
 end
 
-structure Z = Z (structure MLton = MLton
-		 structure Primitive = Primitive)
+structure Z = Z (structure MLton = MLton)
 
 val _ = Z.main ( "prodcons", ["100000"] )



1.4       +1 -1      mlton/regression/real6.ok

Index: real6.ok
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/real6.ok,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- real6.ok	20 Jul 2002 23:14:01 -0000	1.3
+++ real6.ok	24 Nov 2002 01:19:44 -0000	1.4
@@ -64,7 +64,7 @@
 NORMAL
 SUBNORMAL
 NORMAL
-NAN QUIET
+NAN
 INF
 INF
 INF



1.4       +2 -3      mlton/regression/real6.sml

Index: real6.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/real6.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- real6.sml	20 Jul 2002 23:14:01 -0000	1.3
+++ real6.sml	24 Nov 2002 01:19:44 -0000	1.4
@@ -13,8 +13,7 @@
 infix 4 == != ?=
 
 val classToString =
-   fn NAN QUIET => "NAN QUIET"
-    | NAN SIGNALLING => "NAN SIGNALLING"
+   fn NAN => "NAN"
     | INF => "INF"
     | ZERO => "ZERO"
     | NORMAL => "NORMAL"
@@ -40,7 +39,7 @@
     [(maxFinite, NORMAL),
      (minPos, SUBNORMAL),
      (minNormalPos, NORMAL),
-     (nan, NAN QUIET),
+     (nan, NAN),
      (posInf, INF),
      (negInf, INF),
      (1.0 / 0.0, INF),



1.3       +1 -1      mlton/regression/size.ok

Index: size.ok
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/size.ok,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- size.ok	6 Jul 2002 16:28:31 -0000	1.2
+++ size.ok	24 Nov 2002 01:19:44 -0000	1.3
@@ -5,6 +5,6 @@
 The size of a double array of length 10 is 92 bytes.
 The size of an array of length 10 of 2-ples of ints is 172 bytes.
 The size of a useless function is 0 bytes.
-The size of a continuation option ref is 4296 bytes.
+The size of a continuation option ref is 4280 bytes.
 13
 The size of a continuation option ref is 8 bytes.



1.3       +3 -0      mlton/regression/vector.sml

Index: vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/vector.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- vector.sml	10 Feb 2002 19:46:58 -0000	1.2
+++ vector.sml	24 Nov 2002 01:19:44 -0000	1.3
@@ -31,6 +31,9 @@
 local
     open Vector;
     infix 9 sub;
+    fun extract (vec, s, l) = VectorSlice.vector (VectorSlice.slice (vec, s, l))
+    fun mapi f (vec, s, l) = 
+      VectorSlice.mapi (fn (i,x) => f (i+s,x)) (VectorSlice.slice (vec, s, l))
 in
 
 val a = fromList [0,1,2,3,4,5,6];



1.4       +1 -1      mlton/regression/word.sml

Index: word.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/word.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- word.sml	20 Jul 2002 23:14:02 -0000	1.3
+++ word.sml	24 Nov 2002 01:19:44 -0000	1.4
@@ -77,7 +77,7 @@
 val test8b = check (0 = w2i (notb (i2w ~1)));
 val _ = pr_ln "test8b" test8b
 val maxposint = valOf Int.maxInt;
-val maxnegint = ~maxposint-1;
+val maxnegint = (Int.~ maxposint)-1;
 fun pwr2 0 = 1 
   | pwr2 n = 2 * pwr2 (n-1);
 fun rwp i 0 = i



1.3       +5 -0      mlton/regression/word8array.sml

Index: word8array.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/word8array.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- word8array.sml	10 Feb 2002 19:46:58 -0000	1.2
+++ word8array.sml	24 Nov 2002 01:19:44 -0000	1.3
@@ -32,6 +32,11 @@
     open Word8Array 
     infix 9 sub;
     val array0 = fromList [];
+    val copy = fn {src, si, len, dst, di} =>
+      Word8ArraySlice.copy {src = Word8ArraySlice.slice (src, si, len),
+			    dst = dst, di = di}
+    val extract = fn (a, i, sz) =>
+      Word8ArraySlice.vector (Word8ArraySlice.slice (a, i, sz))
 in
 
 val i2w = Word8.fromInt;



1.3       +4 -0      mlton/regression/word8vector.sml

Index: word8vector.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/word8vector.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- word8vector.sml	10 Feb 2002 19:46:58 -0000	1.2
+++ word8vector.sml	24 Nov 2002 01:19:44 -0000	1.3
@@ -30,6 +30,10 @@
 
 local
     open Word8Vector;
+    fun extract (vec, s, l) = 
+      Word8VectorSlice.vector (Word8VectorSlice.slice (vec, s, l))
+    fun mapi f (vec, s, l) = 
+      Word8VectorSlice.mapi (fn (i,x) => f (i+s,x)) (Word8VectorSlice.slice (vec, s, l))
     val i2w = Word8.fromInt;
     infix 9 sub;
 in



1.2       +2 -0      mlton/regression/1.ok




1.2       +2 -0      mlton/regression/2.ok




1.2       +1 -0      mlton/regression/command-line.ok




1.2       +1 -0      mlton/regression/conv.ok




1.2       +1 -0      mlton/regression/conv2.ok




1.2       +1 -0      mlton/regression/fast.ok




1.2       +1 -0      mlton/regression/fast2.ok




1.2       +1 -0      mlton/regression/hello-world.ok




1.2       +8448 -0   mlton/regression/int-inf.bitops.ok




1.2       +110 -0    mlton/regression/int-inf.bitops.sml




1.2       +1 -0      mlton/regression/slow.ok




1.2       +1 -0      mlton/regression/slow2.ok




1.2       +1 -0      mlton/regression/slower.ok




1.2       +68 -0     mlton/regression/substring.ok




1.2       +3 -0      mlton/regression/testdyn2.ok




1.2       +1 -0      mlton/regression/thread-switch.ok




1.9       +43 -26    mlton/runtime/IntInf.h

Index: IntInf.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/IntInf.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- IntInf.h	2 Nov 2002 03:37:41 -0000	1.8
+++ IntInf.h	24 Nov 2002 01:19:45 -0000	1.9
@@ -55,33 +55,50 @@
  * into the array used for allocation profiling, and the appropriate element
  * is incremented by the amount that the function moves the frontier.
  */
-extern pointer			IntInf_do_add (pointer lhs,
-						pointer rhs,
-						uint bytes),
-				IntInf_do_sub (pointer lhs,
-						pointer rhs,
-						uint bytes),
-				IntInf_do_mul (pointer lhs,
-						pointer rhs,
-						uint bytes),
-				IntInf_do_toString (pointer arg,
-							int base,
-							uint bytes),
-				IntInf_do_neg (pointer arg,
-						uint bytes),
-				IntInf_do_quot (pointer num,
-						pointer den,
-						uint bytes),
-				IntInf_do_rem (pointer num,
-						pointer den,
-						uint bytes),
-				IntInf_do_gcd (pointer lhs,
-						pointer rhs,
-						uint bytes);
+extern pointer			IntInf_do_add(pointer lhs,
+					      pointer rhs,
+					      uint bytes),
+				IntInf_do_sub(pointer lhs,
+					      pointer rhs,
+					      uint bytes),
+				IntInf_do_mul(pointer lhs,
+					      pointer rhs,
+					      uint bytes),
+				IntInf_do_neg(pointer arg,
+					      uint bytes),
+				IntInf_do_quot(pointer num,
+					       pointer den,
+					       uint bytes),
+				IntInf_do_rem(pointer num,
+					      pointer den,
+					      uint bytes),
+				IntInf_do_andb(pointer lhs,
+					       pointer rhs,
+					       uint bytes),
+				IntInf_do_orb(pointer lhs,
+					      pointer rhs,
+					      uint bytes),
+				IntInf_do_xorb(pointer lhs,
+					       pointer rhs,
+					       uint bytes),
+				IntInf_do_notb(pointer arg,
+					       uint bytes),
+				IntInf_do_arshift(pointer arg,
+						  uint shift,
+						  uint bytes),
+				IntInf_do_lshift(pointer arg,
+						 uint shift,
+						 uint bytes),
+				IntInf_do_toString(pointer arg,
+						   int base,
+						   uint bytes),
+				IntInf_do_gcd(pointer lhs,
+					      pointer rhs,
+					      uint bytes);
 
-extern Word	IntInf_smallMul (Word lhs, Word rhs, pointer carry);
-extern int	IntInf_compare (pointer lhs, pointer rhs),
-		IntInf_equal (pointer lhs, pointer rhs);
+extern Word	IntInf_smallMul(Word lhs, Word rhs, pointer carry);
+extern int	IntInf_compare(pointer lhs, pointer rhs),
+		IntInf_equal(pointer lhs, pointer rhs);
 
 #endif	/* #ifndef _MLTON_INT_INF_H */
 



1.41      +2 -2      mlton/runtime/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/Makefile,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- Makefile	13 Nov 2002 06:11:54 -0000	1.40
+++ Makefile	24 Nov 2002 01:19:45 -0000	1.41
@@ -41,6 +41,7 @@
 	basis/MLton/size.o			\
 	basis/MLton/world.o			\
 	basis/OS/FileSys/tmpnam.o		\
+	basis/OS/IO/poll.o			\
 	basis/PackReal/subVec.o			\
 	basis/PackReal/update.o			\
 	basis/Ptrace/ptrace2.o			\
@@ -53,7 +54,6 @@
 	basis/Socket/listen.o			\
 	basis/Socket/shutdown.o			\
 	basis/Stdio.o				\
-	basis/String/equal.o			\
 	basis/Thread.o				\
 	basis/Time.o				\
 	basis/Word32/addOverflow.o		\
@@ -188,6 +188,7 @@
 	basis/MLton/size-gdb.o			\
 	basis/MLton/world-gdb.o			\
 	basis/OS/FileSys/tmpnam-gdb.o		\
+	basis/OS/IO/poll-gdb.o			\
 	basis/PackReal/subVec-gdb.o		\
 	basis/PackReal/update-gdb.o		\
 	basis/Ptrace/ptrace2-gdb.o		\
@@ -200,7 +201,6 @@
 	basis/Socket/listen-gdb.o		\
 	basis/Socket/shutdown-gdb.o		\
 	basis/Stdio-gdb.o			\
-	basis/String/equal-gdb.o		\
 	basis/Thread-gdb.o			\
 	basis/Time-gdb.o			\
 	basis/Word32/addOverflow-gdb.o		\



1.8       +6 -2      mlton/runtime/posix-constants.h

Index: posix-constants.h
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/posix-constants.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- posix-constants.h	29 Sep 2002 02:23:59 -0000	1.7
+++ posix-constants.h	24 Nov 2002 01:19:45 -0000	1.8
@@ -118,15 +118,18 @@
 #define Posix_FileSys_F_OK F_OK
 
 /* used by pathconf and fpathconf */
+#define Posix_FileSys_CHOWN_RESTRICTED _PC_CHOWN_RESTRICTED
 #define Posix_FileSys_LINK_MAX _PC_LINK_MAX
 #define Posix_FileSys_MAX_CANON _PC_MAX_CANON
 #define Posix_FileSys_MAX_INPUT _PC_MAX_INPUT
 #define Posix_FileSys_NAME_MAX _PC_NAME_MAX
+#define Posix_FileSys_NO_TRUNC _PC_NO_TRUNC
 #define Posix_FileSys_PATH_MAX _PC_PATH_MAX
 #define Posix_FileSys_PIPE_BUF _PC_PIPE_BUF
-#define Posix_FileSys_CHOWN_RESTRICTED _PC_CHOWN_RESTRICTED
-#define Posix_FileSys_NO_TRUNC _PC_NO_TRUNC
 #define Posix_FileSys_VDISABLE _PC_VDISABLE
+#define Posix_FileSys_ASYNC_IO _PC_ASYNC_IO
+#define Posix_FileSys_SYNC_IO _PC_SYNC_IO
+#define Posix_FileSys_PRIO_IO _PC_PRIO_IO
 
 #define Posix_IO_F_DUPFD F_DUPFD
 #define Posix_IO_F_GETFD F_GETFD
@@ -180,6 +183,7 @@
 #define Posix_ProcEnv_EXPR_NEST_MAX _SC_EXPR_NEST_MAX
 #define Posix_ProcEnv_JOB_CONTROL _SC_JOB_CONTROL
 #define Posix_ProcEnv_LINE_MAX _SC_LINE_MAX
+#define Posix_ProcEnv_NGROUPS_MAX _SC_NGROUPS_MAX
 #define Posix_ProcEnv_OPEN_MAX _SC_OPEN_MAX
 #define Posix_ProcEnv_RE_DUP_MAX _SC_RE_DUP_MAX
 #define Posix_ProcEnv_SAVED_IDS _SC_SAVED_IDS



1.11      +77 -12    mlton/runtime/basis/IntInf.c

Index: IntInf.c
===================================================================
RCS file: /cvsroot/mlton/mlton/runtime/basis/IntInf.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- IntInf.c	5 Nov 2002 19:08:07 -0000	1.10
+++ IntInf.c	24 Nov 2002 01:19:45 -0000	1.11
@@ -200,7 +200,75 @@
 	return binary (lhs, rhs, bytes, &mpz_sub);
 }
 
-Word IntInf_smallMul (Word lhs, Word rhs, pointer carry) {
+pointer IntInf_do_andb(pointer lhs, pointer rhs, uint bytes)
+{
+	return binary(lhs, rhs, bytes, &mpz_and);
+}
+
+pointer IntInf_do_orb(pointer lhs, pointer rhs, uint bytes)
+{
+	return binary(lhs, rhs, bytes, &mpz_ior);
+}
+
+pointer IntInf_do_xorb(pointer lhs, pointer rhs, uint bytes)
+{
+	return binary(lhs, rhs, bytes, &mpz_xor);
+}
+
+static pointer
+unary(pointer arg, uint bytes,
+      void(*unop)(__mpz_struct *resmpz, 
+		  __gmp_const __mpz_struct *argspace))
+{
+	__mpz_struct	argmpz,
+			resmpz;
+	mp_limb_t	argspace[2];
+
+	initRes(&resmpz, bytes);
+	fill(arg, &argmpz, argspace);
+	unop(&resmpz, &argmpz);
+	return answer(&resmpz);
+}
+
+pointer IntInf_do_neg(pointer arg, uint bytes)
+{
+	return unary(arg, bytes, &mpz_neg);
+}
+
+pointer IntInf_do_notb(pointer arg, uint bytes)
+{
+	return unary(arg, bytes, &mpz_com);
+}
+
+static pointer
+shary(pointer arg, uint shift, uint bytes,
+      void(*shop)(__mpz_struct *resmpz, 
+		  __gmp_const __mpz_struct *argspace,
+		  ulong shift))
+{
+	__mpz_struct	argmpz,
+			resmpz;
+	mp_limb_t	argspace[2];
+
+	initRes(&resmpz, bytes);
+	fill(arg, &argmpz, argspace);
+	shop(&resmpz, &argmpz, (ulong)shift);
+	return answer(&resmpz);
+}
+
+pointer IntInf_do_arshift(pointer arg, uint shift, uint bytes)
+{
+	return shary(arg, shift, bytes, &mpz_fdiv_q_2exp);
+}
+
+pointer IntInf_do_lshift(pointer arg, uint shift, uint bytes)
+{
+	return shary(arg, shift, bytes, &mpz_mul_2exp);
+}
+
+Word
+IntInf_smallMul(Word lhs, Word rhs, pointer carry)
+{
 	llong	prod;
 
 	prod = (llong)(int)lhs * (int)rhs;
@@ -246,6 +314,8 @@
 	mp_limb_t	argspace[2];
 	char		*str;
 	uint		size;
+	int		i;
+	char		c;
 
 	assert (base == 2 || base == 8 || base == 10 || base == 16);
 	fill (arg, &argmpz, argspace);
@@ -255,22 +325,17 @@
 	size = strlen(str);
 	if (*sp->chars == '-')
 		*sp->chars = '~';
+        if (base > 0)
+		for (i = 0; i < size; i++) {
+			c = sp->chars[i];
+			if (('a' <= c) && (c <= 'z'))
+				sp->chars[i] = c + ('A' - 'a');
+		}
 	sp->counter = 0;
 	sp->card = size;
 	sp->magic = STRMAGIC;
 	setFrontier (&sp->chars[wordAlign(size)]);
 	return (pointer)str;
-}
-
-pointer IntInf_do_neg (pointer arg, uint bytes) {
-	__mpz_struct	argmpz,
-			resmpz;
-	mp_limb_t	argspace[2];
-
-	initRes (&resmpz, bytes);
-	fill (arg, &argmpz, argspace);
-	mpz_neg (&resmpz, &argmpz);
-	return answer (&resmpz);
 }
 
 /*



1.2       +18 -0     mlton/runtime/basis/OS/IO/poll.c






-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel