SICP 3.5 ストリーム

stream.scm

(define (1+ n)
  (+ 1 n))

(define (1- n)
  (- n 1))

(define (bfind/l pred lower upper)
  (letrec ((M (lambda (low high)
                (if (even? (- high low))
                  (/ (+ high low) 2)
                  (/ (+ high low -1) 2)))))
    (cond
      ((= upper (+ 1 lower))  upper)
      ((pred (M lower upper)) (bfind/l pred lower (M lower upper)))
      (else                   (bfind/l pred (M lower upper) upper)))))

(define (nsqrt n)
  (bfind/l (lambda (x) (<= n (* x x))) 1 n))

(define (exists? pred init end next)
  (cond
    ((= init end) (pred init))
    ((pred init) init)
    (else (exists? pred (next init) end next))))

(define (prime? n)
  (cond
    ((>= 1 n) #f)
    (else (not (exists? (lambda (x) (and (zero? (modulo n x))
                                         (not (= n x))))
                        2 
                        (nsqrt n) 
                        (cut + 1 <>))))))

(define (frce delayed)
  (delayed))

(define (memo-proc proc)
  (let ((already-run? #f)
        (result #f))
    (lambda ()
      (if (not already-run?)
        (begin (set! result (proc))
               (set! already-run? #t)
               result)
        result))))

(define-syntax dlay
  (syntax-rules ()
    [(_ expr ...) (memo-proc (lambda () expr ...))]))

(define st/nil '())
(define st/null? null?)

(define-syntax st/cons
  (syntax-rules ()
    [(_ x y) (cons x (dlay y))]))

(define (st/car stream)
  (car stream))

(define (st/cdr stream)
  (frce (cdr stream)))

(define (st/ref s n)
  (if (zero? n)
    (st/car s)
    (st/ref (st/cdr s) (- n 1))))

(define (any? pred l)
  (cond
    ((null? l) #f)
    ((pred (car l)) (car l))
    (else (any? pred (cdr l)))))

(define (st/map proc . streams)
  (if (any? st/null? streams)
    st/nil
    (st/cons (apply proc (map st/car streams))
             (st/map proc (map cdr args)))))

(define (st/for-each proc s)
  (if (st/null? s)
    'done
    (begin (proc (st/car s))
           (st/for-each proc (st/cdr s)))))

(define (st/display s)
  (let ((D (lambda (x)
             (newline)
             (display x))))
    (st/for-each D s)))

(define (st/filter pred s)
  (cond
    ((st/null? s) st/nil)
    ((pred (st/car s)) (st/cons (st/car s) 
                                (st/filter pred (st/cdr s))))
    (else (st/filter pred (st/cdr s)))))

(define (interval low high)
  (iota (+ 1 (- high low)) low))

(define (st/interval low high)
  (if (> low high)
    st/nil
    (st/cons
      low
      (st/interval (+ low 1) high))))

(define (show x)
  (print x)
  x)

(define (integers-from n)
  (st/cons n (integers-from (1+ n))))

(define integers (integers-from 1))

(define (st/take n stream)
  (if (zero? n)
    '()
    (cons (st/car stream) (st/take (1- n) (st/cdr stream)))))

(define fibs
  (letrec ((fibgen (lambda (a b)
                     (st/cons a (fibgen b (+ a b))))))
    (fibgen 0 1)))

(define (divisible? a b)
  (zero? (modulo a b)))

(define (sieve stream)
  (let ((p (st/car stream)))
    (st/cons p
             (sieve (st/filter
                      (lambda (x) (not (divisible? x p)))
                      (st/cdr stream))))))

(define primenumbers (sieve (integers-from 2)))