From 11de40ce989db2be6be06e99bfede628254a73bc Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sat, 5 Aug 2017 19:36:15 -0400
Subject: [PATCH] Change spawn processing to include initial-assertions

---
 racket/syndicate-gl/2d.rkt                    |  4 +-
 racket/syndicate/actor.rkt                    | 49 +++++++---
 racket/syndicate/big-bang.rkt                 |  4 +-
 racket/syndicate/core.rkt                     | 62 +++++++------
 racket/syndicate/dataspace.rkt                | 93 ++++++++++---------
 .../actor/example-action-after-suspension.rkt |  5 +
 .../example-during-criterion-snapshotting.rkt |  2 +-
 .../example-responsibility-transfer-1.rkt     | 42 +++++++++
 .../example-responsibility-transfer-2.rkt     | 63 +++++++++++++
 .../actor/example-synthetic-patch.rkt         |  2 +-
 .../examples/actor/firewall-demo.rkt          | 18 ++--
 racket/syndicate/firewall.rkt                 |  6 +-
 racket/syndicate/ground.rkt                   |  4 +-
 racket/syndicate/monolithic/core.rkt          | 47 +++++-----
 racket/syndicate/relay.rkt                    |  6 +-
 racket/syndicate/supervise.rkt                |  5 +-
 racket/syndicate/threaded.rkt                 | 12 ++-
 racket/syndicate/upside-down.rkt              |  7 +-
 18 files changed, 291 insertions(+), 140 deletions(-)
 create mode 100644 racket/syndicate/examples/actor/example-responsibility-transfer-1.rkt
 create mode 100644 racket/syndicate/examples/actor/example-responsibility-transfer-2.rkt

diff --git a/racket/syndicate-gl/2d.rkt b/racket/syndicate-gl/2d.rkt
index f26ce7e..533c5c3 100644
--- a/racket/syndicate-gl/2d.rkt
+++ b/racket/syndicate-gl/2d.rkt
@@ -433,8 +433,8 @@
     (define current-touching #f)
     (define current-coordinate-maps (hash))
 
-    (define-values (proc pending-transition)
-      (actor->process+transition (dataspace-actor boot-actions)))
+    (define-values (proc pending-transition _initial-assertions-always-empty)
+      (actor->process+transition/assertions (dataspace-actor boot-actions)))
     (define event-queue (make-queue))
 
     (define target-frame-rate 60)
diff --git a/racket/syndicate/actor.rkt b/racket/syndicate/actor.rkt
index 2092a22..2c7befd 100644
--- a/racket/syndicate/actor.rkt
+++ b/racket/syndicate/actor.rkt
@@ -83,6 +83,7 @@
 (require (for-syntax racket/base))
 (require (for-syntax syntax/parse))
 (require (for-syntax syntax/srcloc))
+(require "syntax-classes.rkt")
 
 (require (prefix-in core: "core.rkt"))
 (require (prefix-in core: "dataspace.rkt"))
@@ -272,10 +273,6 @@
     (pattern (~seq #:let clauses))
     (pattern (~seq) #:attr clauses #'()))
 
-  (define-splicing-syntax-class name
-    (pattern (~seq #:name N))
-    (pattern (~seq) #:attr N #'#f))
-
   (define-splicing-syntax-class when-pred
     (pattern (~seq #:when Pred))
     (pattern (~seq) #:attr Pred #'#t))
@@ -289,33 +286,53 @@
 
 (define-syntax (actor-action stx)
   (syntax-parse stx
-    [(_ name:name script ...)
+    [(_ name:name assertions:assertions script ...)
      (quasisyntax/loc stx
        (core:make-actor
         (lambda ()
           (list actor-behavior
                 (boot-actor (lambda () (begin/void-default script ...)))
-                name.N))))]))
+                name.N))
+        assertions.P))]))
 
 (define-syntax (spawn stx)
   (syntax-parse stx
     [(_ (~or (~optional (~seq #:name name-expr) #:defaults ([name-expr #'#f])
                         #:name "#:name")
+             (~optional (~seq #:assertions assertions-expr)
+                        #:name "#:assertions")
+             (~optional (~seq #:assertions* assertions*-expr)
+                        #:name "#:assertions*")
              (~optional (~seq #:linkage [linkage-expr ...]) #:defaults ([(linkage-expr 1) '()])
                         #:name "#:linkage"))
         ...
         O ...)
      (quasisyntax/loc stx
-       (let ((spawn-action (actor-action #:name name-expr (react linkage-expr ... O ...))))
+       (let ((spawn-action (actor-action
+                            #:name name-expr
+                            #:assertions*
+                            #,(cond
+                                [(attribute assertions-expr)
+                                 (when (attribute assertions*-expr)
+                                   (raise-syntax-error
+                                    'spawn
+                                    "Both #:assertions and #:assertions* supplied"
+                                    stx))
+                                 #'(pattern->trie '<initial-spawn-assertions> assertions-expr)]
+                                [(attribute assertions*-expr)
+                                 #'assertions*-expr]
+                                [else
+                                 #'trie-empty])
+                            (react linkage-expr ... O ...))))
          (if (syndicate-effects-available?)
              (schedule-action! spawn-action)
              spawn-action)))]))
 
 (define-syntax (spawn* stx)
   (syntax-parse stx
-    [(_ name:name script ...)
+    [(_ name:name assertions:assertions script ...)
      (quasisyntax/loc stx
-       (let ((spawn-action (actor-action #:name name.N script ...)))
+       (let ((spawn-action (actor-action #:name name.N #:assertions* assertions.P script ...)))
          (if (syndicate-effects-available?)
              (schedule-action! spawn-action)
              spawn-action)))]))
@@ -485,7 +502,9 @@
 
 (define-syntax (during/spawn stx)
   (syntax-parse stx
-    [(_ P w:actor-wrapper name:name parent-let:let-option oncrash:on-crash-option O ...)
+    [(_ P w:actor-wrapper name:name assertions:assertions parent-let:let-option
+        oncrash:on-crash-option
+        O ...)
      (define E-stx (syntax/loc #'P (asserted P)))
      (define-values (_proj _pat _bindings instantiated)
        (analyze-pattern E-stx #'P))
@@ -520,6 +539,7 @@
                (w.wrapper #:linkage [(assert inst)
                                      (stop-when (retracted (observe inst)))]
                           #:name name.N
+                          #:assertions* assertions.P
                           O ...)))))]))
 
 (define-syntax (begin/dataflow stx)
@@ -1104,6 +1124,11 @@
                (current-pending-scripts (make-empty-pending-scripts))
                (current-action-transformer values)]
     (with-current-facet '() #f
+      (schedule-action! (core:retract ?))
+      ;; Retract any initial-assertions we might have been given. We
+      ;; must ensure that we explicitly maintain them: retracting them
+      ;; here prevents us from accidentally relying on their
+      ;; persistence from our creation.
       (schedule-script! script-proc)
       (run-scripts!))))
 
@@ -1186,7 +1211,9 @@
            (struct-out endpoint)
 
            suspend-script
-           suspend-script*))
+           suspend-script*
+
+           capture-actor-actions))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Script suspend-and-resume.
diff --git a/racket/syndicate/big-bang.rkt b/racket/syndicate/big-bang.rkt
index 9c068c1..190ca0d 100644
--- a/racket/syndicate/big-bang.rkt
+++ b/racket/syndicate/big-bang.rkt
@@ -133,8 +133,8 @@
              (assert (active-window active-id))))
 
 (define-syntax-rule (big-bang-dataspace* boot-actions extra-clause ...)
-  (let-values (((proc initial-transition)
-                (actor->process+transition (dataspace-actor boot-actions))))
+  (let-values (((proc initial-transition _initial-assertions-always-empty)
+                (actor->process+transition/assertions (dataspace-actor boot-actions))))
     (big-bang (interpret-actions (bb proc
                                      '()
                                      '()
diff --git a/racket/syndicate/core.rkt b/racket/syndicate/core.rkt
index 4d5840b..5fddaee 100644
--- a/racket/syndicate/core.rkt
+++ b/racket/syndicate/core.rkt
@@ -62,7 +62,8 @@
          clean-transition
 
          update-process-state
-         actor->process+transition)
+         boot->process+transition
+         actor->process+transition/assertions)
 
 (require racket/match)
 (require (only-in racket/list flatten))
@@ -71,11 +72,16 @@
 (require "mux.rkt")
 (require "pretty.rkt")
 
+(require (for-syntax racket/base))
+(require (for-syntax syntax/parse))
+(require (for-syntax syntax/srcloc))
+(require "syntax-classes.rkt")
+
 ;; Events = Patches ∪ Messages
 (struct message (body) #:prefab)
 
 ;; Actions ⊃ Events
-(struct actor (boot) #:prefab)
+(struct actor (boot initial-assertions) #:prefab)
 (struct quit-dataspace () #:prefab) ;; NB. An action. Compare (quit), a Transition.
 
 ;; A Behavior is a ((Option Event) Any -> Transition): a function
@@ -160,14 +166,18 @@
 (define (update-process-state i new-state)
   (struct-copy process i [state new-state]))
 
-(define (actor->process+transition s)
-  (match-define (list beh t name) ((actor-boot s)))
+(define (boot->process+transition boot-proc)
+  (match-define (list beh t name) (boot-proc))
   (values (process name beh 'undefined-initial-state) t))
 
+(define (actor->process+transition/assertions s)
+  (define-values (proc t) (boot->process+transition (actor-boot s)))
+  (values proc t (actor-initial-assertions s)))
+
 (define (make-quit #:exception [exn #f] . actions)
   (quit exn actions))
 
-(define (make-actor actor-producing-thunk)
+(define (make-actor actor-producing-thunk initial-assertions)
   (actor (let ((parameterization (current-parameterization)))
            (lambda ()
              (call-with-parameterization
@@ -179,32 +189,26 @@
                            (call-with-parameterization parameterization (lambda () (raw-beh e s))))
                          txn
                          name)]
-                  [other other]))))))) ;; punt on error checking to dataspace boot code
+                  [other other]))))) ;; punt on error checking to dataspace boot code
+         initial-assertions))
 
-(define-syntax boot-process
-  (syntax-rules ()
-    [(_ #:name name-exp behavior-exp initial-state-exp initial-action-tree-exp)
-     (make-actor (lambda ()
-                   (list behavior-exp
-                         (transition initial-state-exp initial-action-tree-exp)
-                         name-exp)))]
-    [(_ behavior-exp initial-state-exp initial-action-tree-exp)
-     (make-actor (lambda ()
-                   (list behavior-exp
-                         (transition initial-state-exp initial-action-tree-exp)
-                         #f)))]))
+(define-syntax (boot-process stx)
+  (syntax-parse stx
+    [(_ name:name assertions:assertions behavior-exp initial-state-exp initial-action-tree-exp)
+     #'(make-actor (lambda ()
+                     (list behavior-exp
+                           (transition initial-state-exp initial-action-tree-exp)
+                           name.N))
+                   assertions.P)]))
 
-(define-syntax actor/stateless
-  (syntax-rules ()
-    [(_ #:name name-exp behavior-exp initial-action-tree-exp)
-     (boot-process #:name name-exp
-                    (stateless-behavior-wrap behavior-exp)
-                    (void)
-                    initial-action-tree-exp)]
-    [(_ behavior-exp initial-action-tree-exp)
-     (boot-process (stateless-behavior-wrap behavior-exp)
-                    (void)
-                    initial-action-tree-exp)]))
+(define-syntax (actor/stateless stx)
+  (syntax-parse stx
+    [(_ name:name assertions:assertions behavior-exp initial-action-tree-exp)
+     #'(boot-process #:name name.N
+                     #:assertions* assertions.P
+                     (stateless-behavior-wrap behavior-exp)
+                     (void)
+                     initial-action-tree-exp)]))
 
 (define ((stateless-behavior-wrap b) e state)
   (match (b e)
diff --git a/racket/syndicate/dataspace.rkt b/racket/syndicate/dataspace.rkt
index 331d2db..a349c3c 100644
--- a/racket/syndicate/dataspace.rkt
+++ b/racket/syndicate/dataspace.rkt
@@ -20,6 +20,11 @@
 (require "core.rkt")
 (require "protocol/standard-relay.rkt")
 
+(require (for-syntax racket/base))
+(require (for-syntax syntax/parse))
+(require (for-syntax syntax/srcloc))
+(require "syntax-classes.rkt")
+
 ;; Sentinel
 (define missing-process (process #f #f #f))
 
@@ -109,14 +114,11 @@
      (queue-append-list (dataspace-pending-action-queue w)
                         (for/list [(a actions)] (cons label a)))]))
 
-(define-syntax dataspace-actor
-  (syntax-rules ()
-    [(dataspace-actor #:name name-exp boot-action ...)
-     (spawn-standard-relay
-      (make-dataspace-actor #:name name-exp (lambda () (list boot-action ...))))]
-    [(dataspace-actor boot-action ...)
-     (spawn-standard-relay
-      (make-dataspace-actor (lambda () (list boot-action ...))))]))
+(define-syntax (dataspace-actor stx)
+  (syntax-parse stx
+    [(dataspace-actor name:name boot-action ...)
+     #'(spawn-standard-relay
+        (make-dataspace-actor #:name name.N (lambda () (list boot-action ...))))]))
 
 (define (make-dataspace boot-actions)
   (dataspace (mux)
@@ -128,7 +130,8 @@
   (<actor> (lambda ()
              (list dataspace-handle-event
                    (transition (make-dataspace (boot-actions-thunk)) '())
-                   name))))
+                   name))
+           trie-empty))
 
 (define (inert? w)
   (and (queue-empty? (dataspace-pending-action-queue w))
@@ -156,7 +159,7 @@
 
 (define ((perform-action label a) w)
   (match a
-    [(<actor> boot)
+    [(<actor> boot initial-assertions)
      (invoke-process (mux-next-pid (dataspace-mux w)) ;; anticipate pid allocation
                      (lambda ()
                        (match (boot)
@@ -168,7 +171,7 @@
                                  other)]))
                      (lambda (results)
                        (match-define (list behavior initial-transition name) results)
-                       (create-process label w behavior initial-transition name))
+                       (create-process label w behavior initial-transition initial-assertions name))
                      (lambda (exn)
                        (log-error "Spawned process in dataspace ~a died with exception:\n~a"
                                   (current-actor-path)
@@ -198,40 +201,40 @@
     [(targeted-event (cons pid remaining-path) e)
      (transition (send-event/guard label (target-event remaining-path e) pid w) '())]))
 
-(define (create-process parent-label w behavior initial-transition name)
-  (if (not initial-transition)
-      (transition w '()) ;; Uh, ok
-      (let ()
-        (define-values (postprocess initial-state initial-actions)
-          (match (clean-transition initial-transition)
-            [(and q (<quit> exn initial-actions0))
-             (values (lambda (w pid)
-                       (trace-actor-spawn parent-label pid (process name behavior (void)))
-                       (trace-actor-exit pid exn)
-                       (disable-process pid exn w))
-                     #f
-                     (append initial-actions0 (list 'quit)))]
-            [(and t (transition initial-state initial-actions0))
-             (values (lambda (w pid)
-                       (trace-actor-spawn parent-label pid (process name behavior initial-state))
-                       (mark-pid-runnable w pid))
-                     initial-state
-                     initial-actions0)]))
-        (define-values (initial-patch remaining-initial-actions)
-          (match initial-actions
-            [(cons (? patch? p) rest) (values p rest)]
-            [other (values patch-empty other)]))
-        (define-values (new-mux new-pid delta delta-aggregate)
-          (mux-add-stream (dataspace-mux w) initial-patch))
-        (let* ((w (struct-copy dataspace w
-                               [process-table (hash-set (dataspace-process-table w)
-                                                        new-pid
-                                                        (process name
-                                                                 behavior
-                                                                 initial-state))]))
-               (w (enqueue-actions (postprocess w new-pid) new-pid remaining-initial-actions)))
-          (trace-action-produced new-pid initial-patch)
-          (deliver-patches w new-mux new-pid delta delta-aggregate)))))
+(define (create-process parent-label w behavior initial-transition initial-assertions name)
+  (define-values (postprocess initial-state initial-actions)
+    (match (clean-transition initial-transition)
+      [#f
+       (values (lambda (w pid)
+                 (trace-actor-spawn parent-label pid (process name behavior (void)))
+                 w)
+               #f
+               '())]
+      [(and q (<quit> exn initial-actions0))
+       (values (lambda (w pid)
+                 (trace-actor-spawn parent-label pid (process name behavior (void)))
+                 (trace-actor-exit pid exn)
+                 (disable-process pid exn w))
+               #f
+               (append initial-actions0 (list 'quit)))]
+      [(and t (transition initial-state initial-actions0))
+       (values (lambda (w pid)
+                 (trace-actor-spawn parent-label pid (process name behavior initial-state))
+                 (mark-pid-runnable w pid))
+               initial-state
+               initial-actions0)]))
+  (define initial-patch (patch initial-assertions trie-empty))
+  (define-values (new-mux new-pid delta delta-aggregate)
+    (mux-add-stream (dataspace-mux w) initial-patch))
+  (let* ((w (struct-copy dataspace w
+              [process-table (hash-set (dataspace-process-table w)
+                                       new-pid
+                                       (process name
+                                                behavior
+                                                initial-state))]))
+         (w (enqueue-actions (postprocess w new-pid) new-pid initial-actions)))
+    (trace-action-produced new-pid initial-patch)
+    (deliver-patches w new-mux new-pid delta delta-aggregate)))
 
 (define (deliver-patches w new-mux acting-label delta delta-aggregate)
   (define-values (patches meta-action)
diff --git a/racket/syndicate/examples/actor/example-action-after-suspension.rkt b/racket/syndicate/examples/actor/example-action-after-suspension.rkt
index 527beb8..8bebc8f 100644
--- a/racket/syndicate/examples/actor/example-action-after-suspension.rkt
+++ b/racket/syndicate/examples/actor/example-action-after-suspension.rkt
@@ -5,6 +5,11 @@
 ;;
 ;; Expected output:
 ;;     flag: 'clear
+;;     flag: 'set
+;;     - '(saw ping)
+;;
+;; Previously expected output:
+;;     flag: 'clear
 ;;     - 'first
 ;;     flag: 'set
 ;;     - '(saw ping)
diff --git a/racket/syndicate/examples/actor/example-during-criterion-snapshotting.rkt b/racket/syndicate/examples/actor/example-during-criterion-snapshotting.rkt
index d0dc1a0..a51c1f5 100644
--- a/racket/syndicate/examples/actor/example-during-criterion-snapshotting.rkt
+++ b/racket/syndicate/examples/actor/example-during-criterion-snapshotting.rkt
@@ -9,8 +9,8 @@
 ;;
 ;; Correct output:
 ;; x=123 v=999
-;; finally for x=124 v=999
 ;; x=124 v=999
+;; finally for x=124 v=999
 ;;
 ;; Should eventually be turned into some kind of test case.
 
diff --git a/racket/syndicate/examples/actor/example-responsibility-transfer-1.rkt b/racket/syndicate/examples/actor/example-responsibility-transfer-1.rkt
new file mode 100644
index 0000000..a786526
--- /dev/null
+++ b/racket/syndicate/examples/actor/example-responsibility-transfer-1.rkt
@@ -0,0 +1,42 @@
+#lang syndicate/actor
+;; Demonstrates glitch preservation in during/spawn.
+;;
+;; Previously, `spawn` was expanded in place into the new actor's
+;; initial actions. This reordering was confusing, as demonstrated
+;; here: the reordering of `spawn` ahead of the retraction of previous
+;; supply caused uninterrupted supply, even though demand had glitched
+;; and the supply instance had been replaced.
+;;
+;; Buggy output:
+;;
+;; Asserting demand.
+;; Supply asserted.
+;; Glitching demand.
+;; Demand now steady.
+;;
+;; Correct output:
+;;
+;; Asserting demand.
+;; Supply asserted.
+;; Glitching demand.
+;; Demand now steady.
+;; Supply retracted.
+;; Supply asserted.
+
+(spawn (during/spawn 'demand
+         (assert 'intermediate-demand)))
+
+(spawn (during/spawn 'intermediate-demand
+         (assert 'supply)))
+
+(spawn* (react (on (asserted 'supply) (printf "Supply asserted.\n"))
+               (on (retracted 'supply) (printf "Supply retracted.\n")))
+        (until (asserted (observe 'demand)))
+        (printf "Asserting demand.\n")
+        (assert! 'demand)
+        (until (asserted 'supply))
+        (printf "Glitching demand.\n")
+        (retract! 'demand)
+        (flush!)
+        (assert! 'demand)
+        (printf "Demand now steady.\n"))
diff --git a/racket/syndicate/examples/actor/example-responsibility-transfer-2.rkt b/racket/syndicate/examples/actor/example-responsibility-transfer-2.rkt
new file mode 100644
index 0000000..9708543
--- /dev/null
+++ b/racket/syndicate/examples/actor/example-responsibility-transfer-2.rkt
@@ -0,0 +1,63 @@
+#lang syndicate/actor
+;; Demonstrates responsibility transfer.
+;;
+;; Previously, `spawn` was expanded in place into the new actor's
+;; initial actions. This reordering was confusing, as demonstrated in
+;; example-responsibility-transfer-1.rkt, motivating a change in the
+;; `actor` constructor to make it carry not only a boot procedure but
+;; a set of initial assertions.
+;;
+;; Correct output:
+;;
+;; Supply 1 asserted.
+;;
+;; If only (A) is commented out:
+;;
+;; Supply 1 asserted.
+;; Supply 1 retracted.
+;; Supply 1 asserted.
+;;
+;; We see this because `service-1`'s initial patch takes effect
+;; *after* previously queued actions -- namely, the patch from
+;; `factory-1` retracting (observe (list 'X 1)). The effect of the
+;; #:assertions clause is to start `service-1` off with some
+;; assertions even before it has produced any actions at all.
+;;
+;; If only (B) is commented out:
+;;
+;; Supply 1 asserted.
+;; Supply 1 retracted.
+;;
+;; We see this because even though `service-1` is given initial
+;; assertions, the HLL *clears them* as part of its startup. It
+;; requires the user to explicitly add endpoints for the assertions to
+;; be maintained. Think of the `#:assertions` as *transient*, just for
+;; the transition between the startup and normal running phases.
+;;
+;; If both (A) and (B) are commented out:
+;;
+;; Supply 1 asserted.
+;; Supply 1 retracted.
+;;
+;; This is straightforwardly because once `factory-1`'s assertion of
+;; (observe (list 'X 1)) is withdrawn, there are no instructions for
+;; any other party to take it over.
+
+(spawn #:name 'factory-1
+       (on (asserted (list 'X 1))
+           (spawn #:name 'service-1
+                  #:assertions (observe (list 'X 1))  ;; (A)
+                  (stop-when (retracted (list 'X 1))) ;; (B)
+                  (on (message 'dummy))) ;; exists just to keep the
+                                         ;; service alive if there are
+                                         ;; no other endpoints
+           ;; spawn executes *before* teardown of this on-asserted
+           ;; endpoint, and thus before the patch withdrawing (observe
+           ;; (list 'X 1)).
+           (stop-current-facet)))
+
+(spawn (on (asserted (observe (list 'X $supplier)))
+           (printf "Supply ~v asserted.\n" supplier)
+           (assert! (list 'X supplier)))
+       (on (retracted (observe (list 'X $supplier)))
+           (printf "Supply ~v retracted.\n" supplier)))
diff --git a/racket/syndicate/examples/actor/example-synthetic-patch.rkt b/racket/syndicate/examples/actor/example-synthetic-patch.rkt
index 116b211..287a5e0 100644
--- a/racket/syndicate/examples/actor/example-synthetic-patch.rkt
+++ b/racket/syndicate/examples/actor/example-synthetic-patch.rkt
@@ -14,9 +14,9 @@
 ;;
 ;; +outer "first"
 ;; +show
+;; +outer "second"
 ;; -show
 ;; -outer "first"
-;; +outer "second"
 ;; +show
 ;;
 ;; Should eventually be turned into some kind of test case.
diff --git a/racket/syndicate/examples/actor/firewall-demo.rkt b/racket/syndicate/examples/actor/firewall-demo.rkt
index ab5b81e..5fade94 100644
--- a/racket/syndicate/examples/actor/firewall-demo.rkt
+++ b/racket/syndicate/examples/actor/firewall-demo.rkt
@@ -12,6 +12,15 @@
        (on (retracted (a $v))
            (printf "Retracted: ~v\n" v)))
 
+(firewall [(allow (observe (m 'ok1)))
+           (allow (observe (a 'ok1)))]
+          (on (asserted $x)
+              (printf "Observed assertion ~v\n" x))
+          (on (retracted $x)
+              (printf "Observed retraction ~v\n" x))
+          (on (message $x)
+              (printf "Observed message ~v\n" x)))
+
 (firewall [(allow (m 'ok1))
            (allow (m 'ok2))]
           (on-start (send! (m 'ok1))
@@ -48,12 +57,3 @@
           (on-start (firewall [(allow ?)
                                (forbid (a 'ok-parent2))]
                               (assert (a _)))))
-
-(firewall [(allow (observe (m 'ok1)))
-           (allow (observe (a 'ok1)))]
-          (on (asserted $x)
-              (printf "Observed assertion ~v\n" x))
-          (on (retracted $x)
-              (printf "Observed retraction ~v\n" x))
-          (on (message $x)
-              (printf "Observed message ~v\n" x)))
diff --git a/racket/syndicate/firewall.rkt b/racket/syndicate/firewall.rkt
index e3d2c34..bb7f3a6 100644
--- a/racket/syndicate/firewall.rkt
+++ b/racket/syndicate/firewall.rkt
@@ -50,10 +50,12 @@
 
 (define (spawn-firewall limit inner-spawn)
   (make-actor (lambda ()
-                (define-values (proc initial-transition) (actor->process+transition inner-spawn))
+                (define-values (proc initial-transition)
+                  (boot->process+transition (actor-boot inner-spawn)))
                 (list firewall-handle-event
                       (firewall-transition initial-transition (firewall limit proc))
-                      (process-name proc)))))
+                      (process-name proc)))
+              (limit-trie limit (actor-initial-assertions inner-spawn))))
 
 (define (firewall-transition t f)
   (match t
diff --git a/racket/syndicate/ground.rkt b/racket/syndicate/ground.rkt
index fdd5f4e..a65be30 100644
--- a/racket/syndicate/ground.rkt
+++ b/racket/syndicate/ground.rkt
@@ -175,5 +175,5 @@
 ;; actor -> AssertionSet
 ;; Returns the final set of active assertions at groundmost level.
 (define (run-ground* s)
-  (define-values (proc t) (actor->process+transition s))
-  (process-transition t proc trie-empty 0))
+  (define-values (proc t initial-assertions) (actor->process+transition/assertions s))
+  (process-transition t proc initial-assertions 0))
diff --git a/racket/syndicate/monolithic/core.rkt b/racket/syndicate/monolithic/core.rkt
index a30e887..f1f55c4 100644
--- a/racket/syndicate/monolithic/core.rkt
+++ b/racket/syndicate/monolithic/core.rkt
@@ -21,6 +21,11 @@
 (require racket/match)
 (require (only-in racket/list flatten))
 
+(require (for-syntax racket/base))
+(require (for-syntax syntax/parse))
+(require (for-syntax syntax/srcloc))
+(require "../syntax-classes.rkt")
+
 (require "scn.rkt")
 (require "../trie.rkt")
 (require (except-in "../core.rkt"
@@ -120,32 +125,24 @@
                                             [state new-underlying-state])
                                monolithic-actions)])))
 
-(define-syntax actor-monolithic
-  (syntax-rules ()
-    [(_ #:name name-exp behavior-exp initial-state-exp initial-action-tree-exp)
-     (make-actor (lambda ()
-                   (list (wrap-monolithic-behaviour behavior-exp)
-                         (differentiate-outgoing (wrap-monolithic-state initial-state-exp)
-                                                 (clean-actions initial-action-tree-exp))
-                         name-exp)))]
-    [(_ behavior-exp initial-state-exp initial-action-tree-exp)
-     (make-actor (lambda ()
-                   (list (wrap-monolithic-behaviour behavior-exp)
-                         (differentiate-outgoing (wrap-monolithic-state initial-state-exp)
-                                                 (clean-actions initial-action-tree-exp))
-                         #f)))]))
+(define-syntax (actor-monolithic stx)
+  (syntax-parse stx
+    [(_ name:name assertions:assertions behavior-exp initial-state-exp initial-action-tree-exp)
+     #'(make-actor (lambda ()
+                     (list (wrap-monolithic-behaviour behavior-exp)
+                           (differentiate-outgoing (wrap-monolithic-state initial-state-exp)
+                                                   (clean-actions initial-action-tree-exp))
+                           name.N))
+                   assertions.P)]))
 
-(define-syntax actor-monolithic/stateless
-  (syntax-rules ()
-    [(_ #:name name-exp behavior-exp initial-action-tree-exp)
-     (actor-monolithic #:name name-exp
-                       (stateless-behavior-wrap behavior-exp)
-                       (void)
-                       initial-action-tree-exp)]
-    [(_ behavior-exp initial-action-tree-exp)
-     (actor-monolithic (stateless-behavior-wrap behavior-exp)
-                       (void)
-                       initial-action-tree-exp)]))
+(define-syntax (actor-monolithic/stateless stx)
+  (syntax-parse stx
+    [(_ name:name assertions:assertions behavior-exp initial-action-tree-exp)
+     #'(actor-monolithic #:name name.N
+                         #:assertions* assertions.P
+                         (stateless-behavior-wrap behavior-exp)
+                         (void)
+                         initial-action-tree-exp)]))
 
 (define ((stateless-behavior-wrap b) e state)
   (match (b e)
diff --git a/racket/syndicate/relay.rkt b/racket/syndicate/relay.rkt
index f33fe13..ace70bb 100644
--- a/racket/syndicate/relay.rkt
+++ b/racket/syndicate/relay.rkt
@@ -91,7 +91,8 @@
                      inbound-parenthesis
                      inner-spawn)
   (make-actor (lambda ()
-                (define-values (proc initial-transition) (actor->process+transition inner-spawn))
+                (define-values (proc initial-transition)
+                  (boot->process+transition (actor-boot inner-spawn)))
                 (define initial-relay-state (relay outbound?
                                                    outbound-assertion
                                                    outbound-parenthesis
@@ -103,7 +104,8 @@
                        (transition-bind (inject-relay-subscription initial-relay-state)
                                         initial-transition)
                        initial-relay-state)
-                      (process-name proc)))))
+                      (process-name proc)))
+              (actor-initial-assertions inner-spawn)))
 
 (define (pretty-print-relay r p)
   (fprintf p "RELAY ~a/~a\n"
diff --git a/racket/syndicate/supervise.rkt b/racket/syndicate/supervise.rkt
index e67547c..26a40f8 100644
--- a/racket/syndicate/supervise.rkt
+++ b/racket/syndicate/supervise.rkt
@@ -124,10 +124,11 @@
                (on-start
                 (catch-exns
                  (lambda ()
-                   (define-values (initial-proc initial-transition)
-                     (actor->process+transition supervisee-spawn-action))
+                   (define-values (initial-proc initial-transition initial-assertions)
+                     (actor->process+transition/assertions supervisee-spawn-action))
                    (proc initial-proc)
                    (supervisee-name (process-name initial-proc))
+                   (patch! (patch initial-assertions trie-empty))
                    initial-transition)
                  handle-transition!))
 
diff --git a/racket/syndicate/threaded.rkt b/racket/syndicate/threaded.rkt
index 24150e1..5052eb7 100644
--- a/racket/syndicate/threaded.rkt
+++ b/racket/syndicate/threaded.rkt
@@ -10,6 +10,7 @@
 
 (require (except-in syndicate dataspace))
 (require (only-in syndicate/actor spawn spawn* dataspace schedule-action!))
+(require (only-in (submod syndicate/actor implementation-details) capture-actor-actions))
 (require syndicate/hierarchy)
 (require syndicate/store)
 
@@ -29,9 +30,11 @@
      #f]))
 
 (define (spawn-threaded-actor spawn-action-thunk)
+  (match-define (list (<actor> boot-proc initial-assertions))
+    (clean-actions (capture-actor-actions spawn-action-thunk)))
   (make-actor (lambda ()
                 (define path (current-actor-path))
-                (define thd (thread (lambda () (run-thread path spawn-action-thunk))))
+                (define thd (thread (lambda () (run-thread path boot-proc))))
                 (thread (lambda ()
                           (sync (thread-dead-evt thd))
                           (send-ground-message (thread-quit #f '()) #:path path)
@@ -39,9 +42,10 @@
                 (signal-background-activity! #t)
                 (list proxy-behaviour
                       (transition (proxy-state thd) '())
-                      'threaded-proxy))))
+                      'threaded-proxy))
+              initial-assertions))
 
-(define (run-thread actor-path spawn-action-thunk)
+(define (run-thread actor-path boot-proc)
   (define actor-path-rev (reverse actor-path))
 
   (define (process-transition proc t)
@@ -65,7 +69,7 @@
     (signal-background-activity! #f)
     (deliver-event (thread-receive) proc))
 
-  (call-with-values (lambda () (actor->process+transition (spawn-action-thunk)))
+  (call-with-values (lambda () (boot->process+transition boot-proc))
                     process-transition))
 
 (define-syntax spawn/thread
diff --git a/racket/syndicate/upside-down.rkt b/racket/syndicate/upside-down.rkt
index 4eb00a2..d512ff1 100644
--- a/racket/syndicate/upside-down.rkt
+++ b/racket/syndicate/upside-down.rkt
@@ -46,10 +46,11 @@ this facility for testing.
 (define (spawn-upside-down inner-spawn)
   (make-actor (lambda ()
                 (define-values (proc initial-transition)
-                  (actor->process+transition inner-spawn))
+                  (boot->process+transition (actor-boot inner-spawn)))
                 (list (upside-down-behavior (process-behavior proc))
                       (upside-down-transition initial-transition)
-                      (process-name proc)))))
+                      (process-name proc)))
+              (actor-initial-assertions inner-spawn)))
 
 ;; Transition -> Transition
 (define (upside-down-transition t)
@@ -111,4 +112,4 @@ this facility for testing.
 (define (turn-trie-rightside-up t)
   (define upside-downs (trie-project t (upside-down (?!))))
   (define inbounds (trie-project t (?! (inbound ?))))
-  (trie-union upside-downs inbounds))
\ No newline at end of file
+  (trie-union upside-downs inbounds))