SICP 3.5 ストリーム Common Lisp で実装したので、コードを貼っておこう。
遅延ストリーム・無限ストリームを使って、エラトステネスのふるいを作成し、素数を求めた。
(defmacro stream-cons (a b)
`(cons ,a
(delay ,b)))
(defun stream-car (s)
(car s))
(defun stream-cdr (s)
(force (cdr s)))
(defmacro delay (func)
`#'(lambda () ,func))
(defun force (delay-obj)
(funcall delay-obj))
(defvar +stream-empty+ (delay nil))
(defun stream-null? (s)
(eq s +stream-empty+))
(defun stream-enumerate-interval (a b)
(format t "[~a]~%" a b)
(if (= a b)
+stream-empty+
(stream-cons a
(stream-enumerate-interval (1+ a) b))))
(defun stream-each (func s)
(unless (stream-null? s)
(funcall func (stream-car s))
(stream-each func (stream-cdr s))))
(defun stream-cadr (s)
(stream-car (stream-cdr s)))
(defun stream-caddr (s)
(stream-car (stream-cdr (stream-cdr s))))
(defun stream-nth (n s)
(if (= n 0)
(stream-car s)
(stream-nth (1- n) (stream-cdr s))))
(defun stream-integers-starting-from (n)
(stream-cons n
(stream-integers-starting-from (1+ n))))
(defun stream-map (func &rest ss)
(if (null (car ss))
+stream-empty+
(stream-cons
(apply func (mapcar #'car ss))
(apply #'stream-map (cons func (mapcar #'stream-cdr ss))))))
(defun stream-filter (pred s)
(if (stream-null? s)
+stream-empty+
(if (funcall pred (car s))
(stream-cons (car s)
(stream-filter pred (stream-cdr s)))
(stream-filter pred (stream-cdr s)))))
(defun stream-take (s n)
(labels ((iter (s ts n)
(if (= n 0)
(reverse ts)
(iter (stream-cdr s)
(cons (stream-car s) ts)
(1- n)))))
(iter s '() n)))
(defun divisible? (x y)
(= (mod x y) 0))
(defun sieve (stream)
(stream-cons
(stream-car stream)
(sieve
(stream-filter
#'(lambda (x) (not (divisible? x (stream-car stream))))
(stream-cdr stream)))))
sieve関数に2から始まる整数の無限ストリームを渡すと、最初の要素の値2と、2で割れる数を除外した無限ストリームを引数とするsieve関数の結果をconsしたものとなり、素数を表す無限ストリームが得られる。
実行例
最初の10個の素数を取得する。
CL-USER> (stream-take (sieve (stream-integers-starting-from 2)) 10)
(2 3 5 7 11 13 17 19 23 29)
おおっ。素晴しい。
1000個目の素数を取得する。
CL-USER> (stream-nth 999 (sieve (stream-integers-starting-from 2)))
7919
楽しいねー。
10000個目の素数を取得する。
CL-USER> (stream-take (sieve (stream-integers-starting-from 2)) 9999)
帰ってこない...
と思ったら、SBCL(swankサーバー側)でエラーとなっていて、
ヒープを使い尽していた。
fatal error encountered in SBCL pid 26815(tid 140737295218432):
Heap exhausted, game over.
ゲームオーバー...
