[MLton-commit] r4826

Vesa Karvonen vesak at mlton.org
Thu Nov 16 02:49:21 PST 2006


Added preliminary implementation of unfoldi to arrays and vectors.  The
signature is curried and supposed to be more in the style of the Basis
library than MLton's internal libraries.

Factored out some repetition.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/array.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-array-ext.fun
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-seq-common-ext.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-vector-ext.fun
A   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-seq-common-ext.fun
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/funs.cm
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/vector.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U   mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/array.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-array.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-vector.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/vector.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/array.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/array.sml	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/array.sml	2006-11-16 10:49:19 UTC (rev 4826)
@@ -8,11 +8,16 @@
  * Extended {Array :> ARRAY} structure.
  *)
 structure Array : ARRAY = struct
-   open Array
-   type 'a t = 'a array
+   local
+      structure Array = struct
+         open Array
+         type 'a t = 'a array
+      end
+      structure Common = MkSeqCommonExt (Array)
+   in
+      open Array Common
+   end
    fun dup a = tabulate (length a, fn i => sub (a, i))
-   fun toList a = foldr op :: [] a
-   val isoList = (toList, fromList)
    val toVector = vector
    fun fromVector v = tabulate (Vector.length v, fn i => Vector.sub (v, i))
    val isoVector = (toVector, fromVector)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-array-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-array-ext.fun	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-array-ext.fun	2006-11-16 10:49:19 UTC (rev 4826)
@@ -11,11 +11,16 @@
                         structure MonoArray : MONO_ARRAY
                            where type elem = MonoVector.elem
                            where type vector = MonoVector.vector) = struct
-   open MonoArray
-   type t = array
+   local
+      structure MonoArray = struct
+         open MonoArray
+         type t = array
+      end
+      structure Common = MkMonoSeqCommonExt (MonoArray)
+   in
+      open MonoArray Common
+   end
    fun dup a = tabulate (length a, fn i => sub (a, i))
-   fun toList a = foldr op :: [] a
-   val isoList = (toList, fromList)
    val toVector = vector
    fun fromVector v =
        tabulate (MonoVector.length v, fn i => MonoVector.sub (v, i))
@@ -24,4 +29,3 @@
    fun fromPoly a = tabulate (Array.length a, fn i => Array.sub (a, i))
    val isoPoly = (toPoly, fromPoly)
 end
-

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-seq-common-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-seq-common-ext.fun	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-seq-common-ext.fun	2006-11-16 10:49:19 UTC (rev 4826)
@@ -0,0 +1,23 @@
+(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(**
+ * Functor to make common sequence (array or vector) extensions.
+ *)
+functor MkMonoSeqCommonExt (type t
+                            type elem
+                            val foldr : (elem * 'a -> 'a) -> 'a -> t -> 'a
+                            val fromList : elem list -> t
+                            val maxLen : int) = struct
+   fun unfoldi fis (n, s) = let
+      fun lp (i, s, xs) =
+          if i = n then (fromList (rev xs), s)
+          else case fis (i, s) of (x, s) => lp (i+1, s, x::xs)
+   in if n < 0 orelse maxLen < n then raise Size else lp (0, s, [])
+   end
+   fun toList t = foldr op :: [] t
+   val isoList = (toList, fromList)
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-seq-common-ext.fun
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-vector-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-vector-ext.fun	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-mono-vector-ext.fun	2006-11-16 10:49:19 UTC (rev 4826)
@@ -7,11 +7,16 @@
 (**
  * Functor for extending {MONO_VECTOR} modules.
  *)
-functor MkMonoVectorExt (M : MONO_VECTOR) = struct
-   open M
-   type t = vector
-   fun toList v = foldr op :: [] v
-   val isoList = (toList, fromList)
+functor MkMonoVectorExt (MonoVector : MONO_VECTOR) = struct
+   local
+      structure MonoVector = struct
+         open MonoVector
+         type t = vector
+      end
+      structure Common = MkMonoSeqCommonExt (MonoVector)
+   in
+      open MonoVector Common
+   end
    (* XXX It would be nice to avoid copying in toPoly and fromPoly *)
    fun toPoly v = Vector.tabulate (length v, fn i => sub (v, i))
    fun fromPoly v = tabulate (Vector.length v, fn i => Vector.sub (v, i))

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-seq-common-ext.fun
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-seq-common-ext.fun	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-seq-common-ext.fun	2006-11-16 10:49:19 UTC (rev 4826)
@@ -0,0 +1,22 @@
+(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+ *
+ * MLton is released under a BSD-style license.
+ * See the file MLton-LICENSE for details.
+ *)
+
+(**
+ * Functor to make common sequence (array or vector) extensions.
+ *)
+functor MkSeqCommonExt (type 'a t
+                        val foldr : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+                        val fromList : 'a list -> 'a t
+                        val maxLen : int) = struct
+   fun unfoldi fis (n, s) = let
+      fun lp (i, s, xs) =
+          if i = n then (fromList (rev xs), s)
+          else case fis (i, s) of (x, s) => lp (i+1, s, x::xs)
+   in if n < 0 orelse maxLen < n then raise Size else lp (0, s, [])
+   end
+   fun toList t = foldr op :: [] t
+   val isoList = (toList, fromList)
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/mk-seq-common-ext.fun
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/funs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/funs.cm	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/smlnj/funs.cm	2006-11-16 10:49:19 UTC (rev 4826)
@@ -9,9 +9,11 @@
    ../mk-integer-ext.fun
    ../mk-mono-array-ext.fun
    ../mk-mono-array-slice-ext.fun
+   ../mk-mono-seq-common-ext.fun
    ../mk-mono-vector-ext.fun
    ../mk-mono-vector-slice-ext.fun
    ../mk-real-ext.fun
+   ../mk-seq-common-ext.fun
    ../mk-text-ext.fun
    ../mk-word-ext.fun
    workarounds/basis.cm

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/vector.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/vector.sml	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/vector.sml	2006-11-16 10:49:19 UTC (rev 4826)
@@ -8,8 +8,13 @@
  * Extended {Vector :> VECTOR} structure.
  *)
 structure Vector : VECTOR = struct
-   open Vector
-   type 'a t = 'a vector
-   fun toList v = foldr op :: [] v
-   val isoList = (toList, fromList)
+   local
+      structure Vector = struct
+         open Vector
+         type 'a t = 'a vector
+      end
+      structure Common = MkSeqCommonExt (Vector)
+   in
+      open Vector Common
+   end
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb	2006-11-16 10:49:19 UTC (rev 4826)
@@ -45,6 +45,8 @@
          detail/mk-int-inf-ext.fun
          detail/mk-real-ext.fun
          detail/mk-word-ext.fun
+         detail/mk-seq-common-ext.fun
+         detail/mk-mono-seq-common-ext.fun
          detail/mk-mono-vector-ext.fun
          detail/mk-mono-vector-slice-ext.fun
          detail/mk-mono-array-ext.fun

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use	2006-11-16 10:49:19 UTC (rev 4826)
@@ -28,6 +28,8 @@
             "detail/mk-int-inf-ext.fun",
             "detail/mk-real-ext.fun",
             "detail/mk-word-ext.fun",
+            "detail/mk-seq-common-ext.fun",
+            "detail/mk-mono-seq-common-ext.fun",
             "detail/mk-mono-vector-ext.fun",
             "detail/mk-mono-vector-slice-ext.fun",
             "detail/mk-mono-array-ext.fun",

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/array.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/array.sig	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/array.sig	2006-11-16 10:49:19 UTC (rev 4826)
@@ -21,6 +21,13 @@
     * to {tabulate (length a, fn i => sub (a, i))}.
     *)
 
+   val unfoldi : (int * 'b -> 'a * 'b) -> int * 'b -> 'a t * 'b
+   (**
+    * {unfoldi f (n, b)} constructs an array a of length {n}, whose
+    * elements {ai} are determined by the equations {b0 = b} and {(ai,
+    * bi+1) = f (i, bi)}.
+    *)
+
    (** == Conversions == *)
 
    val fromVector : 'a vector -> 'a array

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-array.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-array.sig	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-array.sig	2006-11-16 10:49:19 UTC (rev 4826)
@@ -21,6 +21,13 @@
     * to {tabulate (length a, fn i => sub (a, i))}.
     *)
 
+   val unfoldi : (int * 'a -> elem * 'a) -> int * 'a -> t * 'a
+   (**
+    * {unfoldi f (n, b)} constructs an array a of length {n}, whose
+    * elements {ai} are determined by the equations {b0 = b} and {(ai,
+    * bi+1) = f (i, bi)}.
+    *)
+
    (** == Conversions == *)
 
    val fromPoly : elem Array.array -> array

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-vector.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-vector.sig	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/mono-vector.sig	2006-11-16 10:49:19 UTC (rev 4826)
@@ -15,6 +15,13 @@
     * Convenience alias.
     *)
 
+   val unfoldi : (int * 'a -> elem * 'a) -> int * 'a -> t * 'a
+   (**
+    * {unfoldi f (n, b)} constructs a vector {v} of a length {n}, whose
+    * elements {vi} are determined by the equations {b0 = b} and {(vi,
+    * bi+1) = f (i, bi)}.
+    *)
+
    (** == Conversions == *)
 
    val fromPoly : elem Vector.vector -> vector

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/vector.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/vector.sig	2006-11-15 18:35:09 UTC (rev 4825)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/vector.sig	2006-11-16 10:49:19 UTC (rev 4826)
@@ -15,6 +15,13 @@
     * Convenience alias.
     *)
 
+   val unfoldi : (int * 'b -> 'a * 'b) -> int * 'b -> 'a t * 'b
+   (**
+    * {unfoldi f (n, b)} constructs a vector {v} of a length {n}, whose
+    * elements {vi} are determined by the equations {b0 = b} and {(vi,
+    * bi+1) = f (i, bi)}.
+    *)
+
    (** == Conversions == *)
 
    val toList : 'a vector -> 'a list




More information about the MLton-commit mailing list