New dataspace pattern language.

New http server protocol implementation and example
Update noise implementation for new protocol
2024-04-09 14:00:33 +02:00 · 2024-04-09 13:01:27 +02:00 · 2024-04-09 11:36:22 +02:00 · 2024-04-09 11:35:48 +02:00 · 2024-04-09 11:35:22 +02:00 · 2024-04-09 09:15:59 +02:00
19 changed files with 705 additions and 385 deletions
--- a/syndicate-examples/chat.pr
+++ b/syndicate-examples/chat.pr
@ -1,4 +1,4 @@
-; syndicate-server -c chat.pr
+#!/usr/bin/env -S syndicate-server -c
 <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 @@
-; syndicate-server -c dummy-port-relay.pr
+#!/usr/bin/env -S syndicate-server -c
 <require-service <daemon dummy-port-relay>>
 <daemon dummy-port-relay {
--- a/syndicate-examples/http-server.rkt
+++ b/syndicate-examples/http-server.rkt
@ -0,0 +1,55 @@
 ;;; 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
+20 October 2018; revised 21 June 2019 and 4-5 April 2024
 <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 ::= e | x(p, ...) | $x | _
+    p ∈ patterns    P ::= v | x(p, ...) | $x | _
 Syntactic patterns can be translated into assertions of interest
 directly. Binding subpatterns `$x` are translated into `capture()`,
@ -113,10 +113,9 @@ event handlers added later.
 ### Skeletons
 A skeleton is comprised of three pieces: a *shape*, describing the
-positions and arities of statically-known constructors in matching
+positions of statically-known constructors in matching assertions; a
-assertions; a *constant map*, which places restrictions on fields
+*constant map*, which places restrictions on fields within constructors;
-within constructors; and a *capture map*, which specifies locations of
+and a *capture map*, which specifies locations of captured positions.
 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.
@ -124,49 +123,57 @@ 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×E] × [H]
+    k ∈ skeletons      K = S × (H ⟼ V+1) × [H]
-    s ∈ shapes      S ::= * | x(s, ...)
+    s ∈ shapes         S = (H ⟼ L)
-    h ∈ paths       H   = [𝐍]
+    ℓ ∈ classes        L = X			-- label
    h ∈ paths          H = [𝐍]
-Shapes retain only statically-known constructors and arities in a
+Shapes retain only statically-known constructors in a pattern:
 pattern:
-    shape :: P -> S
+    shape :: P → S
-    shape e          = *
+    shape p = shape' [] p
-    shape x(p, ...)  = x(shape p, ...)
+      where
-    shape $x         = *
+        shape' :: H → P → S
-    shape _          = *
+        shape h v               = ∅
        shape h x(p₀, ..., pᵢ)  = (h ⟼ x)
                                ∪ (shape (h++[0]) p₀) ∪ ...
                                ∪ (shape (h++[i]) pᵢ)
        shape h $x              = ∅
        shape h _               = ∅
-A constant map extracts all non-capturing, non-discard positions in a
+A constant map filters potential matches by placing constraints on
-pattern. The expressions in the map are evaluated at the time the
+contained fields. The paths `H` in the map denote positions to be
-corresponding event handler is installed; that is, at facet creation
+checked; the predicates `V+1` denote either a particular value that must
-time. They are not subsequently reevaluated; if any expression depends
+exist at that position, or a simple check that the term in question
-on a dataflow variable, and that variable changes, the entire handler
+merely *has* a value in that position.
 is removed, reevaluated, and reinstalled.
-    constantmap :: P -> [(H, E)]
+    constantmap :: P → (H ⟼ V+1)
    constantmap p  = cmap [] p
      where
-        cmap :: H -> P -> [(H, E)]
+        cmap :: H → P → (H ⟼ V+1)
-        cmap h e                 = [(h, e)]
+        cmap h v               = (h ⟼ inl v)
-        cmap h x(p_0, ..., p_i)  = (cmap (h++[0]) p_0) ++
+        cmap h x(p₀, ..., pᵢ)  = (cmap (h++[0]) p₀) ∪ ...
-                                   ... ++
+                               ∪ (cmap (h++[i]) pᵢ)
-                                   (cmap (h++[i]) p_i)
+        cmap h $x              = ∅
-        cmap h $x                = []
+        cmap h _               = (h ⟼ inr ())
        cmap h _                 = []
-Finally, a capture map extracts all capturing positions in a pattern:
+It will be useful to separate value-check operations from existence-check operations.
-    capturemap :: P -> [H]
+    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  = vmap [] p
      where
-        vmap :: H -> P -> [H]
+        vmap :: H → P → [H]
-        vmap h e                = []
+        vmap h v              = []
-        vmap h x(p_0, ..., p_i) = (vmap (h++[0]) p_0) ++
+        vmap h x(p₀, ..., pᵢ) = (vmap (h++[0]) p₀) ++ ...
-                                  ... +
+                             ++ (vmap (h++[i]) pᵢ)
-                                  (vmap (h++[i]) p_i)
+        vmap h $x             = [h]
-        vmap h $x               = [h]
+        vmap h _              = []
        vmap h _                = []
 ### The index
@ -175,8 +182,8 @@ assertion in the dataspace.
 #### Overview and structures
-An index is a pair of a bag of all currently-asserted
+An index contains a bag of all currently-asserted
-assertion-values, plus the root node of a trie-like structure.
+assertion-values, as well as the root of a trie-like structure.
 Information from each indexed event handler's skeleton's shape is laid
 out along edges connecting trie nodes.
@ -185,23 +192,22 @@ a skeleton's constant map and capture map alongside handler callback
 functions and caches of currently-asserted values.
           Index = Bag(V) × Node
-            Node = Continuation × (Selector ⟼ Class ⟼ Node)
+            Node = Continuation × (Move ⟼ L ⟼ Node)
-        Selector = 𝐍 × 𝐍		-- pop-count and index
+            Move = 𝐍 × H
           Class = X			-- label
-    Continuation = 𝒫(V) × ([H] ⟼ [V] ⟼ Leaf)
+    Continuation = 𝒫(V) × ([H]×𝒫(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 `Selector`/`Class`-labelled edges,
+the root `Node` of the index along move- and 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
@ -213,15 +219,103 @@ 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)` in the
+Most of the components in an index are *mutable*: the `Bag(V)` and
 initial class-to-`Node` map in the
 root; the assertion-value cache set in each `Continuation` or `Leaf`
-object; the map from `Selector` to `Class` to `Node` within each
+object; the map from move 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.
@ -239,64 +333,72 @@ 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.
-**Definition.** The `project` function extracts the subvalue at a
+**Example.** Let our pattern be
  given path `h` from an overall value `v`.
-    project :: V -> H -> 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 [] = v
-    project x(v_0, ..., v_i) (n:h) = project v_n h
+    project x(v₀, ..., vᵢ) (n:h) = project vₙ h, if 0 ≤ n ≤ i
-**Definition.** The `projectMany` function projects a sequence of
+**Definition.** The `projectMany` partial function projects a sequence
-  subvalues.
+  of subvalues.
-    projectMany :: V -> [H] -> V
+    projectMany :: V → [H] ⇀ [V]
-    projectMany v [h_0, ...] = [project v h_0, ...]
+    projectMany v [h, ...] = [project v h, ...]
-**Definition.** The `classof` function extracts the constructor label
+**Definition.** The `classof` partial function extracts the constructor
-  `x` from a value `v`, yielding `()` if `v` is not a record.
+  label `x` from a record value. It is undefined for non-record values.
-    classof :: V -> 1 + Class
+    classof :: V ⇀ L
-    classof a                = ()
+    classof x(v₀, ..., vᵢ) = x
    classof x(v_0, ..., v_i) = x
 **Definition.** The `extend` procedure augments an index with shape
-  information `s`, by imperatively updating the index structure. It
+  information `s`, where `∃p . s = shape p`, by imperatively updating
-  returns the `Continuation` associated with the deepest `Node`
+  the index structure. It returns the `Continuation` associated with the
-  visited in the path described by `s`.
+  final `Node` visited in the path described by `s`.
-    extend :: Node -> S -> Continuation
+    extend :: Index → S → Continuation
-    extend node s =
+    extend (_, root) s = visit [] root (shapeVisit s)
        let (_, (cont, _)) = walk-node [] node 0 0 s
        cont
      where
-
+        visit :: H → Node → [Move × L] → Continuation
-        walk-edge :: H -> Node -> 𝐍 -> 𝐍 -> [S] -> (𝐍,Node)
+        visit h (cont, moveTable) [] = cont
-        walk-edge h node n_pop n_index [] =
+        visit h (cont, moveTable) ([(h̅, ℓ)] ++ moves) =
-          (n_pop + 1, node)
+          if h̅ not in moveTable then
-        walk-edge h node n_pop n_index (s:shapes) =
+              moveTable[h̅] := {}
-          let (n_pop', node') = walk-node h node n_pop n_index s
+          let classTable = moveTable[h̅]
-          let n_index' = n_index + 1
+          if ℓ not in classTable then
-          let h' = (dropRight h 1) ++ [n_index']
+              let vs = { v | v ∈ fst cont,
-          walk-edge h' node' n_pop' n_index' shapes
+                             classof (project v (h ⊕ h̅)) = ℓ }
-
+              classTable[ℓ] := ((vs, {}), {})
-        walk-node :: H -> Node -> 𝐍 -> 𝐍 -> S -> (𝐍,Node)
+          visit (h ⊕ h̅) classTable[ℓ] moves
        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
@ -304,31 +406,35 @@ cases where handlers are dynamically installed.
  sequence of captured values matching existing assertions in the
  index.[^function-pointer-equality]
-    addHandler :: Index -> (S × [H×V] × [H]) -> Callback -> 1
+    addHandler :: Index → K → Callback → 1
    addHandler index (s, constantMap, captureMap) f =
-      let (_, root) = index
+      let (cache, table) = extend index s
-      let (cache, table) = extend root s
+      let (unsortedConstants, checks) = constantchecks constantMap
-      let constLocs = [h | (h,v) ∈ constantMap]
+      let constants = sort lexLt unsortedConstants
-      if constLocs not in table then
+      let constLocs = map fst constants
-          table[constLocs] := {}
+      let constKey = (constLocs, checks)
      if constKey not in table then
          table[constKey] := {}
          for v in cache
-              let key = projectMany v constLocs
+              if ∀h ∈ checks, project v h is defined and
-              if key not in table[constLocs] then
+                 ∃key . key = projectMany v constLocs then
-                  table[constLocs][key] := ({}, {})
+                  if key not in table[constKey] then
-              let (leafcache, _leaftable) = table[constLocs][key]
+                      table[constKey][key] := ({}, {})
-              leafcache += v
+                  let (leafcache, _leaftable) = table[constKey][key]
-      let constVals = [v | (h,v) ∈ constantMap]
+                  leafcache += v
-      if constVals not in table[constLocs] then
+      let constVals = map snd constants
-          table[constLocs][constVals] := ({}, {})
+      if constVals not in table[constKey] then
-      let (leafcache, leaftable) = table[constLocs][constVals]
+          table[constKey][constVals] := ({}, {})
      let (leafcache, leaftable) = table[constKey][constVals]
      if captureMap not in leaftable then
          let bag = empty_bag
          for v in leafcache
-              bag[projectMany v captureMap] += 1
+              if ∃seq . seq = projectMany v captureMap then
                  bag[seq] += 1
          leaftable[captureMap] := (bag, {})
      let (bag, f_table) = leaftable[captureMap]
      f_table += f
-      for seq in bag
+      for (seq ⟼ _) in bag
          f "+" seq
      ()
@ -340,17 +446,19 @@ cases where handlers are dynamically installed.
 **Definition.** The `removeHandler` procedure removes an event handler
  from an index.
-    removeHandler :: Index -> (S × [H×V] × [H]) -> Callback -> 1
+    removeHandler :: Index → K → Callback → 1
    removeHandler index (s, constantMap, captureMap) f =
-      let (_, root) = index
+      let (_, table) = extend index s
-      let (cache, table) = extend root s
+      let (unsortedConstants, checks) = constantchecks constantMap
-      let constLocs = [h | (h,v) ∈ constantMap]
+      let constants = sort lexLt unsortedConstants
-      if constLocs not in table then
+      let constLocs = map fst constants
      let constKey = (constLocs, checks)
      if constKey not in table then
          return
-      let constVals = [v | (h,v) ∈ constantMap]
+      let constVals = map snd constants
-      if constVals not in table[constLocs] then
+      if constVals not in table[constKey] then
          return
-      let (leafcache, leaftable) = table[constLocs][constVals]
+      let (leafcache, leaftable) = table[constKey][constVals]
      if captureMap not in leaftable then
          return
      let (bag, f_table) = leaftable[captureMap]
@ -360,9 +468,9 @@ cases where handlers are dynamically installed.
      if f_table = {} then
          delete leaftable[captureMap]
      if leafcache = {} and leaftable = {} then
-          delete table[constLocs][constVals]
+          delete table[constKey][constVals]
-      if table[constLocs] = {} then
+      if table[constKey] = {} then
-          delete table[constLocs]
+          delete table[constKey]
 #### Adding assertions, removing assertions and sending messages
@ -377,70 +485,59 @@ parameterized with different update procedures.
    Operation = { AddAssertion, RemoveAssertion, SendMessage }
-    modify :: Node ->
+    modify :: Index →
-              Operation ->
+              Operation →
-              V ->
+              V →
-              (Continuation -> V -> 1) ->
+              (Continuation → V → 1) →
-              (Leaf -> V -> 1) ->
+              (Leaf → V → 1) →
-              (Handler -> [V] -> 1) ->
+              (Handler → [V] → 1) →
              1
-    modify node operation v m_cont m_leaf m_handler =
+    modify (_, root) operation v m_cont m_leaf m_handler =
-      walk-node node [outermost(v)]
+        visit root [v]
      where
-        walk-node :: Node -> [V] -> 1
+        visit :: Node → [V] → 1
-        walk-node (cont, edges) vs =
+        visit (cont, moveTable) vs =
-          walk-cont cont
+          visit-cont cont
-          for sel@(n_pop, n_index) in edges
+          for ((n, h) ⟼ classTable) in moveTable
-              let vs' = dropLeft vs n_pop
+            let (v' : vs') = dropLeft vs n in
-              let (x(v_0, ...) : _) = vs'
+              if ∃v . v = project v' h and
-              let v' = v_{n_index}
+                 ∃ℓ . ℓ = classof v and
-              if classof v' in edges[sel] then
+                 ∃next . (ℓ ⟼ next) ∈ classTable then
-                  walk-node edges[sel][classof v'] (v':vs')
+                visit next (v : v' : vs')
-        walk-cont :: Continuation -> 1
+        visit-cont :: Continuation → 1
-        walk-cont cont@(cache, table) =
+        visit-cont cont@(_, table) =
          m_cont cont v
-          for constLocs in table
+          for ((constLocs, checks) ⟼ constVals) in table
-            let consts = projectMany v constLocs
+            if ∀h ∈ checks, project v h is defined and
-            if operation = AddAssertion and consts not in table[constLocs] then
+               ∃consts . consts = projectMany v constLocs then
-                table[constLocs][consts] := ({}, {})
+                if operation = AddAssertion and consts not in constVals then
-            if consts in table[constLocs] then
+                    constVals[consts] := ({}, {})
-                let leaf@(leafcache, leaftable) =
+                if consts in constVals then
-                      table[constLocs][consts]
+                    let leaf@(leafcache, leaftable) = constVals[consts]
-                m_leaf leaf v
+                    m_leaf leaf v
-                for captureMap in leaftable
+                    for (captureMap ⟼ handler) in leaftable
-                    let handler = leaftable[captureMap]
+                        if ∃vs . vs = projectMany v captureMap then
-                    let vs = projectMany v captureMap
+                            m_handler handler vs
-                    m_handler handler vs
+                    if operation = RemoveAssertion and leafcache = {} and leaftable = {} then
-                if operation = RemoveAssertion and leafcache = {} and leaftable = {} then
+                        delete constVals[consts]
-                    delete table[constLocs][consts]
+                        if constVals = {} then
-                    if table[constLocs] = {} then
+                            delete table[(constLocs, checks)]
                        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 → V → 𝐍 → 1
-    adjustAssertion (cache, root) v delta =
+    adjustAssertion index@(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 root AddAssertion v add_cont add_leaf add_handler
+            modify index AddAssertion v add_cont add_leaf add_handler
        if was_present and not is_present then
-            modify root RemoveAssertion v del_cont del_leaf del_handler
+            modify index RemoveAssertion v del_cont del_leaf del_handler
      where
        add_cont (cache, _) v = cache += v
        add_leaf (leafcache, _) v = leafcache += v
@ -463,10 +560,10 @@ check followed by zero or more (move, check) pairs.
  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
@ -481,7 +578,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
@ -491,8 +588,32 @@ 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,8 +70,12 @@
                           (when (eq? (bag-change! assertions value -1) 'present->absent)
                             (remove-assertion! this-turn skeleton value)
                             (match maybe-observe
-                               [(? eof-object?) (void)]
+                               [(? eof-object?)
-                               [(Observe pat ref) (remove-interest! this-turn skeleton pat ref)]))]))
+                                (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))]))]))
            #: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,17 +49,21 @@
          (lambda (set-peer-session! handle-message)
            (at acceptor-ref
              (assert (Resolve (Step (NoiseStepType) service-selector)
-                               (object #:name 'noise-initiator
+                               (object #:name 'noise-observer
                                       [#: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
-                         #:initiator-session initiator-session
+                         #:observer observer
                         #:preshared-keys [psks #f]
                         #:pattern [pattern #f])
  (noise* #:role 'responder
@ -69,11 +73,15 @@
          #:preshared-keys psks
          #:pattern pattern
          (lambda (set-peer-session! handle-message)
-            (set-peer-session! initiator-session)
+            (at observer
            (at initiator-session
              (assert (Resolved-accepted
-                       (object #:name (list 'noise-responder initial-ref initiator-session)
+                       (object #:name (list 'noise-responder initial-ref observer)
-                               [#:message m (handle-message m)])))))))
+                               [#:asserted (Initiator s)
                                (set-peer-session! s)
                                #:retracted
                                (stop-current-facet)]
                               [#:message m
                                (handle-message m)])))))))
 (define (noise* #:role role
                #:service-selector service-selector
@ -127,6 +135,7 @@
                (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)))
@ -134,12 +143,15 @@
 (module+ test
  (require libsodium)
-  (file-stream-buffer-mode (current-output-port) 'none)
+
  (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))
  (standard-actor-system (ds)
-    (spawn #:name 'test-main
+    (define server-keys (make-crypto-box-keypair))
           (define server-keys (make-crypto-box-keypair))
    (spawn #:name 'test-responder
           (define service-object
             (object [a
                      (printf "service+: ~v\n" a)
@ -149,12 +161,13 @@
                      (stop-current-facet)]))
           (at ds
-             (during (Resolve (Step (NoiseStepType) 'test-service) $initiator-session)
+             (during (Resolve (Step (NoiseStepType) 'test-service) $observer)
               (noise-responder #:service-selector 'test-service
                                #:static-keypair server-keys
-                                #:initiator-session initiator-session
+                                #:observer observer
-                                #:export service-object)))
+                                #: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,6 +44,8 @@
 (define-logger syndicate/drivers/http)
 (struct active-handler (ref signal) #:transparent)
 (provide-service [ds]
  (at ds
      (during/spawn (HttpBinding _ $port _ _ _)
@ -59,8 +61,11 @@
              (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))
-              (set-add! handler-set handler)
+              (define-field handler-terminated? #f)
-              (on-stop (set-remove! handler-set handler)
+              (define entry (active-handler handler handler-terminated?))
              (set-add! handler-set entry)
              (on-stop (handler-terminated? #t)
                       (set-remove! handler-set entry)
                       (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)))
@ -100,7 +105,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 ~v" connection-name routes req close?)
+         ;; (log-syndicate/drivers/http-debug "~v ~v ~v ~v" connection-name routes req close?)
         (define continue-ch (make-async-channel))
         (turn! facet
                (lambda ()
@ -192,48 +197,73 @@
                                                             (list (header #"Allow" methods))
                                                             (list)))
                                    (return (void)))))
-          (define handler (set-first handler-set))
+          (match-define (active-handler handler handler-terminated?) (set-first handler-set))
-          (define pending-code #f)
+          (define processing #f)
-          (define pending-message #f)
+          (define pending-code 500)
          (define pending-message "Internal Server Error")
          (define pending-headers-rev '())
          (define chunk-ch #f)
-          (define res (object #:name connection-name
+
-                              [#:message (HttpResponse-status code message)
+          (define (check-processing!)
-                               (set! pending-code code)
+            (unless processing
-                               (set! pending-message message)]
+              (error 'HttpResponse "Attempt to reply before <processing> has been asserted")))
-                              [#:message (HttpResponse-header name value)
+
-                               (set! pending-headers-rev (cons (cons name value) pending-headers-rev))]
+          (define (send-headers!)
-                              [#:message (HttpResponse-chunk chunk)
+            (unless chunk-ch
-                               (unless chunk-ch
+              (set! chunk-ch (make-async-channel))
-                                 (set! chunk-ch (make-async-channel))
+              (thread
-                                 (output-response/method
+               (lambda ()
-                                  conn
+                 (output-response/method conn
-                                  (response pending-code
+                                         (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))
-                                                   (list (chunk->bytes chunk)))
+                                                   (lambda (output-port)
-                                    (request-method req)))
+                                                     (let loop ()
-                               (stop-current-facet)]))
+                                                       (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))]))
          (at handler (assert (HttpContext decoded-req res)))
          (return (void)))))
@ -283,14 +313,11 @@
           (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 (with-handlers [((lambda (e) #t)
+                (async (match (let () body ...)
-                                               (lambda (e)
+                         [(mime (? symbol? type) (or (? bytes? data) (? string? data)))
                                                 (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?)
@ -298,7 +325,8 @@
                         [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")]))))])))
+               [_ (send-http-response! res 400 "Bad request path")])
             (stop-current-facet))))])))
 (define (define-http-route* ds host port method path-pattern handler)
  (at ds
@ -362,11 +390,7 @@
  (for [(header headers)]
    (match-define (cons name value) header)
    (send! res (HttpResponse-header name value)))
-  (let loop ((chunks chunks))
+  (for [(chunk chunks)] (send! res (HttpResponse-body chunk))))
    (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 ,(DLit $embedded-event) ,_)) _)
+    (during/spawn (Observe (:pattern (RacketEvent ,(Pattern-lit $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 ,(DLit $host) ,(DLit $port)))) _)
+          (Observe (:pattern (StreamConnection ,_ ,_ (TcpLocal ,(Pattern-lit $host) ,(Pattern-lit $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 ,(DLit $seconds))) _)
+    (during (Observe (:pattern (LaterThan ,(Pattern-lit $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,8 +13,10 @@
         :pattern
         :parse
         pattern->shape
         pattern->constant-values
         pattern->constant-paths
         pattern->check-paths
         pattern->capture-paths
         !dump-registered-preserves-patterns!
@ -180,14 +182,14 @@
        [id
         (dollar-id? #'id)
-         (transform-binding (undollar #'id) #`(Pattern-DBind (DBind (Pattern-DDiscard (DDiscard)))))]
+         (transform-binding (undollar #'id) #`(Pattern-bind (Pattern-discard)))]
        [($ id p)
-         (transform-binding #'id #`(Pattern-DBind (DBind #,(walk #'p))))]
+         (transform-binding #'id #`(Pattern-bind #,(walk #'p)))]
        [id
         (discard-id? #'id)
-         #`(Pattern-DDiscard (DDiscard))]
+         #`(Pattern-discard)]
        [(c l (list-stx piece ...))
         (and (id=? #'rec #'c)
@ -379,36 +381,55 @@
 ;;---------------------------------------------------------------------------
-(define (select-pattern-leaves desc capture-fn lit-fn)
+(define (pattern->shape desc)
  (let walk-node ((key-rev '()) (desc desc))
    (match desc
-      [(Pattern-DCompound (or (DCompound-rec _ fields)
+      [(Pattern-group type entries)
-                              (DCompound-arr fields)))
+       (append* (list (cons (reverse key-rev) type))
-       (append* (for/list [(key (in-naturals)) (subdesc (in-list fields))]
+                (for/list [((key subdesc) (in-hash entries))]
                  (walk-node (cons key key-rev) subdesc)))]
-      [(Pattern-DCompound (DCompound-dict entries))
+      [(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)
       (append* (for/list [((key subdesc) (in-hash entries))]
                  (walk-node (cons key key-rev) subdesc)))]
-      [(Pattern-DBind (DBind subdesc))
+      [(Pattern-bind subdesc)
       (append (capture-fn key-rev) (walk-node key-rev subdesc))]
-      [(Pattern-DDiscard (DDiscard))
+      [(Pattern-discard)
-       '()]
+       (discard-fn key-rev)]
-      [(Pattern-DLit (DLit value))
+      [(Pattern-lit 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,13 +4,15 @@ 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µµ±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„„µ±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„„µ±
 fragmented´³seqof´³atom³
-ByteString„„„„„³	NoiseSpec´³andµ´³dict·³key´³named³key´³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„„„„³
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„„³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„„„„„µ±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€„„µ³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´³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³
 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„„„„³
@ -40,5 +42,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·³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³
+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µµ±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„„„„„
+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„„„„„
--- a/syndicate/private/protocols/schemas/dataspacePatterns.prs
+++ b/syndicate/private/protocols/schemas/dataspacePatterns.prs
@ -1,15 +1,23 @@
 version 1 .
 embeddedType EntityRef.Cap .
-# Dataspace patterns: a sublanguage of attenuation patterns.
+# Dataspace patterns: *almost* a sublanguage of attenuation patterns.
-Pattern = DDiscard / DBind / DLit / DCompound .
+#
 # One key difference is that Dataspace patterns are extensible, in that
 # they ignore fields not mentioned in group patterns.
-DDiscard = <_>.
+Pattern =
-DBind = <bind @pattern Pattern>.
+    / @discard <_>
-DLit = <lit @value AnyAtom>.
+    / <bind @pattern Pattern>
-DCompound = <rec @label any @fields [Pattern ...]>
+    / <lit @value AnyAtom>
-          / <arr @items [Pattern ...]>
+    / <group @type GroupType @entries { any: Pattern ...:... }>
-          / <dict @entries { any: Pattern ...:... }> .
+.
 GroupType =
    / <rec @label any>
    / <arr>
    / <dict>
 .
 AnyAtom =
    / @bool bool
--- a/syndicate/private/protocols/schemas/gatekeeper.prs
+++ b/syndicate/private/protocols/schemas/gatekeeper.prs
@ -13,8 +13,37 @@ Step = <<rec> @stepType symbol [@detail any]> .
 # ---------------------------------------------------------------------------
 # Protocol at dataspaces *associated* with gatekeeper entities
-# Assertion. Gatekeeper will compute an appropriate PathStep from `description` pointing at
+# ## Handling `Resolve` requests
-# `target`, and will respond with a `Bound` to `observer` (if supplied).
+#
 # 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).
 #
 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,10 +39,13 @@ 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>
-/ <chunk @chunk Chunk>
+/ <body @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,4 +1,5 @@
 version 1 .
 embeddedType EntityRef.Cap .
 # https://noiseprotocol.org/
@ -42,13 +43,30 @@ 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 {} .
-# Sessions proceed by sending Packets to the initiatorSession and responderSession according to
+# ---------------------------------------------------------------------------
-# the Noise protocol definition. Each Packet represents a complete logical unit of
+# 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
 # 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-DDiscard) (,(N 'DDiscard))))
+    (define discard `(,(N 'Pattern-discard)))
    (define (pat-pattern p)
      (match (unwrap p)
@ -73,8 +73,8 @@
        [(SimplePattern-embedded _interface) discard]
        [(SimplePattern-lit value)
         (if (eq? value '...)
-             `(,(N 'Pattern-DLit) (,(N 'DLit) (quote (... ...))))
+             `(,(N 'Pattern-lit) (quote (... ...)))
-             `(,(N 'Pattern-DLit) (,(N 'DLit) ',value)))]
+             `(,(N 'Pattern-lit) ',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 SkSelector (MutableHash ConstructorSpec Skeleton)))
+;;  Skeleton = (skeleton-node SkCont (AListof SkMove (MutableHash ConstructorSpec Skeleton)))
-;;  SkSelector = (skeleton-selector Nat Any)
+;;    SkMove = (skeleton-move Nat (Listof Any))
 ;;
-;; A `ConstructorSpec` specifies a record label with arity, or a list
+;; A `ConstructorSpec` specifies a record and its label, or a sequence,
-;; arity, or a dictionary.
+;; or a dictionary.
 ;;
-;;  ConstructorSpec = (U (cons any nat) nat 'dict)
+;;  ConstructorSpec = (U (GroupType-rec any) (GroupType-arr) (GroupType-dict))
 ;;
 (struct skeleton-node (continuation [edges #:mutable]) #:transparent)
-(struct skeleton-selector (pop-count key) #:transparent)
+(struct skeleton-move (pop-count path) #:transparent)
 ;;
 ;; A `Pattern` is a pattern over assertions, following the schema of
 ;; the same name in schemas/dataspacePatterns.prs. Instances of
@ -57,7 +57,8 @@
 ;;
 ;;      SkCont = (skeleton-continuation
 ;;                 (MutableHash Assertion #t)
-;;                 (MutableHash SkProj (MutableHash SkKey SkConst)))
+;;                 (MutableHash (constant-positions SkProj SkProj)
 ;;                              (MutableHash SkKey SkConst)))
 ;;     SkConst = (skeleton-matched-constant
 ;;                 (MutableHash Assertion #t)
 ;;                 (MutableHash SkProj SkAcc))
@ -66,6 +67,7 @@
 ;;                 (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)
 ;;
@ -106,15 +108,19 @@
 (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 _)
-                     (define avs (apply-projection a cs))
+                     (unless (void? (apply-projection a ce))
-                     (define sc (hash-ref! cvt avs make-empty-matched-constant))
+                       (define avs (apply-projection a cs))
-                     (hash-set! (skeleton-matched-constant-cache sc) a #t)))
+                       (unless (void? avs)
                         (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 cvt
    (hash-ref! (skeleton-continuation-table c) (constant-positions cs ce) classify-assertions))
  (define sc (hash-ref! cvt (pattern->constant-values pat) make-empty-matched-constant))
  (define vs (pattern->capture-paths pat))
  (define (make-accumulator)
@ -133,8 +139,9 @@
  (and (hash-empty? cache) (hash-empty? table)))
 (define (skcont-remove! turn c pat ref)
-  (define cs (pattern->constant-paths pat))
+  (define ck (constant-positions (pattern->constant-paths pat)
-  (define cvt (hash-ref (skeleton-continuation-table c) cs #f))
+                                 (pattern->check-paths pat)))
  (define cvt (hash-ref (skeleton-continuation-table c) ck #f))
  (when cvt
    (define cv (pattern->constant-values pat))
    (define sc (hash-ref cvt cv #f))
@ -150,65 +157,60 @@
      (when (skeleton-matched-constant-empty? sc)
        (hash-remove! cvt cv)))
    (when (hash-empty? cvt)
-      (hash-remove! (skeleton-continuation-table c) cs))))
+      (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))])))
 (define (term-matches-ctor-spec? term ctor-spec)
  (match ctor-spec
-    [(cons 'rec label)
+    [(GroupType-rec label)
     (and (non-object-struct? term)
          (equal? (struct-type-name (struct->struct-type term)) label))]
-    ['arr
+    [(GroupType-arr)
     (list? term)]
-    ['dict
+    [(GroupType-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)
-  (define (walk-node! rev-path sk pop-count key pat)
+  (let visit ((h '()) (sk sk) (moves (shape->visit (pattern->shape pat))))
-    (match pat
+    (match moves
-      [(Pattern-DCompound compound-pat)
+      ['() sk]
-       (define selector (skeleton-selector pop-count key))
+      [(cons (cons move ctor-spec) moves)
-       (define table
+       (define table (skeleton-node-edge-table! sk move))
-         (match (assoc selector (skeleton-node-edges sk))
+       (define path (⊕ h move))
           [#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))
-       (let-values (((pop-count sk)
+       (visit path next moves)])))
                     (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))
@ -217,45 +219,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 (list term0))))
+  (let walk-node! ((sk sk) (term-stack (list term0)))
    (match-define (skeleton-node continuation edges) sk)
    (modify-skcont! continuation term0)
    (let ((sct (skeleton-continuation-table continuation))
-          (constant-projections-to-remove '()))
+          (constant-keys-to-remove '()))
-      (hash-for-each sct
+      (for [((constant-key key-proj-handler) (in-hash sct))]
-                     (lambda (constant-proj key-proj-handler)
+        (unless (void? (apply-projection term0 (constant-positions-required-to-exist constant-key)))
-                       (define constants (apply-projection term0 constant-proj))
+          (define constants (apply-projection term0 (constant-positions-with-values constant-key)))
-                       (define proj-handler
+          (unless (void? constants)
-                         (hash-ref key-proj-handler
+            (define proj-handler
-                                   constants
+              (hash-ref key-proj-handler
-                                   (lambda () (on-missing-skconst key-proj-handler constants))))
+                        constants
-                       (when proj-handler
+                        (lambda () (on-missing-skconst key-proj-handler constants))))
-                         (when (eq? (modify-skconst! proj-handler term0) 'remove-check)
+            (when proj-handler
-                           (when (skeleton-matched-constant-empty? proj-handler)
+              (when (eq? (modify-skconst! proj-handler term0) 'remove-check)
-                             (hash-remove! key-proj-handler constants)
+                (when (skeleton-matched-constant-empty? proj-handler)
-                             (when (hash-empty? key-proj-handler)
+                  (hash-remove! key-proj-handler constants)
-                               (set! constant-projections-to-remove
+                  (when (hash-empty? key-proj-handler)
-                                     (cons constant-proj constant-projections-to-remove)))))
+                    (set! constant-keys-to-remove (cons constant-key constant-keys-to-remove)))))
-                         (hash-for-each (skeleton-matched-constant-table proj-handler)
+              (hash-for-each (skeleton-matched-constant-table proj-handler)
-                                        (lambda (variable-proj acc)
+                             (lambda (variable-proj acc)
-                                          (define vars (apply-projection term0 variable-proj))
+                               (define vars (apply-projection term0 variable-proj))
-                                          (modify-skacc! turn acc vars term0))))))
+                               (modify-skacc! turn acc vars term0)))))))
-      (for-each (lambda (constant-proj) (hash-remove! sct constant-proj))
+      (for [(constant-key (in-list constant-keys-to-remove))]
-                constant-projections-to-remove))
+        (hash-remove! sct constant-key)))
    (for [(edge (in-list edges))]
-      (match-define (cons (skeleton-selector pop-count key) table) edge)
+      (match-define (cons (skeleton-move pop-count path) table) edge)
      (define popped-stack (drop term-stack pop-count))
      (define old-top (car popped-stack))
-      (define new-top (step-term old-top key))
+      (define new-top (apply-projection-path old-top path))
-      (define entry
+      (define ctor-spec (cond [(non-object-struct? new-top)
-        (hash-ref table
+                               (GroupType-rec (struct-type-name
-                  (cond [(non-object-struct? new-top) (cons 'rec (struct-type-name
+                                               (struct->struct-type new-top)))]
-                                                                  (struct->struct-type new-top)))]
+                              [(list? new-top) (GroupType-arr)]
-                        [(list? new-top) 'arr]
+                              [(hash? new-top) (GroupType-dict)]
-                        [(hash? new-top) 'dict]
+                              [else #f]))
-                        [else #f])
+      (define entry (hash-ref table ctor-spec #f))
                  #f))
      (when entry (walk-node! entry (cons new-top popped-stack))))))
 (define (add-term-to-skcont! skcont term)
@ -331,8 +333,12 @@
 ;; TODO: avoid repeated descent into `term` by factoring out prefixes of paths in `proj`
 (define (apply-projection term proj)
-  (for/list [(path (in-list proj))]
+  (let/ec return
-    (apply-projection-path term path)))
+    (for/list [(path (in-list proj))]
      (define v (apply-projection-path term path))
      (if (void? v)
          (return (void))
          v))))
 (define (apply-projection-path term path)
  (for/fold [(term term)]
--- a/syndicate/smart-pattern.rkt
+++ b/syndicate/smart-pattern.rkt
@ -23,13 +23,28 @@
 (require syndicate/schemas/dataspacePatterns)
-(define (rec label pats) (Pattern-DCompound (DCompound-rec label pats)))
+(define (items->entries pats)
-(define (arr pats) (Pattern-DCompound (DCompound-arr pats)))
+  (define-values (entries max-i)
-(define (dict pats) (Pattern-DCompound (DCompound-dict pats)))
+    (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) (rec 'rec (list (lit label) (arr pats))))
+(define (entries->items entries on-missing)
-(define (arr* pats) (rec 'arr (list (arr pats))))
+  (define max-key (apply max -1 (hash-keys entries)))
-(define (dict* pats) (rec 'dict (list (dict pats))))
+  (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 (literal->literal-pattern v)
  (let walk ((v (->preserve v)))
@ -37,18 +52,19 @@
      [(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-DLit (DLit (parse-AnyAtom! other)))])))
+      [other (Pattern-lit (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-DDiscard (DDiscard)) (return (void))]
+        [(Pattern-discard) (return (void))]
-        [(Pattern-DBind (DBind pp)) (walk pp)]
+        [(Pattern-bind pp) (walk pp)]
-        [(Pattern-DLit (DLit a)) (->preserve a)]
+        [(Pattern-lit a) (->preserve a)]
-        [(Pattern-DCompound (DCompound-rec label ps)) (record label (map walk ps))]
+        [(Pattern-group (GroupType-rec label) ps) (record label (map walk (e->i ps)))]
-        [(Pattern-DCompound (DCompound-arr ps)) (map walk ps)]
+        [(Pattern-group (GroupType-arr) ps) (map walk (e->i ps))]
-        [(Pattern-DCompound (DCompound-dict d)) (for/hash [((k pp) (in-hash d))]
+        [(Pattern-group (GroupType-dict) d) (for/hash [((k pp) (in-hash d))]
-                                                  (values k (walk pp)))]))))
+                                              (values k (walk pp)))]))))
Author	SHA1	Message	Date
Tony Garnock-Jones	9a0697e3c5	New dataspace pattern language.	2024-04-09 14:00:33 +02:00
Tony Garnock-Jones	0370c19e43	New http server protocol implementation and example	2024-04-09 13:01:27 +02:00
Tony Garnock-Jones	e6234b7713	Update noise implementation for new protocol	2024-04-09 11:36:22 +02:00
Tony Garnock-Jones	c97069375a	More dataspace logging	2024-04-09 11:35:48 +02:00
Tony Garnock-Jones	6673c2b68c	Repair comment syntax in config files	2024-04-09 11:35:22 +02:00
Tony Garnock-Jones	269dd2dc40	Merge latest changes from the syndicate-protocols repository	2024-04-09 09:15:59 +02:00
Tony Garnock-Jones	ca18ca08df	Alternative representation of dataspacePatterns	2024-04-09 09:15:21 +02:00
Tony Garnock-Jones	40ca168eac	Repair typo	2024-04-09 09:13:51 +02:00
Tony Garnock-Jones	cdb44de662	Merge latest changes from the syndicate-protocols repository	2024-04-04 16:46:01 +02:00
Tony Garnock-Jones	5a73e8d4c3	Alter dataspacePatterns language to make rec and arr more like dict	2024-04-04 16:31:09 +02:00
Tony Garnock-Jones	710ff91a64	Revise http protocol	2024-04-01 15:56:07 +02:00
Tony Garnock-Jones	c59e044695	Set embeddedType for noise	2024-03-28 15:49:48 +01:00
Tony Garnock-Jones	bf0d47f1b7	Repair noise protocol	2024-03-28 15:17:28 +01:00
Tony Garnock-Jones	7797a3cd09	Updated description of gatekeeper protocol	2024-03-22 10:11:57 +01:00
`@ -1,4 +1,4 @@`
	`; syndicate-server -c chat.pr`	`#!/usr/bin/env -S syndicate-server -c`

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