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

more contract fixes

Browse Source 
original commit: 52c1f41a2036906ab6462abd5479053e2894b1ca
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-10 15:50:24 -04:00
parent 5557322514
commit 5912a6243a
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/typed-scheme/typecheck/tc-lambda-unit.rkt
View File

@ -74,10 +74,11 @@
(define (check-body)
(with-lexical-env/extend
arg-list arg-types
(make lam-result (for/list ([al arg-list] [at arg-types] [a-ty arg-tys]) (list al at)) null rest-ty
;; make up a fake name if none exists, this is an error case anyway
(cons (or rest (generate-temporary)) drest)
(tc-exprs/check (syntax->list body) ret-ty))))
(lam-result (for/list ([al arg-list] [at arg-types] [a-ty arg-tys]) (list al at)) null
(and rest-ty (list (or rest (generate-temporary)) rest-ty))
;; make up a fake name if none exists, this is an error case anyway
(and drest (cons (or rest (generate-temporary)) drest))
(tc-exprs/check (syntax->list body) ret-ty))))
(when (or (not (= arg-len tys-len))
(and (or rest-ty drest) (not rest)))
(tc-error/delayed (expected-str tys-len rest-ty drest arg-len rest)))
@ -165,7 +166,7 @@
(make lam-result
(map list arg-list arg-types)
null
rest-type
(list #'rest rest-type)
#f
(tc-exprs (syntax->list body)))))]))]))