diff --git a/Makefile b/Makefile index 6cfb23f..a0924ab 100644 --- a/Makefile +++ b/Makefile @@ -108,6 +108,7 @@ SEX_TEST_PROGRAMS = c99 \ inference \ lambdas \ lists \ + operators \ serialize \ type-shapes \ unicode \ diff --git a/semen.scm b/semen.scm index 8f545b4..ccbed18 100644 --- a/semen.scm +++ b/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) - (if (and (pair? param) (= 2 (length param)) (named-arg? param)) - (list (second param)) - param)) - (sex-fn-arglist fn-form)) + `(fn ,(arglist-types (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 - (let* ((walked (resolve-wildcard (walk-parts form env) env)) + ;; the initializer is walked before the name it binds is in + ;; 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! - form - `(,(register-closure-call! closure form) - ,(walk-statement (car form) env) - ,@(map (lambda (argument) (walk-statement argument env)) - (cdr form)))) + ;; the receiver is walked first: a closure written where it + ;; is called registers its struct on the way, and the call + ;; helper's signature mentions that struct + (let ((receiver (walk-statement (car form) env))) + (copy-form-source! + 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)) diff --git a/tests/sex-programs/operators.sex b/tests/sex-programs/operators.sex new file mode 100644 index 0000000..bd730bc --- /dev/null +++ b/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)) diff --git a/tools/sextest/sextest.scm b/tools/sextest/sextest.scm index 4ce6229..e07319e 100644 --- a/tools/sextest/sextest.scm +++ b/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)