From f47159be466908138421d4a051019ab694bc9fe6 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sat, 14 Jun 2014 14:00:14 -0700
Subject: [PATCH] Add vars to tvar environment when infering poly function
 applications.

---
 .../typed-racket/typecheck/tc-funapp.rkt      | 29 ++++++++++---------
 .../tests/typed-racket/succeed/poly-dots.rkt  | 10 +++++++
 2 files changed, 26 insertions(+), 13 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/poly-dots.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
index e81770c4a3..06095ef5e3 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
@@ -3,6 +3,7 @@
 (require (rename-in "../utils/utils.rkt" [infer r:infer])
          racket/match syntax/stx
          (prefix-in c: (contract-req))
+         (env tvar-env)
          (for-syntax syntax/parse racket/base)
          (types utils union subtype resolve abbrev
                 substitute classes)
@@ -78,17 +79,18 @@
       ;; in filters/objects). Note that we have to use argtys-t here, since
       ;; argtys is a list of tc-results.
       (λ (dom rng rest drest a)
-        (cond
-         [drest
-          (infer/dots
-           fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng)
-           #:expected (and expected (tc-results->values expected)))]
-         [rest
-          (infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng
-                        (and expected (tc-results->values expected)))]
-         ;; no rest or drest
-         [else (infer fixed-vars (list dotted-var) argtys-t dom rng
-                      (and expected (tc-results->values expected)))]))
+        (extend-tvars vars
+          (cond
+           [drest
+            (infer/dots
+             fixed-vars dotted-var argtys-t dom (car drest) rng (fv rng)
+             #:expected (and expected (tc-results->values expected)))]
+           [rest
+            (infer/vararg fixed-vars (list dotted-var) argtys-t dom rest rng
+                          (and expected (tc-results->values expected)))]
+           ;; no rest or drest
+           [else (infer fixed-vars (list dotted-var) argtys-t dom rng
+                        (and expected (tc-results->values expected)))])))
       t argtys expected)]
     ;; regular polymorphic functions without dotted rest, 
     ;; we do not choose any instantiations with mandatory keyword arguments
@@ -109,8 +111,9 @@
       ;; in filters/objects). Note that we have to use argtys-t here, since
       ;; argtys is a list of tc-results.
       (λ (dom rng rest kw? a)
-         (infer/vararg vars null argtys-t dom rest rng
-                       (and expected (tc-results->values expected))))
+         (extend-tvars vars
+           (infer/vararg vars null argtys-t dom rest rng
+                         (and expected (tc-results->values expected)))))
       t argtys expected)]
     ;; Row polymorphism. For now we do really dumb inference that only works
     ;; in very restricted cases, but is probably enough for most cases in
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/poly-dots.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/poly-dots.rkt
new file mode 100644
index 0000000000..a31d5f3325
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/poly-dots.rkt
@@ -0,0 +1,10 @@
+#lang typed/scheme/base
+
+(: map-with-funcs (All (b ...) ((List (b ... b -> b) ... b ) -> (b ... b -> (values b ... b)))))
+(define (map-with-funcs fs)
+  (lambda bs
+    (apply values (map (plambda: (c) ([f : (b ... b -> c)])
+                         (apply f bs)) fs))))
+
+(map-with-funcs (list + - /))
+