parse-type: inline type applications for simple type constructors

Author: capfredf

typed-racket-lib/typed-racket/private/parse-type.rkt

@@ -1385,13 +1385,20 @@
                                 (lambda (e)
                                   (match-define (exn:fail:contract:arity:type-constructor _ _ expected given) e)
                                   (err expected given))])
-                 (define alias (lookup-type-alias #'id (lambda (x) x) (lambda () #f)))
-                 (match alias
-                   [(? Name?)
-                    (if (equal? arity (length args^))
-                        (make-App alias args^)
-                        (err arity (length args^)))]
-                   [_ (apply rator args^)]))]
+                 (cond
+                   ;; in the checking mode, inline type applications of simple
+                   ;; type constructors
+                   [(and (not mode)
+                         (simple-type-constructor? #'id))
+                    (apply rator args^)]
+                   [else
+                    (define alias (lookup-type-alias #'id (lambda (x) x) (lambda () #f)))
+                    (match alias
+                      [(? Name?)
+                       (if (equal? arity (length args^))
+                           (make-App alias args^)
+                           (err arity (length args^)))]
+                      [_ (apply rator args^)])]))]
               [(? Name?)
                (resolve-app-check-error rator args^ stx)
                (define app (make-App rator args^))

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

@@ -10,9 +10,9 @@
          "../find-annotation.rkt"
          "../tc-metafunctions.rkt"
          "../../types/abbrev.rkt"
-         "../../types/resolve.rkt"
          "../../types/utils.rkt"
          "../../types/generalize.rkt"
+         "../../types/resolve.rkt"
          "../../types/type-table.rkt"
          "../../private/type-annotation.rkt"
          "../../private/syntax-properties.rkt"
@@ -109,8 +109,9 @@
                        (generalize (tc-expr/t ac)))))]
            [acc-ty (or
                     (type-annotation #'val #:infer #t)
-                    (match (resolve expected)
-                      [(tc-result1: (app resolve (and t (Listof: _)))) t]
+                    (match expected
+                      [(tc-result1: (and t (or (? App? (app resolve-once (Listof: _))) (Listof: _))))
+                       t]
                       [_ #f])
                     (generalize -Null))])
        ;; this check is needed because the type annotation may come

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

@@ -12,6 +12,7 @@
          "../../types/type-table.rkt"
          "../../types/utils.rkt"
          "../../types/substitute.rkt"
+         "../../types/resolve.rkt"
          "../../rep/type-rep.rkt"
          "../../env/tvar-env.rkt"
          (prefix-in i: "../../infer/infer.rkt")
@@ -154,7 +155,7 @@
   ;; special case for `reverse' to propagate expected type info
   (pattern ((~and fun (~or reverse k:reverse)) arg)
     (match expected
-      [(tc-result1: (and return-ty (Listof: _)))
+      [(tc-result1: (and return-ty (or (? App? (app resolve-once (Listof: _))) (Listof: _))))
        (begin0
          (tc-expr/check #'arg expected)
          (add-typeof-expr #'fun (ret (-> return-ty return-ty))))]

typed-racket-test/succeed/poly-lists.rkt

@@ -0,0 +1,15 @@
+#lang typed/racket
+
+(define-type (Assoc X Y) (Listof (Pairof X Y)))
+
+(: f : (Listof Integer) (Listof String) -> (Listof (Pairof Integer String)))
+(define (f l m)
+  (for/list : (Assoc Integer String) ([x : Integer (in-list l)]
+                                      [y : String (in-list m)])
+    (cons x y)))
+
+
+(define (g [l : (Listof Integer)] [m : (Listof String)]) : (Assoc Integer String)
+  (for/list ([x (in-list l)]
+             [y (in-list m)])
+    (cons x y)))