From 9ec358b665ef664eed06ac116cec0f9aa9a2c625 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Mon, 28 Mar 2016 12:11:11 -0400
Subject: [PATCH] Update type-table after tc-funapp processing

This makes the tooltip show the more refined function
type after application typechecking. For example, case->
types will be narrowed to the particular case that fits.

Polymorphic function types will be instantiated at the
appropriate type.

Fixes issue #325
---
 typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt | 4 +++-
 typed-racket-test/unit-tests/tooltip-tests.rkt            | 8 +++++++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
index db89ca21..faaa5711 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
@@ -7,7 +7,7 @@
          (typecheck check-below tc-subst tc-metafunctions possible-domains)
          (utils tc-utils)
          (rep type-rep filter-rep)
-         (except-in (types utils abbrev subtype)
+         (except-in (types utils abbrev subtype type-table)
                     -> ->* one-of/c))
 (require-for-cond-contract
   syntax/stx)
@@ -18,6 +18,8 @@
      (#:check boolean?)
      . ->* . full-tc-results/c)])
 (define (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
+  ;; update tooltip-table with inferred function type
+  (add-typeof-expr f-stx (ret (make-Function (list ftype0))))
   (match* (ftype0 argtys)
     ;; we check that all kw args are optional
     [((arr: dom rng rest #f (and kws (list (Keyword: _ _ #f) ...)))
diff --git a/typed-racket-test/unit-tests/tooltip-tests.rkt b/typed-racket-test/unit-tests/tooltip-tests.rkt
index 9da37ba2..d9be073a 100644
--- a/typed-racket-test/unit-tests/tooltip-tests.rkt
+++ b/typed-racket-test/unit-tests/tooltip-tests.rkt
@@ -100,4 +100,10 @@
                    (has-types-at? (list (list "^Integer$" 74 75))))
     (check-tooltip (values 1 2)
                    (has-types-at? (list (list #rx"Value 1:.*One.*Value 2:.*Positive-Byte"
-                                              23 24))))))
+                                              23 24))))
+    (check-tooltip (identity 1)
+                   (has-types-at? (list (list #rx"^\\(-> One One\\)$"
+                                              24 32))))
+    (check-tooltip (+ 1 2)
+                   (has-types-at? (list (list #rx"^\\(-> Positive-Byte Positive-Byte Positive-Index\\)$"
+                                              24 25))))))