src/sicp/streams.rkt

   1 #lang planet neil/sicp
   2
   3 (define (stream-car s) (car s))
   4 (define (stream-cdr s) (force (cdr s)))
   5
   6 (define (stream-ref s n)
   7   (if (= n 0)
   8       (stream-car s)
   9       (stream-ref (stream-cdr s)
  10                   (- n 1))))
  11
  12 (define (stream-map proc s)
  13   (if (stream-null? s)
  14       the-empty-stream
  15       (cons-stream (proc (stream-car s))
  16                    (stream-map proc (stream-cdr s)))))
  17
  18 (define (stream-filter pred? s)
  19   (cond [(stream-null? s) the-empty-stream]
  20         [(pred? (stream-car s))
  21          (cons-stream (stream-car s)
  22                       (stream-filter pred? (stream-cdr s)))]
  23         [else (stream-filter pred? (stream-cdr s))]))
  24
  25 (define (stream-for-each proc s)
  26   (if (stream-null? s)
  27       'done
  28       (begin
  29         (proc (stream-car s))
  30         (stream-for-each proc (stream-cdr s)))))
  31
  32 (define (display-stream s)
  33   (stream-for-each display-line s))
  34
  35 (define (display-line x)
  36   (newline)
  37   (display x))
  38
  39 ;; stream-enumerate-interval
  40 (define (stream-enumerate-interval low high)
  41   (if (> low high)
  42       the-empty-stream
  43       (cons-stream low
  44                    (stream-enumerate-interval (+ low 1)
  45                                               high))))
  46
  47
  48 ;; prime?
  49 (define (square x) (* x x))
  50 (define (smallest-divisor n)
  51   (find-divisor n 2))
  52 (define (find-divisor n test-divisor)
  53   (cond ((> (square test-divisor) n) n)
  54         ((divides? test-divisor n) test-divisor)
  55         (else (find-divisor n (+ test-divisor 1)))))
  56 (define (divides? a b)
  57   (= (remainder b a) 0))
  58
  59 (define (prime? n)
  60   (= (smallest-divisor n) n))
  61