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 (define (merge s1 s2)
146   (cond ((stream-null? s1) s2)
147 	((stream-null? s2) s1)
148 	(else
149 	 (let ((s1car (stream-car s1))
150 	       (s2car (stream-car s2)))
151 	   (cond ((< s1car s2car) 
152 		  (cons-stream 
153 		   s1car
154 		   (merge (stream-cdr s1) s2)))
155 		 ((> s1car s2car) 
156 		  (cons-stream
157 		   s2car
158 		   (merge s1 (stream-cdr s2))))
159 		 (else 
160 		  (cons-stream 
161 		   s1car
162 		   (merge (stream-cdr s1) (stream-cdr s2)))))))))
163 
164 (define (test-stream-list stream list)
165   (if (null? list)
166       'done
167       (begin (display "A: ")
168 	     (display (stream-car stream))
169 	     (display "  --  ")
170 	     (display "E: ")
171 	     (display (car list))
172 	     (newline)
173 	     (test-stream-list (stream-cdr stream) (cdr list)))))
174 
175  ;; Exercise 3.58.  Give an interpretation of the stream computed by the following procedure:
176 
177 (define (expand num den radix)
178   (cons-stream
179    (quotient (* num radix) den)
180    (expand (remainder (* num radix) den) den radix)))
181 
182 ;; (Quotient is a primitive that returns the integer quotient of two integers.) What are the successive elements produced by (expand 1 7 10) ? What is produced by (expand 3 8 10) ? 
183 
184 ;; num/den expressed as a decimal(? not sure what it's called when not in base 10) in base radix
185 ;; the elements of the stream are the digits
186 
187 (newline)
188 (test-stream-list (expand 1 7 10) '(1 4 2 8 5 7 1 4 2 8))
189 (test-stream-list (expand 3 8 10) '(3 7 5 0 0 0 0))