fix paren placing in fmt

Prior to the fix, the Sex code
`(while (!= EOF (= c (getc f))) ...)` expanded wrongly to
`while (EOF != c = getc(f)) { ...`, instead of
`while (EOF != (c = getc(f))) { ...`

.gitignore

@@ -1,4 +1,5 @@
 *.o
 *.import.scm
+*.link
 sexc
 sex-tests

Makefile

@@ -1,53 +1,61 @@
 CHICKEN_C = csc
-CSC_FLAGS += -K prefix
+CSC_FLAGS += -K prefix -static
+# What and why:
+# -emit-all-import-libraries: Emit import-libraries for all defined modules.
+#    Used to generate .import.scm files so compiler would know how to use the modules.
+#    Without it, csc fails with "cannot import from undefined module" error.
+# -module-registration: Always  generate  module registration code, even when
+#    import libraries are emitted. Enables us to import from our modules at run time.
+#    Used in macros, where we inject `(import (only sex-macros cat))' before the macro body.
+#    Without it, sexc compiles scuccessfully, but is unable to process macros, failing with
+#    "during expansion of (import ...) - cannot import from undefined module: sex-macros"
+#     error.
+# -c: Stop after compilation to object files. This one is obvious.
+
+MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
 
 # Order matters, since module check correctness on compilation
-MODULES = utils macros reader module-system semen sex-fmt-c fmt-c-writer sexc
+MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
 OBJ = $(MODULES:%=%.o)
-IMPORTS = $(MODULES:%=%.import.scm)
-LINK = $(MODULES:%=%.link)
 
-sexc: $(OBJ) main.o
-	$(CHICKEN_C) $(CSC_FLAGS) $^ -o $@
-
-main.o: main.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $< -c -o $@ -link sexc
+sexc: $(OBJ) main.scm
+	$(CHICKEN_C) $(CSC_FLAGS) main.scm -o sexc-tmp -link sexc,sex-macros
+        # otherwise csc hangs, probably because it tries to compile to sexc.o first
+	mv sexc-tmp sexc
 
 #------------------------------------------------------------------
 
-utils.o: utils.scm
-	$(CHICKEN_C) $(CSC_FLAGS) utils.scm -e -c -J -o utils.o -unit utils
+utils.o: utils.module.scm utils.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
 
-macros.o: macros.scm
-	$(CHICKEN_C) $(CSC_FLAGS) macros.scm -e -c -J -o macros.o -unit macros
+sex-macros.o: sex-macros.module.scm sex-macros.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-macros.module.scm -o sex-macros.o -unit sex-macros
 
-reader.o:
-	$(CHICKEN_C) $(CSC_FLAGS) reader.scm -e -c -J -o reader.o -unit reader
+reader.o: reader.module.scm reader.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader
 
-module-system.o: module-system.scm reader.import.scm utils.import.scm
-	$(CHICKEN_C) $(CSC_FLAGS) module-system.scm -e -c -J -o module-system.o -unit module-system -link utils
+sex-modules.o: sex-modules.module.scm sex-modules.scm reader.o utils.o
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-modules.module.scm -o sex-modules.o -unit sex-modules -link reader,utils
 
-semen.o: semen.scm macros.import.scm module-system.import.scm utils.import.scm
-	$(CHICKEN_C) $(CSC_FLAGS) semen.scm -e -c -J -o semen.o -unit semen -link macros -link module-system -link utils
+semen.o: semen.module.scm semen.scm sex-macros.o sex-modules.o utils.o
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) semen.module.scm -o semen.o -unit semen -link sex-macros,sex-modules,utils
 
-fmt-c-writer.o: fmt-c-writer.scm sex-fmt-c.import.scm utils.import.scm
-	$(CHICKEN_C) $(CSC_FLAGS) fmt-c-writer.scm -e -c -J -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c -link utils
+sex-fmt-c.o: sex-fmt-c.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sex-fmt-c.scm -o sex-fmt-c.o -unit sex-fmt-c
 
-sexc.o: sexc.scm fmt-c-writer.import.scm macros.import.scm module-system.import.scm reader.import.scm semen.import.scm utils.import.scm
-	$(CHICKEN_C) $(CSC_FLAGS) sexc.scm -e -c -J -o sexc.o -unit sexc -link fmt-c-writer -link macros -link module-system -link reader -link semen -link utils
+fmt-c-writer.o: fmt-c-writer.module.scm fmt-c-writer.scm sex-fmt-c.o utils.o
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) fmt-c-writer.module.scm -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c,utils
 
-%.link: %.o
-%.import.scm: %.o
-%.o: %.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $< -e -c -J -o $@ -unit $(@:%.o=%)
+sexc.o: sexc.module.scm sexc.scm fmt-c-writer.o sex-macros.o sex-modules.o reader.o semen.o utils.o
+	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) sexc.module.scm -o sexc.o -unit sexc -link fmt-c-writer,sex-macros,sex-modules,reader,semen,utils
 
-
-sex-tests: $(OBJ) tests/*.scm
-	cd ./tests && $(CHICKEN_C) $(CSC_FLAGS) run.scm -c -o sex-tests.o
-	$(CHICKEN_C) $(CSC_FLAGS) $(OBJ) ./tests/sex-tests.o -o sex-tests
+sex-tests:
+	cd tests
+	make sex-tests
+	cp ./tests/sex-tests ./
 
 clean:
-	rm -f $(OBJ) main.o ./tests/sex-tests.o
-	rm -f $(IMPORTS)
-	rm -f $(LINK) main.link
-	rm -f sexc sex-tests
+	rm -f $(OBJ) main.o
+	rm -f *.import.scm
+	rm -f *.link
+	rm -f sexc

fmt-c-writer.module.scm

@@ -0,0 +1,3 @@
+(module fmt-c-writer (emit-c
+                      sex-fmt-current-file)
+  "fmt-c-writer.scm")

fmt-c-writer.scm

@@ -1,8 +1,6 @@
 ;;; Sex fmt-c output writer
 
-(module fmt-c-writer (emit-c
-                      sex-fmt-current-file)
-  (import
+(import
   scheme
   (chicken base)
   (chicken string)
@@ -18,7 +16,7 @@
   tree
   utils)
 
-  (define (unkebabify sym)
+(define (unkebabify sym)
   (case sym
     ((-) sym)
     ((--) sym)
@@ -29,7 +27,7 @@
       (string-substitute "-(?!>)" "_"
                          (symbol->string sym) #t)))))
 
-  (define (atom-to-fmt-c atom)
+(define (atom-to-fmt-c atom)
   (case atom
     ((fn) '%fun)
     ((prototype) '%prototype)
@@ -49,29 +47,29 @@
          (unkebabify atom)
          atom))))
 
-  (define (maybe-unwrap-type type)
+(define (maybe-unwrap-type type)
   (if (and (list? type)
            (= 1 (length type)))
       (car type)
       type))
 
-  (define (make-field-access form)
+(define (make-field-access form)
   (assert
    (= 2 (length form)) "Wrong field access format")
   (unkebabify
    (string->symbol
     (fmt #f (cadr form) (car form)))))
 
-  (define (walk-generic-toplevel form)
+(define (walk-generic-toplevel form)
   (cond ((atom? form) (atom-to-fmt-c form))
         ((list? form) (map walk-generic-toplevel form))
         (else (error "Malformed form " form))))
 
-  (define (field-access-form? form)
+(define (field-access-form? form)
   (and (symbol? (car form))
        (char=? #\. (string-ref (symbol->string (car form)) 0))))
 
-  (define (walk-expr form)
+(define (walk-expr form)
   (match form
     ((? vector?)
      (list->vector
@@ -92,7 +90,7 @@
     (('c-bit-or= . rest) (apply c-bit-or= (map walk-expr rest)))
     (else (map walk-expr form))))
 
-  (define (walk-var form)
+(define (walk-var form)
   ;; (var a int) -> (%var int a)
   ;; (var a (const int) 32) -> (%var (const int) a 32)
   ;; (var b [const char 512]) -> (%var (%array (const char) 512) b)
@@ -107,7 +105,7 @@
          (walk-expr (drop form 3)))      ; optional init expression
     ))
 
-  (define (walk-type form)
+(define (walk-type form)
   ;; int -> int
   ;; (const int) -> const int
   ;; [const char 512] ->(¤ (const char) 512) -> (%array (const char) 512)
@@ -140,7 +138,7 @@
     (else
      (type-convert-to-c form))))
 
-  (define (type-convert-to-c type)
+(define (type-convert-to-c type)
   ;; Our pointers to C pointers
   ;; int -> int
   ;; * const char -> const char *
@@ -152,7 +150,7 @@
                   (list-join (reverse (list-split type '*))
                              '(*)))))))
 
-  (define (walk-fn-def form)
+(define (walk-fn-def form)
   (match form
     (('fn name args ret-type . maybe-body)
      `(%fun
@@ -163,12 +161,12 @@
        ,(walk-expr maybe-body)))))
 
 ;;; TODO: isn't there a better way?
-  (define (is-probably-type form)
+(define (is-probably-type form)
   (case (car form)
     ((¤ * const volatile struct union) #t)
     (else #f)))
 
-  (define (walk-arglist form)
+(define (walk-arglist form)
   ;; E.g.:
   ;; ((float) (int) (const char) (* const char) (¤ (* const struct res) 32))
   ;; ((f1 float) (f2 float) (f3 float) (res (¤ float 4)))
@@ -188,20 +186,20 @@
                                 (list (walk-type var))))))
        form))
 
-  (define (walk-function form)
+(define (walk-function form)
   ;; (fn ret-type name arglist body) -> normal function
   ;; (fn ret-type name arglist) -> prototype
   (if (>= (length form) 5)
       (walk-fn-def form)
       (cons '%prototype (cdr (walk-fn-def form)))))
 
-  (define (process-struct-fields fields)
+(define (process-struct-fields fields)
   (map (fn
         (let ((type (walk-type (last x))))
           (cons type (map atom-to-fmt-c (drop-right x 1)))))
        fields))
 
-  (define (walk-struct form)
+(define (walk-struct form)
   (match form
     ((type (fields ...) . attrs)        ; anonymous struct
      `(,type ,(process-struct-fields fields)
@@ -214,14 +212,14 @@
              . ,(tree-map atom-to-fmt-c attrs)))
     (else (error "Malformed aggregate definition " form))))
 
-  (define (walk-enum form)
+(define (walk-enum form)
   (match form
     (('enum (values ...))
      `(enum ,(map atom-to-fmt-c values)))
     (('enum name (values ...))
      `(enum ,(atom-to-fmt-c name) ,(map atom-to-fmt-c values)))))
 
-  (define (walk-extern form)
+(define (walk-extern form)
   (match form
     (('fn . _)
      ;; extern function?.. What
@@ -230,7 +228,7 @@
      (list 'extern (walk-var form)))
     (else (error "Extern what?"))))
 
-  (define (walk-public form)
+(define (walk-public form)
   (match form
     (('fn . _)
      (walk-function form))
@@ -251,7 +249,7 @@
     (else
      (error "Pub what?" (cadr form)))))
 
-  (define (process-toplevel-form form)
+(define (process-toplevel-form form)
   (match form
     (('fn . _) (list 'static (walk-function form)))
     (('var . _) (list 'static (walk-var form)))
@@ -263,23 +261,23 @@
     (('define name . rest) `(%define ,(atom-to-fmt-c name) ,@rest))
     (else (walk-expr form))))
 
-  (define (get-line-num form)
+(define (get-line-num form)
   (let ((num (get-line-number form)))
     (if (string? num)
         (last (string-split num ":"))
         #f)))
 
-  (define sex-fmt-current-file (make-parameter "/dev/null"))
-  (define sex-fmt-line-num (make-parameter 0))
+(define sex-fmt-current-file (make-parameter "/dev/null"))
+(define sex-fmt-line-num (make-parameter 0))
 
-  (define (line-directive-string)
+(define (line-directive-string)
   (fmt #f #\# "line " (sex-fmt-line-num) " " #\" (sex-fmt-current-file) #\"))
 
-  (define (emit-c sex-forms)
+(define (emit-c sex-forms)
   (for-each (lambda (form)
               (let ((start-line (get-line-num form)))
                 (when start-line
                   (sex-fmt-line-num start-line)
                   (fmt #t (line-directive-string) nl)))
               (fmt #t (c-expr (process-toplevel-form form)) nl))
-              sex-forms)))
+            sex-forms))

macros.scm

@@ -1,45 +0,0 @@
-(module macros
-    (register-macro
-     cat
-     get-macro
-     macro?
-     apply-macro
-     defmacro)
-  (import
-    scheme
-    (only fmt fmt)
-    (chicken base)
-    (chicken plist)
-    (chicken string))
-
-  (define (cat-syms s-1 s-2)
-    (fmt #f s-1 s-2))
-
-  (define (cat sym-1 sym-2)
-    (string->symbol (cat-syms sym-1 sym-2)))
-
-  (define (register-macro name arglist body)
-    (put! name 'sex-macro
-          `(lambda ,arglist
-             (import scheme
-                     (only macros cat))
-             ,@body)))
-
-  (define (get-macro name)
-    (eval (get name 'sex-macro)))
-
-  (define (macro? form)
-    (and (list? form)
-         (symbol? (car form))
-         (get (car form) 'sex-macro)))
-
-  (define (apply-macro form)
-    (assert (macro? form)
-            (fmt #f (car form) " is not a macro"))
-    (apply (get-macro (car form))
-           (cdr form)))
-
-  (define (defmacro form)
-    (let ((arglist (car form))
-          (body (cdr form)))
-      (register-macro (car arglist) (cdr arglist) body))))

module-system.scm

@@ -1,92 +0,0 @@
-(module module-system
-    (get-modules-public-forms
-     load-persistent-module-paths
-     read-public-interface)
-
-  (import
-    scheme
-    brev-separate
-    (chicken base)
-    (chicken file)
-    (chicken load)
-    (chicken pathname)
-    (chicken process-context)
-    (chicken string)
-    fmt
-    reader
-    srfi-1
-    utils)
-
-  (define +persistent-module-paths+ (list))
-
-  (define (get-modules-public-forms 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)))
-
-;;; TODO: use semen facilities to analyze modules
-  (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 defmacro import include struct 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 ":")))))))

reader.module.scm

@@ -0,0 +1,3 @@
+(module reader (read-from-file
+                read-raw-forms)
+  "reader.scm")

reader.scm

@@ -1,6 +1,4 @@
-(module reader (read-from-file
-                read-raw-forms)
-  (import
+(import
   scheme
   (chicken base)
   (chicken io)
@@ -12,19 +10,19 @@
   brev-separate
   fmt)
 
-  (import-syntax utils)
+(import-syntax utils)
 
-  (define (read-forms acc)
+(define (read-forms acc)
   (let ((r (read-with-source-info (current-input-port))))
     (if (eof-object? r) (reverse acc)
         (read-forms (cons r acc)))))
 
-  (define (read-from-file file)
+(define (read-from-file file)
   (with-directory file
                   (with-input-from-file (pathname-strip-directory file)
                     (fn (read-forms (list))))))
 
-  (define (read-bracket port)
+(define (read-bracket port)
   (let loop ((c (read-char port))
              (str (string)))
     (cond ((char=? c #\])
@@ -37,9 +35,9 @@
            (loop (read-char port)
                  (conc str c))))))
 
-  (define open-bracket-counter (make-parameter 0))
+(define open-bracket-counter (make-parameter 0))
 
-  (define (read-raw-forms input-source)
+(define (read-raw-forms input-source)
   (let ((bracket-end (gensym)))
     (set-read-syntax!
      #\]
@@ -61,4 +59,4 @@
                    (cons r acc)))))))
   (if (eq? input-source 'stdin)
       (read-forms (list))
-        (read-from-file input-source))))
+      (read-from-file input-source)))

semen.module.scm

@@ -0,0 +1,2 @@
+(module semen ()
+  "semen.scm")

semen.scm

@@ -1,22 +1,21 @@
 ;;; Sex semantic engine
 
-(module semen ()
-  (import
+(import
   scheme
   (chicken base)
   (chicken keyword)
   (chicken string)
   (chicken module)
   fmt
-    macros
+  sex-macros
+  sex-modules
   matchable                         ; pattern matching
-    module-system
   srfi-1                            ; list routines
   srfi-69                           ; hash tables
   utils
   )
 
-  (export/rename (process semen-process))
+(export/rename (process semen-process))
 
 ;;; for lambda extraction, docstring processing, macro expansion,
 ;;; injection of module headers, i.e. all things that rearrange code
@@ -26,10 +25,10 @@
 ;;; append their return to the resulting list. Each handler can return
 ;;; multiple forms, e.g. lambdas collected from a function may result
 ;;; in auxiliary structures and functions.
-  (define (process raw-sex-forms)
+(define (process raw-sex-forms)
   (process-rec raw-sex-forms (list)))
 
-  (define (process-rec forms acc)
+(define (process-rec forms acc)
   (cond
    ((null? forms) (reverse acc))
    ((macro? (car forms))
@@ -40,7 +39,7 @@
     (process-rec (cdr forms)
                  (match-sex-form (car forms) acc)))))
 
-  (define (macroexpand macro-form rest-forms)
+(define (macroexpand macro-form rest-forms)
   ;; We want to replace macro with its expansion. The problem is,
   ;; top-level macro can return either a single form, or a list of
   ;; forms, when it for example generates some aux
@@ -53,7 +52,7 @@
         (append res rest-forms)
         (cons res rest-forms))))
 
-  (define (match-sex-form sex-form acc)
+(define (match-sex-form sex-form acc)
   (match sex-form
     ((or ('fn . _)
          ('pub 'fn . _)
@@ -82,7 +81,7 @@
 
     (else (assert #f (fmt #f "Unknown top level form " sex-form)))))
 
-  (define (process-imports module-public-forms acc)
+(define (process-imports module-public-forms acc)
   ;; Recursively process imports: register public macros, cons all
   ;; other public things to our acc
   (if (null? module-public-forms) acc
@@ -95,7 +94,7 @@
                           (cons (car module-public-forms)
                                 acc))))))
 
-  (define (macro-expand form)
+(define (macro-expand form)
   "Walk the form recursively and expand all macros, until none is left."
   (walk-form
    form
@@ -113,12 +112,12 @@
 ;;; For inspiration, see SBCL's walk.lisp and their template
 ;;; system.
 
-  (define walk-embed-result (gensym)
+(define walk-embed-result (gensym)
   ;; For cases when result is a list which must be embedded in the
   ;; form, e.g. when it returned from a macro
   )
 
-  (define (walk-form form walk-fn env)
+(define (walk-form form walk-fn env)
   (if (atom? form) form
       (let ((new-form (walk-fn form env)))
         (cond ((not (eq? form new-form))
@@ -134,12 +133,12 @@
 
 ;;; Typdef
 
-  (define (process-typedef new-type target acc)
+(define (process-typedef new-type target acc)
   (cons `(typedef ,target ,new-type) acc))
 
 ;;; Fn processing
 
-  (define (process-fn sex-fn acc)
+(define (process-fn sex-fn acc)
   (let* ((expanded (macro-expand sex-fn))
          (env (make-hash-table))
          (processed
@@ -155,7 +154,7 @@
     (cons processed
           (append (hash-table-ref env :lambda-aux-code) acc))))
 
-  (define (fn-walker form env)
+(define (fn-walker form env)
   (if (eq? 'lambda (car form))
       (let ((lambda-name (make-lambda-name (hash-table-ref env :fn-name)
                                            (hash-table-ref env :lambda-counter))))
@@ -167,11 +166,11 @@
         lambda-name)
       form))
 
-  (define (make-lambda-name enclosing-fn-name counter)
+(define (make-lambda-name enclosing-fn-name counter)
   (string->symbol
    (fmt #f "__lambda_" counter "_" enclosing-fn-name)))
 
-  (define (make-aux-lambda-struct name form)
+(define (make-aux-lambda-struct name form)
   (match form
     (('lambda ret-type arglist captures . body)
      ;; Captures are ignored for now, but
@@ -181,18 +180,18 @@
 
 ;;; Structs
 
-  (define (process-struct sex-struct acc)
+(define (process-struct sex-struct acc)
   (cons sex-struct acc))
 
-  (define (process-global-var sex-var acc)
+(define (process-global-var sex-var acc)
   (cons sex-var acc))
 
 ;;; Utils
-  (define (non-empty-list? form)
+(define (non-empty-list? form)
   (and (list? form)
        (not (null? form))))
 
-  (define (sex-fn? form)
+(define (sex-fn? form)
   "The `form` must be toplevel.
 Returns #f if the form is not a function, returns the form otherwise"
   (match form
@@ -200,31 +199,31 @@ Returns #f if the form is not a function, returns the form otherwise"
     ((pub fn . _) form)
     (else #f)))
 
-  (define (sex-fn-public? fn-form)
+(define (sex-fn-public? fn-form)
   (eq? (car fn-form) 'pub))
 
-  (define (sex-fn-return-type fn-form)
+(define (sex-fn-return-type fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
   (if (sex-fn-public? fn-form)
       (third fn-form)
       (second fn-form)))
 
-  (define (sex-fn-name fn-form)
+(define (sex-fn-name fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
   (if (sex-fn-public? fn-form)
       (fourth fn-form)
       (third fn-form)))
 
-  (define (sex-fn-arglist fn-form)
+(define (sex-fn-arglist fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
   (if (sex-fn-public? fn-form)
       (fifth fn-form)
       (fourth fn-form)))
 
-  (define (sex-fn-prototype fn-form)
+(define (sex-fn-prototype fn-form)
   "Returns all except body"
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
@@ -232,10 +231,9 @@ Returns #f if the form is not a function, returns the form otherwise"
       (take fn-form 5)
       (take fn-form 4)))
 
-  (define (sex-fn-body fn-form)
+(define (sex-fn-body fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
   (if (sex-fn-public? fn-form)
       (drop fn-form 5)
       (drop fn-form 4)))
-  )

sex-fmt-c.scm

@@ -112,7 +112,7 @@
     (lambda (st)
       ((fmt-let 'op op
                 (if (and (c-op<= (fmt-op st) op)
-                         (not (vector? st)))
+                         (not (vector? x)))
                     (c-paren x)
                     x))
        st)))

sex-macros.module.scm

@@ -0,0 +1,8 @@
+(module sex-macros
+    (register-macro
+     cat
+     get-macro
+     macro?
+     apply-macro
+     defmacro)
+  "sex-macros.scm")

sex-macros.scm

@@ -0,0 +1,38 @@
+(import
+  scheme
+  (only fmt fmt)
+  (chicken base)
+  (chicken plist)
+  (chicken string))
+
+(define (cat-syms s-1 s-2)
+  (fmt #f s-1 s-2))
+
+(define (cat sym-1 sym-2)
+  (string->symbol (cat-syms sym-1 sym-2)))
+
+(define (register-macro name arglist body)
+  (put! name 'sex-macro
+        `(lambda ,arglist
+           (import scheme
+                   (only sex-macros cat))
+           ,@body)))
+
+(define (get-macro name)
+  (eval (get name 'sex-macro)))
+
+(define (macro? form)
+  (and (list? form)
+       (symbol? (car form))
+       (get (car form) 'sex-macro)))
+
+(define (apply-macro form)
+  (assert (macro? form)
+          (fmt #f (car form) " is not a macro"))
+  (apply (get-macro (car form))
+         (cdr form)))
+
+(define (defmacro form)
+  (let ((arglist (car form))
+        (body (cdr form)))
+    (register-macro (car arglist) (cdr arglist) body)))

sex-mode.el

@@ -51,7 +51,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
      ;; Keywords
      (list (concat "("
                    (regexp-opt '(
+                                 "begin"
                                  "case"
+                                 "default"
                                  "do"
                                  "if"
                                  "for"
@@ -83,6 +85,8 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
 (put 'union 'lisp-indent-function 'defun)
 (put 'var 'lisp-indent-function 0)
 (put 'import 'lisp-indent-function 1)
+(put 'switch 'lisp-indent-function 1)
+(put 'case 'lisp-indent-function 1)
 
 ;;;###autoload
 (define-derived-mode sex-mode lisp-data-mode "Sex"

sex-modules.module.scm

@@ -0,0 +1,5 @@
+(module sex-modules
+    (get-modules-public-forms
+     load-persistent-module-paths
+     read-public-interface)
+  "sex-modules.scm")

sex-modules.scm

@@ -0,0 +1,87 @@
+(import
+  scheme
+  brev-separate
+  (chicken base)
+  (chicken file)
+  (chicken load)
+  (chicken pathname)
+  (chicken process-context)
+  (chicken string)
+  fmt
+  reader
+  srfi-1
+  utils)
+
+(define +persistent-module-paths+ (list))
+
+(define (get-modules-public-forms 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)))
+
+;;; TODO: use semen facilities to analyze modules
+(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 defmacro import include struct 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.module.scm

@@ -0,0 +1 @@
+(module sexc (main) "sexc.scm")

sexc.scm

@@ -1,5 +1,4 @@
-(module sexc (main)
-  (import scheme
+(import scheme
         brev-separate
         (chicken base)
         (chicken file)
@@ -11,8 +10,8 @@
         fmt
         fmt-c-writer
         getopt-long
-          macros
-          module-system
+        sex-macros
+        sex-modules
         reader
         semen
         srfi-1                          ; list routines
@@ -22,7 +21,7 @@
 
 ;;; Main function facilities
 
-  (define opts-grammar
+(define opts-grammar
   (let ((padding 26))
     `((c-compiler ,(fmt #f "Select C compiler. Defaults to value of SEX_CC" nl
                         (pad padding) "environment variable, or if it is empty, to cc")
@@ -53,46 +52,46 @@
               (value #t)
               (single-char #\o)))))
 
-  (define (print-help)
+(define (print-help)
   (fmt #t "Usage: sexc [options] filename [-- options-for-c-compiler]\n")
   (fmt #t "Options:\n")
   (fmt #t (usage opts-grammar))
   (fmt #t ""))
 
-  (define (help-arg? args)
+(define (help-arg? args)
   (assoc 'help args))
 
-  (define (get-arg args arg-name default)
+(define (get-arg args arg-name default)
   (let ((arg (assoc arg-name args)))
     (if arg (cdr arg)
         default)))
 
-  (define (get-rest-args args)
+(define (get-rest-args args)
   (cdr (assoc '@ args)))
 
-  (define (get-c-compiler-args args)
+(define (get-c-compiler-args args)
   (filter (fn (string-prefix? "-" x)) (get-rest-args args)))
 
-  (define (get-input-file args)
+(define (get-input-file args)
   (let ((rest-args (get-rest-args args)))
     (if (null? rest-args)
         'stdin
         (car rest-args))))
 
-  (define (write-to-file-or-stdout output what)
+(define (write-to-file-or-stdout output what)
   (if (eq? output 'default)
       (what)
       (with-output-to-file output
         (fn (what)))))
 
-  (define (emit-c-or-sex sex-forms output args)
+(define (emit-c-or-sex sex-forms output args)
   (write-to-file-or-stdout output
                            (lambda ()
                              (if (get-arg args 'macro-expand #f)
                                  (map pp sex-forms)
                                  (emit-c sex-forms)))))
 
-  (define (compile-to-file sex-forms output args)
+(define (compile-to-file sex-forms output args)
   (let ((compiler (or (get-arg args 'c-compiler #f)
                       (get-env-var "SEX_CC")
                       "cc"))
@@ -113,13 +112,13 @@
         (close-output-port in-port)
         (process-wait pid)))))
 
-  (define (semantic-process-forms raw-forms input-source)
+(define (semantic-process-forms raw-forms input-source)
   (if (eq? input-source 'stdin)
       (semen-process raw-forms)
       (with-directory input-source
                       (semen-process raw-forms))))
 
-  (define prelude
+(define prelude
   '((include inttypes.h)
 
     (typedef u8 uint8-t)
@@ -131,7 +130,7 @@
     (typedef u64 uint64-t)
     (typedef i64 int64-t)))
 
-  (define (main)
+(define (main)
   (let* ((raw-args (command-line-arguments))
          (args (getopt-long raw-args
                             opts-grammar))
@@ -164,4 +163,4 @@
              ;; Emit processed and macro-expanded sex code, or emit C code
              (emit-c-or-sex sex-forms output args)
              ;; Compile file!
-               (compile-to-file sex-forms output args))))))))
+             (compile-to-file sex-forms output args)))))))

tests/Makefile

@@ -1 +1,40 @@
+CHICKEN_C = csc
+CSC_FLAGS += -K prefix
 
+MODULES = utils macros reader module-system semen sex-fmt-c fmt-c-writer sexc
+TESTS = basic semen reader fmt-c-writer utils
+IMPORTS = $(MODULES:%=%.import.scm)
+OBJ = $(MODULES:%=%.o)
+
+sex-tests: $(OBJ) sex-tests.o
+	$(CHICKEN_C) $(CSC_FLAGS) $(OBJ) sex-tests.o -o sex-tests
+
+sex-tests.o: run.scm basic.scm semen.scm reader.scm fmt-c-writer.scm utils.scm
+	$(CHICKEN_C) $(CSC_FLAGS) run.scm -c -o ./sex-tests.o -link semen,fmt-c-writer,reader,utils
+
+utils.o: utils.module.scm
+	$(CHICKEN_C) $(CSC_FLAGS) utils.module.scm -e -c -J -o utils.o -unit utils
+
+macros.o: macros.module.scm
+	$(CHICKEN_C) $(CSC_FLAGS) macros.module.scm -e -c -J -o macros.o -unit macros
+
+reader.o: reader.module.scm
+	$(CHICKEN_C) $(CSC_FLAGS) reader.module.scm -e -c -J -o reader.o -unit reader
+
+module-system.o: module-system.module.scm reader.import.scm utils.import.scm
+	$(CHICKEN_C) $(CSC_FLAGS) module-system.module.scm -e -c -J -o module-system.o -unit module-system -link reader,utils
+
+semen.o: semen.module.scm macros.import.scm module-system.import.scm utils.import.scm
+	$(CHICKEN_C) $(CSC_FLAGS) semen.module.scm -e -c -J -o semen.o -unit semen -link macros,module-system,utils
+
+fmt-c-writer.o: fmt-c-writer.module.scm fmt-c-writer.scm sex-fmt-c.import.scm utils.import.scm
+	$(CHICKEN_C) $(CSC_FLAGS) fmt-c-writer.module.scm -e -c -J -o fmt-c-writer.o -unit fmt-c-writer -link sex-fmt-c,utils
+
+sex-fmt-c.o: ../sex-fmt-c.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $< -e -c -J -o $@ -unit sex-fmt-c
+
+sexc.o: sexc.module.scm fmt-c-writer.import.scm macros.import.scm module-system.import.scm reader.import.scm semen.import.scm utils.import.scm
+	$(CHICKEN_C) $(CSC_FLAGS) sexc.module.scm -e -c -J -o sexc.o -unit sexc -link fmt-c-writer,macros,module-system,reader,semen,utils
+
+clean:
+	rm -f $(OBJ) $(IMPORTS) sex-tests.o sex-tests

tests/basic.scm

@@ -1,3 +1,5 @@
+(import fmt-c-writer)
+
 (test-group "basic"
 
   ;; unkebabify

tests/fmt-c-writer.module.scm

@@ -0,0 +1,3 @@
+(module fmt-c-writer
+    *
+  "../fmt-c-writer.scm")

tests/macros.module.scm

@@ -0,0 +1,3 @@
+(module macros
+    *
+  "../macros.scm")

tests/module-system.module.scm

@@ -0,0 +1,3 @@
+(module module-system
+    *
+  "../module-system.scm")

tests/reader.module.scm

@@ -0,0 +1,3 @@
+(module reader
+    *
+  "../reader.scm")

tests/reader.scm

@@ -1,4 +1,5 @@
-(import (chicken port))
+(import (chicken port)
+        reader)
 
 (define-syntax reader-test
   (syntax-rules ()

tests/run.scm

@@ -1,10 +1,4 @@
-(declare (uses fmt-c-writer
-               semen))
-
 (import
-  (chicken process)
-  (chicken process-context)
-  srfi-1
   test)
 
 (include "basic.scm")

tests/semen.module.scm

@@ -0,0 +1,2 @@
+(module semen *
+  "../semen.scm")

tests/semen.scm

@@ -1,4 +1,5 @@
-(import srfi-69)
+(import srfi-69
+        semen)
 
 (define print-str-fn
   '(fn void print-str ((string s))
@@ -38,11 +39,11 @@
   (define (form-identity form env)
     form)
 
-  (test 'a (semen-walk-form 'a form-identity (make-hash-table)))
-  (test '(a b c) (semen-walk-form '(a b c) form-identity (make-hash-table)))
+  (test 'a (walk-form 'a form-identity (make-hash-table)))
+  (test '(a b c) (walk-form '(a b c) form-identity (make-hash-table)))
 
-  (test 'a (semen-macro-expand 'a))
-  (test '(a b c) (semen-macro-expand '(a b c)))
+  (test 'a (macro-expand 'a))
+  (test '(a b c) (macro-expand '(a b c)))
 
   (let ((sex-code-macro
          '((defmacro (x10 a)

tests/sexc.module.scm

@@ -0,0 +1 @@
+(module sexc (main) "../sexc.scm")

tests/utils.module.scm

@@ -0,0 +1,3 @@
+(module utils
+    *
+  "../utils.scm")

tests/utils.scm

@@ -1,3 +1,5 @@
+(import utils)
+
 (test-group "utils"
 
   (test

utils.module.scm

@@ -0,0 +1,10 @@
+(module utils
+    (get-env-var
+     set-working-directory
+     to-absolute-pathname
+     list-split
+     list-join
+     recons
+     with-directory
+     )
+  "utils.scm")

utils.scm

@@ -1,28 +1,18 @@
-(module utils
-    (get-env-var
-     set-working-directory
-     to-absolute-pathname
-     list-split
-     list-join
-     recons
-     with-directory
-     )
-
-  (import
+(import
   scheme
   (chicken base)
   (chicken pathname)
   (chicken process-context)
   srfi-1)
 
-  (define-syntax prog1
+(define-syntax prog1
   (syntax-rules ()
     ((prog1 form . forms)
      (let ((res form))
        (begin . forms)
        res))))
 
-  (define-syntax with-directory
+(define-syntax with-directory
   (syntax-rules ()
     ((with-directory path form . forms)
      (let ((current-dir (current-directory)))
@@ -31,10 +21,10 @@
         (begin form . forms)
         (change-directory current-dir))))))
 
-  (define (get-env-var name)
+(define (get-env-var name)
   (get-environment-variable name))
 
-  (define (set-working-directory file)
+(define (set-working-directory file)
   (change-directory
    (normalize-pathname
     (if (absolute-pathname? file)
@@ -43,14 +33,14 @@
          (current-directory)
          (pathname-directory file))))))
 
-  (define (to-absolute-pathname pathname)
+(define (to-absolute-pathname pathname)
   (if (absolute-pathname? pathname)
       pathname
       (make-absolute-pathname
        (current-directory)
        pathname)))
 
-  (define (list-split src-list split-elt)
+(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)
@@ -60,7 +50,7 @@
         (list (list))
         src-list))
 
-  (define (list-join lists join-by)
+(define (list-join lists join-by)
   (drop-right
    (fold (lambda (elt acc)
            (append acc (list elt) (list join-by)))
@@ -69,9 +59,8 @@
    1))
 
 ;;; Reconstruct form
-  (define (recons old-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)))
-  )