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