actors: Add %current-actor parameter.

[8sync.git] / 8sync / systems / actors.scm

diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index ea638c0e180eb5b290f88ef6bde90d36eae2669f..4c9215fc0e49d5dce6b713608a102d03c32824eb 100644 (file)
--- a/8sync/systems/actors.scm
+++ b/8sync/systems/actors.scm
@@ -36,6 +36,8 @@
             actor-id
             actor-message-handler
 
+            %current-actor
+
             ;;; Commenting out the <address> type for now;
             ;;; it may be back when we have better serializers
             ;; <address>
@@ -70,7 +72,7 @@
 
             <- <-wait <-reply <-reply-wait
 
-            call-with-message msg-receive
+            call-with-message msg-receive msg-val
 
             ez-run-hive
             bootstrap-message
@@ -110,6 +112,11 @@
 ;;; ========
 
 
+;; @@: We may want to add a deferred-reply to the below, similar to
+;;   what we had in XUDD, for actors which do their own response
+;;   queueing.... ie, that might receive messages but need to shelve
+;;   them to be acted upon after something else is taken care of.
+
 (define-record-type <message>
   (make-message-intern id to from action
                        body in-reply-to wants-reply
@@ -276,6 +283,8 @@
   "Render the full actor id as a human-readable string"
   (address->string (actor-id actor)))
 
+(define %current-actor
+  (make-parameter #f))
 
 \f
 ;;; Actor utilities
@@ -505,13 +514,14 @@ more compact following syntax:
        (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)))))
+         (parameterize ((%current-actor actor))
+           (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)
     (cond
@@ -617,11 +627,20 @@ argument.  Similar to call-with-values in concept."
 ;; Emacs: (put 'msg-receive 'scheme-indent-function 2)
 
 ;; @@: Or receive-msg or receieve-message or??
-(define-syntax-rule (msg-receive arglist the-message body ...)
-  (call-with-message the-message
+(define-syntax-rule (msg-receive arglist message body ...)
+  "Call body with arglist (which can accept arguments like lambda*)
+applied from the message-body of message."
+  (call-with-message message
                      (lambda* arglist
                        body ...)))
 
+(define (msg-val message)
+  "Retrieve the first value from the message-body of message.
+Like single value return from a procedure call.  Probably the most
+common case when waiting on a reply from some action invocation."
+  (call-with-message message
+                     (lambda (_ val) val)))
+
 \f
 ;;; Various API methods for actors to interact with the system
 ;;; ==========================================================