X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Fsystems%2Factors.scm;h=84a5c2e3c178f168d39b981f90be4ff2b3b609f3;hp=ce46f63614fb7640eb3db3ee90450cffac999d92;hb=711168a756750d8e8236c8549d8617c10ddcda58;hpb=ea14f5dc75cebaaf9cc21d96a6575b3738c43354

diff --git a/8sync/systems/actors.scm b/8sync/systems/actors.scm
index ce46f63..84a5c2e 100644
--- a/8sync/systems/actors.scm
+++ b/8sync/systems/actors.scm
@@ -70,7 +70,7 @@
 
             <- <-wait <-reply <-reply-wait
 
-            call-with-message msg-receive =>
+            call-with-message msg-receive msg-val
 
             ez-run-hive
             bootstrap-message
@@ -110,6 +110,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
@@ -437,7 +442,10 @@ more compact following syntax:
                                     (actor-id hive) '*error*
                                     new-message-body
                                     #:in-reply-to (message-id original-message))))
-    (8sync (hive-process-message hive new-message))))
+    ;; We only return a thunk, rather than run 8sync here, because if
+    ;; we ran 8sync in the middle of a catch we'd end up with an
+    ;; unresumable continuation.
+    (lambda () (hive-process-message hive new-message))))
 
 (define-method (hive-process-message (hive <hive>) message)
   "Handle one message, or forward it via an ambassador"
@@ -459,6 +467,7 @@ more compact following syntax:
       actor))
 
   (define (call-catching-coroutine thunk)
+    (define queued-error-handling-thunk #f)
     (define (call-catching-errors)
       ;; TODO: maybe parameterize (or attach to hive) and use
       ;;   maybe-catch-all from agenda.scm
@@ -475,9 +484,16 @@ more compact following syntax:
           (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))
+              ;; However, we have to do it outside of this catch
+              ;; routine, or we'll end up in an unrewindable continuation
+              ;; situation.
+              (set! queued-error-handling-thunk
+                    (hive-reply-with-error hive message key args)))
           ;; print error message
-          (apply print-error-and-continue key args))))
+          (apply print-error-and-continue key args)))
+      ;; @@: This is a kludge.  See above for why.
+      (if queued-error-handling-thunk
+          (8sync (queued-error-handling-thunk))))
     (call-with-prompt (hive-prompt hive)
       call-catching-errors
       (lambda (kont actor message)
@@ -606,16 +622,19 @@ 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 ...)))
 
-;; Emacs: (put '=> 'scheme-indent-function 2)
-;;; An experimental alias.
-(define-syntax-rule (=> rest ...)
-  (msg-receive rest ...))
-
+(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)))
 
 
 ;;; Various API methods for actors to interact with the system