actors: Switch coroutine waiting code over to using case.

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

diff --git a/8sync/actors.scm b/8sync/actors.scm
index fdcbc85193c43300b293de7e8abb92933073810d..2ce7e142b16a0cedf8706f21c1ad390d00ed24c6 100644 (file)
--- a/8sync/actors.scm
+++ b/8sync/actors.scm
@@ -122,14 +122,15 @@
                        body in-reply-to wants-reply
                        replied)
   message?
-  (id message-id)
-  (to message-to)
-  (from message-from)
-  (action message-action)
-  (body message-body)
-  (in-reply-to message-in-reply-to)
-  (wants-reply message-wants-reply)
-  (replied message-replied set-message-replied!))
+  (id message-id)                    ; id of this message
+  (to message-to)                    ; actor id this is going to
+  (from message-from)                ; actor id of sender
+  (action message-action)            ; action (a symbol) to be handled
+  (body message-body)                ; argument list "body" of message
+  (in-reply-to message-in-reply-to)  ; message id this is in reply to, if any
+  (wants-reply message-wants-reply)  ; whether caller is waiting for reply
+  (replied message-replied           ; was this message replied to?
+           set-message-replied!))
 
 
 (define* (make-message id to from action body
@@ -511,45 +512,50 @@ to come after class definition."
              result))))))
 
   (define (resume-waiting-coroutine)
-    (cond
-     ((or (eq? (message-action message) '*reply*)
-          (eq? (message-action message) '*auto-reply*))
-      (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))))))
-     ;; Yikes, we must have gotten an error or something back
-     (else
-      ;; @@: Not what we want in the long run?
-      ;; What we'd *prefer* to do is to resume this message
-      ;; and throw an error inside the message handler
-      ;; (say, from send-mesage-wait), but that causes a SIGABRT (??!!)
-      (hash-remove! (hive-waiting-coroutines hive)
-                    (message-in-reply-to message))
-      (let ((explaination
-             (if (eq? (message-action message) '*reply*)
-                 "Won't resume coroutine; got an *error* as a reply"
-                 "Won't resume coroutine because action is not *reply*")))
-        (throw 'hive-unresumable-coroutine
-               explaination
-               #:message message)))))
+    (case (message-action message)
+      ;; standard reply / auto-reply
+      ((*reply* *auto-reply*)
+       (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))))))
+      ;; Yikes, an error!
+      ((*error*)
+       ;; @@: Not what we want in the long run?
+       ;; What we'd *prefer* to do is to resume this message
+       ;; and throw an error inside the message handler
+       ;; (say, from send-mesage-wait), but that causes a SIGABRT (??!!)
+       (hash-remove! (hive-waiting-coroutines hive)
+                     (message-in-reply-to message))
+       (let ((explaination
+              (if (eq? (message-action message) '*reply*)
+                  "Won't resume coroutine; got an *error* as a reply"
+                  "Won't resume coroutine because action is not *reply*")))
+         (throw 'hive-unresumable-coroutine
+                explaination #:message message)))
+      ;; Unhandled action for a reply!
+      (else
+       (throw 'hive-unresumable-coroutine
+              "Won't resume coroutine, nonsense action on reply message"
+              #:action (message-action message)
+              #:message message))))
 
   (define (process-remote-message)
     ;; Find the ambassador