summaryrefslogtreecommitdiff
path: root/chapter-7
diff options
context:
space:
mode:
Diffstat (limited to 'chapter-7')
-rw-r--r--chapter-7/index.html15
-rw-r--r--chapter-7/propagators.js47
-rw-r--r--chapter-7/propagators.scm43
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)