diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-05-11 20:48:27 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-05-11 20:48:51 +0200 |
| commit | f6da8bc8a634a218e1ca4e87238abcc3c188d29e (patch) | |
| tree | a968674beae9402545d44ee9e68593b8df4dd264 /module/hnh | |
| parent | Remove arbitary_kv.js. (diff) | |
| download | calp-f6da8bc8a634a218e1ca4e87238abcc3c188d29e.tar.gz calp-f6da8bc8a634a218e1ca4e87238abcc3c188d29e.tar.xz | |
Move let-env to own module.
Diffstat (limited to 'module/hnh')
| -rw-r--r-- | module/hnh/util.scm | 23 | ||||
| -rw-r--r-- | module/hnh/util/env.scm | 25 |
2 files changed, 26 insertions, 22 deletions
diff --git a/module/hnh/util.scm b/module/hnh/util.scm index c4282bf6..49fd6ebb 100644 --- a/module/hnh/util.scm +++ b/module/hnh/util.scm @@ -8,7 +8,7 @@ #:export (for sort* sort*! set/r! -> ->> set set-> aif awhen - let-lazy let-env + let-lazy case* and=>> label print-and-return @@ -558,27 +558,6 @@ - -(define-syntax let-env - (syntax-rules () - [(_ ((name value) ...) - body ...) - - (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-syntax catch* (syntax-rules () ((_ thunk (key handler)) diff --git a/module/hnh/util/env.scm b/module/hnh/util/env.scm new file mode 100644 index 00000000..a6877186 --- /dev/null +++ b/module/hnh/util/env.scm @@ -0,0 +1,25 @@ +(define-module (hnh util env) + :export (let-env)) + +(define-syntax let-env + (syntax-rules () + [(_ ((name value) ...) + body ...) + + (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))))])) + + + |