Automated Resyntax fixes

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

@@ -183,8 +183,8 @@
 ;; (Syntax -> Type) -> Syntax Any -> Syntax
 ;; See `parse-type/id`. This is a curried generalization.
 (define ((parse/id p) loc datum)
-  (let* ([stx* (datum->syntax loc datum loc loc)])
-    (p stx*)))
+  (define stx* (datum->syntax loc datum loc loc))
+  (p stx*))
 
 (define (parse-literal-alls stx)
   (syntax-parse stx
@@ -902,15 +902,16 @@
                                      (k Err)
                                      (remove-duplicates res)))
                        ([ty (in-syntax #'(tys ...))])
-               (let ([t (do-parse ty)])
-                 (match (resolve t)
-                   [(Fun: arrows) (values (append res arrows) err?)]
-                   [_ (if (side-effect-mode? mode)
-                          (values res #t)
-                          (parse-error
-                           #:stx ty
-                           "expected a function type for component of case-> type"
-                           "given" t))]))))
+               (define t (do-parse ty))
+               (match (resolve t)
+                 [(Fun: arrows) (values (append res arrows) err?)]
+                 [_
+                  (if (side-effect-mode? mode)
+                      (values res #t)
+                      (parse-error #:stx ty
+                                   "expected a function type for component of case-> type"
+                                   "given"
+                                   t))])))
            (make-Fun arrows))]
         [(:Rec^ x:id t)
          (let* ([var (syntax-e #'x)])

typed-racket-lib/typed-racket/private/shallow-rewrite.rkt

@@ -415,19 +415,19 @@
   stx)
 
 (define (maybe-add-typeof-expr new-stx old-stx)
-  (let ((old-type (maybe-type-of old-stx)))
-    (when old-type
-      (add-typeof-expr new-stx old-type))))
+  (define old-type (maybe-type-of old-stx))
+  (when old-type
+    (add-typeof-expr new-stx old-type)))
 
 (define (maybe-add-test-position new-stx old-stx)
   (maybe-add-test-true new-stx old-stx)
   (maybe-add-test-false new-stx old-stx)
   (void))
 
 (define (maybe-add-scoped-tvar new-stx old-stx)
-  (let ([old-layer (lookup-scoped-tvar-layer old-stx)])
-    (when old-layer
-      (add-scoped-tvars new-stx old-layer))))
+  (define old-layer (lookup-scoped-tvar-layer old-stx))
+  (when old-layer
+    (add-scoped-tvars new-stx old-layer)))
 
 (define (maybe-add-test-true new-stx old-stx)
   (when (test-position-takes-true-branch old-stx)
@@ -629,12 +629,10 @@
     (λ (mpi)
       (hash-ref! cache mpi
         (λ () ;; Typed Racket always installs a `#%type-decl` submodule
-          (let* ([mpi+ (module-path-index-join '(submod "." #%type-decl) mpi)])
-            (parameterize ([current-namespace (make-base-namespace)])
-              (with-handlers ([exn:fail:contract? (lambda (exn) #f)])
-                (and mpi+
-                     (dynamic-require mpi+ #f)
-                     #t)))))))))
+          (define mpi+ (module-path-index-join '(submod "." #%type-decl) mpi))
+          (parameterize ([current-namespace (make-base-namespace)])
+            (with-handlers ([exn:fail:contract? (lambda (exn) #f)])
+              (and mpi+ (dynamic-require mpi+ #f) #t))))))))
 
 (define (protect-domain dom-type dom-stx ctx ctc-cache)
   (define-values [extra-def* ctc-stx]

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

@@ -89,46 +89,49 @@
    (listof tc-result?))
   (match stxs
     [(list stx ...)
-     (let ([anns (for/list ([s (in-list stxs)])
-                   (cond
-                     ;; if the lhs identifier is the rest parameter, its type is
-                     ;; (Listof ty), where ty is the annotated type
-                     [(rst-arg-property s)
-                      (make-Listof (type-annotation s #:infer #t))]
-                     [else (type-annotation s #:infer #t)]))])
-       (if (for/and ([a (in-list anns)]) a)
-           (match (tc-expr/check expr (ret anns))
-             [(tc-results: tcrs _) tcrs])
-           (match (tc-expr expr)
-             [(tc-any-results: _)
-              (tc-error/expr
-               #:return (map (λ _ (-tc-result -Bottom)) stxs)
-               "Expression should produce ~a values, but produces an unknown number of values"
-               (length stxs))]
-             [(tc-result1: (== -Bottom))
-              (for/list ([_ (in-range (length stxs))])
-                (-tc-result -Bottom))]
-             [(tc-results: tcrs _)
-              (cond
-                [(not (= (length stxs) (length tcrs)))
-                 (tc-error/expr #:return (map (λ _ (-tc-result -Bottom)) stxs)
-                                "Expression should produce ~a values, but produces ~a values of types ~a"
-                                (length stxs)
-                                (length tcrs)
-                                (stringify (map tc-result-t tcrs)))]
-                [else
-                 (for/list ([stx (in-list stxs)]
-                            [tcr (in-list tcrs)]
-                            [a   (in-list anns)])
-                   (match tcr
-                     [(tc-result: ty ps o)
-                      (cond [a (check-type stx ty a)
-                               (-tc-result a ps o)]
-                            ;; mutated variables get generalized, so that we don't
-                            ;; infer too small a type
-                            [(is-var-mutated? stx)
-                             (-tc-result (generalize ty) ps o)]
-                            [else (-tc-result ty ps o)])]))])])))]))
+     (define anns
+       (for/list ([s (in-list stxs)])
+         (cond
+           ;; if the lhs identifier is the rest parameter, its type is
+           ;; (Listof ty), where ty is the annotated type
+           [(rst-arg-property s) (make-Listof (type-annotation s #:infer #t))]
+           [else (type-annotation s #:infer #t)])))
+     (if (for/and ([a (in-list anns)])
+           a)
+         (match (tc-expr/check expr (ret anns))
+           [(tc-results: tcrs _) tcrs])
+         (match (tc-expr expr)
+           [(tc-any-results: _)
+            (tc-error/expr
+             #:return (map (λ _ (-tc-result -Bottom)) stxs)
+             "Expression should produce ~a values, but produces an unknown number of values"
+             (length stxs))]
+           [(tc-result1: (== -Bottom))
+            (for/list ([_ (in-range (length stxs))])
+              (-tc-result -Bottom))]
+           [(tc-results: tcrs _)
+            (cond
+              [(not (= (length stxs) (length tcrs)))
+               (tc-error/expr
+                #:return (map (λ _ (-tc-result -Bottom)) stxs)
+                "Expression should produce ~a values, but produces ~a values of types ~a"
+                (length stxs)
+                (length tcrs)
+                (stringify (map tc-result-t tcrs)))]
+              [else
+               (for/list ([stx (in-list stxs)]
+                          [tcr (in-list tcrs)]
+                          [a (in-list anns)])
+                 (match tcr
+                   [(tc-result: ty ps o)
+                    (cond
+                      [a
+                       (check-type stx ty a)
+                       (-tc-result a ps o)]
+                      ;; mutated variables get generalized, so that we don't
+                      ;; infer too small a type
+                      [(is-var-mutated? stx) (-tc-result (generalize ty) ps o)]
+                      [else (-tc-result ty ps o)])]))])]))]))
 
 ;; check that e-type is compatible with ty in context of stx
 ;; otherwise, error

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

@@ -554,13 +554,11 @@
         ;; Avoid putting (-> any T) contracts on struct predicates (where Boolean <: T)
         ;; Optimization: if the value is typed, we can assume it's not wrapped
         ;;  in a type-unsafe chaperone/impersonator and use the unsafe contract
-        (let* ([unsafe-spp/sc (flat/sc #'struct-predicate-procedure?)]
-               [safe-spp/sc (flat/sc #'struct-predicate-procedure?/c)]
-               [optimized/sc (if (from-typed? typed-side)
-                                 unsafe-spp/sc
-                                 safe-spp/sc)]
-               [spt-pred-procedure?/sc (flat/sc #'struct-type-property-predicate-procedure?)])
-          (or/sc optimized/sc spt-pred-procedure?/sc (t->sc/fun t)))]
+        (define unsafe-spp/sc (flat/sc #'struct-predicate-procedure?))
+        (define safe-spp/sc (flat/sc #'struct-predicate-procedure?/c))
+        (define optimized/sc (if (from-typed? typed-side) unsafe-spp/sc safe-spp/sc))
+        (define spt-pred-procedure?/sc (flat/sc #'struct-type-property-predicate-procedure?))
+        (or/sc optimized/sc spt-pred-procedure?/sc (t->sc/fun t))]
        [(? Fun? t) (t->sc/fun t)]
        [(? DepFun? t) (t->sc/fun t)]
        [(Set: t) (set/sc (t->sc t))]
@@ -1165,10 +1163,8 @@
   ;; Match the range of an arr and determine if a contract can be generated
   ;; and call the given thunk or raise an error
   (define (handle-arrow-range arrow proceed)
-    (match arrow
-      [(or (Arrow: _ _ _ rng)
-           (DepFun: _ _ rng))
-       (handle-range rng proceed)]))
+    (match-define (or (Arrow: _ _ _ rng) (DepFun: _ _ rng)) arrow)
+    (handle-range rng proceed))
   (define (handle-range rng proceed)
     (match rng
       [(Values: (list (Result: _
@@ -1293,28 +1289,20 @@
                             arrows)))])]
     [(DepFun/ids: ids dom pre rng)
      (define (continue)
-       (match rng
-         [(Values: (list (Result: rngs _ _) ...))
-          (define (dom-id? id) (member id ids free-identifier=?))
-          (define-values (dom* dom-deps)
-            (for/lists (_1 _2) ([d (in-list dom)])
-              (values (t->sc/neg d)
-                      (filter dom-id? (free-ids d)))))
-          (define pre* (if (TrueProp? pre) #f (t->sc/neg pre)))
-          (define pre-deps (filter dom-id? (free-ids pre)))
-          (define rng* (map t->sc rngs))
-          (define rng-deps (filter dom-id?
-                                   (remove-duplicates
-                                    (apply append (map free-ids rngs))
-                                    free-identifier=?)))
-          (->i/sc (from-typed? typed-side)
-                  ids
-                  dom*
-                  dom-deps
-                  pre*
-                  pre-deps
-                  rng*
-                  rng-deps)]))
+       (match-define (Values: (list (Result: rngs _ _) ...)) rng)
+       (define (dom-id? id)
+         (member id ids free-identifier=?))
+       (define-values (dom* dom-deps)
+         (for/lists (_1 _2) ([d (in-list dom)]) (values (t->sc/neg d) (filter dom-id? (free-ids d)))))
+       (define pre*
+         (if (TrueProp? pre)
+             #f
+             (t->sc/neg pre)))
+       (define pre-deps (filter dom-id? (free-ids pre)))
+       (define rng* (map t->sc rngs))
+       (define rng-deps
+         (filter dom-id? (remove-duplicates (apply append (map free-ids rngs)) free-identifier=?)))
+       (->i/sc (from-typed? typed-side) ids dom* dom-deps pre* pre-deps rng* rng-deps))
      (handle-range rng continue)]))
 
 ;; Generate a contract for a object/class method clause

typed-racket-lib/typed-racket/private/user-defined-type-constr.rkt

@@ -30,7 +30,8 @@
     [_ #f]))
 
 (define (recursive-type-constr? constr)
-  (match constr
-    [(struct* TypeConstructor
-              ([real-trep-constr (struct* user-defined-type-op ([recursive? recursive?]))]))
-     recursive?]))
+  (match-define (struct* TypeConstructor
+                         ([real-trep-constr
+                           (struct* user-defined-type-op ([recursive? recursive?]))]))
+    constr)
+  recursive?)

typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt

@@ -290,12 +290,10 @@
       [(tc-result1: type) (resolve type)]
       [_ #f]))
   (match expected-type
-    [(? Class? class-type)
-     (ret (parse-and-check form class-type))]
+    [(? Class? class-type) (ret (parse-and-check form class-type))]
     [(Poly-names: ns body-type)
-     (match (check-class form (ret body-type))
-       [(tc-result1: t f o)
-        (ret (make-Poly ns t) f o)])]
+     (match-define (tc-result1: t f o) (check-class form (ret body-type)))
+     (ret (make-Poly ns t) f o)]
     [_ (ret (parse-and-check form #f))]))
 
 ;; Syntax Option<Type> -> Type

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

@@ -379,25 +379,34 @@
           msg-vars
           (Fun: (list (Arrow: msg-doms msg-rests kws msg-rngs) ...))
           _))
-     (let ([fcn-string (if name
-                           (format "function with keywords ~a" (syntax->datum name))
-                           "function with keywords")])
-       (if (and (andmap null? msg-doms)
-                (null? argtypes))
-           (tc-error/expr (string-append
-                           "Could not infer types for applying polymorphic "
+     (define fcn-string
+       (if name
+           (format "function with keywords ~a" (syntax->datum name))
+           "function with keywords"))
+     (if (and (andmap null? msg-doms) (null? argtypes))
+         (tc-error/expr
+          (string-append "Could not infer types for applying polymorphic " fcn-string "\n"))
+         (domain-mismatches
+          f-stx
+          args-stx
+          t
+          msg-doms
+          msg-rests
+          msg-rngs
+          argtypes
+          #f
+          #f
+          #:expected expected
+          #:msg-thunk
+          (lambda (dom)
+            (string-append "Polymorphic "
                            fcn-string
-                           "\n"))
-           (domain-mismatches f-stx args-stx t msg-doms msg-rests
-                              msg-rngs argtypes #f #f #:expected expected
-                              #:msg-thunk (lambda (dom)
-                                            (string-append
-                                             "Polymorphic " fcn-string " could not be applied to arguments:\n"
-                                             dom
-                                             (if (not (subset? (apply set-union (seteq) (map fv/list msg-doms))
-                                                               (list->seteq msg-vars)))
-                                                 (string-append "Type Variables: " (stringify msg-vars) "\n")
-                                                 ""))))))]))
+                           " could not be applied to arguments:\n"
+                           dom
+                           (if (not (subset? (apply set-union (seteq) (map fv/list msg-doms))
+                                             (list->seteq msg-vars)))
+                               (string-append "Type Variables: " (stringify msg-vars) "\n")
+                               "")))))]))
 
 ;; name->function-str : (Option Identifier) -> String
 ;; Produce a function name string for error messages

typed-racket-lib/typed-racket/typecheck/tc-apply.rkt

@@ -50,15 +50,24 @@
 
   ;; Raises an error message for the case that the arguments do not match any of the domains
   (define (failure)
-    (match f-ty
-      [(tc-result1:
-         (and t (AnyPoly-names: _ _
-                                (Fun: (list (Arrow: doms rests (list (Keyword: _ _ #f) ...) rngs) ..1)))))
-       (domain-mismatches f args t doms rests rngs arg-tres full-tail-ty #f
-                          #:msg-thunk (lambda (dom)
-                                        (string-append
-                                         "Bad arguments to function in `apply':\n"
-                                         dom)))]))
+    (match-define (tc-result1: (and t
+                                    (AnyPoly-names:
+                                     _
+                                     _
+                                     (Fun: (list (Arrow: doms rests (list (Keyword: _ _ #f) ...) rngs)
+                                                 ..1)))))
+      f-ty)
+    (domain-mismatches f
+                       args
+                       t
+                       doms
+                       rests
+                       rngs
+                       arg-tres
+                       full-tail-ty
+                       #f
+                       #:msg-thunk
+                       (lambda (dom) (string-append "Bad arguments to function in `apply':\n" dom))))
 
   (match f-ty
     ;; apply of a simple function or polymorphic function
@@ -74,9 +83,8 @@
            ;; Takes a possible substitution and computes
            ;; the substituted range type if it is not #f
            (define (finish substitution)
-             (begin0
-               (and substitution (do-ret (subst-all substitution rng)))
-               (add-typeof-expr f (ret (make-Fun (list arrow))))))
+             (and substitution (do-ret (subst-all substitution rng))))
+           (add-typeof-expr f (ret (make-Fun (list arrow))))
            (finish
             (infer vars dotted-vars
                    (list (-Tuple* arg-tys full-tail-ty))