Stream Types

[chebert]

I've written two stream types for my application which I'll share below.

To avoid recomputation the streams depend on Lisp to implement a memoize-thunk.

The first stream type is like a lazy list whose tails are delayed.
The second stream type is like the first, but is guaranteed to never be empty.
I've found the second stream type to be more useful, since a lot of times with streams I want an infinite set of integer ids, random numbers, etc., and there is no point in checking if the stream is empty if I know its impossible.

(cl:defun memoize-thunk (funit->a)
  "Return a memoized thunk of the same type as funit->a which
evaluates funit->a at most once."
  (cl:let ((value ())
	   (already-computed? cl:nil))
    ;; Return a function of Unit -> a
    (fn (_)
      (cl:declare (cl:ignore _))
      (cl:if already-computed?
	     ;; If we have already computed the value, we can return it.
	     value
	     ;; Otherwise we need to compute the value and store it before returning it.
	     (cl:progn
	       (cl:setq value (cl:funcall funit->a unit))
	       (cl:setq already-computed? cl:t)
	       value)))))

(coalton-toplevel
  (declare memoized ((unit -> :a) -> (unit -> :a)))
  (define (memoized thunk)
    "Return a memoized thunk that will evaluate thunk at most once."
    (lisp (unit -> :a) (thunk) (memoize-thunk thunk))))

(coalton-toplevel
  (define-type (Stream :value)
    "A stream is a lazy list-like data structure whose head is a value,
and whose tail is a function which returns the rest of the stream."
    (%StreamCons :value (unit -> (Stream :value)))
    (StreamEmpty))

  (define (stream-cons head delayed-tail)
    "Construct a stream with the head and a memoized version of the delayed-tail."
    (%StreamCons head (memoized delayed-tail)))
  (define (stream-head stream)
    "Return the first element of stream if not empty."
    (match stream
      ((%StreamCons head _) (Some head))
      ((StreamEmpty) None)))
  (define (stream-tail stream)
    "Return the forced tail of stream. If the stream is empty, returns the empty stream."
    (match stream
      ((%StreamCons _ delayed-tail) (delayed-tail))
      ((StreamEmpty) StreamEmpty)))

  (define-instance (Semigroup (Stream :value))
    (define (<> stream1 stream2)
      ;; Returns a stream with stream2 appended to the end of stream1
      (match (stream-head stream1)
	((Some head)
	 (stream-cons head (fn (_) (<> (stream-tail stream1) stream2))))
	((None) stream2))))

  (define-instance (Monoid (Stream :value))
    (define mempty StreamEmpty))

  (define-instance (Alternative Stream)
    (define alt <>)
    (define empty mempty))

  (define-instance (Functor Stream)
    (define (map fa->b sa)
      (match (stream-head sa)
	((Some a)
	 (stream-cons (fa->b a)
		      (fn (_) (map fa->b (stream-tail sa)))))
	((None) StreamEmpty))))

  (define-instance (Applicative Stream)
    (define (pure value)
      ;; Return a stream with a single element, like the List Applicative instance.
      (stream-cons value (fn (_) StreamEmpty)))

    (define (liftA2 fab->c sa sb)
      (match (stream-head sa)
	((Some a)
	 (match (stream-head sb)
	   ((Some b)
	    (stream-cons (fab->c a b)
			 (fn (_)
			   (liftA2 fab->c
				   (stream-tail sa)
				   (stream-tail sb)))))
	   ((None) StreamEmpty))))))

  (define-instance (Monad Stream)
    (define (>>= sa fa->sb)
      (match (stream-head sa)
	((Some a)
	 ;; Append the stream of b to the rest of the stream of bs
	 (<> (fa->sb a) (>>= (stream-tail sa) fa->sb)))
	((None) StreamEmpty)))))

(coalton-toplevel
  (define-type (InfiniteStream :value)
    "An infinite stream is a lazy list-like data structure whose head is a value,
and whose tail is a function which returns the rest of the stream. Unlike a Stream,
an InfiniteStream is guaranteed to never be empty."
    (%InfiniteStreamCons :value (unit -> (InfiniteStream :value))))

  (define (infinite-stream-cons head delayed-tail)
    "Construct a stream with the head and a memoized version of the delayed-tail."
    (%InfiniteStreamCons head (memoized delayed-tail)))
  (define (infinite-stream-head stream)
    "Return the first element of stream."
    (match stream
      ((%InfiniteStreamCons head _) head)))
  (define (infinite-stream-tail stream)
    "Return the forced tail of stream."
    (match stream
      ((%InfiniteStreamCons _ delayed-tail) (delayed-tail))))

  (define-instance (Functor InfiniteStream)
    (define (map fa->b sa)
      (infinite-stream-cons (fa->b (infinite-stream-head sa))
			    (fn (_) (map fa->b (infinite-stream-tail sa))))))

  (define-instance (Applicative InfiniteStream)
    (define (pure value)
      ;; Return an infinite stream of value.
      (infinite-stream-cons value (fn (_) (pure value))))

    (define (liftA2 fab->c sa sb)
      (infinite-stream-cons (fab->c (infinite-stream-head sa)
				    (infinite-stream-head sb))
			    (fn (_)
			      (liftA2 fab->c
				      (infinite-stream-tail sa)
				      (infinite-stream-tail sb)))))))