syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Make #:state optional in roles

This commit is contained in:
Tony Garnock-Jones 2012-07-16 17:01:35 -04:00
parent 50f52283bb
commit cf4ca5c8bd
1 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
os2.rkt
View File

@ -242,8 +242,8 @@
(lambda (stx) (lambda (stx)
(syntax-parse stx (syntax-parse stx
[(_ pre-eid topics-expr [(_ pre-eid topics-expr
#:state state-pattern (~or (~optional (~seq #:state state-pattern) #:name "#:state pattern")
(~or (~optional (~seq #:on-presence presence) #:name "#:on-presence handler") (~optional (~seq #:on-presence presence) #:name "#:on-presence handler")
(~optional (~seq #:on-absence absence) #:name "#:on-absence handler") (~optional (~seq #:on-absence absence) #:name "#:on-absence handler")
(~optional (~seq #:topic topic) #:defaults ([topic #'t0]) #:name "#:topic") (~optional (~seq #:topic topic) #:defaults ([topic #'t0]) #:name "#:topic")
(~optional (~seq #:reason reason) #:defaults ([reason #'r0]) #:name "#:reason")) (~optional (~seq #:reason reason) #:defaults ([reason #'r0]) #:name "#:reason"))
@ -251,19 +251,32 @@
[message-pattern clause-body ...] [message-pattern clause-body ...]
...) ...)
(define-syntax-rule (build-handler args e-attr) (define-syntax-rule (build-handler args e-attr)
(if (not (attribute e-attr)) (cond
#'#f [(not (attribute e-attr))
#`(lambda args (match-lambda [state-pattern e-attr])))) #'#f]
[(not (attribute state-pattern))
#`(lambda args (match-lambda [state (transition state e-attr)]))]
[else
#`(lambda args (match-lambda [state-pattern e-attr]))]))
(with-syntax ([presence-handler (build-handler (topic) presence)] (with-syntax ([presence-handler (build-handler (topic) presence)]
[absence-handler (build-handler (topic reason) absence)] [absence-handler (build-handler (topic reason) absence)]
[message-handler #'(lambda (topic message-body) [message-handler
(lambda (state) (if (not (attribute state-pattern))
(match state #'(lambda (topic message-body)
[state-pattern (lambda (state)
(match message-body (transition state
[message-pattern clause-body ...] (match message-body
... [message-pattern clause-body ...]
[_ state])])))]) ...
[_ '()]))))
#'(lambda (topic message-body)
(lambda (state)
(match state
[state-pattern
(match message-body
[message-pattern clause-body ...]
...
[_ state])]))))])
#'(add-role pre-eid #'(add-role pre-eid
topics-expr topics-expr
(handlers presence-handler absence-handler message-handler)))]))) (handlers presence-handler absence-handler message-handler)))])))