From e87463be87fdc1aa8254cdd1aa846e08a4039906 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Wed, 30 Sep 2026 23:12:52 +0300 Subject: [PATCH] type the operators the walk had no rule for `&&', the bitwise operators, the shifts and `++' each stopped with `cannot infer'; an array operand came back as the array; a rank tie went to whichever operand came first; and a toplevel `_' reached the writer unsolved. --- Makefile | 21 +++++++++--- infer.module.scm | 1 + semen.scm | 76 +++++++++++++++++++++++++++++++++++++----- tests/infer.module.scm | 1 + 4 files changed, 86 insertions(+), 13 deletions(-) diff --git a/Makefile b/Makefile index a769559..6cfb23f 100644 --- a/Makefile +++ b/Makefile @@ -96,10 +96,23 @@ sextest: $(MAKE) -C ./tools/sextest sextest cp ./tools/sextest/sextest . -SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \ - feature-flags lambdas compound-literals closures fixpoint \ - wildcards inference type-shapes unnamed-params \ - closure-signatures c99 +SEX_TEST_PROGRAMS = c99 \ + closure-signatures \ + closures \ + comments \ + compound-literals \ + feature-flags \ + features \ + fixpoint \ + hello-world \ + inference \ + lambdas \ + lists \ + serialize \ + type-shapes \ + unicode \ + unnamed-params \ + wildcards # Multi-module linking is checked end to end; see tests/modules/Makefile. check-modules: sexc diff --git a/infer.module.scm b/infer.module.scm index f53f1f3..dc9c3b3 100644 --- a/infer.module.scm +++ b/infer.module.scm @@ -17,6 +17,7 @@ resolve underlying + c-primitive? type-quals free-tvars decay diff --git a/semen.scm b/semen.scm index c47866f..8f545b4 100644 --- a/semen.scm +++ b/semen.scm @@ -560,9 +560,11 @@ ;; subscripts the same way ((¤) (let ((base (expression-type (second expr) env))) (or (array-element-type base) (pointer-target base)))) - ((&) (and (= 2 (length expr)) - (let ((target (expression-type (second expr) env))) - (and target `(* ,target))))) + ;; unary `&' takes an address; with two operands it is bitwise and + ((&) (if (= 2 (length expr)) + (let ((target (expression-type (second expr) env))) + (and target `(* ,target))) + (arithmetic-type expr env))) ;; unary `*' is a dereference; with two operands it is a product ((*) (if (= 2 (length expr)) (pointer-target (expression-type (second expr) env)) @@ -573,8 +575,17 @@ (cddr expr))) ((cast) (and (= 3 (length expr)) (third expr))) ((sizeof) 'size-t) - ((== != < > <= >= c-and c-or !) 'bool) + ;; `c-and' and `c-or' are the names from before `&&' and `||' + ((== != < > <= >= && |\|\|| ! c-and c-or) 'bool) ((+ - / %) (arithmetic-type expr env)) + ;; the bitwise operators join like the arithmetic ones + ((^ |\||) (arithmetic-type expr env)) + ;; a shift does not join: the result is the promoted left operand, + ;; and the right one says only how far + ((<< >>) (promoted-type (expression-type (second expr) env))) + ;; ...and an increment is not a join either -- it is the operand, + ;; unpromoted, being what is written back to it + ((++ --) (expression-type (second expr) env)) ;; otherwise a call: a closure answers with its own return type, ;; anything else with what its signature says (else @@ -605,16 +616,45 @@ (let ((l (underlying (parse-type left))) (r (underlying (parse-type right)))) (cond - ((or (ptr-type? l) (array-type? l)) left) - ((or (ptr-type? r) (array-type? r)) right) + ((or (ptr-type? l) (array-type? l)) (decayed left l)) + ((or (ptr-type? r) (array-type? r)) (decayed right r)) + ;; one type on both sides needs no ranking, which is the only way + ;; a name we never parsed a declaration for joins at all + ((and (prim-type? l) (prim-type? r) (equal? (prim-name l) (prim-name r))) + (promoted left l)) + ((or (unrankable? l) (unrankable? r)) '?) ((< (conversion-rank l) (conversion-rank r)) (promoted right r)) + ((> (conversion-rank l) (conversion-rank r)) (promoted left l)) + ;; at equal rank C takes the unsigned one, whichever side it is + ;; written on + ((unsigned-type? r) (promoted right r)) (else (promoted left l))))))) +;;; A name we never parsed a declaration for -- `size-t', `GLuint' -- +;;; has no rank we can know, so a join that would have to compare one +;;; answers `?' instead of taking whichever operand came first. +;;; `resolve-wildcard' turns that into "write it out", which is the only +;;; honest thing to say about it. +(define (unrankable? type) + (and (prim-type? type) (not (c-primitive? type)))) + +(define (unsigned-type? type) + (and (prim-type? type) (memq 'unsigned (prim-name type)) #t)) + ;;; Anything narrower than `int' is promoted to one before the ;;; arithmetic happens, so two `char's join as `int' and not as `char'. ;;; Operands of the same type reach here too, which is the whole point: ;;; `(+ c c)' is where the promotion is invisible and the truncation is ;;; not. `unsigned' alone is `unsigned int' and stays as written. +;;; An array is a pointer to its first element the moment it is an +;;; operand, so `(+ a 1)' is a `(* int)' and not the `(¤ int 4)' that +;;; `a' was declared as -- which is not a type an initializer can have. +(define (decayed written type) + (if (array-type? type) (unparse-type (decay type)) written)) + +(define (promoted-type written) + (and written (promoted written (underlying (parse-type written))))) + (define (promoted written type) (if (and (prim-type? type) (any (lambda (word) (memq word '(char short bool _Bool))) @@ -1045,11 +1085,29 @@ ((union) (add-union name form)) ((enum) (add-enum name form)))))) +;;; A toplevel form has no function around it and so no scope chain. A +;;; name in a global's initializer is another global's or a function's, +;;; which `get-name-type' answers without one. +(define (make-toplevel-env) + (let ((env (make-hash-table))) + (set! (hash-table-ref env :scopes) (list)) + env)) + (define (process-global-var sex-var acc) ;; A global is not walked for lambdas, but its type still has to stop - ;; saying `closure' before the writer sees it - (let* ((form (resolve-closure-types sex-var)) - (core (if (memq (car form) '(pub extern)) (cdr form) form))) + ;; saying `closure' before the writer sees it, and a `_' still has to + ;; be written out: the writer has no spelling for one either way. + (let* ((resolved (resolve-closure-types sex-var)) + (qualifier (and (memq (car resolved) '(pub extern)) (car resolved))) + (core (if qualifier (cdr resolved) resolved)) + ;; `extern' declares without initializing, so there is nothing + ;; for a `_' to be worked out from + (core (if (eq? 'extern qualifier) + core + (resolve-wildcard core (make-toplevel-env)))) + (form (if qualifier + (copy-form-source! resolved (cons qualifier core)) + core))) (when (and (pair? (cdr core)) (pair? (cddr core)) (symbol? (second core))) (add-name-type! (second core) (third core))) (cons form acc))) diff --git a/tests/infer.module.scm b/tests/infer.module.scm index 5cf5645..5b55c47 100644 --- a/tests/infer.module.scm +++ b/tests/infer.module.scm @@ -17,6 +17,7 @@ resolve underlying + c-primitive? type-quals free-tvars decay