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

@@ -96,10 +96,23 @@ sextest:
 	$(MAKE) -C ./tools/sextest sextest
 	cp ./tools/sextest/sextest .
 
-SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \
+SEX_TEST_PROGRAMS = c99 \
-                    feature-flags lambdas compound-literals closures fixpoint \
+                    closure-signatures \
-                    wildcards inference type-shapes unnamed-params \
+                    closures \
-                    closure-signatures c99
+                    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

infer.module.scm

@@ -17,6 +17,7 @@
 
      resolve
      underlying
+     c-primitive?
      type-quals
      free-tvars
      decay

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))
+      ;; unary `&' takes an address; with two operands it is bitwise and
-                (let ((target (expression-type (second expr) env)))
+      ((&) (if (= 2 (length expr))
-                  (and target `(* ,target)))))
+               (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? l) (array-type? l)) (decayed left l))
-       ((or (ptr-type? r) (array-type? r)) right)
+       ((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
+  ;; saying `closure' before the writer sees it, and a `_' still has to
-  (let* ((form (resolve-closure-types sex-var))
+  ;; be written out: the writer has no spelling for one either way.
-         (core (if (memq (car form) '(pub extern)) (cdr form) form)))
+  (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)))

tests/infer.module.scm

@@ -17,6 +17,7 @@
 
      resolve
      underlying
+     c-primitive?
      type-quals
      free-tvars
      decay