From 31bf61e3336d821e5ad269ea9b00f2e2ccdc691a Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 6 May 2016 18:55:23 -0400
Subject: [PATCH] Remove redundant values checks

These can all be done via check-below later in the
typechecking process
---
 .../typecheck/tc-app/tc-app-values.rkt        | 29 ++++++++-----------
 .../fail/pr13365-variation-3.rkt              |  2 +-
 .../unit-tests/typecheck-tests.rkt            | 14 ++++-----
 3 files changed, 18 insertions(+), 27 deletions(-)

diff --git a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt
index 932bf486..5625aaa3 100644
--- a/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt
@@ -5,7 +5,7 @@
          "utils.rkt"
          syntax/parse racket/match racket/sequence
          (typecheck signatures tc-funapp)
-         (types utils)
+         (types base-abbrev utils)
 
          (for-label racket/base))
 
@@ -34,29 +34,24 @@
      [(tc-result1: tp)
       (single-value #'arg expected)]
      [(tc-results: ts)
-      (single-value #'arg) ;Type check the argument, to find other errors
-      (tc-error/expr
-        "wrong number of values: expected ~a but got one"
-         (length ts))]
+      (single-value #'arg)] ;Type check the argument, to find other errors
      ;; match polydots case and error
      [(tc-results: ts _ _ dty dbound)
-      (single-value #'arg)
-      (tc-error/expr
-        "Expected ~a ..., but got only one value" dty)]))
+      (single-value #'arg)]))
   ;; handle `values' specially
   (pattern (values . args)
     (match expected
       [(tc-results: ets efs eos)
        (match-let ([(list (tc-result1: ts fs os) ...)
-                    (for/list ([arg (in-syntax #'args)]
-                               [et (in-list ets)]
-                               [ef (in-list efs)]
-                               [eo (in-list eos)])
-                      (single-value arg (ret et ef eo)))])
-         (if (= (length ts) (length ets) (syntax-length #'args))
-             (ret ts fs os)
-             (tc-error/expr "wrong number of values: expected ~a but got ~a"
-                            (length ets) (syntax-length #'args))))]
+                    (for/list
+                      ([arg (in-syntax #'args)]
+                       [et (in-sequences (in-list ets) (in-cycle (in-value #f)))]
+                       [ef (in-sequences (in-list efs) (in-cycle (in-value #f)))]
+                       [eo (in-sequences (in-list eos) (in-cycle (in-value #f)))])
+                      (if et
+                          (single-value arg (ret et ef eo))
+                          (single-value arg)))])
+         (ret ts fs os))]
       [_ (match-let ([(list (tc-result1: ts fs os) ...)
                       (for/list ([arg (in-syntax #'args)])
                         (single-value arg))])
diff --git a/typed-racket-test/fail/pr13365-variation-3.rkt b/typed-racket-test/fail/pr13365-variation-3.rkt
index b73fda54..b1be4387 100644
--- a/typed-racket-test/fail/pr13365-variation-3.rkt
+++ b/typed-racket-test/fail/pr13365-variation-3.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred #rx"Expected a ...")
+(exn-pred #rx"mismatch in.*a ...")
 #lang typed/racket
 
 (: f (All (a ...) (a ... a -> (Values a ... a))))
diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt
index b964ed87..569bde14 100644
--- a/typed-racket-test/unit-tests/typecheck-tests.rkt
+++ b/typed-racket-test/unit-tests/typecheck-tests.rkt
@@ -3023,27 +3023,23 @@
          #:expected (ret (make-HeterogeneousVector (list -Byte -Byte)) -false-propset #f)]
 
        [tc-err (values 'x)
-         #:ret (ret (list -Symbol -Symbol)
-                    (list -ff-propset -ff-propset)
-                    (list -empty-obj -empty-obj))
+         #:ret (ret (list -Symbol -Symbol))
          #:expected (ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
 
        [tc-err (values 'x 'y 'z)
-         #:ret (ret (list -Symbol -Symbol)
-                    (list -ff-propset -ff-propset)
-                    (list -empty-obj -empty-obj))
+         #:ret (ret (list -Symbol -Symbol))
          #:expected (ret (list -Symbol -Symbol) (list #f #f ) (list #f #f))]
 
        [tc-err (values 'y)
-         #:ret (ret (list -Symbol) (list -ff-propset ) (list -empty-obj) Univ 'B)
+         #:ret (ret (list -Symbol) (list -tt-propset) (list -empty-obj) Univ 'B)
          #:expected (ret (list -Symbol) (list #f ) (list #f) Univ 'B)]
 
        [tc-err (values (values 'x 'y))
-         #:ret (ret (-val 'x) -ff-propset)
+         #:ret (ret (-val 'x))
          #:expected (ret (-val 'x) #f #f)]
 
        [tc-err (if (random) (values 1 2) 3)
-         #:ret (ret (-val 3) -true-propset)
+         #:ret (ret (-val 3) -tt-propset)
          #:expected (ret (-val 3) #f #f)]
 
        [tc-err