Lazy Streams

I’ve been watching the SICP Lectures with a group of coworkers and friends. We just finished the lectures 6a and 6b which describe how to implement lazy lists or streams. I found these stream lectures to be very enlightening, mostly because they teach a new method of solving problems that is not typical in your average programming job. If you have never watched the lectures I highly recommend it!

Implementing streams requires two new special forms, DELAY and
CONS-STREAM. Neither the book or the video lectures go into great
detail about the actual implementation of DELAY and CONS-STREAM. I
assume the reason is you need access to the compiler code or macros to
implement them, and that is surely beyond the scope of the class.

So I decided to take a crack at implementing the code in Common Lisp,
and I was surprised how simple it is. Common lisp of course has
macros, so implementing the special forms is easy:

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro delay (exp)
    "creates a promise to calculate exp"
    `(memo-proc #'(lambda () ,exp)))

  (defmacro cons-stream (a b)
    `(cons ,a (delay ,b))))

DELAY is simply a macro that wraps its arguments into a lambda
expression. This causes the evaluation of the expression to be delayed
until the lambda expression is executed, using FORCE. MEMO-PROC
creates a memoized version of the lambda, making multiple calls to the
expression more efficient.

CONS-STREAM must also be a macro because it needs to pass its
second argument unevaluated to DELAY. The rest of the stream code can
be implemented using plain-old-procedures.

You can do some pretty neat things with streams, like create a
lazy Sieve of Eratosthenes:

(defun sieve (stream)
  "lazy sieve of eratosthenes"
  (cons-stream
   (stream-car stream)
   (sieve (stream-filter
           #'(lambda (x)
               (not (= 0 (mod x (stream-car stream)))))
           (stream-cdr stream)))))

SICP-STREAMS> (defparameter primes (sieve (integers-from 2)))
PRIMES
SICP-STREAMS> (stream-ref primes 100)
547
SICP-STREAMS> (stream-ref primes 1000)
7927

STREAM-REF finds the Nth element in the stream, so the examples
show the 100th and 1000th primes. It turns out that the lazy sieve is
horribly inefficient because it creates a new stream filter for every
prime found. Finding the 10,000th prime will create 10,000 filter
procedures and execute them all to find the next prime!

Here’s an infinite Fibonacci stream:

SICP-STREAMS> (defparameter fibs (cons-stream
                                  0
                                  (cons-stream
                                   1
                                   (add-streams (stream-cdr fibs)
                                                fibs))))
FIBS
SICP-STREAMS> (stream-ref fibs 10)
55
SICP-STREAMS> (stream-ref fibs 50)
12586269025
SICP-STREAMS> (stream-ref fibs 100)
354224848179261915075

And finally, the complete source code:

#|

Lazy Streams in Common Lisp
Author: Anthony Fairchild

Created: 2008.01.05
Last Modified: 2008.01.07

An implementation of the lazy streams found in SICP, using Common
Lisp.

|#

(defpackage sicp-streams
  (:use :common-lisp))

(in-package :sicp-streams)

;; (declaim (optimize (debug 3)))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defmacro delay (exp)
    "creates a promise to calculate exp"
    `(memo-proc #'(lambda () ,exp)))

  (defmacro cons-stream (a b)
    `(cons ,a (delay ,b))))

(defun memo-proc (proc)
    "returns a memoized version of proc"
    (let ((already-run-p nil)
          (result nil))
      #'(lambda ()
          (if already-run-p
              result
              (progn (setf result (funcall proc))
                     (setf already-run-p t)
                     result)))))

(defun force (exp)
    "evaluates a previously created promise"
    (funcall exp))

(defun stream-car (s) (car s))
(defun stream-cdr (s) (force (cdr s)))

(defun stream-ref (s n)
  "finds the Nth element of stream S"
  (if (= 0 n)
      (stream-car s)
      (stream-ref (stream-cdr s) (- n 1))))

(defun stream-map (proc &rest streams)
  "executes PROC for every element in each stream"
  (if (null streams)
      nil
      (cons-stream
       (apply proc (mapcar #'stream-car streams))
       (apply #'stream-map
              proc
              (mapcar #'stream-cdr streams)))))

(defun stream-filter (pred stream)
  (cond ((not stream) nil)
        ((funcall pred (stream-car stream))
         (cons-stream (stream-car stream)
                      (stream-filter pred
                                     (stream-cdr stream))))
        (t (stream-filter pred (stream-cdr stream)))))

(defun add-streams (s1 s2)
  (stream-map #'+ s1 s2))

(defun stream-for-each (proc stream)
  (if (not stream)
      'done
      (progn (funcall proc (stream-car stream))
             (stream-for-each proc (stream-cdr stream)))))

(defun print-stream (stream)
  (stream-for-each #'print stream))

;;;; Example Usage ;;;;

(defun integers-from (n)`
  "returns a stream of integers starting from N"
  (cons-stream n (integers-from (+ n 1))))

(defun sieve (stream)
  "lazy sieve of eratosthenes"
  (cons-stream
   (stream-car stream)
   (sieve (stream-filter
           #'(lambda (x)
               (not (= 0 (mod x (stream-car stream)))))
           (stream-cdr stream)))))

(defun make-primes-stream ()
  (sieve (integers-from 2)))

(defun make-fibs-stream ()
  (let ((fibs nil))
    (setf fibs (cons-stream
                0
                (cons-stream
                 1
                 (add-streams (stream-cdr fibs)
                              fibs))))
    fibs))