(define (adder a1 a2 sum) (define (process-new-value)

(cond ((and (has-value? al) (has-value? a2)) (set-value! sum

(+ (get-value a1) (get-value a2))

me))

((and (has-value? al) (has-value? sum)) (set-value! a2

(- (get-value sum) (get-value a1))

me))

((and (has-value? a2) (has-value? sum)) (set-value! a1

(- (get-value sum) (get-value a2))

me))))

(define (process-forget-value) (forget-value! sum me) (forget-value! a1 me) (forget-value! a2 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 "Неизвестный запрос -- ADDER" request)))) (connect a1 me) (connect a2 me) (connect sum me) me)

Adder связывает новый сумматор с указанными соединителями и возвращает его в качестве значения. Процедура me, которая представляет сумматор, работает как диспетчер для внутренних процедур. Для доступа к диспетчеру используются следующие «синтаксические интерфейсы» (см. примечание 27 в разделе 3.3.4):

(define (inform-about-value constraint) (constraint I-have-a-value))

(define (inform-about-no-value constraint) (constraint I-lost-my-value))

Внутренняя процедура сумматора process-new-value вызывается, когда сумматору сообщают, что один из его соединителей получил значение. Сумматор проверяет, имеют ли значения одновременно a1 и a2. Если да, то он говорит sum, чтобы тот установил значение в сумму двух слагаемых. Аргумент informant процедуры set-value! равен me, то есть самому объекту-сумматору. Если неверно, что и a1 и a2 имеют значения, то сумматор проверяет, имеют ли одновременно значения a1 и sum. Если да, то он устанавливает a2 в их разность. Наконец, если значения есть у a2 и sum, это дает сумматору достаточно информации, чтобы установить a1. Если сумматору сообщают, что один из соединителей потерял значение, то он просит все свои

соединители избавиться от значений. (На самом деле будут отброшены только значения, установленные самим сумматором.) Затем он зовет process-new-value. Смысл этого последнего шага в том, что один или более соединителей по-прежнему могут обладать значением (то есть, у соединителя могло быть значение, не установленное сумматором), и эти значения может быть необходимо распространить через сумматор.

Умножитель очень похож на сумматор. Он устанавливает свой вывод product в 0, если хотя бы один множитель равен 0, даже в том случае, когда второй множитель неизвестен.

(define (multiplier m1 m2 product) (define (process-new-value)

(cond ((or (and (has-value? ml) (= (get-value ml) 0)) (and (has-value? m2) (= (get-value m2) 0))) (set-value! product 0 me)) ((and (has-value? m1) (has-value? m2)) (set-value! product

(* (get-value ml) (get-value m2))

me))

((and (has-value? product) (has-value? ml)) (set-value! m2

(/ (get-value product) (get-value ml))

me))

((and (has-value? product) (has-value? m2)) (set-value! ml

(/ (get-value product) (get-value m2))

me))))

(define (process-forget-value) (forget-value! product me) (forget-value! ml me) (forget-value! m2 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 "Неизвестный запрос -- MULTIPLIER" request)))) (connect ml me) (connect m2 me) (connect product me) me)

Конструктор constant просто устанавливает значение указанного соединителя. Сообщение I-have-a-value либо I-lost-my-value, посланные блоку-константе, приводят к ошибке.

(define (constant value connector) (define (me request)

(error "Неизвестный запрос -- CONSTANT" request)) (connect connector me) (set-value! connector value me) me)

Наконец, тестер печатает сообщение о присваивании или потере значения в указанном соединителе:

(define (probe name connector) (define (print-probe value) (newline)

(display "Тестер: ") (display name) (display " = ") (display value)) (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 "Неизвестный запрос -- PROBE" request)))) (connect connector me) me)

Представление соединителей

Соединитель представляется в виде процедурного объекта с внутренними переменными состояния: value, значение соединителя; informant, объект, который установил значение соединителя; и constraints, множество ограничений, в которых участвует соединитель.

(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

inform-about-value constraints)) ((not (= value newval))

(error "Противоречие" (list value newval))) (else ignored))) (define (forget-my-value retractor) (if (eq? retractor informant)

(begin (set! informant false)

(for-each-except retractor

inform-about-no-value constraints))

ignored)) (define (connect new-constraint)

(if (not (memq new-constraint constraints)) (set! constraints

(cons new-constraint constraints)))