From 27cabe8618f0848dce1091afcbbbd050f356b756 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sun, 27 Apr 2014 14:41:16 -0700
Subject: [PATCH] Make apply of poly functions more like regular functions.

original commit: 362747bfcdb8ceecd36b7e40d76de671b43d46e1
---
 .../typed-racket/typecheck/tc-apply.rkt       | 23 ++++---------------
 .../unit-tests/typecheck-tests.rkt            | 15 ++++++++++--
 2 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
index 8d866da5..8e4c08fe 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-apply.rkt
@@ -91,15 +91,12 @@
                   [drest (in-list drests)])
            (define (finish substitution) (do-ret (subst-all substitution range)))
            (cond
-             ;; the actual work, when we have a * function and a list final argument
+             ;; the actual work, when we have a * function
              [(and rest
-                   (not tail-bound)
-                   (<= (length domain) (length arg-tys))
-                   (infer/vararg vars null
-                                 (cons full-tail-ty arg-tys)
-                                 (cons (make-Listof rest) domain)
-                                 rest
-                                 range))
+                   (infer vars null
+                          (list (-Tuple* arg-tys full-tail-ty))
+                          (list (-Tuple* domain (make-Listof rest)))
+                          range))
               => finish]
              ;; the function has no rest argument, but provides all the necessary fixed arguments
              [(and (not rest) (not drest) (not tail-bound)
@@ -108,16 +105,6 @@
                           (list (-Tuple domain))
                           range))
               => finish]
-             ;; actual work, when we have a * function and ... final arg
-             [(and rest
-                   tail-bound
-                   (<= (length domain) (length arg-tys))
-                   (infer/vararg vars null
-                                 (cons (make-Listof tail-ty) arg-tys)
-                                 (cons (make-Listof rest) domain)
-                                 rest
-                                 range))
-              => finish]
              ;; ... function, ... arg
              [(and drest
                    tail-bound
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
index dccb5209..2f80a9cb 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -1001,8 +1001,8 @@
         [tc-err (apply append (list 1) (list 2) (list 3) (list (list 1) "foo"))]
         [tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list 1))) (-lst -PosByte)]
         [tc-e (apply append (list 1) (list 2) (list 3) (list (list 1) (list "foo"))) (-lst (t:Un -String -PosByte))]
-        [tc-err (plambda: (b ...) [y : b ... b] (apply append (map list y)))
-         #:ret (ret (-polydots (b) (->... (list) (b b) -Bottom)) -true-filter)]
+        [tc-e (plambda: (b ...) [y : b ... b] (apply append (map list y)))
+         #:ret (ret (-polydots (b) (->... (list) (b b) (-lst Univ))) -true-filter)]
         [tc-e/t (plambda: (b ...) [y : (Listof Integer) ... b] (apply append y))
                 (-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer)))]
 
@@ -2897,6 +2897,17 @@
          #:ret (ret -Bottom)
          #:msg #rx"has no cases"]
 
+       [tc-e/t
+         (let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
+           (plambda: (A B ...) ([xs : (List Any A ... B)])
+             (apply f xs)))
+         (-polydots (a b) (t:-> (-pair Univ  (make-ListDots a 'b)) -Void))]
+       [tc-e/t
+         (let: ([f : (All (a) (a a * -> Void)) (λ _ (void))])
+           (plambda: (A B ...) ([xs : (List A ... B)])
+             (apply f (first xs) xs)))
+         (-polydots (a b) (t:-> (make-ListDots a 'b) -Void))]
+
        [tc-e
          (let ()
            (: a Symbol)