From f6da8bc8a634a218e1ca4e87238abcc3c188d29e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 11 May 2022 20:48:27 +0200
Subject: Move let-env to own module.

---
 module/hnh/util.scm     | 23 +----------------------
 module/hnh/util/env.scm | 25 +++++++++++++++++++++++++
 2 files changed, 26 insertions(+), 22 deletions(-)
 create mode 100644 module/hnh/util/env.scm

(limited to 'module')

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))))]))
+
+
+
-- 
cgit v1.2.3