add support for nested lambdas

add initial lambda support
No closures for now, but solid groundwork is laid.
2025-10-01 12:37:59 +03:00 · 2025-09-26 16:53:38 +03:00 · 2025-09-26 16:52:34 +03:00 · 2025-09-26 14:51:44 +03:00 · 2025-09-26 14:51:44 +03:00 · 2025-09-26 14:33:47 +03:00
52 changed files with 1273 additions and 2384 deletions
--- a/.github/workflows/build.yaml
+++ b/.github/workflows/build.yaml
@@ -1,55 +0,0 @@
-name: Sex CI
-
-on:
-  push:
-    branches: [ main ]
-  pull_request:
-    branches: [ main ]
-
-jobs:
-  build-linux:
-
-    runs-on: ubuntu-latest
-
-    steps:
-    - uses: actions/checkout@v3
-    - name: Install chicken
-      run: |
-        wget -N https://code.call-cc.org/releases/5.4.0/chicken-5.4.0.tar.gz
-        tar zxf chicken-5.4.0.tar.gz
-        sudo apt install -y make
-        make -C chicken-5.4.0 PLATFORM=linux
-        sudo make -C chicken-5.4.0 PLATFORM=linux install
-    - name: Install dependencies
-      # FIXME: [project-local deps]: use venv or something
-      # run: make deps
-      run: sudo chicken-install $(cat dependencies.txt)
-    - name: Make sure that sexc builds
-      # FIXME: sexc being built with local .eggs/ libs needs the path at runtime.
-      # Without it there will be `Error: cannot load extension: fmt`.
-      run: make sexc && ./sexc --help
-    - name: Run tests
-      # FIXME: [project-local deps]: use local deps or build with -static
-      # run: make run-tests
-      run: make sex-tests && ./sex-tests
-
-  build-macos:
-
-    runs-on: macos-15
-
-    steps:
-    - uses: actions/checkout@v3
-    - name: Install chicken
-      run: brew install chicken make
-    - name: Install dependencies
-      # FIXME: [project-local deps]: use venv or something
-      # run: make deps
-      run: chicken-install $(cat dependencies.txt)
-    - name: Make sure that sexc builds
-      # FIXME: sexc being built with local .eggs/ libs needs the path at runtime.
-      # Without it there will be `Error: cannot load extension: fmt`.
-      run: make sexc && ./sexc --help
-    - name: Run tests
-      # FIXME: [project-local deps]: use local deps or build with -static
-      # run: make run-tests
-      run: make sex-tests && ./sex-tests
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,3 @@
 *.o
-*.import.scm
-*.link
 sexc
 sex-tests
--- a/75
+++ b/75
@@ -1,72 +1,21 @@
 CHICKEN_C = csc
-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.
+CSC_FLAGS = -K prefix

-MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
-
-# Order matters, since module check correctness on compilation
-MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
+MODULES = sexc fmt-c fmt-c-writer semen sex-macros sex-modules sex-reader utils
 OBJ = $(MODULES:%=%.o)

-sexc: $(OBJ) main.scm
-	$(CHICKEN_C) $(CSC_FLAGS) main.scm -o sexc-tmp -link sexc
-        # otherwise csc hangs, probably because it tries to compile to sexc.o first
-	mv sexc-tmp sexc
+sexc: main.o $(OBJ)
+	$(CHICKEN_C) $(CSC_FLAGS) $^ -o $@

-#------------------------------------------------------------------
+main.o: main.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $< -c -o $@

-utils.o: utils.module.scm utils.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
+%.o: %.scm
+	$(CHICKEN_C) $(CSC_FLAGS) $< -e -c -o $@

-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: reader.module.scm reader.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader
-
-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.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
-
-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
-
-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
-
-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
-
-# Unit testing
-sex-tests:
-	$(MAKE) -C ./tests sex-tests
-	cp ./tests/sex-tests ./
-
-sextest:
-	$(MAKE) -C ./tools/sextest sextest
-	cp ./tools/sextest/sextest .
-
-SEX_TEST_PROGRAMS = hello-world lists
-
-run-tests: sexc sex-tests sextest
-	./sex-tests && ./sextest --sexc=./sexc $(SEX_TEST_PROGRAMS:%=./tests/sex-programs/%.sex)
+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

 clean:
-	rm -f $(OBJ) main.o
-	rm -f *.import.scm
-	rm -f *.link
-	rm -f sexc sex-tests sextest
-
-.PHONY: clean run-tests
+	rm -f $(OBJ) sexc sex-tests main.o ./tests/sex-tests.o
--- a/Readme.org
+++ b/Readme.org
@@ -1,9 +1,4 @@
 * The Sex language
-
-#+NAME: the Sex logo
-#+ATTR_HTML: :width 300px
-[[sex.png][file:./sex.png]]
-
 Sex is a S-expressions language. Sex is written in Chicken, which is a
 [[https://call-cc.org][R5RS Scheme]].
 Sex is statically typed, compiled general purpose language.
@@ -18,7 +13,7 @@ to export ~CHICKEN_INSTALL_REPOSITORY~ and ~CHICKEN_REPOSITORY_PATH~
 environment variables. Refer to the documentation for more info:
 https://wiki.call-cc.org/man/5/Extension%20tools#changing-the-repository-location

-~chicken-install `cat dependencies.txt`~
+~chicken-install fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable~

 ** Compilation
 ~make~
@@ -54,13 +49,13 @@ An example of Sex source:
 #+begin_src scheme
 (include stdio.h)

-(pub fn main ((argc int) (argv  [* const char])) int
+(pub fn int main ((int argc) (char **argv))
  (puts "Hello from Sex!")
-  (var name [char 512])
+  (var (array char 512) name)
  (puts "What is your name?")
-  (scanf "%s" (cast (& name) (* char)))
+  (scanf "%s" (cast char* &name))
  (printf "Hello, %s!\n" name)
-  (return 0))
+  0)
 #+end_src

 Compile and run:
@@ -106,16 +101,16 @@ return Sex code.
 (pub defmacro (list-T type)
  (let ((list-type (cat 'list- type)))
    `(struct ,list-type
-       ((value ,type)
-        (next (* ,list-type))))))
+       ((,type value)
+        ((* ,list-type) next)))))

 (list-T int)
 #+end_src
 ->
 #+begin_src scheme
 (struct list_int
- ((value int)
-  (next (* list_int))))
+ ((int value)
+  ((* list_int) next)))
 #+end_src

 **** Wrapper for checking return codes
@@ -124,19 +119,20 @@ return Sex code.
  `(if (< 0 ,call)
       (begin
         (puts ,message)
-         (return ,ret-code))))
+         (return ,ret-code)))))

-(pub fn init () int
+(pub fn int init ()
  (check-sdl-return
    (SDL-Init SDL-INIT-VIDEO) "Failed to initialize SDL" 1)
 ...)
 #+end_src
 ->
-#+begin_src scheme
-(pub fn init () int
+#+begin_src c
+(%fun int init ()
  (if (< 0 (SDL_Init SDL_INIT_VIDEO))
-    (begin (puts "Failed to initialize SDL") (return 1)))
+    (%begin (puts "Failed to initialize SDL") (return 1)))
  ...)
+}
 #+end_src

 ** Use an established environment for development
--- a/dependencies.txt
+++ b/dependencies.txt
@@ -1 +0,0 @@
-fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable
--- a/example/fns.sex
+++ b/example/fns.sex
@@ -1,10 +1,10 @@
 ;;; Prototypes
-(fn puk () void)
+(fn void puk ())

-(pub fn plak () void)
+(pub fn void plak ())

 ;;; Functions
-(fn foo () int (return 1))
+(fn int foo () (return 1))

-(pub fn bar ((a int) (b int)) void
+(pub fn void bar ((int a) (int b))
  (printf "%d\n" (+ a b)))
--- a/example/hello-world.sex
+++ b/example/hello-world.sex
@@ -1,9 +1,9 @@
 (include stdio.h)

-(pub fn main ((argc int) (argv  [* const char])) int
+(pub fn int main ((int argc) (char **argv))
  (puts "Hello from Sex!")
-  (var name [char 512])
+  (var (array char 512) name)
  (puts "What is your name?")
-  (scanf "%s" (cast (& name) (* char)))
+  (scanf "%s" (cast char* &name))
  (printf "Hello, %s!\n" name)
  (return 0))
--- a/example/lambdas.sex
+++ b/example/lambdas.sex
@@ -1,21 +1,21 @@
 (include stdio.h)

-(fn sum ((a int) (b int)) int
+(fn int sum ((int a) (int b))
  (return (+ a b)))

-(pub fn main () int
-  (var a int 10)
-  (var b int 20)
-  (var (fn ((int) (int)) int) sum-fn sum)
+(pub fn int main ()
+  (var int a 10)
+  (var int b 20)
+  (var (fn int ((int) (int))) sum-fn sum)

-  (var (fn ((int) (int)) int) sum-lambda
+  (var (fn int ((int) (int))) sum-lambda

-       (lambda ((a int) (b int)) int ()
+       (lambda int ((int a) (int b)) ()
         (return (+ a b))))

-  (var (fn ((int)) int) sum-lambda-2
+  (var (fn int ((int))) sum-lambda-2

-       (lambda ((a int)) int ()
+       (lambda int ((int a)) ()
         (return (+ a 20))))

  (printf "Hello from main fn!\n")
@@ -24,28 +24,15 @@
  (printf "Calling fn ptr: %d\n" (sum-fn a b))
  (printf "Calling lambda: %d\n" (sum-lambda a b))
  (printf "Calling other lambda: %d\n" (sum-lambda-2 a))
-  (printf "Calling lambda inplace: %d\n" ((lambda ((a int) (b int)) int ()
+  (printf "Calling lambda inplace: %d\n" ((lambda int ((int a) (int b)) ()
                                            (return (+ a b 100)))
                                          a b))

-  (var (fn ((int)) int) l-1
-       (lambda ((a int)) int ()
-         (var (fn ((int)) int) l-2
-              (lambda ((a int)) int ()
+  (var (fn int ((int))) l-1
+       (lambda int ((int a)) ()
+         (var (fn int ((int))) l-2
+              (lambda int ((int a)) ()
                (return (+ 60 a))))
         (return (+ 600 (l-2 a)))))
  (printf "Calling nested lambdas: %d\n" (l-1 6))
-
-  ;; Not supported yet
-  ;; Closure
-  ;;  (var (fn (fn ((int)) int) ((int))) make-adder
-  ;;       (lambda (fn int ((int a))) ()
-  ;;         (return (lambda int ((int b)) (a)
-  ;;                   (return (+ a b))))))
-  ;;
-  ;;  (var (fn int ((int))) add-10
-  ;;       (make-adder 10))
-  ;;  (var (fn int ((int))) add-20
-  ;;       (make-adder 20))
-  ;;  (printf "Calling closures: %d\n" (add-10 24))
  (return 0))
--- a/example/list.sex
+++ b/example/list.sex
@@ -1,21 +1,21 @@
 (pub defmacro (list-T type)
  (let ((list-type (cat 'list- type)))
    `(struct ,list-type
-       ((value ,type)
-        (next (* struct ,list-type))))))
+       ((,type value)
+        ((* (struct ,list-type)) next)))))

 (pub defmacro (make-list-T type is-public?)
  (let ((list-type (list 'struct (cat 'list- type)))
        (fn-name (cat 'make-list- type)))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name () (* ,list-type)
-      (var list (* ,list-type) (cast  (malloc (sizeof ,list-type)) (* ,list-type)))
+    `(,@(if is-public? '(pub) '()) fn (* ,list-type) ,fn-name ()
+      (var (* ,list-type) list (cast (* ,list-type) (malloc (sizeof ,list-type))))
      (= (-> list next) NULL)
      (return list))))

 (pub defmacro (add-value-list-T type is-public?)
  (let ((list-type (list 'struct (cat 'list- type)))
        (fn-name (cat 'add-value-list- type)))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name ((list * ,list-type) (value ,type)) void
+    `(,@(if is-public? '(pub) '()) fn void ,fn-name ((,list-type *list) (,type value))
      (while (!= (-> list next) NULL)
        (= list (-> list next)))
      (= (-> list next) (,(cat 'make-list- type)))
@@ -24,24 +24,23 @@
 (pub defmacro (length-list-T type is-public?)
  (let ((fn-name (cat 'length-list- type))
        (list-type (list 'struct (cat 'list- type))))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name ((list ,(cons '* list-type))) size-t
-      (var n size-t 0)
+    `(,@(if is-public? '(pub) '()) fn size-t ,fn-name ((,list-type *list))
+      (var size-t n 0)
      (while (!= (-> list next) NULL)
        (= list (-> list next))
        (++ n))
      (return n))))

 (pub defmacro (is-empty-list-T type is-public?)
-  `(,@(if is-public? '(pub) '()) fn ,(cat 'is-empty-list- type)
-    ((list ,(list '* 'struct (cat 'list- type))))
-    bool
+  `(,@(if is-public? '(pub) '()) fn bool ,(cat 'is-empty-list- type)
+    ((,(list 'struct (cat 'list- type)) *list))
    (return (== (-> list next) NULL))))

 (pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
  (let ((list-var-2 (cat list-var '-2)))
    `(begin
-      (var ,list-var-2 (* ,list-type) ,list-var)
-      (var ,elt-var ,elt-type (-> ,list-var-2 value))
+      (var (pointer ,list-type) ,list-var-2 ,list-var)
+      (var ,elt-type ,elt-var (-> ,list-var-2 value))
      (while (!= (-> ,list-var-2 next) NULL)
        ,what-do
        (= ,list-var-2 (-> ,list-var-2 next))
--- a/example/test-list.sex
+++ b/example/test-list.sex
@@ -5,12 +5,12 @@
 (import list)

 (struct foo
-  ((a-field float)
-   (b int)
-   (c (* const char))
-   (not (fn ((val bool)) bool))))
+  ((float a-field)
+   (int b)
+   ((const char *) c)
+   ((fn bool ((bool val))) not)))

-(var f (struct foo))
+(var (struct foo) f)

 (list-T int)
 (make-list-T int #f)
@@ -18,16 +18,15 @@
 (length-list-T int #f)
 (is-empty-list-T int #f)

-(extern fn puk ((a int) (b float)) void)
-(pub fn baz () bool
-  (return true))
+(extern fn void puk ((int a) (float b)))
+(pub fn bool baz () (return true))

-(extern var i int)
-(var j int)
-(pub var k int)
+(extern var int i)
+(var int j)
+(pub var int k)

-(pub fn main () int
-     (var l (* struct list-int) (make-list-int))
+(pub fn int main ()
+     (var (struct list-int) *l (make-list-int))
     (printf "Size of the list: %lu\n" (length-list-int l))
     (add-value-list-int l 3)
     (add-value-list-int l 4)
@@ -36,9 +35,9 @@
       (printf "%d " v))
     (printf "\n")
     (printf "Size of the list: %lu\n" (length-list-int l))
-     (printf "%p\n" (cast l->next (* void)))
+     (printf "%p\n" (cast void* l->next))
     (return 0))

-(pub fn print-list ((l (* const struct list-int))) void
+(pub fn void print-list (((const struct list-int) *l))
     (list-for-each (const struct list-int) l int v (printf "%d " v))
     (printf "\n"))
--- a/fmt-c-writer.module.scm
+++ b/fmt-c-writer.module.scm
@@ -1,3 +0,0 @@
-(module fmt-c-writer (emit-c
-                      sex-fmt-current-file)
-  "fmt-c-writer.scm")
--- a/fmt-c-writer.scm
+++ b/fmt-c-writer.scm
@@ -1,20 +1,16 @@
 ;;; Sex fmt-c output writer

-(import
-  scheme
-  (chicken base)
-  (chicken string)
-  (chicken syntax)
-  brev-separate
-  fmt
-  sex-fmt-c
-  matchable
-  regex
-  srfi-1                                ; lists
-  srfi-13                               ; strings
-  srfi-39                               ; parameters
-  tree
-  utils)
+(declare (unit fmt-c-writer)
+         (uses fmt-c
+               semen))
+
+(import (chicken string)
+        brev-separate
+        fmt
+        regex
+        srfi-1                          ; lists
+        srfi-13                         ; strings
+        )

 (define (unkebabify sym)
  (case sym
@@ -31,13 +27,15 @@
  (case atom
    ((fn) '%fun)
    ((prototype) '%prototype)
+    ((var) '%var)
    ((begin) '%block-begin)
    ((define) '%define)
    ((pointer) '%pointer)
    ((array) '%array)
    ((attribute) '%attribute)
-    ((¤) 'vector-ref)
+    ((@) 'vector-ref)
    ((include) '%include)
+    ((cast) '%cast)
    ;; uh things we do for c89 compatibility
    ((bool) 'int)
    ((true) 1)
@@ -47,12 +45,6 @@
         (unkebabify atom)
         atom))))

-(define (maybe-unwrap-type type)
-  (if (and (list? type)
-           (= 1 (length type)))
-      (car type)
-      type))
-
 (define (make-field-access form)
  (assert
   (= 2 (length form)) "Wrong field access format")
@@ -60,224 +52,77 @@
   (string->symbol
    (fmt #f (cadr form) (car 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 (walk-generic form acc)
+  (cond
+   ((null? form) (cons '() acc))

-(define (field-access-form? form)
-  (and (symbol? (car form))
-       (char=? #\. (string-ref (symbol->string (car form)) 0))))
-
-(define (walk-expr form)
-  (match form
-    ((? vector?)
+   ;; vector, e.g. {}-initializer
+   ((vector? form)
+    (cons
     (list->vector
-      (walk-expr (vector->list form))))
-    ((? atom?)
-     (atom-to-fmt-c form))
-    ((? field-access-form?)
-     (make-field-access form))
-    (('var . _) (walk-var form))
-    (('cast expr type) (list '%cast
-                             (walk-type type)
-                             (walk-expr expr)))
-    (('enum . _) (walk-enum form))
-    ;; | is problematic... And c-or/bit-or/etc are actually
-    ;; procedures, so we have to call the procedure itself
-    (('c-or . rest) (apply c-or (map walk-expr rest)))
-    (('c-bit-or . rest) (apply c-bit-or (map walk-expr rest)))
-    (('c-bit-or= . rest) (apply c-bit-or= (map walk-expr rest)))
-    (else (map walk-expr form))))
+      (car (walk-generic (vector->list form) (list))))
+     acc))

-(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)
-  ;; note: [...] is actually (¤ ...) after reading
-  ;; (var c (fn ((int) (float)) void)) -> (%var (%fun void ((int) (float))) c)
-  `(%var
-    ,(walk-type (third form))
-    ,(atom-to-fmt-c (second form))
-    .
-    ,(if (null? (drop form 3))
-         (list)
-         (walk-expr (drop form 3)))      ; optional init expression
-    ))
+   ;; atom (hopefully)
+   ((not (list? form)) (cons (atom-to-fmt-c form) acc))

-(define (walk-type form)
-  ;; int -> int
-  ;; (const int) -> const int
-  ;; [const char 512] ->(¤ (const char) 512) -> (%array (const char) 512)
-  ;; [float 8] -> (%array float 8)
-  ;; (* const char) -> (const char *)
-  ;; (const * const * const char) -> (const char * const * const)
-  ;; (fn ((int) (float)) void) -> (%fun void ((int) (float)))
-  (match form
-    (('¤ . array-type)
-     (if (integer? (last array-type))
-         ;; sized array
-         (let* ((type-list (drop-right array-type 1))
-                (type (maybe-unwrap-type type-list))
-                (size (last array-type)))
-           `(%array ,(walk-type type)
-                    ,size))
-         ;; sugar for pointer... Do we really need it? Guess why not,
-         ;; it's a strong semantic cue
-         `(%array ,(walk-type (maybe-unwrap-type array-type)))))
-    (('fn arglist ret-type)
-     `(%fun ,(walk-type ret-type) ,(walk-arglist arglist)))
-    (('fn . _)
-     (assert #f "Malformed function type form"))
+   ;; another special case - field access
+   ((and (symbol? (car form))
+         (char=? #\. (string-ref (symbol->string (car form)) 0)))
+    (cons (make-field-access form) acc))

-    ;; Special case: nested structs/unions
-    ((or ('struct . _)
-         ('union . _)) (walk-struct form))
+   ;; toplevel, or a start of a regular list form
+   (else
+    (let ((new-acc (list)))
+      (cons (fold-right
+             walk-generic
+             new-acc
+             form)
+            acc)))))

-    (('enum . _) (walk-enum form))
-    (else
-     (type-convert-to-c form))))
-
-(define (type-convert-to-c type)
-  ;; Our pointers to C pointers
-  ;; int -> int
-  ;; * const char -> const char *
-  ;; const * const char -> const char * const
-  (if (atom? type) (atom-to-fmt-c type)
-      (flatten
-       (tree-map atom-to-fmt-c
-                 (flatten
-                  (list-join (reverse (list-split type '*))
-                             '(*)))))))
-
-(define (walk-fn-def form)
-  (match form
-    (('fn name args ret-type . maybe-body)
-     `(%fun
-       ,(walk-type ret-type)
-       ,(atom-to-fmt-c name)
-       ,(walk-arglist args)
-       .
-       ,(walk-expr maybe-body)))))
-
-;;; TODO: isn't there a better way?
-(define (is-probably-type form)
-  (case (car form)
-    ((¤ * const volatile struct union) #t)
-    (else #f)))
-
-(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)))
-  (map (fn
-        (match x
-          (('¤ . _) (walk-type x))
-
-          ;; yeah shitty, but I don't know yet how to determine if the
-          ;; first entry is part of the type and not an argument name
-          ;; :(
-          ((? is-probably-type) (walk-type x))
-
-          ;; 1 element args are always type
-          ((_) (walk-type x))
-
-          ((var . type) (append (list (walk-type (maybe-unwrap-type type)))
-                                (list (walk-type var))))))
-       form))
-
-(define (walk-function form)
+(define (normalize-fn-form 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)))))
+      form
+      (cons 'prototype (cdr form))))

-(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)
-  (match form
-    ((type (fields ...) . attrs)        ; anonymous struct
-     `(,type ,(process-struct-fields fields)
-             . ,(tree-map atom-to-fmt-c attrs)))
-    ((type name)                        ; simple 'struct whatever', like in variable def
-     `(,type ,(atom-to-fmt-c name)))
-    ((type name (fields ...) . attrs)
-     `(,type ,(atom-to-fmt-c name)
-             ,(process-struct-fields fields)
-             . ,(tree-map atom-to-fmt-c attrs)))
-    (else (error "Malformed aggregate definition " 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-function form static)
+  (if static
+      (walk-generic (list 'static (normalize-fn-form form))
+                    (list))
+      (walk-generic (normalize-fn-form (cdr form))
+                    (list))))

 (define (walk-extern form)
-  (match form
-    (('fn . _)
-     ;; extern function?.. What
-     (list 'extern (walk-function form)))
-    (('var . _)
-     (list 'extern (walk-var form)))
+  (case (cadr form)
+    ((fn)
+     (list (cons 'extern (walk-function form #f))))
+    ((var)
+     (list (cons 'extern (walk-generic (cdr form) (list)))))
    (else (error "Extern what?"))))

 (define (walk-public form)
-  (match form
-    (('fn . _)
-     (walk-function form))
-    (('var . _)
-     (walk-var form))
-    ((or ('define . _)
-         ('defmacro . _)
-
-         ('import . _)
-         ('include . _)
-
-         ('struct . _)
-         ('union . _)
-
-         ('typedef . _))
+  (case (cadr form)
+    ((fn)
+     (walk-function form #f))
+    ((var)
+     (walk-generic (list 'static (cdr form)) (list)))
+    ((define defmacro import include struct typedef union var)
     ;; ignore here, used in generating public interface
-     (process-toplevel-form form))
+     (process-toplevel-form (cdr form)))
    (else
     (error "Pub what?" (cadr form)))))

 (define (process-toplevel-form form)
-  (match form
-    (('fn . _) (list 'static (walk-function form)))
-    (('var . _) (list 'static (walk-var form)))
-    (('extern . rest) (walk-extern rest))
-    (('pub . rest) (walk-public rest))
-    ((or ('struct . _)
-         ('union . _)) (walk-struct form))
-    (('enum . _) (walk-enum form))
-    (('define name . rest) `(%define ,(atom-to-fmt-c name) ,@rest))
-    (else (walk-expr 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 (line-directive-string)
-  (fmt #f #\# "line " (sex-fmt-line-num) " " #\" (sex-fmt-current-file) #\"))
+  ;; todo: rewrite to match
+  (case (car form)
+    ((fn) (walk-function form #t))
+    ((extern) (walk-extern form))
+    ((pub) (walk-public form))
+    (else (walk-generic form (list)))))

 (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))
+              (fmt #t (c-expr (car (process-toplevel-form form))) nl))
            sex-forms))
--- a/fmt-c.scm
+++ b/fmt-c.scm
@@ -0,0 +1,919 @@
+;;;; fmt-c.scm -- fmt module for emitting/pretty-printing C code
+;;
+;; Copyright (c) 2007 Alex Shinn.  All rights reserved.
+;; BSD-style license: http://synthcode.com/license.txt
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; additional state information
+
+(declare (unit fmt-c))
+
+(import fmt
+        srfi-13)
+
+(define (fmt-in-macro? st) (fmt-ref st 'in-macro?))
+(define (fmt-macro-params st) (fmt-ref st 'macro-params))
+(define (fmt-expression? st) (fmt-ref st 'expression?))
+(define (fmt-return? st) (fmt-ref st 'return?))
+(define (fmt-newline-before-brace? st) (fmt-ref st 'newline-before-brace?))
+(define (fmt-braceless-bodies? st) (fmt-ref st 'braceless-bodies?))
+(define (fmt-non-spaced-ops? st) (fmt-ref st 'non-spaced-ops?))
+(define (fmt-no-wrap? st) (fmt-ref st 'no-wrap?))
+(define (fmt-indent-space st) (fmt-ref st 'indent-space))
+(define (fmt-switch-indent-space st) (fmt-ref st 'switch-indent-space))
+(define (fmt-op st) (fmt-ref st 'op 'stmt))
+(define (fmt-gen st) (fmt-ref st 'gen))
+
+(define (c-in-expr proc) (fmt-let 'expression? #t proc))
+(define (c-in-stmt proc) (fmt-let 'expression? #f proc))
+(define (c-reset-newline proc) (fmt-let 'newline-before-brace? #f proc))
+
+(define (c-in-test proc) (fmt-let 'in-cond? #t (c-in-expr proc)))
+(define (c-with-op op proc) (fmt-let 'op op proc))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; be smart about operator precedence
+
+(define (c-op-precedence x)
+  (if (string? x)
+      (cond
+        ((or (string=? x ".") (string=? x "->")) 10)
+        ((or (string=? x "++") (string=? x "--")) 20)
+        ((string=? x "&") 55)
+        ((string=? x "|") 65)
+        ((string=? x "&&") 70)
+        ((string=? x "||") 75)
+        ((string=? x "|=") 85)
+        ((or (string=? x "+=") (string=? x "-=")) 85)
+        (else 95))
+      (case x
+        ;;((|::|) 5) ; C++
+        ((dot arrow post-decrement post-increment) 10)
+        ((**) 15)                       ; Perl
+        ((unary+ unary- ! ~ cast unary-* unary-& sizeof) 20) ; ++ --
+        ((=~ !~) 25)                    ; Perl
+        ((* / %) 30)
+        ((+ -) 35)
+        ((<< >>) 40)
+        ((< > <= >=) 45)
+        ((lt gt le ge) 45)              ; Perl
+        ((== !=) 50)
+        ((eq ne cmp) 50)                ; Perl
+        ((&) 55)
+        ((^) 60)
+        ;;((|\||) 65)
+        ((&& %and) 70)
+        ((%or) 75)
+        ;;((|\|\||) 75)
+        ;;((.. ...) 77)                   ; Perl
+        ((?) 80)
+        ((= *= /= %= &= ^= <<= >>=) 85) ; |\|=| ;  += -=
+        ((comma) 90)
+        ((=>) 90)                       ; Perl
+        ((not) 92)                      ; Perl
+        ((and) 93)                      ; Perl
+        ((or xor) 94)                   ; Perl
+        ((paren bracket) 100)
+        (else 95))))
+
+(define (c-op< x y) (< (c-op-precedence x) (c-op-precedence y)))
+(define (c-op<= x y) (<= (c-op-precedence x) (c-op-precedence y)))
+
+(define (c-paren x) (cat "(" (c-expr x) ")"))
+
+(define (c-maybe-paren op x)
+  (lambda (st)
+    ((fmt-let 'op op
+              (if (c-op<= (fmt-op st) op)
+                  (c-paren x)
+                  x))
+     st)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; default literals writer
+
+(define (c-control-operator? x)
+  (memq x '(if while switch repeat do for fun begin)))
+
+(define (c-literal? x)
+  (or (number? x) (string? x) (char? x) (boolean? x)))
+
+(define (char->c-char c)
+  (string-append "'" (c-escape-char c #\') "'"))
+
+(define (c-escape-char c quote-char)
+  (let ((n (char->integer c)))
+    (if (<= 32 n 126)
+        (if (or (eqv? c quote-char) (eqv? c #\\))
+            (string #\\ c)
+            (string c))
+        (case n
+          ((7) "\\a") ((8) "\\b") ((9) "\\t") ((10) "\\n")
+          ((11) "\\v") ((12) "\\f") ((13) "\\r")
+          (else (string-append "\\x" (number->string (char->integer c) 16)))))))
+
+(define (c-format-number x)
+  (if (and (integer? x) (exact? x))
+      (lambda (st)
+        ((case (fmt-radix st)
+           ((16) (cat "0x" (string-upcase (number->string x 16))))
+           ((8) (cat "0" (number->string x 8)))
+           (else (dsp (number->string x))))
+         st))
+      (dsp (number->string x))))
+
+(define (c-format-string x)
+  (lambda (st) ((cat #\" (apply-cat (c-string-escaped x)) #\") st)))
+
+(define (c-string-escaped x)
+  (let loop ((parts '()) (idx (string-length x)))
+    (cond ((string-index-right x c-needs-string-escape? 0 idx)
+           => (lambda (special-idx)
+                (loop (cons (c-escape-char (string-ref x special-idx) #\")
+                            (cons (substring/shared x (+ special-idx 1) idx)
+                                  parts))
+                      special-idx)))
+          (else
+           (cons (substring/shared x 0 idx) parts)))))
+
+(define (c-needs-string-escape? c)
+  (if (<= 32 (char->integer c) 127) (memv c '(#\" #\\)) #t))
+
+(define (c-simple-literal x)
+  (c-wrap-stmt
+   (cond ((char? x) (dsp (char->c-char x)))
+         ((boolean? x) (dsp (if x "1" "0")))
+         ((number? x) (c-format-number x))
+         ((string? x) (c-format-string x))
+         ((null? x) (dsp "NULL"))
+         ((eof-object? x) (dsp "EOF"))
+         (else (dsp (write-to-string x))))))
+
+(define (c-literal x)
+  (lambda (st)
+    ((if (and (symbol? x) (memq x (or (fmt-macro-params st) '())))
+         (c-paren (c-simple-literal x))
+         (c-simple-literal x))
+     st)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; default expression generator
+
+(define (c-expr/sexp x)
+  (if (procedure? x)
+      x
+      (lambda (st)
+        (cond
+         ((pair? x)
+          (case (car x)
+            ((if) ((apply c-if (cdr x)) st))
+            ((for) ((apply c-for (cdr x)) st))
+            ((while) ((apply c-while (cdr x)) st))
+            ((switch) ((apply c-switch (cdr x)) st))
+            ((case) ((apply c-case (cdr x)) st))
+            ((case/fallthrough) ((apply c-case/fallthrough (cdr x)) st))
+            ((default) ((apply c-default (cdr x)) st))
+            ((break) (c-break st))
+            ((continue) (c-continue st))
+            ((return) ((apply c-return (cdr x)) st))
+            ((goto) ((apply c-goto (cdr x)) st))
+            ((typedef) ((apply c-typedef (cdr x)) st))
+            ((struct union class) ((apply c-struct/aux x) st))
+            ((enum) ((apply c-enum (cdr x)) st))
+            ((inline auto restrict register volatile extern static)
+             ((cat (car x) " " (apply c-begin (cdr x))) st))
+            ;; non C-keywords must have some character invalid in a C
+            ;; identifier to avoid conflicts - by default we prefix %
+            ((vector-ref)
+             ((c-wrap-stmt
+               (cat (c-expr (cadr x)) "[" (c-expr (caddr x)) "]"))
+              st))
+            ((vector-set!)
+             ((c= (c-in-expr
+                   (cat (c-expr (cadr x)) "[" (c-expr (caddr x)) "]"))
+                  (c-expr (cadddr x)))
+              st))
+            ((extern/C) ((apply c-extern/C (cdr x)) st))
+            ((%apply) ((apply c-apply (cdr x)) st))
+            ((%define) ((apply cpp-define (cdr x)) st))
+            ((%include) ((apply cpp-include (cdr x)) st))
+            ((%fun) ((apply c-fun (cdr x)) st))
+            ((%cond)
+             (let lp ((ls (cdr x)) (res '()))
+               (if (null? ls)
+                   ((apply c-if (reverse res)) st)
+                   (lp (cdr ls)
+                       (cons (if (pair? (cddar ls))
+                                 (apply c-begin (cdar ls))
+                                 (cadar ls))
+                             (cons (caar ls) res))))))
+            ((%prototype) ((apply c-prototype (cdr x)) st))
+            ((%var) ((apply c-var (cdr x)) st))
+            ((%begin) ((apply c-begin (cdr x)) st))
+            ((%attribute) ((apply c-attribute (cdr x)) st))
+            ((%line) ((apply cpp-line (cdr x)) st))
+            ((%pragma %error %warning)
+             ((apply cpp-generic (substring/shared (symbol->string (car x)) 1)
+                     (cdr x)) st))
+            ((%if %ifdef %ifndef %elif)
+             ((apply cpp-if/aux (substring/shared (symbol->string (car x)) 1)
+                     (cdr x)) st))
+            ((%endif) ((apply cpp-endif (cdr x)) st))
+            ((%block-begin) ((apply c-braced-block #f (cdr x)) st))
+            ((%block) ((apply c-braced-block (cdr x)) st))
+            ((%comment) ((apply c-comment (cdr x)) st))
+            ((:) ((apply c-label (cdr x)) st))
+            ((%cast) ((apply c-cast (cdr x)) st))
+            ((+ - & * / % ! ~ ^ && < > <= >= == != << >>
+                = *= /= %= &= ^= >>= <<=) ; |\|| |\|\|| |\|=|
+             ((apply c-op x) st))
+            ((bitwise-and bit-and) ((apply c-op '& (cdr x)) st))
+            ((bitwise-ior bit-or) ((apply c-op "|" (cdr x)) st))
+            ((bitwise-xor bit-xor) ((apply c-op '^ (cdr x)) st))
+            ((bitwise-not bit-not) ((apply c-op '~ (cdr x)) st))
+            ((arithmetic-shift) ((apply c-op '<< (cdr x)) st))
+            ((bitwise-ior= bit-or=) ((apply c-op "|=" (cdr x)) st))
+            ((%and) ((apply c-op "&&" (cdr x)) st))
+            ((%or) ((apply c-op "||" (cdr x)) st))
+            ((%. %field) ((apply c-op "." (cdr x)) st))
+            ((%->) ((apply c-op "->" (cdr x)) st))
+            (else
+             (cond
+              ((eq? (car x) (string->symbol "."))
+               ((apply c-op "." (cdr x)) st))
+              ((eq? (car x) (string->symbol "->"))
+               ((apply c-op "->" (cdr x)) st))
+              ((eq? (car x) (string->symbol "++"))
+               ((apply c-op "++" (cdr x)) st))
+              ((eq? (car x) (string->symbol "--"))
+               ((apply c-op "--" (cdr x)) st))
+              ((eq? (car x) (string->symbol "+="))
+               ((apply c-op "+=" (cdr x)) st))
+              ((eq? (car x) (string->symbol "-="))
+               ((apply c-op "-=" (cdr x)) st))
+              (else ((c-apply x) st))))))
+         ((vector? x)
+          ((c-wrap-stmt
+            (fmt-try-fit
+             (fmt-let 'no-wrap? #t
+                      (cat "{" (fmt-join c-expr (vector->list x) ", ") "}"))
+             (lambda (st)
+               (let* ((col (fmt-col st))
+                      (sep (string-append "," (make-nl-space col))))
+                 ((cat "{" (fmt-join c-expr (vector->list x) sep)
+                       "}" nl)
+                  st)))))
+           st))
+         (else
+          ((c-literal x) st))))))
+
+(define (c-apply ls)
+  (c-wrap-stmt
+   (c-with-op
+    'paren
+    (cat (c-expr (car ls))
+         (let ((flat (fmt-let 'no-wrap? #t (fmt-join c-expr (cdr ls) ", "))))
+           (fmt-if
+            fmt-no-wrap?
+            (c-paren flat)
+            (c-paren
+             (fmt-try-fit
+              flat
+              (lambda (st)
+                (let* ((col (fmt-col st))
+                       (sep (string-append "," (make-nl-space col))))
+                  ((fmt-join c-expr (cdr ls) sep) st)))))))))))
+
+(define (c-expr x)
+  (lambda (st) (((or (fmt-gen st) c-expr/sexp) x) st)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; comments, with Emacs-friendly escaping of nested comments
+
+(define (make-comment-writer st)
+  (let ((output (fmt-ref st 'writer)))
+    (lambda (str st)
+      (let ((lim (- (string-length str) 1)))
+        (let lp ((i 0) (st st))
+          (let ((j (string-index str #\/ i)))
+            (if j
+                (let ((st (if (and (> j 0)
+                                   (eqv? #\* (string-ref str (- j 1))))
+                              (output
+                               "\\/"
+                               (output (substring/shared str i j) st))
+                              (output (substring/shared str i (+ j 1)) st))))
+                  (lp (+ j 1)
+                      (if (and (< j lim) (eqv? #\* (string-ref str (+ j 1))))
+                          (output "\\" st)
+                          st)))
+                (output (substring/shared str i) st))))))))
+
+(define (c-comment . args)
+  (lambda (st)
+    ((cat "/*" (fmt-let 'writer (make-comment-writer st)
+                        (apply-cat args))
+          "*/")
+     st)))
+
+(define (make-block-comment-writer st)
+  (let ((output (make-comment-writer st))
+        (indent (string-append (make-nl-space (+ (fmt-col st) 1)) "* ")))
+    (lambda (str st)
+      (let ((lim (string-length str)))
+        (let lp ((i 0) (st st))
+          (let ((j (string-index str #\newline i)))
+            (if j
+                (lp (+ j 1)
+                    (output indent (output (substring/shared str i j) st)))
+                (output (substring/shared str i) st))))))))
+
+(define (c-block-comment . args)
+  (lambda (st)
+    (let ((col (fmt-col st))
+          (row (fmt-row st))
+          (indent (c-current-indent-string st)))
+      ((cat "/* "
+            (fmt-let 'writer (make-block-comment-writer st) (apply-cat args))
+            (lambda (st)
+              (cond
+                ((= row (fmt-row st)) ((dsp " */") st))
+                ;;((= (+ 3 col) (fmt-col st)) ((dsp "*/") st))
+                (else ((cat fl indent " */") st)))))
+       st))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; preprocessor
+
+(define (make-cpp-writer st)
+  (let ((output (fmt-ref st 'writer)))
+    (lambda (str st)
+      (let lp ((i 0) (st st))
+        (let ((j (string-index str #\newline i)))
+          (if j
+              (lp (+ j 1)
+                  (output
+                   nl-str
+                   (output " \\" (output (substring/shared str i j) st))))
+              (output (substring/shared str i) st)))))))
+
+(define (cpp-include file)
+  (if (string? file)
+      (cat fl "#include " (wrt file) fl)
+      (cat fl "#include <" file ">" fl)))
+
+(define (list-dot x)
+  (cond ((pair? x) (list-dot (cdr x)))
+        ((null? x) #f)
+        (else x)))
+
+(define (flatten-list ls)
+  (let lp ((ls ls) (res '()))
+    (cond ((pair? ls) (lp (cdr ls) (cons (car ls) res)))
+          ((null? ls) (reverse res))
+          (else (reverse (cons ls res))))))
+
+(define (replace-tree from to x)
+  (let replace ((x x))
+    (cond ((eq? x from) to)
+          ((pair? x) (cons (replace (car x)) (replace (cdr x))))
+          (else x))))
+
+(define (cpp-define x . body)
+  (define (name-of x) (c-expr (if (pair? x) (cadr x) x)))
+  (lambda (st)
+    (let* ((body (cond
+                   ((and (pair? x) (list-dot x))
+                    => (lambda (dot)
+                         (if (eq? dot '...)
+                             body
+                             (replace-tree dot '__VA_ARGS__ body))))
+                   (else body)))
+           (params (map (lambda (x) (if (pair? x) (cadr x) x))
+                        (flatten-list (if (pair? x) (cdr x) '()))))
+           (tail
+            (if (pair? body)
+                (cat " "
+                     (fmt-let 'writer (make-cpp-writer st)
+                              (fmt-let 'macro-params params
+                                       ((if (or (not (pair? x))
+                                                (and (null? (cdr body))
+                                                     (c-literal? (car body))))
+                                            (lambda (x) x)
+                                            c-paren)
+                                        (c-in-expr (apply c-begin body))))))
+                (lambda (x) x))))
+      ((c-in-expr
+        (if (pair? x)
+            (cat fl "#define " (name-of (car x))
+                 (c-paren
+                  (fmt-join/dot name-of
+                                (lambda (dot) (dsp "..."))
+                                (cdr x)
+                                ", "))
+                 tail fl)
+            (cat fl "#define " (c-expr x) tail fl)))
+       st))))
+
+(define (cpp-expr x)
+  (if (or (symbol? x) (string? x)) (dsp x) (c-expr x)))
+
+(define (cpp-if/aux name check . o)
+  (let* ((pass (and (pair? o) (car o)))
+         (comment (if (member name '("ifdef" "ifndef"))
+                      (cat "  "
+                           (c-comment
+                            " " (if (equal? name "ifndef") "! " "")
+                            check " "))
+                      ""))
+         (endif (if pass (cat fl "#endif" comment) ""))
+         (tail (cond
+                ((and (pair? o) (pair? (cdr o)))
+                 (if (pair? (cddr o))
+                     (apply cpp-elif (cdr o))
+                     (cat (cpp-else) (cadr o) endif)))
+                (else endif))))
+    (lambda (st)
+      (let ((indent (c-current-indent-string st)))
+        ((cat fl "#" name " " (cpp-expr check) fl
+              (if pass (cat indent pass) "") fl
+              tail fl)
+         st)))))
+
+(define (cpp-if check . o)
+  (apply cpp-if/aux "if" check o))
+(define (cpp-ifdef check . o)
+  (apply cpp-if/aux "ifdef" check o))
+(define (cpp-ifndef check . o)
+  (apply cpp-if/aux "ifndef" check o))
+(define (cpp-elif check . o)
+  (apply cpp-if/aux "elif" check o))
+(define (cpp-else . o)
+  (cat fl "#else " (if (pair? o) (c-comment (car o)) "") fl))
+(define (cpp-endif . o)
+  (cat fl "#endif " (if (pair? o) (c-comment (car o)) "") fl))
+
+(define (cpp-wrap-header name . body)
+  (let ((name name)) ; consider auto-mangling
+    (cpp-ifndef name (c-begin (cpp-define name) nl (apply c-begin body) nl))))
+
+(define (cpp-line num . o)
+  (cat fl "#line " num (if (pair? o) (cat " " (car o)) "") fl))
+
+(define (cpp-generic name . ls)
+  (cat fl "#" name (apply-cat ls) fl))
+
+(define (cpp-undef . args) (apply cpp-generic "undef" args))
+(define (cpp-pragma . args) (apply cpp-generic "pragma" args))
+(define (cpp-error . args) (apply cpp-generic "error" args))
+(define (cpp-warning . args) (apply cpp-generic "warning" args))
+
+(define (cpp-stringify x)
+  (cat "#" x))
+
+(define (cpp-sym-cat . args)
+  (fmt-join dsp args " ## "))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; general indentation and brace rules
+
+(define (c-current-indent-string st . o)
+  (make-space (max 0 (+ (fmt-col st) (if (pair? o) (car o) 0)))))
+
+(define (c-indent st . o)
+  (dsp (make-space (max 0 (+ (fmt-col st) (or (fmt-indent-space st) 4)
+                             (if (pair? o) (car o) 0))))))
+
+(define (c-indent/switch st)
+  (dsp (make-space (+ (fmt-col st) (or (fmt-switch-indent-space st) 4)))))
+
+(define (c-open-brace st)
+  (if (fmt-newline-before-brace? st)
+      (begin
+        (fmt-set! st 'newline-before-brace? #t)
+        (cat "{" nl))
+      (begin
+        (fmt-set! st 'newline-before-brace? #t)
+        (cat " {" nl))))
+
+(define (c-close-brace st)
+  (dsp "}"))
+
+(define (c-wrap-stmt x)
+  (fmt-if fmt-expression?
+          (c-expr x)
+          (cat (c-in-expr (c-expr x)) ";" nl)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; code blocks
+
+(define (c-block . args)
+  (apply c-block/aux 0 args))
+
+(define (c-block/aux offset header body0 . body)
+   (let ((inner (apply c-begin body0 body)))
+     (if (or (pair? body)
+             (not (or (c-literal? body0)
+                      (and (pair? body0)
+                           (not (c-control-operator? (car body0)))))))
+         (c-braced-block/aux offset header inner)
+         (lambda (st)
+           (if (fmt-braceless-bodies? st)
+               ((cat header fl (c-indent st offset) inner fl) st)
+               ((c-braced-block/aux offset header inner) st))))))
+
+(define (c-braced-block . args)
+  (apply c-braced-block/aux 0 args))
+
+(define (c-braced-block/aux offset header . body)
+   (lambda (st)
+     ((cat (if header header "") (c-open-brace st) (c-indent st offset)
+           (apply c-begin body) fl
+           (c-current-indent-string st offset) (c-close-brace st))
+      st)))
+
+(define (c-begin . args)
+  (apply c-begin/aux #f args))
+
+(define (c-begin/aux ret? body0 . body)
+   (if (null? body)
+       (c-expr body0)
+       (lambda (st)
+         (if (fmt-expression? st)
+             ((fmt-try-fit
+               (fmt-let 'no-wrap? #t (fmt-join c-expr (cons body0 body) ", "))
+               (lambda (st)
+                 (let ((indent (c-current-indent-string st)))
+                   ((fmt-join c-expr (cons body0 body) (cat "," nl indent)) st))))
+              st)
+             (let ((orig-ret? (fmt-return? st)))
+               ((fmt-join/last c-expr
+                               (lambda (x) (fmt-let 'return? orig-ret? (c-expr x)))
+                               (cons body0 body)
+                               (cat fl (c-current-indent-string st)))
+                (fmt-set! st 'return? (and ret? orig-ret?))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; data structures
+
+(define (c-struct/aux type x . o)
+  (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
+         (body (if name (if (not (null? o)) (car o) '()) x))
+         (o (if (null? o) o (cdr o))))
+    (if (not (null? body))
+        (c-wrap-stmt
+         (cat
+          (c-braced-block
+           (cat type (if (and name (not (equal? name ""))) (cat " " name) ""))
+           (cat
+            (c-in-stmt
+             (if (list? body)
+                 (apply c-begin (map c-wrap-stmt (map c-field body)))
+                 (c-wrap-stmt (c-expr body))))))
+          (if (pair? o) (cat " " (apply c-begin o)) (dsp ""))))
+        (c-wrap-stmt
+         (cat type (if (and name (not (equal? name ""))) (cat " " name) ""))))))
+
+(define (c-struct . args) (apply c-struct/aux "struct" args))
+(define (c-union . args) (apply c-struct/aux "union" args))
+(define (c-class . args) (apply c-struct/aux "class" args))
+
+(define (c-enum x . o)
+  (define (c-enum-one x)
+    (if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
+  (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
+         (vals (if name (car o) x)))
+    (c-wrap-stmt
+     (cat
+      (c-braced-block
+       (if name (cat "enum " name) (dsp "enum"))
+       (c-in-expr (apply c-begin (map c-enum-one vals))))))))
+
+(define (c-attribute . args)
+  (cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; basic control structures
+
+(define (c-while check . body)
+  (c-reset-newline
+   (cat (c-block (cat "while (" (c-in-test (c-expr check)) ")")
+                 (c-in-stmt (apply c-begin body)))
+        fl)))
+
+(define (c-for init check update . body)
+  (c-reset-newline
+   (cat
+    (c-block
+     (c-in-expr
+      (cat "for (" (c-expr init) "; " (c-in-test (c-expr check)) "; "
+           (c-expr update ) ")"))
+     (c-in-stmt (apply c-begin body)))
+    fl)))
+
+(define (c-param x)
+  (cond
+    ((procedure? x) x)
+    ((pair? x) (c-type (car x) (cadr x)))
+    (else (error "missing type" x))))
+
+(define (c-field x)
+  (cond
+    ((procedure? x) x)
+    ((pair? x)
+     (if (list? (car x))
+         (case (caar x)
+           ((union struct class)
+            (if (> (length x) 1)
+                (c-type (car x)
+                        (cadr x))
+                (c-type (car x))))
+           (else (c-type (car x) (cadr x))))
+         (c-type (car x)
+                 (fmt-join c-expr (cdr x) ", "))))
+    (else (error "missing type" x))))
+
+(define (c-param-list ls)
+  (if (null? ls)
+      (c-type 'void)
+      (c-in-expr (fmt-join/dot c-param (lambda (dot) (dsp "...")) ls ", "))))
+
+(define (c-fun type name params . body)
+  (cat (c-block (c-in-expr (c-prototype type name params))
+                (c-in-stmt (apply c-begin body)))
+       fl))
+
+(define (c-prototype type name params . o)
+  (c-wrap-stmt
+   (cat (c-type type) " " (c-expr name) " (" (c-param-list params) ")"
+        (fmt-join/prefix c-expr o " "))))
+
+(define (c-static x) (cat "static " (c-expr x)))
+(define (c-const x) (cat "const " (c-expr x)))
+(define (c-restrict x) (cat "restrict " (c-expr x)))
+(define (c-volatile x) (cat "volatile " (c-expr x)))
+(define (c-auto x) (cat "auto " (c-expr x)))
+(define (c-inline x) (cat "inline " (c-expr x)))
+(define (c-extern x) (cat "extern " (c-expr x)))
+(define (c-extern/C . body)
+  (cat "extern \"C\" {" nl (apply c-begin body) nl "}" nl))
+
+(define (c-type type . o)
+  (let ((name (and (pair? o) (car o))))
+    (cond
+     ((pair? type)
+      (case (car type)
+        ((%fun)
+         (cat (c-type (cadr type) #f)
+              " (*" (or name "") ")("
+              (fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
+        ((%array)
+         (let ((name (cat name "[" (if (pair? (cddr type))
+                                       (c-expr (caddr type))
+                                       "")
+                          "]")))
+           (c-type (cadr type) name)))
+        ((%pointer *)
+         (let ((name (cat "*" (if name (c-expr name) ""))))
+           (c-type (cadr type)
+                   (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
+                       (c-paren name)
+                       name))))
+        ((enum) (apply c-enum name (cdr type)))
+        ((struct union class)
+         (cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
+        (else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))
+     ((not type)
+      (lambda (st) ((c-type (or (fmt-default-type st) 'int) name) st)))
+     (else
+      (cat (if (eq? '%pointer type) '* type) (if name (cat " " name) ""))))))
+
+(define (c-var type name . init)
+  (c-wrap-stmt
+   (if (pair? init)
+       (cat (c-type type name) " = " (c-expr (car init)))
+       (c-type type (if (pair? name)
+                        (fmt-join c-expr name ", ")
+                        (c-expr name))))))
+
+(define (c-cast type expr)
+  (cat "(" (c-type type) ")" (c-expr expr)))
+
+(define (c-typedef type alias . o)
+  (c-wrap-stmt
+   (cat "typedef " (c-type type alias) (fmt-join/prefix c-expr o " "))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Generalized IF: allows multiple tail forms for if/else if/.../else
+;; blocks.  A final ELSE can be signified with a test of #t or 'else,
+;; or by simply using an odd number of expressions (by which the
+;; normal 2 or 3 clause IF forms are special cases).
+
+(define (c-if/stmt c p . rest)
+  (lambda (st)
+    (let ((indent (c-current-indent-string st)))
+      ((let lp ((c c) (p p) (ls rest))
+         (if (or (eq? c 'else) (eq? c #t))
+             (if (not (null? ls))
+                 (error "forms after else clause in IF" c p ls)
+                 (cat (c-block/aux -1 " else" p) fl))
+             (let ((tail (if (pair? ls)
+                             (if (pair? (cdr ls))
+                                 (lp (car ls) (cadr ls) (cddr ls))
+                                 (lp 'else (car ls) '()))
+                             fl)))
+               (cat (c-block/aux
+                     (if (eq? ls rest) 0 -1)
+                     (cat (if (eq? ls rest) (lambda (x) x) " else ")
+                          "if (" (c-in-test (c-expr c)) ")") p)
+                    tail))))
+       st))))
+
+(define (c-if/expr c p . rest)
+  (let lp ((c c) (p p) (ls rest))
+    (cond
+      ((or (eq? c 'else) (eq? c #t))
+       (if (not (null? ls))
+           (error "forms after else clause in IF" c p ls)
+           (c-expr p)))
+      ((pair? ls)
+       (cat (c-in-test (c-expr c)) " ? " (c-expr p) " : "
+            (if (pair? (cdr ls))
+                (lp (car ls) (cadr ls) (cddr ls))
+                (lp 'else (car ls) '()))))
+      (else
+       (c-or (c-in-test (c-expr c)) (c-expr p))))))
+
+(define (c-if . args)
+  (fmt-if fmt-expression?
+          (apply c-if/expr args)
+          (apply c-if/stmt args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; switch statements, automatic break handling
+
+(define (c-label name)
+  (lambda (st)
+    (let ((indent (make-space (max 0 (- (fmt-col st) 2)))))
+      ((cat fl indent name ":" fl) st))))
+
+(define c-break
+  (c-wrap-stmt (dsp "break")))
+(define c-continue
+  (c-wrap-stmt (dsp "continue")))
+(define (c-return . result)
+  (if (pair? result)
+      (c-wrap-stmt (cat "return " (c-expr (car result))))
+      (c-wrap-stmt (dsp "return"))))
+(define (c-goto label)
+  (c-wrap-stmt (cat "goto " (c-expr label))))
+
+(define (c-switch val . clauses)
+  (c-reset-newline
+   (lambda (st)
+     ((cat "switch (" (c-in-expr val) ")" (c-open-brace st)
+           (c-indent/switch st)
+           (c-in-stmt (apply c-begin/aux #t (map c-switch-clause clauses))) fl
+           (c-current-indent-string st) (c-close-brace st) fl)
+      st))))
+
+(define (c-switch-clause/breaks x)
+  (lambda (st)
+    (let* ((break?
+            (and (car x)
+                 (not (member (cadr x) '(case/fallthrough
+                                         default/fallthrough
+                                         else/fallthrough)))))
+           (explicit-case? (member (cadr x) '(case case/fallthrough)))
+           (indent (c-current-indent-string st))
+           (indent-body (c-indent st))
+           (sep (string-append ":" nl-str indent)))
+      ((cat (c-in-expr
+             (fmt-join/suffix
+              dsp
+              (cond
+               ((pair? (cadr x))
+                (map (lambda (y) (cat (dsp "case ") (c-expr y)))
+                     (cadr x)))
+               (explicit-case?
+                (map (lambda (y) (cat (dsp "case ") (c-expr y)))
+                     (if (list? (caddr x))
+                         (caddr x)
+                         (list (caddr x)))))
+               ((member (cadr x)
+                        '(default else default/fallthrough else/fallthrough))
+                (list (dsp "default")))
+               (else
+                (error
+                 "unknown switch clause, expected a list or default but got"
+                 (cadr x))))
+              sep))
+            (make-space (or (fmt-indent-space st) 4))
+            (fmt-join c-expr
+                      (if explicit-case? (cdddr x) (cddr x))
+                      indent-body)
+            (if (and break? (not (fmt-return? st)))
+                (cat fl indent-body c-break)
+                ""))
+       st))))
+
+(define (c-switch-clause x)
+  (if (procedure? x) x (c-switch-clause/breaks (cons #t x))))
+(define (c-switch-clause/no-break x)
+  (if (procedure? x) x (c-switch-clause/breaks (cons #f x))))
+
+(define (c-case x . body)
+  (c-switch-clause (cons (if (pair? x) x (list x)) body)))
+(define (c-case/fallthrough x . body)
+  (c-switch-clause/no-break (cons (if (pair? x) x (list x)) body)))
+(define (c-default . body)
+  (c-switch-clause/breaks (cons #t (cons 'else body))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; operators
+
+(define (c-op op first . rest)
+  (if (null? rest)
+      (c-unary-op op first)
+      (apply c-binary-op op first rest)))
+
+(define (c-binary-op op . ls)
+  (define (lit-op? x) (or (c-literal? x) (symbol? x)))
+  (let ((str (display-to-string op)))
+    (c-wrap-stmt
+     (c-maybe-paren
+      op
+      (if (or (equal? str ".") (equal? str "->"))
+          (fmt-join c-expr ls str)
+          (let ((flat
+                 (fmt-let 'no-wrap? #t
+                          (lambda (st)
+                            ((fmt-join c-expr
+                                       ls
+                                       (if (and (fmt-non-spaced-ops? st)
+                                                (every lit-op? ls))
+                                           str
+                                           (string-append " " str " ")))
+                             st)))))
+            (fmt-if
+             fmt-no-wrap?
+             flat
+             (fmt-try-fit
+              flat
+              (lambda (st)
+                   ((fmt-join c-expr
+                              ls
+                              (cat nl (make-space (+ 2 (fmt-col st))) str " "))
+                    st))))))))))
+
+(define (c-unary-op op x)
+  (c-wrap-stmt
+   (cat (display-to-string op) (c-maybe-paren op (c-expr x)))))
+
+;; some convenience definitions
+
+(define (c++ . args) (apply c-op "++" args))
+(define (c-- . args) (apply c-op "--" args))
+(define (c+ . args) (apply c-op '+ args))
+(define (c- . args) (apply c-op '- args))
+(define (c* . args) (apply c-op '* args))
+(define (c/ . args) (apply c-op '/ args))
+(define (c% . args) (apply c-op '% args))
+(define (c& . args) (apply c-op '& args))
+;; (define (|c\|| . args) (apply c-op '|\|| args))
+(define (c^ . args) (apply c-op '^ args))
+(define (c~ . args) (apply c-op '~ args))
+(define (c! . args) (apply c-op '! args))
+(define (c&& . args) (apply c-op '&& args))
+;; (define (|c\|\|| . args) (apply c-op '|\|\|| args))
+(define (c<< . args) (apply c-op '<< args))
+(define (c>> . args) (apply c-op '>> args))
+(define (c== . args) (apply c-op '== args))
+(define (c!= . args) (apply c-op '!= args))
+(define (c< . args) (apply c-op '< args))
+(define (c> . args) (apply c-op '> args))
+(define (c<= . args) (apply c-op '<= args))
+(define (c>= . args) (apply c-op '>= args))
+(define (c= . args) (apply c-op '= args))
+(define (c+= . args) (apply c-op "+=" args))
+(define (c-= . args) (apply c-op "-=" args))
+(define (c*= . args) (apply c-op '*= args))
+(define (c/= . args) (apply c-op '/= args))
+(define (c%= . args) (apply c-op '%= args))
+(define (c&= . args) (apply c-op '&= args))
+;; (define (|c\|=| . args) (apply c-op '|\|=| args))
+(define (c^= . args) (apply c-op '^= args))
+(define (c<<= . args) (apply c-op '<<= args))
+(define (c>>= . args) (apply c-op '>>= args))
+
+(define (c. . args) (apply c-op "." args))
+(define (c-> . args) (apply c-op "->" args))
+
+(define (c-bit-or . args) (apply c-op "|" args))
+(define (c-or . args) (apply c-op "||" args))
+(define (c-bit-or= . args) (apply c-op "|=" args))
+
+(define (c++/post x)
+  (cat (c-maybe-paren 'post-increment (c-expr x)) "++"))
+(define (c--/post x)
+  (cat (c-maybe-paren 'post-decrement (c-expr x)) "--"))
--- a/main.scm
+++ b/main.scm
@@ -1,5 +1,6 @@
 ;;; The purpose of this file is to compile it to the only
 ;;; .o that has main entry point.

-(import sexc)
+(declare (uses sexc))
+
 (main)
--- a/reader.module.scm
+++ b/reader.module.scm
@@ -1,3 +0,0 @@
-(module reader (read-from-file
-                read-raw-forms)
-  "reader.scm")
--- a/reader.scm
+++ b/reader.scm
@@ -1,49 +0,0 @@
-(import
-  scheme
-  (chicken base)
-  (chicken io)
-  (chicken pathname)
-  (chicken port)
-  (chicken read-syntax)
-  (chicken string)
-  (chicken syntax)
-  brev-separate
-  fmt)
-
-(import-syntax utils)
-
-(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)
-  (with-directory file
-    (with-input-from-file (pathname-strip-directory file)
-      (fn (read-forms (list))))))
-
-(define open-bracket-counter (make-parameter 0))
-
-(define (read-raw-forms input-source)
-  (let ((bracket-end (gensym)))
-    (set-read-syntax!
-     #\]
-     (lambda (port)
-       (when (= 0 (open-bracket-counter))
-         (error "Unmatched closing bracket"))
-       (open-bracket-counter (- (open-bracket-counter) 1))
-       bracket-end))
-
-    (set-read-syntax!
-     #\[
-     (lambda (port)
-       (open-bracket-counter (+ (open-bracket-counter) 1))
-       (let loop ((r (read port))
-                  (acc (list)))
-         (if (eq? r bracket-end)
-             (cons '¤ (reverse acc))
-             (loop (read port)
-                   (cons r acc)))))))
-  (if (eq? input-source 'stdin)
-      (read-forms (list))
-      (read-from-file input-source)))
--- a/semen.module.scm
+++ b/semen.module.scm
@@ -1,2 +0,0 @@
-(module semen ()
-  "semen.scm")
--- a/semen.scm
+++ b/semen.scm
@@ -1,21 +1,16 @@
 ;;; Sex semantic engine

-(import
-  scheme
-  (chicken base)
-  (chicken keyword)
-  (chicken string)
-  (chicken module)
-  fmt
-  sex-macros
-  sex-modules
-  matchable                         ; pattern matching
-  srfi-1                            ; list routines
-  srfi-69                           ; hash tables
-  utils
-  )
+(declare (unit semen)
+         (uses sex-macros
+               sex-modules))

-(export/rename (process semen-process))
+(import
+  (chicken string)
+  fmt
+  matchable                             ; pattern matching
+  srfi-1                                ; list routines
+  srfi-69                               ; hash tables
+  )

 ;;; for lambda extraction, docstring processing, macro expansion,
 ;;; injection of module headers, i.e. all things that rearrange code
@@ -25,28 +20,28 @@
 ;;; 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)
-  (process-rec raw-sex-forms (list)))
+(define (semen-process raw-sex-forms)
+  (semen-process-rec raw-sex-forms (list)))

-(define (process-rec forms acc)
+(define (semen-process-rec forms acc)
  (cond
   ((null? forms) (reverse acc))
-   ((macro? (car forms))
-    (process-rec
-     (macroexpand (car forms) (cdr forms))
+   ((sex-macro? (car forms))
+    (semen-process-rec
+     (semen-apply-macro (car forms) (cdr forms))
     acc))
   (else
-    (process-rec (cdr forms)
-                 (match-sex-form (car forms) acc)))))
+    (semen-process-rec (cdr forms)
+                       (match-sex-form (car forms) acc)))))

-(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
-  ;; structures/functions/typedefs.
-  ;;
-  ;; Single form we just cons to the top of rest-forms, but multiple
-  ;; forms have to be appended to the rest-forms.
+(define (semen-apply-macro 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
+;; structures/functions/typedefs.
+;;
+;; Single form we just cons to the top of rest-forms, but multiple
+;; forms have to be appended to the rest-forms.
  (let ((res (apply-macro macro-form)))
    (if (list? (car res))
        (append res rest-forms)
@@ -58,93 +53,73 @@
         ('pub 'fn . _)
         ('extern 'fn . _)) (process-fn sex-form acc))
    ((or ('struct . _)
-         ('pub 'struct . _)) (process-struct sex-form acc))
+         ('pub struct . _)) (process-struct sex-form acc))
    ((or ('union . _)
         ('pub 'union . _)) (process-struct sex-form acc))
-    ((or ('enum . _)
-         ('pub 'enum . _)) (process-struct sex-form acc))
    ((or ('var . _)
         ('pub 'var . _)
         ('extern 'var . _)) (process-global-var sex-form acc))
    (('include _) (cons sex-form acc))
-    (('define . _) (cons sex-form acc))

    (('import . modules)
-     (process-imports (get-modules-public-forms modules) acc))
+     (semen-process-imports (get-public-forms modules) acc))

    ((or ('defmacro . rest)
         ('pub 'defmacro . rest)) (defmacro rest) acc)

-    ((or ('typedef new-type target)
-         ('pub 'typedef new-type target))
-     (process-typedef new-type target acc))
-
    (else (assert #f (fmt #f "Unknown top level form " sex-form)))))

-(define (process-imports module-public-forms acc)
+(define (semen-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
      (match (car module-public-forms)
        (('defmacro . rest)
         (defmacro rest)
-         (process-imports (cdr module-public-forms) acc))
+         (semen-process-imports (cdr module-public-forms) acc))
        (else
-         (process-imports (cdr module-public-forms)
-                          (cons (car module-public-forms)
-                                acc))))))
+         (semen-process-imports (cdr module-public-forms)
+                                (cons (car module-public-forms)
+                                      acc))))))

-(define (macro-expand form)
-  "Walk the form recursively and expand all macros, until none is left."
-  (walk-form
+(define (semen-macro-expand form)
+  "Walk the form recursively and expand all macros, unitl none is left."
+  (semen-walk-form
   form
   (lambda (subform env)
-     (if (macro? subform)
-         (cons walk-embed-result (macroexpand subform (list)))
+     (if (sex-macro? subform)
+         (apply-macro subform)
         subform))
   #f))

-;;; walk-form and friends: form walker with various abilities.
-;;; By default, replaces walked form with walk-fn result But may
-;;; perform additional operations depending of what the walk function
-;;; has requested.
-
-;;; For inspiration, see SBCL's walk.lisp and their template
-;;; system.
-
-(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)
+;;; TODO: for greater inspiration, see SBCL's walk.lisp and their
+;;; template system. Maybe it is worth it to implement something
+;;; similar here
+(define (semen-walk-form form walk-fn env)
  (if (atom? form) form
      (let ((new-form (walk-fn form env)))
        (cond ((not (eq? form new-form))
-               (walk-form new-form walk-fn env))
-              (else
-               (let ((new-car (walk-form (car new-form) walk-fn env))
-                     (new-cdr (walk-form (cdr new-form) walk-fn env)))
-                 (cond ((and (pair? new-car)
-                             (eq? (car new-car) walk-embed-result))
-                        (append (cdr new-car) new-cdr))
-                       (else
-                        (recons new-form new-car new-cdr)))))))))
+               (semen-walk-form new-form walk-fn env))
+              (else (recons
+                     new-form
+                     (semen-walk-form (car new-form) walk-fn env)
+                     (semen-walk-form (cdr new-form) walk-fn env)))))))

-;;; Typdef
-
-(define (process-typedef new-type target acc)
-  (cons `(typedef ,target ,new-type) acc))
+(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)))

 ;;; Fn processing

 (define (process-fn sex-fn acc)
-  (let* ((expanded (macro-expand sex-fn))
+  (let* ((expanded (semen-macro-expand sex-fn))
         (env (make-hash-table))
         (processed
-          (walk-form
+          (semen-walk-form
           expanded
-           fn-walker
+           semen-fn-walker
           (begin
             (set! (hash-table-ref env :fn-name) (sex-fn-name expanded))
             (set! (hash-table-ref env :lambda-counter) 0)
@@ -154,23 +129,23 @@
    (cons processed
          (append (hash-table-ref env :lambda-aux-code) acc))))

-(define (fn-walker form env)
+(define (semen-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))))
+      (let ((lambda-name (semen-make-lambda-name (hash-table-ref env :fn-name)
+                                                 (hash-table-ref env :lambda-counter))))
        (set! (hash-table-ref env :lambda-aux-code)
-          (append (make-aux-lambda-struct lambda-name form)
+          (append (semen-make-aux-lambda-struct lambda-name form)
                  (hash-table-ref env :lambda-aux-code)))
        (set! (hash-table-ref env :lambda-counter)
          (+ (hash-table-ref env :lambda-counter) 1))
        lambda-name)
-      form))
+    form))

-(define (make-lambda-name enclosing-fn-name counter)
+(define (semen-make-lambda-name enclosing-fn-name counter)
  (string->symbol
   (fmt #f "__lambda_" counter "_" enclosing-fn-name)))

-(define (make-aux-lambda-struct name form)
+(define (semen-make-aux-lambda-struct name form)
  (match form
    (('lambda ret-type arglist captures . body)
     ;; Captures are ignored for now, but
@@ -178,7 +153,7 @@
     (process-fn `(fn ,ret-type ,name ,arglist ,@body) (list)))
    (else (assert #f (fmt #f "Malformed lambda " form)))))

-;;; Structs
+;;; Struct

 (define (process-struct sex-struct acc)
  (cons sex-struct acc))
--- a/sex-fmt-c.scm
+++ b/sex-fmt-c.scm
@@ -1,985 +0,0 @@
-;;;; fmt-c.scm -- fmt module for emitting/pretty-printing C code
-;;
-;; Copyright (c) 2007 Alex Shinn.  All rights reserved.
-;; BSD-style license: http://synthcode.com/license.txt
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; additional state information
-
-(module sex-fmt-c
-    (
-     fmt-in-macro? fmt-expression? fmt-return?
-     fmt-newline-before-brace? fmt-braceless-bodies?
-     fmt-indent-space fmt-switch-indent-space fmt-op fmt-gen
-     c-in-expr c-in-stmt c-in-test
-     c-paren c-maybe-paren c-type c-literal? c-literal char->c-char
-     c-struct c-union c-class c-enum c-typedef c-cast
-     c-expr c-expr/sexp c-apply c-op c-indent c-current-indent-string
-     c-wrap-stmt c-open-brace c-close-brace
-     c-block c-braced-block c-begin
-     c-fun c-var c-prototype c-param c-param-list
-     c-while c-for c-if c-switch
-     c-case c-case/fallthrough c-default
-     c-break c-continue c-return c-goto c-label
-     c-static c-const c-extern c-volatile c-auto c-restrict c-inline
-     c++ c-- c+ c- c* c/ c% c& c^ c~ c! c&& c<< c>> c== c!= ;  |c\||  |c\|\||
-     c< c> c<= c>= c= c+= c-= c*= c/= c%= c&= c^= c<<= c>>= ;++c --c ;  |c\|=|
-     c++/post c--/post c. c->
-     c-bit-or c-or c-bit-or=
-     cpp-if cpp-ifdef cpp-ifndef cpp-elif cpp-endif cpp-else cpp-undef
-     cpp-include cpp-define cpp-wrap-header cpp-pragma cpp-line
-     cpp-error cpp-warning cpp-stringify cpp-sym-cat
-     c-comment c-block-comment c-attribute)
-
-  (import
-    scheme
-    (chicken base)
-    fmt
-    srfi-1
-    srfi-13)
-
-  (define (fmt-in-macro? st) (fmt-ref st 'in-macro?))
-  (define (fmt-macro-params st) (fmt-ref st 'macro-params))
-  (define (fmt-expression? st) (fmt-ref st 'expression?))
-  (define (fmt-return? st) (fmt-ref st 'return?))
-  (define (fmt-newline-before-brace? st) (fmt-ref st 'newline-before-brace?))
-  (define (fmt-braceless-bodies? st) (fmt-ref st 'braceless-bodies?))
-  (define (fmt-non-spaced-ops? st) (fmt-ref st 'non-spaced-ops?))
-  (define (fmt-no-wrap? st) (fmt-ref st 'no-wrap?))
-  (define (fmt-indent-space st) (fmt-ref st 'indent-space))
-  (define (fmt-switch-indent-space st) (fmt-ref st 'switch-indent-space))
-  (define (fmt-op st) (fmt-ref st 'op 'stmt))
-  (define (fmt-gen st) (fmt-ref st 'gen))
-
-  (define (c-in-expr proc) (fmt-let 'expression? #t proc))
-  (define (c-in-stmt proc) (fmt-let 'expression? #f proc))
-  (define (c-reset-newline proc) (fmt-let 'newline-before-brace? #f proc))
-
-  (define (c-in-test proc) (fmt-let 'in-cond? #t (c-in-expr proc)))
-  (define (c-with-op op proc) (fmt-let 'op op proc))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; be smart about operator precedence
-
-  (define (c-op-precedence x)
-    (if (string? x)
-        (cond
-         ((or (string=? x ".") (string=? x "->")) 10)
-         ((or (string=? x "++") (string=? x "--")) 20)
-         ((string=? x "&") 55)
-         ((string=? x "|") 65)
-         ((string=? x "&&") 70)
-         ((string=? x "||") 75)
-         ((string=? x "|=") 85)
-         ((or (string=? x "+=") (string=? x "-=")) 85)
-         (else 95))
-        (case x
-          ;;((|::|) 5) ; C++
-          ((dot arrow post-decrement post-increment) 10)
-          ((**) 15)                                            ; Perl
-          ((unary+ unary- ! ~ cast unary-* unary-& sizeof) 20) ; ++ --
-          ((=~ !~) 25)                                         ; Perl
-          ((* / %) 30)
-          ((+ -) 35)
-          ((<< >>) 40)
-          ((< > <= >=) 45)
-          ((lt gt le ge) 45)            ; Perl
-          ((== !=) 50)
-          ((eq ne cmp) 50)              ; Perl
-          ((&) 55)
-          ((^) 60)
-          ;;((|\||) 65)
-          ((&& %and) 70)
-          ((%or) 75)
-          ;;((|\|\||) 75)
-          ;;((.. ...) 77)                   ; Perl
-          ((?) 80)
-          ((= *= /= %= &= ^= <<= >>=) 85) ; |\|=| ;  += -=
-          ((comma) 90)
-          ((=>) 90)                     ; Perl
-          ((not) 92)                    ; Perl
-          ((and) 93)                    ; Perl
-          ((or xor) 94)                 ; Perl
-          ((paren bracket) 100)
-          (else 95))))
-
-  (define (c-op< x y) (< (c-op-precedence x) (c-op-precedence y)))
-  (define (c-op<= x y) (<= (c-op-precedence x) (c-op-precedence y)))
-
-  (define (c-paren x) (cat "(" (c-expr x) ")"))
-
-  (define (c-maybe-paren op x)
-    (lambda (st)
-      ((fmt-let 'op op
-                (if (and (c-op<= (fmt-op st) op)
-                         (not (vector? x)))
-                    (c-paren x)
-                    x))
-       st)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; default literals writer
-
-  (define (c-control-operator? x)
-    (memq x '(if while switch repeat do for fun begin)))
-
-  (define (c-literal? x)
-    (or (number? x) (string? x) (char? x) (boolean? x)))
-
-  (define (char->c-char c)
-    (string-append "'" (c-escape-char c #\') "'"))
-
-  (define (c-escape-char c quote-char)
-    (let ((n (char->integer c)))
-      (if (<= 32 n 126)
-          (if (or (eqv? c quote-char) (eqv? c #\\))
-              (string #\\ c)
-              (string c))
-          (case n
-            ((7) "\\a") ((8) "\\b") ((9) "\\t") ((10) "\\n")
-            ((11) "\\v") ((12) "\\f") ((13) "\\r")
-            (else (string-append "\\x" (number->string (char->integer c) 16)))))))
-
-  (define (c-format-number x)
-    (if (and (integer? x) (exact? x))
-        (lambda (st)
-          ((case (fmt-radix st)
-             ((16) (cat "0x" (string-upcase (number->string x 16))))
-             ((8) (cat "0" (number->string x 8)))
-             (else (dsp (number->string x))))
-           st))
-        (dsp (number->string x))))
-
-  (define (c-format-string x)
-    (lambda (st) ((cat #\" (apply-cat (c-string-escaped x)) #\") st)))
-
-  (define (c-string-escaped x)
-    (let loop ((parts '()) (idx (string-length x)))
-      (cond ((string-index-right x c-needs-string-escape? 0 idx)
-             => (lambda (special-idx)
-                  (loop (cons (c-escape-char (string-ref x special-idx) #\")
-                              (cons (substring/shared x (+ special-idx 1) idx)
-                                    parts))
-                        special-idx)))
-            (else
-             (cons (substring/shared x 0 idx) parts)))))
-
-  (define (c-needs-string-escape? c)
-    (if (<= 32 (char->integer c) 127) (memv c '(#\" #\\)) #t))
-
-  (define (c-simple-literal x)
-    (c-wrap-stmt
-     (cond ((char? x) (dsp (char->c-char x)))
-           ((boolean? x) (dsp (if x "1" "0")))
-           ((number? x) (c-format-number x))
-           ((string? x) (c-format-string x))
-           ((null? x) (dsp "NULL"))
-           ((eof-object? x) (dsp "EOF"))
-           (else (dsp (write-to-string x))))))
-
-  (define (c-literal x)
-    (lambda (st)
-      ((if (and (symbol? x) (memq x (or (fmt-macro-params st) '())))
-           (c-paren (c-simple-literal x))
-           (c-simple-literal x))
-       st)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; default expression generator
-
-  (define (c-expr/sexp x)
-    (if (procedure? x)
-        x
-        (lambda (st)
-          (cond
-           ((pair? x)
-            (case (car x)
-              ((if) ((apply c-if (cdr x)) st))
-              ((for) ((apply c-for (cdr x)) st))
-              ((while) ((apply c-while (cdr x)) st))
-              ((switch) ((apply c-switch (cdr x)) st))
-              ((case) ((apply c-case (cdr x)) st))
-              ((case/fallthrough) ((apply c-case/fallthrough (cdr x)) st))
-              ((default) ((apply c-default (cdr x)) st))
-              ((break) (c-break st))
-              ((continue) (c-continue st))
-              ((return) ((apply c-return (cdr x)) st))
-              ((goto) ((apply c-goto (cdr x)) st))
-              ((typedef) ((apply c-typedef (cdr x)) st))
-              ((struct union class) ((apply c-struct/aux x) st))
-              ((enum) ((apply c-enum (cdr x)) st))
-              ((inline auto restrict register volatile extern static)
-               ((cat (car x) " " (apply c-begin (cdr x))) st))
-              ;; non C-keywords must have some character invalid in a C
-              ;; identifier to avoid conflicts - by default we prefix %
-              ((vector-ref)
-               ((c-wrap-stmt
-                 (cat (c-expr (cadr x)) "[" (c-expr (caddr x)) "]"))
-                st))
-              ((vector-set!)
-               ((c= (c-in-expr
-                     (cat (c-expr (cadr x)) "[" (c-expr (caddr x)) "]"))
-                    (c-expr (cadddr x)))
-                st))
-              ((extern/C) ((apply c-extern/C (cdr x)) st))
-              ((%apply) ((apply c-apply (cdr x)) st))
-              ((%define) ((apply cpp-define (cdr x)) st))
-              ((%include) ((apply cpp-include (cdr x)) st))
-              ((%fun) ((apply c-fun (cdr x)) st))
-              ((%cond)
-               (let lp ((ls (cdr x)) (res '()))
-                 (if (null? ls)
-                     ((apply c-if (reverse res)) st)
-                     (lp (cdr ls)
-                         (cons (if (pair? (cddar ls))
-                                   (apply c-begin (cdar ls))
-                                   (cadar ls))
-                               (cons (caar ls) res))))))
-              ((%prototype) ((apply c-prototype (cdr x)) st))
-              ((%var) ((apply c-var (cdr x)) st))
-              ((%begin) ((apply c-begin (cdr x)) st))
-              ((%attribute) ((apply c-attribute (cdr x)) st))
-              ((%line) ((apply cpp-line (cdr x)) st))
-              ((%pragma %error %warning)
-               ((apply cpp-generic (substring/shared (symbol->string (car x)) 1)
-                       (cdr x)) st))
-              ((%if %ifdef %ifndef %elif)
-               ((apply cpp-if/aux (substring/shared (symbol->string (car x)) 1)
-                       (cdr x)) st))
-              ((%endif) ((apply cpp-endif (cdr x)) st))
-              ((%block-begin) ((apply c-braced-block #f (cdr x)) st))
-              ((%block) ((apply c-braced-block (cdr x)) st))
-              ((%comment) ((apply c-comment (cdr x)) st))
-              ((:) ((apply c-label (cdr x)) st))
-              ((%cast) ((apply c-cast (cdr x)) st))
-              ((+ - & * / % ! ~ ^ && < > <= >= == != << >>
-                  = *= /= %= &= ^= >>= <<=) ; |\|| |\|\|| |\|=|
-               ((apply c-op x) st))
-              ((bitwise-and bit-and) ((apply c-op '& (cdr x)) st))
-              ((bitwise-ior bit-or) ((apply c-op "|" (cdr x)) st))
-              ((bitwise-xor bit-xor) ((apply c-op '^ (cdr x)) st))
-              ((bitwise-not bit-not) ((apply c-op '~ (cdr x)) st))
-              ((arithmetic-shift) ((apply c-op '<< (cdr x)) st))
-              ((bitwise-ior= bit-or=) ((apply c-op "|=" (cdr x)) st))
-              ((%and) ((apply c-op "&&" (cdr x)) st))
-              ((%or) ((apply c-op "||" (cdr x)) st))
-              ((%. %field) ((apply c-op "." (cdr x)) st))
-              ((%->) ((apply c-op "->" (cdr x)) st))
-              (else
-               (cond
-                ((eq? (car x) (string->symbol "."))
-                 ((apply c-op "." (cdr x)) st))
-                ((eq? (car x) (string->symbol "->"))
-                 ((apply c-op "->" (cdr x)) st))
-                ((eq? (car x) (string->symbol "++"))
-                 ((apply c-op "++" (cdr x)) st))
-                ((eq? (car x) (string->symbol "--"))
-                 ((apply c-op "--" (cdr x)) st))
-                ((eq? (car x) (string->symbol "+="))
-                 ((apply c-op "+=" (cdr x)) st))
-                ((eq? (car x) (string->symbol "-="))
-                 ((apply c-op "-=" (cdr x)) st))
-                (else ((c-apply x) st))))))
-           ((vector? x)
-            ((c-wrap-stmt
-              (fmt-try-fit
-               (fmt-let 'no-wrap? #t
-                        (cat "{" (fmt-join c-expr (vector->list x) ", ") "}"))
-               (lambda (st)
-                 (let* ((col (fmt-col st))
-                        (sep (string-append "," (make-nl-space col))))
-                   ((cat "{" (fmt-join c-expr (vector->list x) sep)
-                         "}" nl)
-                    st)))))
-             st))
-           (else
-            ((c-literal x) st))))))
-
-  (define (c-apply ls)
-    (c-wrap-stmt
-     (c-with-op
-      'paren
-      (cat (c-expr (car ls))
-           (let ((flat (fmt-let 'no-wrap? #t (fmt-join c-expr (cdr ls) ", "))))
-             (fmt-if
-              fmt-no-wrap?
-              (c-paren flat)
-              (c-paren
-               (fmt-try-fit
-                flat
-                (lambda (st)
-                  (let* ((col (fmt-col st))
-                         (sep (string-append "," (make-nl-space col))))
-                    ((fmt-join c-expr (cdr ls) sep) st)))))))))))
-
-  (define (c-expr x)
-    (lambda (st) (((or (fmt-gen st) c-expr/sexp) x) st)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; comments, with Emacs-friendly escaping of nested comments
-
-  (define (make-comment-writer st)
-    (let ((output (fmt-ref st 'writer)))
-      (lambda (str st)
-        (let ((lim (- (string-length str) 1)))
-          (let lp ((i 0) (st st))
-            (let ((j (string-index str #\/ i)))
-              (if j
-                  (let ((st (if (and (> j 0)
-                                     (eqv? #\* (string-ref str (- j 1))))
-                                (output
-                                 "\\/"
-                                 (output (substring/shared str i j) st))
-                                (output (substring/shared str i (+ j 1)) st))))
-                    (lp (+ j 1)
-                        (if (and (< j lim) (eqv? #\* (string-ref str (+ j 1))))
-                            (output "\\" st)
-                            st)))
-                  (output (substring/shared str i) st))))))))
-
-  (define (c-comment . args)
-    (lambda (st)
-      ((cat "/*" (fmt-let 'writer (make-comment-writer st)
-                          (apply-cat args))
-            "*/")
-       st)))
-
-  (define (make-block-comment-writer st)
-    (let ((output (make-comment-writer st))
-          (indent (string-append (make-nl-space (+ (fmt-col st) 1)) "* ")))
-      (lambda (str st)
-        (let ((lim (string-length str)))
-          (let lp ((i 0) (st st))
-            (let ((j (string-index str #\newline i)))
-              (if j
-                  (lp (+ j 1)
-                      (output indent (output (substring/shared str i j) st)))
-                  (output (substring/shared str i) st))))))))
-
-  (define (c-block-comment . args)
-    (lambda (st)
-      (let ((col (fmt-col st))
-            (row (fmt-row st))
-            (indent (c-current-indent-string st)))
-        ((cat "/* "
-              (fmt-let 'writer (make-block-comment-writer st) (apply-cat args))
-              (lambda (st)
-                (cond
-                 ((= row (fmt-row st)) ((dsp " */") st))
-                 ;;((= (+ 3 col) (fmt-col st)) ((dsp "*/") st))
-                 (else ((cat fl indent " */") st)))))
-         st))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; preprocessor
-
-  (define (make-cpp-writer st)
-    (let ((output (fmt-ref st 'writer)))
-      (lambda (str st)
-        (let lp ((i 0) (st st))
-          (let ((j (string-index str #\newline i)))
-            (if j
-                (lp (+ j 1)
-                    (output
-                     nl-str
-                     (output " \\" (output (substring/shared str i j) st))))
-                (output (substring/shared str i) st)))))))
-
-  (define (cpp-include file)
-    (if (string? file)
-        (cat fl "#include " (wrt file) fl)
-        (cat fl "#include <" file ">" fl)))
-
-  (define (list-dot x)
-    (cond ((pair? x) (list-dot (cdr x)))
-          ((null? x) #f)
-          (else x)))
-
-  (define (flatten-list ls)
-    (let lp ((ls ls) (res '()))
-      (cond ((pair? ls) (lp (cdr ls) (cons (car ls) res)))
-            ((null? ls) (reverse res))
-            (else (reverse (cons ls res))))))
-
-  (define (replace-tree from to x)
-    (let replace ((x x))
-      (cond ((eq? x from) to)
-            ((pair? x) (cons (replace (car x)) (replace (cdr x))))
-            (else x))))
-
-  (define (cpp-define x . body)
-    (define (name-of x) (c-expr (if (pair? x) (cadr x) x)))
-    (lambda (st)
-      (let* ((body (cond
-                    ((and (pair? x) (list-dot x))
-                     => (lambda (dot)
-                          (if (eq? dot '...)
-                              body
-                              (replace-tree dot '__VA_ARGS__ body))))
-                    (else body)))
-             (params (map (lambda (x) (if (pair? x) (cadr x) x))
-                          (flatten-list (if (pair? x) (cdr x) '()))))
-             (tail
-              (if (pair? body)
-                  (cat " "
-                       (fmt-let 'writer (make-cpp-writer st)
-                                (fmt-let 'macro-params params
-                                         ((if (or (not (pair? x))
-                                                  (and (null? (cdr body))
-                                                       (c-literal? (car body))))
-                                              (lambda (x) x)
-                                              c-paren)
-                                          (c-in-expr (apply c-begin body))))))
-                  (lambda (x) x))))
-        ((c-in-expr
-          (if (pair? x)
-              (cat fl "#define " (name-of (car x))
-                   (c-paren
-                    (fmt-join/dot name-of
-                                  (lambda (dot) (dsp "..."))
-                                  (cdr x)
-                                  ", "))
-                   tail fl)
-              (cat fl "#define " (c-expr x) tail fl)))
-         st))))
-
-  (define (cpp-expr x)
-    (if (or (symbol? x) (string? x)) (dsp x) (c-expr x)))
-
-  (define (cpp-if/aux name check . o)
-    (let* ((pass (and (pair? o) (car o)))
-           (comment (if (member name '("ifdef" "ifndef"))
-                        (cat "  "
-                             (c-comment
-                              " " (if (equal? name "ifndef") "! " "")
-                              check " "))
-                        ""))
-           (endif (if pass (cat fl "#endif" comment) ""))
-           (tail (cond
-                  ((and (pair? o) (pair? (cdr o)))
-                   (if (pair? (cddr o))
-                       (apply cpp-elif (cdr o))
-                       (cat (cpp-else) (cadr o) endif)))
-                  (else endif))))
-      (lambda (st)
-        (let ((indent (c-current-indent-string st)))
-          ((cat fl "#" name " " (cpp-expr check) fl
-                (if pass (cat indent pass) "") fl
-                tail fl)
-           st)))))
-
-  (define (cpp-if check . o)
-    (apply cpp-if/aux "if" check o))
-  (define (cpp-ifdef check . o)
-    (apply cpp-if/aux "ifdef" check o))
-  (define (cpp-ifndef check . o)
-    (apply cpp-if/aux "ifndef" check o))
-  (define (cpp-elif check . o)
-    (apply cpp-if/aux "elif" check o))
-  (define (cpp-else . o)
-    (cat fl "#else " (if (pair? o) (c-comment (car o)) "") fl))
-  (define (cpp-endif . o)
-    (cat fl "#endif " (if (pair? o) (c-comment (car o)) "") fl))
-
-  (define (cpp-wrap-header name . body)
-    (let ((name name))                  ; consider auto-mangling
-      (cpp-ifndef name (c-begin (cpp-define name) nl (apply c-begin body) nl))))
-
-  (define (cpp-line num . o)
-    (cat fl "#line " num (if (pair? o) (cat " " (car o)) "") fl))
-
-  (define (cpp-generic name . ls)
-    (cat fl "#" name (apply-cat ls) fl))
-
-  (define (cpp-undef . args) (apply cpp-generic "undef" args))
-  (define (cpp-pragma . args) (apply cpp-generic "pragma" args))
-  (define (cpp-error . args) (apply cpp-generic "error" args))
-  (define (cpp-warning . args) (apply cpp-generic "warning" args))
-
-  (define (cpp-stringify x)
-    (cat "#" x))
-
-  (define (cpp-sym-cat . args)
-    (fmt-join dsp args " ## "))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; general indentation and brace rules
-
-  (define (c-current-indent-string st . o)
-    (make-space (max 0 (+ (fmt-col st) (if (pair? o) (car o) 0)))))
-
-  (define (c-indent st . o)
-    (dsp (make-space (max 0 (+ (fmt-col st) (or (fmt-indent-space st) 4)
-                               (if (pair? o) (car o) 0))))))
-
-  (define (c-indent/switch st)
-    (dsp (make-space (+ (fmt-col st) (or (fmt-switch-indent-space st) 4)))))
-
-  (define (c-open-brace st)
-    (if (fmt-newline-before-brace? st)
-        (begin
-          (fmt-set! st 'newline-before-brace? #t)
-          (cat "{" nl))
-        (begin
-          (fmt-set! st 'newline-before-brace? #t)
-          (cat " {" nl))))
-
-  (define (c-close-brace st)
-    (dsp "}"))
-
-  (define (c-wrap-stmt x)
-    (fmt-if fmt-expression?
-            (c-expr x)
-            (cat (c-in-expr (c-expr x)) ";" nl)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; code blocks
-
-  (define (c-block . args)
-    (apply c-block/aux 0 args))
-
-  (define (c-block/aux offset header body0 . body)
-    (let ((inner (apply c-begin body0 body)))
-      (if (or (pair? body)
-              (not (or (c-literal? body0)
-                       (and (pair? body0)
-                            (not (c-control-operator? (car body0)))))))
-          (c-braced-block/aux offset header inner)
-          (lambda (st)
-            (if (fmt-braceless-bodies? st)
-                ((cat header fl (c-indent st offset) inner fl) st)
-                ((c-braced-block/aux offset header inner) st))))))
-
-  (define (c-braced-block . args)
-    (apply c-braced-block/aux 0 args))
-
-  (define (c-braced-block/aux offset header . body)
-    (lambda (st)
-      ((cat (if header header "") (c-open-brace st) (c-indent st offset)
-            (apply c-begin body) fl
-            (c-current-indent-string st offset) (c-close-brace st))
-       st)))
-
-  (define (c-begin . args)
-    (apply c-begin/aux #f args))
-
-  (define (c-begin/aux ret? body0 . body)
-    (if (null? body)
-        (c-expr body0)
-        (lambda (st)
-          (if (fmt-expression? st)
-              ((fmt-try-fit
-                (fmt-let 'no-wrap? #t (fmt-join c-expr (cons body0 body) ", "))
-                (lambda (st)
-                  (let ((indent (c-current-indent-string st)))
-                    ((fmt-join c-expr (cons body0 body) (cat "," nl indent)) st))))
-               st)
-              (let ((orig-ret? (fmt-return? st)))
-                ((fmt-join/last c-expr
-                                (lambda (x) (fmt-let 'return? orig-ret? (c-expr x)))
-                                (cons body0 body)
-                                (cat fl (c-current-indent-string st)))
-                 (fmt-set! st 'return? (and ret? orig-ret?))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; data structures
-
-  (define (c-struct/aux type x . o)
-    ;; can be just pointer to SUC, need to support such case:
-    ;; struct whatever * - body is just '*'
-    (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
-           (body (if name (if (not (null? o)) (car o) '()) x))
-           (o (if (null? o) o (cdr o))))
-      (if (and (not (null? body))
-               (not (eq? '* body)))
-          (c-wrap-stmt
-           (cat
-            (c-braced-block
-             (cat type (if (and name (not (equal? name ""))) (cat " " name) ""))
-             (cat
-              (c-in-stmt
-               (if (list? body)
-                   (apply c-begin (map c-wrap-stmt (map c-field body)))
-                   (c-wrap-stmt (c-expr body))))))
-            (if (pair? o) (cat " " (apply c-begin o)) (dsp ""))))
-          (c-wrap-stmt
-           (cat type
-                (if (and name (not (equal? name "")))
-                    (cat " " name)
-                    "")
-                (if (not (null? body))
-                    (cat body)
-                    ""))))))
-
-  (define (c-struct . args) (apply c-struct/aux "struct" args))
-  (define (c-union . args) (apply c-struct/aux "union" args))
-  (define (c-class . args) (apply c-struct/aux "class" args))
-
-  (define (c-enum x . o)
-    (define (c-enum-one x)
-      (if (pair? x) (cat (car x) " = " (c-expr (cadr x))) (dsp x)))
-    (let* ((name (if (null? o) (if (or (symbol? x) (string? x)) x #f) x))
-           (vals (if name (car o) x)))
-      (c-wrap-stmt
-       (cat
-        (c-braced-block
-         (if name (cat "enum " name) (dsp "enum"))
-         (c-in-expr (apply c-begin (map c-enum-one vals))))))))
-
-  (define (c-attribute . args)
-    (cat "__attribute__ ((" (fmt-join c-expr args ", ") "))"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; basic control structures
-
-  (define (c-while check . body)
-    (c-reset-newline
-     (if (null? body)
-         (cat "while (" (c-in-test (c-expr check)) ");")
-         (cat (c-block (cat "while (" (c-in-test (c-expr check)) ")")
-                       (c-in-stmt (apply c-begin body)))
-              fl))))
-
-  (define (c-for init check update . body)
-    (c-reset-newline
-     (cat
-      (c-block
-       (c-in-expr
-        (cat "for (" (c-expr init) "; " (c-in-test (c-expr check)) "; "
-             (c-expr update ) ")"))
-       (c-in-stmt (apply c-begin body)))
-      fl)))
-
-  (define (c-param x)
-    (cond
-     ((procedure? x) x)
-     ((pair? x) (c-param-type (car x) (cadr x)))
-     (else (error "missing type" x))))
-
-  (define (c-field x)
-    (cond
-     ((procedure? x) x)
-     ((pair? x)
-      (if (list? (car x))
-          (case (caar x)
-            ((union struct class)
-             (if (> (length x) 1)
-                 (c-type (car x)
-                         (cadr x))
-                 (c-type (car x))))
-            (else (c-type (car x) (cadr x))))
-          (c-type (car x)
-                  (fmt-join c-expr (cdr x) ", "))))
-     (else (error "missing type" x))))
-
-  (define (c-param-list ls)
-    (if (null? ls)
-        (c-type 'void)
-        (c-in-expr (fmt-join/dot c-param (lambda (dot) (dsp "...")) ls ", "))))
-
-  (define (c-fun type name params . body)
-    (cat (c-block (c-in-expr (c-prototype type name params))
-                  (c-in-stmt (apply c-begin body)))
-         fl))
-
-  (define (c-prototype type name params . o)
-    (c-wrap-stmt
-     (cat (c-type type) " " (c-expr name) " (" (c-param-list params) ")"
-          (fmt-join/prefix c-expr o " "))))
-
-  (define (c-static x) (cat "static " (c-expr x)))
-  (define (c-const x) (cat "const " (c-expr x)))
-  (define (c-restrict x) (cat "restrict " (c-expr x)))
-  (define (c-volatile x) (cat "volatile " (c-expr x)))
-  (define (c-auto x) (cat "auto " (c-expr x)))
-  (define (c-inline x) (cat "inline " (c-expr x)))
-  (define (c-extern x) (cat "extern " (c-expr x)))
-  (define (c-extern/C . body)
-    (cat "extern \"C\" {" nl (apply c-begin body) nl "}" nl))
-
-  (define (c-type type . o)
-    (let ((name (and (pair? o) (car o))))
-      (cond
-       ((pair? type)
-        (case (car type)
-          ((%fun)
-           (cat (c-type (cadr type) #f)
-                " (*" (or name "") ")("
-                (fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
-          ((%array)
-           (let ((name (cat name "[" (if (pair? (cddr type))
-                                         (c-expr (caddr type))
-                                         "")
-                            "]")))
-             (c-type (cadr type) name)))
-          ((%pointer *)
-           (let ((name (cat "*" (if name (c-expr name) ""))))
-             (c-type (cadr type)
-                     (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
-                         (c-paren name)
-                         name))))
-          ((enum) (apply c-enum name (cdr type)))
-          ((struct union class)
-           (cat (apply c-struct/aux (car type) (cdr type)) (if name (cat " " name) "")))
-          (else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))
-       ((not type)
-        (lambda (st) ((c-type 'int name) st)))
-       (else
-        (cat (if (eq? '%pointer type) '* type) (if name (cat " " name) ""))))))
-
-  (define (c-param-type type . o)
-    (let ((name (and (pair? o) (car o))))
-      (cond
-       ((pair? type)
-        (case (car type)
-          ((%fun)
-           (cat (c-type (cadr type) #f)
-                " (*" (or name "") ")("
-                (fmt-join (lambda (x) (c-type x #f)) (caddr type) ", ") ")"))
-          ((%array)
-           (let ((name (cat name "[" (if (pair? (cddr type))
-                                         (c-expr (caddr type))
-                                         "")
-                            "]")))
-             (c-type (cadr type) name)))
-          ((%pointer *)
-           (let ((name (cat "*" (if name (c-expr name) ""))))
-             (c-type (cadr type)
-                     (if (and (pair? (cadr type)) (eq? '%array (caadr type)))
-                         (c-paren name)
-                         name))))
-          (else (fmt-join/last c-expr (lambda (x) (c-type x name)) type " "))))
-       ((not type)
-        (lambda (st) ((c-type 'int name) st)))
-       (else
-        (cat (if (eq? '%pointer type) '* type) (if name (cat " " name) ""))))))
-
-  (define (c-var type name . init)
-    (c-wrap-stmt
-     (if (pair? init)
-         (cat (c-type type name) " = " (c-expr (car init)))
-         (c-type type (if (pair? name)
-                          (fmt-join c-expr name ", ")
-                          (c-expr name))))))
-
-  (define (c-cast type expr)
-    (cat "(" (c-type type) ")" (c-expr expr)))
-
-  (define (c-typedef type alias . o)
-    (c-wrap-stmt
-     (cat "typedef " (c-type type alias) (fmt-join/prefix c-expr o " "))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; Generalized IF: allows multiple tail forms for if/else if/.../else
-  ;; blocks.  A final ELSE can be signified with a test of #t or 'else,
-  ;; or by simply using an odd number of expressions (by which the
-  ;; normal 2 or 3 clause IF forms are special cases).
-
-  (define (c-if/stmt c p . rest)
-    (lambda (st)
-      (let ((indent (c-current-indent-string st)))
-        ((let lp ((c c) (p p) (ls rest))
-           (if (or (eq? c 'else) (eq? c #t))
-               (if (not (null? ls))
-                   (error "forms after else clause in IF" c p ls)
-                   (cat (c-block/aux -1 " else" p) fl))
-               (let ((tail (if (pair? ls)
-                               (if (pair? (cdr ls))
-                                   (lp (car ls) (cadr ls) (cddr ls))
-                                   (lp 'else (car ls) '()))
-                               fl)))
-                 (cat (c-block/aux
-                       (if (eq? ls rest) 0 -1)
-                       (cat (if (eq? ls rest) (lambda (x) x) " else ")
-                            "if (" (c-in-test (c-expr c)) ")") p)
-                      tail))))
-         st))))
-
-  (define (c-if/expr c p . rest)
-    (let lp ((c c) (p p) (ls rest))
-      (cond
-       ((or (eq? c 'else) (eq? c #t))
-        (if (not (null? ls))
-            (error "forms after else clause in IF" c p ls)
-            (c-expr p)))
-       ((pair? ls)
-        (cat (c-in-test (c-expr c)) " ? " (c-expr p) " : "
-             (if (pair? (cdr ls))
-                 (lp (car ls) (cadr ls) (cddr ls))
-                 (lp 'else (car ls) '()))))
-       (else
-        (c-or (c-in-test (c-expr c)) (c-expr p))))))
-
-  (define (c-if . args)
-    (fmt-if fmt-expression?
-            (apply c-if/expr args)
-            (apply c-if/stmt args)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; switch statements, automatic break handling
-
-  (define (c-label name)
-    (lambda (st)
-      (let ((indent (make-space (max 0 (- (fmt-col st) 2)))))
-        ((cat fl indent name ":" fl) st))))
-
-  (define c-break
-    (c-wrap-stmt (dsp "break")))
-  (define c-continue
-    (c-wrap-stmt (dsp "continue")))
-  (define (c-return . result)
-    (if (pair? result)
-        (c-wrap-stmt (cat "return " (c-expr (car result))))
-        (c-wrap-stmt (dsp "return"))))
-  (define (c-goto label)
-    (c-wrap-stmt (cat "goto " (c-expr label))))
-
-  (define (c-switch val . clauses)
-    (c-reset-newline
-     (lambda (st)
-       ((cat "switch (" (c-in-expr val) ")" (c-open-brace st)
-             (c-indent/switch st)
-             (c-in-stmt (apply c-begin/aux #t (map c-switch-clause clauses))) fl
-             (c-current-indent-string st) (c-close-brace st) fl)
-        st))))
-
-  (define (c-switch-clause/breaks x)
-    (lambda (st)
-      (let* ((break?
-              (and (car x)
-                   (not (member (cadr x) '(case/fallthrough
-                                           default/fallthrough
-                                           else/fallthrough)))))
-             (explicit-case? (member (cadr x) '(case case/fallthrough)))
-             (indent (c-current-indent-string st))
-             (indent-body (c-indent st))
-             (sep (string-append ":" nl-str indent)))
-        ((cat (c-in-expr
-               (fmt-join/suffix
-                dsp
-                (cond
-                 ((pair? (cadr x))
-                  (map (lambda (y) (cat (dsp "case ") (c-expr y)))
-                       (cadr x)))
-                 (explicit-case?
-                  (map (lambda (y) (cat (dsp "case ") (c-expr y)))
-                       (if (list? (caddr x))
-                           (caddr x)
-                           (list (caddr x)))))
-                 ((member (cadr x)
-                          '(default else default/fallthrough else/fallthrough))
-                  (list (dsp "default")))
-                 (else
-                  (error
-                   "unknown switch clause, expected a list or default but got"
-                   (cadr x))))
-                sep))
-              (make-space (or (fmt-indent-space st) 4))
-              (fmt-join c-expr
-                        (if explicit-case? (cdddr x) (cddr x))
-                        indent-body)
-              (if (and break? (not (fmt-return? st)))
-                  (cat fl indent-body c-break)
-                  ""))
-         st))))
-
-  (define (c-switch-clause x)
-    (if (procedure? x) x (c-switch-clause/breaks (cons #t x))))
-  (define (c-switch-clause/no-break x)
-    (if (procedure? x) x (c-switch-clause/breaks (cons #f x))))
-
-  (define (c-case x . body)
-    (c-switch-clause (cons (if (pair? x) x (list x)) body)))
-  (define (c-case/fallthrough x . body)
-    (c-switch-clause/no-break (cons (if (pair? x) x (list x)) body)))
-  (define (c-default . body)
-    (c-switch-clause/breaks (cons #t (cons 'else body))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;; operators
-
-  (define (c-op op first . rest)
-    (if (null? rest)
-        (c-unary-op op first)
-        (apply c-binary-op op first rest)))
-
-  (define (c-binary-op op . ls)
-    (define (lit-op? x) (or (c-literal? x) (symbol? x)))
-    (let ((str (display-to-string op)))
-      (c-wrap-stmt
-       (c-maybe-paren
-        op
-        (if (or (equal? str ".") (equal? str "->"))
-            (fmt-join c-expr ls str)
-            (let ((flat
-                   (fmt-let 'no-wrap? #t
-                            (lambda (st)
-                              ((fmt-join c-expr
-                                         ls
-                                         (if (and (fmt-non-spaced-ops? st)
-                                                  (every lit-op? ls))
-                                             str
-                                             (string-append " " str " ")))
-                               st)))))
-              (fmt-if
-               fmt-no-wrap?
-               flat
-               (fmt-try-fit
-                flat
-                (lambda (st)
-                  ((fmt-join c-expr
-                             ls
-                             (cat nl (make-space (+ 2 (fmt-col st))) str " "))
-                   st))))))))))
-
-  (define (c-unary-op op x)
-    (c-wrap-stmt
-     (cat (display-to-string op) (c-maybe-paren op (c-expr x)))))
-
-  ;; some convenience definitions
-
-  (define (c++ . args) (apply c-op "++" args))
-  (define (c-- . args) (apply c-op "--" args))
-  (define (c+ . args) (apply c-op '+ args))
-  (define (c- . args) (apply c-op '- args))
-  (define (c* . args) (apply c-op '* args))
-  (define (c/ . args) (apply c-op '/ args))
-  (define (c% . args) (apply c-op '% args))
-  (define (c& . args) (apply c-op '& args))
-  ;; (define (|c\|| . args) (apply c-op '|\|| args))
-  (define (c^ . args) (apply c-op '^ args))
-  (define (c~ . args) (apply c-op '~ args))
-  (define (c! . args) (apply c-op '! args))
-  (define (c&& . args) (apply c-op '&& args))
-  ;; (define (|c\|\|| . args) (apply c-op '|\|\|| args))
-  (define (c<< . args) (apply c-op '<< args))
-  (define (c>> . args) (apply c-op '>> args))
-  (define (c== . args) (apply c-op '== args))
-  (define (c!= . args) (apply c-op '!= args))
-  (define (c< . args) (apply c-op '< args))
-  (define (c> . args) (apply c-op '> args))
-  (define (c<= . args) (apply c-op '<= args))
-  (define (c>= . args) (apply c-op '>= args))
-  (define (c= . args) (apply c-op '= args))
-  (define (c+= . args) (apply c-op "+=" args))
-  (define (c-= . args) (apply c-op "-=" args))
-  (define (c*= . args) (apply c-op '*= args))
-  (define (c/= . args) (apply c-op '/= args))
-  (define (c%= . args) (apply c-op '%= args))
-  (define (c&= . args) (apply c-op '&= args))
-  ;; (define (|c\|=| . args) (apply c-op '|\|=| args))
-  (define (c^= . args) (apply c-op '^= args))
-  (define (c<<= . args) (apply c-op '<<= args))
-  (define (c>>= . args) (apply c-op '>>= args))
-
-  (define (c. . args) (apply c-op "." args))
-  (define (c-> . args) (apply c-op "->" args))
-
-  (define (c-bit-or . args) (apply c-op "|" args))
-  (define (c-or . args) (apply c-op "||" args))
-  (define (c-bit-or= . args) (apply c-op "|=" args))
-
-  (define (c++/post x)
-    (cat (c-maybe-paren 'post-increment (c-expr x)) "++"))
-  (define (c--/post x)
-    (cat (c-maybe-paren 'post-decrement (c-expr x)) "--")))
--- a/sex-macros.module.scm
+++ b/sex-macros.module.scm
@@ -1,8 +0,0 @@
-(module sex-macros
-    (register-macro
-     cat
-     get-macro
-     macro?
-     apply-macro
-     defmacro)
-  "sex-macros.scm")
--- a/sex-macros.scm
+++ b/sex-macros.scm
@@ -1,11 +1,11 @@
+(declare (unit sex-macros))
+
 (import
-  scheme
-  (only fmt fmt)
-  (chicken base)
  (chicken plist)
  (chicken string))

 (define (cat-syms s-1 s-2)
+  (import fmt)
  (fmt #f s-1 s-2))

 (define (cat sym-1 sym-2)
@@ -14,20 +14,18 @@
 (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)
+(define (sex-macro? form)
  (and (list? form)
       (symbol? (car form))
       (get (car form) 'sex-macro)))

 (define (apply-macro form)
-  (assert (macro? form)
+  (assert (sex-macro? form)
          (fmt #f (car form) " is not a macro"))
  (apply (get-macro (car form))
         (cdr form)))
--- a/sex-mode.el
+++ b/sex-mode.el
@@ -51,9 +51,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
     ;; Keywords
     (list (concat "("
                   (regexp-opt '(
-                                 "begin"
                                 "case"
-                                 "default"
                                 "do"
                                 "if"
                                 "for"
@@ -85,8 +83,6 @@ 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"
--- a/sex-modules.module.scm
+++ b/sex-modules.module.scm
@@ -1,5 +0,0 @@
-(module sex-modules
-    (get-modules-public-forms
-     load-persistent-module-paths
-     read-public-interface)
-  "sex-modules.scm")
--- a/sex-modules.scm
+++ b/sex-modules.scm
@@ -1,20 +1,21 @@
-(import
-  scheme
-  brev-separate
-  (chicken base)
-  (chicken file)
-  (chicken load)
-  (chicken pathname)
-  (chicken process-context)
-  (chicken string)
-  fmt
-  reader
-  srfi-1
-  utils)
+; Why `sex-modules`? Probably `modules` unit is reserved by chicken,
+; things start to break.
+(declare (unit sex-modules)
+         (uses sex-reader
+               utils))
+
+(import brev-separate
+        (chicken file)
+        (chicken load)
+        (chicken pathname)
+        (chicken process-context)
+        (chicken string)
+        fmt
+        srfi-1)

 (define +persistent-module-paths+ (list))

-(define (get-modules-public-forms module-list)
+(define (get-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
@@ -68,7 +69,7 @@
  (case (car form)
    ((pub)
     (case (cadr form)
-       ((fn)                 ; replace with prototype
+       ((fn) ; replace with prototype
        ;; fn type name (arg-list) (body)
        ;; 1    2   3       4 - we need first 4
        (cons (take (cdr form) 4) acc))
--- a/sex-reader.scm
+++ b/sex-reader.scm
@@ -0,0 +1,22 @@
+(declare (unit sex-reader))
+
+(include "utils.macros.scm")
+
+(import (chicken pathname)
+        brev-separate
+        fmt)
+
+(define (read-forms acc)
+  (let ((r (read)))
+    (if (eof-object? r) (reverse acc)
+        (read-forms (cons r acc)))))
+
+(define (read-from-file file)
+  (with-directory file
+    (with-input-from-file (pathname-strip-directory file)
+      (fn (read-forms (list))))))
+
+(define (read-raw-forms input-source)
+  (if (eq? input-source 'stdin)
+      (read-forms (list))
+      (read-from-file input-source)))
--- a/sex.png
+++ b/sex.png
--- a/sexc.module.scm
+++ b/sexc.module.scm
@@ -1 +0,0 @@
-(module sexc (main) "sexc.scm")
--- a/sexc.scm
+++ b/sexc.scm
@@ -1,6 +1,11 @@
-(import scheme
-        brev-separate
-        (chicken base)
+(declare (unit sexc)
+         (uses fmt-c-writer
+               sex-reader
+               semen))
+
+(include "utils.macros.scm")
+
+(import brev-separate
        (chicken file)
        (chicken plist)
        (chicken pretty-print)
@@ -8,16 +13,10 @@
        (chicken process-context)
        (chicken port)
        fmt
-        fmt-c-writer
        getopt-long
-        sex-macros
-        sex-modules
-        reader
-        semen
        srfi-1                          ; list routines
        srfi-13
-        tree
-        utils)
+        tree)

 ;;; Main function facilities

@@ -32,9 +31,9 @@
                      (value #f)
                      (single-char #\c))
      (emit-c "Emit C code"
-              (required #f)
-              (value #f)
-              (single-char #\C))
+                  (required #f)
+                  (value #f)
+                  (single-char #\C))
      (public-interface "Get module's public interface"
                        (required #f)
                        (value #f))
@@ -86,10 +85,10 @@

 (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)))))
+   (lambda ()
+    (if (get-arg args 'macro-expand #f)
+        (map pp sex-forms)
+        (emit-c sex-forms)))))

 (define (compile-to-file sex-forms output args)
  (let ((compiler (or (get-arg args 'c-compiler #f)
@@ -116,19 +115,7 @@
  (if (eq? input-source 'stdin)
      (semen-process raw-forms)
      (with-directory input-source
-                      (semen-process raw-forms))))
-
-(define prelude
-  '((include inttypes.h)
-
-    (typedef u8 uint8-t)
-    (typedef i8 int8-t)
-    (typedef u16 uint16-t)
-    (typedef i16 int16-t)
-    (typedef u32 uint32-t)
-    (typedef i32 int32-t)
-    (typedef u64 uint64-t)
-    (typedef i64 int64-t)))
+        (semen-process raw-forms))))

 (define (main)
  (let* ((raw-args (command-line-arguments))
@@ -155,10 +142,7 @@
         (return #f))
       (load-persistent-module-paths)

-       (if (eq? input 'stdin)
-           (sex-fmt-current-file "stdin")
-           (sex-fmt-current-file (to-absolute-pathname input)))
-       (let* ((raw-forms (append prelude (read-raw-forms input)))
+       (let* ((raw-forms (read-raw-forms input))
              (sex-forms (semantic-process-forms raw-forms input)))
         (if (or (get-arg args 'macro-expand #f)
                 (get-arg args 'emit-c #f))
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -1,45 +1 @@
-CHICKEN_C = csc

-CSC_FLAGS += -K prefix -static
-MODULE_FLAGS = -emit-all-import-libraries -module-registration -c
-
-MODULES = utils sex-macros reader sex-modules semen sex-fmt-c fmt-c-writer sexc
-SEX_OBJ = $(MODULES:%=%.o)
-
-TESTS = basic semen reader fmt-c-writer utils
-TEST_SRCS = $(TESTS:%=%.scm)
-
-sex-tests: run.scm $(TEST_SRCS) $(SEX_OBJ)
-	$(CHICKEN_C) $(CSC_FLAGS) run.scm -o sex-tests -link sexc
-
-#------------------------------------------------------------------
-
-utils.o: utils.module.scm ../utils.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) utils.module.scm -o utils.o -unit utils
-
-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: reader.module.scm ../reader.scm
-	$(CHICKEN_C) $(CSC_FLAGS) $(MODULE_FLAGS) reader.module.scm -o reader.o -unit reader
-
-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.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
-
-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
-
-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
-
-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
-
-clean:
-	rm -f $(OBJ)
-	rm -f *.import.scm
-	rm -f *.link
-	rm -f sex-tests
--- a/tests/basic.scm
+++ b/tests/basic.scm
@@ -1,33 +1,35 @@
-(import fmt-c-writer)
+(test-begin "basic")

-(test-group "basic"
+;;; unkebabify
+(test '- (unkebabify '-))
+(test '-- (unkebabify '--))
+(test '-> (unkebabify '->))
+(test '-= (unkebabify '-=))
+(test 'kebab_case (unkebabify 'kebab-case))
+(test '_what_ (unkebabify '-what-))
+(test 'this->member (unkebabify 'this->member))
+(test '_this_->_member_ (unkebabify '-this-->-member-))
+(test '__->>> (unkebabify '--->>>))

-  ;; unkebabify
-  (test '- (unkebabify '-))
-  (test '-- (unkebabify '--))
-  (test '-> (unkebabify '->))
-  (test '-= (unkebabify '-=))
-  (test 'kebab_case (unkebabify 'kebab-case))
-  (test '_what_ (unkebabify '-what-))
-  (test 'this->member (unkebabify 'this->member))
-  (test '_this_->_member_ (unkebabify '-this-->-member-))
-  (test '__->>> (unkebabify '--->>>))
+;;; atom-to-fmt-c
+(test '%fun (atom-to-fmt-c 'fn))
+(test '%prototype (atom-to-fmt-c 'prototype))
+(test '%var (atom-to-fmt-c 'var))
+(test '%block-begin (atom-to-fmt-c 'begin))
+(test '%define (atom-to-fmt-c 'define))
+(test '%pointer (atom-to-fmt-c 'pointer))
+(test '%array (atom-to-fmt-c 'array))
+(test 'vector-ref (atom-to-fmt-c '@))
+(test '%include (atom-to-fmt-c 'include))
+(test '%cast (atom-to-fmt-c 'cast))

-  ;; atom-to-fmt-c
-  (test '%fun (atom-to-fmt-c 'fn))
-  (test '%prototype (atom-to-fmt-c 'prototype))
-  (test '%block-begin (atom-to-fmt-c 'begin))
-  (test '%define (atom-to-fmt-c 'define))
-  (test '%pointer (atom-to-fmt-c 'pointer))
-  (test '%array (atom-to-fmt-c 'array))
-  (test 'vector-ref (atom-to-fmt-c '¤))
-  (test '%include (atom-to-fmt-c 'include))
+;;; c89 stuff
+(test 'int (atom-to-fmt-c 'bool))
+(test 1 (atom-to-fmt-c 'true))
+(test 0 (atom-to-fmt-c 'false))

-  ;; c89 stuff
-  (test 'int (atom-to-fmt-c 'bool))
-  (test 1 (atom-to-fmt-c 'true))
-  (test 0 (atom-to-fmt-c 'false))
+;;; make-field-access
+(test 'a.b (make-field-access '(.b a)))
+(test 'a.b.c (make-field-access '(.c a.b)))

-  ;; make-field-access
-  (test 'a.b (make-field-access '(.b a)))
-  (test 'a.b.c (make-field-access '(.c a.b))))
+(test-end)
--- a/tests/fmt-c-writer.module.scm
+++ b/tests/fmt-c-writer.module.scm
@@ -1,3 +0,0 @@
-(module fmt-c-writer
-    *
-  "../fmt-c-writer.scm")
--- a/tests/fmt-c-writer.scm
+++ b/tests/fmt-c-writer.scm
@@ -1,159 +0,0 @@
-;;; Types
-(test-group "fmt-writer"
-
-  (test
-   '(const int)
-   (walk-type '(const int)))
-
-  (test
-   '(%array (const char) 512)
-   (walk-type '(¤ const char 512)))
-
-  (test
-   '(%array (float) 512)
-   (walk-type '(¤ (float) 512)))
-
-  (test
-   '(%array (const char) 512)
-   (walk-type '(¤ (const char) 512)))
-
-  (test
-   '(%array (const char))
-   (walk-type '(¤ const char)))
-
-  (test
-   '(%array (const char))
-   (walk-type '(¤ (const char))))
-
-  (test
-   '(%array float 8)
-   (walk-type '(¤ float 8)))
-
-  (test
-   "Pointer to const char"
-   '(const char *)
-   (walk-type '(* const char)))
-
-  (test
-   "Const pointer to const char"
-   '(const char * const)
-   (walk-type '(const * const char)))
-
-  (test
-   '(%fun void ((int) (float) (%array (struct what * const))))
-   (walk-type '(fn ((int) (float) (¤ (const * struct what))) void)))
-
-  (test
-   '(%fun void ((int) (%array float) (%array (struct what * const))))
-   (walk-type '(fn ((int) (¤ float) (¤ (const * struct what))) void)))
-
-  (test
-   '(%array (%fun void ((int) (%array float) (%array (struct what * const)))))
-   (walk-type '(¤ (fn ((int) (¤ float) (¤ (const * struct what))) void))))
-
-  ;; Type convert to C
-  (test
-   '(int)
-   (type-convert-to-c '(int)))
-
-  (test
-   '(* int)
-   (type-convert-to-c '(int *)))
-
-  (test
-   '(* const int)
-   (type-convert-to-c '(const int *)))
-
-  (test
-   '(const * const char)
-   (type-convert-to-c '(const char * const)))
-
-;;; Variable defs
-  (test
-   '(%var (%array float 8) a)
-   (walk-var '(var a (¤ float 8))))
-
-  (test
-   '(%var (int *) a (& n))
-   (walk-var '(var a (* int) (& n))))
-
-  (test
-   '(%var (const int *) a (& n))
-   (walk-var '(var a (* const int) (& n))))
-
-  (test
-   '(%var (struct suc) s)
-   (walk-var '(var s (struct suc))))
-
-  (test
-   '(%var (const struct suc *) s s1)
-   (walk-var '(var s (* const struct suc) s1)))
-
-  (test
-   '(%var (const struct suc *) s s1)
-   (walk-var '(var s (* (const struct suc)) s1)))
-
-  (test
-   '(%var (struct suc) s (hoge piyo))
-   (walk-var '(var s (struct suc) (hoge piyo))))
-
-  (test
-   '(%var (struct suc *) s (hoge piyo))
-   (walk-var '(var s (* struct suc) (hoge piyo))))
-
-;;; Fn defs
-  (test
-   '(%fun void puk ((int) (%array float 8)))
-   (walk-fn-def '(fn puk ((int) (¤ float 8)) void)))
-
-  (test
-   '(%fun int main ((int argc) ((%array (const char)) argv))
-          (return 0))
-   (walk-fn-def
-    '(fn main ((argc int) (argv (¤ const char))) int
-         (return 0))))
-  (test
-   '(%fun int quxu (((struct piq *) bar))
-          (return 0))
-   (walk-fn-def
-    '(fn quxu ((bar (* struct piq))) int
-         (return 0))))
-
-  (test
-   '(%fun int quxu (((struct piq *) bar) ((%array (struct tt *)) ploop))
-          (return 0))
-   (walk-fn-def
-    '(fn quxu ((bar (* struct piq)) (ploop (¤ * struct tt))) int
-         (return 0))))
-
-  ;; Structs
-  (test
-   '(struct no_kebab ((int a) (float f)))
-   (walk-struct '(struct no-kebab ((a int) (f float)))))
-
-  (test
-   '(struct settings ((u32 x y w h)
-                      ((%array (struct ((float r g b a))) 4) colors)))
-   (walk-struct
-    '(struct settings
-             ((x y w h u32)
-              (colors [¤ struct ((r g b a float)) 4])))))
-
-  (test
-   '(struct settings ((u32 x y w h)
-                      ((%array (struct color ((float r g b a))) 4) colors)))
-   (walk-struct
-    '(struct settings
-             ((x y w h u32)
-              (colors [¤ struct color ((r g b a float)) 4])))))
-
-  (test
-   '(struct mega_kebab ((int a)
-                        ((struct ((int year) (int month) (int day))) dob)
-                        ((%fun int ((int) (%array int))) min)))
-   (walk-struct '(struct mega-kebab
-                         ((a int)
-                          (dob (struct ((year int)
-                                        (month int)
-                                        (day int))))
-                          (min (fn ((int) (¤ int)) bool)))))))
--- a/tests/reader.module.scm
+++ b/tests/reader.module.scm
@@ -1,3 +0,0 @@
-(module reader
-    *
-  "../reader.scm")
--- a/tests/reader.scm
+++ b/tests/reader.scm
@@ -1,18 +0,0 @@
-(import (chicken port)
-        reader)
-
-(define-syntax reader-test
-  (syntax-rules ()
-    ((reader-test result string)
-     (test result
-           (with-input-from-string string
-             (lambda () (read-raw-forms 'stdin)))))))
-
-(test-group "reader"
-  ;; []-syntax. For array types and array access expressions
-  (reader-test '((¤ * char)) "[* char]")
-  (reader-test '((¤ * * char const 512)) "[* * char const 512]")
-  (reader-test '((¤)) "[]")
-  (reader-test '((¤ (¤))) "[[]]")
-  (reader-test '((¤ (¤ const char))) "[[const char]]")
-)
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -1,11 +1,14 @@
+(declare (uses fmt-c-writer
+               semen))
+
 (import
+  (chicken process)
+  (chicken process-context)
+  srfi-1
  test)

 (include "basic.scm")
 (include "semen.scm")
-(include "reader.scm")
-(include "fmt-c-writer.scm")
-(include "utils.scm")

 ;;; Should be the last in the test suite
 (test-exit)
--- a/tests/semen.module.scm
+++ b/tests/semen.module.scm
@@ -1,2 +0,0 @@
-(module semen *
-  "../semen.scm")
--- a/tests/semen.scm
+++ b/tests/semen.scm
@@ -1,6 +1,3 @@
-(import srfi-69
-        semen)
-
 (define print-str-fn
  '(fn void print-str ((string s))
       (printf "%s" s)))
@@ -9,49 +6,48 @@
  '(pub fn float sum ((int a) (int b))
        (return (cast float (+ a b)))))

-(test-group "semen"
-  (test-assert (sex-fn? print-str-fn))
-  (test #f (sex-fn-public? print-str-fn))
-  (test 'void (sex-fn-return-type print-str-fn))
-  (test 'print-str (sex-fn-name print-str-fn))
-  (test '((string s)) (sex-fn-arglist print-str-fn))
-  (test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn))
-  (test '((printf "%s" s)) (sex-fn-body print-str-fn))
+(test-begin "semen")
+(test-assert (sex-fn? print-str-fn))
+(test #f (sex-fn-public? print-str-fn))
+(test 'void (sex-fn-return-type print-str-fn))
+(test 'print-str (sex-fn-name print-str-fn))
+(test '((string s)) (sex-fn-arglist print-str-fn))
+(test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn))
+(test '((printf "%s" s)) (sex-fn-body print-str-fn))

-  (test-assert (sex-fn? sum-fn))
-  (test #t (sex-fn-public? sum-fn))
-  (test 'float (sex-fn-return-type sum-fn))
-  (test 'sum (sex-fn-name sum-fn))
-  (test '((int a) (int b)) (sex-fn-arglist sum-fn))
-  (test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
-  (test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))
+(test-assert (sex-fn? sum-fn))
+(test #t (sex-fn-public? sum-fn))
+(test 'float (sex-fn-return-type sum-fn))
+(test 'sum (sex-fn-name sum-fn))
+(test '((int a) (int b)) (sex-fn-arglist sum-fn))
+(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn))
+(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn))

-  (let ((sex-code
-         '((defmacro (sum-var name a b c)
-             `(var ,name ,(+ a b c)))
+(let ((sex-code
+       '((defmacro (sum-var name a b c)
+           `(var ,name ,(+ a b c)))

-           (sum-var v 1 2 3))))
+         (sum-var v 1 2 3))))

-    (test '((var v 6)) (semen-process sex-code)))
+  (test '((var v 6)) (semen-process sex-code)))

 ;;; Macro expansion

-  (define (form-identity form env)
-    form)
+(test 'a (semen-walk-form 'a identity))
+(test '(a b c) (semen-walk-form '(a b c) identity))

-  (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)
+           `(* 10 ,a))

-  (let ((sex-code-macro
-         '((defmacro (x10 a)
-             `(* 10 ,a))
+         (fn void foo ((int a) (int b))
+             (return (+ a (x10 b)))))))

-           (fn void foo ((int a) (int b))
-               (return (+ a (x10 b)))))))
+  (test '((fn void foo ((int a) (int b))
+              (return (+ a (* 10 b)))))
+        (semen-process sex-code-macro)))

-    (test '((fn void foo ((int a) (int b))
-                (return (+ a (* 10 b)))))
-          (semen-process sex-code-macro))))
+(test-end)
--- a/tests/sex-macros.module.scm
+++ b/tests/sex-macros.module.scm
@@ -1,3 +0,0 @@
-(module sex-macros
-    *
-  "../sex-macros.scm")
--- a/tests/sex-modules.module.scm
+++ b/tests/sex-modules.module.scm
@@ -1,3 +0,0 @@
-(module sex-modules
-    *
-  "../sex-modules.scm")
--- a/tests/sex-programs/hello-world.sex
+++ b/tests/sex-programs/hello-world.sex
@@ -1,13 +0,0 @@
-(input "Sextest")
-(output "Hello from Sex!" "What is your name?" "Hello, Sextest!")
-(return 255)
-
-(include stdio.h)
-
-(pub fn main ((argc int) (argv  [* const char])) int
-  (puts "Hello from Sex!")
-  (var name [char 512])
-  (puts "What is your name?")
-  (scanf "%s" (cast (& name) (* char)))
-  (printf "Hello, %s!\n" name)
-  (return 255))
--- a/tests/sex-programs/list-macros.sex
+++ b/tests/sex-programs/list-macros.sex
@@ -1,48 +0,0 @@
-(pub defmacro (list-T type)
-  (let ((list-type (cat 'list- type)))
-    `(struct ,list-type
-       ((value ,type)
-        (next (* struct ,list-type))))))
-
-(pub defmacro (make-list-T type is-public?)
-  (let ((list-type (list 'struct (cat 'list- type)))
-        (fn-name (cat 'make-list- type)))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name () (* ,list-type)
-      (var list (* ,list-type) (cast  (malloc (sizeof ,list-type)) (* ,list-type)))
-      (= (-> list next) NULL)
-      (return list))))
-
-(pub defmacro (add-value-list-T type is-public?)
-  (let ((list-type (list 'struct (cat 'list- type)))
-        (fn-name (cat 'add-value-list- type)))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name ((list * ,list-type) (value ,type)) void
-      (while (!= (-> list next) NULL)
-        (= list (-> list next)))
-      (= (-> list next) (,(cat 'make-list- type)))
-      (= (-> list value) value))))
-
-(pub defmacro (length-list-T type is-public?)
-  (let ((fn-name (cat 'length-list- type))
-        (list-type (list 'struct (cat 'list- type))))
-    `(,@(if is-public? '(pub) '()) fn ,fn-name ((list ,(cons '* list-type))) size-t
-      (var n size-t 0)
-      (while (!= (-> list next) NULL)
-        (= list (-> list next))
-        (++ n))
-      (return n))))
-
-(pub defmacro (is-empty-list-T type is-public?)
-  `(,@(if is-public? '(pub) '()) fn ,(cat 'is-empty-list- type)
-    ((list ,(list '* 'struct (cat 'list- type))))
-    bool
-    (return (== (-> list next) NULL))))
-
-(pub defmacro (list-for-each list-type list-var elt-type elt-var what-do)
-  (let ((list-var-2 (cat list-var '-2)))
-    `(begin
-      (var ,list-var-2 (* ,list-type) ,list-var)
-      (var ,elt-var ,elt-type (-> ,list-var-2 value))
-      (while (!= (-> ,list-var-2 next) NULL)
-        ,what-do
-        (= ,list-var-2 (-> ,list-var-2 next))
-        (= ,elt-var (-> ,list-var-2 value))))))
--- a/tests/sex-programs/lists.sex
+++ b/tests/sex-programs/lists.sex
@@ -1,50 +0,0 @@
-(input)
-(output "Size of the list: 0"
-        "Size of the list: 2"
-        "3 4 "
-        "Size of the list: 2")
-(return 0)
-
-(include stdlib.h)
-(include stddef.h)
-(include stdio.h)
-
-(import list-macros)
-
-(struct foo
-  ((a-field float)
-   (b int)
-   (c (* const char))
-   (not (fn ((val bool)) bool))))
-
-(var f (struct foo))
-
-(list-T int)
-(make-list-T int #f)
-(add-value-list-T int #f)
-(length-list-T int #f)
-(is-empty-list-T int #f)
-
-(extern fn puk ((a int) (b float)) void)
-(pub fn baz () bool
-  (return true))
-
-(extern var i int)
-(var j int)
-(pub var k int)
-
-(pub fn main () int
-     (var l (* struct list-int) (make-list-int))
-     (printf "Size of the list: %lu\n" (length-list-int l))
-     (add-value-list-int l 3)
-     (add-value-list-int l 4)
-     (printf "Size of the list: %lu\n" (length-list-int l))
-     (list-for-each (struct list-int) l int v
-       (printf "%d " v))
-     (printf "\n")
-     (printf "Size of the list: %lu\n" (length-list-int l))
-     (return 0))
-
-(pub fn print-list ((l (* const struct list-int))) void
-     (list-for-each (const struct list-int) l int v (printf "%d " v))
-     (printf "\n"))
--- a/tests/sexc.module.scm
+++ b/tests/sexc.module.scm
@@ -1 +0,0 @@
-(module sexc (main) "../sexc.scm")
--- a/tests/utils.module.scm
+++ b/tests/utils.module.scm
@@ -1,3 +0,0 @@
-(module utils
-    *
-  "../utils.scm")
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,24 +0,0 @@
-(import utils)
-
-(test-group "utils"
-
-  (test
-   '((1) (2) (3))
-   (list-split '(1 * 2 * 3) '*))
-
-  (test
-   '((1 2 3))
-   (list-split '(1 2 3) '*))
-
-  (test
-   '(() (1) (2) (3) ())
-   (list-split '(* 1 * 2 * 3 *) '*))
-
-  (test
-   '((const) (const struct something))
-   (list-split '(const * const struct something) '*))
-
-  (test
-   '(1 * 2 * 3)
-   (list-join '(1 2 3) '*))
-)
--- a/tools/sextest/Makefile
+++ b/tools/sextest/Makefile
@@ -1,5 +0,0 @@
-CHICKEN_C = csc
-CSC_FLAGS += -K prefix -static
-
-sextest: sextest.scm
-	$(CHICKEN_C) $(CSC_FLAGS) sextest.scm -o sextest
--- a/tools/sextest/README.org
+++ b/tools/sextest/README.org
@@ -1,26 +0,0 @@
-* Sextest
-A tool for testing Sex compiler by using test programs.
-The tools compiles test programs, then runs with provided
-input, checking the output and return code.
-
-* Test format
-The test program is just a regular Sex program, which may contain
-additional toplevel forms, to define compilation parameters, input to
-the program, and expected output and return code. Default value for
-compilation, input and output is an empty strings. For the return code
-it is 0.
-
-* Example
-some-test.sex:
-#+begin_src
-(compilation "-- -O2")
-(input "")
-(output "Hello world!")
-(return 123)
-
-(include stdio.h)
-
-(pub fn main () int
-  (puts "Hello World!")
-  (return 123))
-#+end_src
--- a/tools/sextest/hello-sextest.sex
+++ b/tools/sextest/hello-sextest.sex
@@ -1,13 +0,0 @@
-(input "Sextest")
-(output "Hello from Sex!" "What is your name?" "Hello, Sextest!")
-(return 255)
-
-(include stdio.h)
-
-(pub fn main ((argc int) (argv  [* const char])) int
-  (puts "Hello from Sex!")
-  (var name [char 512])
-  (puts "What is your name?")
-  (scanf "%s" (cast (& name) (* char)))
-  (printf "Hello, %s!\n" name)
-  (return 255))
--- a/tools/sextest/sextest.scm
+++ b/tools/sextest/sextest.scm
@@ -1,211 +0,0 @@
-(import scheme
-        brev-separate
-        (chicken base)
-        (chicken file)
-        (chicken io)
-        (chicken pathname)
-        (chicken port)
-        (chicken process)
-        (chicken process-context)
-        (chicken read-syntax)
-        (chicken syntax)
-        fmt
-        getopt-long
-        srfi-1)
-
-(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 (set-working-directory file)
-  (change-directory
-   (normalize-pathname
-    (if (absolute-pathname? file)
-        (pathname-directory file)
-        (make-absolute-pathname
-         (current-directory)
-         (pathname-directory file))))))
-
-;;; TODO: use sexc reader code i.e. link with sex reader
-(define open-bracket-counter (make-parameter 0))
-
-(define (read-raw-forms input-source)
-  (let ((bracket-end (gensym)))
-    (set-read-syntax!
-     #\]
-     (lambda (port)
-       (when (= 0 (open-bracket-counter))
-         (error "Unmatched closing bracket"))
-       (open-bracket-counter (- (open-bracket-counter) 1))
-       bracket-end))
-
-    (set-read-syntax!
-     #\[
-     (lambda (port)
-       (open-bracket-counter (+ (open-bracket-counter) 1))
-       (let loop ((r (read port))
-                  (acc (list)))
-         (if (eq? r bracket-end)
-             (cons '¤ (reverse acc))
-             (loop (read port)
-                   (cons r acc)))))))
-  (read-from-file input-source))
-
-(define (read-from-file file)
-  (with-directory file
-    (with-input-from-file (pathname-strip-directory file)
-      (fn (read-forms (list))))))
-
-(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 (print-help)
-  (fmt #t "Usage: sextest [options] filename" nl
-       "Options:" nl
-       (usage opts-grammar) nl))
-
-(define (process-file target-path)
-  (let ((contents (read-raw-forms target-path)))
-    (foldl (lambda (acc elt)
-             (case (car elt)
-               ((compilation input output return)
-                (cons
-                 (append (car acc) (list elt))
-                 (cdr acc)))
-               (else
-                (cons
-                 (car acc)
-                 (append (cdr acc) (list elt))))))
-           (cons (list) (list))
-           contents)))
-
-(define (compile src flags sexc)
-  (let ((compiler (or
-                   (and sexc (cdr sexc))
-                   (get-environment-variable "SEXC")
-                   "sexc"))
-        (compiled-file (create-temporary-file)))
-    (call-with-values
-        (fn
-         (process compiler
-                  (append (list "-o" compiled-file)
-                          flags)))
-      (lambda (out-port in-port pid)
-        (with-output-to-port in-port
-          (fn (map (fn (fmt #t x)) src)))
-        (close-output-port in-port)
-
-        (call-with-values
-            (fn (process-wait pid))
-          (lambda (pid exited retcode)
-            (if (= 0 retcode)
-                compiled-file
-                #f)))))))
-
-(define (run-and-check file in out ret)
-  (call-with-values
-      (fn (process file))
-    (lambda (out-port in-port pid)
-      (when in
-        (with-output-to-port in-port
-          (fn (map (fn (fmt #t x))
-                   (cdr in))))
-        (close-output-port in-port))
-      (let ((out-lines
-             (with-input-from-port out-port
-               (fn
-                (let loop ((line (read-line))
-                           (lines (list)))
-                  (if (eof-object? line)
-                      (reverse lines)
-                      (loop (read-line)
-                            (cons line lines)))))))
-            (ret-code
-             (call-with-values
-                 ;; TODO: what if the program hangs
-                 ;; we need some kind of timeout mechanism
-                 (fn
-                  (process-wait pid))
-               (lambda (pid exited retcode)
-                 retcode))))
-        (and
-         (if (not (= ret-code (cadr ret)))
-             (begin
-               (fmt #t "Retcode differs. Got " ret-code ", expected " (cadr ret) nl)
-               #f)
-             #t)
-
-         (if (not (equal? out-lines (cdr out)))
-             (begin
-               (fmt #t "Output differs. Got " out-lines " expected " (cdr out) nl)
-               #f)
-             #t))))))
-
-(define opts-grammar
-  `((sexc ,(fmt #f "Path to sexc compiler. Defaults to value of SEXC" nl
-                (pad 26) "environment variable, ot if it's empty, to sexc" nl )
-          (required #f)
-          (value #t))
-    (help "Show this help"
-          (required #f)
-          (value #f)
-          (single-char #\h))))
-
-(define (process-test-file sexc path)
-  (set-environment-variable! "SEX_MODULE_PATH"
-                             (normalize-pathname (make-absolute-pathname
-                                                  (current-directory)
-                                                  (pathname-directory path))))
-  (let* ((settings-and-src (process-file path))
-         (settings (car settings-and-src))
-         (src (cdr settings-and-src))
-         (compiled-file (compile src (assoc 'compile settings) sexc)))
-    (if (not compiled-file)
-        (begin (fmt #t "Failed to compile " path nl)
-               #f)
-        (if (run-and-check
-             compiled-file
-             (assoc 'input settings)
-             (assoc 'output settings)
-             (assoc 'return settings))
-            (begin (fmt #t ".")
-                   #t)
-            (begin (fmt #t ",")
-                   #f)))))
-
-(define (main)
-  (let ((args (getopt-long (command-line-arguments)
-                           opts-grammar)))
-    (when (assoc 'help args)
-      (print-help)
-      (exit 0))
-    (when (null? (cdr (assoc '@ args)))
-      (fmt #t "Missing target file" nl)
-      (print-help)
-      (exit 1))
-    (unless
-        (foldl and
-               #t
-               (map (fn (process-test-file (assoc 'sexc args) x))
-                    (cdr (assoc '@ args))))
-      ;; TODO: add more verbose and human readable output and reporting
-      (fmt #t nl)
-      (exit 2))
-    (fmt #t nl)
-    (exit 0)))
-
-(main)
--- a/utils.macros.scm
+++ b/utils.macros.scm
@@ -0,0 +1,17 @@
+(import (chicken process-context))
+
+(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))))))
--- a/utils.module.scm
+++ b/utils.module.scm
@@ -1,10 +0,0 @@
-(module utils
-    (get-env-var
-     set-working-directory
-     to-absolute-pathname
-     list-split
-     list-join
-     recons
-     with-directory
-     )
-  "utils.scm")
--- a/utils.scm
+++ b/utils.scm
@@ -1,25 +1,10 @@
+(declare (unit utils))
+
+(include "utils.macros.scm")
+
 (import
-  scheme
-  (chicken base)
  (chicken pathname)
-  (chicken process-context)
-  srfi-1)
-
-(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))))))
+  (chicken process-context))

 (define (get-env-var name)
  (get-environment-variable name))
@@ -32,35 +17,3 @@
        (make-absolute-pathname
         (current-directory)
         (pathname-directory file))))))
-
-(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-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)))
Author	SHA1	Message	Date
alex-eg	18b9e20fee	add support for nested lambdas	2025-10-01 12:37:59 +03:00
alex-eg	e888ed1281	add initial lambda support No closures for now, but solid groundwork is laid.	2025-09-26 16:53:38 +03:00
alex-eg	21293c421f	enable prefix form for keywords I like writing :keyword more than #:keyword. That hash sign seems redundant	2025-09-26 16:52:34 +03:00
alex-eg	d5bbe853aa	don't force c89 after all	2025-09-26 14:51:44 +03:00
alex-eg	a7cd720057	update Readme.org	2025-09-26 14:51:44 +03:00
alex-eg	b314dfd58e	re-implement macro-expansion using new semantic walker	2025-09-26 14:33:47 +03:00
alex-eg	d0005a6622	implement semantic code walking framework	2025-09-26 14:33:23 +03:00
alex-eg	13984ccc78	add binaries to .gitignore	2025-09-26 11:53:10 +03:00
alex-eg	d8d6f4f5a4	add .gitignore	2025-09-24 20:14:21 +03:00
alex-eg	42d58d3359	split semantic processing and fmt-c code generation Introducing Sex SEMantic ENgine: the semen. Also split reader to other file (it can be replaced in the future). Macro expansion inside Sex code doesn't work yet, and it must be done in semen, not during fmt-c generation as before.	2025-09-24 20:12:08 +03:00
				`@@ -1 +0,0 @@`
				`fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable`