Make simple substitution happen all at once.

Closes pr12920.

collects/tests/typed-racket/succeed/type-alias-rec-struct.rkt

@@ -0,0 +1,6 @@
+#lang typed/racket/base
+;; Iteratee
+(define-type (Alias A D) (U #f (Main A D)))
+
+(struct: (A D) Main
+  ([resume : (Alias A D)])) ;

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

@@ -366,33 +366,13 @@
        (let loop
          ([rator (parse-type #'id)]
           [args (map parse-type (syntax->list #'(arg args ...)))])
+         (resolve-app-check-error rator args stx)
          (match rator
-           [(Name: n)
+           [(Name: _) (make-App rator args stx)]
-            (when (and (current-poly-struct)
+           [(Poly: _ _) (instantiate-poly rator args)]
-                       (free-identifier=? n (poly-name (current-poly-struct)))
-                       (not (or (ormap Error? args)
-                                (andmap type-equal? args (poly-vars (current-poly-struct))))))
-              (tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator args))
-            (make-App rator args stx)]
-           [(Poly: ns _)
-            (unless (= (length args) (length ns))
-              (tc-error "Wrong number of arguments to type ~a, expected ~a but got ~a" rator (length ns) (length args)))
-            (instantiate-poly rator args)]
            [(Mu: _ _) (loop (unfold rator) args)]
            [(Error:) Err]
-           [_ (tc-error/delayed "Type ~a cannot be applied, arguments were: ~a" rator args)
+           [_ Err]))]
-              Err]))
-       #;
-       (let ([ty (parse-type #'id)])
-         #;(printf "ty is ~a" ty)
-         (unless (Poly? ty)
-           (tc-error "not a polymorphic type: ~a" (syntax-e #'id)))
-         (unless (= (length (syntax->list #'(arg args ...))) (Poly-n ty))
-           (tc-error "wrong number of arguments to type constructor ~a: expected ~a, got ~a"
-                     (syntax-e #'id)
-                     (Poly-n ty)
-                     (length (syntax->list #'(arg args ...)))))
-         (instantiate-poly ty (map parse-type (syntax->list #'(arg args ...)))))]
       [t:atom
        (-val (syntax-e #'t))]
       [_ (tc-error "not a valid type: ~a" (syntax->datum stx))])))
@@ -463,4 +443,3 @@
 (define parse-tc-results/id (parse/id parse-tc-results))
 
 (define parse-type/id (parse/id parse-type))
-

collects/typed-racket/types/resolve.rkt

@@ -8,7 +8,8 @@
          racket/match
          racket/contract)
 
-(provide resolve-name resolve-app needs-resolving? resolve)
+(provide resolve-name resolve-app needs-resolving?
+         resolve resolve-app-check-error)
 (provide/cond-contract [resolve-once (Type/c . -> . (or/c Type/c #f))])
 
 (define-struct poly (name vars) #:prefab)
@@ -21,24 +22,35 @@
 
 (define already-resolving? (make-parameter #f))
 
-(define (resolve-app rator rands stx)
-  (parameterize ([current-orig-stx stx]
 
-                 [already-resolving? #t])
+(define (resolve-app-check-error rator rands stx)
+  (parameterize ([current-orig-stx stx])
     (match rator
       [(Poly-unsafe: n _)
        (unless (= n (length rands))
          (tc-error "wrong number of arguments to polymorphic type: expected ~a and got ~a"
-                   n (length rands)))
+                   n (length rands)))]
-       (instantiate-poly rator rands)]
       [(Name: n)
        (when (and (current-poly-struct)
                   (free-identifier=? n (poly-name (current-poly-struct)))
                   (not (or (ormap Error? rands)
                            (andmap type-equal? rands (poly-vars (current-poly-struct))))))
-         (tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator rands))
+         (tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator rands))]
+      [(Mu: _ _) (void)]
+      [(App: _ _ _) (void)]
+      [(Error:) (void)]
+      [_ (tc-error/delayed "Type ~a cannot be applied, arguments were: ~a" rator rands)])))
+
+
+(define (resolve-app rator rands stx)
+  (parameterize ([current-orig-stx stx]
+                 [already-resolving? #t])
+    (resolve-app-check-error rator rands stx)
+    (match rator
+      [(Name: _)
        (let ([r (resolve-name rator)])
          (and r (resolve-app r rands stx)))]
+      [(Poly: _ _) (instantiate-poly rator rands)]
       [(Mu: _ _) (resolve-app (unfold rator) rands stx)]
       [(App: r r* s) (resolve-app (resolve-app r r* s) rands stx)]
       [_ (tc-error "cannot apply a non-polymorphic type: ~a" rator)])))

collects/typed-racket/types/substitute.rkt

@@ -21,6 +21,7 @@
 (define-struct/cond-contract (i-subst/dotted subst-rhs) ([types (listof Type/c)] [dty Type/c] [dbound symbol?]) #:transparent)
 
 (define substitution/c (hash/c symbol? subst-rhs? #:immutable #t))
+(define simple-substitution/c (hash/c symbol? Type/c #:immutable #t))
 
 (define (subst v t e) (substitute t v e))
 
@@ -32,38 +33,48 @@
     (values v (t-subst t))))
 
 
-;; substitute : Type Name Type -> Type
+
-(define/cond-contract (substitute image name target #:Un [Un (lambda (args) (apply Un args))])
+;; substitute-many : Hash[Name,Type] Type -> Type
-  ((Type/c symbol? Type?) (#:Un procedure?) . ->* . Type?)
+(define/cond-contract (substitute-many subst target #:Un [Un (lambda (args) (apply Un args))])
-  (define (sb t) (substitute image name t #:Un Un))
+  ((simple-substitution/c Type?) (#:Un procedure?) . ->* . Type?)
-  (if (hash-ref (free-vars* target) name #f)
+  (define (sb t) (substitute-many subst t #:Un Un))
+  (define names (hash-keys subst))
+  (if (ormap (lambda (name) (hash-has-key? (free-vars* target) name)) names)
       (type-case (#:Type sb #:Filter (sub-f sb) #:Object (sub-o sb))
                  target
                  [#:Union tys (Un (map sb tys))]
-                 [#:F name* (if (eq? name* name) image target)]
+                 [#:F name (hash-ref subst name target)]
                  [#:arr dom rng rest drest kws
-                        (begin
+                        (cond
-                          (when (and (pair? drest)
+                          ((and (pair? drest) (ormap (and/c (cdr drest) (not/c bound-tvar?)) names)) =>
-                                     (eq? name (cdr drest))
+                           (lambda (name)
-                                     (not (bound-tvar? name)))
+                             (int-err "substitute used on ... variable ~a in type ~a" name target)))
-                            (int-err "substitute used on ... variable ~a in type ~a" name target))
+                          (else
                            (make-arr (map sb dom)
                                      (sb rng)
                                      (and rest (sb rest))
                                      (and drest (cons (sb (car drest)) (cdr drest)))
-                                    (map sb kws)))]
+                                     (map sb kws))))]
                  [#:ValuesDots types dty dbound
-                               (begin
+                               (cond
-                                 (when (and (eq? name dbound) (not (bound-tvar? name)))
+                                 ((ormap (and/c dbound (not/c bound-tvar?)) names) =>
-                                   (int-err "substitute used on ... variable ~a in type ~a" name target))
+                                  (lambda (name)
+                                    (int-err "substitute used on ... variable ~a in type ~a" name target)))
                                  (make-ValuesDots (map sb types) (sb dty) dbound))]
                  [#:ListDots dty dbound
-                             (begin
+                             (cond
-                               (when (and (eq? name dbound) (not (bound-tvar? name)))
+                               ((ormap (and/c dbound (not/c bound-tvar?)) names) =>
-                                 (int-err "substitute used on ... variable ~a in type ~a" name target))
+                                (lambda (name)
+                                  (int-err "substitute used on ... variable ~a in type ~a" name target)))
                                (make-ListDots (sb dty) dbound))])
       target))
 
+
+;; substitute : Type Name Type -> Type
+(define/cond-contract (substitute image name target #:Un [Un (lambda (args) (apply Un args))])
+  ((Type/c symbol? Type?) (#:Un procedure?) . ->* . Type?)
+  (substitute-many (hash name image) target #:Un Un))
+
 ;; implements angle bracket substitution from the formalism
 ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type
 (define/cond-contract (substitute-dots images rimage name target)
@@ -142,12 +153,21 @@
 ;; substitute many variables
 ;; substitution = Listof[U List[Name,Type] List[Name,Listof[Type]]]
 ;; subst-all : substitution Type -> Type
-(define/cond-contract (subst-all s t)
+(define/cond-contract (subst-all s ty)
   (substitution/c Type? . -> . Type?)
-  (for/fold ([t t]) ([(v r) (in-hash s)])
+
+  (define t-substs
+    (for/fold ([acc (hash)]) ([(v r) (in-hash s)])
       (match r
         [(t-subst img)
-       (substitute img v t)]
+         (hash-set acc v img)]
+        [_ acc])))
+  (define t-substed-ty (substitute-many t-substs ty))
+
+
+  (for/fold ([t t-substed-ty]) ([(v r) (in-hash s)])
+    (match r
+      [(t-subst img) t]
       [(i-subst imgs)
        (substitute-dots imgs #f v t)]
       [(i-subst/starred imgs rest)