19 changed files with 385 additions and 705 deletions
--- a/syndicate-examples/chat.pr
+++ b/syndicate-examples/chat.pr
@ -1,4 +1,4 @@
-#!/usr/bin/env -S syndicate-server -c
+; syndicate-server -c chat.pr

 <require-service <relay-listener <tcp "0.0.0.0" 9001> $gatekeeper>>

--- a/syndicate-examples/dummy-port-relay.pr
+++ b/syndicate-examples/dummy-port-relay.pr
@ -1,4 +1,4 @@
-#!/usr/bin/env -S syndicate-server -c
+; syndicate-server -c dummy-port-relay.pr

 <require-service <daemon dummy-port-relay>>
 <daemon dummy-port-relay {
--- a/syndicate-examples/http-server.rkt
+++ b/syndicate-examples/http-server.rkt
@ -1,55 +0,0 @@
-;;; SPDX-License-Identifier: LGPL-3.0-or-later
-;;; SPDX-FileCopyrightText: Copyright © 2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
-
-#lang syndicate
-;; Simple example of the HTTP server protocol and Racket implementation.
-
-(require syndicate/drivers/http)
-(require racket/pretty)
-(require xml)
-
-(define (html-response #:title title #:head [head '()] . body-items)
-  (parameterize ((current-unescaped-tags html-unescaped-tags)
-                 (empty-tag-shorthand html-empty-tags))
-    (mime 'text/html
-          (string-append "<!DOCTYPE html>\n"
-                         (xexpr->string
-                          `(html
-                            (head
-                             (meta ((http-equiv "Content-Type") (content "text/html; charset=utf-8")))
-                             (meta ((name "viewport") (content "width=device-width, initial-scale=1.0")))
-                             (title ,title)
-                             ,@head)
-                            (body ,@body-items)))))))
-
-(module+ main
-  (standard-actor-system (ds)
-    (with-services [syndicate/drivers/http]
-      (spawn #:name 'logger
-        (at ds
-          (during (HttpRequest $id $host $port $method $path $headers $query $body)
-            (define start-time (current-inexact-milliseconds))
-            (on-start (log-info ":+ ~a ~a ~a ~a ~v" id method host port path))
-            (on-stop (define stop-time (current-inexact-milliseconds))
-                     (define duration-ms (- stop-time start-time))
-                     (log-info ":- ~a ~a ~a ~a ~v ~ams" id method host port path
-                               duration-ms)))))
-
-      (spawn #:name 'server
-        (define-field counter 0)
-
-        (at ds
-          (define-http-route [#f 8080 'get [""] req res]
-            []
-            (counter (+ (counter) 1))
-            (html-response #:title "Hello"
-                           `(h1 "Hello world")
-                           `(p "Counter " ,(number->string (counter)))
-                           `(a ((href "/page2")) "Go forward")))
-          (define-http-route [#f 8080 'get ["page2"] req res]
-            []
-            (html-response #:title "Page 2"
-                           `(h1 "Second page")
-                           `(a ((href "/")) "Go back")))))
-
-      )))
--- a/syndicate/HOWITWORKS.md
+++ b/syndicate/HOWITWORKS.md
@ -1,7 +1,7 @@
 # Efficient, Imperative Dataspaces for Conversational Concurrency

 Tony Garnock-Jones <tonyg@leastfixedpoint.com>  
-20 October 2018; revised 21 June 2019 and 4-5 April 2024
+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
@ -29,7 +29,7 @@ language.
    x ∈ identifiers X
    a ∈ atoms       A = numbers ∪ strings ∪ ...

-Here are some examples of assertions in `C`, along with suggested
+Here are some examples of assertions in `c`, along with suggested
 interpretations:

    present("Alice")           Alice is present in the chat room
@ -87,7 +87,7 @@ only the name of the speaker.
 Imagine now an enriched version of our language that can construct
 patterns over data, including captures and "don't care" positions.

-    p ∈ patterns    P ::= v | x(p, ...) | $x | _
+    p ∈ patterns    P ::= e | x(p, ...) | $x | _

 Syntactic patterns can be translated into assertions of interest
 directly. Binding subpatterns `$x` are translated into `capture()`,
@ -113,9 +113,10 @@ event handlers added later.
 ### Skeletons

 A skeleton is comprised of three pieces: a *shape*, describing the
-positions of statically-known constructors in matching assertions; a
-*constant map*, which places restrictions on fields within constructors;
-and a *capture map*, which specifies locations of captured positions.
+positions and arities of statically-known constructors in matching
+assertions; a *constant map*, which places restrictions on fields
+within constructors; and a *capture map*, which specifies locations of
+captured positions.

 Each time an assertion is added or removed, it is conceptually checked
 against each handler's skeleton. First, the overall shape is checked.
@ -123,57 +124,49 @@ If the assertion passes this check, the constant map is checked. If
 all the constants match, the capture map is used to prepare an
 argument vector, and the event handler's callback is invoked.

-    k ∈ skeletons      K = S × (H ⟼ V+1) × [H]
-    s ∈ shapes         S = (H ⟼ L)
-    ℓ ∈ classes        L = X			-- label
-    h ∈ paths          H = [𝐍]
+    k ∈ skeletons   K   = S × [H×E] × [H]
+    s ∈ shapes      S ::= * | x(s, ...)
+    h ∈ paths       H   = [𝐍]

-Shapes retain only statically-known constructors in a pattern:
+Shapes retain only statically-known constructors and arities in a
+pattern:

-    shape :: P → S
-    shape p = shape' [] p
-      where
-        shape' :: H → P → S
-        shape h v               = ∅
-        shape h x(p₀, ..., pᵢ)  = (h ⟼ x)
-                                ∪ (shape (h++[0]) p₀) ∪ ...
-                                ∪ (shape (h++[i]) pᵢ)
-        shape h $x              = ∅
-        shape h _               = ∅
+    shape :: P -> S
+    shape e          = *
+    shape x(p, ...)  = x(shape p, ...)
+    shape $x         = *
+    shape _          = *

-A constant map filters potential matches by placing constraints on
-contained fields. The paths `H` in the map denote positions to be
-checked; the predicates `V+1` denote either a particular value that must
-exist at that position, or a simple check that the term in question
-merely *has* a value in that position.
+A constant map extracts all non-capturing, non-discard positions in a
+pattern. The expressions in the map are evaluated at the time the
+corresponding event handler is installed; that is, at facet creation
+time. They are not subsequently reevaluated; if any expression depends
+on a dataflow variable, and that variable changes, the entire handler
+is removed, reevaluated, and reinstalled.

-    constantmap :: P → (H ⟼ V+1)
+    constantmap :: P -> [(H, E)]
    constantmap p  = cmap [] p
      where
-        cmap :: H → P → (H ⟼ V+1)
-        cmap h v               = (h ⟼ inl v)
-        cmap h x(p₀, ..., pᵢ)  = (cmap (h++[0]) p₀) ∪ ...
-                               ∪ (cmap (h++[i]) pᵢ)
-        cmap h $x              = ∅
-        cmap h _               = (h ⟼ inr ())
+        cmap :: H -> P -> [(H, E)]
+        cmap h e                 = [(h, e)]
+        cmap h x(p_0, ..., p_i)  = (cmap (h++[0]) p_0) ++
+                                   ... ++
+                                   (cmap (h++[i]) p_i)
+        cmap h $x                = []
+        cmap h _                 = []

-It will be useful to separate value-check operations from existence-check operations.
+Finally, a capture map extracts all capturing positions in a pattern:

-    constantchecks :: (H ⟼ V+1) → (H ⟼ V) × 𝒫(H)
-    constantchecks m = ( { h ⟼ v | h ⟼ inl v ∈ m },
-                         { h       | h ⟼ inr () ∈ m } )
-
-Finally, a capture map extracts all capturing positions in a pattern.
-
-    capturemap :: P → [H]
+    capturemap :: P -> [H]
    capturemap p  = vmap [] p
      where
-        vmap :: H → P → [H]
-        vmap h v              = []
-        vmap h x(p₀, ..., pᵢ) = (vmap (h++[0]) p₀) ++ ...
-                             ++ (vmap (h++[i]) pᵢ)
-        vmap h $x             = [h]
-        vmap h _              = []
+        vmap :: H -> P -> [H]
+        vmap h e                = []
+        vmap h x(p_0, ..., p_i) = (vmap (h++[0]) p_0) ++
+                                  ... +
+                                  (vmap (h++[i]) p_i)
+        vmap h $x               = [h]
+        vmap h _                = []

 ### The index

@ -182,8 +175,8 @@ assertion in the dataspace.

 #### Overview and structures

-An index contains a bag of all currently-asserted
-assertion-values, as well as the root of a trie-like structure.
+An index is a pair of a bag of all currently-asserted
+assertion-values, plus the root node of a trie-like structure.
 Information from each indexed event handler's skeleton's shape is laid
 out along edges connecting trie nodes.

@ -192,22 +185,23 @@ a skeleton's constant map and capture map alongside handler callback
 functions and caches of currently-asserted values.

           Index = Bag(V) × Node
-            Node = Continuation × (Move ⟼ L ⟼ Node)
-            Move = 𝐍 × H
+            Node = Continuation × (Selector ⟼ Class ⟼ Node)
+        Selector = 𝐍 × 𝐍		-- pop-count and index
+           Class = X			-- label

-    Continuation = 𝒫(V) × ([H]×𝒫(H) ⟼ [V] ⟼ Leaf)
+    Continuation = 𝒫(V) × ([H] ⟼ [V] ⟼ Leaf)
            Leaf = 𝒫(V) × ([H] ⟼ Handler)

         Handler = Bag([V]) × 𝒫(Callback)

-        Callback = EventType → [V] → V
+        Callback = EventType -> [V] -> V
     EventType ::= "+" | "-" | "!"

          Bag(τ) = τ ⟼ 𝐍		-- bag of τ values

 To use an index in the context of a single assertion—be it a new
 addition, a removal, or a message to be delivered—follow a path from
-the root `Node` of the index along move- and class-labelled edges,
+the root `Node` of the index along `Selector`/`Class`-labelled edges,
 collecting `Continuations` as you go. This yields a complete set of
 event handlers that may match the assertion being considered. Further
 investigating each collected `Continuation` by analyzing its constant
@ -219,103 +213,15 @@ At every `Continuation`, `Leaf` and `Handler` object, the index
 maintains a set of currently-asserted values that conform to the
 constraints implied by the object's position in the overall index.

-Most of the components in an index are *mutable*: the `Bag(V)` and
-initial class-to-`Node` map in the
+Most of the components in an index are *mutable*: the `Bag(V)` in the
 root; the assertion-value cache set in each `Continuation` or `Leaf`
-object; the map from move to class to `Node` within each
+object; the map from `Selector` to `Class` to `Node` within each
 `Node`; the map from path list to value-list to `Leaf` in each
 `Continuation`; the map from path list to `Handler` in each `Leaf`;
 and the `Bag([V])` in every `Handler`. This reflects the fact that the
 index directly reflects the current state of the dataspace it is
 indexing.

-#### From pattern shapes to tries of moves
-
-**Definition.** A *visit* of a tree is a sequence of paths to nodes
-within the tree. It may be described in two equivalent ways: as a
-sequence of rooted (absolute) paths, `[H]`, or as a sequence of *moves*,
-relative paths, `[Move]`.
-
-    w ∈ absolute visits [H]
-    w̅ ∈ relative visits [Move]
-
-**Definition.** A *move* or *relative path* `h̅ ∈ Move` consists of zero
-or more steps rootward from a position in a tree, followed by a path
-from that position leafward in the tree. We define operators `⊕` and `⊖`
-for applying a move to an existing path and computing a move from one
-path to another, respectively:
-
-    ⊕ :: H → Move → H
-    hₒ ⊕ (n, h) = dropRight n hₒ ++ h
-
-    ⊖ :: H → H → Move
-    h ⊖ hₒ = (|hₒ| - |h'|, dropLeft |h'| h)
-      where
-        h' = longestCommonPrefix hₒ h
-
-The first relative path in a relative visit is interpreted with respect
-to the root of the tree. Relative and absolute visits are
-interconvertible:
-
-    absToRel :: [H] → [Move]
-    absToRel hs = rel [] hs
-      where
-        rel hₒ [] = []
-        rel hₒ [h, h₁, ...] = [h ⊖ hₒ] ++ rel h [h₁, ...]
-
-    relToAbs :: [Move] → [H]
-    relToAbs hs = abs [] hs
-      where
-        abs hₒ [] = []
-        abs hₒ [h̅, h̅₁, ...] = [hₒ ⊕ h̅] ++ abs (hₒ ⊕ h̅) [h̅₁, ...]
-
-**Definition.** The `shapeVisit` function converts a shape into a
-sequence of `Move × L` pairs. The `Move`s in the sequence are a
-visit of the nodes in the domain of the input shape.
-
-    shapeVisit :: S → [Move × L]
-    shapeVisit s = zip (absToRel (map fst s')) (map snd s')
-      where
-        s' = sort lexLt s
-
-The utility `sort :: ∀A ∀B . (A → A → 2) → (A ⟼ B) → [(A, B)]`
-produces a sorted sequence from a finite map and a "less-than"
-predicate, which in this case is `lexLt`, the lexicographic ordering on
-paths.
-
-*Implementation note.* The type `S = (H ⟼ L)` is an (unordered) map, but
-could equally well be a sequence of pairs `S = [H × L]` with the side
-condition that the `H`s must be unique. With that representation,
-`shape` can be adjusted to produce output in lexicographically-sorted
-order, obviating the need for `sort` in `shapeVisit`.
-
-*Implementation note.* In the special case of visiting a shape derived
-from a pattern, a move `(n, h)` will always have either `|h| = 0` (if it
-is the first move in the visit) or `|h| = 1` (if not). This allows
-representation of moves in indexes as `𝐍 × (1 + 𝐍)` instead of the fully
-general `𝐍 × H`.
-
-**Lemma.** Every shape produced by `shape p` for a pattern `p` includes
-a mapping for all and only the interior nodes of the tree embodied by
-`p`. That is, every non-leaf node in `p` has a path in the domain of
-`shape p`.
-
-*Proof*. By induction on `p` and examination of `shape`. ∎
-
-**Lemma.** Every relative path contained in a nonempty visit produced by
-`shapeVisit (shape p)` has a leafward path of length one, except the
-first such relative path, which always equals `(0, [])`.
-
-*Proof*. By properties of the lexicographic ordering of paths and the
-lemma above. The first path in `shapeVisit`'s result will always be the
-relative path to the root node, `(0, [])`, since that is the smallest
-possible path by the ordering. Subsequent paths will always be to an
-*immediate* child of the current node or of one of its ancestors. If it
-were not so, a contradiction would arise: since every interior node is
-represented, every immediate child with children of its own must appear,
-and lexicographic ordering requires that such nodes appear before their
-own children, so "skipping" a generation is not possible. ∎
-
 #### Adding and removing event handlers

 Every event handler is a pair of a skeleton and a callback function.
@ -333,72 +239,64 @@ itself to removal of handler functions, capture maps, and constant
 maps. This assumption will have to be revisited in future broker-like
 cases where handlers are dynamically installed.

-**Example.** Let our pattern be
+**Definition.** The `project` function extracts the subvalue at a
+  given path `h` from an overall value `v`.

-    p = x(y(3, 4), $v, z(_, w(), _), _)
-
-The skeleton of the pattern is then
-
-    k = (shape p, constantmap p, capturemap p)
-
-    shape p = ([] ⟼ x)
-            ∪ ([0] ⟼ y)
-            ∪ ([2] ⟼ z)
-            ∪ ([2, 1] ⟼ w)
-
-    constantmap p = ([0, 0] ⟼ inl 3)
-                  ∪ ([0, 1] ⟼ inl 4)
-                  ∪ ([2, 0] ⟼ inr ())
-                  ∪ ([2, 2] ⟼ inr ())
-                  ∪ ([3] ⟼ inr ())
-
-    capturemap p = [[1]]
-
-The shape-visit of `p` is thus
-
-    shapeVisit (shape p) = [((0, []), x),
-                            ((0, [0]), y),
-                            ((1, [2]), z),
-                            ((0, [1]), w)]
-
-**Definition.** The partial `project` function extracts the subvalue at
-  a given path `h` from an overall value `v`.
-
-    project :: V → H ⇀ V
+    project :: V -> H -> V
    project v [] = v
-    project x(v₀, ..., vᵢ) (n:h) = project vₙ h, if 0 ≤ n ≤ i
+    project x(v_0, ..., v_i) (n:h) = project v_n h

-**Definition.** The `projectMany` partial function projects a sequence
-  of subvalues.
+**Definition.** The `projectMany` function projects a sequence of
+  subvalues.

-    projectMany :: V → [H] ⇀ [V]
-    projectMany v [h, ...] = [project v h, ...]
+    projectMany :: V -> [H] -> V
+    projectMany v [h_0, ...] = [project v h_0, ...]

-**Definition.** The `classof` partial function extracts the constructor
-  label `x` from a record value. It is undefined for non-record values.
+**Definition.** The `classof` function extracts the constructor label
+  `x` from a value `v`, yielding `()` if `v` is not a record.

-    classof :: V ⇀ L
-    classof x(v₀, ..., vᵢ) = x
+    classof :: V -> 1 + Class
+    classof a                = ()
+    classof x(v_0, ..., v_i) = x

 **Definition.** The `extend` procedure augments an index with shape
-  information `s`, where `∃p . s = shape p`, by imperatively updating
-  the index structure. It returns the `Continuation` associated with the
-  final `Node` visited in the path described by `s`.
+  information `s`, by imperatively updating the index structure. It
+  returns the `Continuation` associated with the deepest `Node`
+  visited in the path described by `s`.

-    extend :: Index → S → Continuation
-    extend (_, root) s = visit [] root (shapeVisit s)
+    extend :: Node -> S -> Continuation
+    extend node s =
+        let (_, (cont, _)) = walk-node [] node 0 0 s
+        cont
      where
-        visit :: H → Node → [Move × L] → Continuation
-        visit h (cont, moveTable) [] = cont
-        visit h (cont, moveTable) ([(h̅, ℓ)] ++ moves) =
-          if h̅ not in moveTable then
-              moveTable[h̅] := {}
-          let classTable = moveTable[h̅]
-          if ℓ not in classTable then
-              let vs = { v | v ∈ fst cont,
-                             classof (project v (h ⊕ h̅)) = ℓ }
-              classTable[ℓ] := ((vs, {}), {})
-          visit (h ⊕ h̅) classTable[ℓ] moves
+
+        walk-edge :: H -> Node -> 𝐍 -> 𝐍 -> [S] -> (𝐍,Node)
+        walk-edge h node n_pop n_index [] =
+          (n_pop + 1, node)
+        walk-edge h node n_pop n_index (s:shapes) =
+          let (n_pop', node') = walk-node h node n_pop n_index s
+          let n_index' = n_index + 1
+          let h' = (dropRight h 1) ++ [n_index']
+          walk-edge h' node' n_pop' n_index' shapes
+
+        walk-node :: H -> Node -> 𝐍 -> 𝐍 -> S -> (𝐍,Node)
+        walk-node h node n_pop n_index * =
+          (n_pop, node)
+        walk-node h node n_pop n_index x(s_0, ... s_i) =
+          let (cont, edges) = node
+          let selector = (n_pop,n_index)
+          let class = x
+          if selector not in edges then
+              edges[selector] := {}
+          let table = edges[selector]
+          if class not in table then
+              let (outercache, constmap) = cont
+              let innercache =
+                { v | v ∈ outercache,
+                      classof (project v h) = class }
+              table[class] := ((innercache, {}), {})
+          let node' = table[class]
+          walk-edge (h ++ [0]) node' 0 0 [s_0, ..., s_i]

 **Definition.** The `addHandler` procedure installs into an index an
  event handler callback `f` expecting values matching and captured by
@ -406,35 +304,31 @@ The shape-visit of `p` is thus
  sequence of captured values matching existing assertions in the
  index.[^function-pointer-equality]

-    addHandler :: Index → K → Callback → 1
+    addHandler :: Index -> (S × [H×V] × [H]) -> Callback -> 1
    addHandler index (s, constantMap, captureMap) f =
-      let (cache, table) = extend index s
-      let (unsortedConstants, checks) = constantchecks constantMap
-      let constants = sort lexLt unsortedConstants
-      let constLocs = map fst constants
-      let constKey = (constLocs, checks)
-      if constKey not in table then
-          table[constKey] := {}
+      let (_, root) = index
+      let (cache, table) = extend root s
+      let constLocs = [h | (h,v) ∈ constantMap]
+      if constLocs not in table then
+          table[constLocs] := {}
          for v in cache
-              if ∀h ∈ checks, project v h is defined and
-                 ∃key . key = projectMany v constLocs then
-                  if key not in table[constKey] then
-                      table[constKey][key] := ({}, {})
-                  let (leafcache, _leaftable) = table[constKey][key]
-                  leafcache += v
-      let constVals = map snd constants
-      if constVals not in table[constKey] then
-          table[constKey][constVals] := ({}, {})
-      let (leafcache, leaftable) = table[constKey][constVals]
+              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
+          table[constLocs][constVals] := ({}, {})
+      let (leafcache, leaftable) = table[constLocs][constVals]
      if captureMap not in leaftable then
          let bag = empty_bag
          for v in leafcache
-              if ∃seq . seq = projectMany v captureMap then
-                  bag[seq] += 1
+              bag[projectMany v captureMap] += 1
          leaftable[captureMap] := (bag, {})
      let (bag, f_table) = leaftable[captureMap]
      f_table += f
-      for (seq ⟼ _) in bag
+      for seq in bag
          f "+" seq
      ()

@ -446,19 +340,17 @@ The shape-visit of `p` is thus
 **Definition.** The `removeHandler` procedure removes an event handler
  from an index.

-    removeHandler :: Index → K → Callback → 1
+    removeHandler :: Index -> (S × [H×V] × [H]) -> Callback -> 1
    removeHandler index (s, constantMap, captureMap) f =
-      let (_, table) = extend index s
-      let (unsortedConstants, checks) = constantchecks constantMap
-      let constants = sort lexLt unsortedConstants
-      let constLocs = map fst constants
-      let constKey = (constLocs, checks)
-      if constKey not in table then
+      let (_, root) = index
+      let (cache, table) = extend root s
+      let constLocs = [h | (h,v) ∈ constantMap]
+      if constLocs not in table then
          return
-      let constVals = map snd constants
-      if constVals not in table[constKey] then
+      let constVals = [v | (h,v) ∈ constantMap]
+      if constVals not in table[constLocs] then
          return
-      let (leafcache, leaftable) = table[constKey][constVals]
+      let (leafcache, leaftable) = table[constLocs][constVals]
      if captureMap not in leaftable then
          return
      let (bag, f_table) = leaftable[captureMap]
@ -468,9 +360,9 @@ The shape-visit of `p` is thus
      if f_table = {} then
          delete leaftable[captureMap]
      if leafcache = {} and leaftable = {} then
-          delete table[constKey][constVals]
-      if table[constKey] = {} then
-          delete table[constKey]
+          delete table[constLocs][constVals]
+      if table[constLocs] = {} then
+          delete table[constLocs]

 #### Adding assertions, removing assertions and sending messages

@ -485,59 +377,70 @@ parameterized with different update procedures.

    Operation = { AddAssertion, RemoveAssertion, SendMessage }

-    modify :: Index →
-              Operation →
-              V →
-              (Continuation → V → 1) →
-              (Leaf → V → 1) →
-              (Handler → [V] → 1) →
+    modify :: Node ->
+              Operation ->
+              V ->
+              (Continuation -> V -> 1) ->
+              (Leaf -> V -> 1) ->
+              (Handler -> [V] -> 1) ->
              1
-    modify (_, root) operation v m_cont m_leaf m_handler =
-        visit root [v]
+    modify node operation v m_cont m_leaf m_handler =
+      walk-node node [outermost(v)]
      where
-        visit :: Node → [V] → 1
-        visit (cont, moveTable) vs =
-          visit-cont cont
-          for ((n, h) ⟼ classTable) in moveTable
-            let (v' : vs') = dropLeft vs n in
-              if ∃v . v = project v' h and
-                 ∃ℓ . ℓ = classof v and
-                 ∃next . (ℓ ⟼ next) ∈ classTable then
-                visit next (v : v' : vs')
+        walk-node :: Node -> [V] -> 1
+        walk-node (cont, edges) vs =
+          walk-cont cont
+          for sel@(n_pop, n_index) in edges
+              let vs' = dropLeft vs n_pop
+              let (x(v_0, ...) : _) = vs'
+              let v' = v_{n_index}
+              if classof v' in edges[sel] then
+                  walk-node edges[sel][classof v'] (v':vs')

-        visit-cont :: Continuation → 1
-        visit-cont cont@(_, table) =
+        walk-cont :: Continuation -> 1
+        walk-cont cont@(cache, table) =
          m_cont cont v
-          for ((constLocs, checks) ⟼ constVals) in table
-            if ∀h ∈ checks, project v h is defined and
-               ∃consts . consts = projectMany v constLocs then
-                if operation = AddAssertion and consts not in constVals then
-                    constVals[consts] := ({}, {})
-                if consts in constVals then
-                    let leaf@(leafcache, leaftable) = constVals[consts]
-                    m_leaf leaf v
-                    for (captureMap ⟼ handler) in leaftable
-                        if ∃vs . vs = projectMany v captureMap then
-                            m_handler handler vs
-                    if operation = RemoveAssertion and leafcache = {} and leaftable = {} then
-                        delete constVals[consts]
-                        if constVals = {} then
-                            delete table[(constLocs, checks)]
+          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]
+                m_leaf leaf v
+                for captureMap in leaftable
+                    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
+`node` is a sequence of zero or more (move, check) pairs. Each "move"
+pops zero or more items from the stack and then pushes a sub-structure
+of the topmost stack element onto the stack; the "check" then examines
+the class of the new top element, abandoning the search if it does not
+match. Without some outermost constructor, there would be no possible
+"move", and the trie would have to be expressed as a single optional
+check followed by zero or more (move, check) pairs.

 **Definition.** The procedure `adjustAssertion` updates the copy-count
  associated with `v` in the given index, invoking callbacks as a
  side-effect if this changes the observable contents of the
  dataspace.

-    adjustAssertion :: Index → V → 𝐍 → 1
-    adjustAssertion index@(cache, root) v delta =
+    adjustAssertion :: Index -> V -> 𝐍 -> 1
+    adjustAssertion (cache, root) v delta =
        let was_present = v in cache
        cache[v] += delta
        let is_present = v in cache
        if not was_present and is_present then
-            modify index AddAssertion 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 index RemoveAssertion 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
@ -560,10 +463,10 @@ parameterized with different update procedures.
  install and remove an assertion `v` into the given index,
  respectively.

-    addAssertion :: Index → V → 1
+    addAssertion :: Index -> V -> 1
    addAssertion index v = adjustAssertion index v 1

-    removeAssertion :: Index → V → 1
+    removeAssertion :: Index -> V -> 1
    removeAssertion index v = adjustAssertion index v -1

 Care must be taken when applying entire *patches* to ensure that added
@ -578,7 +481,7 @@ processed first, no glitch will be detected.
 **Definition.** The procedure `sendMessage` delivers a message `v` to
  event handlers in the given index.

-    sendMessage :: Index → V → 1
+    sendMessage :: Index -> V -> 1
    sendMessage (_, root) v =
        modify root SendMessage v send_cont send_leaf send_handler
      where
@ -588,32 +491,8 @@ processed first, no glitch will be detected.
          for f in f_table
              f "!" vs

-## Variations
-
-### Exact arity matching
-
-The initial version of this design had
-
-    k ∈ skeletons   K   = S × (H ⟼ V) × [H]
-    ℓ ∈ classes     L   = X × 𝐍		-- label and arity
-
-which provided for exact arity matching instead of extensible "at-least"
-arity matching. Constant maps contained `V` rather than `V+1` because
-the arity check as part of the class obviated the need to check a
-position for mere existence.
-
-### Matching atom classes
-
-Skeleton constant map predicates `V+1` can be changed to include any
-other kind of predicate besides equal-to-expected-value `V` and simple
-existence `1`, such as `string?`/`int?`/etc.
-
 ## Potential future optimizations

-### JIT compilation of shapes, constant checks, captures
-
-TODO
-
 ### Static analysis of messages and assertions

 Static analysis of expressions under `(send! ...)` and `(assert ...)`
--- a/syndicate/dataspace.rkt
+++ b/syndicate/dataspace.rkt
@ -70,12 +70,8 @@
                           (when (eq? (bag-change! assertions value -1) 'present->absent)
                             (remove-assertion! this-turn skeleton value)
                             (match maybe-observe
-                               [(? eof-object?)
-                                (log-syndicate/dataspace-debug "Not an observer:~a" (pretty-assertion 4 value))
-                                (void)]
-                               [(Observe pat ref)
-                                (remove-interest! this-turn skeleton pat ref)
-                                (log-syndicate/dataspace-debug "Updated index:~a" (pretty-assertion 4 skeleton))]))]))
+                               [(? eof-object?) (void)]
+                               [(Observe pat ref) (remove-interest! this-turn skeleton pat ref)]))]))
            #:message (lambda (message)
                        (log-syndicate/dataspace-debug "~v !~a" ds-e (pretty-assertion 4 message))
                        (send-assertion! this-turn skeleton message))))
--- a/syndicate/distributed/noise.rkt
+++ b/syndicate/distributed/noise.rkt
@ -49,21 +49,17 @@
          (lambda (set-peer-session! handle-message)
            (at acceptor-ref
              (assert (Resolve (Step (NoiseStepType) service-selector)
-                               (object #:name 'noise-observer
+                               (object #:name 'noise-initiator
                                       [#:asserted (Resolved-accepted responder-session)
-                                        (at responder-session
-                                          (assert (Initiator
-                                                   (object #:name 'noise-initiator
-                                                           [#:message m
-                                                            (handle-message m)]))))
                                        (set-peer-session! responder-session)
                                        #:retracted
-                                        (stop-current-facet)])))))))
+                                        (stop-current-facet)]
+                                       [#:message m (handle-message m)])))))))

 (define (noise-responder #:service-selector service-selector
                         #:static-keypair static-keypair
                         #:export initial-ref
-                         #:observer observer
+                         #:initiator-session initiator-session
                         #:preshared-keys [psks #f]
                         #:pattern [pattern #f])
  (noise* #:role 'responder
@ -73,15 +69,11 @@
          #:preshared-keys psks
          #:pattern pattern
          (lambda (set-peer-session! handle-message)
-            (at observer
+            (set-peer-session! initiator-session)
+            (at initiator-session
              (assert (Resolved-accepted
-                       (object #:name (list 'noise-responder initial-ref observer)
-                               [#:asserted (Initiator s)
-                                (set-peer-session! s)
-                                #:retracted
-                                (stop-current-facet)]
-                               [#:message m
-                                (handle-message m)])))))))
+                       (object #:name (list 'noise-responder initial-ref initiator-session)
+                               [#:message m (handle-message m)])))))))

 (define (noise* #:role role
                #:service-selector service-selector
@ -135,7 +127,6 @@
                (handshake-step))))))

  (define (set-peer-session! session)
-    (when peer-session (error 'noise* "Double-setting of peer-session"))
    (set! peer-session session)
    (when (eq? role 'initiator) (handshake-step)))

@ -143,15 +134,12 @@

 (module+ test
  (require libsodium)
-
-  (when (file-stream-buffer-mode (current-output-port))
-    ;; ^ Only try to set it if we get a non-#f answer when we ask for it
-    (file-stream-buffer-mode (current-output-port) 'none))
+  (file-stream-buffer-mode (current-output-port) 'none)

  (standard-actor-system (ds)
-    (define server-keys (make-crypto-box-keypair))
+    (spawn #:name 'test-main
+           (define server-keys (make-crypto-box-keypair))

-    (spawn #:name 'test-responder
           (define service-object
             (object [a
                      (printf "service+: ~v\n" a)
@ -161,13 +149,12 @@
                      (stop-current-facet)]))

           (at ds
-             (during (Resolve (Step (NoiseStepType) 'test-service) $observer)
+             (during (Resolve (Step (NoiseStepType) 'test-service) $initiator-session)
               (noise-responder #:service-selector 'test-service
                                #:static-keypair server-keys
-                                #:observer observer
-                                #:export service-object))))
+                                #:initiator-session initiator-session
+                                #:export service-object)))

-    (spawn #:name 'test-initiator
           (noise-initiator #:service-selector 'test-service
                            #:remote-static-pk (crypto-box-keypair-pk server-keys)
                            #:acceptor-ref ds
--- a/syndicate/drivers/http.rkt
+++ b/syndicate/drivers/http.rkt
@ -44,8 +44,6 @@

 (define-logger syndicate/drivers/http)

-(struct active-handler (ref signal) #:transparent)
-
 (provide-service [ds]
  (at ds
      (during/spawn (HttpBinding _ $port _ _ _)
@ -61,11 +59,8 @@
              (define handler-set (hash-ref! method-map method mutable-set))
              (unless (set-empty? handler-set)
                (log-syndicate/drivers/http-warning "Multiple active handlers for ~v" service))
-              (define-field handler-terminated? #f)
-              (define entry (active-handler handler handler-terminated?))
-              (set-add! handler-set entry)
-              (on-stop (handler-terminated? #t)
-                       (set-remove! handler-set entry)
+              (set-add! handler-set handler)
+              (on-stop (set-remove! handler-set handler)
                       (when (set-empty? handler-set) (hash-remove! method-map method))
                       (when (hash-empty? method-map) (hash-remove! pattern-map path))
                       (when (hash-empty? pattern-map) (hash-remove! routes host)))
@ -105,7 +100,7 @@
         (with-handlers ([exn:fail? (lambda (e) (values #f #t))])
           (read-request conn port tcp-addresses)))
       (when req
-         ;; (log-syndicate/drivers/http-debug "~v ~v ~v ~v" connection-name routes req close?)
+         ;; (log-syndicate/drivers/http-debug "~v ~v ~v ~v ~v" connection-name routes req close?)
         (define continue-ch (make-async-channel))
         (turn! facet
                (lambda ()
@ -197,73 +192,48 @@
                                                             (list (header #"Allow" methods))
                                                             (list)))
                                    (return (void)))))
-          (match-define (active-handler handler handler-terminated?) (set-first handler-set))
-          (define processing #f)
-          (define pending-code 500)
-          (define pending-message "Internal Server Error")
+          (define handler (set-first handler-set))
+          (define pending-code #f)
+          (define pending-message #f)
          (define pending-headers-rev '())
          (define chunk-ch #f)
-
-          (define (check-processing!)
-            (unless processing
-              (error 'HttpResponse "Attempt to reply before <processing> has been asserted")))
-
-          (define (send-headers!)
-            (unless chunk-ch
-              (set! chunk-ch (make-async-channel))
-              (thread
-               (lambda ()
-                 (output-response/method conn
-                                         (response pending-code
+          (define res (object #:name connection-name
+                              [#:message (HttpResponse-status code message)
+                               (set! pending-code code)
+                               (set! pending-message message)]
+                              [#:message (HttpResponse-header name value)
+                               (set! pending-headers-rev (cons (cons name value) pending-headers-rev))]
+                              [#:message (HttpResponse-chunk chunk)
+                               (unless chunk-ch
+                                 (set! chunk-ch (make-async-channel))
+                                 (output-response/method
+                                  conn
+                                  (response pending-code
+                                            (string->bytes/utf-8 pending-message)
+                                            (current-seconds)
+                                            #f
+                                            (build-headers (reverse pending-headers-rev))
+                                            (lambda (output-port)
+                                              (let loop ()
+                                                (match (async-channel-get chunk-ch)
+                                                  [#f (void)]
+                                                  [bs (write-bytes bs output-port) (loop)]))))
+                                  (request-method req)))
+                               (async-channel-put chunk-ch (chunk->bytes chunk))]
+                              [#:message (HttpResponse-done chunk)
+                               (if chunk-ch
+                                   (begin (async-channel-put chunk-ch (chunk->bytes chunk))
+                                          (async-channel-put chunk-ch #f))
+                                   (output-response/method
+                                    conn
+                                    (response/full pending-code
                                                   (string->bytes/utf-8 pending-message)
                                                   (current-seconds)
                                                   #f
                                                   (build-headers (reverse pending-headers-rev))
-                                                   (lambda (output-port)
-                                                     (let loop ()
-                                                       (match (async-channel-get chunk-ch)
-                                                         [#f (void)]
-                                                         [bs
-                                                          (write-bytes bs output-port)
-                                                          (flush-output output-port)
-                                                          (loop)]))))
-                                         (request-method req))))))
-
-          (define (finish-request!)
-            (send-headers!)
-            (async-channel-put chunk-ch #f)
-            (stop-current-facet))
-
-          (begin/dataflow
-            (when (handler-terminated?)
-              (finish-request!)))
-
-          (define res (object #:name connection-name
-                              [#:asserted (HttpResponse-processing)
-                               (log-syndicate/drivers/http-debug "~v: +processing" connection-name)
-                               (set! processing #t)
-                               (set! pending-code 200)
-                               (set! pending-message "OK")
-                               #:retracted
-                               (log-syndicate/drivers/http-debug "~v: -processing" connection-name)
-                               (finish-request!)]
-                              [#:message (HttpResponse-status code message)
-                               (log-syndicate/drivers/http-debug "~v: status ~v ~v" connection-name
-                                                                 code message)
-                               (check-processing!)
-                               (set! pending-code code)
-                               (set! pending-message message)]
-                              [#:message (HttpResponse-header name value)
-                               (log-syndicate/drivers/http-debug "~v: header ~v ~v" connection-name
-                                                                 name value)
-                               (check-processing!)
-                               (set! pending-headers-rev (cons (cons name value) pending-headers-rev))]
-                              [#:message (HttpResponse-body chunk)
-                               (log-syndicate/drivers/http-debug "~v: chunk ~v" connection-name
-                                                                 chunk)
-                               (check-processing!)
-                               (send-headers!)
-                               (async-channel-put chunk-ch (chunk->bytes chunk))]))
+                                                   (list (chunk->bytes chunk)))
+                                    (request-method req)))
+                               (stop-current-facet)]))
          (at handler (assert (HttpContext decoded-req res)))
          (return (void)))))

@ -313,11 +283,14 @@
           (lambda () method)
           (lambda () (quote-path-pattern () (path-pattern-element ...)))
           (lambda (req res)
-             (at res (assert (HttpResponse-processing)))
             (match (HttpRequest-path req)
               [#,(match-quote-path-pattern #'(path-pattern-element ...))
-                (async (match (let () body ...)
-                         [(mime (? symbol? type) (or (? bytes? data) (? string? data)))
+                (async (match (with-handlers [((lambda (e) #t)
+                                               (lambda (e)
+                                                 (send-http-response! res 500 "Internal Server Error")
+                                                 (raise e)))]
+                                (let () body ...))
+                         [(mime (? symbol? type) (? bytes? data))
                          (log-syndicate/drivers/http-debug "REPLY: ~a ~v" type data)
                          (send-http-response! res 200 "OK" #:mime-type type data)]
                         [(? void?)
@ -325,8 +298,7 @@
                         [bad
                          (log-syndicate/drivers/http-error "Bad MIME response: ~v" bad)
                          (send-http-response! res 500 "Internal Server Error")]))]
-               [_ (send-http-response! res 400 "Bad request path")])
-             (stop-current-facet))))])))
+               [_ (send-http-response! res 400 "Bad request path")]))))])))

 (define (define-http-route* ds host port method path-pattern handler)
  (at ds
@ -390,7 +362,11 @@
  (for [(header headers)]
    (match-define (cons name value) header)
    (send! res (HttpResponse-header name value)))
-  (for [(chunk chunks)] (send! res (HttpResponse-body chunk))))
+  (let loop ((chunks chunks))
+    (cond [(null? chunks) (send! res (HttpResponse-done ""))]
+          [(null? (cdr chunks)) (send! res (HttpResponse-done (car chunks)))]
+          [else (send! res (HttpResponse-chunk (car chunks))) (loop (cdr chunks))]))
+  (void))

 ;;---------------------------------------------------------------------------

--- a/syndicate/drivers/racket-event.rkt
+++ b/syndicate/drivers/racket-event.rkt
@ -14,7 +14,7 @@

 (provide-service [ds]
  (at ds
-    (during/spawn (Observe (:pattern (RacketEvent ,(Pattern-lit $embedded-event) ,_)) _)
+    (during/spawn (Observe (:pattern (RacketEvent ,(DLit $embedded-event) ,_)) _)
      #:name (embedded-value embedded-event)
      (define event (embedded-value embedded-event))
      (linked-thread
--- a/syndicate/drivers/tcp.rkt
+++ b/syndicate/drivers/tcp.rkt
@ -23,7 +23,7 @@
  (with-services [syndicate/drivers/stream]
    (at ds
      (during/spawn
-          (Observe (:pattern (StreamConnection ,_ ,_ (TcpLocal ,(Pattern-lit $host) ,(Pattern-lit $port)))) _)
+          (Observe (:pattern (StreamConnection ,_ ,_ (TcpLocal ,(DLit $host) ,(DLit $port)))) _)
        #:name (TcpLocal host port)
        (run-listener ds host port))

--- a/syndicate/drivers/timer.rkt
+++ b/syndicate/drivers/timer.rkt
@ -88,7 +88,7 @@
      (log-syndicate/drivers/timer-debug "received instruction ~a" instruction)
      (channel-put control-ch instruction))

-    (during (Observe (:pattern (LaterThan ,(Pattern-lit $seconds))) _)
+    (during (Observe (:pattern (LaterThan ,(DLit $seconds))) _)
      (log-syndicate/drivers/timer-debug "observing (later-than ~a) at ~a"
                                         seconds
                                         (/ (current-inexact-milliseconds) 1000.0))
--- a/syndicate/pattern.rkt
+++ b/syndicate/pattern.rkt
@ -13,10 +13,8 @@
         :pattern
         :parse

-         pattern->shape
         pattern->constant-values
         pattern->constant-paths
-         pattern->check-paths
         pattern->capture-paths

         !dump-registered-preserves-patterns!
@ -182,14 +180,14 @@

        [id
         (dollar-id? #'id)
-         (transform-binding (undollar #'id) #`(Pattern-bind (Pattern-discard)))]
+         (transform-binding (undollar #'id) #`(Pattern-DBind (DBind (Pattern-DDiscard (DDiscard)))))]

        [($ id p)
-         (transform-binding #'id #`(Pattern-bind #,(walk #'p)))]
+         (transform-binding #'id #`(Pattern-DBind (DBind #,(walk #'p))))]

        [id
         (discard-id? #'id)
-         #`(Pattern-discard)]
+         #`(Pattern-DDiscard (DDiscard))]

        [(c l (list-stx piece ...))
         (and (id=? #'rec #'c)
@ -381,55 +379,36 @@

 ;;---------------------------------------------------------------------------

-(define (pattern->shape desc)
+(define (select-pattern-leaves desc capture-fn lit-fn)
  (let walk-node ((key-rev '()) (desc desc))
    (match desc
-      [(Pattern-group type entries)
-       (append* (list (cons (reverse key-rev) type))
-                (for/list [((key subdesc) (in-hash entries))]
+      [(Pattern-DCompound (or (DCompound-rec _ fields)
+                              (DCompound-arr fields)))
+       (append* (for/list [(key (in-naturals)) (subdesc (in-list fields))]
                  (walk-node (cons key key-rev) subdesc)))]
-      [(Pattern-bind subdesc)
-       (walk-node key-rev subdesc)]
-      [(Pattern-discard)
-       '()]
-      [(Pattern-lit value)
-       '()])))
-
-(define (select-pattern-leaves desc capture-fn discard-fn lit-fn)
-  (let walk-node ((key-rev '()) (desc desc))
-    (match desc
-      [(Pattern-group _type entries)
+      [(Pattern-DCompound (DCompound-dict entries))
       (append* (for/list [((key subdesc) (in-hash entries))]
                  (walk-node (cons key key-rev) subdesc)))]
-      [(Pattern-bind subdesc)
+      [(Pattern-DBind (DBind subdesc))
       (append (capture-fn key-rev) (walk-node key-rev subdesc))]
-      [(Pattern-discard)
-       (discard-fn key-rev)]
-      [(Pattern-lit value)
+      [(Pattern-DDiscard (DDiscard))
+       '()]
+      [(Pattern-DLit (DLit value))
       (lit-fn key-rev (->preserve value))])))

 (define (pattern->constant-values desc)
  (select-pattern-leaves desc
-                         (lambda (key-rev) (list))
                         (lambda (key-rev) (list))
                         (lambda (key-rev value) (list value))))

 (define (pattern->constant-paths desc)
  (select-pattern-leaves desc
-                         (lambda (key-rev) (list))
                         (lambda (key-rev) (list))
                         (lambda (key-rev value) (list (reverse key-rev)))))

-(define (pattern->check-paths desc)
-  (select-pattern-leaves desc
-                         (lambda (key-rev) (list))
-                         (lambda (key-rev) (list (reverse key-rev)))
-                         (lambda (key-rev value) (list))))
-
 (define (pattern->capture-paths desc)
  (select-pattern-leaves desc
                         (lambda (key-rev) (list (reverse key-rev)))
-                         (lambda (key-rev) (list))
                         (lambda (key-rev value) (list))))

 (define-syntax (!dump-registered-preserves-patterns! stx)
--- a/syndicate/private/protocols/schema-bundle.bin
+++ b/syndicate/private/protocols/schema-bundle.bin
@ -4,15 +4,13 @@ ByteString
 QueryValue´³orµµ±string´³atom³String„„µ±file´³rec´³lit³file„´³tupleµ´³named³filename´³atom³String„„´³named³headers´³refµ„³Headers„„´³named³body´³atom³
 ByteString„„„„„„„„³HostPattern´³orµµ±host´³atom³String„„µ±any´³lit€„„„„³HttpBinding´³rec´³lit³	http-bind„´³tupleµ´³named³host´³refµ„³HostPattern„„´³named³port´³atom³
SignedInteger„„´³named³method´³refµ„³
MethodPattern„„´³named³path´³refµ„³PathPattern„„´³named³handler´³embedded´³refµ„³HttpRequest„„„„„„³HttpContext´³rec´³lit³request„´³tupleµ´³named³req´³refµ„³HttpRequest„„´³named³res´³embedded´³refµ„³HttpResponse„„„„„„³HttpRequest´³rec´³lit³http-request„´³tupleµ´³named³sequenceNumber´³atom³
SignedInteger„„´³named³host´³atom³String„„´³named³port´³atom³
SignedInteger„„´³named³method´³atom³Symbol„„´³named³path´³seqof´³atom³String„„„´³named³headers´³refµ„³Headers„„´³named³query´³dictof´³atom³Symbol„´³seqof´³refµ„³
 QueryValue„„„„´³named³body´³refµ„³RequestBody„„„„„³HttpService´³rec´³lit³http-service„´³tupleµ´³named³host´³refµ„³HostPattern„„´³named³port´³atom³
SignedInteger„„´³named³method´³refµ„³
MethodPattern„„´³named³path´³refµ„³PathPattern„„„„„³PathPattern´³seqof´³refµ„³PathPatternElement„„³RequestBody´³orµµ±present´³atom³
-ByteString„„µ±absent´³lit€„„„„³HttpListener´³rec´³lit³
http-listener„´³tupleµ´³named³port´³atom³
SignedInteger„„„„„³HttpResponse´³orµµ±
-processing´³rec´³lit³
-processing„´³tupleµ„„„„µ±status´³rec´³lit³status„´³tupleµ´³named³code´³atom³
SignedInteger„„´³named³message´³atom³String„„„„„„µ±header´³rec´³lit³header„´³tupleµ´³named³name´³atom³Symbol„„´³named³value´³atom³String„„„„„„µ±body´³rec´³lit³body„´³tupleµ´³named³chunk´³refµ„³Chunk„„„„„„„„³
MethodPattern´³orµµ±any´³lit€„„µ±specific´³atom³Symbol„„„„³PathPatternElement´³orµµ±label´³atom³String„„µ±wildcard´³lit³_„„µ±rest´³lit³...„„„„„³embeddedType€„„µ³noise„´³schema·³version°³definitions·³Packet´³orµµ±complete´³atom³
+ByteString„„µ±absent´³lit€„„„„³HttpListener´³rec´³lit³
http-listener„´³tupleµ´³named³port´³atom³
SignedInteger„„„„„³HttpResponse´³orµµ±status´³rec´³lit³status„´³tupleµ´³named³code´³atom³
SignedInteger„„´³named³message´³atom³String„„„„„„µ±header´³rec´³lit³header„´³tupleµ´³named³name´³atom³Symbol„„´³named³value´³atom³String„„„„„„µ±chunk´³rec´³lit³chunk„´³tupleµ´³named³chunk´³refµ„³Chunk„„„„„„µ±done´³rec´³lit³done„´³tupleµ´³named³chunk´³refµ„³Chunk„„„„„„„„³
MethodPattern´³orµµ±any´³lit€„„µ±specific´³atom³Symbol„„„„³PathPatternElement´³orµµ±label´³atom³String„„µ±wildcard´³lit³_„„µ±rest´³lit³...„„„„„³embeddedType€„„µ³noise„´³schema·³version°³definitions·³Packet´³orµµ±complete´³atom³
 ByteString„„µ±
 fragmented´³seqof´³atom³
-ByteString„„„„„³	Initiator´³rec´³lit³	initiator„´³tupleµ´³named³initiatorSession´³embedded´³refµ„³Packet„„„„„„³	NoiseSpec´³andµ´³dict·³key´³named³key´³atom³
-ByteString„„³service´³named³service´³refµ„³ServiceSelector„„„„´³named³protocol´³refµ„³
NoiseProtocol„„´³named³
preSharedKeys´³refµ„³NoisePreSharedKeys„„„„³SessionItem´³orµµ±	Initiator´³refµ„³	Initiator„„µ±Packet´³refµ„³Packet„„„„³
NoiseProtocol´³orµµ±present´³dict·³protocol´³named³protocol´³atom³String„„„„„µ±invalid´³dict·³protocol´³named³protocol³any„„„„µ±absent´³dict·„„„„„³
NoiseStepType´³lit³noise„³SecretKeyField´³orµµ±present´³dict·³	secretKey´³named³	secretKey´³atom³
+ByteString„„„„„³	NoiseSpec´³andµ´³dict·³key´³named³key´³atom³
+ByteString„„³service´³named³service´³refµ„³ServiceSelector„„„„´³named³protocol´³refµ„³
NoiseProtocol„„´³named³
preSharedKeys´³refµ„³NoisePreSharedKeys„„„„³
NoiseProtocol´³orµµ±present´³dict·³protocol´³named³protocol´³atom³String„„„„„µ±invalid´³dict·³protocol´³named³protocol³any„„„„µ±absent´³dict·„„„„„³
NoiseStepType´³lit³noise„³SecretKeyField´³orµµ±present´³dict·³	secretKey´³named³	secretKey´³atom³
 ByteString„„„„„µ±invalid´³dict·³	secretKey´³named³	secretKey³any„„„„µ±absent´³dict·„„„„„³DefaultProtocol´³lit±!Noise_NK_25519_ChaChaPoly_BLAKE2s„³NoiseStepDetail´³refµ„³ServiceSelector„³ServiceSelector³any³NoiseServiceSpec´³andµ´³named³base´³refµ„³	NoiseSpec„„´³named³	secretKey´³refµ„³SecretKeyField„„„„³NoisePreSharedKeys´³orµµ±present´³dict·³
preSharedKeys´³named³
preSharedKeys´³seqof´³atom³
-ByteString„„„„„„µ±invalid´³dict·³
preSharedKeys´³named³
preSharedKeys³any„„„„µ±absent´³dict·„„„„„³NoisePathStepDetail´³refµ„³	NoiseSpec„³NoiseDescriptionDetail´³refµ„³NoiseServiceSpec„„³embeddedType´³refµ³	EntityRef„³Cap„„„µ³timer„´³schema·³version°³definitions·³SetTimer´³rec´³lit³	set-timer„´³tupleµ´³named³label³any„´³named³seconds´³atom³Double„„´³named³kind´³refµ„³	TimerKind„„„„„³	LaterThan´³rec´³lit³
+ByteString„„„„„„µ±invalid´³dict·³
preSharedKeys´³named³
preSharedKeys³any„„„„µ±absent´³dict·„„„„„³NoisePathStepDetail´³refµ„³	NoiseSpec„³NoiseDescriptionDetail´³refµ„³NoiseServiceSpec„„³embeddedType€„„µ³timer„´³schema·³version°³definitions·³SetTimer´³rec´³lit³	set-timer„´³tupleµ´³named³label³any„´³named³seconds´³atom³Double„„´³named³kind´³refµ„³	TimerKind„„„„„³	LaterThan´³rec´³lit³
 later-than„´³tupleµ´³named³seconds´³atom³Double„„„„„³	TimerKind´³orµµ±relative´³lit³relative„„µ±absolute´³lit³absolute„„µ±clear´³lit³clear„„„„³TimerExpired´³rec´³lit³
timer-expired„´³tupleµ´³named³label³any„´³named³seconds´³atom³Double„„„„„„³embeddedType€„„µ³trace„´³schema·³version°³definitions·³Oid³any³Name´³orµµ±	anonymous´³rec´³lit³	anonymous„´³tupleµ„„„„µ±named´³rec´³lit³named„´³tupleµ´³named³name³any„„„„„„„³Target´³rec´³lit³entity„´³tupleµ´³named³actor´³refµ„³ActorId„„´³named³facet´³refµ„³FacetId„„´³named³oid´³refµ„³Oid„„„„„³TaskId³any³TurnId³any³ActorId³any³FacetId³any³	TurnCause´³orµµ±turn´³rec´³lit³	caused-by„´³tupleµ´³named³id´³refµ„³TurnId„„„„„„µ±cleanup´³rec´³lit³cleanup„´³tupleµ„„„„µ±linkedTaskRelease´³rec´³lit³linked-task-release„´³tupleµ´³named³id´³refµ„³TaskId„„´³named³reason´³refµ„³LinkedTaskReleaseReason„„„„„„µ±periodicActivation´³rec´³lit³periodic-activation„´³tupleµ´³named³period´³atom³Double„„„„„„µ±delay´³rec´³lit³delay„´³tupleµ´³named³causingTurn´³refµ„³TurnId„„´³named³amount´³atom³Double„„„„„„µ±external´³rec´³lit³external„´³tupleµ´³named³description³any„„„„„„„³	TurnEvent´³orµµ±assert´³rec´³lit³assert„´³tupleµ´³named³	assertion´³refµ„³AssertionDescription„„´³named³handle´³refµ³protocol„³Handle„„„„„„µ±retract´³rec´³lit³retract„´³tupleµ´³named³handle´³refµ³protocol„³Handle„„„„„„µ±message´³rec´³lit³message„´³tupleµ´³named³body´³refµ„³AssertionDescription„„„„„„µ±sync´³rec´³lit³sync„´³tupleµ´³named³peer´³refµ„³Target„„„„„„µ±	breakLink´³rec´³lit³
 break-link„´³tupleµ´³named³source´³refµ„³ActorId„„´³named³handle´³refµ³protocol„³Handle„„„„„„„„³
 ExitStatus´³orµµ±ok´³lit³ok„„µ±Error´³refµ³protocol„³Error„„„„³
@ -42,5 +40,5 @@ ByteString
 RunService´³rec´³lit³run-service„´³tupleµ´³named³serviceName³any„„„„³ServiceState´³rec´³lit³
service-state„´³tupleµ´³named³serviceName³any„´³named³state´³refµ„³State„„„„„³
ServiceObject´³rec´³lit³service-object„´³tupleµ´³named³serviceName³any„´³named³object³any„„„„³RequireService´³rec´³lit³require-service„´³tupleµ´³named³serviceName³any„„„„³RestartService´³rec´³lit³restart-service„´³tupleµ´³named³serviceName³any„„„„³ServiceDependency´³rec´³lit³
 depends-on„´³tupleµ´³named³depender³any„´³named³dependee´³refµ„³ServiceState„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„µ³protocol„´³schema·³version°³definitions·³Oid´³atom³
SignedInteger„³Sync´³rec´³lit³S„´³tupleµ´³named³peer´³embedded´³lit<69>„„„„„„³Turn´³seqof´³refµ„³	TurnEvent„„³Error´³rec´³lit³error„´³tupleµ´³named³message´³atom³String„„´³named³detail³any„„„„³Event´³orµµ±Assert´³refµ„³Assert„„µ±Retract´³refµ„³Retract„„µ±Message´³refµ„³Message„„µ±Sync´³refµ„³Sync„„„„³Assert´³rec´³lit³A„´³tupleµ´³named³	assertion´³refµ„³	Assertion„„´³named³handle´³refµ„³Handle„„„„„³Handle´³atom³
SignedInteger„³Packet´³orµµ±Turn´³refµ„³Turn„„µ±Error´³refµ„³Error„„µ±	Extension´³refµ„³	Extension„„„„³Message´³rec´³lit³M„´³tupleµ´³named³body´³refµ„³	Assertion„„„„„³Retract´³rec´³lit³R„´³tupleµ´³named³handle´³refµ„³Handle„„„„„³	Assertion³any³	Extension´³rec´³named³label³any„´³named³fields´³seqof³any„„„³	TurnEvent´³tupleµ´³named³oid´³refµ„³Oid„„´³named³event´³refµ„³Event„„„„„³embeddedType€„„µ³	dataspace„´³schema·³version°³definitions·³Observe´³rec´³lit³Observe„´³tupleµ´³named³pattern´³refµ³dataspacePatterns„³Pattern„„´³named³observer´³embedded³any„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„µ³
 gatekeeper„´³schema·³version°³definitions·³Bind´³rec´³lit³bind„´³tupleµ´³named³description´³refµ„³Description„„´³named³target´³embedded³any„„´³named³observer´³refµ„³BindObserver„„„„„³Step´³rec´³named³stepType´³atom³Symbol„„´³tupleµ´³named³detail³any„„„„³Bound´³orµµ±bound´³rec´³lit³bound„´³tupleµ´³named³pathStep´³refµ„³PathStep„„„„„„µ±Rejected´³refµ„³Rejected„„„„³Route´³rec´³lit³route„´³tuplePrefixµ´³named³
-transports´³seqof³any„„„´³named³	pathSteps´³seqof´³refµ„³PathStep„„„„„³Resolve´³rec´³lit³resolve„´³tupleµ´³named³step´³refµ„³Step„„´³named³observer´³embedded´³refµ„³Resolved„„„„„„³PathStep´³rec´³named³stepType´³atom³Symbol„„´³tupleµ´³named³detail³any„„„„³Rejected´³rec´³lit³rejected„´³tupleµ´³named³detail³any„„„„³Resolved´³orµµ±accepted´³rec´³lit³accepted„´³tupleµ´³named³responderSession´³embedded³any„„„„„„µ±Rejected´³refµ„³Rejected„„„„³Description´³rec´³named³stepType´³atom³Symbol„„´³tupleµ´³named³detail³any„„„„³ResolvePath´³rec´³lit³resolve-path„´³tupleµ´³named³route´³refµ„³Route„„´³named³addr³any„´³named³control´³embedded´³refµ„³TransportControl„„„´³named³resolved´³refµ„³Resolved„„„„„³BindObserver´³orµµ±present´³embedded´³refµ„³Bound„„„µ±absent´³lit€„„„„³ForceDisconnect´³rec´³lit³force-disconnect„´³tupleµ„„„³ResolvedPathStep´³rec´³lit³	path-step„´³tupleµ´³named³origin´³embedded´³refµ„³Resolve„„„´³named³pathStep´³refµ„³PathStep„„´³named³resolved´³refµ„³Resolved„„„„„³TransportControl´³refµ„³ForceDisconnect„³TransportConnection´³rec´³lit³connect-transport„´³tupleµ´³named³addr³any„´³named³control´³embedded´³refµ„³TransportControl„„„´³named³resolved´³refµ„³Resolved„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„µ³transportAddress„´³schema·³version°³definitions·³Tcp´³rec´³lit³tcp„´³tupleµ´³named³host´³atom³String„„´³named³port´³atom³
SignedInteger„„„„„³Unix´³rec´³lit³unix„´³tupleµ´³named³path´³atom³String„„„„„³Stdio´³rec´³lit³stdio„´³tupleµ„„„³	WebSocket´³rec´³lit³ws„´³tupleµ´³named³url´³atom³String„„„„„„³embeddedType€„„µ³dataspacePatterns„´³schema·³version°³definitions·³AnyAtom´³orµµ±bool´³atom³Boolean„„µ±double´³atom³Double„„µ±int´³atom³
SignedInteger„„µ±string´³atom³String„„µ±bytes´³atom³
-ByteString„„µ±symbol´³atom³Symbol„„µ±embedded´³embedded³any„„„„³Pattern´³orµµ±discard´³rec´³lit³_„´³tupleµ„„„„µ±bind´³rec´³lit³bind„´³tupleµ´³named³pattern´³refµ„³Pattern„„„„„„µ±lit´³rec´³lit³lit„´³tupleµ´³named³value´³refµ„³AnyAtom„„„„„„µ±group´³rec´³lit³group„´³tupleµ´³named³type´³refµ„³	GroupType„„´³named³entries´³dictof³any´³refµ„³Pattern„„„„„„„„„³	GroupType´³orµµ±rec´³rec´³lit³rec„´³tupleµ´³named³label³any„„„„„µ±arr´³rec´³lit³arr„´³tupleµ„„„„µ±dict´³rec´³lit³dict„´³tupleµ„„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„„„
+transports´³seqof³any„„„´³named³	pathSteps´³seqof´³refµ„³PathStep„„„„„³Resolve´³rec´³lit³resolve„´³tupleµ´³named³step´³refµ„³Step„„´³named³observer´³embedded´³refµ„³Resolved„„„„„„³PathStep´³rec´³named³stepType´³atom³Symbol„„´³tupleµ´³named³detail³any„„„„³Rejected´³rec´³lit³rejected„´³tupleµ´³named³detail³any„„„„³Resolved´³orµµ±accepted´³rec´³lit³accepted„´³tupleµ´³named³responderSession´³embedded³any„„„„„„µ±Rejected´³refµ„³Rejected„„„„³Description´³rec´³named³stepType´³atom³Symbol„„´³tupleµ´³named³detail³any„„„„³ResolvePath´³rec´³lit³resolve-path„´³tupleµ´³named³route´³refµ„³Route„„´³named³addr³any„´³named³control´³embedded´³refµ„³TransportControl„„„´³named³resolved´³refµ„³Resolved„„„„„³BindObserver´³orµµ±present´³embedded´³refµ„³Bound„„„µ±absent´³lit€„„„„³ForceDisconnect´³rec´³lit³force-disconnect„´³tupleµ„„„³ResolvedPathStep´³rec´³lit³	path-step„´³tupleµ´³named³origin´³embedded´³refµ„³Resolve„„„´³named³pathStep´³refµ„³PathStep„„´³named³resolved´³refµ„³Resolved„„„„„³TransportControl´³refµ„³ForceDisconnect„³TransportConnection´³rec´³lit³connect-transport„´³tupleµ´³named³addr³any„´³named³control´³embedded´³refµ„³TransportControl„„„´³named³resolved´³refµ„³Resolved„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„µ³transportAddress„´³schema·³version°³definitions·³Tcp´³rec´³lit³tcp„´³tupleµ´³named³host´³atom³String„„´³named³port´³atom³
SignedInteger„„„„„³Unix´³rec´³lit³unix„´³tupleµ´³named³path´³atom³String„„„„„³Stdio´³rec´³lit³stdio„´³tupleµ„„„³	WebSocket´³rec´³lit³ws„´³tupleµ´³named³url´³atom³String„„„„„„³embeddedType€„„µ³dataspacePatterns„´³schema·³version°³definitions·³DLit´³rec´³lit³lit„´³tupleµ´³named³value´³refµ„³AnyAtom„„„„„³DBind´³rec´³lit³bind„´³tupleµ´³named³pattern´³refµ„³Pattern„„„„„³AnyAtom´³orµµ±bool´³atom³Boolean„„µ±double´³atom³Double„„µ±int´³atom³
SignedInteger„„µ±string´³atom³String„„µ±bytes´³atom³
+ByteString„„µ±symbol´³atom³Symbol„„µ±embedded´³embedded³any„„„„³Pattern´³orµµ±DDiscard´³refµ„³DDiscard„„µ±DBind´³refµ„³DBind„„µ±DLit´³refµ„³DLit„„µ±	DCompound´³refµ„³	DCompound„„„„³DDiscard´³rec´³lit³_„´³tupleµ„„„³	DCompound´³orµµ±rec´³rec´³lit³rec„´³tupleµ´³named³label³any„´³named³fields´³seqof´³refµ„³Pattern„„„„„„„µ±arr´³rec´³lit³arr„´³tupleµ´³named³items´³seqof´³refµ„³Pattern„„„„„„„µ±dict´³rec´³lit³dict„´³tupleµ´³named³entries´³dictof³any´³refµ„³Pattern„„„„„„„„„„³embeddedType´³refµ³	EntityRef„³Cap„„„„„
--- a/syndicate/private/protocols/schemas/dataspacePatterns.prs
+++ b/syndicate/private/protocols/schemas/dataspacePatterns.prs
@ -1,23 +1,15 @@
 version 1 .
 embeddedType EntityRef.Cap .

-# Dataspace patterns: *almost* a sublanguage of attenuation patterns.
-#
-# One key difference is that Dataspace patterns are extensible, in that
-# they ignore fields not mentioned in group patterns.
+# Dataspace patterns: a sublanguage of attenuation patterns.
+Pattern = DDiscard / DBind / DLit / DCompound .

-Pattern =
-    / @discard <_>
-    / <bind @pattern Pattern>
-    / <lit @value AnyAtom>
-    / <group @type GroupType @entries { any: Pattern ...:... }>
-.
-
-GroupType =
-    / <rec @label any>
-    / <arr>
-    / <dict>
-.
+DDiscard = <_>.
+DBind = <bind @pattern Pattern>.
+DLit = <lit @value AnyAtom>.
+DCompound = <rec @label any @fields [Pattern ...]>
+          / <arr @items [Pattern ...]>
+          / <dict @entries { any: Pattern ...:... }> .

 AnyAtom =
    / @bool bool
--- a/syndicate/private/protocols/schemas/gatekeeper.prs
+++ b/syndicate/private/protocols/schemas/gatekeeper.prs
@ -13,37 +13,8 @@ Step = <<rec> @stepType symbol [@detail any]> .
 # ---------------------------------------------------------------------------
 # Protocol at dataspaces *associated* with gatekeeper entities

-# ## Handling `Resolve` requests
-#
-# When the gatekeeper entity receives a `Resolve` assertion (call it R1), it
-#
-#  1. asserts a `Resolve` (call it R2) into its associated dataspace that
-#     is the same as R1 except it has a different `observer`; and
-#
-#  2. observes a `Bind` with `description` matching the `step` of R1/R2
-#     according to `stepType` (e.g. treatment of SturdyStepType is not the
-#     same as treatment of NoiseStepType).
-#
-# Normally, an appropriate `Bind` is expected to exist. If the gatekeeper
-# sees the `Bind` first, it takes the `target` from it and does whatever
-# `stepType` mandates before replying to R1's observer.
-#
-# However, if a `Resolved` is asserted to R2's observer before a `Bind`
-# appears, that resolution is relayed on to R1's observer directly, be it
-# positive or negative, and the gatekeeper stops waiting for a `Bind`.
-#
-# This way, entities can keep an eye out for `Resolve` requests that will
-# never complete, and answer `Rejected` to them even when no matching
-# `Bind` exists. Entities could also use `Resolve` requests to synthesize a
-# `Bind` in a "just-in-time" fashion.
-#
-# ## General treatment of `Bind` assertions
-#
-# When the gatekeeper sees a `Bind`, independently of any potential
-# `Resolve` requests, it computes an appropriate PathStep from
-# `description` pointing at `target`, and responds with a `Bound` to
-# `observer` (if supplied).
-#
+# Assertion. Gatekeeper will compute an appropriate PathStep from `description` pointing at
+# `target`, and will respond with a `Bound` to `observer` (if supplied).
 Bind = <bind @description Description @target #:any @observer BindObserver> .
 Description = <<rec> @stepType symbol [@detail any]> .
 BindObserver = @present #:Bound / @absent #f .
--- a/syndicate/private/protocols/schemas/http.prs
+++ b/syndicate/private/protocols/schemas/http.prs
@ -39,13 +39,10 @@ HttpContext = <request @req HttpRequest @res #:HttpResponse> .
@<TODO "trailers?">
 # Messages
 HttpResponse =
-# Assertion - frames the response. When retracted, response is considered complete.
-# If retracted before `status` is delivered, response is considered a 500.
-/ <processing>
-# Remainder are messages: +processing . (status | header)* . body* . -processing
 / <status @code int @message string>
 / <header @name symbol @value string>
-/ <body @chunk Chunk>
+/ <chunk @chunk Chunk>
+/ <done @chunk Chunk>
 .

 Chunk = @string string / @bytes bytes .
--- a/syndicate/private/protocols/schemas/noise.prs
+++ b/syndicate/private/protocols/schemas/noise.prs
@ -1,5 +1,4 @@
 version 1 .
-embeddedType EntityRef.Cap .

 # https://noiseprotocol.org/

@ -43,30 +42,13 @@ DefaultProtocol = "Noise_NK_25519_ChaChaPoly_BLAKE2s" .
 # sequence is exhausted or not supplied, an all-zeros key is used each time a PSK is needed.
 NoisePreSharedKeys = @present { preSharedKeys: [bytes ...] } / @invalid { preSharedKeys: any } / @absent {} .

-# ---------------------------------------------------------------------------
-# Handshaking and running a session
-
-# 1. initiator asserts <resolve <noise ServiceSelector> #:A> at Gatekeeper
-# 2. gatekeeper asserts <accepted #:B> at #:A
-# 3. initiator asserts <initiator #:C> at #:B and then sends `Packet`s to #:B
-# 4. responder sends `Packet`s to #:C
-#
-# Sessions begin with introduction of initiator (#:C) and responder (#:B) to each other, and
-# then proceed by sending `Packet`s (from #:C) to #:B and (from #:B) to #:C according to
-# the Noise protocol definition. Each `Packet` represents a complete logical unit of
+# Sessions proceed by sending Packets to the initiatorSession and responderSession according to
+# the Noise protocol definition. Each Packet represents a complete logical unit of
 # communication; for example, a complete Turn when layering the Syndicate protocol over Noise.
 # Note well the restriction on Noise messages: no individual complete packet or packet fragment
-# may exceed 65535 bytes (N.B. not 65536!). When `fragmented`, each portion of a `Packet` is a
+# may exceed 65535 bytes (N.B. not 65536!). When `fragmented`, each portion of a Packet is a
 # complete Noise "transport message"; when `complete`, the whole thing is likewise a complete
 # "transport message".
-#
-# Retraction of the `Initiator` ends the session from the initiator-side; retraction of the
-# `<accepted ...>` assertion ends the session from the responder-side.
-
-SessionItem = Initiator / Packet .
-# Assertion
-Initiator = <initiator @initiatorSession #:Packet> .
-# Message
 Packet = @complete bytes / @fragmented [bytes ...] .

 # When layering Syndicate protocol over noise,
--- a/syndicate/schema-compiler.rkt
+++ b/syndicate/schema-compiler.rkt
@ -62,7 +62,7 @@
      [(SimplePattern-Ref (Ref (ModulePath module-path) name)) `values]))

  (define (def-pattern name def)
-    (define discard `(,(N 'Pattern-discard)))
+    (define discard `(,(N 'Pattern-DDiscard) (,(N 'DDiscard))))

    (define (pat-pattern p)
      (match (unwrap p)
@ -73,8 +73,8 @@
        [(SimplePattern-embedded _interface) discard]
        [(SimplePattern-lit value)
         (if (eq? value '...)
-             `(,(N 'Pattern-lit) (quote (... ...)))
-             `(,(N 'Pattern-lit) ',value))]
+             `(,(N 'Pattern-DLit) (,(N 'DLit) (quote (... ...))))
+             `(,(N 'Pattern-DLit) (,(N 'DLit) ',value)))]
        [(SimplePattern-seqof pat) discard]
        [(SimplePattern-setof pat) discard]
        [(SimplePattern-dictof key-pat value-pat) discard]
--- a/syndicate/skeleton.rkt
+++ b/syndicate/skeleton.rkt
@ -31,16 +31,16 @@
 ;; specification of (the outline of) its shape; its silhouette.
 ;; Following a skeleton's structure leads to zero or more `SkCont`s.
 ;;
-;;  Skeleton = (skeleton-node SkCont (AListof SkMove (MutableHash ConstructorSpec Skeleton)))
-;;    SkMove = (skeleton-move Nat (Listof Any))
+;;    Skeleton = (skeleton-node SkCont (AListof SkSelector (MutableHash ConstructorSpec Skeleton)))
+;;  SkSelector = (skeleton-selector Nat Any)
 ;;
-;; A `ConstructorSpec` specifies a record and its label, or a sequence,
-;; or a dictionary.
+;; A `ConstructorSpec` specifies a record label with arity, or a list
+;; arity, or a dictionary.
 ;;
-;;  ConstructorSpec = (U (GroupType-rec any) (GroupType-arr) (GroupType-dict))
+;;  ConstructorSpec = (U (cons any nat) nat 'dict)
 ;;
 (struct skeleton-node (continuation [edges #:mutable]) #:transparent)
-(struct skeleton-move (pop-count path) #:transparent)
+(struct skeleton-selector (pop-count key) #:transparent)
 ;;
 ;; A `Pattern` is a pattern over assertions, following the schema of
 ;; the same name in schemas/dataspacePatterns.prs. Instances of
@ -57,8 +57,7 @@
 ;;
 ;;      SkCont = (skeleton-continuation
 ;;                 (MutableHash Assertion #t)
-;;                 (MutableHash (constant-positions SkProj SkProj)
-;;                              (MutableHash SkKey SkConst)))
+;;                 (MutableHash SkProj (MutableHash SkKey SkConst)))
 ;;     SkConst = (skeleton-matched-constant
 ;;                 (MutableHash Assertion #t)
 ;;                 (MutableHash SkProj SkAcc))
@ -67,7 +66,6 @@
 ;;                 (MutableHasheq EntityRef (MutableHash SkKey Handle)))
 ;;
 (struct skeleton-continuation (cache table) #:transparent)
-(struct constant-positions (with-values required-to-exist) #:transparent)
 (struct skeleton-matched-constant (cache table) #:transparent)
 (struct skeleton-accumulator (cache peers) #:transparent)
 ;;
@ -108,19 +106,15 @@

 (define (skcont-add! turn c pat ref)
  (define cs (pattern->constant-paths pat))
-  (define ce (pattern->check-paths pat))
  (define (classify-assertions)
    (define cvt (make-hash))
    (hash-for-each (skeleton-continuation-cache c)
                   (lambda (a _)
-                     (unless (void? (apply-projection a ce))
-                       (define avs (apply-projection a cs))
-                       (unless (void? avs)
-                         (define sc (hash-ref! cvt avs make-empty-matched-constant))
-                         (hash-set! (skeleton-matched-constant-cache sc) a #t)))))
+                     (define avs (apply-projection 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) (constant-positions cs ce) classify-assertions))
+  (define cvt (hash-ref! (skeleton-continuation-table c) cs classify-assertions))
  (define sc (hash-ref! cvt (pattern->constant-values pat) make-empty-matched-constant))
  (define vs (pattern->capture-paths pat))
  (define (make-accumulator)
@ -139,9 +133,8 @@
  (and (hash-empty? cache) (hash-empty? table)))

 (define (skcont-remove! turn c pat ref)
-  (define ck (constant-positions (pattern->constant-paths pat)
-                                 (pattern->check-paths pat)))
-  (define cvt (hash-ref (skeleton-continuation-table c) ck #f))
+  (define cs (pattern->constant-paths pat))
+  (define cvt (hash-ref (skeleton-continuation-table c) cs #f))
  (when cvt
    (define cv (pattern->constant-values pat))
    (define sc (hash-ref cvt cv #f))
@ -157,60 +150,65 @@
      (when (skeleton-matched-constant-empty? sc)
        (hash-remove! cvt cv)))
    (when (hash-empty? cvt)
-      (hash-remove! (skeleton-continuation-table c) ck))))
-
-(define (⊖ h1 h0)
-  (define-values (h1tail h0tail) (drop-common-prefix h1 h0))
-  (skeleton-move (length h0tail) h1tail))
-
-(define (⊕ h0 move)
-  (match-define (skeleton-move n h) move)
-  (append (drop-right h0 n) h))
-
-(define (shape->visit s)
-  (let walk ((path '()) (s s))
-    (match s
-      ['() '()]
-      [(cons (cons h ctor-spec) more)
-       (cons (cons (⊖ h path) ctor-spec) (walk h more))])))
+      (hash-remove! (skeleton-continuation-table c) cs))))

 (define (term-matches-ctor-spec? term ctor-spec)
  (match ctor-spec
-    [(GroupType-rec label)
+    [(cons 'rec label)
     (and (non-object-struct? term)
          (equal? (struct-type-name (struct->struct-type term)) label))]
-    [(GroupType-arr)
+    ['arr
     (list? term)]
-    [(GroupType-dict)
+    ['dict
     (hash? term)]))

 (define (subterm-matches-ctor-spec? term path ctor-spec)
  (term-matches-ctor-spec? (apply-projection-path term path) ctor-spec))

-(define (skeleton-node-edge-table! sk move)
-  (match (assoc move (skeleton-node-edges sk))
-    [#f (let ((table (make-hash)))
-          (set-skeleton-node-edges! sk (cons (cons move table) (skeleton-node-edges sk)))
-          table)]
-    [(cons _move table) table]))
-
 (define (extend-skeleton! sk pat)
-  (let visit ((h '()) (sk sk) (moves (shape->visit (pattern->shape pat))))
-    (match moves
-      ['() sk]
-      [(cons (cons move ctor-spec) moves)
-       (define table (skeleton-node-edge-table! sk move))
-       (define path (⊕ h move))
+  (define (walk-node! rev-path sk pop-count key pat)
+    (match pat
+      [(Pattern-DCompound compound-pat)
+       (define selector (skeleton-selector pop-count key))
+       (define table
+         (match (assoc selector (skeleton-node-edges sk))
+           [#f (let ((table (make-hash)))
+                 (set-skeleton-node-edges! sk (cons (cons selector table) (skeleton-node-edges sk)))
+                 table)]
+           [(cons _selector table) table]))
+       (define ctor-spec
+         (match compound-pat
+           [(DCompound-rec label field-pats) (cons 'rec label)]
+           [(DCompound-arr item-pats) 'arr]
+           [(DCompound-dict _entries) 'dict]))
       (define (make-skeleton-node-with-cache)
         (define unfiltered (skeleton-continuation-cache (skeleton-node-continuation sk)))
         (define filtered (make-hash))
+         (define path (reverse rev-path))
         (hash-for-each unfiltered
                        (lambda (a _)
                          (when (subterm-matches-ctor-spec? a path ctor-spec)
                            (hash-set! filtered a #t))))
         (make-empty-skeleton/cache filtered))
       (define next (hash-ref! table ctor-spec make-skeleton-node-with-cache))
-       (visit path next moves)])))
+       (let-values (((pop-count sk)
+                     (match compound-pat
+                       [(or (DCompound-rec _ pats)
+                            (DCompound-arr pats))
+                        (for/fold [(pop-count 0) (sk next)]
+                                  [(key (in-naturals)) (subpat (in-list pats))]
+                          (walk-node! (cons key rev-path) sk pop-count key subpat))]
+                       [(DCompound-dict members)
+                        (for/fold [(pop-count 0) (sk next)]
+                                  [((key subpat) (in-hash members))]
+                          (walk-node! (cons key rev-path) sk pop-count key subpat))])))
+         (values (+ pop-count 1) sk))]
+      [(Pattern-DBind (DBind pat))
+       (walk-node! rev-path sk pop-count key pat)]
+      [_
+       (values pop-count sk)]))
+  (let-values (((_pop-count sk) (walk-node! '() sk 0 0 pat)))
+    sk))

 (define (add-interest! turn sk pat ref)
  (skcont-add! turn (skeleton-node-continuation (extend-skeleton! sk pat)) pat ref))
@ -219,45 +217,45 @@
  (skcont-remove! turn (skeleton-node-continuation (extend-skeleton! sk pat)) pat ref))

 (define (skeleton-modify! turn sk term0 modify-skcont! on-missing-skconst modify-skconst! modify-skacc!)
-  (let walk-node! ((sk sk) (term-stack (list term0)))
+  (let walk-node! ((sk sk) (term-stack (list (list term0))))
    (match-define (skeleton-node continuation edges) sk)
    (modify-skcont! continuation term0)
-
    (let ((sct (skeleton-continuation-table continuation))
-          (constant-keys-to-remove '()))
-      (for [((constant-key key-proj-handler) (in-hash sct))]
-        (unless (void? (apply-projection term0 (constant-positions-required-to-exist constant-key)))
-          (define constants (apply-projection term0 (constant-positions-with-values constant-key)))
-          (unless (void? constants)
-            (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-keys-to-remove (cons constant-key constant-keys-to-remove)))))
-              (hash-for-each (skeleton-matched-constant-table proj-handler)
-                             (lambda (variable-proj acc)
-                               (define vars (apply-projection term0 variable-proj))
-                               (modify-skacc! turn acc vars term0)))))))
-      (for [(constant-key (in-list constant-keys-to-remove))]
-        (hash-remove! sct constant-key)))
+          (constant-projections-to-remove '()))
+      (hash-for-each sct
+                     (lambda (constant-proj key-proj-handler)
+                       (define constants (apply-projection term0 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)
+                                          (define vars (apply-projection term0 variable-proj))
+                                          (modify-skacc! turn 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-move pop-count path) table) edge)
+      (match-define (cons (skeleton-selector pop-count key) table) edge)
      (define popped-stack (drop term-stack pop-count))
      (define old-top (car popped-stack))
-      (define new-top (apply-projection-path old-top path))
-      (define ctor-spec (cond [(non-object-struct? new-top)
-                               (GroupType-rec (struct-type-name
-                                               (struct->struct-type new-top)))]
-                              [(list? new-top) (GroupType-arr)]
-                              [(hash? new-top) (GroupType-dict)]
-                              [else #f]))
-      (define entry (hash-ref table ctor-spec #f))
+      (define new-top (step-term old-top key))
+      (define entry
+        (hash-ref table
+                  (cond [(non-object-struct? new-top) (cons 'rec (struct-type-name
+                                                                  (struct->struct-type new-top)))]
+                        [(list? new-top) 'arr]
+                        [(hash? new-top) 'dict]
+                        [else #f])
+                  #f))
      (when entry (walk-node! entry (cons new-top popped-stack))))))

 (define (add-term-to-skcont! skcont term)
@ -333,12 +331,8 @@

 ;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
 (define (apply-projection term proj)
-  (let/ec return
-    (for/list [(path (in-list proj))]
-      (define v (apply-projection-path term path))
-      (if (void? v)
-          (return (void))
-          v))))
+  (for/list [(path (in-list proj))]
+    (apply-projection-path term path)))

 (define (apply-projection-path term path)
  (for/fold [(term term)]
--- a/syndicate/smart-pattern.rkt
+++ b/syndicate/smart-pattern.rkt
@ -23,28 +23,13 @@

 (require syndicate/schemas/dataspacePatterns)

-(define (items->entries pats)
-  (define-values (entries max-i)
-    (for/fold [(entries (hash)) (max-i #f)]
-              [(i (in-naturals)) (p (in-list pats))]
-      (values (if (Pattern-discard? p) entries (hash-set entries i p))
-              i)))
-  (if (and max-i (not (hash-has-key? entries max-i)))
-      (hash-set entries max-i (Pattern-discard))
-      entries))
+(define (rec label pats) (Pattern-DCompound (DCompound-rec label pats)))
+(define (arr pats) (Pattern-DCompound (DCompound-arr pats)))
+(define (dict pats) (Pattern-DCompound (DCompound-dict pats)))

-(define (entries->items entries on-missing)
-  (define max-key (apply max -1 (hash-keys entries)))
-  (for/list [(i (in-range 0 (+ max-key 1)))]
-    (hash-ref entries i on-missing)))
-
-(define (rec label pats) (Pattern-group (GroupType-rec label) (items->entries pats)))
-(define (arr pats) (Pattern-group (GroupType-arr) (items->entries pats)))
-(define (dict pats) (Pattern-group (GroupType-dict) pats))
-
-(define (rec* label pats) (rec 'group (list (rec 'rec (list (lit label))) (dict (items->entries pats)))))
-(define (arr* pats) (rec 'group (list (rec 'arr (list)) (dict (items->entries pats)))))
-(define (dict* pats) (rec 'group (list (rec 'dict (list)) (dict pats))))
+(define (rec* label pats) (rec 'rec (list (lit label) (arr pats))))
+(define (arr* pats) (rec 'arr (list (arr pats))))
+(define (dict* pats) (rec 'dict (list (dict pats))))

 (define (literal->literal-pattern v)
  (let walk ((v (->preserve v)))
@ -52,19 +37,18 @@
      [(record label fs) (rec label (map walk fs))]
      [(? list? vs) (arr (map walk vs))]
      [(? dict? d) (dict (for/hash [((k v) (in-hash d))] (values k (walk v))))]
-      [other (Pattern-lit (parse-AnyAtom! other))])))
+      [other (Pattern-DLit (DLit (parse-AnyAtom! other)))])))

 (define lit literal->literal-pattern)

 (define (literal-pattern->literal p)
  (let/ec return
-    (define (e->i e) (entries->items e (lambda () (return (void)))))
    (let walk ((p p))
      (match p
-        [(Pattern-discard) (return (void))]
-        [(Pattern-bind pp) (walk pp)]
-        [(Pattern-lit a) (->preserve a)]
-        [(Pattern-group (GroupType-rec label) ps) (record label (map walk (e->i ps)))]
-        [(Pattern-group (GroupType-arr) ps) (map walk (e->i ps))]
-        [(Pattern-group (GroupType-dict) d) (for/hash [((k pp) (in-hash d))]
-                                              (values k (walk pp)))]))))
+        [(Pattern-DDiscard (DDiscard)) (return (void))]
+        [(Pattern-DBind (DBind pp)) (walk pp)]
+        [(Pattern-DLit (DLit a)) (->preserve a)]
+        [(Pattern-DCompound (DCompound-rec label ps)) (record label (map walk ps))]
+        [(Pattern-DCompound (DCompound-arr ps)) (map walk ps)]
+        [(Pattern-DCompound (DCompound-dict d)) (for/hash [((k pp) (in-hash d))]
+                                                  (values k (walk pp)))]))))