improves error reporting for (list ....)

closes #995

Author: capfredf

typed-racket-lib/typed-racket/typecheck/signatures.rkt

@@ -13,6 +13,7 @@
    [cond-contracted tc-expr/check/t? (syntax? (or/c tc-results/c #f) . -> . (or/c Type? #f))]
    [cond-contracted tc-body/check (syntax? (or/c tc-results/c #f) . -> . full-tc-results/c)]
    [cond-contracted tc-expr/t (syntax? . -> . Type?)]
+   [cond-contracted tc-expr/t* (syntax? . -> . (values Type? boolean?))]
    [cond-contracted single-value ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]
    [cond-contracted tc-dep-fun-arg ((syntax?) ((or/c tc-results/c #f)) . ->* . full-tc-results/c)]))
 

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-list.rkt

@@ -4,7 +4,7 @@
 (require "../../utils/utils.rkt"
          "signatures.rkt"
          "utils.rkt"
-         syntax/parse syntax/stx racket/match racket/sequence
+         syntax/parse syntax/stx racket/match
          (typecheck signatures tc-funapp error-message)
          (types abbrev type-table utils substitute)
          (rep type-rep)
@@ -101,6 +101,7 @@
            ;; We want to infer the largest vs that are still under the element types
            (define substs (i:infer vs null (list l-type) (list t) (-values (list (-> l-type Univ)))
                                    #:multiple? #t))
+           
            (cond
              [substs
               (define result
@@ -113,8 +114,12 @@
                   (add-typeof-expr #'op-name (ret (->* arg-tys return-ty)))
                   (ret return-ty)))
               (or result
-                  (begin (expected-but-got t (-Tuple (map tc-expr/t args-list)))
-                         (fix-results expected)))]
+                  (let-values ([(tys errs) (for/lists (tys errs)
+                                                      ([i (in-list args-list)])
+                                             (tc-expr/t* i))])
+                    (when (andmap not errs)
+                      (expected-but-got t (-Tuple tys)))
+                    (fix-results expected)))]
              [else
               (define arg-tys (map tc-expr/t args-list))
               (define return-ty (-Tuple arg-tys))

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

@@ -67,6 +67,10 @@
     [(tc-result1: t _ _) t]
     [t (int-err "tc-expr returned ~a, not a single tc-result, for ~a" t (syntax->datum e))]))
 
+(define (tc-expr/t* expr)
+  (parameterize ([current-type-error? #f])
+    (values (tc-expr/t expr) (current-type-error?))))
+
 (define (tc-expr/check/t e t)
   (match (tc-expr/check e t)
     [(tc-result1: t) t]))

typed-racket-test/fail/gh-issue-995.rkt

@@ -0,0 +1,6 @@
+#;
+(exn-pred #rx".*expected: Symbol.*given: String")
+#lang typed/racket
+
+(ann (list (symbol->string "10"))
+     (Listof String))

typed-racket-test/unit-tests/typecheck-tests.rkt

@@ -3488,6 +3488,12 @@
          (list (vector 1 2 3))
         #:ret (tc-ret (-seq (-vec Univ)))
         #:expected (tc-ret (-seq (-vec Univ)))]
+       
+       [tc-err
+        (ann (list (symbol->string "10")) (Listof String))
+        #:ret (tc-ret (-lst -String))
+        #:expected (tc-ret (-lst -String))
+        #:msg #rx"expected: Symbol.*given: String.*"]
 
        ;; PR 14557 - apply union of functions with different return values
        [tc-err