From 4155f63c286a75a4bb82242fe817cc9da1756403 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Thu, 5 Apr 2012 12:10:27 -0400
Subject: [PATCH] Shrink the role macro, using #:defaults and a local expander

---
 os2.rkt | 56 +++++++++++++++++++++-----------------------------------
 1 file changed, 21 insertions(+), 35 deletions(-)

diff --git a/os2.rkt b/os2.rkt
index ed518ba..ae74429 100644
--- a/os2.rkt
+++ b/os2.rkt
@@ -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.