From bc703eef01c912962a502fa676560b2c200d90ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 20 Dec 2021 23:06:02 +0100 Subject: let-env now handles non-local exits correctly. --- module/calp/util.scm | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) (limited to 'module') diff --git a/module/calp/util.scm b/module/calp/util.scm index 6cee1b0f..70091b2e 100644 --- a/module/calp/util.scm +++ b/module/calp/util.scm @@ -554,23 +554,27 @@ -;;; TODO shouldn't this use dynamic-wind? To handle non-local exits? + (define-syntax let-env (syntax-rules () [(_ ((name value) ...) body ...) - (let ((env-pairs - (map (lambda (n new-value) - (list n new-value (getenv n))) - (list (symbol->string (quote name)) ...) - (list value ...)))) - (for-each (lambda (pair) (setenv (car pair) (cadr pair))) - env-pairs) - (let ((return (begin body ...))) - (for-each (lambda (pair) (setenv (car pair) (caddr pair))) - env-pairs) - return))])) + (let ((env-pairs #f)) + (dynamic-wind + (lambda () + (set! env-pairs + (map (lambda (n new-value) + (list n new-value (getenv n))) + (list (symbol->string (quote name)) ...) + (list value ...))) + (for-each (lambda (pair) (setenv (car pair) (cadr pair))) + env-pairs)) + (lambda () body ...) + (lambda () + (for-each (lambda (pair) (setenv (car pair) (caddr pair))) + env-pairs))))])) + (define-public (uuidgen) ((@ (rnrs io ports) call-with-port) -- cgit v1.2.3