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.

Makefile

@@ -1,6 +1,6 @@
 CHICKEN_C = csc
 
-MODULES = sexc sex-macros sex-modules utils fmt-c
+MODULES = sexc fmt-c fmt-c-writer semen sex-macros sex-modules sex-reader utils
 OBJ = $(MODULES:%=%.o)
 
 sexc: main.o $(OBJ)

Readme.org

@@ -12,7 +12,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 fmt getopt-long brev-separate test tree srfi-1 srfi-13~
+~chicken-install fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable~
 
 ** Compilation
 ~make~

example/fns.sex

@@ -0,0 +1,10 @@
+;;; Prototypes
+(fn void puk ())
+
+(pub fn void plak ())
+
+;;; Functions
+(fn int foo () (return 1))
+
+(pub fn void bar ((int a) (int b))
+  (printf "%d\n" (+ a b)))

example/list.sex

@@ -2,10 +2,10 @@
   (let ((list-type (cat 'list- type)))
     `(struct ,list-type
        ((,type value)
-        ((* ,list-type) next)))))
+        ((* (struct ,list-type)) next)))))
 
 (pub defmacro (make-list-T type is-public?)
-  (let ((list-type (cat 'list- type))
+  (let ((list-type (list 'struct (cat 'list- type)))
         (fn-name (cat 'make-list- type)))
     `(,@(if is-public? '(pub) '()) fn (* ,list-type) ,fn-name ()
       (var (* ,list-type) list (cast (* ,list-type) (malloc (sizeof ,list-type))))
@@ -13,7 +13,7 @@
       (return list))))
 
 (pub defmacro (add-value-list-T type is-public?)
-  (let ((list-type (cat 'list- type))
+  (let ((list-type (list 'struct (cat 'list- type)))
         (fn-name (cat 'add-value-list- type)))
     `(,@(if is-public? '(pub) '()) fn void ,fn-name ((,list-type *list) (,type value))
       (while (!= (-> list next) NULL)
@@ -23,7 +23,7 @@
 
 (pub defmacro (length-list-T type is-public?)
   (let ((fn-name (cat 'length-list- type))
-        (list-type (cat 'list- type)))
+        (list-type (list 'struct (cat 'list- type))))
     `(,@(if is-public? '(pub) '()) fn size-t ,fn-name ((,list-type *list))
       (var size-t n 0)
       (while (!= (-> list next) NULL)
@@ -33,15 +33,15 @@
 
 (pub defmacro (is-empty-list-T type is-public?)
   `(,@(if is-public? '(pub) '()) fn bool ,(cat 'is-empty-list- type)
-    ((,(cat 'list- type) *list))
+    ((,(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 (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))
-         (= ,elt-var (-> ,list-var-2 value)))))))
+    `(begin
+      (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))
+        (= ,elt-var (-> ,list-var-2 value))))))

example/test-list.sex

@@ -2,20 +2,15 @@
 (include stddef.h)
 (include stdio.h)
 
-(chicken-import srfi-1 brev-separate)                 ; list routines, e.g. fold
-
 (import list)
 
-(chicken-define (imports-test a b c)
-  (fold + 0 (list 1 2 3 a b c)))
-
 (struct foo
   ((float a-field)
    (int b)
    ((const char *) c)
    ((fn bool ((bool val))) not)))
 
-(var foo f)
+(var (struct foo) f)
 
 (list-T int)
 (make-list-T int #f)
@@ -24,7 +19,6 @@
 (is-empty-list-T int #f)
 
 (extern fn void puk ((int a) (float b)))
-(fn int bar () (return ,(imports-test 10 20 30)))
 (pub fn bool baz () (return true))
 
 (extern var int i)
@@ -32,18 +26,18 @@
 (pub var int k)
 
 (pub fn int main ()
-     (var (* list-int) l (make-list-int))
+     (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)
      (printf "Size of the list: %lu\n" (length-list-int l))
-     (list-for-each list-int l int v
+     (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))
      (printf "%p\n" (cast void* l->next))
      (return 0))
 
-(pub fn void print-list (((const list-int) *l))
-     (list-for-each (const list-int) l int v (printf "%d " v))
+(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"))

fmt-c-writer.scm

@@ -0,0 +1,128 @@
+;;; Sex fmt-c output writer
+
+(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
+    ((-) sym)
+    ((--) sym)
+    ((->) sym)
+    ((-=) sym)
+    (else
+     (string->symbol
+      (string-substitute "-(?!>)" "_"
+                         (symbol->string sym) #t)))))
+
+(define (atom-to-fmt-c atom)
+  (case atom
+    ((fn) '%fun)
+    ((prototype) '%prototype)
+    ((var) '%var)
+    ((begin) '%block-begin)
+    ((define) '%define)
+    ((pointer) '%pointer)
+    ((array) '%array)
+    ((attribute) '%attribute)
+    ((@) 'vector-ref)
+    ((include) '%include)
+    ((cast) '%cast)
+    ;; uh things we do for c89 compatibility
+    ((bool) 'int)
+    ((true) 1)
+    ((false) 0)
+    (else
+     (if (symbol? atom)
+         (unkebabify atom)
+         atom))))
+
+(define (make-field-access form)
+  (assert
+   (= 2 (length form)) "Wrong field access format")
+  (unkebabify
+   (string->symbol
+    (fmt #f (cadr form) (car form)))))
+
+(define (walk-generic form acc)
+  (cond
+   ((null? form) (cons '() acc))
+
+   ;; vector, e.g. {}-initializer
+   ((vector? form)
+    (cons
+     (list->vector
+      (car (walk-generic (vector->list form) (list))))
+     acc))
+
+   ;; atom (hopefully)
+   ((not (list? form)) (cons (atom-to-fmt-c form) acc))
+
+   ;; another special case - field access
+   ((and (symbol? (car form))
+         (char=? #\. (string-ref (symbol->string (car form)) 0)))
+    (cons (make-field-access form) acc))
+
+   ;; toplevel, or a start of a regular list form
+   (else
+    (let ((new-acc (list)))
+      (cons (fold-right
+             walk-generic
+             new-acc
+             form)
+            acc)))))
+
+(define (normalize-fn-form form)
+  ;; (fn ret-type name arglist body) -> normal function
+  ;; (fn ret-type name arglist) -> prototype
+  (if (>= (length form) 5)
+      form
+      (cons 'prototype (cdr form))))
+
+(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)
+  (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)
+  (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 (cdr form)))
+    (else
+     (error "Pub what?" (cadr form)))))
+
+(define (process-toplevel-form form)
+  ;; 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)
+              (fmt #t (c-expr (car (process-toplevel-form form))) nl))
+            sex-forms))

semen.scm

@@ -0,0 +1,141 @@
+;;; Sex semantic engine
+
+(declare (unit semen)
+         (uses sex-macros
+               sex-modules))
+
+(import fmt
+        matchable                       ; pattern matching
+        srfi-1                          ; list routines
+        )
+
+;;; for lambda extraction, docstring processing, macro expansion,
+;;; injection of module headers, i.e. all things that rearrange code
+;;; structurally, add or remove forms
+;;;
+;;; The algorithm: feed toplevel forms to appropriate handlers, then
+;;; 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 (semen-process raw-sex-forms)
+  (semen-process-rec raw-sex-forms (list)))
+
+(define (semen-process-rec forms acc)
+  (cond
+   ((null? forms) (reverse acc))
+   ((sex-macro? (car forms))
+    (semen-process-rec
+     (semen-apply-macro (car forms) (cdr forms))
+     acc))
+   (else
+    (semen-process-rec (cdr forms)
+                       (match-sex-form (car forms) acc)))))
+
+(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)
+        (cons res rest-forms))))
+
+(define (match-sex-form sex-form acc)
+  (match sex-form
+    ((or ('fn . _)
+         ('pub 'fn . _)
+         ('extern 'fn . _)) (process-fn sex-form acc))
+    ((or ('struct . _)
+         ('pub struct . _)) (process-struct sex-form acc))
+    ((or ('union . _)
+         ('pub 'union . _)) (process-struct sex-form acc))
+    ((or ('var . _)
+         ('pub 'var . _)
+         ('extern 'var . _)) (process-global-var sex-form acc))
+    (('include _) (cons sex-form acc))
+
+    (('import . modules)
+     (semen-process-imports (get-public-forms modules) acc))
+
+    ((or ('defmacro . rest)
+         ('pub 'defmacro . rest)) (defmacro rest) acc)
+
+    (else (assert #f (fmt #f "Unknown top level form " sex-form)))))
+
+(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)
+         (semen-process-imports (cdr module-public-forms) acc))
+        (else
+         (semen-process-imports (cdr module-public-forms)
+                                (cons (car module-public-forms)
+                                      acc))))))
+
+(define (process-fn sex-fn acc)
+  (cons sex-fn acc))
+
+(define (process-struct sex-struct acc)
+  (cons sex-struct acc))
+
+(define (process-global-var sex-var acc)
+  (cons sex-var acc))
+
+;;; Utils
+(define (non-empty-list? form)
+  (and (list? form)
+       (not (null? form))))
+
+(define (sex-fn? form)
+  "The `form` must be toplevel.
+Returns #f if the form is not a function, returns the form otherwise"
+  (match form
+    ((fn . _) form)
+    ((pub fn . _) form)
+    (else #f)))
+
+(define (sex-fn-public? fn-form)
+  (eq? (car fn-form) 'pub))
+
+(define (sex-fn-return-type fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (third fn-form)
+      (second fn-form)))
+
+(define (sex-fn-name fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (fourth fn-form)
+      (third fn-form)))
+
+(define (sex-fn-arglist fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (fifth fn-form)
+      (fourth fn-form)))
+
+(define (sex-fn-prototype fn-form)
+  "Returns all except body"
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (take fn-form 5)
+      (take fn-form 4)))
+
+(define (sex-fn-body fn-form)
+  (assert (sex-fn? fn-form)
+          (fmt #f "Form " fn-form " is not a function"))
+  (if (sex-fn-public? fn-form)
+      (drop fn-form 5)
+      (drop fn-form 4)))

sex-macros.scm

@@ -19,11 +19,17 @@
 (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 (sex-macro? form)
+          (fmt #f (car form) " is not a macro"))
+  (apply (get-macro (car form))
+         (cdr form)))
+
 (define (defmacro form)
   (let ((arglist (car form))
         (body (cdr form)))

sex-modules.scm

@@ -1,7 +1,8 @@
 ; Why `sex-modules`? Probably `modules` unit is reserved by chicken,
 ; things start to break.
 (declare (unit sex-modules)
-         (uses utils))
+         (uses sex-reader
+               utils))
 
 (import brev-separate
         (chicken file)
@@ -14,7 +15,7 @@
 
 (define +persistent-module-paths+ (list))
 
-(define (import-modules 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
@@ -63,6 +64,7 @@
      (list)
      raw-forms)))
 
+;;; TODO: use semen facilities to analyze modules
 (define (process-public-interface-form form acc)
   (case (car form)
     ((pub)

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)))

sexc.scm

@@ -1,207 +1,23 @@
 (declare (unit sexc)
-         (uses fmt-c
-               sex-macros
-               sex-modules))
+         (uses fmt-c-writer
+               sex-reader
+               semen))
 
 (include "utils.macros.scm")
 
 (import brev-separate
         (chicken file)
-        (chicken pathname)
         (chicken plist)
         (chicken pretty-print)
         (chicken process)
         (chicken process-context)
         (chicken port)
-        (chicken string)
         fmt
         getopt-long
-        regex
         srfi-1                          ; list routines
-        srfi-13                         ; string routines
+        srfi-13
         tree)
 
-(define (unkebabify sym)
-  (case sym
-    ((-) sym)
-    ((--) sym)
-    ((->) sym)
-    ((-=) sym)
-    (else
-     (string->symbol
-      (string-substitute "-(?!>)" "_"
-                         (symbol->string sym) #t)))))
-
-(define (atom-to-fmt-c atom)
-  (case atom
-    ((fn) '%fun)
-    ((prototype) '%prototype)
-    ((var) '%var)
-    ((begin) '%block-begin)
-    ((define) '%define)
-    ((pointer) '%pointer)
-    ((array) '%array)
-    ((attribute) '%attribute)
-    ((@) 'vector-ref)
-    ((include) '%include)
-    ((cast) '%cast)
-    ;; uh things we do for c89 compatibility
-    ((bool) 'int)
-    ((true) 1)
-    ((false) 0)
-    (else
-     (if (symbol? atom)
-         (unkebabify atom)
-         atom))))
-
-(define (make-field-access form)
-  (assert (= 2 (length form)) "Wrong field access format")
-  (unkebabify
-   (string->symbol
-    (fmt #f (cadr form) (car form)))))
-
-(require-library chicken-syntax)
-
-(define (walk-generic form acc)
-  (cond
-   ((null? form) (cons '() acc))
-
-   ;; vector, e.g. {}-initializer
-   ((vector? form)
-    (cons
-     (list->vector
-      (car (walk-sex-tree (vector->list form) (list))))
-     acc))
-
-   ;; atom (hopefully)
-   ((not (list? form)) (cons (atom-to-fmt-c form) acc))
-
-   ;; special case - replace unquote with its expansion
-   ((eq? (car form) 'unquote)
-    (fold
-     cons
-     acc
-     (car                               ; bc walk-sex-tree always
-                                        ; wraps its result
-      (walk-sex-tree (eval (cadr form)) (list)))))
-
-   ;; another special case - field access
-   ((and (symbol? (car form))
-         (char=? #\. (string-ref (symbol->string (car form)) 0)))
-    (cons (make-field-access form) acc))
-
-   ;; another special case - macro
-   ((macro? form)
-    (append (fold-right
-             walk-generic
-             (list)
-             (apply (get-macro (car form)) (cdr form)))
-            acc))
-
-   ;; toplevel, or a start of a regular list form
-   (else
-    (let ((new-acc (list)))
-      (cons (fold-right
-             walk-generic
-             new-acc
-             form)
-            acc)))))
-
-(define (normalize-fn-form form)
-  ;; (fn ret-type name arglist body) -> normal function
-  ;; (fn ret-type name arglist) -> prototype
-  (if (>= (length form) 5)
-      form
-      (cons 'prototype (cdr form))))
-
-(define (walk-function form static acc)
-  (if static
-      (append (walk-generic (list 'static (normalize-fn-form form))
-                            (list))
-              acc)
-      (append (walk-generic (normalize-fn-form (cdr form))
-                            (list))
-              acc)))
-
-(define (walk-struct form acc)
-  (let ((name (unkebabify (cadr form))))
-    (append (walk-generic form (list))
-          (cons `(typedef struct ,name ,name) acc))))
-
-(define (walk-extern form acc)
-  (case (cadr form)
-    ((fn)
-     (append
-      (list (cons 'extern (walk-function form #f (list))))
-      acc))
-    ((var)
-     (append
-      (list (cons 'extern (walk-generic (cdr form) (list))))
-      acc))
-    (else (error "Extern what?"))))
-
-(define (walk-public form acc)
-  (case (cadr form)
-    ((fn)
-     (walk-function form #f acc))
-    ((var)
-     (append (walk-generic (list 'static (cdr form)) (list)) acc))
-    ((define defmacro import include struct typedef union var)
-     ;; ignore here, used in generating public interface
-     (process-form (cdr form) acc))
-    (else
-     (error "Pub what?" (cadr form)))))
-
-(define (walk-sex-tree form acc)
-  (if (list? form)
-      (if (macro? form)
-          (fold-right (fn (walk-sex-tree x y))
-                      acc
-                      (list (apply (get-macro (car form)) (cdr form))))
-          (case (car form)
-            ((fn) (walk-function form #t acc))
-            ((extern) (walk-extern form acc))
-            ((pub) (walk-public form acc))
-            ((struct union) (walk-struct form acc))
-            ((unquote) (fold (fn (walk-sex-tree x y))
-                             acc
-                             (eval (cadr form))))
-            (else (append (walk-generic form (list)) acc))))
-      ;; only for unquote support
-      (list (list (atom-to-fmt-c form)))))
-
-(define (process-form form acc)
-  (case (car form)
-    ((chicken-define) (eval (cons 'define (cdr form))) acc)
-    ((defmacro) (defmacro (cdr form)) acc)
-    ((chicken-load)
-     (load (cadr form)) acc)
-    ((chicken-import)
-     (eval (cons 'import (cdr form))) acc)
-    ((import)
-     (append (process-raw-forms
-
-              (import-modules (cdr form)) (list))
-             acc))
-    (else
-     (walk-sex-tree form acc))))
-
-(define (process-raw-forms raw-forms acc)
-  (if (null? raw-forms)
-      (reverse acc)
-      (process-raw-forms (cdr raw-forms)
-                         (process-form (car raw-forms) acc))))
-
-(define (read-forms acc)
-  (let ((r (read)))
-    (if (eof-object? r) (reverse acc)
-        (read-forms (cons r acc)))))
-
-(define (emit-c forms)
-  (for-each (lambda (form)
-              (fmt #t (c-expr form) nl))
-            forms))
-
 ;;; Main function facilities
 
 (define opts-grammar
@@ -214,10 +30,10 @@
                       (required #f)
                       (value #f)
                       (single-char #\c))
-      (preprocess "Emit C code"
+      (emit-c "Emit C code"
                   (required #f)
                   (value #f)
-                  (single-char #\E))
+                  (single-char #\C))
       (public-interface "Get module's public interface"
                         (required #f)
                         (value #f))
@@ -261,20 +77,14 @@
         'stdin
         (car rest-args))))
 
-(define (read-from-file file)
-  (with-directory file
-   (with-input-from-file (pathname-strip-directory file)
-     (fn (read-forms (list))))))
-
 (define (write-to-file-or-stdout output what)
   (if (eq? output 'default)
       (what)
       (with-output-to-file output
         (fn (what)))))
 
-(define (preprocess-or-macroexpand sex-forms output args)
-  (write-to-file-or-stdout
-   output
+(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)
@@ -301,13 +111,11 @@
         (close-output-port in-port)
         (process-wait pid)))))
 
-(define (process-input input raw-forms)
-  (let ((current-dir (current-directory)))
-    (unless (eq? input 'stdin)
-      (set-working-directory input))
-    (prog1
-     (process-raw-forms raw-forms (list))
-     (change-directory current-dir))))
+(define (semantic-process-forms raw-forms input-source)
+  (if (eq? input-source 'stdin)
+      (semen-process raw-forms)
+      (with-directory input-source
+        (semen-process raw-forms))))
 
 (define (main)
   (let* ((raw-args (command-line-arguments))
@@ -334,14 +142,11 @@
          (return #f))
        (load-persistent-module-paths)
 
-       (let* ((raw-forms
-               (if (eq? input 'stdin)
-                   (read-forms (list))
-                   (read-from-file input)))
-              (sex-forms (process-input input raw-forms)))
+       (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 'preprocess #f))
-             ;; Preprocess or macroexpand
-             (preprocess-or-macroexpand sex-forms output args)
+                 (get-arg args 'emit-c #f))
+             ;; Emit processed and macro-expanded sex code, or emit C code
+             (emit-c-or-sex sex-forms output args)
              ;; Compile file!
              (compile-to-file sex-forms output args)))))))

tests/basic.scm

@@ -1,3 +1,5 @@
+(test-begin "basic")
+
 ;;; unkebabify
 (test '- (unkebabify '-))
 (test '-- (unkebabify '--))
@@ -29,3 +31,5 @@
 ;;; make-field-access
 (test 'a.b (make-field-access '(.b a)))
 (test 'a.b.c (make-field-access '(.c a.b)))
+
+(test-end)

tests/run.scm

@@ -1,4 +1,5 @@
-(declare (uses sexc))
+(declare (uses fmt-c-writer
+               semen))
 
 (import
   (chicken process)
@@ -7,7 +8,7 @@
   test)
 
 (include "basic.scm")
-(include "types.scm")
+(include "semen.scm")
 
 ;;; Should be the last in the test suite
 (test-exit)

tests/semen.scm

@@ -0,0 +1,34 @@
+(define print-str-fn
+  '(fn void print-str ((string s))
+       (printf "%s" s)))
+
+(define sum-fn
+  '(pub fn float sum ((int a) (int b))
+        (return (cast float (+ a b)))))
+
+(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))
+
+(define sex-code
+  '((defmacro (sum-var name a b c)
+      `(var ,name ,(+ a b c)))
+
+    (sum-var v 1 2 3)))
+
+(test '((var v 6)) (semen-process sex-code))
+
+(test-end)

tests/types.scm

@@ -1 +0,0 @@
-(test "char *" (to-c-type '(%pointer char)))

utils.macros.scm

@@ -1,3 +1,5 @@
+(import (chicken process-context))
+
 (define-syntax prog1
   (syntax-rules ()
     ((prog1 form . forms)