From 914f142f4fc16e4053e9e899b12e094ac93cf53e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 16:59:18 -0400
Subject: [PATCH] Fixed types of let loop lambdas.

---
 collects/typed-scheme/typecheck/tc-app.rkt | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 6b59f06d56..ef16316921 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -195,7 +195,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; let loop
 
-(define (let-loop-check form lp actuals args body expected)
+(define (let-loop-check form lam lp actuals args body expected)
   (syntax-parse #`(#,args #,body #,actuals) 
     #:literals (#%plain-app if null? pair? null)
     [((val acc ...)
@@ -216,7 +216,7 @@
                   [t ann-ts])
          (tc-expr/check a (ret t)))
        ;; then check that the function typechecks with the inferred types
-       (tc/rec-lambda/check form args body lp ts expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
        expected)]
     ;; special case `for/list'
     [((val acc ...)
@@ -234,7 +234,7 @@
                       [(tc-result1: (and t (Listof: _))) t]
                       [_ #f])
                     (generalize (-val '())))])
-       (tc/rec-lambda/check form args body lp (cons acc-ty ts) expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp (cons acc-ty ts) expected))
        expected)]
     ;; special case when argument needs inference
     [(_ body* _)
@@ -246,7 +246,7 @@
                        (begin (check-below (tc-expr/t ac) infer-t)
                               infer-t)
                        (generalize (tc-expr/t ac)))))])
-       (tc/rec-lambda/check form args body lp ts expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
        expected)]))
 
 
@@ -569,8 +569,7 @@
      #:fail-unless expected #f 
      #:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f
      #:fail-unless (free-identifier=? #'lp #'lp*) #f
-     (add-typeof-expr #'lam expected)
-     (let-loop-check form #'lp #'actuals #'args #'body expected)]
+     (let-loop-check form #'lam #'lp #'actuals #'args #'body expected)]
     ;; special cases for classes
     [(#%plain-app make-object cl . args)     
      (check-do-make-object #'cl #'args #'() #'())]