Make #:state optional in roles
This commit is contained in:
parent
50f52283bb
commit
cf4ca5c8bd
39
os2.rkt
39
os2.rkt
|
@ -242,8 +242,8 @@
|
|||
(lambda (stx)
|
||||
(syntax-parse stx
|
||||
[(_ pre-eid topics-expr
|
||||
#:state state-pattern
|
||||
(~or (~optional (~seq #:on-presence presence) #:name "#:on-presence handler")
|
||||
(~or (~optional (~seq #:state state-pattern) #:name "#:state pattern")
|
||||
(~optional (~seq #:on-presence presence) #:name "#:on-presence handler")
|
||||
(~optional (~seq #:on-absence absence) #:name "#:on-absence handler")
|
||||
(~optional (~seq #:topic topic) #:defaults ([topic #'t0]) #:name "#:topic")
|
||||
(~optional (~seq #:reason reason) #:defaults ([reason #'r0]) #:name "#:reason"))
|
||||
|
@ -251,19 +251,32 @@
|
|||
[message-pattern clause-body ...]
|
||||
...)
|
||||
(define-syntax-rule (build-handler args e-attr)
|
||||
(if (not (attribute e-attr))
|
||||
#'#f
|
||||
#`(lambda args (match-lambda [state-pattern e-attr]))))
|
||||
(cond
|
||||
[(not (attribute 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)]
|
||||
[absence-handler (build-handler (topic reason) absence)]
|
||||
[message-handler #'(lambda (topic message-body)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern
|
||||
(match message-body
|
||||
[message-pattern clause-body ...]
|
||||
...
|
||||
[_ state])])))])
|
||||
[message-handler
|
||||
(if (not (attribute state-pattern))
|
||||
#'(lambda (topic message-body)
|
||||
(lambda (state)
|
||||
(transition state
|
||||
(match message-body
|
||||
[message-pattern clause-body ...]
|
||||
...
|
||||
[_ '()]))))
|
||||
#'(lambda (topic message-body)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern
|
||||
(match message-body
|
||||
[message-pattern clause-body ...]
|
||||
...
|
||||
[_ state])]))))])
|
||||
#'(add-role pre-eid
|
||||
topics-expr
|
||||
(handlers presence-handler absence-handler message-handler)))])))
|
||||
|
|
Loading…
Reference in New Issue