Make tc-results: and Results: not use ... over patterns.

This avoids a case where match is silently wrong.

original commit: 2f032184ca98d02cdf330ac8d3f5095d37c09252

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-below.rkt

@@ -140,16 +140,18 @@
      (ret t2 (fix-filter f2 f1) (fix-object o2 o1))]
 
     ;; case where expected is like (Values a ... a) but got something else
-    [((tc-results: t1 f o) (tc-results: t2 f o dty dbound))
+    [((tc-results: t1 f1 o1) (tc-results: t2 f2 o2 dty dbound))
      (value-mismatch expected tr1)
      (fix-results expected)]
 
     ;; case where you have (Values a ... a) but expected something else
-    [((tc-results: t1 f o dty dbound) (tc-results: t2 f o))
+    [((tc-results: t1 f1 o1 dty dbound) (tc-results: t2 f2 o2))
      (value-mismatch expected tr1)
      (fix-results expected)]
 
-    [((tc-results: t1 f o dty1 dbound) (tc-results: t2 f o dty2 dbound))
+    [((tc-results: t1 f1 o1 dty1 dbound)
+      (tc-results: t2 (list (or (NoFilter:) (FilterSet: (Top:) (Top:))) ...)
+                      (list (or (NoObject:) (Empty:)) ...) dty2 dbound))
      (cond
        [(= (length t1) (length t2))
         (unless (andmap subtype t1 t2)
@@ -160,12 +162,39 @@
          (value-mismatch expected tr1)])
      (fix-results expected)]
 
+    [((tc-results: t1 f1 o1 dty1 dbound) (tc-results: t2 f2 o2 dty2 dbound))
+     (cond
+       [(= (length t1) (length t2))
+        (unless (andmap subtype t1 t2)
+          (expected-but-got (stringify t2) (stringify t1)))
+        (unless (subtype dty1 dty2)
+          (type-mismatch dty2 dty1 "mismatch in ... argument"))]
+       [else
+         (value-mismatch expected tr1)])
+     (fix-results expected)]
+
+    [((tc-results: t1 f1 o1)
+      (tc-results: t2 (list (or (NoFilter:) (FilterSet: (Top:) (Top:))) ...)
+                      (list (or (NoObject:) (Empty:)) ...)))
+     (unless (= (length t1) (length t2))
+       (value-mismatch expected tr1))
+     (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
+       (expected-but-got (stringify t2) (stringify t1)))
+     (fix-results expected)]
+
     [((tc-results: t1 fs os) (tc-results: t2 fs os))
      (unless (= (length t1) (length t2))
        (value-mismatch expected tr1))
      (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
        (expected-but-got (stringify t2) (stringify t1)))
      (fix-results expected)]
+
+    [((tc-results: t1 f1 o1) (tc-results: t2 f2 o2)) (=> continue)
+     (if (= (length t1) (length t2))
+         (continue)
+         (value-mismatch expected tr1))
+     (fix-results expected)]
+
     [((tc-any-results:) (tc-results: ts fs os))
      (value-mismatch expected tr1)
      (fix-results expected)]

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt

@@ -529,9 +529,9 @@
   (define props
     (match results
       [(tc-any-results:) empty]
-      [(tc-results: _ (FilterSet: f+ f-) _)
+      [(tc-results: _ (list (FilterSet: f+ f-) ...) _)
        (map -or f+ f-)]
-      [(tc-results: _ (FilterSet: f+ f-) _ _ _)
+      [(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _)
        (map -or f+ f-)]))
   (with-lexical-env (env+ (lexical-env) props (box #t))
     (add-unconditional-prop (k) (apply -and props))))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt

@@ -48,7 +48,7 @@
         ([e-r   (in-list expected-results)]
          [names (in-list namess)])
         (match e-r
-          [(tc-results: e-ts (FilterSet: fs+ fs-) os)
+          [(tc-results: e-ts (list (FilterSet: fs+ fs-) ...) os)
            (values e-ts
                    (apply append
                           (for/list ([n (in-list names)]
@@ -58,7 +58,7 @@
                                 (list)
                                 (list (-imp (-not-filter (-val #f) n) f+)
                                       (-imp (-filter (-val #f) n) f-))))))]
-          [(tc-results: e-ts (NoFilter:) _)
+          [(tc-results: e-ts (list (NoFilter:) ...) _)
            (values e-ts null)]))))
   (with-cond-contract append-region ([p1 (listof Filter?)]
                                      [p2 (listof Filter?)])

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/filter-ops.rkt

@@ -214,12 +214,12 @@
   (match results
     ;; TODO add support for filters on tc-any-results
     [(tc-any-results:) results]
-    [(tc-results: ts (FilterSet: fs+ fs-) os)
+    [(tc-results: ts (list (FilterSet: fs+ fs-) ...) os)
      (ret ts
           (for/list ([f+ fs+] [f- fs-])
             (-FS (-and prop f+) (-and prop f-)))
           os)]
-    [(tc-results: ts (FilterSet: fs+ fs-) os dty dbound)
+    [(tc-results: ts (list (FilterSet: fs+ fs-) ...) os dty dbound)
      (ret ts
           (for/list ([f+ fs+] [f- fs-])
             (-FS (-and prop f+) (-and prop f-)))

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/tc-result.rkt

@@ -39,33 +39,32 @@
 
 (define-match-expander tc-result:
   (syntax-rules ()
-   [(_ tp fp op) (struct tc-result (tp fp op))]
-   [(_ tp) (struct tc-result (tp _ _))]))
+   [(_ tp fp op) (tc-result tp fp op)]
+   [(_ tp) (tc-result tp _ _)]))
+
+;; expand-tc-results: (Listof tc-result) -> (Values (Listof Type) (Listof FilterSet) (Listof Object))
+(define (expand-tc-results results)
+  (values (map tc-result-t results) (map tc-result-f results) (map tc-result-o results)))
 
 (define-match-expander tc-results:
   (syntax-rules ()
-   [(_ tp fp op)
-    (struct tc-results ((list (struct tc-result (tp fp op)) (... ...))
-                          #f))]
-   [(_ tp fp op dty dbound)
-    (struct tc-results ((list (struct tc-result (tp fp op)) (... ...))
-                          (cons dty dbound)))]
    [(_ tp)
-    (struct tc-results ((list (struct tc-result (tp _ _)) (... ...))
-                          #f))]))
+    (tc-results (app expand-tc-results tp _ _) #f)]
+   [(_ tp fp op)
+    (tc-results (app expand-tc-results tp fp op) #f)]
+   [(_ tp fp op dty dbound)
+    (tc-results (app expand-tc-results tp fp op) (cons dty dbound))]))
 
 (define-match-expander tc-any-results:
   (syntax-rules ()
    [(_)
-    (struct tc-any-results ())]))
+    (tc-any-results)]))
 
 
 (define-match-expander tc-result1:
   (syntax-rules ()
-   [(_ tp fp op) (struct tc-results ((list (struct tc-result (tp fp op)))
-                                       #f))]
-   [(_ tp) (struct tc-results ((list (struct tc-result (tp _ _)))
-                                 #f))]))
+   [(_ tp) (tc-results: (list tp))]
+   [(_ tp fp op) (tc-results: (list tp) (list fp) (list op))]))
 
 (define (tc-results-ts* tc)
   (match tc
@@ -73,14 +72,19 @@
 
 (define-match-expander Result1:
   (syntax-rules ()
-   [(_ tp) (Values: (list (Result: tp _ _)))]
-   [(_ tp fp op) (Values: (list (Result: tp fp op)))]))
+   [(_ tp) (Results: (list tp))]
+   [(_ tp fp op) (Results: (list tp) (list fp) (list op))]))
+
+;; expand-Results: (Listof Rresult) -> (Values (Listof Type) (Listof FilterSet) (Listof Object))
+(define (expand-Results results)
+  (values (map Result-t results) (map Result-f results) (map Result-o results)))
+
 
 (define-match-expander Results:
   (syntax-rules ()
-   [(_ tp) (Values: (list (Result: tp _ _) (... ...)))]
-   [(_ tp fp op) (Values: (list (Result: tp fp op) (... ...)))]
-   [(_ tp fp op dty dbound) (ValuesDots: (list (Result: tp fp op) (... ...)) dty dbound)]))
+   [(_ tp) (Values: (app expand-Results tp _ _))]
+   [(_ tp fp op) (Values: (app expand-Results tp fp op))]
+   [(_ tp fp op dty dbound) (ValuesDots: (app expand-Results tp fp op) dty dbound)]))
 
 ;; make-tc-result*: Type/c FilterSet/c Object? -> tc-result?
 ;; Smart constructor for a tc-result.