[no subject]

[Ludovic Courtès]

branch: master
commit ef3801b3ccb3db8e9f2c327015b2aca8cfb67a4e
Author: Ludovic Courtès <address@hidden>
Date:   Thu Feb 8 18:46:46 2018 +0100

    utils: 'non-blocking' forwards exceptions to the calling fiber.
    
    * src/cuirass/utils.scm (%non-blocking): Forward exceptions to the
    calling fiber.
---
 src/cuirass/utils.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 56dfced..947bf71 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -71,10 +71,19 @@ value."
   (let ((channel (make-channel)))
     (call-with-new-thread
      (lambda ()
-       (call-with-values thunk
-         (lambda values
-           (put-message channel values)))))
-    (apply values (get-message channel))))
+       (catch #t
+         (lambda ()
+           (call-with-values thunk
+             (lambda values
+               (put-message channel `(values ,@values)))))
+         (lambda args
+           (put-message channel `(exception ,@args))))))
+
+    (match (get-message channel)
+      (('values . results)
+       (apply values results))
+      (('exception . args)
+       (apply throw args)))))
 
 (define-syntax-rule (non-blocking exp ...)
   "Evalaute EXP... in a separate thread so that it doesn't block the execution