Switch adhoc-assertions to a bag (from a set).

This repairs a bug regarding crashes in a new actor's boot-proc.

Previously, if boot-proc raised an exception, the initial assertions
would stick around forever. By changing adhoc-assertions to a bag
rather than a set, and putting the initial assertions in the bag, we
put them somewhere they are guaranteed to be processed during actor
termination, even when an exception is signalled during boot.

This is an API change wrt the previous Syndicate implementation:
assert!/retract! now have bag semantics, not set semantics. We can add
set-semantics APIs if we end up needing them, of course, layered on
top of the bag implementation.

syndicate/dataspace.rkt

@@ -82,7 +82,7 @@
                    ;; v TODO: Caches have to be bags, not sets; once
                    ;; this change is made, can I avoid keeping a bag
                    ;; of assertions in the dataspace as a whole?
-                   assertions ;; (Bagof Assertion)
+                   assertions ;; (MutableBagof Assertion)
                    dataflow ;; DataflowGraph
                    [runnable #:mutable] ;; (Listof Actor)
                    [pending-actions #:mutable] ;; (Queueof ActionGroup)
@@ -94,8 +94,7 @@
                [runnable? #:mutable] ;; Boolean
                pending-scripts ;; (MutableVectorof (Queueof (-> Any)))
                [pending-actions #:mutable] ;; (Queueof Action)
-               ;; TODO: consider using a bag, rather than set, of ad-hoc assertions.
+               [adhoc-assertions #:mutable] ;; (Bagof Assertion)
-               [adhoc-assertions #:mutable] ;; (Setof Assertion)
                )
   #:methods gen:custom-write
   [(define (write-proc a p mode)
@@ -224,14 +223,15 @@
 
 (define (add-actor! ds name boot-proc initial-assertions)
   (define the-actor-id (generate-id! ds))
+  (define filtered-initial-assertions (set-remove initial-assertions (void)))
   (define the-actor (actor the-actor-id
                            name
                            #f
                            #f
                            (make-vector priority-count (make-queue))
                            (make-queue)
-                           (set)))
+                           (set->bag filtered-initial-assertions)))
-  (for [(a initial-assertions)]
+  (for [(a filtered-initial-assertions)]
     (match (bag-change! (dataspace-assertions ds) a 1)
       ['absent->present (add-assertion! (dataspace-routing-table ds) a)]
       ;; 'absent->absent and 'present->absent absurd
@@ -242,7 +242,8 @@
               #f
               (lambda ()
                 (boot-proc)
-                (for [(a initial-assertions)] (retract! the-actor a)))))
+                (for [(a filtered-initial-assertions)]
+                  (adhoc-retract! the-actor a)))))
 
 (define-syntax-rule (with-current-facet [ds0 a0 f0 script?] body ...)
   (let ((ds ds0)
@@ -413,7 +414,7 @@
 ;; Abruptly terminates an entire actor, without running stop-scripts etc.
 (define (terminate-actor! ds the-actor)
   (push-script! ds the-actor
-                (lambda () (for [(a (in-set (actor-adhoc-assertions the-actor)))]
+                (lambda () (for [(a (in-bag (actor-adhoc-assertions the-actor)))]
                              (retract! the-actor a))))
   (let ((f (actor-root-facet the-actor)))
     (when f
@@ -495,16 +496,24 @@
     (bag-change! (ensure-patch-action! ac) assertion +1)))
 
 (define (adhoc-retract! ac assertion)
-  (define adhoc-assertions (actor-adhoc-assertions ac))
+  (when (not (void? assertion))
-  (when (and (not (void? assertion)) (set-member? adhoc-assertions assertion))
+    (define-values (new-assertions summary) (bag-change (actor-adhoc-assertions ac) assertion -1))
-    (set-actor-adhoc-assertions! ac (set-remove adhoc-assertions assertion))
+    (set-actor-adhoc-assertions! ac new-assertions)
-    (retract! ac assertion)))
+    (match summary
+      ;; 'absent->absent and 'absent->present absurd (if the call to
+      ;; `adhoc-retract!` matches a previous `adhoc-assert!`)
+      ['present->absent (retract! ac assertion)]
+      ['present->present (void)])))
 
 (define (adhoc-assert! ac assertion)
-  (define adhoc-assertions (actor-adhoc-assertions ac))
+  (when (not (void? assertion))
-  (when (and (not (void? assertion)) (not (set-member? adhoc-assertions assertion)))
+    (define-values (new-assertions summary) (bag-change (actor-adhoc-assertions ac) assertion +1))
-    (set-actor-adhoc-assertions! ac (set-add adhoc-assertions assertion))
+    (set-actor-adhoc-assertions! ac new-assertions)
-    (assert! ac assertion)))
+    (match summary
+      ;; 'absent->absent and 'present->absent absurd (assuming there
+      ;; haven't been too many calls to `adhoc-retract!` in the past)
+      ['absent->present (assert! ac assertion)]
+      ['present->present (void)])))
 
 (define (dataspace-unsubscribe! ds h)
   (remove-interest! (dataspace-routing-table ds) h))

syndicate/syntax.rkt

@@ -616,6 +616,26 @@
           ;; stop script), we will never retract an assertion more or
           ;; fewer than the correct number of times.
 
+          ;; Expected output:
+          ;;
+          ;; marker appeared
+          ;; marker disappeared
+          ;;
+          ;; (plus the exception report for "Deliberate error")
+
+          (spawn #:assertions ['marker]
+                 (error 'test-case "Deliberate error")
+                 (void))
+
+          (spawn (on (asserted 'marker) (printf "marker appeared\n"))
+                 (on (retracted 'marker) (printf "marker disappeared\n")))
+          )
+
+        #;(lambda ()
+          ;; Goal: no matter the circumstances (e.g. exception in a
+          ;; stop script), we will never retract an assertion more or
+          ;; fewer than the correct number of times.
+
           ;; Test cleanup after exception in stop script
           ;;
           ;; Correct output:
@@ -739,7 +759,8 @@
                   (retract! (entry 'c 33))
                   (assert! (entry 'a 9))
                   (pause)
-                  (for [(a (current-adhoc-assertions))]
+                  (local-require "bag.rkt")
+                  (for [(a (in-bag (current-adhoc-assertions)))]
                     (local-require racket/match)
                     (match a
                       [(entry 'a _) (retract! a)]