より CLtL2 Appendix A らしい素数列

• よりClojureらしい素数列 - OGINO Masanori@はてな
• Island Life - 「よりClojureらしい素数列」をGaucheで
• 「よりClojureらしい素数列」をSqueak Smalltalkで―のつもりがあらぬ方向へ - Smalltalkのtは小文字です

(series::install :implicit-map t)

(defun prime-p (x)
  (not (collect-or (zerop (rem x (scan-range :from 2 :below (1+ (/ x 2))))))))

(defun scan-prime-numbers ()
  (declare (optimizable-series-function))
  (producing (z) ((n 1))
    (loop
      (tagbody
         start
         (setq n (1+ n))
         (unless (prime-p n)
           (go start))
         (next-out z n)))))

(collect (until-if (lambda (x) (< 100 x))
                   (scan-prime-numbers)))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)


(collect (until-if (lambda (x) (< 100 x))
                   (choose-if #'prime-p (scan-range :from 2))))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)


(defun |scan-prime-numbers'| ()
  (declare (optimizable-series-function))
  (choose-if #'prime-p (scan-range :from 2)))

(collect (until-if (lambda (x) (< 100 x))
                   (|scan-prime-numbers'|)))
;;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

それぞれマクロ展開すると

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                   (scan-prime-numbers))))
;;=> (COMMON-LISP:LET* ((#:N-1316 1)
;;                      #:Z-1317
;;                      (#:LASTCONS-1312 (LIST NIL))
;;                      (#:LST-1313 #:LASTCONS-1312))
;;     (DECLARE (TYPE CONS #:LASTCONS-1312)
;;              (TYPE LIST #:LST-1313))
;;     (TAGBODY
;;      #:LL-1318
;;       (SETQ #:N-1316 (1+ #:N-1316))
;;       (IF (PRIME-P #:N-1316)
;;           NIL
;;           (PROGN (GO #:LL-1318)))
;;       (SETQ #:Z-1317 #:N-1316)
;;       (IF ((LAMBDA (X) (< 100 X)) #:Z-1317)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1312 (SETF (CDR #:LASTCONS-1312) (CONS #:Z-1317 NIL)))
;;       (GO #:LL-1318)
;;      SERIES::END)
;;     (CDR #:LST-1313))
;;   T

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                   (choose-if #'prime-p (scan-range :from 2)))))
;;=> (COMMON-LISP:LET* ((#:NUMBERS-1328 (SERIES::COERCE-MAYBE-FOLD (- 2 1) 'NUMBER))
;;                      (#:LASTCONS-1320 (LIST NIL))
;;                      (#:LST-1321 #:LASTCONS-1320))
;;     (DECLARE (TYPE NUMBER #:NUMBERS-1328)
;;              (TYPE CONS #:LASTCONS-1320)
;;              (TYPE LIST #:LST-1321))
;;     (TAGBODY
;;      #:LL-1331
;;       (SETQ #:NUMBERS-1328
;;               (+ #:NUMBERS-1328 (SERIES::COERCE-MAYBE-FOLD 1 'NUMBER)))
;;       (IF (NOT (PRIME-P #:NUMBERS-1328))
;;           (GO #:LL-1331))
;;       (IF ((LAMBDA (X) (< 100 X)) #:NUMBERS-1328)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1320
;;               (SETF (CDR #:LASTCONS-1320) (CONS #:NUMBERS-1328 NIL)))
;;       (GO #:LL-1331)
;;      SERIES::END)
;;     (CDR #:LST-1321))
;;   T

(macroexpand '(collect (until-if (lambda (x) (< 100 x))
                        (|scan-prime-numbers'|))))
;;=> (COMMON-LISP:LET* ((#:NUMBERS-1337 (SERIES::COERCE-MAYBE-FOLD (- 2 1) 'NUMBER))
;;                      (#:LASTCONS-1333 (LIST NIL))
;;                      (#:LST-1334 #:LASTCONS-1333))
;;     (DECLARE (TYPE NUMBER #:NUMBERS-1337)
;;              (TYPE CONS #:LASTCONS-1333)
;;              (TYPE LIST #:LST-1334))
;;     (TAGBODY
;;      #:LL-1338
;;       (SETQ #:NUMBERS-1337
;;               (+ #:NUMBERS-1337 (SERIES::COERCE-MAYBE-FOLD 1 'NUMBER)))
;;       (IF (NOT (PRIME-P #:NUMBERS-1337))
;;           (GO #:LL-1338))
;;       (IF ((LAMBDA (X) (< 100 X)) #:NUMBERS-1337)
;;           (GO SERIES::END))
;;       (SETQ #:LASTCONS-1333
;;               (SETF (CDR #:LASTCONS-1333) (CONS #:NUMBERS-1337 NIL)))
;;       (GO #:LL-1338)
;;      SERIES::END)
;;     (CDR #:LST-1334))
;;   T

いまだにどう書くのがいいのかわからない。