[no subject]

[Mathieu Othacehe]

branch: master
commit 6ad9c602697ffe33c8fbb09ccd796b74bf600223
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Jul 29 19:08:04 2020 +0200

    utils: Do not block the calling fiber.
    
    Setting current-fiber to #f in %non-blocking will prevent put-message in the
    new thread to try suspending itself, but will also cause the same behavior 
on
    get-message, which is not desired.
    
    * src/cuirass/utils.scm (%non-blocking): Reduce the scope of current-fiber
    parameter to the newly created thread.
---
 src/cuirass/utils.scm | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 0bcbb35..e2a6fa3 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -144,23 +144,23 @@ VARS... are bound to the arguments of the worker thread."
                            (lambda (vars ...) exp ...)))
 
 (define (%non-blocking thunk)
-  (parameterize (((@@ (fibers internal) current-fiber) #f))
-    (let ((channel (make-channel)))
-      (call-with-new-thread
-       (lambda ()
+  (let ((channel (make-channel)))
+    (call-with-new-thread
+     (lambda ()
+       (parameterize (((@@ (fibers internal) current-fiber) #f))
          (catch #t
            (lambda ()
              (call-with-values thunk
                (lambda values
                  (put-message channel `(values ,@values)))))
            (lambda args
-             (put-message channel `(exception ,@args))))))
+             (put-message channel `(exception ,@args)))))))
 
-      (match (get-message channel)
-        (('values . results)
-         (apply values results))
-        (('exception . args)
-         (apply throw 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