[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