1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
| ;Unevaluated promises will have the structure ('delayed val1 val2)
;Evaluated promises will have the structure ('forced result)
;Create an unevaluated promise
(define (multiply-delay x y)
(list 'delayed x y))
;Checks promises (and values) to see if they contain any zeros
(define (has-zero promise)
(if (pair? promise)
(if (eq? (car promise) 'forced)
;check forced value
(if (eqv? (cdr promise) 0)
#t
#f)
;check unforced value
(if (or (has-zero (cadr promise)) (has-zero (caddr promise)))
#t
#f))
;Check scalar value
(if (eqv? promise 0)
#t
#f)))
;Attempts zero optimization, then defaults to regular delay/force behavior
(define (multiply-force promise)
(if (eq? (car promise) 'forced)
;if we've already been forced, return the value
(cdr promise)
;otherwise, search for a zero
(if (has-zero promise)
(begin
(set-car! promise 'forced)
(set-cdr! promise 0)
0)
(multiply-force-nonzero promise))))
;This is for promises which are known to be free of zeros
(define (multiply-force-nozero promise)
(if (pair? promise)
(if (eq? (car promise) 'forced)
;if the promise has been forced, just return the value
(cdr promise)
;otherwise, compute the value, and convert this into a "forced" promise
(begin
(set-car! promise 'forced)
(set-cdr! promise
(*
(multiply-force-nonzero (cadr promise))
(multiply-force-nonzero (caddr promise))))
;return the forced value
(cdr promise)))
;This is just a number, so return it
promise))
|