aboutsummaryrefslogtreecommitdiff
path: root/module/calp
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2021-12-20 23:06:02 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2021-12-20 23:06:02 +0100
commitbc703eef01c912962a502fa676560b2c200d90ca (patch)
treeef56882c97157d59a6cac7447d5bbb6927ae482d /module/calp
parentfind-extreme on empty list now an error. (diff)
downloadcalp-bc703eef01c912962a502fa676560b2c200d90ca.tar.gz
calp-bc703eef01c912962a502fa676560b2c200d90ca.tar.xz
let-env now handles non-local exits correctly.
Diffstat (limited to 'module/calp')
-rw-r--r--module/calp/util.scm28
1 files changed, 16 insertions, 12 deletions
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)