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

Support #:on-add, #:on-remove in queries

This commit is contained in:
Tony Garnock-Jones 2016-07-13 17:20:57 -04:00
parent 024cb6d707
commit 0ac24a5755
2 changed files with 61 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
racket/syndicate/actor.rkt
View File

@ -345,42 +345,67 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Queries
(define-syntax-rule (query-set field-name P expr)
(let ()
(field [field-name (set)])
(on (asserted P) #:priority *query-priority*
(field-name (set-add (field-name) expr)))
(on (retracted P) #:priority *query-priority*
(field-name (set-remove (field-name) expr)))
field-name))
(begin-for-syntax
(define-splicing-syntax-class on-add
(pattern (~optional (~seq #:on-add expr) #:defaults ([expr #f]))))
(define-splicing-syntax-class on-remove
(pattern (~optional (~seq #:on-remove expr) #:defaults ([expr #f]))))
(define-syntax-rule (query-hash field-name P key-expr value-expr)
(let ()
(field [field-name (hash)])
(on (asserted P) #:priority *query-priority*
(let ((key key-expr))
(when (hash-has-key? (field-name) key)
(log-warning "query-hash: field ~v with pattern ~v: overwriting existing entry ~v"
'field-name
'P
key))
(field-name (hash-set (field-name) key value-expr))))
(on (retracted P) #:priority *query-priority*
(field-name (hash-remove (field-name) key-expr)))
field-name))
(define (schedule-query-handler-stxs maybe-expr-stx)
(if maybe-expr-stx
#`((schedule-script! #:priority *query-handler-priority*
#f
(lambda () #,maybe-expr-stx)))
#'())))
(define-syntax-rule (query-hash-set field-name P key-expr value-expr)
(let ()
(field [field-name (hash)])
(on (asserted P) #:priority *query-priority*
(field-name (hashset-add (field-name) key-expr value-expr)))
(on (retracted P) #:priority
*query-priority* (field-name (hashset-remove (field-name) key-expr value-expr)))
field-name))
(define-syntax (query-set stx)
(syntax-parse stx
[(_ field-name P expr on-add:on-add on-remove:on-remove)
#`(let ()
(field [field-name (set)])
(on (asserted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-add.expr))
(field-name (set-add (field-name) expr)))
(on (retracted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
(field-name (set-remove (field-name) expr)))
field-name)]))
(define-syntax-rule (define/query-set id P expr) (define id (query-set id P expr)))
(define-syntax-rule (define/query-hash id P k v) (define id (query-hash id P k v)))
(define-syntax-rule (define/query-hash-set id P k v) (define id (query-hash-set id P k v)))
(define-syntax (query-hash stx)
(syntax-parse stx
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
#`(let ()
(field [field-name (hash)])
(on (asserted P) #:priority *query-priority*
(let ((key key-expr))
(when (hash-has-key? (field-name) key)
(log-warning "query-hash: field ~v with pattern ~v: overwriting existing entry ~v"
'field-name
'P
key))
#,@(schedule-query-handler-stxs (attribute on-add.expr))
(field-name (hash-set (field-name) key value-expr))))
(on (retracted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
(field-name (hash-remove (field-name) key-expr)))
field-name)]))
(define-syntax (query-hash-set stx)
(syntax-parse stx
[(_ field-name P key-expr value-expr on-add:on-add on-remove:on-remove)
#`(let ()
(field [field-name (hash)])
(on (asserted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-add.expr))
(field-name (hashset-add (field-name) key-expr value-expr)))
(on (retracted P) #:priority *query-priority*
#,@(schedule-query-handler-stxs (attribute on-remove.expr))
(field-name (hashset-remove (field-name) key-expr value-expr)))
field-name)]))
(define-syntax-rule (define/query-set id P x ...) (define id (query-set id P x ...)))
(define-syntax-rule (define/query-hash id P x ...) (define id (query-hash id P x ...)))
(define-syntax-rule (define/query-hash-set id P x ...) (define id (query-hash-set id P x ...)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntax-time support

4
racket/syndicate/examples/actor/query-set.rkt
View File

@ -4,7 +4,9 @@
(actor #:name 'queryer
(forever
(define/query-set as-set `(item ,$a ,$b) (list a b))
(define/query-set as-set `(item ,$a ,$b) (list a b)
#:on-add (log-info "as-set adding ~v/~v" a b)
#:on-remove (log-info "as-set removing ~v/~v" a b))
(define/query-hash as-hash `(item ,$a ,$b) a b)
(define/query-hash-set as-hash-set `(item ,$a ,$b) a b)