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>)
(define (call-catching-coroutine thunk)
(define (call-catching-errors)
- (with-throw-handler
- #t thunk
- (lambda (key . args)
- (if (message-needs-reply message)
- ;; If the message is waiting on a reply, let them know
- ;; something went wrong.
- (hive-reply-with-error hive message key args)))))
+ ;; TODO: maybe parameterize and use maybe-catch-all from agenda.scm
+ ;; @@: Why not just use with-throw-handler and let the catch
+ ;; happen at the agenda? That's what we used to do, but
+ ;; it ended up with a SIGABRT. See:
+ ;; http://lists.gnu.org/archive/html/bug-guile/2016-05/msg00003.html
+ (catch #t
+ thunk
+ ;; In the actor model, we don't totally crash on errors.
+ (lambda _ #f)
+ ;; If an error happens, we raise it
+ (lambda (key . args)
+ (if (message-needs-reply message)
+ ;; If the message is waiting on a reply, let them know
+ ;; something went wrong.
+ (hive-reply-with-error hive message key args))
+ ;; print error message
+ (apply print-error-and-continue key args))))
(call-with-prompt (hive-prompt hive)
call-catching-errors
(lambda (kont actor message)