SICP演習問題3.33~3.35

;;exercise3-33
(load "./section3-3-5.scm")

(define (averager a b c)
  (let ((u (make-connector))
        (w (make-connector)))
    (adder a b u)
    (multiplier w c u)
    (constant 2.0 w)
    'ok))

;;other
(define (averager a b c)
  (let ((u (make-connector))
        (w (make-connector)))
    (adder a b u)
    (multiplier u w c)
    (constant 0.5 w)
    'ok))

;;test
(define a (make-connector))
(define b (make-connector))
(define average (make-connector))
(averager a b average)

(probe "a" a)
(probe "b" b)
(probe "average" average)

(set-value! a 100 'sakamo)
(newline)
(set-value! average 200 'sakamo)
(newline)
(forget-value! a 'sakamo)
(newline)
(set-value! b 100 'sakamo)
(newline)

;;exercise3-34
(load "./section3-3-5.scm")

(define (squarer a b)
  (multiplier a a b))

;;test
(define a (make-connector))
(define b (make-connector))
(squarer a b)

(probe "a" a)
(probe "b" b)

(set-value! b 9 'sakamot)
;;(set-value! a 3 'sakamot)
;aが求められない

;;exercise3-35
(load "./section3-3-5.scm")

(define (squarer a b)
  (define (square x) (* x x))
  (define (process-new-value)
    (if (has-value? b)
        (if (< (get-value b) 0)
            (error "squarer less than 0 -- SQUARER" (get-value b))
            (set-value! a
                        (sqrt (get-value b))
                        me))
        (if (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)

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

(squarer a b)
(probe "a" a)
(probe "b" b)

(set-value! b 9 'sakamo)
(newline)
(forget-value! b 'sakamo)
(newline)
(set-value! a 4 'user)
(newline)
(forget-value! a 'user)
(newline)
(set-value! b 25 'hoge)
(newline)