1 (define (celsius-fahrenheit-converter c f)
2 (let ((u (make-connector))
15 (define (adder a1 a2 sum)
16 (define (process-new-value)
17 (cond ((and (has-value? a1) (has-value? a2))
19 (+ (get-value a1) (get-value a2))
21 ((and (has-value? a1) (has-value? sum))
23 (- (get-value sum) (get-value a1))
25 ((and (has-value? a2) (has-value? sum))
27 (- (get-value sum) (get-value a2))
29 (define (process-forget-value)
30 (forget-value! sum me)
35 (cond ((eq? request 'I-have-a-value)
37 ((eq? request 'I-lost-my-value)
38 (process-forget-value))
40 (error "Unknown request -- ADDER" request))))
46 (define (inform-about-value constraint)
47 (constraint 'I-have-a-value))
48 (define (inform-about-no-value constraint)
49 (constraint 'I-lost-my-value))
51 (define (multiplier m1 m2 product)
52 (define (process-new-value)
53 (cond ((or (and (has-value? m1) (= (get-value m1) 0))
54 (and (has-value? m2) (= (get-value m2) 0)))
55 (set-value! product 0 me))
56 ((and (has-value? m1) (has-value? m2))
58 (* (get-value m1) (get-value m2))
60 ((and (has-value? product) (has-value? m1))
62 (/ (get-value product) (get-value m1))
64 ((and (has-value? product) (has-value? m2))
66 (/ (get-value product) (get-value m2))
68 (define (process-forget-value)
69 (forget-value! product me)
74 (cond ((eq? request 'I-have-a-value)
76 ((eq? request 'I-lost-my-value)
77 (process-forget-value))
79 (error "Unknown request -- MULTIPLIER" request))))
85 (define (constant value connector)
87 (error "Unknown request -- CONSTANT" request))
88 (connect connector me)
89 (set-value! connector value me)
92 (define (probe name connector)
93 (define (print-probe value)
99 (define (process-new-value)
100 (print-probe (get-value connector)))
101 (define (process-forget-value)
104 (cond ((eq? request 'I-have-a-value)
106 ((eq? request 'I-lost-my-value)
107 (process-forget-value))
109 (error "Unknown request -- PROBE" request))))
110 (connect connector me)
113 (define (make-connector)
114 (let ((value false) (informant false) (constraints '()))
115 (define (set-my-value newval setter)
116 (cond ((not (has-value? me))
118 (set! informant setter)
119 (for-each-except setter
122 ((not (= value newval))
123 (error "Contradiction" (list value newval)))
125 (define (forget-my-value retractor)
126 (if (eq? retractor informant)
127 (begin (set! informant false)
128 (for-each-except retractor
129 inform-about-no-value
132 (define (connect new-constraint)
133 (if (not (memq new-constraint constraints))
135 (cons new-constraint constraints)))
137 (inform-about-value new-constraint))
140 (cond ((eq? request 'has-value?)
141 (if informant true false))
142 ((eq? request 'value) value)
143 ((eq? request 'set-value!) set-my-value)
144 ((eq? request 'forget) forget-my-value)
145 ((eq? request 'connect) connect)
146 (else (error "Unknown operation -- CONNECTOR"
150 (define (for-each-except exception procedure list)
152 (cond ((null? items) 'done)
153 ((eq? (car items) exception) (loop (cdr items)))
154 (else (procedure (car items))
155 (loop (cdr items)))))
158 (define (has-value? connector)
159 (connector 'has-value?))
160 (define (get-value connector)
162 (define (set-value! connector new-value informant)
163 ((connector 'set-value!) new-value informant))
164 (define (forget-value! connector retractor)
165 ((connector 'forget) retractor))
166 (define (connect connector new-constraint)
167 ((connector 'connect) new-constraint))
169 (define (test-case actual expected)
174 (display "Expected: ")
178 (define (averager a b c)
179 (let ((sum (make-connector))
180 (two (make-connector)))
183 (multiplier two c sum)))
185 ;; Exercise 3.34. Louis Reasoner wants to build a squarer, a constraint device with two terminals such that the value of connector b on the second terminal will always be the square of the value a on the first terminal. He proposes the following simple device made from a multiplier:
187 (define (squarer a b)
190 ;; There is a serious flaw in this idea. Explain.
192 ;; This constraint only works in one direction. If a has a value, then the value is propagated to b. But, if b has a value, the value is not propagated to a because a multiplier normally needs to know one product plus one factor in orer to figure out the value of the second factor. The problem is that the multiplier is unaware that the two factors are referring to the same connector.