X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=40f860c5b024922d7b7ef51e9850fbcd197d8e66;hb=171dbab2f07df50ac5b1daedfbef6d60860b7935;hp=0659eb52c95f45b5323dcf9e44e887a3a02ebc0a;hpb=efe3df614b1808a686a91d07dfc46690b94ad126;p=8sync.git diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm index 0659eb5..40f860c 100644 --- a/8sync/systems/actors.scm +++ b/8sync/systems/actors.scm @@ -68,9 +68,6 @@ message-wants-reply message-ref - send-message send-message-wait - reply-message reply-message-wait - <- <-wait <-reply <-reply-wait ez-run-hive @@ -126,11 +123,6 @@ (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!)) @@ -191,15 +183,18 @@ If key not found and DFLT not provided, throw an error." args))))) -(define (send-message from-actor to-id action . message-body-args) +;;; See: https://web.archive.org/web/20081223021934/http://mumble.net/~jar/articles/oo-moon-weinreb.html +;;; (also worth seeing: http://mumble.net/~jar/articles/oo.html ) + +(define (<- from-actor to-id action . message-body-args) "Send a message from an actor to another actor" (let* ((hive (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)))) - (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) +(define (<-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)) (abort-to (hive-prompt (actor-hive from-actor))) @@ -214,8 +209,7 @@ If key not found and DFLT not provided, throw an error." ;; not have an exception thrown and instead just have a message with ;; the appropriate '*error* message returned. -(define (reply-message from-actor original-message - . message-body-args) +(define (<-reply from-actor original-message . message-body-args) "Reply to a message" (set-message-replied! original-message #t) (let* ((hive (actor-hive from-actor)) @@ -224,10 +218,9 @@ If key not found and DFLT not provided, throw an error." (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) +(define (<-reply-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)) @@ -241,16 +234,6 @@ If key not found and DFLT not provided, throw an error." (abort-to-prompt abort-to from-actor new-message))) -;;; Aliases! -;;; See: http://mumble.net/~jar/articles/oo-moon-weinreb.html -;;; (also worth seeing: http://mumble.net/~jar/articles/oo.html ) - -(define <- send-message) -(define <-wait send-message-wait) -(define <-reply reply-message) -(define <-reply-wait reply-message-wait) - - ;;; Main actor implementation ;;; ========================= @@ -513,7 +496,7 @@ more compact following syntax: (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 ) message) "Handle one message, or forward it via an ambassador" @@ -521,8 +504,7 @@ more compact following syntax: ;; Possibly autoreply (if (message-needs-reply message) ;; @@: Should we give *autoreply* as the action instead of *reply*? - (reply-message actor message - #:*auto-reply* #t))) + (<-reply actor message #:*auto-reply* #t))) (define (resolve-actor-to) "Get the actor the message was aimed at" @@ -538,7 +520,8 @@ more compact following syntax: (define (call-catching-coroutine thunk) (define (call-catching-errors) - ;; TODO: maybe parameterize and use maybe-catch-all from agenda.scm + ;; 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: @@ -641,7 +624,7 @@ more compact following syntax: (process-remote-message)))) (define-method (hive-actor-local? (hive ) address) - (hash-ref (hive-actor-registry hive) address)) + (equal? (hive-id hive) (address-hive-id address))) (define-method (hive-register-actor! (hive ) (actor )) (hash-set! (hive-actor-registry hive) (actor-id actor) actor)) @@ -683,16 +666,16 @@ that method for documentation." 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) @@ -724,7 +707,7 @@ an integer." (define (bootstrap-message hive to-id action . message-body-args) (wrap - (apply send-message hive to-id action message-body-args))) + (apply <- hive to-id action message-body-args)))