read a var's type as a type, not as a call

`walk-parts' walked the whole `var' form, and a `fn' type's parameter
list is shaped like a call: `(fn ((c int)) int)' came out as
`int (*fp)(c int)'. A closure literal had no type, so calling one in
place missed the rewrite; sextest fed sexc symbols Sex cannot read.

Makefile

@@ -108,6 +108,7 @@ SEX_TEST_PROGRAMS = c99 \
                     inference \
                     lambdas \
                     lists \
+                    operators \
                     serialize \
                     type-shapes \
                     unicode \

semen.scm

@@ -274,12 +274,15 @@
 ;;; (fn sum ((a int) (b int)) int ...) -> (fn ((int) (int)) int).
 ;;; Anything that is not a plain (name type) -- a variadic tail -- goes
 ;;; through untouched.
+(define (arglist-types arglist)
+  (map (lambda (param)
+         (if (and (pair? param) (= 2 (length param)) (named-arg? param))
+             (list (second param))
+             param))
+       arglist))
+
 (define (fn-type-of fn-form)
-  `(fn ,(map (lambda (param)
+  `(fn ,(arglist-types (sex-fn-arglist fn-form))
-               (if (and (pair? param) (= 2 (length param)) (named-arg? param))
-                   (list (second param))
-                   param))
-             (sex-fn-arglist fn-form))
        ,(sex-fn-return-type fn-form)))
 
 (define (aux-name! env make)
@@ -379,8 +382,24 @@
                                     (fourth form))))))))
 
       ((var)
-       ;; the initializer is walked before the name it binds is in scope
+       ;; the initializer is walked before the name it binds is in
-       (let* ((walked (resolve-wildcard (walk-parts form env) env))
+       ;; scope; the type is resolved rather than walked, a `fn' type's
+       ;; parameter list being indistinguishable from a call -- walking
+       ;; `(fn ((c int)) int)' with a closure named `c' in scope would
+       ;; rewrite the parameter as a call of it
+       (let* ((prefix (if (>= (length form) 3)
+                          (append (take form 2)
+                                  (list (resolve-closure-types
+                                         (expand-type (third form) env))))
+                          form))
+              (walked (resolve-wildcard
+                       (copy-form-source!
+                        form
+                        (append prefix
+                                (if (> (length form) 3)
+                                    (walk-body (drop form 3) env)
+                                    (list))))
+                       env))
               (bound  (if (>= (length walked) 4)
                           (copy-form-source!
                            walked
@@ -408,12 +427,16 @@
       (else
        (let ((closure (receiver-closure-type (car form) env)))
          (if closure
-             (copy-form-source!
+             ;; the receiver is walked first: a closure written where it
-              form
+             ;; is called registers its struct on the way, and the call
-              `(,(register-closure-call! closure form)
+             ;; helper's signature mentions that struct
-                ,(walk-statement (car form) env)
+             (let ((receiver (walk-statement (car form) env)))
-                ,@(map (lambda (argument) (walk-statement argument env))
+               (copy-form-source!
-                       (cdr form))))
+                form
+                `(,(register-closure-call! closure form)
+                  ,receiver
+                  ,@(map (lambda (argument) (walk-statement argument env))
+                         (cdr form)))))
              (convert-arguments (walk-parts form env) env))))))))
 
 ;;; `(var n _ (strlen s))' becomes `(var n size-t (strlen s))'.
@@ -507,6 +530,21 @@
      (else (pair (cdr params) (- remaining 1)
                  (cons (unwrap-type (car params)) acc))))))
 
+;;; A `fn' header has its macros expanded and its closure types
+;;; resolved without being walked; a `var' type is the same thing in the
+;;; same position, and gets the same two. A macro standing in for a type
+;;; may still ask `(type-of x)' while it does so.
+(define (expand-type type env)
+  (let ((expanded
+         (parameterize ((current-type-of
+                         (lambda (queried)
+                           (unresolve-closure-types
+                            (expression-type queried env)))))
+           (macro-expand (list type)))))
+    (if (and (pair? expanded) (null? (cdr expanded)))
+        (car expanded)
+        expanded)))
+
 (define (walk-parts form env)
   (copy-form-source! form (walk-body form env)))
 
@@ -575,6 +613,11 @@
                               (cddr expr)))
       ((cast) (and (= 3 (length expr)) (third expr)))
       ((sizeof) 'size-t)
+      ;; a closure literal is its own type: the first three elements
+      ;; already spell one, so calling one where it is written resolves
+      ;; like calling one through a name
+      ((closure) (and (closure-expression? expr)
+                      `(closure ,(arglist-types (second expr)) ,(third expr))))
       ;; `c-and' and `c-or' are the names from before `&&' and `||'
       ((== != < > <= >= && |\|\|| ! c-and c-or) 'bool)
       ((+ - / %) (arithmetic-type expr env))

tests/sex-programs/operators.sex

@@ -0,0 +1,90 @@
+(input)
+(output "logical: 1 1 0"
+        "bitwise: 7 2 5"
+        "shifts: 48 0 12"
+        "increment: 7"
+        "decayed: 2 2 there"
+        "unsigned wins either way: 4294967295 4294967295"
+        "toplevel: 1 2.5 hi 12"
+        "closure in place: 5"
+        "a type is not a call: 7")
+(return 0)
+
+;;; The walk types an expression by its head, and the heads it had a
+;;; rule for were the ones inference was written against. `&&', the
+;;; bitwise operators, the shifts and `++' were not among them and each
+;;; stopped with `cannot infer'.
+;;;
+;;; The rest of this is the same mistake in three other places: an array
+;;; is a pointer the moment it is an operand, a rank tie is not decided
+;;; by which operand was written first, and `_' is not a local's
+;;; privilege.
+
+(include stdio.h)
+
+(fn area ((w int) (h int)) int
+  (return (* w h)))
+
+;;; a toplevel `_' reads the same table a local's does, so it can name
+;;; anything declared above it
+(var n _ 1)
+(var d _ 2.5)
+(var s _ "hi")
+(var a _ (+ 3 (* 3 3)))
+
+(fn make-adder ((k int)) (closure ((int)) int)
+  (return (closure ((b int)) int (k) (return (+ k b)))))
+
+(pub fn main () int
+  (var x int 6)
+  (var y int 3)
+  (var ok _ (&& x y))
+  (var orr _ (|| x y))
+  (var neg _ (! x))
+  (printf "logical: %d %d %d\n" ok orr neg)
+
+  (var bor _ (| x y))
+  (var band _ (& x y))
+  (var bxor _ (^ x y))
+  (printf "bitwise: %d %d %d\n" bor band bxor)
+
+  ;; a shift is the promoted left operand, not a join: the right one
+  ;; says only how far
+  (var c char 12)
+  (var shl _ (<< x y))
+  (var shr _ (>> x y))
+  (var wide _ (>> c 0))
+  (printf "shifts: %d %d %d\n" shl shr wide)
+
+  ;; ...and an increment is the operand, unpromoted
+  (var inc _ (++ x))
+  (printf "increment: %d\n" inc)
+
+  ;; an array operand decays, so this is a pointer and not an array
+  (var xs (¤ int 4) #(1 2 3 4))
+  (var p _ (+ xs 1))
+  (var q _ (+ 1 xs))
+  (var names (¤ (* const char) 2) #("hi" "there"))
+  (var np _ (+ names 1))
+  (printf "decayed: %d %d %s\n" (* p) (* q) (* np))
+
+  ;; at equal rank C takes the unsigned operand, whichever side it is on
+  (var i int -1)
+  (var u (unsigned int) 1)
+  (var u1 _ (+ i u))
+  (var u2 _ (+ u i))
+  (printf "unsigned wins either way: %u %u\n" (- u1 1) (- u2 1))
+
+  (printf "toplevel: %d %g %s %d\n" n d s a)
+
+  ;; a closure literal is its own type, so it can be called where it is
+  ;; written, the way a lambda already could
+  (printf "closure in place: %d\n"
+          ((closure ((v int)) int () (return v)) 5))
+
+  ;; a `fn' type's parameter list looks exactly like a call; with a
+  ;; closure named `f' in scope it used to be read as one
+  (var f (closure ((int)) int) (make-adder 1))
+  (var fp (fn ((f int) (g int)) int) area)
+  (printf "a type is not a call: %d\n" (f 6))
+  (return 0))

tools/sextest/sextest.scm

@@ -86,8 +86,14 @@
         (compiled-file (create-temporary-file)))
     ;; `process' returns one record; `process-input-port' is named from
     ;; the child's side, so it is the port we write to.
+    ;;
+    ;; Sex has no symbol escaping -- `|' is an operator there, not a
+    ;; quote -- so the forms go out the way they were written. Left to
+    ;; escape, `||' would leave here as `|\|\||' and reach sexc as a
+    ;; different symbol.
     (let* ((proc (process compiler (append (list "-o" compiled-file) flags)))
            (sexc-stdin (process-input-port proc)))
+      (symbol-escape #f)
       (with-output-to-port sexc-stdin
         (fn (map (fn (fmt #t x)) src)))
       (close-output-port sexc-stdin)