[MLton-commit] r4687

Stephen Weeks MLton@mlton.org
Mon, 17 Jul 2006 18:31:20 -0700


Replace MLton.Vector.create with a more powerful version that allows
one to call it and maintain control of the stack.  This allows the
creation of several vectors simultaneously.  The new signature is:

      val create: int -> {done: unit -> 'a vector,
                          sub: int -> 'a,
                          update: int * 'a -> unit}

The update function must fill in all the entries before done() is
called.  Also, it must fill them in in order from lowest to highest.
That is, before calling update (i, x), one must have already called
update (j, x) for all j in [0, i).


----------------------------------------------------------------------

U   mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
U   mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig
U   mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml
U   mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig

----------------------------------------------------------------------

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun	2006-07-18 01:01:39 UTC (rev 4686)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.fun	2006-07-18 01:31:18 UTC (rev 4687)
@@ -147,45 +147,51 @@
 
       fun seq0 () = S.fromArray (arrayUninit' 0)
 
-      fun generate' (n, f) =
+      fun generate' n =
+        let
+           val a = arrayUninit' n
+           val subLim = ref 0
+           fun sub i =
+              if Primitive.Controls.safe andalso geu (i, !subLim) then
+                 raise Subscript
+              else
+                 Array.subUnsafe (a, i)
+           val updateLim = ref 0
+           fun update (i, x) =
+              if Primitive.Controls.safe andalso geu (i, !updateLim) then
+                 if i = !updateLim andalso i < n then
+                    (Array.updateUnsafe (a, i, x);
+                     subLim := i + 1;
+                     updateLim := i + 1)
+                 else
+                    raise Subscript
+              else
+                 Array.updateUnsafe (a, i, x)
+           val gotIt = ref false
+           fun done () =
+              if !gotIt then
+                 raise Fail "already got vector"
+              else
+                 if n = !updateLim then
+                    (gotIt := true;
+                     updateLim := 0;
+                     S.fromArray a)
+                 else
+                    raise Fail "vector not full"
+        in
+           {done = done,
+            sub = sub,
+            update = update}
+        end
+     
+      fun generate n =
          let
-            val a = arrayUninit' n
-            val subLim = ref 0
-            fun sub i =
-               if Primitive.Controls.safe andalso geu (i, !subLim)
-                  then raise Subscript
-                  else Array.subUnsafe (a, i)
-            val updateLim = ref 0
-            fun update (i, x) =
-               if Primitive.Controls.safe andalso geu (i, !updateLim)
-                  then raise Subscript
-                  else Array.updateUnsafe (a, i, x)
-            val (tab, finish) = f {sub = sub, update = update}
-            fun loop i =
-               if i >= n
-                  then ()
-                  else let
-                          val () = Array.updateUnsafe (a, i, tab i)
-                          val () = subLim := i +? 1
-                          val () = updateLim := i +? 1
-                       in
-                          loop (i +? 1)
-                       end
-            val () = loop 0
-            val () = finish ()
-            val () = updateLim := 0
+            val {done, sub, update} = generate' (fromIntForLength n)
          in
-            S.fromArray a
-         end 
-      fun generate (n, f) =
-         generate' (fromIntForLength n, 
-                    fn {sub, update} => 
-                    let 
-                       val (tab, finish) =
-                          f {sub = unwrap1 sub, update = unwrap2 update}
-                    in
-                       (wrap1 tab, finish)
-                    end)
+            {done = done,
+             sub = unwrap1 sub,
+             update = unwrap2 update}
+         end
 
       fun unfoldi' (n, b, f) =
          let

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig	2006-07-18 01:01:39 UTC (rev 4686)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/sequence.sig	2006-07-18 01:31:18 UTC (rev 4687)
@@ -81,15 +81,13 @@
                   ('a elt -> 'b elt) -> 'a sequence -> 'c
       val duplicate: 'a sequence -> 'a sequence
       val generate':
-         SeqIndex.int * ({sub: SeqIndex.int -> 'a elt, 
+         SeqIndex.int -> {done: unit -> 'a sequence,
+                          sub: SeqIndex.int -> 'a elt, 
                           update: SeqIndex.int * 'a elt -> unit}
-                         -> (SeqIndex.int -> 'a elt) * (unit -> unit))
-         -> 'a sequence
       val generate:
-         int * ({sub: int -> 'a elt, 
+         int -> {done: unit -> 'a sequence,
+                 sub: int -> 'a elt, 
                  update: int * 'a elt -> unit}
-                -> (int -> 'a elt) * (unit -> unit))
-         -> 'a sequence
       val newUninit': SeqIndex.int -> 'a sequence
       val newUninit: int -> 'a sequence
       val new': SeqIndex.int * 'a elt -> 'a sequence

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig	2006-07-18 01:01:39 UTC (rev 4686)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sig	2006-07-18 01:31:18 UTC (rev 4687)
@@ -47,10 +47,9 @@
       val fields: ('a -> bool) -> 'a vector -> 'a vector list
 
       val append: 'a vector * 'a vector -> 'a vector
-      val create: 
-         int * ({sub: int -> 'a, update: int * 'a -> unit}
-                -> (int -> 'a) * (unit -> unit))
-         -> 'a vector
+      val create: int -> {done: unit -> 'a vector,
+                          sub: int -> 'a,
+                          update: int * 'a -> unit}
       val duplicate: 'a vector -> 'a vector
       val tabulate': SeqIndex.int * (SeqIndex.int -> 'a) -> 'a vector 
       val toList: 'a vector -> 'a list

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml	2006-07-18 01:01:39 UTC (rev 4686)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/arrays-and-vectors/vector.sml	2006-07-18 01:31:18 UTC (rev 4687)
@@ -61,7 +61,7 @@
 
       val vector = new
 
-      fun create (n, f) = generate (n, f)
+      val create = generate
    end
 structure VectorSlice: VECTOR_SLICE_EXTRA = Vector.VectorSlice
 

Modified: mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig
===================================================================
--- mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig	2006-07-18 01:01:39 UTC (rev 4686)
+++ mlton/branches/on-20050822-x86_64-branch/basis-library/mlton/vector.sig	2006-07-18 01:31:18 UTC (rev 4687)
@@ -10,10 +10,9 @@
 
 signature MLTON_VECTOR =
    sig
-      val create: 
-         int * ({sub: int -> 'a, update: int * 'a -> unit}
-                -> (int -> 'a) * (unit -> unit))
-         -> 'a vector
+      val create: int -> {done: unit -> 'a vector,
+                          sub: int -> 'a,
+                          update: int * 'a -> unit}
       val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector * 'b
    end