From 23311804da2d59b6e63645c63ea5020599349cba Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sat, 6 Jul 2024 18:08:46 -0400 Subject: More tweaks to propagator prototype. --- chapter-7/propagators.scm | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) (limited to 'chapter-7/propagators.scm') 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 - (($ _ neighbors content strongest equivalent? _ + (($ _ 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 (%make-reactive-id name clock) -- cgit v1.2.3