[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Ludovic Courtès |
Date: |
Mon, 19 Mar 2018 19:00:58 -0400 (EDT) |
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