move Sex to better types

Types, fns and vars are now written in another, better, more intuitive
and readable way.

Types:
"pointer to const char" is "* const char"
"array of pointers to volatile int" is "[* volatile int]"
Read left to right

Vars (as well as fn args, struct fields):
(var name type)
(struct vec3 ((x float) (y float) (z float))
(fn vec3-add ((v1 vec3) (v2 vec3)) vec3 ...)

Also fns are now have return types after arg list.

* is now must not be attached to any type name (or variable for that
matter)

fmt-c-writer.scm

@@ -2,14 +2,17 @@
 
 (declare (unit fmt-c-writer)
          (uses fmt-c
-               semen))
+               semen
+               utils))
 
 (import (chicken string)
         brev-separate
         fmt
+        matchable
         regex
         srfi-1                          ; lists
         srfi-13                         ; strings
+        tree
         )
 
 (define (unkebabify sym)
@@ -27,15 +30,13 @@
   (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)
@@ -71,21 +72,133 @@
          (char=? #\. (string-ref (symbol->string (car form)) 0)))
     (cons (make-field-access form) acc))
 
+   ;; variable declaration inside function
+   ((eq? (car form) 'var)
+    (cons (walk-var form) acc))
+
+   ;; (cast expr type) -> (%cast type expr)
+   ((eq? (car form) 'cast)
+    (cons (list '%cast
+                (walk-type (drop form 2))
+                (car (walk-generic (second form) (list))))
+          acc))
+
    ;; toplevel, or a start of a regular list form
    (else
-    (let ((new-acc (list)))
-      (cons (fold-right
-             walk-generic
-             new-acc
-             form)
-            acc)))))
+    (cons (fold-right
+           walk-generic
+           (list)
+           form)
+          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)
+  (append
+   (list '%var)
+   (list (walk-type (flatten (third form))))
+   (list (atom-to-fmt-c (second form)))
+
+   (if (null? (drop form 3))
+       (list)
+       (car (walk-generic (drop form 3) (list))))  ; optional init expression
+   ))
+
+(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 (drop-right array-type 1))
+               (size (last array-type)))
+           `(%array ,(walk-type (flatten type))
+                    ,size))
+         ;; sugar for pointer... Do we really need it? Guess why not,
+         ;; it's a strong semantic cue
+         `(%array ,(walk-type (flatten array-type)))))
+    (('fn arglist ret-type)
+     `(%fun ,(walk-type ret-type) ,(walk-arglist arglist)))
+
+    ;; Special case: nested structs/unions
+    (('struct ((field-names field-types) ...) . attrs)
+     (append `(struct ,(process-struct-fields field-names field-types))
+             (if (null? attrs)
+                 (list)
+                 (list (map atom-to-fmt-c attrs)))))
+    (('union ((field-names field-types) ...) . attrs)
+     (append `(union ,(process-struct-fields field-names field-types))
+             (if (null? attrs)
+                 (list)
+                 (list (map atom-to-fmt-c attrs)))))
+
+    (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)
+      (tree-map atom-to-fmt-c
+                (fold-right append (list)
+                            (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)
+       ,(car (walk-generic name (list)))
+       ,(walk-arglist args)
+       .
+       ,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 (if (= 1 (length type))
+                                                     (car type)
+                                                     type)))
+                                (list (walk-type var))))))
+       form))
 
 (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))))
+      (walk-fn-def form)
+      (cons 'prototype (cdr (walk-fn-def form)))))
 
 (define (walk-function form static)
   (if static
@@ -94,6 +207,19 @@
       (walk-generic (normalize-fn-form (cdr form))
                     (list))))
 
+(define (process-struct-fields names types)
+  (zip (map walk-type types) (map atom-to-fmt-c names)))
+
+(define (walk-struct form)
+  (match form
+    ((type name ((field-names field-types) ...) . attrs)
+     (list (append `(,type ,(atom-to-fmt-c name)
+                           ,(process-struct-fields field-names field-types))
+                   (if (null? attrs)
+                       (list)
+                       (list (map atom-to-fmt-c attrs))))))
+    (else (error "Malformed aggregate definition " form))))
+
 (define (walk-extern form)
   (case (cadr form)
     ((fn)
@@ -107,7 +233,7 @@
     ((fn)
      (walk-function form #f))
     ((var)
-     (walk-generic (list 'static (cdr form)) (list)))
+     (walk-generic (walk-var (cdr form)) (list)))
     ((define defmacro import include struct typedef union var)
      ;; ignore here, used in generating public interface
      (process-toplevel-form (cdr form)))
@@ -116,10 +242,13 @@
 
 (define (process-toplevel-form form)
   ;; todo: rewrite to match
+  ;; for some reason should return list in a list; TODO: rewrite
   (case (car form)
     ((fn) (walk-function form #t))
+    ((var) (walk-generic (list 'static (walk-var form)) (list)))
     ((extern) (walk-extern form))
     ((pub) (walk-public form))
+    ((struct union) (walk-struct form))
     (else (walk-generic form (list)))))
 
 (define (emit-c sex-forms)