suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Check actual args when form looks like for/list.

Browse Source
This commit is contained in:
Eric Dobson 2013-02-19 23:22:47 -08:00
parent 9743afeebf
commit 6105ce8b20
2 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -1612,6 +1612,10 @@
[tc-err (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) -4 'c)] [tc-err (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) -4 'c)]
[tc-e (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) (+ -1 2) 'c) [tc-e (vector-set! (ann (vector 'a 'b) (Vector Symbol Symbol)) (+ -1 2) 'c)
-Void] -Void]
[tc-err
(ann
((letrec ((x (lambda (acc #{ v : Symbol}) (if v (list v) acc)))) x) null (list 'bad 'prog))
(Listof Symbol))]
) )
(test-suite (test-suite
"check-type tests" "check-type tests"

13
collects/typed-racket/typecheck/tc-app/tc-app-lambda.rkt
View File

@ -63,8 +63,10 @@
(let* ([ts1 (generalize (tc-expr/t #'actual))] (let* ([ts1 (generalize (tc-expr/t #'actual))]
[ann-ts (for/list ([a (in-syntax #'(acc ...))] [ann-ts (for/list ([a (in-syntax #'(acc ...))]
[ac (in-syntax #'(actuals ...))]) [ac (in-syntax #'(actuals ...))])
(or (find-annotation #'inner-body a) (let ([type (find-annotation #'inner-body a)])
(generalize (tc-expr/t ac))))] (if type
(tc-expr/check/t ac (ret type))
(generalize (tc-expr/t ac)))))]
[ts (cons ts1 ann-ts)]) [ts (cons ts1 ann-ts)])
;; check that the actual arguments are ok here ;; check that the actual arguments are ok here
(for/list ([a (syntax->list #'(actuals ...))] (for/list ([a (syntax->list #'(actuals ...))]
@ -80,9 +82,10 @@
#:when (free-identifier=? #'val #'e3) #:when (free-identifier=? #'val #'e3)
(let ([ts (for/list ([ac (syntax->list #'(actuals ...))] (let ([ts (for/list ([ac (syntax->list #'(actuals ...))]
[f (syntax->list #'(acc ...))]) [f (syntax->list #'(acc ...))])
(or (let ([type (type-annotation f #:infer #t)])
(type-annotation f #:infer #t) (if type
(generalize (tc-expr/t ac))))] (tc-expr/check/t ac (ret type))
(generalize (tc-expr/t ac)))))]
[acc-ty (or [acc-ty (or
(type-annotation #'val #:infer #t) (type-annotation #'val #:infer #t)
(match expected (match expected