Avoid accidental shadowing of field-names in query-value* and friends
This commit is contained in:
parent
75bc4a8ca5
commit
6a2163bce9
|
@ -565,14 +565,14 @@
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ field-name absent-expr P expr on-add:on-add on-remove:on-remove)
|
[(_ field-name absent-expr P expr on-add:on-add on-remove:on-remove)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(let ()
|
(let ((F field-name))
|
||||||
(on (asserted P) #:priority *query-priority*
|
(on (asserted P) #:priority *query-priority*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||||
(field-name expr))
|
(F expr))
|
||||||
(on (retracted P) #:priority *query-priority-high*
|
(on (retracted P) #:priority *query-priority-high*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||||
(field-name absent-expr))
|
(F absent-expr))
|
||||||
field-name))]))
|
F))]))
|
||||||
|
|
||||||
(define-syntax (query-set stx)
|
(define-syntax (query-set stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -586,14 +586,14 @@
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ field-name P expr on-add:on-add on-remove:on-remove)
|
[(_ field-name P expr on-add:on-add on-remove:on-remove)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(let ()
|
(let ((F field-name))
|
||||||
(on (asserted P) #:priority *query-priority*
|
(on (asserted P) #:priority *query-priority*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||||
(field-name (set-add (field-name) expr)))
|
(F (set-add (F) expr)))
|
||||||
(on (retracted P) #:priority *query-priority-high*
|
(on (retracted P) #:priority *query-priority-high*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||||
(field-name (set-remove (field-name) expr)))
|
(F (set-remove (F) expr)))
|
||||||
field-name))]))
|
F))]))
|
||||||
|
|
||||||
(define-syntax (query-hash stx)
|
(define-syntax (query-hash stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -607,20 +607,20 @@
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
|
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(let ()
|
(let ((F field-name))
|
||||||
(on (asserted P) #:priority *query-priority*
|
(on (asserted P) #:priority *query-priority*
|
||||||
(let ((key key-expr))
|
(let ((key key-expr))
|
||||||
(when (hash-has-key? (field-name) key)
|
(when (hash-has-key? (F) key)
|
||||||
(log-warning "query-hash: field ~v with pattern ~v: overwriting existing entry ~v"
|
(log-warning "query-hash: field ~v with pattern ~v: overwriting existing entry ~v"
|
||||||
'field-name
|
'field-name
|
||||||
'P
|
'P
|
||||||
key))
|
key))
|
||||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||||
(field-name (hash-set (field-name) key value-expr))))
|
(F (hash-set (F) key value-expr))))
|
||||||
(on (retracted P) #:priority *query-priority-high*
|
(on (retracted P) #:priority *query-priority-high*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||||
(field-name (hash-remove (field-name) key-expr)))
|
(F (hash-remove (F) key-expr)))
|
||||||
field-name))]))
|
F))]))
|
||||||
|
|
||||||
(define-syntax (query-hash-set stx)
|
(define-syntax (query-hash-set stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -634,14 +634,14 @@
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
|
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(let ()
|
(let ((F field-name))
|
||||||
(on (asserted P) #:priority *query-priority*
|
(on (asserted P) #:priority *query-priority*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
#,@(schedule-query-handler-stxs (attribute on-add.expr))
|
||||||
(field-name (hashset-add (field-name) key-expr value-expr)))
|
(F (hashset-add (F) key-expr value-expr)))
|
||||||
(on (retracted P) #:priority *query-priority-high*
|
(on (retracted P) #:priority *query-priority-high*
|
||||||
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
|
||||||
(field-name (hashset-remove (field-name) key-expr value-expr)))
|
(F (hashset-remove (F) key-expr value-expr)))
|
||||||
field-name))]))
|
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 ...)))
|
||||||
(define-syntax-rule (define/query-set id P x ...) (define id (query-set id P x ...)))
|
(define-syntax-rule (define/query-set id P x ...) (define id (query-set id P x ...)))
|
||||||
|
|
|
@ -0,0 +1,30 @@
|
||||||
|
#lang syndicate/actor
|
||||||
|
;; Demonstrates a (fixed) bug in define/query-value scoping.
|
||||||
|
;;
|
||||||
|
;; Buggy output:
|
||||||
|
;;
|
||||||
|
;; w is #f
|
||||||
|
;; Process #f (0) died with exception:
|
||||||
|
;; application: not a procedure;
|
||||||
|
;; expected a procedure that can be applied to arguments
|
||||||
|
;; given: '(val 123)
|
||||||
|
;; arguments...:
|
||||||
|
;; '(val 123)
|
||||||
|
;; context...:
|
||||||
|
;;
|
||||||
|
;; Expected output:
|
||||||
|
;;
|
||||||
|
;; w is #f
|
||||||
|
;; w is '(val 123)
|
||||||
|
;;
|
||||||
|
;; Diagnosis:
|
||||||
|
;;
|
||||||
|
;; The field being defined, w, was being shadowed by the w binding in
|
||||||
|
;; the query pattern. Adding `(let ((F field-name)) ...)` in the
|
||||||
|
;; query-value* macro (and friends) avoids the issue.
|
||||||
|
|
||||||
|
(actor (define/query-value w #f ($ w (list 'val _)) w)
|
||||||
|
(begin/dataflow
|
||||||
|
(log-info "w is ~v" (w))))
|
||||||
|
|
||||||
|
(actor (assert (list 'val 123)))
|
Loading…
Reference in New Issue