actor-id-string
mlambda define-mhandler
- build-actions make-action-dispatch
+ simple-dispatcher build-actions make-action-dispatch
define-simple-actor
<hive>
(body message-body)
(in-reply-to message-in-reply-to)
(wants-reply message-wants-reply)
-
- ;; See XUDD source for these. Not use yet, maybe eventually will be?
- ;; XUDD uses them for autoreply.
- ;; Requiring mutation on message objects is clearly not great,
- ;; but it may be worth it...? Investigate!
(replied message-replied set-message-replied!)
(deferred-reply message-deferred-reply set-message-deferred-reply!))
(message (make-message (hive-gen-message-id hive) to-id
(actor-id from-actor) action
(kwarg-list-to-alist message-body-args))))
- (8sync-nowait (hive-process-message hive message))))
+ (8sync (hive-process-message hive message))))
(define (send-message-wait from-actor to-id action . message-body-args)
"Send a message from an actor to another, but wait until we get a response"
(actor-id from-actor) '*reply*
(kwarg-list-to-alist message-body-args)
#:in-reply-to (message-id original-message))))
- (8sync-nowait (hive-process-message hive new-message))))
+ (8sync (hive-process-message hive new-message))))
(define (reply-message-wait from-actor original-message
. message-body-args)
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
(actor-id hive) '*error*
new-message-body
#:in-reply-to (message-id original-message))))
- (8sync-nowait (hive-process-message hive new-message))))
+ (8sync (hive-process-message hive new-message))))
(define-method (hive-process-message (hive <hive>) message)
"Handle one message, or forward it via an ambassador"
(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 (or attach to hive) 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)
(process-remote-message))))
(define-method (hive-actor-local? (hive <hive>) address)
- (hash-ref (hive-actor-registry hive) address))
+ (equal? (hive-id hive) (address-hive-id address)))
(define-method (hive-register-actor! (hive <hive>) (actor <actor>))
(hash-set! (hive-actor-registry hive) (actor-id actor) actor))
This is the method actors should call directly (unless they want
to supply an id-cookie, in which case they should use
create-actor*)."
- (8sync (%hive-create-actor (actor-hive from-actor) actor-class
- init #f)))
+ (%hive-create-actor (actor-hive from-actor) actor-class
+ init #f))
(define* (create-actor* from-actor actor-class id-cookie #:rest init)
"Create an instance of actor-class. Return the new actor's id.
Like create-actor, but permits supplying an id-cookie."
- (8sync (%hive-create-actor (actor-hive from-actor) actor-class
- init id-cookie)))
+ (%hive-create-actor (actor-hive from-actor) actor-class
+ init id-cookie))
(define (self-destruct actor)