[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