modularize sex

utils.scm

@@ -1,52 +1,77 @@
-(declare (unit utils))
+(module utils
+    (get-env-var
+     set-working-directory
+     to-absolute-pathname
+     list-split
+     list-join
+     recons
+     with-directory
+     )
 
-(include "utils.macros.scm")
+  (import
+    scheme
+    (chicken base)
+    (chicken pathname)
+    (chicken process-context)
+    srfi-1)
 
-(import
-  (chicken pathname)
-  (chicken process-context)
-  srfi-1)
+  (define-syntax prog1
+    (syntax-rules ()
+      ((prog1 form . forms)
+       (let ((res form))
+         (begin . forms)
+         res))))
 
-(define (get-env-var name)
-  (get-environment-variable name))
+  (define-syntax with-directory
+    (syntax-rules ()
+      ((with-directory path form . forms)
+       (let ((current-dir (current-directory)))
+         (set-working-directory path)
+         (prog1
+          (begin form . forms)
+          (change-directory current-dir))))))
 
-(define (set-working-directory file)
-  (change-directory
-   (normalize-pathname
-    (if (absolute-pathname? file)
-        (pathname-directory file)
+  (define (get-env-var name)
+    (get-environment-variable name))
+
+  (define (set-working-directory file)
+    (change-directory
+     (normalize-pathname
+      (if (absolute-pathname? file)
+          (pathname-directory file)
+          (make-absolute-pathname
+           (current-directory)
+           (pathname-directory file))))))
+
+  (define (to-absolute-pathname pathname)
+    (if (absolute-pathname? pathname)
+        pathname
         (make-absolute-pathname
          (current-directory)
-         (pathname-directory file))))))
+         pathname)))
 
-(define (to-absolute-pathname pathname)
-  (if (absolute-pathname? pathname)
-      pathname
-      (make-absolute-pathname
-       (current-directory)
-       pathname)))
+  (define (list-split src-list split-elt)
+    ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6))
+    (fold (lambda (elt acc)
+            (if (eq? elt split-elt)
+                (append acc (list (list)))
+                (append (drop-right acc 1)
+                        (list (append (last acc) (list elt))))))
+          (list (list))
+          src-list))
 
-(define (list-split src-list split-elt)
-  ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6))
-  (fold (lambda (elt acc)
-          (if (eq? elt split-elt)
-              (append acc (list (list)))
-              (append (drop-right acc 1)
-                      (list (append (last acc) (list elt))))))
-        (list (list))
-        src-list))
-
-(define (list-join lists join-by)
-  (drop-right
-   (fold (lambda (elt acc)
-           (append acc (list elt) (list join-by)))
-         (list)
-         lists)
-   1))
+  (define (list-join lists join-by)
+    (drop-right
+     (fold (lambda (elt acc)
+             (append acc (list elt) (list join-by)))
+           (list)
+           lists)
+     1))
 
 ;;; Reconstruct form
-(define (recons old-cons new-car new-cdr)
-  (if (and (eq? new-car (car old-cons))
-           (eq? new-cdr (cdr old-cons)))
-      old-cons
-      (cons new-car new-cdr)))
+  (define (recons old-cons new-car new-cdr)
+    (if (and (eq? new-car (car old-cons))
+             (eq? new-cdr (cdr old-cons)))
+        old-cons
+        (cons new-car new-cdr)))
+  )