mescc: Tinycc support: Anonymous union initialization.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 11 May 2018 13:52:30 +0000 (15:52 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 11 May 2018 13:52:30 +0000 (15:52 +0200)
module/language/c99/compiler.mes
scaffold/tests/t.c

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)))
index 0e9937524696a02c16ecc8dd00125abb961d1758..b7181f97a6555d432799d20334b7fe8f2f1379d8 100644 (file)
@@ -38,6 +38,7 @@ struct foo g_foes[2];
 int g_foe;
 
 struct anon {struct {int bar; int baz;};};
+struct anion {union {int foo; int bar;}; union {int baz; int bla;};};
 
 struct here {int and;} there;
 
@@ -114,6 +115,12 @@ main (int argc, char* argv[])
   if (a.bar != 3) return 22;
   if (a.baz != 4) return 23;
 
+  struct anion u = {3, 4};
+  eputs ("u.foo:"); eputs (itoa (u.foo)); eputs ("\n");
+  eputs ("u.bla:"); eputs (itoa (u.bla)); eputs ("\n");
+  if (u.foo != 3) return 24;
+  if (u.bla != 4) return 25;
+
   i = 1;
   int lst[6] = {-1, 1 - 1, i, 2, 3};
   for (int i = 0; i < 4; i++)