syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Cope with potential interference in query-sets (etc) from outside the official event handlers

This commit is contained in:
Tony Garnock-Jones 2017-07-30 18:48:33 -04:00
parent 6e399dd1dd
commit 81a0351828
2 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
racket/syndicate/actor.rkt
View File

@ -618,11 +618,15 @@
(quasisyntax/loc stx (quasisyntax/loc stx
(let ((F field-name)) (let ((F field-name))
(on (asserted P) #:priority *query-priority* (on (asserted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-add.expr)) (let ((V expr))
(F (set-add (F) 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* (on (retracted P) #:priority *query-priority-high*
#,@(schedule-query-handler-stxs (attribute on-remove.expr)) (let ((V expr))
(F (set-remove (F) expr))) (when (set-member? (F) V)
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
(F (set-remove (F) V)))))
F))])) F))]))
(define-syntax (query-hash stx) (define-syntax (query-hash stx)
@ -666,11 +670,15 @@
(quasisyntax/loc stx (quasisyntax/loc stx
(let ((F field-name)) (let ((F field-name))
(on (asserted P) #:priority *query-priority* (on (asserted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-add.expr)) (let ((K key-expr) (V value-expr))
(F (hashset-add (F) key-expr 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* (on (retracted P) #:priority *query-priority-high*
#,@(schedule-query-handler-stxs (attribute on-remove.expr)) (let ((K key-expr) (V value-expr))
(F (hashset-remove (F) key-expr value-expr))) (when (hashset-member? (F) K V)
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
(F (hashset-remove (F) K V)))))
F))])) F))]))
(define-syntax-rule (define/query-value id ae P x ...) (define id (query-value id ae P x ...))) (define-syntax-rule (define/query-value id ae P x ...) (define id (query-value id ae P x ...)))

5
racket/syndicate/support/hash.rkt
View File

@ -2,6 +2,7 @@
;; Hash-table utilities that are not (yet) part of Racket ;; Hash-table utilities that are not (yet) part of Racket
(provide hash-set/remove (provide hash-set/remove
hashset-member?
hashset-add hashset-add
hashset-remove) hashset-remove)
@ -12,6 +13,10 @@
(hash-remove ht key) (hash-remove ht key)
(hash-set ht key val))) (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]) (define (hashset-add ht key val #:set [set set])
(hash-set ht key (set-add (hash-ref ht key set) val))) (hash-set ht key (set-add (hash-ref ht key set) val)))