# weima learns to program

my attempt to do the exercises in sicp.

## Monday, March 15, 2010

### sicp exercise 3.35

;; Exercise 3.35.  Ben Bitdiddle tells Louis that one way to avoid the trouble in exercise 3.34 is to define a squarer as a new primitive constraint. Fill in the missing portions in Ben's outline for a procedure to implement such a constraint:

;; (define (squarer a b)
;;   (define (process-new-value)
;;     (if (has-value? b)
;;         (if (< (get-value b) 0)
;;             (error "square less than 0 -- SQUARER" (get-value b))
;;             <alternative1>)
;;         <alternative2>))
;;   (define (process-forget-value) <body1>)
;;   (define (me request) <body2>)
;;   <rest of definition>
;;   me)

(define false #f)
(define true  #t)

(constraint 'I-have-a-value))
(constraint 'I-lost-my-value))

(define (constant value connector)
(define (me request)
(error "Unknown request -- CONSTANT" request))
(connect connector me)
(set-value! connector value me)
me)

(define (probe name connector)
(define (print-probe value)
(display "Probe: ")
(display name)
(display " = ")
(display value)
(newline))
(define (process-new-value)
(print-probe (get-value connector)))
(define (process-forget-value)
(print-probe "?"))
(define (me request)
(cond ((eq? request 'I-have-a-value)
(process-new-value))
((eq? request 'I-lost-my-value)
(process-forget-value))
(else
(error "Unknown request -- PROBE" request))))
(connect connector me)
me)

(define (make-connector)
(let ((value false) (informant false) (constraints '()))
(define (set-my-value newval setter)
(cond ((not (has-value? me))
(set! value newval)
(set! informant setter)
(for-each-except setter
constraints))
((not (= value newval))
(else 'ignored)))
(define (forget-my-value retractor)
(if (eq? retractor informant)
(begin (set! informant false)
(for-each-except retractor
constraints))
'ignored))
(define (connect new-constraint)
(if (not (memq new-constraint constraints))
(set! constraints
(cons new-constraint constraints)))
(if (has-value? me)
'done)
(define (me request)
(cond ((eq? request 'has-value?)
(if informant true false))
((eq? request 'value) value)
((eq? request 'set-value!) set-my-value)
((eq? request 'forget) forget-my-value)
((eq? request 'connect) connect)
(else (error "Unknown operation -- CONNECTOR"
request))))
me))

(define (for-each-except exception procedure list)
(define (loop items)
(cond ((null? items) 'done)
((eq? (car items) exception) (loop (cdr items)))
(else (procedure (car items))
(loop (cdr items)))))
(loop list))

(define (has-value? connector)
(connector 'has-value?))
(define (get-value connector)
(connector 'value))
(define (set-value! connector new-value informant)
((connector 'set-value!) new-value informant))
(define (forget-value! connector retractor)
((connector 'forget) retractor))
(define (connect connector new-constraint)
((connector 'connect) new-constraint))

;;--------------------------------------------------

;; here we must use exercise 1.7 to find square roots
(define (sqrt-iter guess x)
(if (good-enough? guess x)
guess
(sqrt-iter (improve guess x)
x)))

(define (improve guess x)
(average guess (/ x guess)))

(define (average x y)
(/ (+ x y) 2))

(define (square x) (* x x))

(define (good-enough? guess x)
(< (/ (abs (- (square guess) x)) x) 0.00001))

(define (sqrt x)
(sqrt-iter 1.0 x))

;;--------------------------------------------------

(define (squarer a b)
(define (process-new-value)
(cond ((has-value? b)
(if (< (get-value b) 0)
(error "square less than 0 -- SQUARER" (get-value b))
(set-value! a (sqrt (get-value b)) me)))
((has-value? a)
(set-value! b (square (get-value a)) me))))
(define (process-forget-value)
(forget-value! a me)
(forget-value! b me)
(process-new-value))
(define (me request)
(cond ((eq? request 'I-have-a-value)
(process-new-value))
((eq? request 'I-lost-my-value)
(process-forget-value))
(else
(error "Unknown request -- SQUARER" request))))
(connect a me)
(connect b me)
me)

(define a (make-connector))
(define b (make-connector))

(probe "A" a)
(probe "B" b)

(squarer a b)

;(set-value! a 30 'user)
(set-value! b 9 'user)