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)))))
9 
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))))))
17 
18 (define (myforce delayed-object)
19   (delayed-object))
20 
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))))))
26 
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 '())
33 
34 (define (integers-starting-from n)
35   (cons-stream n (integers-starting-from (+ n 1))))
36 
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)))))
52 
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))))))
66 
67 (define (display-stream s)
68   (stream-for-each display-line s))
69 (define (display-line x)
70   (newline)
71   (display x))
72 
73 (define (test-case actual expected)
74   (newline)
75   (display "Actual:   ")
76   (display actual)
77   (newline)
78   (display "Expected: ")
79   (display expected)
80   (newline))
81 
82 (define (integers-starting-from n)
83   (cons-stream n (integers-starting-from (+ n 1))))
84 (define integers (integers-starting-from 1))
85 
86 (define (divisible? x y) (= (remainder x y) 0))
87 (define no-sevens
88   (stream-filter (lambda (x) (not (divisible? x 7))) 
89 		 integers))
90 
91 (define (fibgen a b)
92   (cons-stream a (fibgen b (+ a b))))
93 (define fibs (fibgen 0 1))
94 
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)))))
102 
103 ;; (define primes (sieve (integers-starting-from 2)))
104 ;; (test-case (stream-ref primes 25) 101)
105 
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)
111 
112 (define fibs
113   (cons-stream 0
114 	       (cons-stream 1
115 			    (add-streams (stream-cdr fibs)
116 					 fibs))))
117 
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)))
123 
124 (define primes
125   (cons-stream 
126    2
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))
134 
135 (define (mul-streams s1 s2)
136   (stream-map * s1 s2))
137 
138 (define (partial-sums s)
139   (define sums
140     (cons-stream (stream-car s)
141 		 (add-streams sums
142 			      (stream-cdr s))))
143   sums)
144 
145 ;;  Exercise 3.56.  A famous problem, first raised by R. Hamming, is to enumerate, in ascending order with no repetitions, all positive integers with no prime factors other than 2, 3, or 5. One obvious way to do this is to simply test each integer in turn to see whether it has any factors other than 2, 3, and 5. But this is very inefficient, since, as the integers get larger, fewer and fewer of them fit the requirement. As an alternative, let us call the required stream of numbers S and notice the following facts about it.
146 
147 ;;     S begins with 1.
148 
149 ;;     The elements of (scale-stream S 2) are also elements of S.
150 
151 ;;     The same is true for (scale-stream S 3) and (scale-stream 5 S).
152 
153 ;;     These are all the elements of S. 
154 
155 ;; Now all we have to do is combine elements from these sources. For this we define a procedure merge that combines two ordered streams into one ordered result stream, eliminating repetitions:
156 
157 (define (merge s1 s2)
158   (cond ((stream-null? s1) s2)
159 	((stream-null? s2) s1)
160 	(else
161 	 (let ((s1car (stream-car s1))
162 	       (s2car (stream-car s2)))
163 	   (cond ((< s1car s2car) 
164 		  (cons-stream 
165 		   s1car
166 		   (merge (stream-cdr s1) s2)))
167 		 ((> s1car s2car) 
168 		  (cons-stream
169 		   s2car
170 		   (merge s1 (stream-cdr s2))))
171 		 (else 
172 		  (cons-stream 
173 		   s1car
174 		   (merge (stream-cdr s1) (stream-cdr s2)))))))))
175 
176 ;; (define S (cons-stream 1 (merge <??> <??>)))
177 
178 ;; Fill in the missing expressions in the places marked <??> above. 
179 
180 (define S
181   (cons-stream 
182    1
183    (merge (scale-stream S 2)
184 	  (merge (scale-stream S 3)
185 		 (scale-stream S 5)))))
186 
187 (define (test-stream-list stream list)
188   (if (null? list)
189       'done
190       (begin (display "A: ")
191 	     (display (stream-car stream))
192 	     (display "  --  ")
193 	     (display "E: ")
194 	     (display (car list))
195 	     (newline)
196 	     (test-stream-list (stream-cdr stream) (cdr list)))))
197 
198 (test-stream-list S '(1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30))
199 	       
200