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/index.html | 15 +++++++++++++++ chapter-7/propagators.js | 47 +++++++++++++++++++++++++++-------------------- chapter-7/propagators.scm | 43 ++++++++++++++++++++++--------------------- 3 files changed, 64 insertions(+), 41 deletions(-) diff --git a/chapter-7/index.html b/chapter-7/index.html index 17e5f54..e5c4372 100644 --- a/chapter-7/index.html +++ b/chapter-7/index.html @@ -7,5 +7,20 @@ + diff --git a/chapter-7/propagators.js b/chapter-7/propagators.js index c392ad1..fe0034a 100644 --- a/chapter-7/propagators.js +++ b/chapter-7/propagators.js @@ -1,23 +1,30 @@ window.addEventListener("load", async () => { - await Scheme.load_main("propagators.wasm", { - reflect_wasm_dir: "hoot", - user_imports: { - window: { - setTimeout: setTimeout - }, - document: { - makeTextNode: Document.prototype.createTextNode.bind(document), - makeElement: Document.prototype.createElement.bind(document), - body: () => document.body, - }, - element: { - appendChild: (parent, child) => parent.appendChild(child), - setAttribute: (elem, attr, value) => elem.setAttribute(attr, value), - getValue: (elem) => elem.value, - setValue: (elem, val) => elem.value = val, - replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem), - addEventListener: (elem, name, f) => elem.addEventListener(name, f) - }, + try { + await Scheme.load_main("propagators.wasm", { + reflect_wasm_dir: "hoot", + user_imports: { + window: { + setTimeout: setTimeout + }, + document: { + makeTextNode: Document.prototype.createTextNode.bind(document), + makeElement: Document.prototype.createElement.bind(document), + body: () => document.body, + }, + element: { + appendChild: (parent, child) => parent.appendChild(child), + setAttribute: (elem, attr, value) => elem.setAttribute(attr, value), + getValue: (elem) => elem.value, + setValue: (elem, val) => elem.value = val, + replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem), + addEventListener: (elem, name, f) => elem.addEventListener(name, f) + }, + } + }); + } catch(e) { + if(e instanceof WebAssembly.CompileError) { + document.getElementById("wasm-error").hidden = false; } - }); + throw e; + } }); 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

Uh oh!