From 5912a6243a6aeaa0e380698b43bebe61102c8737 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 10 May 2010 15:50:24 -0400 Subject: [PATCH] more contract fixes original commit: 52c1f41a2036906ab6462abd5479053e2894b1ca --- collects/typed-scheme/typecheck/tc-lambda-unit.rkt | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt index aefd8b6a..95628384 100644 --- a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt @@ -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)))))]))]))