より 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
いまだにどう書くのがいいのかわからない。
