From e55f39dccd2505d36b31372c1e0587ca78478055 Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Sat, 31 May 2014 09:33:03 -0700
Subject: [PATCH] Make inference on (list a ..) work better.

---
 .../typecheck/tc-app/tc-app-list.rkt          | 28 ++++++++++---------
 .../unit-tests/typecheck-tests.rkt            |  6 ++++
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt
index d7a140bc02..cdf59b3c86 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt
@@ -9,6 +9,7 @@
          (types abbrev utils union substitute)
          (rep type-rep)
          (env tvar-env)
+         (prefix-in i: (infer infer))
 
          (for-label
           racket/base
@@ -81,19 +82,20 @@
         [_ (tc/app-regular #'form expected)])))
   ;; special case for `list'
   (pattern (list . args)
-    (match expected
-      [(tc-result1: (Listof: elem-ty))
-       (for ([i (in-syntax #'args)])
-         (tc-expr/check i (ret elem-ty)))
-       (ret (-lst elem-ty))]
-      [(tc-result1: (List: (? (lambda (ts) (= (syntax-length #'args)
-                                              (length ts)))
-                              ts)))
-       (ret (-Tuple
-              (for/list ([ac (in-syntax #'args)]
-                         [exp (in-list ts)])
-                (tc-expr/check/t ac (ret exp)))))]
-      [_ (ret (-Tuple (stx-map tc-expr/t #'args)))]))
+    (let ()
+      (define vs (stx-map (λ (x) (gensym)) #'args))
+      (define l-type (-Tuple (map make-F vs)))
+      (define subst
+        (match expected
+          [(tc-result1: t)
+           ;; We want to infer the largest vs that are still under the element types
+           (i:infer vs null (list l-type) (list t) (-values (list (-> l-type Univ))))]
+          [_ #f]))
+      (ret (-Tuple
+             (for/list ([i (in-syntax #'args)] [v (in-list vs)])
+                (if subst
+                    (tc-expr/check/t i (ret (subst-all subst (make-F v))))
+                    (tc-expr/t i)))))))
   ;; special case for `list*'
   (pattern (list* . args)
     (match-let* ([(list tys ... last) (stx-map tc-expr/t #'args)])
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 f106e7e52b..2dbeae6949 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
@@ -2991,6 +2991,12 @@
         ((letrec ([lp (lambda (x) lp)]) lp) 'y)
         #:ret (ret (t:-> -Symbol Univ))
         #:expected (ret (t:-> -Symbol Univ) -no-filter -no-obj)]
+
+       [tc-e
+         (list (vector 1 2 3))
+        #:ret (ret (-seq (-vec Univ)))
+        #:expected (ret (-seq (-vec Univ)))]
+
         )
 
   (test-suite