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 ;; Exercise 3.55.  Define a procedure partial-sums that takes as argument a stream S and returns the stream whose elements are S0, S0 + S1, S0 + S1 + S2, .... For example, (partial-sums integers) should be the stream 1, 3, 6, 10, 15, .... 
139 
140 
141 (define (partial-sums s)
142   (define sums
143     (cons-stream (stream-car s)
144 		 (add-streams sums
145 			      (stream-cdr s))))
146   sums)
147 
148 (test-case (stream-ref (partial-sums integers) 19) 210)