-(define-syntax-rule (with-message-args (message message-arg ...)
- body body* ...)
- (let ((message-arg (message-ref message (quote message-arg))) ...)
- body body* ...))
-
-(define-syntax mlambda
- (lambda (x)
- "A lambda for building message handlers.
-
-Use it like:
- (mlambda (actor message foo)
- ...)
-
-Which is like doing manually:
- (lambda (actor message)
- (let ((foo (message-ref message foo)))
- ...))"
- (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* ...))))))
-
-(define-syntax-rule (define-mhandler (name actor message message-arg ...)
- body ...)
- (define name
- (mlambda (actor message message-arg ...)
- body ...)))
-
-(define (simple-dispatcher action-map)
- (lambda (actor message)
- (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
- #:actor actor
- #:message message
- #:available-actions (map car action-map)))
- (method actor message))))
-
-(define-syntax %expand-action-item
- (syntax-rules ()
- ((_ ((action-name action-args ...) body ...))
- (cons (quote action-name)
- (mlambda (action-args ...)
- body ...)))
- ((_ (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
-
-You can use this like the following:
- (make-action-dispatch
- (cookies
- (lambda (actor message)
- (display \"I love cookies!\n\")))
- (party
- (lambda (actor message)
- (display \"Life of the party!\"))))
-
-Alternately, if you'd like to skip the lambda, you could use the slightly
-more compact following syntax:
- (make-action-dispatch
- ((cookies actor message)
- (display \"I love cookies!\n\"))
- ((party actor message)
- (display \"Life of the party!\")))"
- ((make-action-dispatch action-item ...)
- (simple-dispatcher (build-actions action-item ...)))))
-
-(define-syntax-rule (define-simple-actor class actions ...)