[no subject]

[Ludovic Courtès]

branch: master
commit e0e270986376b81a593553d9ee4b47b5cdb7a2ab
Author: Ludovic Courtès <address@hidden>
Date:   Mon Mar 19 22:13:18 2018 +0100

    utils: Add 'unwind-protect'.
    
    * src/cuirass/utils.scm (unwind-protect): New macro.
---
 src/cuirass/utils.scm | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

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