diff options
| author | Christopher Allan Webber <cwebber@dustycloud.org> | 2017-01-20 17:58:20 -0600 |
|---|---|---|
| committer | Christopher Allan Webber <cwebber@dustycloud.org> | 2017-01-20 18:01:00 -0600 |
| commit | 2aab08f137540cf22d5f5e32467e838c3ab18637 (patch) | |
| tree | f263affe278be03f9018b916227218228128bf08 | |
| parent | 737c0b20467085199c5c189f68c495f239118e68 (diff) | |
| download | 8sync-2aab08f137540cf22d5f5e32467e838c3ab18637.tar.gz | |
actors: Don't reply to a message when the messsage doesn't need a reply.
* 8sync/actors.scm (<-reply, <-reply*, <-reply-wait, <-reply-wait*):
Only reply to messages if they're waiting on a reply still.
This avoids the challenges of actors never having requested a
reply in the first place resulting in trying to resume a waiting
coroutine that doesn't exist, as well as maybe the bonus one of not
replying multiple times to a message.
| -rw-r--r-- | 8sync/actors.scm | 21 |
1 files changed, 13 insertions, 8 deletions
diff --git a/8sync/actors.scm b/8sync/actors.scm index c805067..04e1c06 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -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 |