Streams

lib/Lazy.fram

@@ -21,9 +21,10 @@ data RefP = RefP of {Ref : type -> type}
 
 let RefP {Ref} = (extern dbl_abstrType : Unit ->[IO] RefP) ()
 
-let ref {type X}    = (extern dbl_ref    : X ->[] Ref X)
-method get {type X} = (extern dbl_refGet : Ref X ->[] X)
-method set {type X} = (extern dbl_refSet : Ref X -> X ->[] Unit)
+let ref {type X}     = (extern dbl_ref    : X ->[] Ref X)
+let pureRef {type X} = (extern dbl_ref    : X -> Ref X)
+method get {type X}  = (extern dbl_refGet : Ref X ->[] X)
+method set {type X}  = (extern dbl_refSet : Ref X -> X ->[] Unit)
 
 # Internal representation of lazy state
 data LazyState A =
@@ -37,8 +38,12 @@ abstr data Lazy X = Lazy of Ref (LazyState X)
 {## Creates new suspension from a given computation. ##}
 pub let lazy {type X} (f : Unit ->[] X) = Lazy (ref (Thunk f))
 
-{## Initializes a lazy with a value directly. ##}
-pub let pureLazy {type X} (v : X) = Lazy (ref (Done v))
+{##
+  Creates a lazy value containing a fully evaluated result.
+  This is equivalent to constructing an immutable value directly,
+  so this function is pure.
+ ##}
+pub let pureLazy {type X} (v : X) = Lazy (pureRef (Done v))
 
 {##
   Forces the evaluation of a suspension.

lib/Stream.fram

@@ -0,0 +1,204 @@
+{# This file is part of DBL, released under the MIT license.
+ # See LICENSE for details.
+ #}
+
+import open /Lazy
+
+## # Stream module
+
+{##
+  This module provides lazy lists, also known as streams.
+  Each and every node of a stream is deferred, meaning that
+  no computation occurs unless results are forcibly read.
+
+  Contrary to regular lists, streams may be infinite. Some iterative
+  functions may never terminate!
+ ##}
+
+rec
+  ## Stream type.
+  abstr data Stream X = Stream of Lazy (Node X)
+  data Node X =
+    | Cons of X, Stream X
+    | Nil
+end
+
+parameter X : type
+
+method unstream (Stream xs) = xs
+
+{## Creates stream from given list. ##}
+pub let rec fromList (xs : List X) =
+  Stream (lazy (fn _ =>
+    match xs with
+    | []      => Nil
+    | x :: xs => Cons x (fromList xs)
+    end)) : Stream X
+
+{## Returns all elements of a stream as a list. ##}
+pub let rec toList (Stream xs : Stream X) =
+  match xs.force with
+  | Nil       => [] : List X
+  | Cons x xs => x :: toList xs
+  end : List X
+
+{##
+  Initializes lazy stream by iteratively applying function `f` on previous results.
+
+  This function may generate infinite stream.
+ ##}
+pub let rec unfold {S} (seed : S) (f : S ->[] Option (Pair X S)) =
+  Stream (lazy (fn _ =>
+    match f seed with
+    | None             => Nil
+    | Some (val, seed) => Cons val (unfold seed f)
+    end)) : Stream X
+
+{## Creates an empty stream. ##}
+pub let empty = (Stream (pureLazy Nil) : Stream X)
+
+{## Checks if a stream is empty. ##}
+pub let isEmpty (Stream xs : Stream X) =
+  match xs.force with
+  | Nil => True
+  | _   => False
+  end
+
+{## Creates a stream from given element. ##}
+pub let singleton (elem : X) =
+  Stream (pureLazy (Cons elem empty))
+
+{## Adds an element to the head of a stream. ##}
+pub let cons (elem : X) (tail : Stream X) =
+  Stream (pureLazy (Cons elem tail))
+
+{## Adds a deferred element to the head of a stream. ##}
+pub let lazyCons (elem : Lazy X) (tail : Stream X) =
+  Stream (lazy (fn _ => Cons elem.force tail))
+
+{##
+  Returns head and tail of a stream.
+  Returns `None` if stream is empty.
+ ##}
+pub let uncons (Stream xs : Stream X) =
+  match xs.force with
+  | Nil       => None
+  | Cons x xs => Some (x, xs)
+  end
+
+{##
+  Creates a new stream with mapped values.
+ ##}
+pub let rec map {Y} (f : X ->> Y) (Stream xs : Stream X) =
+  Stream (lazy (fn _ =>
+    match xs.force with
+    | Nil       => Nil
+    | Cons x xs => Cons (f x) (map f xs)
+    end)) : Stream Y
+
+{## Appends two streams together. ##}
+pub let rec append (Stream xs : Stream X) (ys : Stream X) =
+  Stream (lazy (fn _ =>
+    match xs.force with
+    | Nil       => ys.unstream.force
+    | Cons x xs => Cons x (append xs ys)
+    end)) : Stream X
+
+{## Performs monadic bind over a stream. ##}
+pub let rec concatMap {Y} (f : X ->> Stream Y) (Stream xs : Stream X) =
+  Stream (lazy (fn _ =>
+    match xs.force with
+    | Nil       => Nil
+    | Cons x xs => append (f x) (concatMap f xs) >.unstream >.force
+    end)) : Stream Y
+
+{##
+  Returns the longest prefix of a stream that satisfies the given predicate.
+ ##}
+pub let rec takeWhile (f : X ->> Bool) (Stream xs : Stream X) =
+  Stream (lazy (fn _ =>
+    match xs.force with
+    | Nil       => Nil
+    | Cons x xs =>
+      if f x then
+        Cons x (takeWhile f xs)
+      else
+        Nil
+    end)) : Stream X
+
+{## Returns a substream with values that satisfy the given predicate. ##}
+pub let rec filter (f : X ->> Bool) (Stream xs : Stream X) =
+  Stream (lazy (fn _ =>
+    match xs.force with
+    | Nil       => Nil
+    | Cons x xs =>
+      if f x then
+        Cons x (filter f xs)
+      else
+        filter f xs >.unstream >.force
+    end)) : Stream X
+
+{##
+  Folds stream to a single value, beginning with right-most value.
+ ##}
+pub let rec foldRight {A}
+  (f : X -> A ->> A) (Stream xs : Stream X) (acc : A) =
+    match xs.force with
+    | Nil       => acc
+    | Cons x xs => f x (foldRight f xs acc)
+    end : A
+
+{##
+  Folds stream to a single value from right to left. Takes the last
+  element of a stream as an initial accumulator.
+  Calls `~onError` in case of an empty stream.
+
+  @param ~onError Fallback for an empty stream.
+ ##}
+pub let foldRight1Err {~onError : Unit ->> X}
+  (f : X -> X ->> X) (Stream xs : Stream X) =
+    let rec foldRight1ErrAux y (Stream xs) =
+      match xs.force with
+      | Nil       => y
+      | Cons x xs =>
+          f y (foldRight1ErrAux x xs)
+      end
+    in
+    match xs.force with
+    | Nil       => ~onError ()
+    | Cons x xs => foldRight1ErrAux x xs
+    end : X
+
+{## Checks if all elements of given streams are equal pairwise. ##}
+pub let equal
+  {method equal : X -> X ->[] Bool}
+  (xs : Stream X)
+  (ys : Stream X) =
+    let rec equalAux ((Stream xs) : Stream X) ((Stream ys) : Stream X) =
+      match (xs.force, ys.force) with
+      | Nil, Nil => True
+      | Cons x xs, Cons y ys =>
+        if x == y then
+          equalAux (xs : Stream X) ys
+        else
+          False
+      | _ => False
+      end
+    in
+    equalAux xs ys
+
+{## Enables stream showing in REPL. ##}
+pub let show (_ : Stream X) = "#Stream"
+
+parameter ~onError
+
+pub method toList = toList
+pub method uncons = uncons
+pub method map = flip map
+pub method add = append
+pub method concatMap = flip concatMap
+pub method filter = flip filter
+pub method foldRight xs f acc = foldRight f xs acc
+pub method foldRight1Err = flip foldRight1Err
+pub method equal = equal
+pub method show = show

test/stdlib/stdlib0007_Stream.fram

@@ -0,0 +1,72 @@
+import List
+import Stream
+
+let _ = assert {msg="fromList > toList"}
+ (let xs = [1, 2, 3, 4] in
+  xs == Stream.toList (Stream.fromList xs))
+
+let _ = assert {msg="toList > fromList"}
+ (let xs = Stream.cons 10 (Stream.cons 20 (Stream.empty)) in
+  xs == Stream.fromList (Stream.toList xs))
+
+let _ =
+  let f x = if 2 == x then None else Some (x, 1 + x) in
+  assert {msg="unfold"}
+    (Stream.fromList [0, 1] == Stream.unfold 0 f)
+
+let _ = assert {msg="isEmpty"} (Stream.isEmpty (Stream.empty {X=Int}))
+let _ = assert {msg="isEmpty"} (not (Stream.isEmpty (Stream.fromList [1])))
+
+let _ = assert {msg="singleton"} (Stream.singleton 1 == Stream.fromList [1])
+
+let _ = assert {msg="cons"}
+  (Stream.cons 3 (Stream.fromList [2, 1]) == Stream.fromList [3, 2, 1])
+
+let _ = assert {msg="uncons"}
+  match Stream.uncons (Stream.fromList [1, 2, 3]) with
+  | Some (x, _) => 1 == x
+  | None        => False
+  end
+let _ = assert {msg="uncons"}
+  match Stream.uncons (Stream.empty {X=Int}) with
+  | None => True
+  | _    => False
+  end
+
+let _ = assert {msg="map"}
+  (Stream.fromList ["1", "2"]
+  == Stream.map (fn x => (x : Int).toString) (Stream.fromList [1, 2]))
+
+let _ = assert {msg="append"}
+  (Stream.append (Stream.fromList [1, 2, 3]) (Stream.fromList [4, 5, 6])
+  == Stream.fromList [1, 2, 3, 4, 5, 6])
+
+let _ = assert {msg="concatMap"}
+  (Stream.fromList [1, 2, 3] >.concatMap (fn (x : Int) => Stream.fromList [x + 1, x - 1])
+  == Stream.fromList [2, 0, 3, 1, 4, 2])
+
+let _ = assert {msg="takeWhile"}
+  (Stream.takeWhile (fn (x : Int) => x <= 2) (Stream.fromList [1, 2, 3, 4, 1])
+  == Stream.fromList [1, 2])
+
+let _ = assert {msg="filter"}
+  (Stream.filter (fn (x : Int) => x <= 2) (Stream.fromList [1, 2, 3, 4, 1])
+  == Stream.fromList [1, 2, 1])
+
+let _ = assert {msg="foldRight"}
+  (Stream.foldRight (fn (x : Int) y => x + y) (Stream.fromList [1, 2, 3, 4]) 0
+  == 10)
+
+let _ = assert {msg="foldRight1Err"}
+  (Stream.foldRight1Err {~onError = fn _ => 42}
+    (fn (x : Int) y => x + y) (Stream.fromList [1, 2, 3, 4])
+  == 10)
+let _ = assert {msg="foldRight1Err"}
+  (Stream.foldRight1Err {~onError = fn _ => 42}
+    (fn (x : Int) y => x + y) (Stream.empty {X=Int})
+  == 42)
+
+let _ = assert {msg="equal"}
+  (Stream.equal (Stream.fromList [1, 2, 3]) (Stream.fromList [1, 2, 3]))
+let _ = assert {msg="equal"}
+  (not (Stream.equal (Stream.fromList [1, 2, 3]) (Stream.fromList [4, 5, 6])))