hive-id
hive-create-actor hive-create-actor*
+ create-actor create-actor*
+ self-destruct
+
<message>
make-message message?
message-to message-action message-from
(define %random-state
(make-parameter (random-state-from-platform)))
-;; Probably bigger than necessary
-(define random-number-size (expt 10 50))
+;; Same size as a uuid4 I think...
+(define random-number-size (expt 2 128))
(define (big-random-number)
(random random-number-size (%random-state)))
(message (make-message (hive-gen-message-id hive) to-id
(actor-id from-actor) action
(kwarg-list-to-alist message-body-args))))
- (8sync (hive-process-message hive message))))
+ (8sync-nowait (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"
(let* ((hive (actor-hive from-actor))
- (agenda-prompt (hive-prompt (actor-hive from-actor)))
+ (abort-to (hive-prompt (actor-hive from-actor)))
(message (make-message (hive-gen-message-id hive) to-id
(actor-id from-actor) action
(kwarg-list-to-alist message-body-args)
#:wants-reply #t)))
- (abort-to-prompt agenda-prompt from-actor message)))
+ (abort-to-prompt abort-to from-actor message)))
;; TODO: Intelligently ~propagate(ish) errors on -wait functions.
;; We might have `send-message-wait-brazen' to allow callers to
(actor-id from-actor) '*reply*
(kwarg-list-to-alist message-body-args)
#:in-reply-to (message-id original-message))))
- (8sync (hive-process-message hive new-message))))
+ (8sync-nowait (hive-process-message hive new-message))))
(define (reply-message-wait from-actor original-message
. message-body-args)
"Reply to a messsage, but wait until we get a response"
(set-message-replied! original-message #t)
(let* ((hive (actor-hive from-actor))
- (agenda-prompt (hive-prompt (actor-hive from-actor)))
+ (abort-to (hive-prompt (actor-hive from-actor)))
(new-message (make-message (hive-gen-message-id hive)
(message-from original-message)
(actor-id from-actor) '*reply*
(kwarg-list-to-alist message-body-args)
#:wants-reply #t
#:in-reply-to (message-id original-message))))
- (abort-to-prompt agenda-prompt from-actor new-message)))
+ (abort-to-prompt abort-to from-actor new-message)))
\f
(define-method (hive-process-message (hive <hive>) message)
"Handle one message, or forward it via an ambassador"
- (define (process-local-message)
+ (define (maybe-autoreply actor)
+ ;; Possibly autoreply
+ (if (message-needs-reply message)
+ ;; @@: Should we give *autoreply* as the action instead of *reply*?
+ (reply-message actor message
+ #:*auto-reply* #t)))
+
+ (define (resolve-actor-to)
+ "Get the actor the message was aimed at"
(let ((actor (hive-resolve-local-actor hive (message-to message))))
(if (not actor)
(throw 'actor-not-found
(address->string (message-from message))
(address->string (message-to message)))
message))
- (call-with-prompt (hive-prompt hive)
- (lambda ()
- (define message-handler (actor-message-handler actor))
- ;; @@: Should a more general error handling happen here?
- (let ((result
- (message-handler actor message)))
- ;; Possibly autoreply
- (if (message-needs-reply message)
- ;; @@: Should we give *autoreply* as the action instead of *reply*?
- (reply-message actor message
- #:*auto-reply* #t))
- ;; Returning result allows actors to possibly make a run-request
- ;; at the end of handling a message.
- ;; ... We do want that, right?
- result))
+ actor))
+
+ (define (call-catching-coroutine thunk)
+ (call-with-prompt (hive-prompt hive)
+ thunk
+ (lambda (kont actor message)
+ (let ((hive (actor-hive actor)))
+ ;; Register the coroutine
+ (hash-set! (hive-waiting-coroutines hive)
+ (message-id message)
+ (cons (actor-id actor) kont))
+ ;; Send off the message
+ (8sync (hive-process-message hive message))))))
- (lambda (kont actor message)
- (let ((hive (actor-hive actor)))
- ;; Register the coroutine
- (hash-set! (hive-waiting-coroutines hive)
- (message-id message)
- (cons (actor-id actor) kont))
- ;; Send off the message
- (8sync (hive-process-message hive message)))))))
+ (define (process-local-message)
+ (let ((actor (resolve-actor-to)))
+ (call-catching-coroutine
+ (lambda ()
+ (define message-handler (actor-message-handler actor))
+ ;; @@: Should a more general error handling happen here?
+ (let ((result
+ (message-handler actor message)))
+ (maybe-autoreply actor)
+ ;; Returning result allows actors to possibly make a run-request
+ ;; at the end of handling a message.
+ ;; ... We do want that, right?
+ result)))))
(define (resume-waiting-coroutine)
- (match (hash-remove! (hive-waiting-coroutines hive)
- (message-in-reply-to message))
- ((_ . (resume-actor-id . kont))
- (if (not (equal? (message-to message)
- resume-actor-id))
- (throw 'resuming-to-wrong-actor
- "Attempted to resume a coroutine to the wrong actor!"
- #:expected-actor-id (message-to message)
- #:got-actor-id resume-actor-id
- #:message message))
- (kont message))
- (#f (throw 'no-waiting-coroutine
- "message in-reply-to tries to resume nonexistent coroutine"
- message))))
+ (call-catching-coroutine
+ (lambda ()
+ (match (hash-remove! (hive-waiting-coroutines hive)
+ (message-in-reply-to message))
+ ((_ . (resume-actor-id . kont))
+ (if (not (equal? (message-to message)
+ resume-actor-id))
+ (throw 'resuming-to-wrong-actor
+ "Attempted to resume a coroutine to the wrong actor!"
+ #:expected-actor-id (message-to message)
+ #:got-actor-id resume-actor-id
+ #:message message))
+ (let (;; @@: How should we resolve resuming coroutines to actors who are
+ ;; now gone?
+ (actor (resolve-actor-to))
+ (result (kont message)))
+ (maybe-autoreply actor)
+ result))
+ (#f (throw 'no-waiting-coroutine
+ "message in-reply-to tries to resume nonexistent coroutine"
+ message))))))
(define (process-remote-message)
;; Find the ambassador
;; return the actor id
actor-id))
-(define* (hive-create-actor hive actor-class
- #:key
- (init '())
- id-cookie)
+(define* (hive-create-actor hive actor-class #:rest init)
(%hive-create-actor hive actor-class
- init id-cookie))
+ init #f))
-(define-syntax hive-create-actor*
- (syntax-rules ()
- "Create an instance of actor-class attached to this hive.
-Return the new actor's id.
-
-Used internally, and used for bootstrapping a fresh hive.
-
-Note that actors should generally not call this method directly.
-Instead, actors should call create-actor."
- ((_ args ... (init-args ...))
- (hive-create-actor args ...
- #:init (list init-args ...)))))
+(define* (hive-create-actor* hive actor-class id-cookie #:rest init)
+ (%hive-create-actor hive actor-class
+ init id-cookie))
;; TODO: Give actors this instead of the actual hive reference
(hive #:init-keyword #:hive))
+\f
+;;; Various API methods for actors to interact with the system
+;;; ==========================================================
+
+;; TODO: move send-message and friends here...?
+
+;; TODO: Rewrite this inside of a <hive-proxy> ?
+(define* (create-actor from-actor actor-class #:rest init)
+ "Create an instance of actor-class. Return the new actor's id.
+
+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)))
+
+
+(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)))
+
+
+(define (self-destruct actor)
+ "Remove an actor from the hive."
+ (hash-remove! (hive-actor-registry (actor-hive actor))
+ (actor-id actor)))
+
+
\f
;;; 8sync bootstrap utilities
;;; =========================
projects / 8sync.git / blobdiff