More tweaks to propagator prototype.

1 files changed, 22 insertions, 21 deletions

diff --git a/chapter-7/propagators.scm b/chapter-7/propagators.scm
index e0096b6..3b54e47 100644
--- a/chapter-7/propagators.scm
+++ b/chapter-7/propagators.scm
@@ -197,25 +197,26 @@
 (define (add-cell-neighbor! cell neighbor)
   (set-cell-neighbors! cell (lset-adjoin eq? (cell-neighbors cell) neighbor)))
 
-(define (test-cell-content! cell)
+(define (add-cell-content! cell new)
   (match cell
-    (($ <cell> _ neighbors content strongest equivalent? _
+    (($ <cell> _ neighbors content strongest equivalent? merge
                find-strongest handle-contradiction)
-     (let ((strongest* (find-strongest content)))
-       (cond
-        ((equivalent? strongest strongest*)
-         (set-cell-strongest! cell strongest*))
-        ((contradiction? strongest*)
-         (set-cell-strongest! cell strongest*)
-         (handle-contradiction cell))
-        (else
-         (set-cell-strongest! cell strongest*)
-         (for-each alert-propagator! neighbors)))))))
-
-(define (add-cell-content! cell new)
-  (let ((merge (cell-merge cell)))
-    (set-cell-content! cell (merge (cell-content cell) new))
-    (test-cell-content! cell)))
+     (let ((content* (merge content new)))
+       (set-cell-content! cell content*)
+       (let ((strongest* (find-strongest content*)))
+         (cond
+          ;; New strongest value is equivalent to the old one.  No need
+          ;; to alert propagators.
+          ((equivalent? strongest strongest*)
+           (set-cell-strongest! cell strongest*))
+          ;; Uh oh, a contradiction!  Call handler.
+          ((contradiction? strongest*)
+           (set-cell-strongest! cell strongest*)
+           (handle-contradiction cell))
+          ;; Strongest value has changed.  Alert the propagators!
+          (else
+           (set-cell-strongest! cell strongest*)
+           (for-each alert-propagator! neighbors))))))))
 
 (define (alert-propagator! propagator)
   (queue-task! (propagator-activate propagator)))
@@ -242,20 +243,20 @@
            (add-cell-content! output (apply f args)))))
      (make-propagator name inputs (list output) activate))))
 
-(define (compound-propagator name inputs outputs to-build)
+(define (compound-propagator name inputs outputs build)
   (let ((built? #f))
     (define (maybe-build)
       (unless (or built?
                   (and (not (null? inputs))
                        (every unusable-value? (map cell-strongest inputs))))
         (parameterize ((current-parent (propagator-relations propagator)))
-          (to-build)
+          (build)
           (set! built? #t))))
     (define propagator (make-propagator name inputs outputs maybe-build))
     propagator))
 
-(define (constraint-propagator name cells to-build)
-  (compound-propagator name cells cells to-build))
+(define (constraint-propagator name cells build)
+  (compound-propagator name cells cells build))
 
 (define-record-type <reactive-id>
   (%make-reactive-id name clock)