utils: Add 'unwind-protect'.

* src/cuirass/utils.scm (unwind-protect): New macro.

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