fix arrays of structs, multiple struct fields with same type

fmt-c-writer.scm

@@ -84,7 +84,7 @@
   ;; note: [...] is actually (¤ ...) after reading
   ;; (var c (fn ((int) (float)) void)) -> (%var (%fun void ((int) (float))) c)
   `(%var
-    ,(walk-type (flatten (third form)))
+    ,(walk-type (third form))
     ,(atom-to-fmt-c (second form))
     .
     ,(if (null? (drop form 3))
@@ -104,23 +104,26 @@
     (('¤ . array-type)
      (if (integer? (last array-type))
          ;; sized array
-         (let ((type (drop-right array-type 1))
+         (let* ((type-list (drop-right array-type 1))
-               (size (last array-type)))
+                (type (if (and (list? (car type-list))
-           `(%array ,(walk-type (flatten type))
+                               (= 1 (length type-list)))
+                          (car type-list)
+                          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 (flatten array-type)))))
+         `(%array ,(walk-type (if (and (list? (car array-type))
+                                       (= 1 (length array-type)))
+                                  (car array-type)
+                                  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)
+    ((or ('struct . _)
-     `(struct ,(process-struct-fields field-names field-types)
+         ('union . _)) (walk-struct form))
-              . ,(map atom-to-fmt-c attrs)))
-    (('union ((field-names field-types) ...) . attrs)
-     `(union ,(process-struct-fields field-names field-types)
-             . ,(map atom-to-fmt-c attrs)))
 
     (else
      (type-convert-to-c form))))
@@ -181,14 +184,22 @@
       (walk-fn-def form)
       (cons '%prototype (cdr (walk-fn-def form)))))
 
-(define (process-struct-fields names types)
+(define (process-struct-fields fields)
-  (zip (map walk-type types) (map atom-to-fmt-c names)))
+  (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 name ((field-names field-types) ...) . attrs)
+    ((type (fields ...) . attrs)        ; anonymous struct
+     `(,type ,(process-struct-fields fields)
+             . ,(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 field-names field-types)
+             ,(process-struct-fields fields)
              . ,(map atom-to-fmt-c attrs)))
     (else (error "Malformed aggregate definition " form))))
 

tests/fmt-c-writer.scm

@@ -10,8 +10,8 @@
    (walk-type '(¤ const char 512)))
 
   (test
-   '(%array (float 512))
+   '(%array (float) 512)
-   (walk-type '(¤ (float 512))))
+   (walk-type '(¤ (float) 512)))
 
   (test
    '(%array (const char) 512)
@@ -102,6 +102,22 @@
    '(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)