diff --git a/prospect-monolithic/examples/example-layer.rkt b/prospect-monolithic/examples/example-layer.rkt new file mode 100644 index 0000000..9927cc5 --- /dev/null +++ b/prospect-monolithic/examples/example-layer.rkt @@ -0,0 +1,34 @@ +#lang prospect-monolithic +;; Check that nested-world assertions are properly retracted. +;; Should print two "Got SCN:" tries - one nonempty, and one empty. + +#;(spawn (lambda (e s) + (match e + [(message 'die) (quit)] + [_ #f])) + (void) + (scn/union + (subscription 'die) + (subscription (observe 'die)))) + +(spawn-network + (spawn (lambda (e s) + (match e + [(message (at-meta 'die)) (quit)] + [_ #f])) + (void) + (scn/union + (subscription 'die #:meta-level 1) + (subscription (observe 'die) #:meta-level 1)))) + +(spawn (lambda (e s) + (match e + [(scn g) + (printf "Got SCN:\n") + (pretty-print-trie g) + (transition s (if (trie-non-empty? g) + (message 'die) + '()))] + [_ #f])) + (void) + (scn (subscription (observe 'die)))) diff --git a/prospect-monolithic/mux.rkt b/prospect-monolithic/mux.rkt index cc05ffb..b9bacd0 100644 --- a/prospect-monolithic/mux.rkt +++ b/prospect-monolithic/mux.rkt @@ -74,7 +74,9 @@ (values (for/list [(pid (tset->list affected-pids))] (cons pid (scn (biased-intersection new-routing-table (mux-interests-of new-m pid))))) (and (not (meta-label? label)) - (drop-scn (scn (strip-interests new-routing-table)))))) + (drop-scn (scn (trie-subtract (strip-interests new-routing-table) + (mux-interests-of new-m 'meta) + #:combiner (lambda (a b) #f))))))) (define (compute-affected-pids routing-table cover) (trie-match-trie cover diff --git a/prospect/examples/example-layer.rkt b/prospect/examples/example-layer.rkt new file mode 100644 index 0000000..637b66f --- /dev/null +++ b/prospect/examples/example-layer.rkt @@ -0,0 +1,32 @@ +#lang prospect +;; Check that nested-world assertions are properly retracted. +;; Should print two "Got SCN:" patches - one adding, and one removing (observe 'die). + +#;(spawn (lambda (e s) + (match e + [(message 'die) (quit)] + [_ #f])) + (void) + (patch-seq (sub 'die) + (sub (observe 'die)))) + +(spawn-network + (spawn (lambda (e s) + (match e + [(message (at-meta 'die)) (quit)] + [_ #f])) + (void) + (patch-seq (sub 'die #:meta-level 1) + (sub (observe 'die) #:meta-level 1)))) + +(spawn (lambda (e s) + (match e + [(? patch? p) + (printf "Got SCN:\n") + (pretty-print-patch p) + (transition s (if (patch/added? p) + (message 'die) + '()))] + [_ #f])) + (void) + (sub (observe 'die)))