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

Actually typecheck actuals even when there's a type annotation.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2010-06-11 19:35:56 -04:00
parent 7ece2a4872
commit 1cff0a1f85
2 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -808,7 +808,10 @@
(vector-ref #("a" "b") (- x 1))) (vector-ref #("a" "b") (- x 1)))
-String] -String]
[tc-err (string-append "bar" (if (zero? (ann 0.0 Float)) #f "foo"))] [tc-err (string-append "bar" (if (zero? (ann 0.0 Float)) #f "foo"))]
) [tc-err (do: : Void
([j : Natural (+ i 'a) (+ j i)])
((>= j 10))
#f)])
(test-suite (test-suite
"check-type tests" "check-type tests"
(test-exn "Fails correctly" exn:fail:syntax? (lambda () (parameterize ([orig-module-stx #'here]) (test-exn "Fails correctly" exn:fail:syntax? (lambda () (parameterize ([orig-module-stx #'here])

7
collects/typed-scheme/typecheck/tc-app.rkt
View File

@ -238,9 +238,10 @@
[_ [_
(let ([ts (for/list ([ac (syntax->list actuals)] (let ([ts (for/list ([ac (syntax->list actuals)]
[f (syntax->list args)]) [f (syntax->list args)])
(or (let ([infer-t (type-annotation f #:infer #t)])
(type-annotation f #:infer #t) (if infer-t
(generalize (tc-expr/t ac))))]) (check-below (tc-expr/t ac) infer-t)
(generalize (tc-expr/t ac)))))])
(tc/rec-lambda/check form args body lp ts expected) (tc/rec-lambda/check form args body lp ts expected)
expected)])) expected)]))