[MLton-commit] r4381

[Stephen Weeks]

Added MLton.Vector.create, a more powerful vector-creation function
than is available in the basis library.


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

U   mlton/trunk/basis-library/arrays-and-vectors/vector.sig
U   mlton/trunk/basis-library/arrays-and-vectors/vector.sml
U   mlton/trunk/basis-library/misc/primitive.sml
U   mlton/trunk/basis-library/mlton/mlton.sml
U   mlton/trunk/basis-library/mlton/vector.sig

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

Modified: mlton/trunk/basis-library/arrays-and-vectors/vector.sig
===================================================================
--- mlton/trunk/basis-library/arrays-and-vectors/vector.sig	2006-03-24 23:33:21 UTC (rev 4380)
+++ mlton/trunk/basis-library/arrays-and-vectors/vector.sig	2006-03-28 21:34:14 UTC (rev 4381)
@@ -46,6 +46,10 @@
       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 duplicate: 'a vector -> 'a vector
       val fromArray: 'a array -> 'a vector
       val toList: 'a vector -> 'a list

Modified: mlton/trunk/basis-library/arrays-and-vectors/vector.sml
===================================================================
--- mlton/trunk/basis-library/arrays-and-vectors/vector.sml	2006-03-24 23:33:21 UTC (rev 4380)
+++ mlton/trunk/basis-library/arrays-and-vectors/vector.sml	2006-03-28 21:34:14 UTC (rev 4381)
@@ -42,9 +42,37 @@
       val fromArray = Primitive.Vector.fromArray
 
       val vector = new
+
+      fun create (n, f) =
+         let
+            val a = Primitive.Array.array n
+            val subLim = ref 0
+            fun sub i =
+               if Primitive.safe andalso Primitive.Int.geu (i, !subLim) then
+                  raise Subscript
+               else
+                  Primitive.Array.sub (a, i)
+            val updateLim = ref 0
+            fun update (i, x) =
+               if Primitive.safe andalso Primitive.Int.geu (i, !updateLim) then
+                  raise Subscript
+               else
+                  Primitive.Array.update (a, i, x)
+            val (tab, finish) = f {sub = sub, update = update}
+            val () =
+               Util.naturalForeach
+               (n, fn i =>
+                (Primitive.Array.update (a, i, tab i);
+                 subLim := i + 1;
+                 updateLim := i + 1))
+            val () = finish ()
+            val () = updateLim := 0
+         in
+            fromArray a
+         end
    end
 structure VectorSlice: VECTOR_SLICE_EXTRA = Vector.VectorSlice
-
+   
 structure VectorGlobal: VECTOR_GLOBAL = Vector
 open VectorGlobal
 val vector = Vector.fromList

Modified: mlton/trunk/basis-library/misc/primitive.sml
===================================================================
--- mlton/trunk/basis-library/misc/primitive.sml	2006-03-24 23:33:21 UTC (rev 4380)
+++ mlton/trunk/basis-library/misc/primitive.sml	2006-03-28 21:34:14 UTC (rev 4381)
@@ -2262,3 +2262,5 @@
                "unhandled exception in Basis Library\000")))
 in
 end
+
+val op + = Primitive.Int.+

Modified: mlton/trunk/basis-library/mlton/mlton.sml
===================================================================
--- mlton/trunk/basis-library/mlton/mlton.sml	2006-03-24 23:33:21 UTC (rev 4380)
+++ mlton/trunk/basis-library/mlton/mlton.sml	2006-03-28 21:34:14 UTC (rev 4381)
@@ -102,3 +102,13 @@
                end
          end
    end
+
+local
+   open MLton.Vector
+in
+   fun fib n =
+      Vector.create (n,
+                     fn {sub = fib, ...} =>
+                     (fn i => if i <= 1 then 1 else fib (i - 1) + fib (i - 2),
+                      ignore))
+end

Modified: mlton/trunk/basis-library/mlton/vector.sig
===================================================================
--- mlton/trunk/basis-library/mlton/vector.sig	2006-03-24 23:33:21 UTC (rev 4380)
+++ mlton/trunk/basis-library/mlton/vector.sig	2006-03-28 21:34:14 UTC (rev 4381)
@@ -10,6 +10,10 @@
 
 signature MLTON_VECTOR =
    sig
+      val create:
+         int * ({sub: int -> 'a, update: int * 'a -> unit}
+                -> (int -> 'a) * (unit -> unit))
+         -> 'a vector
       val unfoldi: int * 'b * (int * 'b -> 'a * 'b) -> 'a vector
    end