separate tags and typedefs

C has two namespaces and the database had one. A typedef of a tag's
name wiped it.

Tags, i.e. struct, enum and union, share one namespace; they move to a
table of their own. A name resolves the way C does: the ordinary
identifier first, the tag when that leads nowhere.

While resolving a typedef, the target was taken apart with cadr
whatever it was, so (typedef points (¤ point 4)) reported point's
fields as its own -- an array of four points claiming to be a point,
and a macro reaching through it with v->x. Only a name and
(struct|union|enum NAME) name a type now.

sex-macros.scm

@@ -26,8 +26,8 @@
            (import scheme
                    (scheme base)
                    (only sex-macros cat comment)
-                   (only types get-type-info get-fields get-underlying-type
+                   (only types get-type-info get-tag-info get-fields
-                         type-match map-fields))
+                         get-underlying-type type-match map-fields))
            ,@body)))
 
 (define (get-macro name)

tests/types.module.scm

@@ -9,6 +9,7 @@
      map-fields
 
      get-type-info
+     get-tag-info
      get-fields
      get-underlying-type)
   "../types.scm")

tests/types.scm

@@ -79,6 +79,38 @@
         #f
         (get-fields 't-u8))
 
+  ;; C keeps typedefs and ordinary identifiers apart, and the canonical way
+  ;; to declare a struct uses both names at once. Neither declaration
+  ;; may stand on the other.
+  (add-struct 't-node '(struct t-node ((next (* t-node)) (v int))))
+  (add-typedef 't-node '(typedef t-node (struct t-node)))
+  (test "a typedef of a struct's own name keeps the struct reachable"
+        '((next (* t-node)) (v int))
+        (get-fields 't-node))
+  (test "and the tag is there under its own name"
+        '(struct t-node ((next (* t-node)) (v int)))
+        (get-tag-info 't-node))
+  (add-struct 't-rect '(struct t-rect ((w int) (h int))))
+  (add-define 't-rect '(define t-rect 3))
+  (test "a define of a tag's name does not hide the fields"
+        '((w int) (h int))
+        (get-fields 't-rect))
+
+  ;; A type built over a struct is not that struct. Handing back the
+  ;; element's fields would have a macro write v->x for an array
+  (add-typedef 't-points '(typedef t-points (¤ t-point 4)))
+  (test "an array of a struct has no fields of its own"
+        #f
+        (get-fields 't-points))
+  (add-typedef 't-point-p '(typedef t-point-p (* t-point)))
+  (test "nor does a pointer to one"
+        #f
+        (get-fields 't-point-p))
+  (add-typedef 't-cb '(typedef t-cb (fn ((t-point)) void)))
+  (test "nor a function type over one"
+        #f
+        (get-fields 't-cb))
+
   ;; A typedef can be written to lead back to itself. Resolving it must
   ;; stop rather than spin
   (add-typedef 't-loop-a '(typedef t-loop-a t-loop-b))

types.module.scm

@@ -9,6 +9,7 @@
      map-fields
 
      get-type-info
+     get-tag-info
      get-fields
      get-underlying-type)
     "types.scm")

types.scm

@@ -15,7 +15,11 @@
   srfi-1
   srfi-69)
 
-(define +type-db+ (make-hash-table))
+;;; Two namespaces: `struct point' and a `point' typedef are separate
+;;; declarations. Tags -- struct, union and enum alike -- share the
+;;; second table between them
+(define +type-db+ (make-hash-table))    ; typedefs and defines
+(define +tag-db+ (make-hash-table))     ; struct, union and enums
 
 (define (strip-pub form)
   (if (eq? (car form) 'pub) (cdr form) form))
@@ -44,17 +48,17 @@
         (list))))
 
 (define (add-struct name form)
-  (hash-table-set! +type-db+ name
+  (hash-table-set! +tag-db+ name
                    (list 'struct name (normalize-fields (aggregate-fields form)))))
 
 (define (add-union name form)
-  (hash-table-set! +type-db+ name
+  (hash-table-set! +tag-db+ name
                    (list 'union name (normalize-fields (aggregate-fields form)))))
 
 ;;; ([pub] enum name (value ...))
 (define (add-enum name form)
   (let ((f (strip-pub form)))
-    (hash-table-set! +type-db+ name
+    (hash-table-set! +tag-db+ name
                      (list 'enum name (if (and (pair? (cddr f)) (list? (caddr f)))
                                           (caddr f)
                                           (list))))))
@@ -70,8 +74,14 @@
   (hash-table-set! +type-db+ name
                    (list 'define name (cddr (strip-pub form)))))
 
+(define (get-tag-info name)
+  (hash-table-ref/default +tag-db+ name #f))
+
+;;; First look up the ordinary identifier, then tag of that id when
+;;; no ordinary one was declared, as C does
 (define (get-type-info name)
-  (hash-table-ref/default +type-db+ name #f))
+  (or (hash-table-ref/default +type-db+ name #f)
+      (get-tag-info name)))
 
 ;;; ((name type) ...) for a struct or union, #f for anything else --
 ;;; including a name that was never declared. Callers give the better
@@ -100,19 +110,31 @@
 
 ;;; The declaration NAME ultimately names. For a typedef that is the
 ;;; entry of whatever it stands for, and for anything else it is
-;;; NAME's own info.
+;;; NAME's own info
-(define (resolve-type-info name)
+(define (target-tag target)
-  (let ((info (get-type-info name)))
+  (cond
-    (and info
+   ((symbol? target) target)
-         (if (eq? (car info) 'typedef)
-             (let* ((target (get-underlying-type name))
-                    (tag (cond ((symbol? target) target)
    ((and (pair? target)
+         (memq (car target) '(struct union enum))
          (pair? (cdr target))
          (symbol? (cadr target)))
     (cadr target))
-                               (else #f))))
+   (else #f)))
-               (and tag (get-type-info tag)))
+
+(define (resolve-type-info name)
+  (let ((info (resolve-ordinary-type-info name)))
+    (if (and info (memq (car info) '(struct union enum)))
+        info
+        (or (get-tag-info name) info))))
+
+(define (resolve-ordinary-type-info name)
+  (let ((info (get-type-info name)))
+    (and info
+         (if (eq? (car info) 'typedef)
+             (let ((tag (target-tag (get-underlying-type name))))
+               ;; A typedef target is written in type position, where
+               ;; `struct point' means the tag
+               (and tag (or (get-tag-info tag) (get-type-info tag))))
              info))))
 
 ;;; Type matcher macro