Echo cancellation for prospect.
This commit is contained in:
parent
fd7dc03dc6
commit
01b6bf92ee
|
@ -1,16 +1,16 @@
|
||||||
#lang prospect
|
#lang prospect
|
||||||
;; Demonstrates a (hopefully soon historical!) bug in Syndicate.
|
;; Test case for a historical bug in Syndicate.
|
||||||
;;
|
;;
|
||||||
;; When the bug exists, this program receives four patch events in
|
;; When the bug existed, this program receiveed four SCN events in
|
||||||
;; total, whereas it should receive only two.
|
;; total, whereas it should receive only two.
|
||||||
;;
|
;;
|
||||||
;; While metamessages are "echo cancelled", and receivers only ever
|
;; While metamessages were "echo cancelled", and receivers only ever
|
||||||
;; get one copy of a sent metamessage no matter how many metas there
|
;; got one copy of a sent metamessage no matter how many metas there
|
||||||
;; are, state changes are not (yet). Issuing a quick enough "pulse" of
|
;; were, state changes were not. Issuing a quick enough "pulse" of
|
||||||
;; metaassertion while maintaining interest in it leads to an "echo":
|
;; metaassertion while maintaining interest in it led to an "echo":
|
||||||
;; multiple receipts of the pulse.
|
;; 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.
|
;; notifications to cancel the echo for metaassertions.
|
||||||
|
|
||||||
(require prospect/pretty)
|
(require prospect/pretty)
|
||||||
|
|
|
@ -67,7 +67,23 @@
|
||||||
delta
|
delta
|
||||||
delta-aggregate))
|
delta-aggregate))
|
||||||
|
|
||||||
|
(define at-meta-everything (pattern->trie #t (at-meta ?)))
|
||||||
|
(define only-meta (datum-tset 'meta))
|
||||||
|
|
||||||
|
(define (echo-cancelled-trie t)
|
||||||
|
(trie-subtract t
|
||||||
|
at-meta-everything
|
||||||
|
#:combiner (lambda (v1 v2)
|
||||||
|
(if (tset-member? v1 'meta)
|
||||||
|
only-meta
|
||||||
|
#f))))
|
||||||
|
|
||||||
(define (compute-patches old-m new-m label delta delta-aggregate)
|
(define (compute-patches old-m new-m label delta delta-aggregate)
|
||||||
|
(define delta-aggregate/no-echo
|
||||||
|
(if (meta-label? label)
|
||||||
|
delta-aggregate
|
||||||
|
(patch (trie-prune-branch (patch-added delta-aggregate) struct:at-meta)
|
||||||
|
(trie-prune-branch (patch-removed delta-aggregate) struct:at-meta))))
|
||||||
(define old-routing-table (mux-routing-table old-m))
|
(define old-routing-table (mux-routing-table old-m))
|
||||||
(define new-routing-table (mux-routing-table new-m))
|
(define new-routing-table (mux-routing-table new-m))
|
||||||
(define affected-pids
|
(define affected-pids
|
||||||
|
@ -77,15 +93,17 @@
|
||||||
(cond [(equal? pid label)
|
(cond [(equal? pid label)
|
||||||
(define feedback
|
(define feedback
|
||||||
(patch-union
|
(patch-union
|
||||||
(patch (biased-intersection new-routing-table (patch-added delta))
|
(patch (echo-cancelled-trie
|
||||||
(biased-intersection old-routing-table (patch-removed delta)))
|
(biased-intersection new-routing-table (patch-added delta)))
|
||||||
(patch (biased-intersection (patch-added delta-aggregate)
|
(echo-cancelled-trie
|
||||||
|
(biased-intersection old-routing-table (patch-removed delta))))
|
||||||
|
(patch (biased-intersection (patch-added delta-aggregate/no-echo)
|
||||||
(mux-interests-of new-m label))
|
(mux-interests-of new-m label))
|
||||||
(biased-intersection (patch-removed delta-aggregate)
|
(biased-intersection (patch-removed delta-aggregate/no-echo)
|
||||||
(mux-interests-of old-m label)))))
|
(mux-interests-of old-m label)))))
|
||||||
(cons label feedback)]
|
(cons label feedback)]
|
||||||
[else
|
[else
|
||||||
(cons pid (view-patch delta-aggregate (mux-interests-of old-m pid)))]))
|
(cons pid (view-patch delta-aggregate/no-echo (mux-interests-of old-m pid)))]))
|
||||||
(and (not (meta-label? label))
|
(and (not (meta-label? label))
|
||||||
(drop-patch
|
(drop-patch
|
||||||
(compute-aggregate-patch delta label old-routing-table #:remove-meta? #t)))))
|
(compute-aggregate-patch delta label old-routing-table #:remove-meta? #t)))))
|
||||||
|
|
|
@ -32,6 +32,7 @@
|
||||||
trie-match-trie
|
trie-match-trie
|
||||||
trie-append
|
trie-append
|
||||||
trie-relabel
|
trie-relabel
|
||||||
|
trie-prune-branch
|
||||||
|
|
||||||
SOL
|
SOL
|
||||||
SOV
|
SOV
|
||||||
|
@ -605,6 +606,18 @@
|
||||||
[(kv (treap-to-alist m)) #:when (not (eq? (car kv) ?))]
|
[(kv (treap-to-alist m)) #:when (not (eq? (car kv) ?))]
|
||||||
(rupdate acc (car kv) (walk (cdr kv))))])))
|
(rupdate acc (car kv) (walk (cdr kv))))])))
|
||||||
|
|
||||||
|
;; Trie Sigma -> Trie
|
||||||
|
;; Outright removes tries reachable from m via edges labelled with s.
|
||||||
|
;; Useful for removing (at-meta *) when the success value along that
|
||||||
|
;; branch doesn't matter.
|
||||||
|
(define (trie-prune-branch m s)
|
||||||
|
(match m
|
||||||
|
[#f #f]
|
||||||
|
[(wildcard-sequence k)
|
||||||
|
(collapse-wildcard-sequences (rupdate (expand-wildseq k) s (trie-empty)))]
|
||||||
|
[(success _) m]
|
||||||
|
[(? treap? h) (rupdate h s (trie-empty))]))
|
||||||
|
|
||||||
;; Trie Sigma -> Trie
|
;; Trie Sigma -> Trie
|
||||||
(define (trie-step m s)
|
(define (trie-step m s)
|
||||||
(match m
|
(match m
|
||||||
|
|
Loading…
Reference in New Issue