Example code of SRFI 42 (eager comprehension) / 先行評価的内包表記のプログラム例

comprehension-example.scm

(cond-expand
  (guile (use-modules (srfi srfi-42)))
  (gauche (use srfi-42))
  (racket (require srfi/42))
  (plt (require (lib "42.ss" "srfi")))
  (srfi-42 #t))

(list-ec (: k 10) k)               ; 0 から始まり，10 の直前まで
(list-ec (: k 10) (* k k))         ; 0 から始まり，10 の直前まで k の 2乗
(list-ec (: k 1 10) k)             ; 1 から始まり，10 の直前まで
(list-ec (: k 1 10 2) k)           ; 1 から始まり，2ずつ増加し 10 の直前まで
(list-ec (: k 10 0 -1) k)          ; 10 から始まり，1ずつ減少し 0 の直前まで

(list-ec (: i 1 10) (: j 1 10) (* i j))   ; 9x9 の表
(list-ec (: d 2 10) (: n 1 d) (cons n d)) ; 真分数（約分可能なものを含む）
(list-ec (: d 2 10) (: n 1 d)
	 (if (= (gcd d n) 1))
	 (cons n d))			; 既約真分数


(list-ec (: k '(1 2 3 4 5)) k)		; same as (list-ec (: k 1 6) k)
(list-ec (:parallel (: x '(a b c))	; zip (or pairlis)
		    (: n '(1 2 3)))
	 (cons x n))			; ((a . 1) (b . 2) (c . 3))

(list-ec (: c "string->list") c)	; same as string->list
(string-ec (: c '(#\l #\i #\s #\t)) c)	; same as list->string
(vector-ec (: k '(1 2 3 4 5)) k)	; same as list->vector
;; append-ec                            ; like as mapcan
;; string-append-ec                     ; like as string-mapcan
;; do-ec                                ; like as for-each (or mapc)

(sum-ec (: k 1 10 2) k)			; 1 + 3 + 5 + 7 + 9 = 5^2
(product-ec (: k 1 10) k)		; 1 * 2 * ... * 9 = 9!
(max-ec (: k '(3 1 4 1 5 9)) k)		; (max 3 1 4 1 5 9) => 9
(min-ec (: k '(3 1 4 1 5 9)) k)		; (min 3 1 4 1 5 9) => 1

(every?-ec (: k '(1 3 5 7 9)) (odd? k)) ; (every odd? '(1 3 5 7 9))
(any?-ec (: k '(1 3 5 7 10)) (even? k))	; (any even? '(1 3 5 7 10))

(fold-ec 0 (: k 10) k +)		; (+ 0 1 2 3 ... 9) => 45
(fold-ec '() (: k 10) k cons)		; => (9 8 7 ... 0)

(list-ec (:parallel (: x '(a b c))
		    (:integers n))	; indexing
	 (cons x n))			; => ((a . 0) (b . 1) (c . 2))

(first-ec #f				; same as index
	  (:parallel (: c "happy")
		     (:integers n))
	  (if (eqv? c #\p))
	  n)				; => 2

(last-ec  #f				; same as last-index
	  (:parallel (: c "happy")
		     (:integers n))
	  (if (eqv? c #\p))
	  n)				; => 3

(fold3-ec #f				; all of the indices
	  (:parallel (: c "happy")	; but they are reverse ordered.
		     (:integers n))
	  (if (evq? c #\p))
	  n
	  list
	  cons)

;;;
;;; on the number theory
;;;

(define (divisors n)
  (list-ec (: k 1 n)
	   (if (zero? (modulo n k)))
	   k))

(define (perfect? n)
  (= (sum-ec (: k 1 n)
	     (if (zero? (modulo n k)))
	     k)
     n))

(define (coprimes n)
  (list-ec (: k 1 n)
	   (if (= 1 (gcd k n)))
	   k))

;; find pythagorean numbers
(list-ec (: c 5 100)
	 (: b 3 c)
	 (: a 3 b)
	 (if (= (+ (* a a)
		   (* b b))
		(* c c)))
	 (list a b c))

(list-ec (: c 5 100)
	 (: b 3 c)
	 (: a 3 b)
	 (if (= (+ (* a a)
		   (* b b))
		(* c c)))
	 (if (= (gcd a b c) 1))
	 (list a b c))

(let* ([limit 100]
       [p (sqrt limit)])
  (list-ec (: m 2 (+ 1 p) 2)
	   (: n 1 p 2)
	   (if (< (+ (* m m) (* n n)) limit))
	   (list (abs (- (* m m) (* n n)))
		 (* 2 m n)
		 (+ (* m m) (* n n)))))