actors: Don't reply to a message when the messsage doesn't need a reply.

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

diff --git a/8sync/actors.scm b/8sync/actors.scm
index 0c50446d8c1a4ac9b8aaec5328247edd9ef8f4da..04e1c06a4e2b563a7d6dfb2c63b76959cf7ee12f 100644 (file)
--- a/8sync/actors.scm
+++ b/8sync/actors.scm
@@ -1,5 +1,5 @@
 ;;; 8sync --- Asynchronous programming for Guile
-;;; Copyright (C) 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2016, 2017 Christopher Allan Webber <cwebber@dustycloud.org>
 ;;;
 ;;; This file is part of 8sync.
 ;;;
@@ -233,8 +233,9 @@
 
 (define (<-reply original-message . message-body-args)
   "Reply to a message"
-  (send-message '() (%current-actor) (message-from original-message) '*reply*
-                original-message #f message-body-args))
+  (when (message-needs-reply? original-message)
+    (send-message '() (%current-actor) (message-from original-message) '*reply*
+                  original-message #f message-body-args)))
 
 (define (<-reply* send-options original-message . message-body-args)
   "Like <-reply, but allows extra parameters via send-options"
@@ -243,7 +244,8 @@
     (send-message send-options actor
                   (message-from original-message) '*reply*
                   original-message #f message-body-args))
-  (apply really-send send-options))
+  (when (message-needs-reply? original-message)
+    (apply really-send send-options)))
 
 (define (<-auto-reply actor original-message)
   "Auto-reply to a message.  Internal use only!"
@@ -252,10 +254,12 @@
 
 (define (<-reply-wait original-message . message-body-args)
   "Reply to a messsage, but wait until we get a response"
-  (wait-maybe-handle-errors
-   (send-message '() (%current-actor)
-                 (message-from original-message) '*reply*
-                 original-message #t message-body-args)))
+  (if (message-needs-reply? original-message)
+      (wait-maybe-handle-errors
+       (send-message '() (%current-actor)
+                     (message-from original-message) '*reply*
+                     original-message #t message-body-args))
+      #f))
 
 (define (<-reply-wait* send-options original-message
                        . message-body-args)
@@ -267,7 +271,8 @@
                          (message-from original-message) '*reply*
                          original-message #t message-body-args)
            send-options))
-  (apply really-send send-options))
+  (when (message-needs-reply? original-message)
+    (apply really-send send-options)))
 
 (define* (wait-maybe-handle-errors message
                                    #:key accept-errors
@@ -342,22 +347,9 @@ to come after class definition."
                          (*cleanup* (const #f)))
            #:allocation #:each-subclass))
 
-;;; So these are the nicer representations of addresses.
-;;; However, they don't serialize so easily with scheme read/write, so we're
-;;; using the simpler cons cell version below for now.
-
-;; (define-record-type <address>
-;;   (make-address actor-id hive-id)  ; @@: Do we want the trailing -id?
-;;   address?
-;;   (actor-id address-actor-id)
-;;   (hive-id address-hive-id))
-;;
-;; (set-record-type-printer!
-;;  <address>
-;;  (lambda (record port)
-;;    (format port "<address: ~s@~s>"
-;;            (address-actor-id record) (address-hive-id record))))
-;;
+;;; Addresses are vectors where the first part is the actor-id and
+;;; the second part is the hive-id.  This works well enough... they
+;;; look decent being pretty-printed.
 
 (define (make-address actor-id hive-id)
   (vector actor-id hive-id))