Avoid silly use of macro

This commit is contained in:
Tony Garnock-Jones 2019-05-02 23:12:02 +01:00
parent 17d5b88784
commit 79e8d54a51
1 changed files with 44 additions and 40 deletions

View File

@ -80,48 +80,50 @@
(begin/dataflow (log-syndicate/federation-debug "::: ~a specs ~v" nodeid (specs))) (begin/dataflow (log-syndicate/federation-debug "::: ~a specs ~v" nodeid (specs)))
(begin/dataflow (log-syndicate/federation-debug "::: ~a subs ~v" nodeid (subs)))) (begin/dataflow (log-syndicate/federation-debug "::: ~a subs ~v" nodeid (subs))))
(define-syntax with-localid->sub (define (call-with-sub localid connid f)
(syntax-rules (->) (match (hash-ref (subs) localid #f)
((_ (localid connid -> sub) body ...) [#f (log-syndicate/federation-error
(match (hash-ref (subs) localid #f) "Mention of nonexistent local ID ~v from connection ~v. Ignoring."
[#f (log-syndicate/federation-error localid
"Mention of nonexistent local ID ~v from connection ~v. Ignoring." connid)]
localid [sub (f sub)]))
connid)]
[sub body ...]))))
(define (unsubscribe! localid connid) (define (unsubscribe! localid connid)
(with-localid->sub [localid connid -> sub] (call-with-sub
(define new-holders (hash-remove (subscription-holders sub) connid)) localid connid
(specs (hash-remove (specs) (subscription-spec sub))) (lambda (sub)
(subs (if (hash-empty? new-holders) (define new-holders (hash-remove (subscription-holders sub) connid))
(hash-remove (subs) localid) (specs (hash-remove (specs) (subscription-spec sub)))
(hash-set (subs) localid (struct-copy subscription sub (subs (if (hash-empty? new-holders)
[holders new-holders])))) (hash-remove (subs) localid)
(hash-set (subs) localid (struct-copy subscription sub
[holders new-holders]))))
;; The messages we send depend on (hash-count new-holders): ;; The messages we send depend on (hash-count new-holders):
;; - if >1, there are enough other active subscribers that we don't need to send ;; - if >1, there are enough other active subscribers that we don't need to send
;; any messages. ;; any messages.
;; - if =1, we retract the subscription from that peer (INVARIANT: will not be connid) ;; - if =1, we retract the subscription from that peer (INVARIANT: will not be connid)
;; - if =0, we retract the subscription from all peers except connid ;; - if =0, we retract the subscription from all peers except connid
(match (hash-count new-holders) (match (hash-count new-holders)
[0 (for [(peer (in-set (peers)))] [0 (for [(peer (in-set (peers)))]
(when (not (equal? peer connid)) (when (not (equal? peer connid))
(send! (router-outbound peer (Unsubscribe localid)))))] (send! (router-outbound peer (Unsubscribe localid)))))]
[1 (for [(peer (in-hash-keys new-holders))] ;; there will only be one, ≠ connid [1 (for [(peer (in-hash-keys new-holders))] ;; there will only be one, ≠ connid
(send! (router-outbound peer (Unsubscribe localid))))] (send! (router-outbound peer (Unsubscribe localid))))]
[_ (void)]))) [_ (void)]))))
(define (adjust-matches localid connid captures delta expected-outcome ctor) (define (adjust-matches localid connid captures delta expected-outcome ctor)
(with-localid->sub [localid connid -> sub] (call-with-sub
(define-values (new-matches outcome) localid connid
(bag-change (subscription-matches sub) captures delta #:clamp? #t)) (lambda (sub)
(subs (hash-set (subs) localid (struct-copy subscription sub [matches new-matches]))) (define-values (new-matches outcome)
(when (eq? outcome expected-outcome) (bag-change (subscription-matches sub) captures delta #:clamp? #t))
(for ([(peer peer-subid) (in-hash (subscription-holders sub))]) (subs (hash-set (subs) localid (struct-copy subscription sub [matches new-matches])))
(when (not (equal? peer connid)) (when (eq? outcome expected-outcome)
(send! (router-outbound peer (ctor peer-subid captures)))))))) (for ([(peer peer-subid) (in-hash (subscription-holders sub))])
(when (not (equal? peer connid))
(send! (router-outbound peer (ctor peer-subid captures)))))))))
(during (observe (router-connection nodeid $connid)) (during (observe (router-connection nodeid $connid))
(assert (router-connection nodeid connid)) (assert (router-connection nodeid connid))
@ -215,9 +217,11 @@
(relay-add-or-del localid captures -1 'present->absent Del)) (relay-add-or-del localid captures -1 'present->absent Del))
(on (message (router-inbound connid (Msg $localid $captures))) (on (message (router-inbound connid (Msg $localid $captures)))
(with-localid->sub [localid connid -> sub] (call-with-sub
(for ([(peer peer-subid) (in-hash (subscription-holders sub))]) localid connid
(when (not (equal? peer connid)) (lambda (sub)
(send! (router-outbound peer (Msg peer-subid captures))))))) (for ([(peer peer-subid) (in-hash (subscription-holders sub))])
(when (not (equal? peer connid))
(send! (router-outbound peer (Msg peer-subid captures))))))))
))) )))