mescc: Tinycc support: Anonymous union initialization.
[mes.git] / module / language / c99 / compiler.mes
index 51a9263e3983676fa02b12563a43fd6b2ee43294..27ab2b369ddde0cf217644f63b5ae64fbf2b5142 100644 (file)
     ("double" . ,(make-type 'builtin 8 #f))
     ("long double" . ,(make-type 'builtin 16 #f))))
 
-(define (field:name o)
-  (pmatch o
-    ((struct (,name ,type ,size ,pointer) . ,rest) name)
-    ((union (,name ,type ,size ,pointer) . ,rest) name)
-    ((,name . ,type) name)
-    (_ (error "field:name not supported:" o))))
-
-(define (field:pointer o)
-  (pmatch o
-    ((struct (,name ,type ,size ,pointer) . ,rest) pointer)
-    ((union (,name ,type ,size ,pointer) . ,rest) pointer)
-    ((,name . ,type) (->rank type))
-    (_ (error "field:pointer not supported:" o))))
-
-(define (field:size o)
-  (pmatch o
-    ((struct . ,fields) (apply + (map field:size fields)))
-    ((union . ,fields) (apply max (map field:size fields)))
-    ((,name . ,type) (->size type))
-    (_ (error (format #f "field:size: ~s\n" o)))))
-
 (define (ast->type o info)
   (define (type-helper o info)
     (pmatch o
 
       ((d-sel (ident ,field) ,struct)
        (let ((type0 (ast->type struct info)))
+         (stderr "type0=~s\n" type0)
          (ast->type (field-type info type0 field) info)))
 
       ((i-sel (ident ,field) ,struct)
           (else (stderr "ast-type->size barf: ~s => ~s\n" o type)
                 4))))
 
+(define (field:name o)
+  (pmatch o
+    ((struct (,name ,type ,size ,pointer) . ,rest) name)
+    ((union (,name ,type ,size ,pointer) . ,rest) name)
+    ((,name . ,type) name)
+    (_ (error "field:name not supported:" o))))
+
+(define (field:pointer o)
+  (pmatch o
+    ((struct (,name ,type ,size ,pointer) . ,rest) pointer)
+    ((union (,name ,type ,size ,pointer) . ,rest) pointer)
+    ((,name . ,type) (->rank type))
+    (_ (error "field:pointer not supported:" o))))
+
+(define (field:size o)
+  (pmatch o
+    ((struct . ,type) (apply + (map field:size (struct->fields type))))
+    ((union . ,type) (apply max (map field:size (struct->fields type))))
+    ((,name . ,type) (->size type))
+    (_ (error (format #f "field:size: ~s\n" o)))))
+
 (define (field-field info struct field)
-  (let* ((fields (type:description struct)))
+  (let ((fields (type:description struct)))
     (let loop ((fields fields))
       (if (null? fields) (error (format #f "no such field: ~a in ~s" field struct))
           (let ((f (car fields)))
             (cond ((equal? (car f) field) f)
-                  ((and (memq (car f) '(struct union)) (type? (cdr f)))
-                   (find (lambda (x) (equal? (car x) field)) (type:description (cdr f))))
+                  ((and (memq (car f) '(struct union)) (type? (cdr f))
+                        (find (lambda (x) (equal? (car x) field)) (struct->fields (cdr f)))))
                   (else (loop (cdr fields)))))))))
 
 (define (field-offset info struct field)
                                              (member field (reverse fields)
                                                      (lambda (a b)
                                                        (equal? a (car b) field))))))))
-                      ((and (eq? (car f) 'union) (type? (cdr f)))
-                       (let ((fields (type:description (cdr f))))
-                         (find (lambda (x) (equal? (car x) field)) fields)
-                         offset))
+                      ((and (eq? (car f) 'union) (type? (cdr f))
+                            (let ((fields (struct->fields (cdr f))))
+                              (and (find (lambda (x) (equal? (car x) field)) fields)
+                                   offset))))
                       (else (loop (cdr fields) (+ offset (field:size f)))))))))))
 
 (define (field-pointer info struct field)
       (let ((field (field-field info struct field)))
         (field:size field))))
 
+(define (field-size info struct field)
+  (let ((field (field-field info struct field)))
+    (field:size field)))
+
 (define (field-type info struct field)
   (let ((field (field-field info struct field)))
     (ast->type (cdr field) info)))
        (append-map struct->fields (type:description o)))
     (_ (guard (and (type? o) (eq? (type:type o) 'union)))
        (append-map struct->fields (type:description o)))
-    ((struct . ,type) (struct->fields type))
-    ((union . ,type) (struct->fields type))
+    ((struct . ,type) (list (car (type:description type))))
+    ((struct . ,type) (list (car (type:description type))))
+    (_ (list o))))
+
+(define (struct->init-fields o)
+  (pmatch o
+    (_ (guard (and (type? o) (eq? (type:type o) 'struct)))
+       (append-map struct->init-fields (type:description o)))
+    (_ (guard (and (type? o) (eq? (type:type o) 'union)))
+       (append-map struct->init-fields (type:description o)))
+    ((struct . ,type) (struct->init-fields type))
+    ((union . ,type) (list (car (type:description type))))
     (_ (list o))))
 
 (define (byte->hex.m1 o)
     ((initzer-list . ,inits)
      (let ((struct? (structured-type? local)))
        (cond (struct?
-              (let ((fields ((compose struct->fields local:type) local)))
+              (let ((fields ((compose struct->init-fields local:type) local)))
                 (fold (cut init-struct-field local <> <> <>) info fields (append inits (map (const '(p-expr (fixed "22"))) (iota (max 0 (- (length fields) (length inits)))))))))
              (else (fold (cut init-local local <> <> <>) info inits (iota (length inits)))))))
     (((initzer (initzer-list . ,inits)))