4 (define (celsius-fahrenheit-converter c f)
5 (let ((u (make-connector))
18 (define (adder a1 a2 sum)
19 (define (process-new-value)
20 (cond ((and (has-value? a1) (has-value? a2))
22 (+ (get-value a1) (get-value a2))
24 ((and (has-value? a1) (has-value? sum))
26 (- (get-value sum) (get-value a1))
28 ((and (has-value? a2) (has-value? sum))
30 (- (get-value sum) (get-value a2))
32 (define (process-forget-value)
33 (forget-value! sum me)
38 (cond ((eq? request 'I-have-a-value)
40 ((eq? request 'I-lost-my-value)
41 (process-forget-value))
43 (error "Unknown request -- ADDER" request))))
49 (define (multiplier m1 m2 product)
50 (define (process-new-value)
51 (cond ((or (and (has-value? m1) (= (get-value m1) 0))
52 (and (has-value? m2) (= (get-value m2) 0)))
53 (set-value! product 0 me))
54 ((and (has-value? m1) (has-value? m2))
56 (* (get-value m1) (get-value m2))
58 ((and (has-value? product) (has-value? m1))
60 (/ (get-value product) (get-value m1))
62 ((and (has-value? product) (has-value? m2))
64 (/ (get-value product) (get-value m2))
66 (define (process-forget-value)
67 (forget-value! product me)
72 (cond ((eq? request 'I-have-a-value)
74 ((eq? request 'I-lost-my-value)
75 (process-forget-value))
77 (error "Unknown request -- MULTIPLIER" request))))
83 (define (constant value connector)
85 (error "Unknown request -- CONSTANT" request))
86 (connect connector me)
87 (set-value! connector value me)
90 (define (probe name connector)
91 (define (print-probe value)
97 (define (process-new-value)
98 (print-probe (get-value connector)))
99 (define (process-forget-value)
102 (cond ((eq? request 'I-have-a-value)
104 ((eq? request 'I-lost-my-value)
105 (process-forget-value))
107 (error "Unknown request -- PROBE" request))))
108 (connect connector me)
111 (define (inform-about-value constraint)
112 (constraint 'I-have-a-value))
113 (define (inform-about-no-value constraint)
114 (constraint 'I-lost-my-value))
116 (define (make-connector)
117 (let ((value false) (informant #f) (constraints '()))
118 (define (set-my-value newval setter)
119 (cond ((not (has-value? me))
121 (set! informant setter)
122 (for-each-except setter
125 ((not (= value newval))
126 (error "Contradiction" (list value newval)))
128 (define (forget-my-value retractor)
129 (if (eq? retractor informant)
130 (begin (set! informant false)
131 (for-each-except retractor
132 inform-about-no-value
135 (define (connect new-constraint)
136 (when (not (memq new-constraint constraints))
138 (cons new-constraint constraints)))
139 (when (has-value? me)
140 (inform-about-value new-constraint))
143 (cond ((eq? request 'has-value?)
144 (if informant #t #f))
145 ((eq? request 'value) value)
146 ((eq? request 'set-value!) set-my-value)
147 ((eq? request 'forget) forget-my-value)
148 ((eq? request 'connect) connect)
149 (else (error "Unknown operation -- CONNECTOR"
153 (define (for-each-except exception procedure list)
155 (cond ((null? items) 'done)
156 ((eq? (car items) exception) (loop (cdr items)))
157 (else (procedure (car items))
158 (loop (cdr items)))))
161 (define (has-value? connector)
162 (connector 'has-value?))
163 (define (get-value connector)
165 (define (set-value! connector new-value informant)
166 ((connector 'set-value!) new-value informant))
167 (define (forget-value! connector retractor)
168 ((connector 'forget) retractor))
169 (define (connect connector new-constraint)
170 ((connector 'connect) new-constraint))
173 ;; celcius to fahrenheit and vice-versa conv
174 (define C (make-connector))
175 (define F (make-connector))
176 (celsius-fahrenheit-converter C F)
177 (probe "Celsius temp" C)
178 (probe "Fahrenheit temp" F)