Delay and Force

delay.html

(defmacro thunk (x)
  `(lambda () ,x))

(defstruct promise item forced)

(defmacro delay (x)
  `(make-promise :item (thunk ,x) :forced nil))

(defmacro force (x)
  `(etypecase ,x
              (promise (if (promise-forced ,x)
                           (promise-item ,x)
                         (progn
                           (setf (promise-forced ,x) t)
                           (setf (promise-item ,x) (funcall (promise-item ,x))))))
              (t ,x)))

y.lisp

;; The Y combinator.
;; Needs delay.lisp.
  
(defun Y (f)
  (funcall (lambda (x) (funcall f (delay (funcall x x)))) 
           (lambda (x) (funcall f (delay (funcall x x))))))

;; Defining factorial using the Y combinator.
(defun ffact (f)
  (lambda (x)
    (if (zerop x)
        1
      (* x (funcall (force f) (- x 1))))))

(defun fact (n)
  (funcall (Y #'ffact) n))

;; Defining len (length of a list) using the Y combinator.
(defun len (l)
  (funcall (Y (lambda (llen) 
                (lambda (x) 
                  (if (null x) 
                      0 
                    (+ 1 (funcall (force llen) (cdr x))))))) l))

streams.lisp

;; A stream is an infinite list. It is implemented by delaying the computation
;; of all but the first item.

;; Needs delay.lisp.

(defmacro stream-cons (x y)
  `(cons ,x (delay ,y)))

(defmacro stream-car (x)
  `(car ,x))

(defmacro stream-cdr (x)
  `(force (cdr ,x)))

;; The stream of integers >= n.
(defun ints-from (n)
  (stream-cons n (ints-from (+ n 1))))

;; The nth item of a stream.
(defun stream-nth (x n)
  (if (= n 0)
      (stream-car x)
    (stream-nth (stream-cdr x) (- n 1))))

(defun stream-first-n-rev (x n &optional (a nil))
  (if (= n 0) a
    (stream-first-n-rev (stream-cdr x) (- n 1) (cons (stream-car x) a))))

;; A list containing the first n items in a stream.
(defun stream-first-n (x n)
  (reverse (stream-first-n-rev x n)))

;; Filter a stream with a predicate.
(defun stream-filter (x p)
  (if (funcall p (stream-car x))
      (stream-cons (stream-car x) (stream-filter (stream-cdr x) p))
      (stream-filter (stream-cdr x) p)))