diff options
| -rw-r--r-- | chapter-7/index.html | 15 | ||||
| -rw-r--r-- | chapter-7/propagators.js | 47 | ||||
| -rw-r--r-- | 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 @@ <script type="text/javascript" src="propagators.js"></script> </head> <body> + <article id="wasm-error" hidden="true"> + <h1>Uh oh!</h1> + <p> + A browser with Wasm GC and tail call support is required for + this demo. + </p> + <p> + We recommend using either Firefox or Chrome. + </p> + <p> + Safari is currently unsupported. Likewise, <emph>all browsers</emph> on + iOS are unsupported, as they are all secretly Safari under the + hood. + </p> + </article> </body> </html> 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 - (($ <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) |