[MLton-commit] r6003
Vesa Karvonen
vesak at mlton.org
Thu Sep 6 07:03:37 PDT 2007
A minimalistic implementation of streams. To be extended later.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
A mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/stream.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
A mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/stream.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/bootstrap.sml 2007-09-06 14:03:35 UTC (rev 6003)
@@ -30,6 +30,7 @@
structure Option = struct open BasisOption type 'a t = 'a option end
structure Order = struct datatype order = datatype order type t = order end
structure String = struct open BasisString type t = string end
+structure Substring = struct open BasisSubstring type t = substring end
structure Vector = struct open BasisVector type 'a t = 'a vector end
structure VectorSlice = struct open BasisVectorSlice type 'a t = 'a slice end
structure Word = struct open BasisWord type t = word end
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm 2007-09-06 14:03:35 UTC (rev 6003)
@@ -74,6 +74,7 @@
../../../public/sequence/mono-vector-slice.sig
../../../public/sequence/mono-vector.sig
../../../public/sequence/resizable-array.sig
+ ../../../public/sequence/stream.sig
../../../public/sequence/vector-slice.sig
../../../public/sequence/vector.sig
../../../public/text/char.sig
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2007-09-06 14:03:35 UTC (rev 6003)
@@ -73,6 +73,7 @@
../../../detail/sequence/mk-mono-vector-slice-ext.fun
../../../detail/sequence/mk-seq-common-ext.fun
../../../detail/sequence/resizable-array.sml
+ ../../../detail/sequence/stream.sml
../../../detail/sequence/vector-slice.sml
../../../detail/sequence/vector.sml
../../../detail/text/mk-text-ext.fun
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/stream.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/stream.sml 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/stream.sml 2007-09-06 14:03:35 UTC (rev 6003)
@@ -0,0 +1,80 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Stream :> STREAM = struct
+ datatype ('a, 's) step =
+ DONE
+ | GIVE of 'a * 's
+ | SKIP of 's
+ type ('a, 's) stream = 's * ('s -> ('a, 's) step)
+ type 'a t = ('a, Univ.t) stream
+
+ fun seal (s, s2xS) =
+ case Univ.Iso.new ()
+ of (to, from) =>
+ (to s,
+ (fn DONE => DONE
+ | SKIP s => SKIP (to s)
+ | GIVE (a, s) => GIVE (a, to s)) o s2xS o from)
+
+ fun mapStep s2s (s, s2xS) = (s, s2s o s2xS)
+
+ fun foldl xy2y y (u, u2s) = let
+ fun lp (y, u) =
+ case u2s u
+ of DONE => y
+ | GIVE (x, u) => lp (xy2y (x, y), u)
+ | SKIP u => lp (y, u)
+ in
+ lp (y, u)
+ end
+
+ fun app ef = foldl (ef o #1) ()
+
+ fun map x2y =
+ mapStep (fn DONE => DONE
+ | SKIP s => SKIP s
+ | GIVE (x, s) => GIVE (x2y x, s))
+
+ fun filter px =
+ mapStep (fn GIVE (x, s) => if px x then GIVE (x, s) else SKIP s
+ | otherwise => otherwise)
+
+ fun tabulate (n, i2a) =
+ if n < 0
+ then raise Domain
+ else seal (0,
+ fn i => if i < n
+ then GIVE (i2a i, i+1)
+ else DONE)
+
+ fun unfoldr s2asO s =
+ seal (s,
+ fn s =>
+ case s2asO s
+ of NONE => DONE
+ | SOME (a, s) => GIVE (a, s))
+
+ local
+ fun mk length sub s = tabulate (length s, fn i => sub (s, i))
+ in
+ fun fromArray ? = mk Array.length Array.sub ?
+ fun fromVector ? = mk Vector.length Vector.sub ?
+ val fromString = mk size String.sub
+ fun fromArraySlice ? = mk ArraySlice.length ArraySlice.sub ?
+ fun fromVectorSlice ? = mk VectorSlice.length VectorSlice.sub ?
+ val fromSubstring = mk Substring.length Substring.sub
+ end
+
+ fun toBuffer s = case Buffer.new () of b => (app (Buffer.push b) s ; b)
+
+ fun toArray s = Buffer.toArray (toBuffer s)
+ fun toVector s = Buffer.toVector (toBuffer s)
+ fun toString s = Buffer.toString (toBuffer s)
+
+ fun fromList xs = unfoldr List.getItem xs
+ fun toList s = rev (foldl op :: [] s)
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/stream.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2007-09-06 14:03:35 UTC (rev 6003)
@@ -39,7 +39,9 @@
detail/ml/$(SML_COMPILER)/workarounds.mlb
(* Minimal modules for bootstrapping. *)
- detail/bootstrap.sml
+ ann "warnUnused false" in
+ detail/bootstrap.sml
+ end
(* Compiler specific extensions (if any). *)
detail/ml/$(SML_COMPILER)/extensions.mlb
@@ -278,6 +280,10 @@
detail/ml/$(SML_COMPILER)/mono-array-slices.sml
detail/ml/$(SML_COMPILER)/texts.sml
+ (* Stream *)
+ public/sequence/stream.sig
+ detail/sequence/stream.sml
+
(* Lazy *)
public/lazy/lazy.sig
detail/lazy/lazy.sml
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2007-09-06 14:03:35 UTC (rev 6003)
@@ -92,6 +92,7 @@
signature RESIZABLE_ARRAY = RESIZABLE_ARRAY
signature SHIFT_OP = SHIFT_OP
signature SQ = SQ
+signature STREAM = STREAM
signature STRING = STRING
signature SUBSTRING = SUBSTRING
signature SUM = SUM
@@ -168,6 +169,7 @@
structure Ref : REF where type 'a t = 'a ref = Ref
structure ResizableArray : RESIZABLE_ARRAY = ResizableArray
structure ShiftOp : SHIFT_OP = ShiftOp
+structure Stream : STREAM = Stream
structure String : STRING = String
structure Substring : SUBSTRING = Substring
structure Text : TEXT = Text
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/stream.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/stream.sig 2007-09-05 00:51:52 UTC (rev 6002)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/stream.sig 2007-09-06 14:03:35 UTC (rev 6003)
@@ -0,0 +1,52 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * Signature for the {Stream} module.
+ *
+ * The design and implementation is based on ideas from the following
+ * article:
+ *
+ * Stream Fusion: From Lists to Streams to Nothing at All.
+ * Duncan Coutts, Roman Leshchinskiy, and Don Stewart.
+ * Proceedings of the ACM SIGPLAN International Conference on Functional
+ * Programming, ICFP 2007.
+ * [http://www.cse.unsw.edu.au/~dons/papers/CLS07.html]
+ *)
+signature STREAM = sig
+ type 'a t
+
+ (** == Eliminating Streams == *)
+
+ val foldl : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
+ val app : 'a Effect.t -> 'a t Effect.t
+
+ (** == Manipulating Streams == *)
+
+ val map : ('a -> 'b) -> 'a t -> 'b t
+ val filter : 'a UnPr.t -> 'a t UnOp.t
+
+ (** == Introducing Streams == *)
+
+ val tabulate : Int.t * (Int.t -> 'a) -> 'a t
+ val unfoldr : ('s -> ('a * 's) Option.t) -> 's -> 'a t
+
+ (** == Conversions == *)
+
+ val fromArray : 'a Array.t -> 'a t
+ val fromList : 'a List.t -> 'a t
+ val fromString : String.t -> Char.t t
+ val fromVector : 'a Vector.t -> 'a t
+
+ val fromArraySlice : 'a ArraySlice.t -> 'a t
+ val fromSubstring : Substring.t -> Char.t t
+ val fromVectorSlice : 'a VectorSlice.t -> 'a t
+
+ val toArray : 'a t -> 'a Array.t
+ val toList : 'a t -> 'a List.t
+ val toString : Char.t t -> String.t
+ val toVector : 'a t -> 'a Vector.t
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/stream.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list