Blob


1 (define (memo-proc proc)
2 (let ((already-run? false) (result false))
3 (lambda ()
4 (if already-run?
5 result
6 (begin (set! already-run? true)
7 (set! result (proc))
8 result)))))
10 (define-syntax mydelay
11 (rsc-macro-transformer
12 (let ((xfmr
13 (lambda (exp)
14 `(memo-proc (lambda () ,exp)))))
15 (lambda (e r)
16 (apply xfmr (cdr e))))))
18 (define (myforce delayed-object)
19 (delayed-object))
21 (define-syntax cons-stream
22 (rsc-macro-transformer
23 (let ((xfmr (lambda (x y) `(cons ,x (mydelay ,y)))))
24 (lambda (e r)
25 (apply xfmr (cdr e))))))
27 (define (stream-car s)
28 (car s))
29 (define (stream-cdr s)
30 (myforce (cdr s)))
31 (define stream-null? null?)
32 (define the-empty-stream '())
34 (define (integers-starting-from n)
35 (cons-stream n (integers-starting-from (+ n 1))))
37 (define (stream-ref s n)
38 (if (= n 0)
39 (stream-car s)
40 (stream-ref (stream-cdr s) (- n 1))))
41 (define (stream-map proc . argstreams)
42 (if (stream-null? (car argstreams))
43 the-empty-stream
44 (cons-stream
45 (apply proc (map stream-car argstreams))
46 (apply stream-map (cons proc (map stream-cdr argstreams))))))
47 (define (stream-for-each proc s)
48 (if (stream-null? s)
49 'done
50 (begin (proc (stream-car s))
51 (stream-for-each proc (stream-cdr s)))))
53 (define (stream-enumerate-interval low high)
54 (if (> low high)
55 the-empty-stream
56 (cons-stream
57 low
58 (stream-enumerate-interval (+ low 1) high))))
59 (define (stream-filter pred s)
60 (if (stream-null? s)
61 the-empty-stream
62 (let ((scar (stream-car s)))
63 (if (pred scar)
64 (cons-stream scar (stream-filter pred (stream-cdr s)))
65 (stream-filter pred (stream-cdr s))))))
67 (define (display-stream s)
68 (stream-for-each display-line s))
69 (define (display-line x)
70 (newline)
71 (display x))
73 (define (test-case actual expected)
74 (newline)
75 (display "Actual: ")
76 (display actual)
77 (newline)
78 (display "Expected: ")
79 (display expected)
80 (newline))
82 (define (integers-starting-from n)
83 (cons-stream n (integers-starting-from (+ n 1))))
84 (define integers (integers-starting-from 1))
86 (define (divisible? x y) (= (remainder x y) 0))
87 (define no-sevens
88 (stream-filter (lambda (x) (not (divisible? x 7)))
89 integers))
91 (define (fibgen a b)
92 (cons-stream a (fibgen b (+ a b))))
93 (define fibs (fibgen 0 1))
95 (define (sieve s)
96 (cons-stream
97 (stream-car s)
98 (sieve (stream-filter
99 (lambda (x)
100 (not (divisible? x (stream-car s))))
101 (stream-cdr s)))))
103 ;; (define primes (sieve (integers-starting-from 2)))
104 ;; (test-case (stream-ref primes 25) 101)
106 (define ones (cons-stream 1 ones))
107 (define (add-streams s1 s2)
108 (stream-map + s1 s2))
109 (define integers (cons-stream 1 (add-streams ones integers)))
110 ;; (test-case (stream-ref integers 15) 16)
112 (define fibs
113 (cons-stream 0
114 (cons-stream 1
115 (add-streams (stream-cdr fibs)
116 fibs))))
118 (define (scale-stream stream factor)
119 (stream-map (lambda (x)
120 (* x factor))
121 stream))
122 (define double (cons-stream 1 (scale-stream double 2)))
124 (define primes
125 (cons-stream
127 (stream-filter prime? (integers-starting-from 3))))
128 (define (prime? n)
129 (define (iter ps)
130 (cond ((> (square (stream-car ps)) n) true)
131 ((divisible? n (stream-car ps)) false)
132 (else (iter (stream-cdr ps)))))
133 (iter primes))
135 ;; (test-case (stream-ref primes 26) 103
137 ;; Exercise 3.53. Without running the program, describe the elements of the stream defined by
139 (define s (cons-stream 1 (add-streams s s))))
141 ;; the powers of 2, just like double