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.
This commit is contained in:
21
Makefile
21
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
|
||||
|
||||
@@ -17,6 +17,7 @@
|
||||
|
||||
resolve
|
||||
underlying
|
||||
c-primitive?
|
||||
type-quals
|
||||
free-tvars
|
||||
decay
|
||||
|
||||
76
semen.scm
76
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)))
|
||||
|
||||
@@ -17,6 +17,7 @@
|
||||
|
||||
resolve
|
||||
underlying
|
||||
c-primitive?
|
||||
type-quals
|
||||
free-tvars
|
||||
decay
|
||||
|
||||
Reference in New Issue
Block a user