Automated Resyntax fixes (#1450)

* Fix 35 occurrences of `single-clause-match-to-match-define`

This `match` expression can be simplified using `match-define`.

* Fix 1 occurrence of `map-to-for`

This `map` operation can be replaced with a `for/list` loop.

* Fix 7 occurrences of `let-to-define`

Internal definitions are recommended instead of `let` expressions, to reduce nesting.

* Fix 2 occurrences of `inline-unnecessary-define`

This variable is returned immediately and can be inlined.

* Fix 1 occurrence of `if-else-false-to-and`

This `if` expression can be refactored to an equivalent expression using `and`.

* Fix 1 occurrence of `cond-else-if-to-cond`

The `else`-`if` branch of this `cond` expression can be collapsed into the `cond` expression.

* Fix 2 occurrences of `define-let-to-double-define`

This `let` expression can be pulled up into a `define` expression.

* Fix 1 occurrence of `zero-comparison-to-negative?`

This expression is equivalent to calling the `negative?` predicate.

---------

Co-authored-by: resyntax-ci[bot] <181813515+resyntax-ci[bot]@users.noreply.github.com>

Author: resyntax-ci[bot]

typed-racket-lib/typed-racket/env/global-env.rkt

@@ -74,10 +74,10 @@
     #:when (attribute type)))
 
 (define (maybe-finish-register-type id)
-  (let ([v (free-id-table-ref the-mapping id)])
-    (if (box? v)
-        (register-type id (unbox v))
-        #f)))
+  (define v (free-id-table-ref the-mapping id))
+  (if (box? v)
+      (register-type id (unbox v))
+      #f))
 
 (define (unregister-type id)
   (free-id-table-remove! the-mapping id))
@@ -91,13 +91,15 @@
    the-mapping
    (lambda (id e)
      (when (box? e)
-       (let ([bnd (identifier-binding id)])
-         (tc-error/delayed #:stx id
-                           "Declaration for `~a' provided, but `~a' ~a"
-                           (syntax-e id) (syntax-e id)
-                           (cond [(eq? bnd 'lexical) "is a lexical binding"] ;; should never happen
-                                 [(not bnd) "has no definition"]
-                                 [else "is defined in another module"])))))))
+       (define bnd (identifier-binding id))
+       (tc-error/delayed #:stx id
+                         "Declaration for `~a' provided, but `~a' ~a"
+                         (syntax-e id)
+                         (syntax-e id)
+                         (cond
+                           [(eq? bnd 'lexical) "is a lexical binding"] ;; should never happen
+                           [(not bnd) "has no definition"]
+                           [else "is defined in another module"]))))))
 
 ;; map over the-mapping, producing a list
 ;; (id type -> T) -> listof[T]

typed-racket-lib/typed-racket/env/init-envs.rkt

@@ -331,11 +331,10 @@
     [(Instance: ty) `(make-Instance ,(type->sexp ty))]
     [(Signature: name extends mapping)
      (define (serialize-mapping m)
-       (map (lambda (id/ty)
-              (define id (car id/ty))
-              (define ty (force (cdr id/ty)))
-              `(cons (quote-syntax ,id) ,(type->sexp ty)))
-            m))
+       (for/list ([id/ty (in-list m)])
+         (define id (car id/ty))
+         (define ty (force (cdr id/ty)))
+         `(cons (quote-syntax ,id) ,(type->sexp ty))))
      (define serialized-extends (and extends `(quote-syntax ,extends)))
      `(make-Signature (quote-syntax ,name)
                       ,serialized-extends
@@ -437,11 +436,11 @@
      `(make-PrefabPE (quote ,key) ,idx)]))
 
 (define (bound-in-this-module id)
-  (let ([binding (identifier-binding id)])
-    (if (and (list? binding) (module-path-index? (car binding)))
-        (let-values ([(mp base) (module-path-index-split (car binding))])
-          (not mp))
-        #f)))
+  (define binding (identifier-binding id))
+  (if (and (list? binding) (module-path-index? (car binding)))
+      (let-values ([(mp base) (module-path-index-split (car binding))])
+        (not mp))
+      #f))
 
 (define (make-init-code map f)
   (define (bound-f id v)

typed-racket-lib/typed-racket/env/type-alias-env.rkt

@@ -80,10 +80,10 @@
   (match v
     [(struct unresolved (stx _ persistent?))
      (set-unresolved-in-process! v #t)
-     (let ([t (parse-type stx)])
-       (when persistent?
-         (mapping-put! id (make-resolved t)))
-       t)]
+     (define t (parse-type stx))
+     (when persistent?
+       (mapping-put! id (make-resolved t)))
+     t]
     [(struct resolved (t))
      t]))
 

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

@@ -239,12 +239,12 @@
                                                           "#%plain-lambda formals"
                                                           #'formals
                                                           args)]))
-                                 (define check*
-                                   (let ([dom+ (for/fold ([acc '()])
-                                                         ([dom (in-list dom*)]
-                                                          #:when (pair? dom))
-                                                 (cons (cdr dom) acc))])
-                                     (protect-loop rst dom+)))
+                                 (define dom+
+                                   (for/fold ([acc '()])
+                                             ([dom (in-list dom*)]
+                                              #:when (pair? dom))
+                                     (cons (cdr dom) acc)))
+                                 (define check* (protect-loop rst dom+))
                                  (define ann-ty
                                    (and (type-annotation fst #:infer #f)
                                         (get-type fst #:infer #t #:default Univ)))

typed-racket-lib/typed-racket/rep/object-rep.rkt

@@ -272,16 +272,12 @@
        (if (Empty? nm)
            (values c ts)
            (values c (terms-set ts p (+ coeff (terms-ref ts p)))))]
-      [(? exact-integer? new-const)
-       (values (+ new-const c) ts)]
-      [(LExp: c* ts*)
-       (values (+ c c*) (add-terms ts ts*))]
+      [(? exact-integer? new-const) (values (+ new-const c) ts)]
+      [(LExp: c* ts*) (values (+ c c*) (add-terms ts ts*))]
       [(list (? exact-integer? l-coeff) (? LExp? l))
-       (match (scale-obj l-coeff l)
-         [(LExp: c* ts*)
-          (values (+ c c*) (add-terms ts ts*))])]
-      [(? Object? p)
-       (values c (terms-set ts p (add1 (terms-ref ts p))))]
+       (match-define (LExp: c* ts*) (scale-obj l-coeff l))
+       (values (+ c c*) (add-terms ts ts*))]
+      [(? Object? p) (values c (terms-set ts p (add1 (terms-ref ts p))))]
       [(? name-ref/c var)
        (define p (-id-path var))
        (values c (terms-set ts p (add1 (terms-ref ts p))))])))

typed-racket-lib/typed-racket/static-contracts/combinators/case-lambda.rkt

@@ -45,12 +45,15 @@
        (arr-seq-sc-map f (combinator-args v))
        (void))
      (define (sc->contract v f)
-       (match v
-        [(arr-combinator (arr-seq args rest range))
-         (with-syntax ([(arg-stx ...) (map f args)]
-                       [(rest-stx ...) (if rest #`(#:rest #,(f rest)) #'())]
-                       [range-stx (if range #`(values #,@(map f range)) #'any)])
-           #'(arg-stx ... rest-stx ... . -> . range-stx))]))
+       (match-define (arr-combinator (arr-seq args rest range)) v)
+       (with-syntax ([(arg-stx ...) (map f args)]
+                     [(rest-stx ...) (if rest
+                                         #`(#:rest #,(f rest))
+                                         #'())]
+                     [range-stx (if range
+                                    #`(values #,@(map f range))
+                                    #'any)])
+         #'(arg-stx ... rest-stx ... . -> . range-stx)))
      (define (sc->constraints v f)
        (merge-restricts* 'chaperone (map f (arr-seq->list (combinator-args v)))))])
 
@@ -66,20 +69,18 @@
 
 
 (define (arr-seq-sc-map f seq)
-  (match seq
-    [(arr-seq args rest range)
-     (arr-seq
-       (map (λ (a) (f a 'contravariant)) args)
-       (and rest (f rest 'contravariant))
-       (and range (map (λ (a) (f a 'covariant)) range)))]))
+  (match-define (arr-seq args rest range) seq)
+  (arr-seq (map (λ (a) (f a 'contravariant)) args)
+           (and rest (f rest 'contravariant))
+           (and range (map (λ (a) (f a 'covariant)) range))))
 
 (define (arr-seq->list seq)
-  (match seq
-    [(arr-seq args rest range)
-     (append
-       args
-       (if rest (list rest) empty)
-       (or range empty))]))
+  (match-define (arr-seq args rest range) seq)
+  (append args
+          (if rest
+              (list rest)
+              empty)
+          (or range empty)))
 
 
 (struct arr-seq (args rest range)

typed-racket-lib/typed-racket/static-contracts/combinators/control.rkt

@@ -24,14 +24,12 @@
        (pt-seq-map f (combinator-args v))
        (void))
      (define (sc->contract v f)
-       (match v
-        [(prompt-tag-combinator (pt-seq vals call-cc))
-         (with-syntax ([(vals-stx ...) (map f vals)]
-                       [(call-cc-stx ...)
-                        (if call-cc
-                            #`(#:call/cc (values #,@(map f call-cc)))
-                            empty)])
-           #'(prompt-tag/c vals-stx ... call-cc-stx ...))]))
+       (match-define (prompt-tag-combinator (pt-seq vals call-cc)) v)
+       (with-syntax ([(vals-stx ...) (map f vals)]
+                     [(call-cc-stx ...) (if call-cc
+                                            #`(#:call/cc (values #,@(map f call-cc)))
+                                            empty)])
+         #'(prompt-tag/c vals-stx ... call-cc-stx ...)))
      (define (sc->constraints v f)
        (merge-restricts* 'chaperone (map f (pt-seq->list (combinator-args v)))))])
 
@@ -52,16 +50,11 @@
 
 
 (define (pt-seq-map f seq)
-  (match seq
-   [(pt-seq vals call-cc)
-    (define (f* a) (f a 'invariant))
-    (pt-seq
-      (map f* vals)
-      (and call-cc (map f* call-cc)))]))
+  (match-define (pt-seq vals call-cc) seq)
+  (define (f* a)
+    (f a 'invariant))
+  (pt-seq (map f* vals) (and call-cc (map f* call-cc))))
 
 (define (pt-seq->list seq)
-  (match seq
-   [(pt-seq vals call-cc)
-    (append
-      vals
-      (or call-cc empty))]))
+  (match-define (pt-seq vals call-cc) seq)
+  (append vals (or call-cc empty)))

typed-racket-lib/typed-racket/static-contracts/combinators/exist.rkt

@@ -29,12 +29,10 @@
    (define (sc->contract v f)
      (match-define (exist-combinator (list names doms rngs)) v)
      (parameterize ([static-contract-may-contain-free-ids? #t])
-       (define a
-         (with-syntax ([doms-stx (f doms)]
-                       [rngs-stx (f rngs)]
-                       [n (car names)])
-           #'(->i ([n doms-stx]) (_ (n) rngs-stx))))
-       a))
+       (with-syntax ([doms-stx (f doms)]
+                     [rngs-stx (f rngs)]
+                     [n (car names)])
+         #'(->i ([n doms-stx]) (_ (n) rngs-stx)))))
    (define (sc->constraints v f)
      (simple-contract-restrict 'flat))])
 

typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt

@@ -146,13 +146,10 @@
   (match-define (function-combinator args indices mand-kws opt-kws typed-side?) v)
   (define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args)
     (apply split-function-args args indices))
-  (if (and (not rest-arg)
-           (null? (append mand-kw-args mand-args opt-kw-args opt-args))
-           typed-side?)
-      ;; currently we only handle this trivial case
-      ;; we could probably look at the actual kind of `range-args` as well
-      (if (not range-args) 'flat #f)
-      #f))
+  (and (and (not rest-arg) (null? (append mand-kw-args mand-args opt-kw-args opt-args)) typed-side?)
+       ;; currently we only handle this trivial case
+       ;; we could probably look at the actual kind of `range-args` as well
+       (if (not range-args) 'flat #f)))
 
 
 (define (function-sc-constraints v f)