From fd7dc03dc6396a268236486393c2faf5e2dfb1d0 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sun, 7 Feb 2016 19:32:38 -0500
Subject: [PATCH] Echo cancellation for prospect-monolithic. Still deciding how
 best to address incremental variant.

---
 prospect-monolithic/core.rkt                     |  3 ++-
 .../examples/example-meta-echo.rkt               | 14 +++++++-------
 prospect-monolithic/mux.rkt                      | 16 +++++++++++++++-
 3 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/prospect-monolithic/core.rkt b/prospect-monolithic/core.rkt
index 7cacd58..9f53497 100644
--- a/prospect-monolithic/core.rkt
+++ b/prospect-monolithic/core.rkt
@@ -410,12 +410,13 @@
 
 (define (deliver-scns w new-mux acting-label s aggregate-assertions)
   (define old-mux (network-mux w))
+  (define old-echo-cancelled-assertions (echo-cancelled-routing-table old-mux))
   (define-values (scns meta-action)
     (compute-scns old-mux new-mux acting-label s aggregate-assertions))
   (transition (for/fold [(w (struct-copy network w [mux new-mux]))]
                         [(entry (in-list scns))]
                 (match-define (cons label (and event (scn new-assertions))) entry)
-                (if (equal? (biased-intersection (mux-routing-table old-mux)
+                (if (equal? (biased-intersection old-echo-cancelled-assertions
                                                  (mux-interests-of old-mux label))
                             new-assertions)
                     w
diff --git a/prospect-monolithic/examples/example-meta-echo.rkt b/prospect-monolithic/examples/example-meta-echo.rkt
index 7f0eca3..4527254 100644
--- a/prospect-monolithic/examples/example-meta-echo.rkt
+++ b/prospect-monolithic/examples/example-meta-echo.rkt
@@ -1,16 +1,16 @@
 #lang prospect-monolithic
-;; Demonstrates a (hopefully soon historical!) bug in Syndicate.
+;; Test case for a historical bug in Syndicate.
 ;;
-;; When the bug exists, this program receives four SCN events in
+;; When the bug existed, this program receiveed four SCN events in
 ;; total, whereas it should receive only two.
 ;;
-;; While metamessages are "echo cancelled", and receivers only ever
-;; get one copy of a sent metamessage no matter how many metas there
-;; are, state changes are not (yet). Issuing a quick enough "pulse" of
-;; metaassertion while maintaining interest in it leads to an "echo":
+;; While metamessages were "echo cancelled", and receivers only ever
+;; got one copy of a sent metamessage no matter how many metas there
+;; were, state changes were not. Issuing a quick enough "pulse" of
+;; metaassertion while maintaining interest in it led to an "echo":
 ;; multiple receipts of the pulse.
 ;;
-;; The fix is to adjust the implementation of state change
+;; The fix was to adjust the implementation of state change
 ;; notifications to cancel the echo for metaassertions.
 
 (require prospect/pretty)
diff --git a/prospect-monolithic/mux.rkt b/prospect-monolithic/mux.rkt
index 106c2a2..a2ec45b 100644
--- a/prospect-monolithic/mux.rkt
+++ b/prospect-monolithic/mux.rkt
@@ -9,6 +9,7 @@
          mux-update-stream
          mux-route-message
          mux-interests-of
+         echo-cancelled-routing-table
          compute-scns
          compute-affected-pids
          pretty-print-mux)
@@ -65,14 +66,27 @@
           new-scn ;; unnecessary?
           aggregate-assertions))
 
+(define at-meta-everything (pattern->trie #t (at-meta ?)))
+(define only-meta (datum-tset 'meta))
+
+(define (echo-cancelled-routing-table m)
+  (trie-subtract (mux-routing-table m)
+                 at-meta-everything
+                 #:combiner (lambda (v1 v2)
+                              (if (tset-member? v1 'meta)
+                                  only-meta
+                                  #f))))
+
 (define (compute-scns old-m new-m label s aggregate-assertions)
   (define old-routing-table (mux-routing-table old-m))
   (define new-routing-table (mux-routing-table new-m))
+  (define echo-cancelled-assertions (echo-cancelled-routing-table new-m))
   (define affected-pids
     (let ((pids (compute-affected-pids old-routing-table aggregate-assertions))) ;; hmm
       (tset-remove (tset-add pids label) 'meta))) ;; TODO: removing meta is weird
   (values (for/list [(pid (tset->list affected-pids))]
-            (cons pid (scn (biased-intersection new-routing-table (mux-interests-of new-m pid)))))
+            (cons pid (scn (biased-intersection echo-cancelled-assertions
+                                                (mux-interests-of new-m pid)))))
           (and (not (meta-label? label))
                (drop-scn (scn (trie-relabel new-routing-table
                                             (lambda (v)