Skip to content
Snippets Groups Projects
Commit ef3801b3 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

utils: 'non-blocking' forwards exceptions to the calling fiber.

* src/cuirass/utils.scm (%non-blocking): Forward exceptions to the
calling fiber.
parent 8c7c9392
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment