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 ;; (test-case (stream-ref primes 26) 103
136 
137 ;; Exercise 3.54.  Define a procedure mul-streams, analogous to add-streams, that produces the elementwise product of its two input streams. Use this together with the stream of integers to complete the following definition of the stream whose nth element (counting from 0) is n + 1 factorial:
138 
139 (define (mul-streams s1 s2)
140   (stream-map * s1 s2))
141 
142 (define factorials (cons-stream 1 (mul-streams factorials (stream-cdr integers))))
143 
144 (test-case (stream-ref factorials 9) 3628800)