X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=8sync%2Factors.scm;h=04e1c06a4e2b563a7d6dfb2c63b76959cf7ee12f;hb=2aab08f137540cf22d5f5e32467e838c3ab18637;hp=0c50446d8c1a4ac9b8aaec5328247edd9ef8f4da;hpb=04cb3218619e5fd734dd0644e734b3fe506caf00;p=8sync.git diff --git a/8sync/actors.scm b/8sync/actors.scm index 0c50446..04e1c06 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -1,5 +1,5 @@ ;;; 8sync --- Asynchronous programming for Guile -;;; Copyright (C) 2016 Christopher Allan Webber +;;; Copyright © 2016, 2017 Christopher Allan Webber ;;; ;;; 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
-;; (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! -;;
-;; (lambda (record port) -;; (format port "" -;; (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))