Streams

lib/Stream.fram

@@ -0,0 +1,191 @@
+{# 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 deffered, meaniung 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
+
+method unstream (Stream xs) = xs
+
+{## Creates stream from given list. ##}
+pub let rec fromList xs = Stream (lazy (fn _ =>
+  match xs with
+  | x :: xs => Cons x (fromList xs)
+  | []      => Nil
+  end))
+
+{## Returns all elements of a stream as a list. ##}
+pub let rec toList (Stream xs) =
+  match xs.force with
+  | Cons x xs => x :: toList xs
+  | Nil       => []
+  end
+
+{##
+  Initializes lazy stream by iteratively applying function `f` on previous results.
+
+  This function may generate infinite stream.
+ ##}
+pub let rec init {X : type, Y : type}
+  (seed : X) (f : X ->[] Option (Pair Y X)) = (Stream (lazy (fn _ =>
+    match f seed with
+    | None             => Nil
+    | Some (val, seed) => Cons val (init seed f)
+    end)) : Stream Y)
+
+{## Creates an empty stream. ##}
+pub let mkEmpty {X : type} () = (Stream (pureLazy Nil) : Stream X)
+
+{## Checks if a stream is empty. ##}
+pub let isEmpty (Stream xs) =
+  match xs.force with
+  | Nil => True
+  | _   => False
+  end
+
+{## Creates a stream from given element. ##}
+pub let singleton elem = Stream (pureLazy (Cons elem (mkEmpty ())))
+
+{## Adds an element to the head of a stream. ##}
+pub let cons
+  {X : type} 
+  (elem : X)
+  (tail : Stream X) =
+    Stream (pureLazy (Cons elem tail))
+
+{## Adds a deffered element to the head of a stream. ##}
+pub let lazyCons
+  {X : type}
+  (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) =
+  match xs.force with
+  | Nil       => None
+  | Cons x xs => Some (x, xs)
+  end
+
+{##
+  Creates a new stream with mapped values.
+ ##}
+pub let rec map f (Stream xs) = Stream (lazy (fn _ =>
+  match xs.force with
+  | Cons x xs => Cons (f x) (map f xs)
+  | Nil       => Nil
+  end))
+
+{## Appends two streams together. ##}
+pub let rec append (Stream xs) (ys : Stream _) = Stream (lazy (fn _ =>
+  match xs.force with
+  | Cons x xs => Cons x (append xs ys)
+  | Nil       => ys.unstream.force
+  end))
+
+{## Performs monadic bind over a stream. ##}
+pub let rec bind f (Stream xs) = Stream (lazy (fn _ =>
+  match xs.force with
+  | Cons x xs => append (f x) (bind f xs) >.unstream >.force
+  | Nil       => Nil
+  end))
+
+{##
+  Returns a longest prefix of a stream that satisfies given predicate
+ ##}
+pub let rec takeWhile f (Stream xs) = Stream (lazy (fn _ =>
+  match xs.force with
+  | Cons x xs =>
+    if f x then
+      Cons x (takeWhile f xs)
+    else
+      Nil
+  | Nil => Nil
+  end))
+
+{## Returns a st Stream with values that satisfies given predicate. ##}
+pub let rec filter f (Stream xs) = 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))
+
+{##
+  Folds stream to a single value.
+ ##}
+pub let rec foldRight f (Stream xs) acc =
+  match xs.force with
+  | Cons x xs => f x (foldRight f xs acc)
+  | Nil       => acc
+  end
+
+{##
+  Folds stream to a single value. Takes last element of as stream
+  as an initial accumulator. Calls `~onError` in case of an empty
+  stream.
+ ##}
+pub let foldRight1Err {~onError} f (Stream xs) =
+  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
+
+{## Checks if all elements of given streams are equal pairwise. ##}
+pub let equal
+  {X, 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
+
+parameter ~onError
+
+pub method toList = toList
+pub method uncons = uncons
+pub method map = flip map
+pub method add = append
+pub method bind = flip bind
+pub method filter = flip filter
+pub method foldRight xs f acc = foldRight f xs acc
+pub method foldRight1Err = flip foldRight1Err
+pub method equal = equal

test/stdlib/stdlib0004_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.mkEmpty ())) in
+  xs == Stream.fromList (Stream.toList xs))
+
+let _ =
+  let f x = if 2 == x then None else Some (x, 1 + x) in
+  assert {msg="init"}
+    (Stream.fromList [0, 1] == Stream.init 0 f)
+
+let _ = assert {msg="isEmpty"} (Stream.isEmpty (Stream.mkEmpty {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.mkEmpty {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="bind"}
+  (Stream.fromList [1, 2, 3] >.bind (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.mkEmpty {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])))