Similar optimization to that applied to biased-intersection recently
This commit is contained in:
parent
dfad624028
commit
df567e8793
|
@ -71,10 +71,12 @@
|
||||||
|
|
||||||
(define (compute-affected-pids routing-table delta)
|
(define (compute-affected-pids routing-table delta)
|
||||||
(define cover (matcher-union (patch-added delta) (patch-removed delta)))
|
(define cover (matcher-union (patch-added delta) (patch-removed delta)))
|
||||||
(matcher-match-matcher (pattern->matcher #t (observe (embedded-matcher cover)))
|
(matcher-match-matcher cover
|
||||||
routing-table
|
(matcher-step routing-table struct:observe)
|
||||||
#:seed (set)
|
#:seed (set)
|
||||||
#:combiner (lambda (v1 v2 acc) (set-union v2 acc))))
|
#:combiner (lambda (v1 v2 acc) (set-union v2 acc))
|
||||||
|
#:left-short (lambda (v r acc)
|
||||||
|
(set-union acc (success-value (matcher-step r EOS))))))
|
||||||
|
|
||||||
(define (mux-route-message m label body)
|
(define (mux-route-message m label body)
|
||||||
(when (observe? body)
|
(when (observe? body)
|
||||||
|
|
|
@ -38,6 +38,8 @@
|
||||||
ILM
|
ILM
|
||||||
EOS
|
EOS
|
||||||
matcher-step
|
matcher-step
|
||||||
|
success?
|
||||||
|
success-value
|
||||||
|
|
||||||
;; Projections
|
;; Projections
|
||||||
compile-projection
|
compile-projection
|
||||||
|
@ -533,27 +535,34 @@
|
||||||
#:seed [seed (cons (set) (set))]
|
#:seed [seed (cons (set) (set))]
|
||||||
#:combiner [combiner (lambda (v1 v2 a)
|
#:combiner [combiner (lambda (v1 v2 a)
|
||||||
(cons (set-union (car a) v1)
|
(cons (set-union (car a) v1)
|
||||||
(set-union (cdr a) v2)))])
|
(set-union (cdr a) v2)))]
|
||||||
|
#:left-short [left-short (lambda (v r acc) acc)]
|
||||||
|
#:right-short [right-short (lambda (v r acc) acc)])
|
||||||
(let walk ((re1 re1) (re2 re2) (acc seed))
|
(let walk ((re1 re1) (re2 re2) (acc seed))
|
||||||
(match* (re1 re2)
|
(match* (re1 re2)
|
||||||
[(#f _) acc]
|
[(#f _) acc]
|
||||||
[(_ #f) acc]
|
[(_ #f) acc]
|
||||||
[((wildcard-sequence r1) (wildcard-sequence r2)) (walk r1 r2 acc)]
|
|
||||||
[((wildcard-sequence r1) r2) (walk (expand-wildseq r1) r2 acc)]
|
|
||||||
[(r1 (wildcard-sequence r2)) (walk r1 (expand-wildseq r2) acc)]
|
|
||||||
[((success v1) (success v2)) (combiner v1 v2 acc)]
|
|
||||||
[((? treap? h1) (? treap? h2))
|
[((? treap? h1) (? treap? h2))
|
||||||
(define w1 (rlookup h1 ? #f))
|
(define w1 (rlookup h1 ? #f))
|
||||||
(define w2 (rlookup h2 ? #f))
|
(define w2 (rlookup h2 ? #f))
|
||||||
(define r (walk w1 w2 acc))
|
(define r (walk w1 w2 acc))
|
||||||
(for/fold [(r r)]
|
(for/fold [(r r)]
|
||||||
[(key (cond
|
[(key (cond
|
||||||
[(and w1 w2) (set-remove (set-union (treap-keys h1) (treap-keys h2)) ?)]
|
[(and w1 w2) (set-remove (set-union (treap-keys h1) (treap-keys h2)) ?)]
|
||||||
[w1 (treap-keys h2)]
|
[w1 (treap-keys h2)]
|
||||||
[w2 (treap-keys h1)]
|
[w2 (treap-keys h1)]
|
||||||
[(< (treap-size h1) (treap-size h2)) (treap-keys h1)]
|
[(< (treap-size h1) (treap-size h2)) (treap-keys h1)]
|
||||||
[else (treap-keys h2)]))]
|
[else (treap-keys h2)]))]
|
||||||
(walk (rlookup h1 key w1) (rlookup h2 key w2) r))])))
|
(walk (rlookup h1 key w1) (rlookup h2 key w2) r))]
|
||||||
|
|
||||||
|
[((wildcard-sequence r1) (wildcard-sequence r2)) (walk r1 r2 acc)]
|
||||||
|
[((wildcard-sequence r1) r2) (walk (expand-wildseq r1) r2 acc)]
|
||||||
|
[(r1 (wildcard-sequence r2)) (walk r1 (expand-wildseq r2) acc)]
|
||||||
|
|
||||||
|
[((success v1) (success v2)) (combiner v1 v2 acc)]
|
||||||
|
[((success v) r) (left-short v r acc)]
|
||||||
|
[(r (success v)) (right-short v r acc)])))
|
||||||
|
|
||||||
;; Matcher × (Value → Matcher) → Matcher
|
;; Matcher × (Value → Matcher) → Matcher
|
||||||
;; Since Matchers accept *sequences* of input values, this appends two
|
;; Since Matchers accept *sequences* of input values, this appends two
|
||||||
|
|
Loading…
Reference in New Issue