Propagator improvements and cleanup.

2 files changed, 59 insertions, 134 deletions

diff --git a/chapter-7/propagators.js b/chapter-7/propagators.js
index 1477a86..c392ad1 100644
--- a/chapter-7/propagators.js
+++ b/chapter-7/propagators.js
@@ -3,89 +3,21 @@ window.addEventListener("load", async () => {
     reflect_wasm_dir: "hoot",
     user_imports: {
       window: {
-        scrollTo: window.scrollTo,
-        setTimeout: setTimeout,
-        getWindow: function() {
-          return window;
-        },
+        setTimeout: setTimeout
       },
       document: {
         makeTextNode: Document.prototype.createTextNode.bind(document),
         makeElement: Document.prototype.createElement.bind(document),
-        getElementById: Document.prototype.getElementById.bind(document),
-        getBody: function() {
-          return document.body;
-        },
+        body: () => document.body,
       },
       element: {
-        firstChild: (elem) => elem.firstChild,
-        nextSibling: (elem) => elem.nextSibling,
-        appendChild: function(parent, child) {
-          return parent.appendChild(child);
-        },
-        setAttribute: function(elem, attr, value) {
-          return elem.setAttribute(attr, value);
-        },
-        getAttribute: function(elem, attr) {
-          return elem.getAttribute(attr);
-        },
-        getProperty: function(elem, property, dflt) {
-          // The little + '' ensures the value is a string
-          return value = elem[property] + '';
-        },
-        setProperty: function(elem, property, new_value) {
-          elem[property] = new_value;
-        },
+        appendChild: (parent, child) => parent.appendChild(child),
+        setAttribute: (elem, attr, value) => elem.setAttribute(attr, value),
         getValue: (elem) => elem.value,
         setValue: (elem, val) => elem.value = val,
-        remove: function(elem) {
-          elem.remove();
-        },
         replaceWith: (oldElem, newElem) => oldElem.replaceWith(newElem),
-        addEventListener: function(elem, name, f) {
-          elem.addEventListener(name, f);
-        },
+        addEventListener: (elem, name, f) => elem.addEventListener(name, f)
       },
-      websocket: {
-        create: function(uri) {
-          ws = new WebSocket(uri);
-          return ws;
-        },
-        registerHandler: function(sock, handler, f) {
-          sock[handler] = function (event) {
-            if (handler == "onmessage") {
-              f(event.data);
-            } else {
-              f(event);
-            }
-          };
-        },
-        send: function(sock, message) {
-          sock.send(message);
-        },
-      },
-      notification: {
-        create: function(text) {
-          return new Notification(text);
-        },
-        permission: function() {
-          return Notification.permission;
-        },
-        requestPermission: Notification.requestPermission,
-      },
-      promise: {
-        on: function(promise, f) {
-          promise.then(f);
-        },
-      },
-      localStorage: {
-        getItem: (key) => localStorage.getItem(key) || "#f",
-        setItem: (key, value) => localStorage.setItem(key, value)
-      },
-      location: {
-        protocol: () => location.protocol,
-        hostname: () => location.hostname
-      }
     }
   });
 });
diff --git a/chapter-7/propagators.scm b/chapter-7/propagators.scm
index db27a2e..e0096b6 100644
--- a/chapter-7/propagators.scm
+++ b/chapter-7/propagators.scm
@@ -4,49 +4,34 @@
              ((hoot hashtables) #:select (make-weak-key-hashtable
                                           weak-key-hashtable-ref
                                           weak-key-hashtable-set!))
+             ((hoot lists) #:select (fold))
              ((hoot numbers) #:select (truncate))
              (hoot ffi))
 
-(define-foreign make-element
-  "document" "makeElement"
-  (ref string) -> (ref extern))
+(define-foreign timeout
+  "window" "setTimeout"
+  (ref extern) f64 -> i32)
+
+(define-foreign document-body
+  "document" "body"
+  -> (ref null extern))
 
 (define-foreign make-text-node
   "document" "makeTextNode"
   (ref string) -> (ref extern))
 
-(define-foreign get-element-by-id
-  "document" "getElementById"
-  (ref string) -> (ref null extern))
-
-(define-foreign first-child
-  "element" "firstChild"
-  (ref extern) -> (ref null extern))
-
-(define-foreign next-sibling
-  "element" "nextSibling"
-  (ref extern) -> (ref null extern))
+(define-foreign make-element
+  "document" "makeElement"
+  (ref string) -> (ref extern))
 
 (define-foreign append-child!
   "element" "appendChild"
   (ref extern) (ref extern) -> (ref extern))
 
-(define-foreign attribute-ref
-  "element" "getAttribute"
-  (ref extern) (ref string) -> (ref string))
-
-(define-foreign set-attribute!
+(define-foreign attribute-set!
   "element" "setAttribute"
   (ref extern) (ref string) (ref string) -> none)
 
-(define-foreign property-ref
-  "element" "getProperty"
-  (ref extern) (ref string) -> (ref string))
-
-(define-foreign set-property!
-  "element" "setProperty"
-  (ref extern) (ref string) (ref string) -> none)
-
 (define-foreign value
   "element" "getValue"
   (ref extern) -> (ref string))
@@ -59,22 +44,10 @@
   "element" "addEventListener"
   (ref extern) (ref string) (ref extern) -> none)
 
-(define-foreign remove!
-  "element" "remove"
-  (ref extern) -> none)
-
 (define-foreign replace-with!
   "element" "replaceWith"
   (ref extern) (ref extern) -> none)
 
-(define-foreign document-body
-  "document" "getBody"
-  -> (ref null extern))
-
-(define-foreign timeout
-  "window" "setTimeout"
-  (ref extern) f64 -> i32)
-
 (define (lset-adjoin = list . rest)
   (define pred
     (if (or (eq? = eq?) (eq? = eqv?))
@@ -325,21 +298,41 @@
                  (lp rest)))))))))
 
 (define (merge-ephemeral-timestamps ephemerals)
-  (let lp ((ephemerals ephemerals) (timestamps '()))
-    (match ephemerals
-      (() timestamps)
-      ((($ <ephemeral> _ timestamps*) . rest)
-       (let lp2 ((timestamps* timestamps*) (timestamps timestamps))
-         (match timestamps*
-           (() (lp rest timestamps))
-           (((and timestamp (key . time)) . rest)
-            (match (assq-ref timestamps key)
-              (#f (lp2 rest (cons timestamp timestamps)))
-              (time*
-               (if (= time time*)
-                   (lp2 rest timestamps)
-                   #f)))))))
-      ((_ . rest) (lp rest timestamps)))))
+  (define (adjoin-keys alist keys)
+    (fold (lambda (key+value keys)
+            (match key+value
+              ((key . _)
+               (lset-adjoin eq? keys key))))
+          keys alist))
+  (define (check-timestamps id)
+    (let lp ((ephemerals ephemerals) (t #f))
+      (match ephemerals
+        (() t)
+        ((($ <ephemeral> _ timestamps) . rest)
+         (match (assq-ref timestamps id)
+           ;; No timestamp for this id in this ephemeral.  Continue.
+           (#f (lp rest t))
+           (t*
+            (if t
+                ;; If timestamps don't match then we have a mix of
+                ;; fresh and stale values, so return #f.  Otherwise,
+                ;; continue.
+                (and (= t t*) (lp rest t))
+                ;; Initialize timestamp and continue.
+                (lp rest t*))))))))
+  ;; Build a set of all reactive identifiers across all ephemerals.
+  (let ((ids (fold (lambda (ephemeral ids)
+                     (adjoin-keys (ephemeral-timestamps ephemeral) ids))
+                   '() ephemerals)))
+    (let lp ((ids ids) (timestamps '()))
+      (match ids
+        (() timestamps)
+        ((id . rest)
+         ;; Check for consistent timestamps.  If they are consistent
+         ;; then add it to the alist and continue.  Otherwise, return
+         ;; #f.
+         (let ((t (check-timestamps id)))
+           (and t (lp rest (cons (cons id t) timestamps)))))))))
 
 (define (merge-ephemerals old new)
   (cond
@@ -360,15 +353,15 @@
 (define-syntax-rule (define-primitive-reactive-propagator name proc)
   (define name (primitive-reactive-propagator 'name proc)))
 
-(define (r:property input elem property)
-  (let ((property (symbol->string property)))
+(define (r:attribute input elem attr)
+  (let ((attr (symbol->string attr)))
     (define (activate)
       (match (cell-strongest input)
         (($ <ephemeral> val)
-         (set-property! elem property (obj->string val)))
+         (attribute-set! elem attr (obj->string val)))
         ;; Ignore unusable values.
         (_ (values))))
-    (make-propagator 'property (list input) '() activate)))
+    (make-propagator 'r:attribute (list input) '() activate)))
 
 (define-record-type <binding>
   (make-binding id cell default group)
@@ -454,15 +447,15 @@
           (for-each (lambda (attr)
                       (match attr
                         (((? symbol? name) (? string? val))
-                         (set-attribute! elem
+                         (attribute-set! elem
                                          (symbol->string name)
                                          val))
                         (((? symbol? name) (? number? val))
-                         (set-attribute! elem
+                         (attribute-set! elem
                                          (symbol->string name)
                                          (number->string val)))
                         (((? symbol? name) (? cell? cell))
-                         (r:property cell elem name))
+                         (r:attribute cell elem name))
                         ;; The value attribute is special and can be
                         ;; used to setup a 2-way data binding.
                         (('value (? binding? binding))