Cope with potential interference in query-sets (etc) from outside the official event handlers
This commit is contained in:
parent
6e399dd1dd
commit
81a0351828
|
@ -618,11 +618,15 @@
|
|||
(quasisyntax/loc stx
|
||||
(let ((F field-name))
|
||||
(on (asserted P) #:priority *query-priority*
|
||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||
(F (set-add (F) expr)))
|
||||
(let ((V expr))
|
||||
(when (not (set-member? (F) V))
|
||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||
(F (set-add (F) V)))))
|
||||
(on (retracted P) #:priority *query-priority-high*
|
||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||
(F (set-remove (F) expr)))
|
||||
(let ((V expr))
|
||||
(when (set-member? (F) V)
|
||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||
(F (set-remove (F) V)))))
|
||||
F))]))
|
||||
|
||||
(define-syntax (query-hash stx)
|
||||
|
@ -666,11 +670,15 @@
|
|||
(quasisyntax/loc stx
|
||||
(let ((F field-name))
|
||||
(on (asserted P) #:priority *query-priority*
|
||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||
(F (hashset-add (F) key-expr value-expr)))
|
||||
(let ((K key-expr) (V value-expr))
|
||||
(when (not (hashset-member? (F) K V))
|
||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||
(F (hashset-add (F) K V)))))
|
||||
(on (retracted P) #:priority *query-priority-high*
|
||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||
(F (hashset-remove (F) key-expr value-expr)))
|
||||
(let ((K key-expr) (V value-expr))
|
||||
(when (hashset-member? (F) K V)
|
||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||
(F (hashset-remove (F) K V)))))
|
||||
F))]))
|
||||
|
||||
(define-syntax-rule (define/query-value id ae P x ...) (define id (query-value id ae P x ...)))
|
||||
|
|
|
@ -2,6 +2,7 @@
|
|||
;; Hash-table utilities that are not (yet) part of Racket
|
||||
|
||||
(provide hash-set/remove
|
||||
hashset-member?
|
||||
hashset-add
|
||||
hashset-remove)
|
||||
|
||||
|
@ -12,6 +13,10 @@
|
|||
(hash-remove ht key)
|
||||
(hash-set ht key val)))
|
||||
|
||||
(define (hashset-member? ht key val)
|
||||
(define s (hash-ref ht key #f))
|
||||
(and s (set-member? s val)))
|
||||
|
||||
(define (hashset-add ht key val #:set [set set])
|
||||
(hash-set ht key (set-add (hash-ref ht key set) val)))
|
||||
|
||||
|
|
Loading…
Reference in New Issue