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 s)
42 665c255d 2023-08-04 jrmu   (if (stream-null? s)
43 665c255d 2023-08-04 jrmu       the-empty-stream
44 665c255d 2023-08-04 jrmu       (cons-stream (proc (stream-car s))
45 665c255d 2023-08-04 jrmu 		   (stream-map proc (stream-cdr s)))))
46 665c255d 2023-08-04 jrmu (define (stream-for-each proc s)
47 665c255d 2023-08-04 jrmu   (if (stream-null? s)
48 665c255d 2023-08-04 jrmu       'done
49 665c255d 2023-08-04 jrmu       (begin (proc (stream-car s))
50 665c255d 2023-08-04 jrmu 	     (stream-for-each proc (stream-cdr s)))))
51 665c255d 2023-08-04 jrmu 
52 665c255d 2023-08-04 jrmu (define (display-stream s)
53 665c255d 2023-08-04 jrmu   (stream-for-each display-line s))
54 665c255d 2023-08-04 jrmu (define (display-line x)
55 665c255d 2023-08-04 jrmu   (newline)
56 665c255d 2023-08-04 jrmu   (display x))
57 665c255d 2023-08-04 jrmu 
58 665c255d 2023-08-04 jrmu (define (test-case actual expected)
59 665c255d 2023-08-04 jrmu   (newline)
60 665c255d 2023-08-04 jrmu   (display "Actual:   ")
61 665c255d 2023-08-04 jrmu   (display actual)
62 665c255d 2023-08-04 jrmu   (newline)
63 665c255d 2023-08-04 jrmu   (display "Expected: ")
64 665c255d 2023-08-04 jrmu   (display expected)
65 665c255d 2023-08-04 jrmu   (newline))
66 665c255d 2023-08-04 jrmu 
67 665c255d 2023-08-04 jrmu ;; Exercise 3.50.  Complete the following definition, which generalizes stream-map to allow procedures that take multiple arguments, analogous to map in section 2.2.3, footnote 12.
68 665c255d 2023-08-04 jrmu 
69 665c255d 2023-08-04 jrmu (define (stream-map proc . argstreams)
70 665c255d 2023-08-04 jrmu   (if (stream-null? (car argstreams))
71 665c255d 2023-08-04 jrmu       the-empty-stream
72 665c255d 2023-08-04 jrmu       (cons-stream
73 665c255d 2023-08-04 jrmu        (apply proc (map stream-car argstreams))
74 665c255d 2023-08-04 jrmu        (apply stream-map
75 665c255d 2023-08-04 jrmu               (cons proc (map stream-cdr argstreams))))))
76 665c255d 2023-08-04 jrmu 
77 665c255d 2023-08-04 jrmu (define integers (integers-starting-from 1))
78 665c255d 2023-08-04 jrmu (test-case (stream-car (stream-cdr (stream-cdr (stream-cdr (stream-map * integers integers))))) 16)