diff --git a/os2.rkt b/os2.rkt index e2540ec..4fa1293 100644 --- a/os2.rkt +++ b/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)))])))