Cope with echo-server minimart-benchmark test: flat new-connection cost

syndicate/HOWITWORKS.md

@@ -1,7 +1,7 @@
 # Efficient, Imperative Dataspaces for Conversational Concurrency
 
 Tony Garnock-Jones <tonyg@leastfixedpoint.com>  
-20 October 2018
+20 October 2018; revised 21 June 2019
 
 <p style="font-size:90%"><strong>Abstract.</strong> The dataspace
   model of Conversational Concurrency [is great], but implementing it
@@ -310,14 +310,17 @@ cases where handlers are dynamically installed.
       let (_, root) = index
       let (cache, table) = extend root s
       let constLocs = [h | (h,v) ∈ constantMap]
-      let constVals = [v | (h,v) ∈ constantMap]
       if constLocs not in table then
           table[constLocs] := {}
+          for v in cache
+              let key = projectMany v constLocs
+              if key not in table[constLocs] then
+                  table[constLocs][key] := ({}, {})
+              let (leafcache, _leaftable) = table[constLocs][key]
+              leafcache += v
+      let constVals = [v | (h,v) ∈ constantMap]
       if constVals not in table[constLocs] then
-          let leafcache =
-                { v | v ∈ cache,
-                      projectMany v constLocs = constVals }
-          table[constLocs][constVals] := (leafcache, {})
+          table[constLocs][constVals] := ({}, {})
       let (leafcache, leaftable) = table[constLocs][constVals]
       if captureMap not in leaftable then
           let bag = empty_bag
@@ -343,9 +346,9 @@ cases where handlers are dynamically installed.
       let (_, root) = index
       let (cache, table) = extend root s
       let constLocs = [h | (h,v) ∈ constantMap]
-      let constVals = [v | (h,v) ∈ constantMap]
       if constLocs not in table then
           return
+      let constVals = [v | (h,v) ∈ constantMap]
       if constVals not in table[constLocs] then
           return
       let (leafcache, leaftable) = table[constLocs][constVals]
@@ -357,7 +360,7 @@ cases where handlers are dynamically installed.
       f_table -= f
       if f_table = {} then
           delete leaftable[captureMap]
-      if leaftable = {} then
+      if leafcache = {} and leaftable = {} then
           delete table[constLocs][constVals]
       if table[constLocs] = {} then
           delete table[constLocs]
@@ -373,13 +376,16 @@ parameterized with different update procedures.
   by side-effect; in particular, the `m_handler` procedure may choose
   to invoke the callback passed to it.
 
+    Operation = { AddAssertion, RemoveAssertion, SendMessage }
+
     modify :: Node ->
+              Operation ->
               V ->
               (Continuation -> V -> 1) ->
               (Leaf -> V -> 1) ->
               (Handler -> [V] -> 1) ->
               1
-    modify node v m_cont m_leaf m_handler =
+    modify node operation v m_cont m_leaf m_handler =
       walk-node node [outermost(v)]
       where
         walk-node :: Node -> [V] -> 1
@@ -397,6 +403,8 @@ parameterized with different update procedures.
           m_cont cont v
           for constLocs in table
             let consts = projectMany v constLocs
+            if operation = AddAssertion and consts not in table[constLocs] then
+                table[constLocs][consts] := ({}, {})
             if consts in table[constLocs] then
                 let leaf@(leafcache, leaftable) =
                       table[constLocs][consts]
@@ -405,6 +413,10 @@ parameterized with different update procedures.
                     let handler = leaftable[captureMap]
                     let vs = projectMany v captureMap
                     m_handler handler vs
+                if operation = RemoveAssertion and leafcache = {} and leaftable = {} then
+                    delete table[constLocs][consts]
+                    if table[constLocs] = {} then
+                        delete table[constLocs]
 
 The `outermost` constructor applied to `v` at the top of `modify` is
 necessary because every path in the trie structure embodied in each
@@ -427,9 +439,9 @@ check followed by zero or more (move, check) pairs.
         cache[v] += delta
         let is_present = v in cache
         if not was_present and is_present then
-            modify root v add_cont add_leaf add_handler
+            modify root AddAssertion v add_cont add_leaf add_handler
         if was_present and not is_present then
-            modify root v del_cont del_leaf del_handler
+            modify root RemoveAssertion v del_cont del_leaf del_handler
       where
         add_cont (cache, _) v = cache += v
         add_leaf (leafcache, _) v = leafcache += v
@@ -472,7 +484,7 @@ processed first, no glitch will be detected.
 
     sendMessage :: Index -> V -> 1
     sendMessage (_, root) v =
-        modify root v send_cont send_leaf send_handler
+        modify root SendMessage v send_cont send_leaf send_handler
       where
         send_cont _ _ = ()
         send_leaf _ _ = ()

syndicate/skeleton.rkt

@@ -122,17 +122,21 @@
 (define (make-empty-skeleton)
   (make-empty-skeleton/cache (make-hash)))
 
+(define (make-empty-matched-constant)
+  (skeleton-matched-constant (make-hash) (make-hash)))
+
 (define (skcont-add! c i)
   (match-define (skeleton-interest _desc cs cv vs h _cleanup) i)
-  (define (make-matched-constant)
-    (define assertions (make-hash))
+  (define (classify-assertions)
+    (define cvt (make-hash))
     (hash-for-each (skeleton-continuation-cache c)
                    (lambda (a _)
-                     (when (equal? (apply-projection (unscope-assertion a) cs) cv)
-                       (hash-set! assertions a #t))))
-    (skeleton-matched-constant assertions (make-hash)))
-  (define cvt (hash-ref! (skeleton-continuation-table c) cs make-hash))
-  (define sc (hash-ref! cvt cv make-matched-constant))
+                     (define avs (apply-projection (unscope-assertion a) cs))
+                     (define sc (hash-ref! cvt avs make-empty-matched-constant))
+                     (hash-set! (skeleton-matched-constant-cache sc) a #t)))
+    cvt)
+  (define cvt (hash-ref! (skeleton-continuation-table c) cs classify-assertions))
+  (define sc (hash-ref! cvt cv make-empty-matched-constant))
   (define (make-accumulator)
     (define cache (make-bag))
     (hash-for-each (skeleton-matched-constant-cache sc)
@@ -145,6 +149,10 @@
   (hash-set! (skeleton-accumulator-handlers acc) h #t)
   (for [(vars (in-bag (skeleton-accumulator-cache acc)))] (apply h '+ vars)))
 
+(define (skeleton-matched-constant-empty? sc)
+  (match-define (skeleton-matched-constant cache table) sc)
+  (and (hash-empty? cache) (hash-empty? table)))
+
 (define (skcont-remove! c i)
   (match-define (skeleton-interest _desc cs cv vs h cleanup) i)
   (define cvt (hash-ref (skeleton-continuation-table c) cs #f))
@@ -158,7 +166,7 @@
         (hash-remove! (skeleton-accumulator-handlers acc) h)
         (when (hash-empty? (skeleton-accumulator-handlers acc))
           (hash-remove! (skeleton-matched-constant-table sc) vs)))
-      (when (hash-empty? (skeleton-matched-constant-table sc))
+      (when (skeleton-matched-constant-empty? sc)
         (hash-remove! cvt cv)))
     (when (hash-empty? cvt)
       (hash-remove! (skeleton-continuation-table c) cs))))
@@ -259,29 +267,36 @@
   (let ((sk (extend-skeleton! sk (skeleton-interest-desc i))))
     (skcont-remove! (skeleton-node-continuation sk) i)))
 
-(define (skeleton-modify! sk term0 modify-skcont! modify-skconst! modify-skacc!)
+(define (skeleton-modify! sk term0 modify-skcont! on-missing-skconst modify-skconst! modify-skacc!)
   (unpack-scoped-assertion [restriction-path term0-term] term0)
 
   (define (walk-node! sk term-stack)
     (match-define (skeleton-node continuation edges) sk)
 
     (modify-skcont! continuation term0)
-    (hash-for-each (skeleton-continuation-table continuation)
-                   (lambda (constant-proj key-proj-handler)
-                     (define constants (apply-projection term0-term constant-proj))
-                     (define proj-handler (hash-ref key-proj-handler constants #f))
-                     (when proj-handler
-                       (modify-skconst! proj-handler term0)
-                       (hash-for-each (skeleton-matched-constant-table proj-handler)
-                                      (lambda (variable-proj acc)
-                                        ;; (when restriction-path
-                                        ;;   (log-info "Restriction path ~v in effect; variable-proj is ~v, and term is ~v"
-                                        ;;             restriction-path
-                                        ;;             variable-proj
-                                        ;;             term0))
-                                        (when (unrestricted? variable-proj restriction-path)
-                                          (define vars (apply-projection term0-term variable-proj))
-                                          (modify-skacc! acc vars term0)))))))
+    (let ((sct (skeleton-continuation-table continuation))
+          (constant-projections-to-remove '()))
+      (hash-for-each sct
+                     (lambda (constant-proj key-proj-handler)
+                       (define constants (apply-projection term0-term constant-proj))
+                       (define proj-handler
+                         (hash-ref key-proj-handler
+                                   constants
+                                   (lambda () (on-missing-skconst key-proj-handler constants))))
+                       (when proj-handler
+                         (when (eq? (modify-skconst! proj-handler term0) 'remove-check)
+                           (when (skeleton-matched-constant-empty? proj-handler)
+                             (hash-remove! key-proj-handler constants)
+                             (when (hash-empty? key-proj-handler)
+                               (set! constant-projections-to-remove
+                                     (cons constant-proj constant-projections-to-remove)))))
+                         (hash-for-each (skeleton-matched-constant-table proj-handler)
+                                        (lambda (variable-proj acc)
+                                          (when (unrestricted? variable-proj restriction-path)
+                                            (define vars (apply-projection term0-term variable-proj))
+                                            (modify-skacc! acc vars term0)))))))
+      (for-each (lambda (constant-proj) (hash-remove! sct constant-proj))
+                constant-projections-to-remove))
 
     (for [(edge (in-list edges))]
       (match-define (cons (skeleton-selector pop-count index) table) edge)
@@ -321,13 +336,18 @@
   (skeleton-modify! sk
                     term
                     add-term-to-skcont!
+                    (lambda (cv-table cv)
+                      (let ((sc (make-empty-matched-constant)))
+                        (hash-set! cv-table cv sc)
+                        sc))
                     add-term-to-skconst!
                     add-term-to-skacc!))
 
 (define (remove-term-from-skcont! skcont term)
   (hash-remove! (skeleton-continuation-cache skcont) term))
 (define (remove-term-from-skconst! skconst term)
-  (hash-remove! (skeleton-matched-constant-cache skconst) term))
+  (hash-remove! (skeleton-matched-constant-cache skconst) term)
+  'remove-check)
 (define (remove-term-from-skacc! skacc vars _term)
   (define cache (skeleton-accumulator-cache skacc))
   ;; (log-info ">>>>>> At removal time for ~v, cache has ~v" _term (hash-ref cache vars 0))
@@ -345,6 +365,7 @@
   (skeleton-modify! sk
                     term
                     remove-term-from-skcont!
+                    (lambda (_cv-table _cv) #f)
                     remove-term-from-skconst!
                     remove-term-from-skacc!))
 
@@ -352,6 +373,7 @@
   (skeleton-modify! sk
                     term
                     void
+                    (lambda (_cv-table _cv) #f)
                     void
                     (lambda (skacc vars _term)
                       (hash-for-each (skeleton-accumulator-handlers skacc)