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

Avoid TR internal error, by checking shape of args.

Browse Source 
original commit: 1fd21ef640514b0c3a67356d0f68cadff36d3d3a
This commit is contained in:
Eric Dobson 2013-02-19 23:03:12 -08:00
parent 43028b1145
commit b63e5dc1ec
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1601,7 +1601,7 @@
[tc-e (vector-split-at (vector 2 3 4 5 6) 3)
(list (-vec -Integer) (-vec -Integer))]
[tc-e/t (ann ((letrec ((x (lambda args 3))) x) 1 2) Byte) -Byte]
)
(test-suite
"check-type tests"

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

@ -20,11 +20,11 @@
(define-tc/app-syntax-class (tc/app-lambda expected)
#:literals (#%plain-app #%plain-lambda letrec-values)
;; let loop
(pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda args . body))]) lp*) . actuals)
(pattern ((letrec-values ([(lp) (~and lam (#%plain-lambda (args ...) . body))]) lp*) . actuals)
#:fail-unless expected #f
#:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f
#:fail-unless (not (andmap type-annotation (syntax->list #'(lp args ...)))) #f
#:fail-unless (free-identifier=? #'lp #'lp*) #f
(let-loop-check #'lam #'lp #'actuals #'args #'body expected))
(let-loop-check #'lam #'lp #'actuals #'(args ...) #'body expected))
;; inference for ((lambda
(pattern ((#%plain-lambda (x ...) . body) args ...)
#:fail-unless (= (length (syntax->list #'(x ...)))