Propagator improvements and cleanup.

1 files changed, 54 insertions, 61 deletions

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))