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.53.  Without running the program, describe the elements of the stream defined by
138 665c255d 2023-08-04 jrmu 
139 665c255d 2023-08-04 jrmu (define s (cons-stream 1 (add-streams s s))))
140 665c255d 2023-08-04 jrmu 
141 665c255d 2023-08-04 jrmu ;; the powers of 2, just like double