Rename "matcher" to "trie".
This commit is contained in:
parent
e1c5fd4ac1
commit
3c5a6f00ed
38
FAQ.md
38
FAQ.md
|
@ -24,16 +24,16 @@
|
|||
character to turn off the corresponding trace facility; the default
|
||||
value of the variable is just the empty-string.
|
||||
|
||||
- For a more fine-grained approach, there are several ways to print specific patches/matchers inside your program:
|
||||
- For a more fine-grained approach, there are several ways to print specific patches/tries inside your program:
|
||||
|
||||
```racket
|
||||
pretty-print-patch ;; (patch matcher matcher)
|
||||
pretty-print-matcher ;; matchers *are* tries
|
||||
pretty-print-patch ;; (patch trie trie)
|
||||
pretty-print-trie
|
||||
patch->pretty-string
|
||||
matcher->pretty-string
|
||||
matcher->abstract-graph
|
||||
trie->pretty-string
|
||||
trie->abstract-graph
|
||||
abstract-graph->dot
|
||||
matcher->dot ;; handy for visualizing the trie structure
|
||||
trie->dot ;; handy for visualizing the trie structure
|
||||
```
|
||||
* How do spawned processes communicate with one another?
|
||||
|
||||
|
@ -130,42 +130,42 @@
|
|||
|
||||
|
||||
* How do I get the assertions out of a patch?
|
||||
- A patch consists of two matchers, added and removed
|
||||
- To get assertions out of a matcher, you have to decide what sort of assertions
|
||||
- A patch consists of two tries, added and removed
|
||||
- To get assertions out of a trie, you have to decide what sort of assertions
|
||||
you are interested in, compile a pattern for those assertions, and pass that
|
||||
along with the matcher to `matcher-project/set`.
|
||||
- `matcher-project/set` takes a matcher and a pattern and returns a set of lists
|
||||
along with the trie to `trie-project/set`.
|
||||
- `trie-project/set` takes a trie and a pattern and returns a set of lists
|
||||
- Say you are in interested in assertions of the shape `('posn x y)`.
|
||||
* compile the pattern using ```(compile-projection `(posn ,(?!) ,(?!)))```
|
||||
* the `(?!)` is for **capturing** the matched value. Use `?` if you want to
|
||||
match but don't care about the actual value.
|
||||
* the lists returned by `matcher-project/set` contain the captured values in
|
||||
* the lists returned by `trie-project/set` contain the captured values in
|
||||
order.
|
||||
- Say we are receiving a patch p where the assertion `('posn 2 3)` was added.
|
||||
- The result of
|
||||
|
||||
```racket
|
||||
(matcher-project/set (patch-added p)
|
||||
(compile-projection `(posn ,(?!) ,(?!))))
|
||||
(trie-project/set (patch-added p)
|
||||
(compile-projection `(posn ,(?!) ,(?!))))
|
||||
```
|
||||
would be `(set (list 2 3))`.
|
||||
- If we only cared about the y position, we could instead do
|
||||
|
||||
```racket
|
||||
(matcher-project/set (patch-added p)
|
||||
(compile-projection `(posn ,? ,(?!))))
|
||||
(trie-project/set (patch-added p)
|
||||
(compile-projection `(posn ,? ,(?!))))
|
||||
```
|
||||
and get the result `(set (list 3))`.
|
||||
- an entire structure can be captured by passing a pattern as an argument to
|
||||
`(?!)`.
|
||||
|
||||
```racket
|
||||
(matcher-project/set (patch-added p)
|
||||
(compile-projection (?! `(posn ,? ,?))))
|
||||
(trie-project/set (patch-added p)
|
||||
(compile-projection (?! `(posn ,? ,?))))
|
||||
```
|
||||
with the same example yields `(set (list ('posn 2 3))`.
|
||||
- `matcher-project/set/single` is like mapping `car` over the result of
|
||||
`matcher-project/set`. See also `project-assertions`.
|
||||
- `trie-project/set/single` is like mapping `car` over the result of
|
||||
`trie-project/set`. See also `project-assertions`.
|
||||
- `patch-project/set` uses `values` to return the result of matching a projection
|
||||
against both the added and removed bits of a patch.
|
||||
|
||||
|
|
|
@ -273,7 +273,7 @@
|
|||
[(? patch/removed? p)
|
||||
(define continuation-table (actor-state-continuation-table s))
|
||||
(define quit?
|
||||
(for/or [(callee-id (matcher-project/set/single (patch-removed p) link-active-projection))]
|
||||
(for/or [(callee-id (trie-project/set/single (patch-removed p) link-active-projection))]
|
||||
(hash-has-key? continuation-table callee-id)))
|
||||
(if quit? ;; TODO: raise exception instead? Signal the cause of the quit somehow?
|
||||
(quit)
|
||||
|
@ -471,13 +471,13 @@
|
|||
#,(if maybe-Pred-stx
|
||||
#`(if #,maybe-Pred-stx
|
||||
(compute-new-assertions)
|
||||
(matcher-empty))
|
||||
(trie-empty))
|
||||
#`(compute-new-assertions)))
|
||||
(and (not (eq? old-assertions new-assertions))
|
||||
((extend-pending-patch
|
||||
#,endpoint-index
|
||||
(patch-seq (patch (matcher-empty) old-assertions)
|
||||
(patch new-assertions (matcher-empty))))
|
||||
(patch-seq (patch (trie-empty) old-assertions)
|
||||
(patch new-assertions (trie-empty))))
|
||||
s))))))
|
||||
|
||||
(define (analyze-asserted-or-retracted! endpoint-index asserted? outer-expr-stx P-stx I-stxs L-stx)
|
||||
|
@ -491,7 +491,7 @@
|
|||
[(? #,(if asserted? #'patch/added? #'patch/removed?) p)
|
||||
(sequence-transitions0*
|
||||
s
|
||||
(for/list [(entry (in-set (matcher-project/set
|
||||
(for/list [(entry (in-set (trie-project/set
|
||||
#,(if asserted?
|
||||
#'(patch-added p)
|
||||
#'(patch-removed p))
|
||||
|
|
|
@ -68,8 +68,8 @@
|
|||
removed)))
|
||||
(lambda (w1 w2) (< (window-z w1) (window-z w2))))]
|
||||
[halted? (or (and (bb-halted? b)
|
||||
(not (matcher-match-value (patch-removed p) 'stop #f)))
|
||||
(matcher-match-value (patch-added p) 'stop #f))]))
|
||||
(not (trie-lookup (patch-removed p) 'stop #f)))
|
||||
(trie-lookup (patch-added p) 'stop #f))]))
|
||||
|
||||
(define (deliver b e)
|
||||
(clean-transition (network-handle-event e (bb-network b))))
|
||||
|
|
|
@ -19,16 +19,16 @@
|
|||
wildcard?
|
||||
?!
|
||||
(struct-out capture)
|
||||
pretty-print-matcher
|
||||
matcher->pretty-string
|
||||
matcher-non-empty?
|
||||
matcher-empty?
|
||||
matcher-empty
|
||||
pretty-print-trie
|
||||
trie->pretty-string
|
||||
trie-non-empty?
|
||||
trie-empty?
|
||||
trie-empty
|
||||
projection->pattern
|
||||
compile-projection
|
||||
matcher-project
|
||||
matcher-project/set
|
||||
matcher-project/set/single
|
||||
trie-project
|
||||
trie-project/set
|
||||
trie-project/set/single
|
||||
project-assertions
|
||||
|
||||
event?
|
||||
|
@ -132,20 +132,20 @@
|
|||
|
||||
(define (observe-at-meta pattern level)
|
||||
(if (zero? level)
|
||||
(pattern->matcher #t (observe pattern))
|
||||
(matcher-union
|
||||
(pattern->matcher #t (observe (prepend-at-meta pattern level)))
|
||||
(pattern->matcher #t (at-meta (embedded-matcher (observe-at-meta pattern (- level 1))))))))
|
||||
(pattern->trie #t (observe pattern))
|
||||
(trie-union
|
||||
(pattern->trie #t (observe (prepend-at-meta pattern level)))
|
||||
(pattern->trie #t (at-meta (embedded-trie (observe-at-meta pattern (- level 1))))))))
|
||||
|
||||
(define (assert pattern #:meta-level [level 0])
|
||||
(patch (pattern->matcher #t (prepend-at-meta pattern level)) (matcher-empty)))
|
||||
(patch (pattern->trie #t (prepend-at-meta pattern level)) (trie-empty)))
|
||||
(define (retract pattern #:meta-level [level 0])
|
||||
(patch (matcher-empty) (pattern->matcher #t (prepend-at-meta pattern level))))
|
||||
(patch (trie-empty) (pattern->trie #t (prepend-at-meta pattern level))))
|
||||
|
||||
(define (sub pattern #:meta-level [level 0])
|
||||
(patch (observe-at-meta pattern level) (matcher-empty)))
|
||||
(patch (observe-at-meta pattern level) (trie-empty)))
|
||||
(define (unsub pattern #:meta-level [level 0])
|
||||
(patch (matcher-empty) (observe-at-meta pattern level)))
|
||||
(patch (trie-empty) (observe-at-meta pattern level)))
|
||||
|
||||
(define (pub pattern #:meta-level [level 0]) (assert (advertise pattern) #:meta-level level))
|
||||
(define (unpub pattern #:meta-level [level 0]) (retract (advertise pattern) #:meta-level level))
|
||||
|
@ -428,7 +428,7 @@
|
|||
(newline p)
|
||||
(fprintf p " process ~a, behavior ~v, CLAIMS:\n" pid (hash-ref behaviors pid #f))
|
||||
(display (indented-port-output 6 (lambda (p)
|
||||
(pretty-print-matcher (mux-interests-of mux pid) p)))
|
||||
(pretty-print-trie (mux-interests-of mux pid) p)))
|
||||
p)
|
||||
(newline p)))
|
||||
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
on-claim)
|
||||
|
||||
;; A DemandMatcher keeps track of demand for services based on some
|
||||
;; Projection over a Matcher, as well as a collection of functions
|
||||
;; Projection over a Trie, as well as a collection of functions
|
||||
;; that can be used to increase supply in response to increased
|
||||
;; demand, or handle a sudden drop in supply for which demand still
|
||||
;; exists.
|
||||
|
@ -58,10 +58,10 @@
|
|||
|
||||
(when (not added-demand) (error 'demand-matcher "Wildcard demand of ~v:\n~a"
|
||||
demand-spec
|
||||
(matcher->pretty-string (patch-added p))))
|
||||
(trie->pretty-string (patch-added p))))
|
||||
(when (not added-supply) (error 'demand-matcher "Wildcard supply of ~v:\n~a"
|
||||
supply-spec
|
||||
(matcher->pretty-string (patch-added p))))
|
||||
(trie->pretty-string (patch-added p))))
|
||||
|
||||
(set! supply (set-union supply added-supply))
|
||||
(set! demand (set-subtract demand removed-demand))
|
||||
|
@ -107,8 +107,8 @@
|
|||
(sub (projection->pattern supply-spec) #:meta-level meta-level)
|
||||
(pub (projection->pattern supply-spec) #:meta-level meta-level))))
|
||||
|
||||
;; (Matcher (Option (Setof (Listof Value))) ... -> (Option (Constreeof Action)))
|
||||
;; Matcher Projection ...
|
||||
;; (Trie (Option (Setof (Listof Value))) ... -> (Option (Constreeof Action)))
|
||||
;; Trie Projection ...
|
||||
;; -> Action
|
||||
;; Spawns a process that observes the given projections. Any time the
|
||||
;; environment's interests change in a relevant way, calls
|
||||
|
@ -127,7 +127,7 @@
|
|||
[(? patch? p)
|
||||
(define new-aggregate (update-interests current-aggregate p))
|
||||
(define projection-results
|
||||
(map (lambda (p) (matcher-project/set new-aggregate p)) projections))
|
||||
(map (lambda (p) (trie-project/set new-aggregate p)) projections))
|
||||
(define maybe-spawn (apply check-and-maybe-spawn-fn
|
||||
new-aggregate
|
||||
projection-results))
|
||||
|
@ -140,8 +140,8 @@
|
|||
(list
|
||||
(when timeout-msec (message (set-timer timer-id timeout-msec 'relative)))
|
||||
(spawn on-claim-handler
|
||||
(matcher-empty)
|
||||
(patch-seq (patch base-interests (matcher-empty))
|
||||
(trie-empty)
|
||||
(patch-seq (patch base-interests (trie-empty))
|
||||
(patch-seq* (map projection->pattern projections))
|
||||
(sub (timer-expired timer-id ?))))))
|
||||
|
||||
|
|
|
@ -57,7 +57,7 @@
|
|||
(for/fold [(count count)
|
||||
(actions-rev '())
|
||||
(interrupt-clearing-patch empty-patch)]
|
||||
[(expiry (matcher-project/set/single added expiry-projection))]
|
||||
[(expiry (trie-project/set/single added expiry-projection))]
|
||||
(values (- count 1)
|
||||
(cons (message expiry) actions-rev)
|
||||
(patch-seq interrupt-clearing-patch
|
||||
|
|
|
@ -59,7 +59,7 @@
|
|||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(cond [(matcher-empty? (patch-removed p)) #f] ;; peer hasn't quit yet: do nothing.
|
||||
(cond [(trie-empty? (patch-removed p)) #f] ;; peer hasn't quit yet: do nothing.
|
||||
[else (channel-put control-ch 'quit)
|
||||
(quit)])]
|
||||
[(message (at-meta (? udp-packet? p)))
|
||||
|
|
|
@ -152,7 +152,7 @@
|
|||
[endpoints
|
||||
(hash-remove (endpoint-group-endpoints g) eid)])
|
||||
eid
|
||||
(patch (matcher-empty) (pattern->matcher #t ?)))]
|
||||
(patch (trie-empty) (pattern->trie #t ?)))]
|
||||
[(as-endpoint other-eid inner-endpoint-action)
|
||||
(interpret-endpoint-actions cumulative-patch actions g other-eid inner-endpoint-action)]))
|
||||
|
||||
|
@ -177,4 +177,4 @@
|
|||
(fprintf p " - ~a endpoints\n" (hash-count endpoints))
|
||||
(fprintf p " - next eid: ~a\n" (mux-next-pid mux))
|
||||
(fprintf p " - routing table:\n")
|
||||
(pretty-print-matcher (mux-routing-table mux) p))
|
||||
(pretty-print-trie (mux-routing-table mux) p))
|
||||
|
|
|
@ -18,7 +18,7 @@
|
|||
#f)
|
||||
|
||||
(define (updater e _)
|
||||
(if (and (patch? e) (matcher-non-empty? (patch-added e)))
|
||||
(if (and (patch? e) (trie-non-empty? (patch-added e)))
|
||||
(quit (list (message (deposit +100))
|
||||
(message (deposit -30))))
|
||||
#f))
|
||||
|
|
|
@ -87,7 +87,7 @@
|
|||
[(? patch? p)
|
||||
(define-values (added-observations removed-observations)
|
||||
(patch-project/set/single p observation-projector))
|
||||
(define added-updates (matcher-project/set/single (patch-added p) update-projector))
|
||||
(define added-updates (trie-project/set/single (patch-added p) update-projector))
|
||||
(transition-bind (adjust-observations added-observations removed-observations)
|
||||
(for/fold [(t (transition old-state '()))]
|
||||
[(suggestion (in-set added-updates))]
|
||||
|
@ -105,7 +105,7 @@
|
|||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(match (set->list (matcher-project/set/single (patch-added p) binding-projector))
|
||||
(match (set->list (trie-project/set/single (patch-added p) binding-projector))
|
||||
['() #f]
|
||||
[(list (binding _ (== epoch) (== version) _)) #f]
|
||||
[(list (binding _ (== epoch) (== (+ version 1)) (== value))) (quit (on-complete))]
|
||||
|
|
|
@ -29,7 +29,7 @@
|
|||
[(? patch/removed?)
|
||||
(printf "Retracting ~v because dependencies ~v vanished\n"
|
||||
record
|
||||
(set->list (matcher-project/set (patch-removed e) (compile-projection (?!)))))
|
||||
(set->list (trie-project/set (patch-removed e) (compile-projection (?!)))))
|
||||
(quit)]
|
||||
[(message `(retract ,(== record)))
|
||||
(printf "Retracting ~v because we were told to explicitly\n" record)
|
||||
|
@ -48,7 +48,7 @@
|
|||
(match e
|
||||
[(? patch?)
|
||||
(transition s
|
||||
(for/list [(AB (matcher-project/set
|
||||
(for/list [(AB (trie-project/set
|
||||
(patch-added e)
|
||||
(compile-projection `(parent ,(?!) ,(?!)))))]
|
||||
(match-define (list A B) AB)
|
||||
|
@ -62,7 +62,7 @@
|
|||
(match e
|
||||
[(? patch?)
|
||||
(transition s
|
||||
(for/list [(AC (matcher-project/set
|
||||
(for/list [(AC (trie-project/set
|
||||
(patch-added e)
|
||||
(compile-projection `(parent ,(?!) ,(?!)))))]
|
||||
(match-define (list A C) AC)
|
||||
|
@ -70,19 +70,19 @@
|
|||
(spawn (lambda (e s)
|
||||
(define removed-parents
|
||||
(and (patch? e)
|
||||
(matcher-project (patch-removed e)
|
||||
(compile-projection
|
||||
`(parent ,(?!) ,(?!))))))
|
||||
(if (matcher-non-empty? removed-parents)
|
||||
(trie-project (patch-removed e)
|
||||
(compile-projection
|
||||
`(parent ,(?!) ,(?!))))))
|
||||
(if (trie-non-empty? removed-parents)
|
||||
(begin
|
||||
(printf
|
||||
"Inductive step for ~v retracted because of removal ~v\n"
|
||||
`(parent ,A ,C)
|
||||
(matcher-key-set removed-parents))
|
||||
(trie-key-set removed-parents))
|
||||
(quit))
|
||||
(and (patch? e)
|
||||
(transition s
|
||||
(for/list [(CB (matcher-project/set
|
||||
(for/list [(CB (trie-project/set
|
||||
(patch-added e)
|
||||
(compile-projection
|
||||
`(ancestor ,(?!) ,(?!)))))]
|
||||
|
@ -111,8 +111,8 @@
|
|||
;; (match e
|
||||
;; [(? patch/removed?) (quit)]
|
||||
;; [(? patch?)
|
||||
;; (define new-facts (matcher-union old-facts (patch-added e)))
|
||||
;; (define triples (matcher-project/set new-facts
|
||||
;; (define new-facts (trie-union old-facts (patch-added e)))
|
||||
;; (define triples (trie-project/set new-facts
|
||||
;; (compile-projection
|
||||
;; `(,(?!) ,(?!) ,(?!)))))
|
||||
;; (printf "Learned new facts: ~v\n" triples)
|
||||
|
@ -127,7 +127,7 @@
|
|||
;; `(ancestor ,A ,B))
|
||||
;; (assert `(ancestor ,A ,B))))]
|
||||
;; [_ #f]))
|
||||
;; (matcher-empty)
|
||||
;; (trie-empty)
|
||||
;; (patch-seq
|
||||
;; (sub `(parent ,A ,B))
|
||||
;; (sub `(parent ,A ,?))
|
||||
|
|
|
@ -65,7 +65,7 @@
|
|||
[(? patch? p)
|
||||
(define-values (added-observations removed-observations)
|
||||
(patch-project/set/single p observation-projector))
|
||||
(define added-updates (matcher-project/set/single (patch-added p) update-projector))
|
||||
(define added-updates (trie-project/set/single (patch-added p) update-projector))
|
||||
(transition-bind (adjust-observations added-observations removed-observations)
|
||||
(for/fold [(t (transition old-state '()))]
|
||||
[(suggestion (in-set added-updates))]
|
||||
|
@ -83,7 +83,7 @@
|
|||
(spawn (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(match (set->list (matcher-project/set/single (patch-added p) binding-projector))
|
||||
(match (set->list (trie-project/set/single (patch-added p) binding-projector))
|
||||
['() #f]
|
||||
[(list (binding _ (== epoch) (== version) _)) #f]
|
||||
[(list (binding _ (== epoch) (== (+ version 1)) (== value))) (quit (on-complete))]
|
||||
|
|
|
@ -57,7 +57,7 @@
|
|||
;; Interests -> (Listof RacketEvent)
|
||||
;; Projects out the active event subscriptions from the given interests.
|
||||
(define (extract-active-events interests)
|
||||
(define es (matcher-project/set/single interests event-projection))
|
||||
(define es (trie-project/set/single interests event-projection))
|
||||
;; TODO: how should the following error be handled, ideally?
|
||||
;; In principle, security restrictions should make it impossible.
|
||||
;; But absent those, what should be done? Should an offending
|
||||
|
@ -78,9 +78,9 @@
|
|||
(define (run-ground . boot-actions)
|
||||
(let await-interrupt ((inert? #f)
|
||||
(w (make-network boot-actions))
|
||||
(interests (matcher-empty)))
|
||||
;; (log-info "GROUND INTERESTS:\n~a" (matcher->pretty-string interests))
|
||||
(if (and inert? (matcher-empty? interests))
|
||||
(interests (trie-empty)))
|
||||
;; (log-info "GROUND INTERESTS:\n~a" (trie->pretty-string interests))
|
||||
(if (and inert? (trie-empty? interests))
|
||||
(begin (log-info "run-ground: Terminating because inert")
|
||||
(void))
|
||||
(let ((e (apply sync
|
||||
|
|
|
@ -38,7 +38,7 @@
|
|||
(define (meta-label? x) (eq? x 'meta))
|
||||
|
||||
(define (make-mux)
|
||||
(mux 0 (matcher-empty) (hash)))
|
||||
(mux 0 (trie-empty) (hash)))
|
||||
|
||||
(define (mux-add-stream m initial-patch)
|
||||
(define new-pid (mux-next-pid m))
|
||||
|
@ -47,7 +47,7 @@
|
|||
initial-patch))
|
||||
|
||||
(define (mux-remove-stream m label)
|
||||
(mux-update-stream m label (patch (matcher-empty) (pattern->matcher #t ?))))
|
||||
(mux-update-stream m label (patch (trie-empty) (pattern->trie #t ?))))
|
||||
|
||||
(define (mux-update-stream m label delta-orig)
|
||||
(define old-interests (mux-interests-of m label))
|
||||
|
@ -60,7 +60,7 @@
|
|||
(define new-routing-table (apply-patch old-routing-table delta))
|
||||
(values (struct-copy mux m
|
||||
[routing-table new-routing-table]
|
||||
[interest-table (if (matcher-empty? new-interests)
|
||||
[interest-table (if (trie-empty? new-interests)
|
||||
(hash-remove (mux-interest-table m) label)
|
||||
(hash-set (mux-interest-table m) label new-interests))])
|
||||
label
|
||||
|
@ -91,21 +91,21 @@
|
|||
(compute-aggregate-patch delta label old-routing-table #:remove-meta? #t)))))
|
||||
|
||||
(define (compute-affected-pids routing-table delta)
|
||||
(define cover (matcher-union (patch-added delta) (patch-removed delta)))
|
||||
(matcher-match-matcher cover
|
||||
(matcher-step routing-table struct:observe)
|
||||
#:seed (datum-tset)
|
||||
#:combiner (lambda (v1 v2 acc) (tset-union v2 acc))
|
||||
#:left-short (lambda (v r acc)
|
||||
(tset-union acc (success-value (matcher-step r EOS))))))
|
||||
(define cover (trie-union (patch-added delta) (patch-removed delta)))
|
||||
(trie-match-trie cover
|
||||
(trie-step routing-table struct:observe)
|
||||
#:seed (datum-tset)
|
||||
#:combiner (lambda (v1 v2 acc) (tset-union v2 acc))
|
||||
#:left-short (lambda (v r acc)
|
||||
(tset-union acc (success-value (trie-step r EOS))))))
|
||||
|
||||
(define (mux-route-message m body)
|
||||
(if (matcher-match-value (mux-routing-table m) body #f) ;; some other stream has declared body
|
||||
(if (trie-lookup (mux-routing-table m) body #f) ;; some other stream has declared body
|
||||
'()
|
||||
(tset->list (matcher-match-value (mux-routing-table m) (observe body) (datum-tset)))))
|
||||
(tset->list (trie-lookup (mux-routing-table m) (observe body) (datum-tset)))))
|
||||
|
||||
(define (mux-interests-of m label)
|
||||
(hash-ref (mux-interest-table m) label (matcher-empty)))
|
||||
(hash-ref (mux-interest-table m) label (trie-empty)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -115,5 +115,5 @@
|
|||
(fprintf p " - ~a labelled entities with claims\n" (hash-count interest-table))
|
||||
(fprintf p " - next label: ~a\n" next-pid)
|
||||
(fprintf p " - routing-table:\n")
|
||||
(display (indented-port-output 3 (lambda (p) (pretty-print-matcher routing-table p))) p)
|
||||
(display (indented-port-output 3 (lambda (p) (pretty-print-trie routing-table p))) p)
|
||||
(newline p))
|
||||
|
|
|
@ -57,7 +57,7 @@
|
|||
(struct at-meta (claim) #:prefab)
|
||||
(struct advertise (claim) #:prefab)
|
||||
|
||||
(define empty-patch (patch (matcher-empty) (matcher-empty)))
|
||||
(define empty-patch (patch (trie-empty) (trie-empty)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
@ -65,24 +65,24 @@
|
|||
|
||||
(define (patch-empty? p)
|
||||
(and (patch? p)
|
||||
(matcher-empty? (patch-added p))
|
||||
(matcher-empty? (patch-removed p))))
|
||||
(trie-empty? (patch-added p))
|
||||
(trie-empty? (patch-removed p))))
|
||||
|
||||
(define (patch-non-empty? p)
|
||||
(and (patch? p)
|
||||
(or (matcher-non-empty? (patch-added p))
|
||||
(matcher-non-empty? (patch-removed p)))))
|
||||
(or (trie-non-empty? (patch-added p))
|
||||
(trie-non-empty? (patch-removed p)))))
|
||||
|
||||
(define (patch/added? p) (and (patch? p) (matcher-non-empty? (patch-added p))))
|
||||
(define (patch/removed? p) (and (patch? p) (matcher-non-empty? (patch-removed p))))
|
||||
(define (patch/added? p) (and (patch? p) (trie-non-empty? (patch-added p))))
|
||||
(define (patch/removed? p) (and (patch? p) (trie-non-empty? (patch-removed p))))
|
||||
|
||||
(define (lift-patch p)
|
||||
(match-define (patch in out) p)
|
||||
(patch (pattern->matcher #t (at-meta (embedded-matcher in)))
|
||||
(pattern->matcher #t (at-meta (embedded-matcher out)))))
|
||||
(patch (pattern->trie #t (at-meta (embedded-trie in)))
|
||||
(pattern->trie #t (at-meta (embedded-trie out)))))
|
||||
|
||||
(define (drop-interests pi)
|
||||
(matcher-project pi at-meta-proj
|
||||
(trie-project pi at-meta-proj
|
||||
#:project-success (lambda (v) #t)
|
||||
#:combiner (lambda (v1 v2) #t)))
|
||||
|
||||
|
@ -92,10 +92,10 @@
|
|||
(drop-interests out)))
|
||||
|
||||
(define (strip-interests g)
|
||||
(matcher-relabel g (lambda (v) #t)))
|
||||
(trie-relabel g (lambda (v) #t)))
|
||||
|
||||
(define (label-interests g label)
|
||||
(matcher-relabel g (lambda (v) label)))
|
||||
(trie-relabel g (lambda (v) label)))
|
||||
|
||||
(define (strip-patch p)
|
||||
(patch (strip-interests (patch-added p))
|
||||
|
@ -113,8 +113,8 @@
|
|||
;; arguments.
|
||||
(define (limit-patch p bound)
|
||||
(match-define (patch in out) p)
|
||||
(patch (matcher-subtract in bound #:combiner (lambda (v1 v2) #f))
|
||||
(matcher-intersect out bound #:combiner (lambda (v1 v2) v1))))
|
||||
(patch (trie-subtract in bound #:combiner (lambda (v1 v2) #f))
|
||||
(trie-intersect out bound #:combiner (lambda (v1 v2) v1))))
|
||||
|
||||
;; Like limit-patch, but for use when the precise bound for p's label
|
||||
;; isn't known (such as when a process terminates with remaining
|
||||
|
@ -125,9 +125,9 @@
|
|||
;; label sets allowed to contain arbitrary elements.
|
||||
(define (limit-patch/routing-table p bound)
|
||||
(match-define (patch in out) p)
|
||||
(patch (matcher-subtract in bound)
|
||||
(matcher-intersect out bound
|
||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2))))))
|
||||
(patch (trie-subtract in bound)
|
||||
(trie-intersect out bound
|
||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2))))))
|
||||
|
||||
;; Entries labelled with `label` may already exist in `base`; the
|
||||
;; patch `p` MUST already have been limited to add only where no
|
||||
|
@ -189,23 +189,23 @@
|
|||
(tset-member? v2 'meta))
|
||||
v1 ;; remove-meta? is true, and exactly `label` and `'meta` interest exists here.
|
||||
#f))) ;; other interest exists here, so we should discard this removed-point.
|
||||
(patch (matcher-subtract (patch-added p) base #:combiner add-combiner)
|
||||
(matcher-subtract (patch-removed p) base #:combiner rem-combiner)))
|
||||
(patch (trie-subtract (patch-added p) base #:combiner add-combiner)
|
||||
(trie-subtract (patch-removed p) base #:combiner rem-combiner)))
|
||||
|
||||
;; For use by Matchers leading to (Setof Label).
|
||||
;; For use by Tries leading to (Setof Label).
|
||||
(define (apply-patch base p)
|
||||
(match-define (patch in out) p)
|
||||
(matcher-union (matcher-subtract base out) in))
|
||||
(trie-union (trie-subtract base out) in))
|
||||
|
||||
;; Like apply-patch, but for use by Matchers leading to True.
|
||||
;; Like apply-patch, but for use by Tries leading to True.
|
||||
(define (update-interests base p)
|
||||
(match-define (patch in out) p)
|
||||
(matcher-union (matcher-subtract base out #:combiner (lambda (v1 v2) #f)) in
|
||||
#:combiner (lambda (v1 v2) #t)))
|
||||
(trie-union (trie-subtract base out #:combiner (lambda (v1 v2) #f)) in
|
||||
#:combiner (lambda (v1 v2) #t)))
|
||||
|
||||
(define (unapply-patch base p)
|
||||
(match-define (patch in out) p)
|
||||
(matcher-union (matcher-subtract base in) out))
|
||||
(trie-union (trie-subtract base in) out))
|
||||
|
||||
(define (compose-patch p2 p1) ;; p2 after p1
|
||||
;; Can be defined as (patch (apply-patch in1 p2) (unapply-patch out1 p2)),
|
||||
|
@ -213,8 +213,8 @@
|
|||
(match-define (patch in1 out1) p1)
|
||||
(match-define (patch in2 out2) p2)
|
||||
(patch (update-interests in1 p2)
|
||||
(matcher-union (matcher-subtract out1 in2 #:combiner (lambda (v1 v2) #f)) out2
|
||||
#:combiner (lambda (v1 v2) #t))))
|
||||
(trie-union (trie-subtract out1 in2 #:combiner (lambda (v1 v2) #f)) out2
|
||||
#:combiner (lambda (v1 v2) #t))))
|
||||
|
||||
(define (patch-seq . patches) (patch-seq* patches))
|
||||
|
||||
|
@ -224,34 +224,34 @@
|
|||
[(cons p rest) (compose-patch (patch-seq* rest) p)]))
|
||||
|
||||
(define (compute-patch old-base new-base)
|
||||
(patch (matcher-subtract new-base old-base)
|
||||
(matcher-subtract old-base new-base)))
|
||||
(patch (trie-subtract new-base old-base)
|
||||
(trie-subtract old-base new-base)))
|
||||
|
||||
(define (biased-intersection object subject)
|
||||
(matcher-intersect object
|
||||
(matcher-step subject struct:observe)
|
||||
#:combiner (lambda (v1 v2) #t)
|
||||
#:left-short (lambda (v r) (matcher-step r EOS))))
|
||||
(trie-intersect object
|
||||
(trie-step subject struct:observe)
|
||||
#:combiner (lambda (v1 v2) #t)
|
||||
#:left-short (lambda (v r) (trie-step r EOS))))
|
||||
|
||||
(define (view-patch p interests)
|
||||
(patch (biased-intersection (patch-added p) interests)
|
||||
(biased-intersection (patch-removed p) interests)))
|
||||
|
||||
(define (patch-union p1 p2)
|
||||
(patch (matcher-union (patch-added p1) (patch-added p2))
|
||||
(matcher-union (patch-removed p1) (patch-removed p2))))
|
||||
(patch (trie-union (patch-added p1) (patch-added p2))
|
||||
(trie-union (patch-removed p1) (patch-removed p2))))
|
||||
|
||||
(define (patch-project p spec)
|
||||
(match-define (patch in out) p)
|
||||
(patch (matcher-project in spec) (matcher-project out spec)))
|
||||
(patch (trie-project in spec) (trie-project out spec)))
|
||||
|
||||
(define (patch-project/set p spec)
|
||||
(match-define (patch in out) p)
|
||||
(values (matcher-project/set in spec) (matcher-project/set out spec)))
|
||||
(values (trie-project/set in spec) (trie-project/set out spec)))
|
||||
|
||||
(define (patch-project/set/single p spec)
|
||||
(match-define (patch in out) p)
|
||||
(values (matcher-project/set/single in spec) (matcher-project/set/single out spec)))
|
||||
(values (trie-project/set/single in spec) (trie-project/set/single out spec)))
|
||||
|
||||
(define (pretty-print-patch p [port (current-output-port)])
|
||||
(display (patch->pretty-string p) port))
|
||||
|
@ -259,38 +259,38 @@
|
|||
(define (patch->pretty-string p)
|
||||
(match-define (patch in out) p)
|
||||
(format "<<<<<<<< Removed:\n~a======== Added:\n~a>>>>>>>>\n"
|
||||
(matcher->pretty-string out)
|
||||
(matcher->pretty-string in)))
|
||||
(trie->pretty-string out)
|
||||
(trie->pretty-string in)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(define (set->matcher label xs)
|
||||
(for/fold [(acc (matcher-empty))] [(x (in-set xs))]
|
||||
(matcher-union acc (pattern->matcher label x))))
|
||||
(define (set->trie label xs)
|
||||
(for/fold [(acc (trie-empty))] [(x (in-set xs))]
|
||||
(trie-union acc (pattern->trie label x))))
|
||||
|
||||
;; Retains only entries in R labelled with any subset of the labels in label-set.
|
||||
(define (project-routing-table R label-set)
|
||||
(matcher-intersect R
|
||||
(pattern->matcher label-set ?)
|
||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2)))))
|
||||
(trie-intersect R
|
||||
(pattern->trie label-set ?)
|
||||
#:combiner (lambda (v1 v2) (empty-tset-guard (tset-intersect v1 v2)))))
|
||||
|
||||
(define tset datum-tset)
|
||||
|
||||
(define (sanity-check-examples)
|
||||
(define SP (tset 'P))
|
||||
(define m0 (matcher-empty))
|
||||
(define ma (pattern->matcher SP 'a))
|
||||
(define mb (pattern->matcher SP 'b))
|
||||
(define mc (pattern->matcher SP 'c))
|
||||
(define mab (matcher-union ma mb))
|
||||
(define mbc (matcher-union mb mc))
|
||||
(define m* (pattern->matcher SP ?))
|
||||
(define mA (pattern->matcher SP (at-meta 'a)))
|
||||
(define mAb (matcher-union mA mb))
|
||||
(define m0 (trie-empty))
|
||||
(define ma (pattern->trie SP 'a))
|
||||
(define mb (pattern->trie SP 'b))
|
||||
(define mc (pattern->trie SP 'c))
|
||||
(define mab (trie-union ma mb))
|
||||
(define mbc (trie-union mb mc))
|
||||
(define m* (pattern->trie SP ?))
|
||||
(define mA (pattern->trie SP (at-meta 'a)))
|
||||
(define mAb (trie-union mA mb))
|
||||
|
||||
(printf "\nmab:\n")
|
||||
(void (pretty-print-matcher mab))
|
||||
(void (pretty-print-trie mab))
|
||||
|
||||
(printf "\ncompute-patch ma mb:\n")
|
||||
(void (pretty-print-patch (compute-patch ma mb)))
|
||||
|
@ -302,7 +302,7 @@
|
|||
(void (pretty-print-patch (limit-patch (patch m0 m*) mab)))
|
||||
|
||||
(printf "\napply mb (limit m*/m0 mab):\n")
|
||||
(void (pretty-print-matcher (apply-patch mb (limit-patch (patch m* m0) mab))))
|
||||
(void (pretty-print-trie (apply-patch mb (limit-patch (patch m* m0) mab))))
|
||||
|
||||
(printf "\nlimit mbc/ma ma:\n")
|
||||
(void (pretty-print-patch (limit-patch (patch mbc ma) ma)))
|
||||
|
@ -376,11 +376,11 @@
|
|||
(let* ((pre-patch-a-keys (set 1 3 5 7))
|
||||
(pre-patch-b-keys (set 2 3 6 7))
|
||||
(pre-patch-keys (set 1 2 3 5 6 7))
|
||||
(ma (set->matcher (tset 'a) pre-patch-a-keys))
|
||||
(mb (set->matcher (tset 'b) pre-patch-b-keys))
|
||||
(R (matcher-union ma mb))
|
||||
(pa-raw (patch (set->matcher (tset 'a) (set 0 1 2 3 ))
|
||||
(set->matcher (tset 'a) (set 4 5 6 7))))
|
||||
(ma (set->trie (tset 'a) pre-patch-a-keys))
|
||||
(mb (set->trie (tset 'b) pre-patch-b-keys))
|
||||
(R (trie-union ma mb))
|
||||
(pa-raw (patch (set->trie (tset 'a) (set 0 1 2 3 ))
|
||||
(set->trie (tset 'a) (set 4 5 6 7))))
|
||||
(pa1 (limit-patch pa-raw ma))
|
||||
(pa2 (limit-patch/routing-table pa-raw R))
|
||||
(post-patch-a-keys (set 0 1 2 3 ))
|
||||
|
@ -392,49 +392,49 @@
|
|||
(p-aggregate2 (compute-aggregate-patch pa2 'a R))
|
||||
(R1 (apply-patch R pa1))
|
||||
(R2 (apply-patch R pa2))
|
||||
(R-relabeled (matcher-relabel R (lambda (v) (tset 'x))))
|
||||
(R-relabeled (trie-relabel R (lambda (v) (tset 'x))))
|
||||
(R1-relabeled (apply-patch R-relabeled (label-patch (strip-patch p-aggregate1) (tset 'x))))
|
||||
(R2-relabeled (apply-patch R-relabeled (label-patch (strip-patch p-aggregate2) (tset 'x)))))
|
||||
(check-equal? pa1 pa2)
|
||||
(check-equal? (matcher-match-value R 0 (tset)) (tset))
|
||||
(check-equal? (matcher-match-value R 1 (tset)) (tset 'a))
|
||||
(check-equal? (matcher-match-value R 2 (tset)) (tset 'b))
|
||||
(check-equal? (matcher-match-value R 3 (tset)) (tset 'a 'b))
|
||||
(check-equal? (matcher-match-value R 4 (tset)) (tset))
|
||||
(check-equal? (matcher-match-value R 5 (tset)) (tset 'a))
|
||||
(check-equal? (matcher-match-value R 6 (tset)) (tset 'b))
|
||||
(check-equal? (matcher-match-value R 7 (tset)) (tset 'a 'b))
|
||||
(check-equal? (matcher-key-set/single (project-routing-table R (tset 'a))) pre-patch-a-keys)
|
||||
(check-equal? (matcher-key-set/single (project-routing-table R (tset 'b))) pre-patch-b-keys)
|
||||
(check-equal? (matcher-key-set/single R) pre-patch-keys)
|
||||
(check-equal? (matcher-key-set/single R-relabeled) pre-patch-keys)
|
||||
(check-equal? (trie-lookup R 0 (tset)) (tset))
|
||||
(check-equal? (trie-lookup R 1 (tset)) (tset 'a))
|
||||
(check-equal? (trie-lookup R 2 (tset)) (tset 'b))
|
||||
(check-equal? (trie-lookup R 3 (tset)) (tset 'a 'b))
|
||||
(check-equal? (trie-lookup R 4 (tset)) (tset))
|
||||
(check-equal? (trie-lookup R 5 (tset)) (tset 'a))
|
||||
(check-equal? (trie-lookup R 6 (tset)) (tset 'b))
|
||||
(check-equal? (trie-lookup R 7 (tset)) (tset 'a 'b))
|
||||
(check-equal? (trie-key-set/single (project-routing-table R (tset 'a))) pre-patch-a-keys)
|
||||
(check-equal? (trie-key-set/single (project-routing-table R (tset 'b))) pre-patch-b-keys)
|
||||
(check-equal? (trie-key-set/single R) pre-patch-keys)
|
||||
(check-equal? (trie-key-set/single R-relabeled) pre-patch-keys)
|
||||
|
||||
(define (post-checks R* R*-relabeled p-aggregate)
|
||||
(check-equal? (matcher-key-set/single (project-routing-table R* (tset 'a))) post-patch-a-keys)
|
||||
(check-equal? (matcher-key-set/single (project-routing-table R* (tset 'b))) post-patch-b-keys)
|
||||
(check-equal? (matcher-key-set/single R*) post-patch-keys)
|
||||
(check-equal? (matcher-key-set/single R*-relabeled) post-patch-keys)
|
||||
(check-equal? (matcher-key-set/single (patch-added p-aggregate)) aggregate-added)
|
||||
(check-equal? (matcher-key-set/single (patch-removed p-aggregate)) aggregate-removed))
|
||||
(check-equal? (trie-key-set/single (project-routing-table R* (tset 'a))) post-patch-a-keys)
|
||||
(check-equal? (trie-key-set/single (project-routing-table R* (tset 'b))) post-patch-b-keys)
|
||||
(check-equal? (trie-key-set/single R*) post-patch-keys)
|
||||
(check-equal? (trie-key-set/single R*-relabeled) post-patch-keys)
|
||||
(check-equal? (trie-key-set/single (patch-added p-aggregate)) aggregate-added)
|
||||
(check-equal? (trie-key-set/single (patch-removed p-aggregate)) aggregate-removed))
|
||||
|
||||
(post-checks R1 R1-relabeled p-aggregate1)
|
||||
(post-checks R2 R2-relabeled p-aggregate2)
|
||||
)
|
||||
|
||||
(let* ((ma (set->matcher (tset 'a) (set 1)))
|
||||
(mb (set->matcher (tset 'b) (set 1)))
|
||||
(mmeta (set->matcher (tset 'meta) (set 1)))
|
||||
(R0 (matcher-empty))
|
||||
(let* ((ma (set->trie (tset 'a) (set 1)))
|
||||
(mb (set->trie (tset 'b) (set 1)))
|
||||
(mmeta (set->trie (tset 'meta) (set 1)))
|
||||
(R0 (trie-empty))
|
||||
(R1 mmeta)
|
||||
(R2 mb)
|
||||
(R3 (matcher-union mb mmeta))
|
||||
(R3 (trie-union mb mmeta))
|
||||
(R4 ma)
|
||||
(R5 (matcher-union ma mmeta))
|
||||
(R6 (matcher-union ma mb))
|
||||
(R7 (matcher-union (matcher-union ma mb) mmeta))
|
||||
(R5 (trie-union ma mmeta))
|
||||
(R6 (trie-union ma mb))
|
||||
(R7 (trie-union (trie-union ma mb) mmeta))
|
||||
(p0 empty-patch)
|
||||
(p+ (patch (set->matcher (tset 'a) (set 1)) (matcher-empty)))
|
||||
(p- (patch (matcher-empty) (set->matcher (tset 'a) (set 1)))))
|
||||
(p+ (patch (set->trie (tset 'a) (set 1)) (trie-empty)))
|
||||
(p- (patch (trie-empty) (set->trie (tset 'a) (set 1)))))
|
||||
(check-equal? (compute-aggregate-patch p0 'a R0) p0)
|
||||
(check-equal? (compute-aggregate-patch p0 'a R1) p0)
|
||||
(check-equal? (compute-aggregate-patch p0 'a R2) p0)
|
||||
|
@ -469,31 +469,31 @@
|
|||
(check-equal? (compute-aggregate-patch p- 'a R7 #:remove-meta? #t) p0)
|
||||
)
|
||||
|
||||
(let ((m1 (set->matcher #t (set 1 2)))
|
||||
(m2 (set->matcher (tset 'a) (set 1 2)))
|
||||
(p1 (patch (set->matcher #t (set 2 3)) (matcher-empty)))
|
||||
(p2 (patch (set->matcher (tset 'a) (set 2 3)) (matcher-empty))))
|
||||
(check-equal? (limit-patch p1 m1) (patch (set->matcher #t (set 3)) (matcher-empty)))
|
||||
(let ((m1 (set->trie #t (set 1 2)))
|
||||
(m2 (set->trie (tset 'a) (set 1 2)))
|
||||
(p1 (patch (set->trie #t (set 2 3)) (trie-empty)))
|
||||
(p2 (patch (set->trie (tset 'a) (set 2 3)) (trie-empty))))
|
||||
(check-equal? (limit-patch p1 m1) (patch (set->trie #t (set 3)) (trie-empty)))
|
||||
;; This is false because the resulting patch has tset labelling:
|
||||
(check-false (equal? (limit-patch p2 m1)
|
||||
(patch (set->matcher #t (set 3)) (matcher-empty))))
|
||||
(patch (set->trie #t (set 3)) (trie-empty))))
|
||||
(check-equal? (limit-patch p1 m2)
|
||||
(patch (set->matcher #t (set 3)) (matcher-empty)))
|
||||
(patch (set->trie #t (set 3)) (trie-empty)))
|
||||
(check-equal? (limit-patch p2 m2)
|
||||
(patch (set->matcher (tset 'a) (set 3)) (matcher-empty)))
|
||||
(patch (set->trie (tset 'a) (set 3)) (trie-empty)))
|
||||
)
|
||||
|
||||
(let ((m1 (set->matcher #t (set 1 2)))
|
||||
(m2 (set->matcher (tset 'a) (set 1 2)))
|
||||
(p1 (patch (matcher-empty) (set->matcher #t (set 2 3))))
|
||||
(p2 (patch (matcher-empty) (set->matcher (tset 'a) (set 2 3)))))
|
||||
(check-equal? (limit-patch p1 m1) (patch (matcher-empty) (set->matcher #t (set 2))))
|
||||
(let ((m1 (set->trie #t (set 1 2)))
|
||||
(m2 (set->trie (tset 'a) (set 1 2)))
|
||||
(p1 (patch (trie-empty) (set->trie #t (set 2 3))))
|
||||
(p2 (patch (trie-empty) (set->trie (tset 'a) (set 2 3)))))
|
||||
(check-equal? (limit-patch p1 m1) (patch (trie-empty) (set->trie #t (set 2))))
|
||||
;; This is false because the resulting patch has tset labelling:
|
||||
(check-false (equal? (limit-patch p2 m1)
|
||||
(patch (matcher-empty) (set->matcher #t (set 2)))))
|
||||
(patch (trie-empty) (set->trie #t (set 2)))))
|
||||
(check-equal? (limit-patch p1 m2)
|
||||
(patch (matcher-empty) (set->matcher #t (set 2))))
|
||||
(patch (trie-empty) (set->trie #t (set 2))))
|
||||
(check-equal? (limit-patch p2 m2)
|
||||
(patch (matcher-empty) (set->matcher (tset 'a) (set 2))))
|
||||
(patch (trie-empty) (set->trie (tset 'a) (set 2))))
|
||||
)
|
||||
)
|
||||
|
|
|
@ -17,9 +17,9 @@
|
|||
|
||||
(define-generics prospect-pretty-printable
|
||||
(prospect-pretty-print prospect-pretty-printable [port])
|
||||
#:defaults ([(lambda (x) (and (not (eq? x #f)) (matcher? x)))
|
||||
#:defaults ([(lambda (x) (and (not (eq? x #f)) (trie? x)))
|
||||
(define (prospect-pretty-print m [p (current-output-port)])
|
||||
(pretty-print-matcher m p))]
|
||||
(pretty-print-trie m p))]
|
||||
[(lambda (x) #t)
|
||||
(define (prospect-pretty-print v [p (current-output-port)])
|
||||
(pretty-write v p))]))
|
||||
|
|
1088
prospect/route.rkt
1088
prospect/route.rkt
File diff suppressed because it is too large
Load Diff
|
@ -175,9 +175,9 @@
|
|||
(output "~a exiting (~a total processes remain)\n"
|
||||
pidstr
|
||||
(- oldcount 1)))
|
||||
(unless (matcher-empty? interests)
|
||||
(unless (trie-empty? interests)
|
||||
(output "~a's final interests:\n" pidstr)
|
||||
(pretty-print-matcher interests (current-error-port))))]
|
||||
(pretty-print-trie interests (current-error-port))))]
|
||||
[(quit-network)
|
||||
(with-color BRIGHT-RED
|
||||
(output "Process ~a performed a quit-network.\n" pidstr))]
|
||||
|
@ -211,9 +211,9 @@
|
|||
(unless (boring-state? state)
|
||||
(output "~a's initial state:\n" newpidstr)
|
||||
(prospect-pretty-print state (current-error-port)))
|
||||
(unless (matcher-empty? interests)
|
||||
(unless (trie-empty? interests)
|
||||
(output "~a's initial interests:\n" newpidstr)
|
||||
(pretty-print-matcher interests (current-error-port))))]
|
||||
(pretty-print-trie interests (current-error-port))))]
|
||||
[_
|
||||
;; other cases handled in internal-action
|
||||
(void)])
|
||||
|
@ -223,7 +223,7 @@
|
|||
(when (not (equal? old-table new-table))
|
||||
(with-color BRIGHT-BLUE
|
||||
(output "~a's routing table:\n" (format-pids (cdr pids)))
|
||||
(pretty-print-matcher new-table (current-error-port))))))])
|
||||
(pretty-print-trie new-table (current-error-port))))))])
|
||||
(loop))))
|
||||
|
||||
(void (when (not (set-empty? flags))
|
||||
|
|
Loading…
Reference in New Issue