modularize Sex compiler

Makefile

@@ -1,6 +1,6 @@
 CHICKEN_C = csc
 
-MODULES = sexc templates main
+MODULES = sexc main modules templates utils
 OBJ = $(MODULES:%=%.o)
 
 # chicken flags

modules.scm

@@ -0,0 +1,86 @@
+(declare (unit sex-modules)             ; you CAN'T have unit named
+                                        ; modules, things start to
+                                        ; break. Probably some
+                                        ; internal chicken name
+         (uses utils))
+
+(import brev-separate
+        (chicken file)
+        (chicken load)
+        (chicken pathname)
+        (chicken string)
+        fmt
+        srfi-1)
+
+(define +persistent-module-paths+ (list))
+
+(define (import-modules module-list)
+  ;; Module list is a list of symbols
+  ;; How Sex handles modules:
+  ;; For each module in a list, construct path, find module by path in
+  ;; module path directories, extract public definitions from the
+  ;; module, paste them in current one in emulation of C include
+  ;; directives.
+  (fold-right append (list)
+              (map (fn (import-module (symbol->string x)))
+                   module-list)))
+
+(define (import-module name)
+  (let ((module-path (locate-module name)))
+    (assert module-path (fmt #f "Failed to find module " name " in "
+                             (get-module-paths)))
+    (read-public-interface module-path)))
+
+(define (get-module-paths)
+  (cons (current-directory)
+        +persistent-module-paths+))
+
+(define (locate-module name)
+  ;; Module locations: relative to file being compiled, or in what was
+  ;; in SEX_MODULE_PATH env var at the start of the process (see
+  ;; load-persistent-module-paths function)
+
+  (let ((search-paths (get-module-paths)))
+    (let loop ((paths search-paths))
+      (if (null? paths)
+          #f
+          (or (module-exists? name (car paths))
+              (loop (cdr paths)))))))
+
+(define (module-exists? name module-dir)
+  ;; returns absolute path to module, if it exists
+  (and (directory-exists? module-dir)
+       (let ((module-path (make-absolute-pathname module-dir name "sex")))
+         (and (file-exists? module-path)
+              (file-readable? module-path)
+              module-path))))
+
+(define (read-public-interface module-path)
+  ;; pub fns are reduced to prototypes, other pub forms are just pasted
+  (let ((raw-forms (read-from-file module-path)))
+    (fold
+     process-public-interface-form
+     (list)
+     raw-forms)))
+
+(define (process-public-interface-form form acc)
+  (case (car form)
+    ((pub)
+     (case (cadr form)
+       ((fn) ; replace with prototype
+        ;; fn type name (arg-list) (body)
+        ;; 1    2   3       4 - we need first 4
+        (cons (take (cdr form) 4) acc))
+       ((define import include struct template typedef union var)
+        (cons (cdr form) acc))
+       (else (error "Pub what? " (cadr form)))))
+    (else acc)))
+
+(define (load-persistent-module-paths)
+  (let ((sex-module-path-env-var
+         (get-env-var "SEX_MODULE_PATH")))
+    (when sex-module-path-env-var
+      (set! +persistent-module-paths+
+        (map (lambda (p)
+               (make-absolute-pathname p #f #f))
+             (string-split sex-module-path-env-var ":"))))))

sexc.scm

@@ -1,5 +1,8 @@
 (declare (unit sexc)
-         (uses templates))
+         (uses sex-modules
+               templates))
+
+(include "utils.macros.scm")
 
 (import brev-separate
         (chicken file)
@@ -200,81 +203,6 @@
               (fmt #t (c-expr form) nl))
             forms))
 
-;;; Module stuff
-
-(define (import-modules module-list)
-  ;; Module list is a list of symbols
-  ;; How Sex handles modules:
-  ;; For each module in a list, construct path, find module by path in
-  ;; module path directories, extract public definitions from the
-  ;; module, paste them in current one in emulation of C include
-  ;; directives.
-  (fold-right append (list)
-              (map (fn (import-module (symbol->string x)))
-                   module-list)))
-
-(define (import-module name)
-  (let ((module-path (locate-module name)))
-    (assert module-path (fmt #f "Failed to find module " name " in "
-                             (get-module-paths)))
-    (read-public-interface module-path)))
-
-(define (get-module-paths)
-  (cons (current-directory)
-        +persistent-module-paths+))
-
-(define (locate-module name)
-  ;; Module locations: relative to file being compiled, or in what was
-  ;; in SEX_MODULE_PATH env var at the start of the process (see
-  ;; load-persistent-module-paths function)
-
-  (let ((search-paths (get-module-paths)))
-    (let loop ((paths search-paths))
-      (if (null? paths)
-          #f
-          (or (module-exists? name (car paths))
-              (loop (cdr paths)))))))
-
-(define (module-exists? name module-dir)
-  ;; returns absolute path to module, if it exists
-  (and (directory-exists? module-dir)
-       (let ((module-path (make-absolute-pathname module-dir name "sex")))
-         (and (file-exists? module-path)
-              (file-readable? module-path)
-              module-path))))
-
-(define (read-public-interface module-path)
-  ;; pub fns are reduced to prototypes, other pub forms are just pasted
-  (let ((raw-forms (read-from-file module-path)))
-    (fold
-     process-public-interface-form
-     (list)
-     raw-forms)))
-
-(define (process-public-interface-form form acc)
-  (case (car form)
-    ((pub)
-     (case (cadr form)
-       ((fn) ; replace with prototype
-        ;; fn type name (arg-list) (body)
-        ;; 1    2   3       4 - we need first 4
-        (cons (take (cdr form) 4) acc))
-       ((define import include struct template typedef union var)
-        (cons (cdr form) acc))
-       (else (error "Pub what? " (cadr form)))))
-    (else acc)))
-
-(define +persistent-module-paths+ (list))
-
-(define (load-persistent-module-paths)
-  (let ((sex-module-path-env-var
-         (get-env-var "SEX_MODULE_PATH")))
-    (when sex-module-path-env-var
-      (set! +persistent-module-paths+
-        (map (lambda (p)
-               (make-absolute-pathname p #f #f))
-             (string-split sex-module-path-env-var ":"))))))
-
 ;;; Main function facilities
 
 (define opts-grammar
@@ -337,36 +265,11 @@
         'stdin
         (car rest-args))))
 
-(define-syntax prog1
-  (syntax-rules ()
-    ((prog1 form . forms)
-     (let ((res form))
-       (begin . forms)
-       res))))
-
-(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 (read-from-file file)
   (with-directory file
    (with-input-from-file (pathname-strip-directory file)
      (fn (read-forms (list))))))
 
-(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 (write-to-file-or-stdout output what)
   (if (eq? output 'default)
       (what)
@@ -381,9 +284,6 @@
         (map pp sex-forms)
         (emit-c sex-forms)))))
 
-(define (get-env-var name)
-  (get-environment-variable name))
-
 (define (compile-to-file sex-forms output args)
   (let ((compiler (or (get-arg args 'c-compiler #f)
                       (get-env-var "SEX_CC")

templates.scm

@@ -1,8 +1,8 @@
 (declare (unit templates))
 
 (import
-  (chicken plist)
   brev-separate
+  (chicken plist)
   fmt
   regex
   srfi-1                                ; list routines

utils.macros.scm

@@ -0,0 +1,15 @@
+(define-syntax prog1
+  (syntax-rules ()
+    ((prog1 form . forms)
+     (let ((res form))
+       (begin . forms)
+       res))))
+
+(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))))))

utils.scm

@@ -0,0 +1,19 @@
+(declare (unit utils))
+
+(include "utils.macros.scm")
+
+(import
+  (chicken pathname)
+  (chicken process-context))
+
+(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))))))