From 381ad21d8bb14e93759d9ff512ebaade20a6b0d0 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Mon, 21 Sep 2026 00:46:15 +0300 Subject: [PATCH] separate tags and typedefs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 4 ++-- tests/types.module.scm | 1 + tests/types.scm | 32 +++++++++++++++++++++++++++ types.module.scm | 1 + types.scm | 50 ++++++++++++++++++++++++++++++------------ 5 files changed, 72 insertions(+), 16 deletions(-) diff --git a/sex-macros.scm b/sex-macros.scm index 1923a46..ade2ce0 100644 --- a/sex-macros.scm +++ b/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 - type-match map-fields)) + (only types get-type-info get-tag-info get-fields + get-underlying-type type-match map-fields)) ,@body))) (define (get-macro name) diff --git a/tests/types.module.scm b/tests/types.module.scm index 8ae1186..c262cd7 100644 --- a/tests/types.module.scm +++ b/tests/types.module.scm @@ -9,6 +9,7 @@ map-fields get-type-info + get-tag-info get-fields get-underlying-type) "../types.scm") diff --git a/tests/types.scm b/tests/types.scm index d9bfc8a..94ce626 100644 --- a/tests/types.scm +++ b/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)) diff --git a/types.module.scm b/types.module.scm index 8f94b70..afdb80f 100644 --- a/types.module.scm +++ b/types.module.scm @@ -9,6 +9,7 @@ map-fields get-type-info + get-tag-info get-fields get-underlying-type) "types.scm") diff --git a/types.scm b/types.scm index 6e6b4b0..700146c 100644 --- a/types.scm +++ b/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 (target-tag target) + (cond + ((symbol? target) target) + ((and (pair? target) + (memq (car target) '(struct union enum)) + (pair? (cdr target)) + (symbol? (cadr target))) + (cadr target)) + (else #f))) + (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* ((target (get-underlying-type name)) - (tag (cond ((symbol? target) target) - ((and (pair? target) - (pair? (cdr target)) - (symbol? (cadr target))) - (cadr target)) - (else #f)))) - (and tag (get-type-info tag))) + (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