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

Shrink the role macro, using #:defaults and a local expander

This commit is contained in:
Tony Garnock-Jones 2012-04-05 12:10:27 -04:00
parent 4c76dc29f1
commit 4155f63c28
1 changed files with 21 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
os2.rkt
View File

@ -116,44 +116,30 @@
(~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"))
(~optional (~seq #:id eid) #:defaults ([eid #'e0]) #:name "#:id")
(~optional (~seq #:topic topic) #:defaults ([topic #'t0]) #:name "#:topic")
(~optional (~seq #:reason reason) #:defaults ([reason #'r0]) #: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 ...]
...
[_ state])])))])
#'(add-role topic-expr
(handlers presence-handler absence-handler message-handler)
ready-handler)))])))
(define-syntax-rule (build-handler args e-attr)
(if (not (attribute e-attr))
#'#f
#`(lambda (eid . args) (match-lambda [state-pattern e-attr]))))
(with-syntax ([presence-handler (build-handler (topic) presence)]
[absence-handler (build-handler (topic reason) absence)]
[ready-handler (build-handler () ready)]
[message-handler #'(lambda (eid topic message-body)
(lambda (state)
(match state
[state-pattern
(match message-body
[message-pattern clause-body ...]
...
[_ state])])))])
#'(add-role topic-expr
(handlers presence-handler absence-handler message-handler)
ready-handler))])))
;;---------------------------------------------------------------------------
;; Smarter constructors for transitions and preactions.