actor-id-string
mlambda define-mhandler
- make-action-dispatch
+ simple-dispatcher build-actions make-action-dispatch
define-simple-actor
<hive>
body body* ...))
(define-syntax mlambda
- (syntax-rules ()
+ (lambda (x)
"A lambda for building message handlers.
Use it like:
(lambda (actor message)
(let ((foo (message-ref message foo)))
...))"
- ((_ (actor message message-arg ...)
- body body* ...)
- (lambda (actor message)
- (with-message-args (message message-arg ...) body body* ...)))))
+ (syntax-case x ()
+ ((_ (actor message message-arg ...)
+ docstring
+ body ...)
+ (string? (syntax->datum #'docstring))
+ #'(lambda (actor message)
+ docstring
+ (with-message-args (message message-arg ...) body ...)))
+ ((_ (actor message message-arg ...)
+ body body* ...)
+ #'(lambda (actor message)
+ (with-message-args (message message-arg ...) body body* ...))))))
-;; @@: Sadly, docstrings won't work with this...
-;; I think we need to bust out syntax-case to make that happen...
(define-syntax-rule (define-mhandler (name actor message message-arg ...)
body ...)
(define name
(let* ((action (message-action message))
(method (assoc-ref action-map action)))
(if (not method)
+ ;; @@: There's every possibility this should be handled in
+ ;; hive-process-message instead.
(throw 'action-not-found
"No appropriate action handler found for actor"
#:action action
((_ (action-name handler))
(cons (quote action-name) handler))))
+(define-syntax-rule (build-actions action-item ...)
+ "Build a mapping of actions. Same syntax as make-action-dispatch
+but this doesn't build the dispatcher for you (you probably want to
+pass it to simple-dispatcher).
+
+The advantage here is that since this simply builds an alist, you can
+compose it with other action maps."
+ (list (%expand-action-item action-item) ...))
+
(define-syntax make-action-dispatch
(syntax-rules ()
"Expand a list of action names and actions into an alist
((party actor message)
(display \"Life of the party!\")))"
((make-action-dispatch action-item ...)
- (simple-dispatcher
- (list (%expand-action-item action-item) ...)))))
+ (simple-dispatcher (build-actions action-item ...)))))
(define-syntax-rule (define-simple-actor class actions ...)
(define-class class (<actor>)