Menu
▾
▴
[MLton-commit] r4826
|
From: Vesa K. <ve...@ml...> - 2006-11-16 02:49:22
|
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
|
