syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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.
This commit is contained in:
Tony Garnock-Jones 2018-04-27 09:59:03 +01:00
parent ff4799b282
commit a247d8fd2b
2 changed files with 46 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
syndicate/dataspace.rkt
View File

@ -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] ;; (Setof Assertion)
[adhoc-assertions #:mutable] ;; (Bagof 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)))
(for [(a initial-assertions)]
(set->bag filtered-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 (and (not (void? assertion)) (set-member? adhoc-assertions assertion))
(set-actor-adhoc-assertions! ac (set-remove adhoc-assertions assertion))
(retract! ac assertion)))
(when (not (void? assertion))
(define-values (new-assertions summary) (bag-change (actor-adhoc-assertions ac) assertion -1))
(set-actor-adhoc-assertions! ac new-assertions)
(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 (and (not (void? assertion)) (not (set-member? adhoc-assertions assertion)))
(set-actor-adhoc-assertions! ac (set-add adhoc-assertions assertion))
(assert! ac assertion)))
(when (not (void? assertion))
(define-values (new-assertions summary) (bag-change (actor-adhoc-assertions ac) assertion +1))
(set-actor-adhoc-assertions! ac new-assertions)
(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))

23
syndicate/syntax.rkt
View File

@ -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)]