diff options
Diffstat (limited to 'src/cuirass/utils.scm')
-rw-r--r-- | src/cuirass/utils.scm | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index 947bf71..2e71910 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -32,6 +32,7 @@ object->json-scm object->json-string define-enumeration + unwind-protect non-blocking essential-task bytevector-range)) @@ -67,6 +68,25 @@ value." ((_ symbol) value) ...))) +(define-syntax-rule (unwind-protect body ... conclude) + "Evaluate BODY... and return its result(s), but always evaluate CONCLUDE +before leaving, even if an exception is raised. + +This is *not* implemented with 'dynamic-wind' in order to play well with +delimited continuations and fibers." + (let ((conclusion (lambda () conclude))) + (catch #t + (lambda () + (call-with-values + (lambda () + body ...) + (lambda results + (conclusion) + (apply values results)))) + (lambda args + (conclusion) + (apply throw args))))) + (define (%non-blocking thunk) (let ((channel (make-channel))) (call-with-new-thread |