role macro
This commit is contained in:
parent
ebbd589e88
commit
8aa649a14b
49
os2.rkt
49
os2.rkt
|
@ -21,6 +21,7 @@
|
|||
(rename-out [make-transition transition])
|
||||
extend-transition
|
||||
|
||||
role
|
||||
(except-out (struct-out add-role) add-role)
|
||||
(rename-out [make-add-role add-role])
|
||||
(except-out (struct-out delete-role) delete-role)
|
||||
|
@ -103,6 +104,54 @@
|
|||
|
||||
;;---------------------------------------------------------------------------
|
||||
|
||||
(require (for-syntax syntax/parse))
|
||||
(require (for-syntax racket/base))
|
||||
(define-syntax role
|
||||
(lambda (stx)
|
||||
(syntax-parse stx
|
||||
[(_ topic-expr
|
||||
#:state state-pattern
|
||||
(~or (~optional (~seq #:on-presence presence) #:name "#:on-presence handler")
|
||||
(~optional (~seq #:on-absence absence) #:name "#:on-absence handler")
|
||||
(~optional (~seq #:on-ready ready) #:name "#:on-ready handler")
|
||||
(~optional (~seq #:id eid) #:name "#:id")
|
||||
(~optional (~seq #:topic topic) #:name "#:topic")
|
||||
(~optional (~seq #:reason reason) #:name "#:reason"))
|
||||
...
|
||||
[message-pattern clause-body ...]
|
||||
...)
|
||||
(with-syntax ([eid (if (attribute eid) #'eid #'dummy-eid)]
|
||||
[topic (if (attribute topic) #'topic #'dummy-topic)]
|
||||
[reason (if (attribute reason) #'reason #'dummy-reason)])
|
||||
(with-syntax ([presence-handler (if (not (attribute presence))
|
||||
#'#f
|
||||
#'(lambda (eid topic)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern presence]))))]
|
||||
[absence-handler (if (not (attribute absence))
|
||||
#'#f
|
||||
#'(lambda (eid topic reason)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern absence]))))]
|
||||
[ready-handler (if (not (attribute ready))
|
||||
#'#f
|
||||
#'(lambda (eid)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern ready]))))]
|
||||
[message-handler #'(lambda (eid topic message-body)
|
||||
(lambda (state)
|
||||
(match state
|
||||
[state-pattern
|
||||
(match message-body
|
||||
[message-pattern clause-body ...]
|
||||
...)])))])
|
||||
#'(add-role topic-expr
|
||||
(handlers presence-handler absence-handler message-handler)
|
||||
ready-handler)))])))
|
||||
|
||||
(define (make-transition state . actions) (transition state actions))
|
||||
(define (make-add-role topic handlers [k #f]) (add-role topic handlers k))
|
||||
(define (make-delete-role eid [reason #f]) (delete-role eid reason))
|
||||
|
|
Loading…
Reference in New Issue