From c26f9b4c735e3170b28ae55bc2a11000c95d1041 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Mon, 24 Feb 2014 00:26:11 -0500
Subject: [PATCH] Support ValuesDots in a typechecking a funapp

Closes PR 13651

original commit: 4f3c98f7549bc0fe2641dea92bd1188bb527bfdf
---
 .../typed-racket/typecheck/tc-app-helper.rkt    | 17 ++++++++++++++---
 .../typed-racket/typecheck/tc-expr-unit.rkt     |  7 ++++++-
 .../typed-racket/unit-tests/typecheck-tests.rkt | 15 +++++++++++++++
 3 files changed, 35 insertions(+), 4 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
index 5aa7752c..55d256fe 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt
@@ -19,14 +19,19 @@
 (define (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
   (match* (ftype0 argtys)
     ;; we check that all kw args are optional
-    [((arr: dom (and rng (or (AnyValues:) (Values: _))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
+    [((arr: dom rng rest #f (and kws (list (Keyword: _ _ #f) ...)))
       (list (tc-result1: t-a phi-a o-a) ...))
 
      (when check?
        (define error-ret
          (match rng
           ((AnyValues:) tc-any-results)
-          ((Values: (list (Result: t-r _ _) ...)) (ret t-r))))
+          ((Values: (list (Result: t-r _ _) ...)) (ret t-r))
+          ((ValuesDots: (list (Result: t-r _ _) ...) dty dbound)
+           (ret t-r
+                (make-list (length t-r) -no-filter)
+                (make-list (length t-r) -no-obj)
+                dty dbound))))
        (cond [(and (not rest) (not (= (length dom) (length t-a))))
               (tc-error/expr #:return error-ret
                              "Wrong number of arguments, expected ~a and got ~a" (length dom) (length t-a))]
@@ -53,7 +58,13 @@
                (for/lists (t-r f-r o-r)
                  ([r (in-list results)])
                  (open-Result r o-a t-a)))
-             (ret t-r f-r o-r)))))]
+             (ret t-r f-r o-r))
+            ((ValuesDots: results dty dbound)
+             (define-values (t-r f-r o-r)
+               (for/lists (t-r f-r o-r)
+                 ([r (in-list results)])
+                 (open-Result r o-a t-a)))
+             (ret t-r f-r o-r dty dbound)))))]
     ;; this case should only match if the function type has mandatory keywords
     ;; but no keywords were provided in the application
     [((arr: _ _ _ _
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
index cd3cb2df..ec5e1065 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@@ -507,7 +507,12 @@
             (let* ([ts* (do-inst form ts)]
                    [r (ret ts* fs os)])
               (add-typeof-expr form r)
-              r)]))])))
+              r)]
+           [(tc-results: ts fs os dty dbound)
+            (define ts* (do-inst form ts))
+            (define r (ret ts* fs os dty dbound))
+            (add-typeof-expr form r)
+            r]))])))
 
 (define (single-value form [expected #f])
   (define t (if expected (tc-expr/check form expected) (tc-expr form)))
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 a57b7010..382b74fd 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
@@ -2302,6 +2302,21 @@
                                        (-filter (-val #f) (list 0 0)))
                                 : (make-Path null (list 0 0))))
                         (-FS -top -bot))]
+
+       ;; PR 13651 and related
+       [tc-e (tr:lambda #:forall (a ...) ([f : (-> String (values a ... a))])
+               (f "foo"))
+             #:ret (ret (-polydots (a)
+                          (t:-> (t:-> -String (make-ValuesDots '() a 'a))
+                                (make-ValuesDots '() a 'a)))
+                        (-FS -top -bot))]
+       [tc-e (inst (plambda: (A B ...) ((a : A) b : B ... B)
+                     ((ann (lambda () (apply (inst values A B ... B) a b))
+                           (-> (values A B ... B)))))
+                   String String Symbol)
+             #:ret (ret (t:-> -String -String -Symbol
+                              (-values (list -String -String -Symbol)))
+                        (-FS -top -bot))]
         )
   (test-suite
    "tc-literal tests"