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)))