Plaster
New
List
Login
text
default
anonymous
2023.08.21 22:48:09
;;;; Streams from SICP ;;;; Here, I'll call them rivers (defparameter *the-empty-river* '*the-empty-river*) (defmacro delay (expr) (let ((table (gensym))) `(let ((,table nil)) (lambda () (unless ,table (push ,expr ,table)) (car ,table))))) #|| (defun memo (fn) (let ((val nil)) (lambda () (unless val (push (funcall fn) val)) (car val)))) (defun delay (expr) `(memo (lambda () ,expr))) ||# (defun force (expr) (funcall expr)) (defun cons-river (item river) (cons item (delay river))) (defun river-car (river) (car river)) (defun river-cdr (river) (force (cdr river))) (defun river-ref (river n) "Get the nth element of river" (if (zerop n) (river-car river) (river-ref (river-cdr river) (1- n)))) (defun river-null? (river) (eq river *the-empty-river*)) (defun river-map (fn &rest rivers) (if (some #'river-null? rivers) *the-empty-river* (cons-river (apply fn (mapcar #'river-car rivers)) (apply #'river-map fn (mapcar #'river-cdr rivers))))) (defun river-for-each (fn river) (if (river-null? river) 'done (progn (funcall fn (river-car river)) (river-for-each fn (river-cdr river))))) (defun display-river (river) (river-for-each (lambda (x) (format t "~&~A~%" x)) river)) (defun river-enumerate-interval (low high) ;; Tracing this shows it is evaluated eagerly!!! (if (> low high) *the-empty-river* (cons-river low (river-enumerate-interval (1+ low) high)))) (defun prime? (n) (labels ((crude (n) (do ((p 3 (+ p 2)) (e (1+ (isqrt n))) (k (mod n 3) (mod n p))) ((or (> p e) (zerop k)) (or (> p e) (> k 1)))))) (or (= 2 n) (= 3 n) (and (not (evenp n)) (crude n))))) (defun river-filter (fn river) (if (river-null? river) *the-empty-river* (destructuring-bind (head tail) river (if (funcall fn head) (cons-river head (river-filter fn tail)) (river-filter fn tail))))) #|| RECURSION BLOW OUT!! (river-car (river-cdr (river-filter prime? (river-enumerate-interval 10000 1000000)))) ||# ;
Raw
Annotate
Repaste
Edit