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.

1 files 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