From b75dd7eca22874f08b388b6e5ff0b73efbc6fad7 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Wed, 9 May 2018 21:31:23 +0200
Subject: [PATCH] mescc: Refactor type system: introduce <array>, <pointer>,
 <var>.

* module/language/c99/info.scm (<array>, <pointer>, <var>): New type.
* module/language/c99/compiler.mes (ast-><type>): New function.
  (ast-type): Use it.
---
 module/language/c99/compiler.mes | 472 +++++++++++++++++--------------
 module/language/c99/info.scm     | 120 +++++++-
 scaffold/tests/t.c               |  14 +-
 3 files changed, 369 insertions(+), 237 deletions(-)

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 81be0124..db882dc9 100644
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -135,42 +135,42 @@
   (cons name value))
 
 (define (enum->type-entry name fields)
-  (cons `("tag" ,name) (make-type 'enum 4 0 fields)))
+  (cons `(tag ,name) (make-type 'enum 4 fields)))
 
 (define (struct->type-entry name fields)
-  (cons `("tag" ,name) (make-type 'struct (apply + (map field:size fields)) 0 fields)))
+  (cons `(tag ,name) (make-type 'struct (apply + (map field:size fields)) fields)))
 
 (define (union->type-entry name fields)
-  (cons `("tag" ,name) (make-type 'union (apply + (map field:size fields)) 0 fields)))
+  (cons `(tag ,name) (make-type 'union (apply + (map field:size fields)) fields)))
 
 (define i386:type-alist
-  `(("char" . ,(make-type 'builtin 1 0 #f))
-    ("short" . ,(make-type 'builtin 2 0 #f))
-    ("int" . ,(make-type 'builtin 4 0 #f))
-    ("long" . ,(make-type 'builtin 4 0 #f))
-    ;;("long long" . ,(make-type 'builtin 8 0 #f))
-    ;;("long long int" . ,(make-type 'builtin 8 0 #f))
+  `(("char" . ,(make-type 'builtin 1 #f))
+    ("short" . ,(make-type 'builtin 2 #f))
+    ("int" . ,(make-type 'builtin 4 #f))
+    ("long" . ,(make-type 'builtin 4 #f))
+    ;;("long long" . ,(make-type 'builtin 8 #f))
+    ;;("long long int" . ,(make-type 'builtin 8 #f))
 
-    ("long long" . ,(make-type 'builtin 4 0 #f))  ;; FIXME
-    ("long long int" . ,(make-type 'builtin 4 0 #f))
+    ("long long" . ,(make-type 'builtin 4 #f))  ;; FIXME
+    ("long long int" . ,(make-type 'builtin 4 #f))
 
-    ("void" . ,(make-type 'builtin 1 0 #f))
+    ("void" . ,(make-type 'builtin 1 #f))
     ;; FIXME sign
-    ("unsigned char" . ,(make-type 'builtin 1 0 #f))
-    ("unsigned short" . ,(make-type 'builtin 2 0 #f))
-    ("unsigned short int" . ,(make-type 'builtin 2 0 #f))
-    ("unsigned" . ,(make-type 'builtin 4 0 #f))
-    ("unsigned int" . ,(make-type 'builtin 4 0 #f))
-    ("unsigned long" . ,(make-type 'builtin 4 0 #f))
+    ("unsigned char" . ,(make-type 'builtin 1 #f))
+    ("unsigned short" . ,(make-type 'builtin 2 #f))
+    ("unsigned short int" . ,(make-type 'builtin 2 #f))
+    ("unsigned" . ,(make-type 'builtin 4 #f))
+    ("unsigned int" . ,(make-type 'builtin 4 #f))
+    ("unsigned long" . ,(make-type 'builtin 4 #f))
 
-    ;; ("unsigned long long" . ,(make-type 'builtin 8 0 #f))
-    ;; ("unsigned long long int" . ,(make-type 'builtin 8 0 #f))
-    ("unsigned long long" . ,(make-type 'builtin 4 0 #f)) ;; FIXME
-    ("unsigned long long int" . ,(make-type 'builtin 4 0 #f))
+    ;; ("unsigned long long" . ,(make-type 'builtin 8 #f))
+    ;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
+    ("unsigned long long" . ,(make-type 'builtin 4 #f)) ;; FIXME
+    ("unsigned long long int" . ,(make-type 'builtin 4 #f))
 
-    ("float" . ,(make-type 'builtin 4 0 #f))
-    ("double" . ,(make-type 'builtin 8 0 #f))
-    ("long double" . ,(make-type 'builtin 16 0 #f))))
+    ("float" . ,(make-type 'builtin 4 #f))
+    ("double" . ,(make-type 'builtin 8 #f))
+    ("long double" . ,(make-type 'builtin 16 #f))))
 
 (define (field:name o)
   (pmatch o
@@ -202,102 +202,125 @@
     (_ (error (format #f "field:type: ~s\n" o)))))
 
 (define (ast->type info o)
-  (define (get-type o)
-    (let ((t (assoc-ref (.types info) o)))
-      (pmatch t
-        ((typedef ,next) (or (get-type next) o))
-        (_ t))))
+  (-><type> (ast-><type> o info)))
+
+(define (get-type o info)
+  (let ((t (assoc-ref (.types info) o)))
+    (pmatch t
+      ((typedef ,next) (or (get-type next info) o))
+      (_ t))))
+
+(define (ast-><type> o info)
+  (stderr "ast-><type> o=~s\n" o)
   (pmatch o
     (,t (guard (type? t)) t)
-    ((p-expr ,expr) (ast->type info expr))
-    ((pre-inc ,expr) (ast->type info expr))
-    ((post-inc ,expr) (ast->type info expr))
+    (,p (guard (pointer? p)) p)
+    (,a (guard (c-array? a)) a)
+
+    ((char ,value) (get-type "char" info))
+    ((enum-ref . _) (get-type "int" info))
+    ((fixed ,value) (get-type "int" info))
+    ((sizeof-expr . _) (get-type "int" info))
+    ((sizeof-type . _) (get-type "int" info))
+    ((string _) (make-c-array (get-type "char" info) #f))
+    ((void) (get-type "void" info))
+
     ((ident ,name) (ident->type info name))
-    ((char ,value) (get-type "char"))
-    ((fixed ,value) (get-type "int"))
-    ((type-spec (typename ,type))
-     (ast->type info type))
-    ((array-ref ,index ,array)
-     (ast->type info array))
+    ((fctn-call (p-expr (ident ,name)) . _) (ident->type info name))
+
+
+    ((fixed-type ,type) (ast-><type> type info))
+    ((float-type ,type) (ast-><type> type info))
+    ((typename ,type) (ast-><type> type info))
+
+    ((array-ref ,index ,array) (rank-- (ast-><type> array info)))
+
+    ((de-ref ,expr) (rank-- (ast-><type> expr info)))
+    ((ref-to ,expr) (rank++ (ast-><type> expr info)))
+
+    ((p-expr ,expr) (ast-><type> expr info))
+    ((pre-inc ,expr) (ast-><type> expr info))
+    ((post-inc ,expr) (ast-><type> expr info))
+
+    ((type-spec (typename ,type)) (ast-><type> type info))
+
     ((struct-ref (ident ,type))
-     (or (get-type type)
-         (let ((struct (if (pair? type) type `("tag" ,type))))
-           (ast->type info struct))))
+     (or (get-type type info)
+         (let ((struct (if (pair? type) type `(tag ,type))))
+           (ast-><type> struct info))))
     ((union-ref (ident ,type))
-     (or (get-type type)
-         (let ((struct (if (pair? type) type `("tag" ,type))))
-           (ast->type info struct))))
+     (or (get-type type info)
+         (let ((struct (if (pair? type) type `(tag ,type))))
+           (ast-><type> struct info))))
+
+    ;;;
     ((struct-def (ident ,name) . _)
-     (ast->type info `("tag" ,name)))
+     (ast-><type> `(tag ,name) info))
     ((union-def (ident ,name) . _)
-     (ast->type info `("tag" ,name)))
+     (ast-><type> `(tag ,name) info))
     ((struct-def (field-list . ,fields))
      (let ((fields (append-map (struct-field info) fields)))
-       (make-type 'struct (apply + (map field:size fields)) 0 fields)))
+       (make-type 'struct (apply + (map field:size fields)) fields)))
     ((union-def (field-list . ,fields))
      (let ((fields (append-map (struct-field info) fields)))
-       (make-type 'union (apply + (map field:size fields)) 0 fields)))
-    ((void) (ast->type info "void"))
-    ((fixed-type ,type) (ast->type info type))
-    ((float-type ,type) (ast->type info type))
-    ((typename ,type) (ast->type info type))
-    ((de-ref ,expr)
-     (ast->type info expr))
+       (make-type 'union (apply + (map field:size fields)) fields)))
+
+
+
     ((d-sel (ident ,field) ,struct)
-     (let ((type0 (ast->type info struct)))
-       (ast->type info (field-type info type0 field))))
+     (let ((type0 (ast-><type> struct info)))
+       (ast-><type> (field-type info type0 field) info)))
     ((i-sel (ident ,field) ,struct)
-     (let ((type0 (ast->type info struct)))
-       (ast->type info (field-type info type0 field))))
-    ((ref-to ,expr) (ast->type info expr))
-    ((pre-inc ,a) (ast->type info a))
-    ((pre-dec ,a) (ast->type info a))
-    ((post-inc ,a) (ast->type info a))
-    ((post-dec ,a) (ast->type info a))
-    ((add ,a ,b) (ast->type info a))
-    ((sub ,a ,b) (ast->type info a))
-    ((bitwise-and ,a ,b) (ast->type info a))
-    ((bitwise-not ,a) (ast->type info a))
-    ((bitwise-or ,a ,b) (ast->type info a))
-    ((bitwise-xor ,a ,b) (ast->type info a))
-    ((lshift ,a ,b) (ast->type info a))
-    ((rshift ,a ,b) (ast->type info a))
-    ((div ,a ,b) (ast->type info a))
-    ((mod ,a ,b) (ast->type info a))
-    ((mul ,a ,b) (ast->type info a))
-    ((not ,a) (ast->type info a))
-    ((neg ,a) (ast->type info a))
-    ((eq ,a ,b) (ast->type info a))
-    ((ge ,a ,b) (ast->type info a))
-    ((gt ,a ,b) (ast->type info a))
-    ((ne ,a ,b) (ast->type info a))
-    ((le ,a ,b) (ast->type info a))
-    ((lt ,a ,b) (ast->type info a))
-    ((or ,a ,b) (ast->type info a))
-    ((and ,a ,b) (ast->type info a))
+     (let ((type0 (ast-><type> struct info)))
+       (ast-><type> (field-type info type0 field) info)))
+
+    ;; arithmetic
+    ((pre-inc ,a) (ast-><type> a info))
+    ((pre-dec ,a) (ast-><type> a info))
+    ((post-inc ,a) (ast-><type> a info))
+    ((post-dec ,a) (ast-><type> a info))
+    ((add ,a ,b) (ast-><type> a info))
+    ((sub ,a ,b) (ast-><type> a info))
+    ((bitwise-and ,a ,b) (ast-><type> a info))
+    ((bitwise-not ,a) (ast-><type> a info))
+    ((bitwise-or ,a ,b) (ast-><type> a info))
+    ((bitwise-xor ,a ,b) (ast-><type> a info))
+    ((lshift ,a ,b) (ast-><type> a info))
+    ((rshift ,a ,b) (ast-><type> a info))
+    ((div ,a ,b) (ast-><type> a info))
+    ((mod ,a ,b) (ast-><type> a info))
+    ((mul ,a ,b) (ast-><type> a info))
+    ((not ,a) (ast-><type> a info))
+    ((neg ,a) (ast-><type> a info))
+    ((eq ,a ,b) (ast-><type> a info))
+    ((ge ,a ,b) (ast-><type> a info))
+    ((gt ,a ,b) (ast-><type> a info))
+    ((ne ,a ,b) (ast-><type> a info))
+    ((le ,a ,b) (ast-><type> a info))
+    ((lt ,a ,b) (ast-><type> a info))
+
+    ;; logical
+    ((or ,a ,b) (ast-><type> a info))
+    ((and ,a ,b) (ast-><type> a info))
+
+
     ((cast (type-name ,type) ,expr)     ; FIXME: ignore expr?
-     (ast->type info type))
+     (ast-><type> type info))
     ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: ignore expr?
-     (ast->type info type))
+     (ast-><type> type info))
+
     ((decl-spec-list (type-spec ,type))
-     (ast->type info type))
+     (ast-><type> type info))
     ((assn-expr ,a ,op ,b)
-     (ast->type info a))
-    ((enum-ref . _) (get-type "int"))
-    ((sizeof-type . _) (get-type "int"))
-    ((sizeof-expr . _) (get-type "int"))
-    ((string _) (get-type "char"))
-    ((fctn-call (p-expr (ident ,function)) . ,rest)
-     (or (and=> (assoc-ref (.functions info) function) function:type)
-         (begin
-           (stderr "ast->type: no such function: ~s\n" function)
-           (get-type "int"))))
-    (_ (let ((type (get-type o)))
+     (ast-><type> a info))
+
+
+    (_ (let ((type (get-type o info)))
          (cond ((type? type) type)
-               ((and (pair? type) (equal? (car type) "tag"))
+               ((and (pair? type) (eq? (car type) 'tag))
                 (stderr "NO STRUCT YET:~s\n" (.types info))
                 type)
-               ((and (pair? o) (equal? (car o) "tag"))
+               ((and (pair? o) (eq? (car o) 'tag))
                 (stderr "NO STRUCT YET:~s\n" (.types info))
                 o)
                (else
@@ -308,11 +331,7 @@
   ((compose type:description (cut ast->type info <>) o)))
 
 (define (ast-type->size info o)
-  ;;((compose type:size (cut ast->type info <>)) o)
-  (let ((type (if (type? o) o
-                  (ast->type info o))))
-    (if (not (type? type)) (error "ast-type->size: no such type:" o)
-        (type:size type))))
+  ((compose type:size -><type> (cut ast->type info <>)) o))
 
 (define (field-field info struct field)
   (let* ((xtype (if (type? struct) struct
@@ -395,21 +414,23 @@
   (let ((var (ident->variable info o)))
     (cond ((global? var) (global:type var))
           ((local? var) (local:type var))
+          ((function? var) (function:type var))
           ((assoc-ref (.constants info) o) (assoc-ref (.types info) "int"))
           ((pair? var) (car var))
           (else (stderr "ident->type ~s => ~s\n" o var)
                 #f))))
 
-(define (ident->pointer info o)
+(define (ident->rank info o)
   (let ((local (assoc-ref (.locals info) o)))
-    (if local (let* ((t ((compose type:pointer local:type) local))
+    (if local (let* ((t 0 ;; <pointer> ((compose type:pointer local:type) local)
+                        )
                      (v (local:pointer local))
                      (p (+ (abs t) (abs v))))
                 (if (or (< t 0) (< v 0)) (- p) p))
         (let ((global (assoc-ref (.globals info) o)))
           (if global
-              (let* ((t ((compose type:pointer global:type) global))
-                     ;;(global:pointer (ident->variable info o))
+              (let* ((t 0 ;; <pointer> ((compose type:pointer global:type) global)
+                        )
                      (v (global:pointer global))
                      (p (+ (abs t) (abs v))))
                 (if (or (< t 0) (< v 0)) (- p) p))
@@ -431,28 +452,28 @@
     ((pointer) 1)
     ((pointer ,pointer) (1+ (pointer->ptr pointer)))))
 
-(define (expr->pointer info o)
+(define (expr->rank info o)
   (pmatch o
     ((pointer . _) (pointer->ptr o))
     ((p-expr (char ,value)) 0)
     ((p-expr (fixed ,value)) 0)
-    ((ident ,name) (ident->pointer info name))
-    ((p-expr ,expr) (expr->pointer info expr))
-    ((de-ref ,expr) (ptr-dec (expr->pointer info expr)))
-    ((assn-expr ,lhs ,op ,rhs) (expr->pointer info lhs))
-    ((add ,a ,b) (expr->pointer info a))
-    ((div ,a ,b) (expr->pointer info a))
-    ((mod ,a ,b) (expr->pointer info a))
-    ((mul ,a ,b) (expr->pointer info a))
-    ((sub ,a ,b) (expr->pointer info a))
-    ((neg ,a) (expr->pointer info a))
-    ((pre-inc ,a) (expr->pointer info a))
-    ((pre-dec ,a) (expr->pointer info a))
-    ((post-inc ,a) (expr->pointer info a))
-    ((post-dec ,a) (expr->pointer info a))
-    ((ref-to ,expr) (ptr-inc (expr->pointer info expr)))
+    ((ident ,name) (ident->rank info name))
+    ((p-expr ,expr) (expr->rank info expr))
+    ((de-ref ,expr) (ptr-dec (expr->rank info expr)))
+    ((assn-expr ,lhs ,op ,rhs) (expr->rank info lhs))
+    ((add ,a ,b) (expr->rank info a))
+    ((div ,a ,b) (expr->rank info a))
+    ((mod ,a ,b) (expr->rank info a))
+    ((mul ,a ,b) (expr->rank info a))
+    ((sub ,a ,b) (expr->rank info a))
+    ((neg ,a) (expr->rank info a))
+    ((pre-inc ,a) (expr->rank info a))
+    ((pre-dec ,a) (expr->rank info a))
+    ((post-inc ,a) (expr->rank info a))
+    ((post-dec ,a) (expr->rank info a))
+    ((ref-to ,expr) (ptr-inc (expr->rank info expr)))
     ((array-ref ,index ,array)
-     (ptr-dec (abs (expr->pointer info array))))
+     (ptr-dec (abs (expr->rank info array))))
 
     ((d-sel (ident ,field) ,struct)
      (let ((type (ast->type info struct)))
@@ -463,53 +484,52 @@
        (field-pointer info type field)))
 
     ((cast (type-name ,type) ,expr)     ; FIXME: add expr?
-     (let* ((type (ast->type info type))
-            (pointer (type:pointer type)))
-       pointer))
+     (let* ((type (ast->type info type)))
+       (->rank type)))
     ((cast (type-name ,type (abs-declr ,pointer)) ,expr) ; FIXME: add expr?
      (let* ((type (ast->type info type))
-            (pointer0 (type:pointer type))
-            (pointer1 (ptr-declr->pointer pointer))
-            (pointer2 (expr->pointer info expr)))
+            (pointer0 (->rank type))
+            (pointer1 (ptr-declr->rank pointer))
+            (pointer2 (expr->rank info expr)))
        (+ pointer0 pointer1)))
     ((type-spec ,type)
-     (or (and=> (ast->type info o) type:pointer)
+     (or (and=> (ast->type info o) ->rank)
          (begin
-           (stderr "expr->pointer: not supported: ~a\n" o)
+           (stderr "expr->rank: not supported: ~a\n" o)
            0)))
     ((fctn-call (p-expr (ident ,function)) . ,rest)
      (or (and=> (and=> (assoc-ref (.functions info) function) function:type)
                 (lambda (t)
-                  (and (type? t) (type:pointer t))))
+                  (and (type? t) 0 (->rank t))))
          (begin
-           (stderr "expr->pointer: no such function: ~a\n" function)
+           (stderr "expr->rank: no such function: ~a\n" function)
            0)))
 
     ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr ,pointer ,init) . ,initzer)))
-     (let* ((t (expr->pointer info `(type-spec ,type)))
-            (i (expr->pointer info init))
-            (p (expr->pointer info pointer))
+     (let* ((t (expr->rank info `(type-spec ,type)))
+            (i (expr->rank info init))
+            (p (expr->rank info pointer))
             (e (+ (abs t) (abs i) (abs p))))
        (if (or (< t 0) (< i 0)) (- e) e)))
     ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
-     (let* ((t (expr->pointer info `(type-spec ,type)))
-            (i  (expr->pointer info init))
+     (let* ((t (expr->rank info `(type-spec ,type)))
+            (i  (expr->rank info init))
             (p (+ (abs t) (abs i))))
        (if (or (< t 0) (< i 0)) (- p) p)))
     ((ptr-declr ,pointer (array-of ,array . ,rest))
-     (let* ((p (expr->pointer info pointer))
-            (a (expr->pointer info array))
+     (let* ((p (expr->rank info pointer))
+            (a (expr->rank info array))
             (t (+ (abs p) (abs a) 2)))
        (- t)))
     ((ptr-declr ,pointer . ,rest)
-     (expr->pointer info pointer))
+     (expr->rank info pointer))
     ((array-of ,array . ,rest)
-     (let ((a (abs (expr->pointer info array))))
+     (let ((a (abs (expr->rank info array))))
        (- (+ a 1))))
-    (_ (stderr "expr->pointer: not supported: ~s\n" o) 0)))
+    (_ (stderr "expr->rank: not supported: ~s\n" o) 0)))
 
 (define (expr->size info o)
-  (let ((ptr (expr->pointer info o)))
+  (let ((ptr (expr->rank info o)))
     (if (or (= ptr -1)
             (= ptr 0))
         (ast-type->size info o)
@@ -520,7 +540,7 @@
 
 (define (push-global info)
   (lambda (o)
-    (let ((ptr (ident->pointer info o)))
+    (let ((ptr (ident->rank info o)))
       (cond ((< ptr 0) (list (i386:push-label `(#:address ,o))))
             (else (list (i386:push-label-mem `(#:address ,o))))))))
 
@@ -560,15 +580,15 @@
           (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
           (error "TODO int-de-de-ref")))))
 
-(define (make-global-entry key type pointer array value)
-  (cons key (make-global key type pointer array value #f)))
+(define (make-global-entry name type pointer array value)
+  (cons name (make-global name type pointer array value #f)))
 
 (define (string->global-entry string)
   (let ((value (append (string->list string) (list #\nul))))
    (make-global-entry `(#:string ,string) "char" 0 (length value) value)))
 
 (define (make-local-entry name type pointer array id)
-  (cons name (make-local type pointer array id)))
+  (cons name (make-local name type pointer array id)))
 
 (define* (mescc:trace name #:optional (type ""))
   (format (current-error-port) "    :~a~a\n" name type))
@@ -644,13 +664,13 @@
           ((assoc-ref (.statics info) o)
            =>
            (lambda (global)
-             (let* ((ptr (ident->pointer info o)))
+             (let* ((ptr (ident->rank info o)))
                (cond ((< ptr 0) (list (i386:label->accu `(#:address ,global))))
                      (else (list (i386:label-mem->accu `(#:address ,global))))))))
           ((assoc-ref (.globals info) o)
            =>
            (lambda (global)
-             (let* ((ptr (ident->pointer info o)))
+             (let* ((ptr (ident->rank info o)))
                (cond ((< ptr 0) (list (i386:label->accu `(#:address ,o))))
                      (else (list (i386:label-mem->accu `(#:address ,o))))))))
           ((assoc-ref (.constants info) o)
@@ -865,7 +885,7 @@
 
     ((array-ref ,index ,array)
      (let* ((info (expr->accu index info))
-            (ptr (expr->pointer info array))
+            (ptr (expr->rank info array))
             (size (expr->size info o))
             (info (accu*n info size))
             (info (expr->base array info)))
@@ -940,7 +960,7 @@
          (append-text info (wrap-as (i386:value->accu size)))))
 
       ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,type))))))
-       (let* ((type `("tag" ,type))
+       (let* ((type `(tag ,type))
               (size (ast-type->size info type)))
          (append-text info (wrap-as (i386:value->accu size)))))
 
@@ -964,7 +984,7 @@
       ((d-sel ,field ,struct)
        (let* ((info (expr->accu* o info))
               (info (append-text info (ast->comment o)))
-              (ptr (expr->pointer info o))
+              (ptr (expr->rank info o))
               (size (if (= ptr 0) (ast-type->size info o)
                         4)))
          (if (or (= -2 ptr) (= -1 ptr)) info
@@ -977,7 +997,7 @@
       ((i-sel ,field ,struct)
        (let* ((info (expr->accu* o info))
               (info (append-text info (ast->comment o)))
-              (ptr (expr->pointer info o))
+              (ptr (expr->rank info o))
               (size (if (= ptr 0) (ast-type->size info o)
                         4)))
          (if (or (= -2 ptr) (= ptr -1)) info
@@ -1033,7 +1053,7 @@
       ((post-inc ,expr)
        (let* ((info (append (expr->accu expr info)))
               (info (append-text info (wrap-as (i386:push-accu))))
-              (ptr (expr->pointer info expr))
+              (ptr (expr->rank info expr))
               (size (cond ((= ptr 1) (ast-type->size info expr))
                           ((> ptr 1) 4)
                           (else 1)))
@@ -1044,7 +1064,7 @@
       ((post-dec ,expr)
        (let* ((info (append (expr->accu expr info)))
               (info (append-text info (wrap-as (i386:push-accu))))
-              (ptr (expr->pointer info expr))
+              (ptr (expr->rank info expr))
               (size (cond ((= ptr 1) (ast-type->size info expr))
                           ((> ptr 1) 4)
                           (else 1)))
@@ -1053,7 +1073,7 @@
          info))
 
       ((pre-inc ,expr)
-       (let* ((ptr (expr->pointer info expr))
+       (let* ((ptr (expr->rank info expr))
               (size (cond ((= ptr 1) (ast-type->size info expr))
                           ((> ptr 1) 4)
                           (else 1)))
@@ -1062,7 +1082,7 @@
          info))
 
       ((pre-dec ,expr)
-       (let* ((ptr (expr->pointer info expr))
+       (let* ((ptr (expr->rank info expr))
               (size (cond ((= ptr 1) (ast-type->size info expr))
                           ((> ptr 1) 4)
                           (else 1)))
@@ -1073,10 +1093,9 @@
 
 
       ((add ,a (p-expr (fixed ,value)))
-       (let* ((ptr (expr->pointer info a))
+       (let* ((ptr (expr->rank info a))
               (type (ast->type info a))
-              (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                           (memq (type:type type) '(struct union))))
+              (struct? (structured-type? type))
               (size (cond ((= ptr 1) (ast-type->size info a))
                           ((> ptr 1) 4)
                           ((and struct? (= ptr -2)) 4)
@@ -1088,11 +1107,10 @@
          (append-text info (wrap-as (i386:accu+value value)))))
 
       ((add ,a ,b)
-       (let* ((ptr (expr->pointer info a))
-              (ptr-b (expr->pointer info b))
+       (let* ((ptr (expr->rank info a))
+              (ptr-b (expr->rank info b))
               (type (ast->type info a))
-              (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                           (memq (type:type type) '(struct union))))
+              (struct? (structured-type? type))
               (size (cond ((= ptr 1) (ast-type->size info a))
                           ((> ptr 1) 4)
                           ((and struct? (= ptr -2)) 4)
@@ -1107,10 +1125,9 @@
                (append-text info (wrap-as (i386:accu+base)))))))
 
       ((sub ,a (p-expr (fixed ,value)))
-       (let* ((ptr (expr->pointer info a))
+       (let* ((ptr (expr->rank info a))
               (type (ast->type info a))
-              (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                           (memq (type:type type) '(struct union))))
+              (struct? (structured-type? type))
               (size (cond ((= ptr 1) (ast-type->size info a))
                           ((> ptr 1) 4)
                           ((and struct? (= ptr -2)) 4)
@@ -1122,11 +1139,10 @@
          (append-text info (wrap-as (i386:accu+value (- value))))))
 
       ((sub ,a ,b)
-       (let* ((ptr (expr->pointer info a))
-              (ptr-b (expr->pointer info b))
+       (let* ((ptr (expr->rank info a))
+              (ptr-b (expr->rank info b))
               (type (ast->type info a))
-              (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                           (memq (type:type type) '(struct union))))
+              (struct? (structured-type? type))
               (size  (cond ((= ptr 1) (ast-type->size info a))
                            ((> ptr 1) 4)
                            ((and struct? (= ptr -2)) 4)
@@ -1215,30 +1231,29 @@
       ((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
        (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
               (type (ident->type info name))
-              (ptr (ident->pointer info name))
+              (ptr (ident->rank info name))
               (size (if (> ptr 1) 4 1)))
          (append-text info ((ident-add info) name size))))
 
       ((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
        (let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
               (type (ident->type info name))
-              (ptr (ident->pointer info name))
+              (ptr (ident->rank info name))
               (size (if (> ptr 1) 4 1)))
          (append-text info ((ident-add info) name (- size)))))
 
       ((assn-expr ,a (op ,op) ,b)
        (let* ((info (append-text info (ast->comment o)))
-              (ptr-a (expr->pointer info a))
-              (ptr-b (expr->pointer info b))
+              (ptr-a (expr->rank info a))
+              (ptr-b (expr->rank info b))
               (size-a (expr->size info a))
               (size-b (expr->size info b))
               (info (expr->accu b info))
               (info (if (equal? op "=") info
-                        (let* ((ptr (expr->pointer info a))
-                               (ptr-b (expr->pointer info b))
+                        (let* ((ptr (expr->rank info a))
+                               (ptr-b (expr->rank info b))
                                (type (ast->type info a))
-                               (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                                            (memq (type:type type) '(struct union))))
+                               (struct? (structured-type? type))
                                (size (cond ((= ptr 1) (ast-type->size info a))
                                            ((> ptr 1) 4)
                                            ((and struct? (= ptr -2)) 4)
@@ -1402,14 +1417,14 @@
               (info (append-text info (wrap-as `((#:label ,skip-b-label))))))
          info))
 
-      ((array-ref ,index ,expr) (let* ((ptr (expr->pointer info expr))
+      ((array-ref ,index ,expr) (let* ((ptr (expr->rank info expr))
                                        (size (if (= ptr 1) (ast-type->size info expr)
                                                  4)))
                                   ((jump (if (= size 1) i386:jump-byte-z
                                              i386:jump-z)
                                          (wrap-as (i386:accu-zero?))) o)))
 
-      ((de-ref ,expr) (let* ((ptr (expr->pointer info expr))
+      ((de-ref ,expr) (let* ((ptr (expr->rank info expr))
                              (size (if (= ptr 1) (ast-type->size info expr)
                                        4)))
                         ((jump (if (= size 1) i386:jump-byte-z
@@ -1486,7 +1501,7 @@
     (pmatch o
       ((comp-decl (decl-spec-list (type-spec (enum-ref (ident ,type))))
                   (comp-declr-list (comp-declr (ident ,name))))
-       (list (list name `("tag" ,type) 4 0)))
+       (list (list name `(tag ,type) 4 0)))
       ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ident ,name))))
        (list (list name type (ast-type->size info type) 0)))
       ((comp-decl (decl-spec-list (type-spec (typename ,type))) (comp-declr-list (comp-declr (ident ,name))))
@@ -1522,21 +1537,21 @@
          (list (list name type (* count size) -1))))      
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
-       (list (list name `("tag" ,type) 4 2)))
+       (list (list name `(tag ,type) 4 2)))
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name)))))
-       (list (list name `("tag" ,type) 4 1)))
+       (list (list name `(tag ,type) 4 1)))
 
       ((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
-       (let ((size (ast-type->size info `("tag" ,type))))
-         (list (list name `("tag" ,type) size 0))))
+       (let ((size (ast-type->size info `(tag ,type))))
+         (list (list name `(tag ,type) size 0))))
 
       ((comp-decl (decl-spec-list (type-spec (struct-def (field-list . ,fields)))))
        (list `(struct ,@(append-map (struct-field info) fields))))
 
       ((comp-decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
-       (let ((size (ast-type->size info `("tag" ,type))))
-         (list (list name `("tag" ,type) size 0))))
+       (let ((size (ast-type->size info `(tag ,type))))
+         (list (list name `(tag ,type) size 0))))
 
       ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
        (list `(union ,@(append-map (struct-field info) fields))))
@@ -1552,12 +1567,12 @@
 (define (local-var? o) ;; formals < 0, locals > 0
   (positive? (local:id o)))
 
-(define (ptr-declr->pointer o)
+(define (ptr-declr->rank o)
   (pmatch o
     ((pointer) 1)
     ((pointer (pointer)) 2)
     ((pointer (pointer (pointer))) 3)
-    (_ (error "ptr-declr->pointer not supported: " o))))
+    (_ (error "ptr-declr->rank not supported: " o))))
 
 (define (statements->clauses statements)
   (let loop ((statements statements) (clauses '()))
@@ -1829,14 +1844,14 @@
 (define (decl->info info o)
   (pmatch o
     (((decl-spec-list (type-spec ,type)) (init-declr-list . ,inits))
-     (let* ((info (type->info info type))
+     (let* ((info (type->info type #f info))
             (type (ast->type info type))
             (pointer 0))                ; FIXME
        (fold (cut init-declr->info type pointer <> <>) info (map cdr inits))))
     (((decl-spec-list (type-spec ,type)))
-     (type->info info type))
+     (type->info type #f info))
     (((decl-spec-list (stor-spec (typedef)) (type-spec ,type)) (init-declr-list (init-declr (ident ,name))))
-     (let* ((info (type->info info type))
+     (let* ((info (type->info type name info))
             (type (ast->type info type)))
        (clone info #:types (acons name type (.types info)))))
     (((decl-spec-list (stor-spec (,store)) (type-spec ,type)) (init-declr-list . ,inits))
@@ -1920,9 +1935,7 @@
     ((initzer-list ,init)
      (init-local local init n info))
     ((initzer-list . ,inits)
-     (let* ((type ((compose type:type local:type) local))
-            (struct? (or (and (pair? type) (equal? (car type) "tag"))
-                         (memq type '(struct union)))))
+     (let ((struct? (pke 'struct? local '=> (structured-type? local))))
        (cond (struct?
               (let ((fields ((compose struct->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)))))))))
@@ -1940,10 +1953,7 @@
          (local (make-local-entry name type pointer array id))
          (struct? (and (or (zero? pointer)
                            (= -1 pointer))
-                       (or (and (pair? type)
-                                (equal? (car type) "tag"))
-                           (and (type? type)
-                                (memq (type:type type) '(struct union))))))
+                       (structured-type? type)))
          (size (or (and (zero? pointer) (type? type) (type:size type))
                    (and struct? (and=> (ast->type info type) struct:size))
                    4))
@@ -2008,8 +2018,7 @@
             (info (if (null? strings) info
                       (clone info #:globals (append (.globals info) strings))))
             (struct? (and (zero? pointer)
-                          (or (and (pair? type) (equal? (car type) "tag"))
-                              (memq (type:type type) '(struct union)))))
+                          (structured-type? type)))
             (pointer (if struct? (- (1+ (abs pointer))) pointer)))
        (if (.function info) (local->info type pointer #f name o init info)
            (global->info type pointer #f name o init info))))
@@ -2118,8 +2127,9 @@
        (append-map (cut init->strings <> info) init))
       (_ '()))))
 
-(define (type->info info o)
+(define (type->info o name info)
   (pmatch o
+
     ((enum-def (ident ,name) (enum-def-list . ,fields))
      (mescc:trace name " <t>")
      (let* ((type-entry (enum->type-entry name fields))
@@ -2127,21 +2137,45 @@
        (clone info
               #:types (cons type-entry (.types info))
               #:constants (append constants (.constants info)))))
+
+    ((enum-def (enum-def-list . ,fields))
+     (mescc:trace name " <t>")
+     (let* ((type-entry (enum->type-entry name fields))
+            (constants (enum-def-list->constants (.constants info) fields)))
+       (clone info
+              #:types (cons type-entry (.types info))
+              #:constants (append constants (.constants info)))))
+
+    ((struct-def (field-list . ,fields))
+     (mescc:trace name " <t>")
+     (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
+       (clone info #:types (cons type-entry (.types info)))))
+
     ((struct-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
      (let ((type-entry (struct->type-entry name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
-    ((struct-ref . _)
-     info)
+
     ((union-def (ident ,name) (field-list . ,fields))
      (mescc:trace name " <t>")
      (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
        (clone info #:types (cons type-entry (.types info)))))
-    ((union-ref . _)
-     info)
-    (_ 
+
+    ((union-def (field-list . ,fields))
+     (mescc:trace name " <t>")
+     (let ((type-entry (union->type-entry name (append-map (struct-field info) fields))))
+       (clone info #:types (cons type-entry (.types info)))))
+
+    ((struct-ref . _) info)
+    ((typename ,name) info)
+    ((union-ref . _) info)
+    ((fixed-type . _) info)
+    ((void) info)
+
+    (_ ;;(error "type->info: not supported:" o)
      (stderr "type->info: not supported: ~s\n" o)
-     info)))
+     info
+     )))
 
 ;;; fctn-defn
 (define (param-decl:get-name o)
@@ -2215,12 +2249,10 @@
 (define (fctn-defn:get-type info o)
   (pmatch o
     (((decl-spec-list (type-spec ,type)) (ptr-declr ,pointer . _) ,statement)
-     (let ((type (ast->type info type))
-           (pointer (ptr-declr->pointer pointer)))
-       (make-type (type:type type)
-                  (type:size type)
-                  (+ (type:pointer type) pointer)
-                  (type:description type))))
+     (let* ((type (ast->type info type))
+            (rank (ptr-declr->rank pointer)))
+       (if (zero? rank) type
+           (make-pointer type rank))))
     (((decl-spec-list (type-spec ,type)) . ,rest)
      (ast->type info type))
     (((decl-spec-list (stor-spec ,store) (type-spec ,type)) (ftn-declr (ident _) _) _)
diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm
index 69bacbcf..5ac44718 100644
--- a/module/language/c99/info.scm
+++ b/module/language/c99/info.scm
@@ -51,13 +51,32 @@
             type:pointer
             type:description
 
+            <c-array>
+            make-c-array
+            c-array?
+            c-array:type
+            c-array:count
+
+            <pointer>
+            make-pointer
+            pointer?
+            pointer:type
+            pointer:rank
+
+            <var>
+            var:name
+            var:type
+            var:pointer
+            var:c-array
+
             <global>
             make-global
             global?
             global:name
             global:type
             global:pointer
-            global:array
+            global:c-array
+            global:var
             global:value
             global:function
             global->string
@@ -67,7 +86,8 @@
             local?
             local:type
             local:pointer
-            local:array
+            local:c-array
+            local:var
             local:id
 
             <function>
@@ -75,7 +95,13 @@
             function?
             function:name
             function:type
-            function:text))
+            function:text
+
+            -><type>
+            ->rank
+            rank--
+            rank++
+            structured-type?))
 
 (cond-expand
  (guile-2)
@@ -102,35 +128,69 @@
 (define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (break '()) (continue '()))
   (make-<info> types constants functions globals locals statics function text break continue))
 
+;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
+;;           (make-type 'enum 4 0 fields)
+;;           (make-type 'struct (apply + (map field:size fields)) 0 fields)
+
 (define-immutable-record-type <type>
-  (make-type type size pointer description)
+  (make-type type size description)
   type?
   (type type:type)
   (size type:size)
-  (pointer type:pointer)
   (description type:description))
 
+(define-immutable-record-type <c-array>
+  (make-c-array type count)
+  c-array?
+  (type c-array:type)
+  (count c-array:count))
+
+(define-immutable-record-type <pointer>
+  (make-pointer type rank)
+  pointer?
+  (type pointer:type)
+  (rank pointer:rank))
+
+(define-immutable-record-type <var>
+  (make-var name type function id value)
+  var?
+  (name var:name)
+  (type var:type)                       ; <type>
+  (function var:function)
+  (id var:id)
+  (value var:value))
+
 (define-immutable-record-type <global>
-  (make-global name type pointer array value function)
+  (make-global- name type var pointer c-array value function)
   global?
   (name global:name)
   (type global:type)
+  (var global:var)                      ; <var>
+
   (pointer global:pointer)
-  (array global:array)
+  (c-array global:c-array)
   (value global:value)
   (function global:function))
 
+(define (make-global name type pointer c-array value function)
+  (make-global- name type (make-var name type function #f value) pointer c-array value function))
+
 (define (global->string o)
   (or (and=> (global:function o) (cut string-append <> "-" (global:name o)))
       (global:name o)))
 
 (define-immutable-record-type <local>
-  (make-local type pointer array id)
+  (make-local- type var id pointer c-array)
   local?
   (type local:type)
+  (var local:var)                       ; <var>
+
+  (id local:id)
   (pointer local:pointer)
-  (array local:array)
-  (id local:id))
+  (c-array local:c-array))
+
+(define (make-local name type pointer c-array id)
+  (make-local- type (make-var name type #f id #f) id pointer c-array))
 
 (define-immutable-record-type <function>
   (make-function name type text)
@@ -138,3 +198,43 @@
   (name function:name)
   (type function:type)
   (text function:text))
+
+(define (structured-type? o)
+  (cond ((type? o) (memq (type:type o) '(struct union)))
+        ((global? o) ((compose structured-type? global:type) o))
+        ((local? o) ((compose structured-type? local:type) o))
+        ((and (pair? o) (eq? (car o) 'tag))) ;; FIXME: enum?
+        (else #f)))
+
+(define (-><type> o)
+  (cond ((type? o) o)
+        ((pointer? o) (pointer:type o))
+        ((c-array? o) (c-array:type o))
+        ((and (pair? o) (eq? (car o) 'tag)) o)
+        ;; FIXME
+        (#t
+         (format (current-error-port) "->type--: not a <type>: ~s\n" o)
+         (make-type 'builtin 4 #f))
+        (else (error "-><type>: not a <type>:" o))))
+
+(define (->rank o)
+  (cond ((type? o) 0)
+        ((pointer? o) (pointer:rank o))
+        ((c-array? o) ((compose ->rank c-array:type) o))
+        ;; FIXME
+        (#t
+         (format (current-error-port) "->rank--: not a type: ~s\n" o)
+         0)
+        (else (error "->rank: not a <type>:" o))))
+
+(define (rank-- o)
+  (cond ((and (pointer? o) (zero? (pointer:rank o))) (pointer:type o))
+        ((pointer? o) (set-field o (pointer:rank) (1- (pointer:rank o))))
+        ;; FIXME
+        (#t (format (current-error-port) "rank--: not a pointer: ~s\n" o)
+              o)
+        (else (error "rank--: not a pointer" o))))
+
+(define (rank++ o)
+  (cond ((pointer? o) (set-field o (pointer:rank) (1+ (pointer:rank o))))
+        (else (make-pointer o 1))))
diff --git a/scaffold/tests/t.c b/scaffold/tests/t.c
index fe6bf40a..1324e375 100644
--- a/scaffold/tests/t.c
+++ b/scaffold/tests/t.c
@@ -86,25 +86,25 @@ main (int argc, char* argv[])
     return 17;
   struct foo g = {4, "baar"};
   if (g.length != 4)
-    return 16;
-  if (strcmp (g.string, "baar"))
     return 18;
+  if (strcmp (g.string, "baar"))
+    return 19;
   struct foo f = {3, "foo"};
   g_foes[0] = f;
   g_foes[1] = f;
   if (g_foe)
-    return 19;
+    return 20;
   char *strings[] = { "one\n", "two\n", "three\n", 0 };
   char **p = strings;
   while (*p) puts (*p++);
   if (strcmp (strings[1], "two\n"))
-    return 20;
+    return 21;
   p = list;
   struct anon a = {3,4};
   eputs ("bar:"); eputs (itoa (a.bar)); eputs ("\n");
   eputs ("baz:"); eputs (itoa (a.baz)); eputs ("\n");
-  if (a.bar != 3) return 1;
-  if (a.baz != 4) return 2;
+  if (a.bar != 3) return 22;
+  if (a.baz != 4) return 23;
 
   i = 1;
   int lst[6] = {-1, 1 - 1, i, 2, 3};
@@ -112,7 +112,7 @@ main (int argc, char* argv[])
     {
       puts ("i: "); puts (itoa (lst[i])); puts ("\n");
       if (lst[i+1] != i)
-        return i;
+        return 30 + i;
     }
 
   return 0;