From de1dc5aa8e6546516bd18e30731e2b1238a08b6b Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sun, 24 Jan 2016 00:04:29 -0500
Subject: [PATCH] Fix "out"-related bug in monolithic implementation

---
 .../examples/example-layer.rkt                | 34 +++++++++++++++++++
 prospect-monolithic/mux.rkt                   |  4 ++-
 prospect/examples/example-layer.rkt           | 32 +++++++++++++++++
 3 files changed, 69 insertions(+), 1 deletion(-)
 create mode 100644 prospect-monolithic/examples/example-layer.rkt
 create mode 100644 prospect/examples/example-layer.rkt

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