From 93507eb519c60d32074764dda089f79d62ae12ae Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@cs.indiana.edu>
Date: Tue, 10 Nov 2015 13:23:39 -0500
Subject: [PATCH] Avoid doing too much duplicate typechecking work.

---
 .../typed-racket/typecheck/tc-lambda-unit.rkt            | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt b/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
index 2891ee80..44cf1447 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
@@ -62,7 +62,6 @@
 ;; body: The body of the lambda to typecheck.
 (define/cond-contract
   (tc-lambda-body arg-names arg-types #:rest [raw-rest #f] #:expected [expected #f]
-                  #:body-type [body-type #f]
                   body)
   (->* ((listof identifier?) (listof Type/c) syntax?)
        (#:rest (or/c #f (list/c identifier? (or/c Type/c (cons/c Type/c symbol?))))
@@ -88,7 +87,7 @@
       (with-lexical-env/extend-types
         (append rest-names arg-names)
         (append rest-types arg-types)
-        (or body-type (tc-body/check body expected)))
+        (tc-body/check body expected))
       arg-names #:rest-id rest-id)
     #:rest (and (Type? rest) rest)
     #:drest (and (cons? rest) rest)))
@@ -212,7 +211,7 @@
 
   (define eta-expanded?
     (syntax-parse body
-      [(((~literal #%plain-app) fun:expr j:id ...))
+      [(((~literal #%plain-app) fun:id j:id ...)) ;; restricted to ids to avoid re-typechecking
        #:when (equal? (length arg-list)
                       (length (syntax->list #'(j ...))))
        #:when (andmap free-identifier=? arg-list (syntax->list #'(j ...)))
@@ -240,14 +239,13 @@
           (get-type rest-id #:default Univ)]
          ;; Lambda with no rest argument
          [else #f]))
-     (define body-t (and eta-expanded? (tc-expr eta-expanded?)))
      (cond 
       ;; special case for un-annotated eta-expansions
       [(and eta-expanded? (not rest-id) (andmap not arg-types)
             ;; FIXME: should also handle polymorphic types
             ;; but we can't return anything but a (listof arr?) here 
             ;; FIXME: misses optimization opportunities in this code
-            (match body-t
+            (match (tc-expr eta-expanded?)
               [(tc-result1: (Function: arrs))
                (define possibles (for*/list ([arr (in-list arrs)]
                                              [restricted (in-value (restrict-to-arity arr (length arg-list)))]
@@ -265,7 +263,6 @@
        (list
         (tc-lambda-body arg-list (map (lambda (v) (or v Univ)) arg-types)
                         #:rest (and rest-type (list rest-id rest-type))
-                        #:body-type body-t
                         body))])]))