Automated Resyntax fixes

typed-racket-lib/typed-racket/infer/infer-unit.rkt

@@ -65,34 +65,28 @@
    [indices (listof symbol?)]) #:transparent)
 
 (define (context-add-vars ctx vars)
-  (match ctx
-    [(context V X Y)
-     (context V (append vars X) Y)]))
+  (match-define (context V X Y) ctx)
+  (context V (append vars X) Y))
 
 (define (context-add-var ctx var)
-  (match ctx
-    [(context V X Y)
-     (context V (cons var X) Y)]))
+  (match-define (context V X Y) ctx)
+  (context V (cons var X) Y))
 
 (define (context-add ctx #:bounds [bounds empty] #:vars [vars empty] #:indices [indices empty])
-  (match ctx
-    [(context V X Y)
-     (context (append bounds V) (append vars X) (append indices Y))]))
+  (match-define (context V X Y) ctx)
+  (context (append bounds V) (append vars X) (append indices Y)))
 
 (define (inferable-index? ctx bound)
-  (match ctx
-    [(context _ _ Y)
-     (memq bound Y)]))
+  (match-define (context _ _ Y) ctx)
+  (memq bound Y))
 
 (define ((inferable-var? ctx) var)
-  (match ctx
-    [(context _ X _)
-     (memq var X)]))
+  (match-define (context _ X _) ctx)
+  (memq var X))
 
 (define (empty-cset/context ctx)
-  (match ctx
-    [(context _ X Y)
-     (empty-cset X Y)]))
+  (match-define (context _ X Y) ctx)
+  (empty-cset X Y))
 
 
 
@@ -766,9 +760,8 @@
             (list values -Nat)))
          (define type
            (for/or ([pred-type (in-list possibilities)])
-             (match pred-type
-               [(list pred? type)
-                (and (pred? n) type)])))
+             (match-define (list pred? type) pred-type)
+             (and (pred? n) type)))
          (cgen/seq context (seq (list type) -null-end) ts*)]
         ;; numeric? == #true
         [((Base-bits: #t _) (SequenceSeq: ts*))
@@ -915,16 +908,12 @@
   ;; c : Constaint
   ;; variance : Variance
   (define (constraint->type v variance)
-    (match v
-      [(c S T)
-       (match variance
-         [(? variance:const?) S]
-         [(? variance:co?) S]
-         [(? variance:contra?) T]
-         [(? variance:inv?) (let ([gS (generalize S)])
-                             (if (subtype gS T)
-                                 gS
-                                 S))])]))
+    (match-define (c S T) v)
+    (match variance
+      [(? variance:const?) S]
+      [(? variance:co?) S]
+      [(? variance:contra?) T]
+      [(? variance:inv?) (let ([gS (generalize S)]) (if (subtype gS T) gS S))]))
 
   ;; Since we don't add entries to the empty cset for index variables (since there is no
   ;; widest constraint, due to dcon-exacts), we must add substitutions here if no constraint
@@ -934,14 +923,14 @@
     (hash-union
      (for/hash ([v (in-list Y)]
                 #:unless (hash-has-key? S v))
-       (let ([var (hash-ref idx-hash v variance:const)])
-         (values v
-                 (match var
-                   [(? variance:const?) (i-subst null)]
-                   [(? variance:co?) (i-subst null)]
-                   [(? variance:contra?) (i-subst/starred null Univ)]
-                   ;; TODO figure out if there is a better subst here
-                   [(? variance:inv?) (i-subst null)]))))
+       (define var (hash-ref idx-hash v variance:const))
+       (values v
+               (match var
+                 [(? variance:const?) (i-subst null)]
+                 [(? variance:co?) (i-subst null)]
+                 [(? variance:contra?) (i-subst/starred null Univ)]
+                 ;; TODO figure out if there is a better subst here
+                 [(? variance:inv?) (i-subst null)])))
      S))
   (define (build-subst m)
     (match m

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/dep-function.rkt

@@ -25,64 +25,63 @@
   #:property prop:combinator-name "dep->/sc"
   #:methods gen:sc
   [(define (sc->contract v rec)
-     (match v
-       [(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps)
-        (with-syntax ([(id ...) ids]
-                      [(c ...) (for/list ([d/sc (in-list dom/scs)]
-                                          [dep-ids (in-list dom-deps)])
-                                 (cond
-                                   [(not (null? dep-ids))
-                                    (parameterize ([static-contract-may-contain-free-ids? #t])
-                                      (rec d/sc))]
-                                   [else (rec d/sc)]))]
-                      [(dep ...) dom-deps]
-                      [(r-deps ...) rng-deps]
-                      [(p-deps ...) pre-deps])
-          #`(->i ([id dep c] ...)
-                 #,@(cond
-                      [(not pre) #'()]
-                      [else #`(#:pre (p-deps ...)
-                               #,(cond
-                                   [(not (null? pre-deps))
-                                    (parameterize ([static-contract-may-contain-free-ids? #t])
-                                      (rec pre))]
-                                   [else (rec pre)]))])
-                 #,(cond
-                     [(and typed-side? (andmap any/sc? rng-deps)) #'any]
-                     [(null? rng-deps)
-                      #`[_ () (values #,@(map rec rng/scs))]]
-                     [else
-                      (parameterize ([static-contract-may-contain-free-ids? #t])
-                        #`[_ (r-deps ...) (values #,@(map rec rng/scs))])])))]))
+     (match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v)
+     (with-syntax ([(id ...) ids]
+                   [(c ...) (for/list ([d/sc (in-list dom/scs)]
+                                       [dep-ids (in-list dom-deps)])
+                              (cond
+                                [(not (null? dep-ids))
+                                 (parameterize ([static-contract-may-contain-free-ids? #t])
+                                   (rec d/sc))]
+                                [else (rec d/sc)]))]
+                   [(dep ...) dom-deps]
+                   [(r-deps ...) rng-deps]
+                   [(p-deps ...) pre-deps])
+       #`(->i ([id dep c] ...)
+              #,@(cond
+                   [(not pre) #'()]
+                   [else
+                    #`(#:pre (p-deps ...)
+                             #,(cond
+                                 [(not (null? pre-deps))
+                                  (parameterize ([static-contract-may-contain-free-ids? #t])
+                                    (rec pre))]
+                                 [else (rec pre)]))])
+              #,(cond
+                  [(and typed-side? (andmap any/sc? rng-deps)) #'any]
+                  [(null? rng-deps) #`[_ () (values #,@(map rec rng/scs))]]
+                  [else
+                   (parameterize ([static-contract-may-contain-free-ids? #t])
+                     #`[_ (r-deps ...) (values #,@(map rec rng/scs))])]))))
    (define (sc-map v f)
-     (match v
-       [(->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps)
-        (->i/sc typed-side?
-                ids
-                (for/list ([d/sc (in-list dom/scs)])
-                  (f d/sc 'contravariant))
-                dom-deps
-                (and pre (f pre 'contravariant))
-                pre-deps
-                (for/list ([r/sc (in-list rng/scs)])
-                  (f r/sc 'covariant))
-                rng-deps)]))
+     (match-define (->i/sc typed-side? ids dom/scs dom-deps pre pre-deps rng/scs rng-deps) v)
+     (->i/sc typed-side?
+             ids
+             (for/list ([d/sc (in-list dom/scs)])
+               (f d/sc 'contravariant))
+             dom-deps
+             (and pre (f pre 'contravariant))
+             pre-deps
+             (for/list ([r/sc (in-list rng/scs)])
+               (f r/sc 'covariant))
+             rng-deps))
    (define (sc-traverse v f)
-     (match v
-       [(->i/sc _ _ dom/scs _ pre _ rng/scs _)
-        (for ([d/sc (in-list dom/scs)])
-          (f d/sc 'contravariant))
-        (when pre (f pre 'contravariant))
-        (for ([r/sc (in-list rng/scs)])
-          (f r/sc 'covariant))]))
+     (match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v)
+     (for ([d/sc (in-list dom/scs)])
+       (f d/sc 'contravariant))
+     (when pre
+       (f pre 'contravariant))
+     (for ([r/sc (in-list rng/scs)])
+       (f r/sc 'covariant)))
    (define (sc-terminal-kind v) 'impersonator)
    (define (sc->constraints v f)
-     (match v
-       [(->i/sc _ _ dom/scs _ pre _ rng/scs _)
-        (merge-restricts* 'impersonator
-                          (append (if pre (list (f pre)) (list))
-                                  (map f rng/scs)
-                                  (map f dom/scs)))]))])
+     (match-define (->i/sc _ _ dom/scs _ pre _ rng/scs _) v)
+     (merge-restricts* 'impersonator
+                       (append (if pre
+                                   (list (f pre))
+                                   (list))
+                               (map f rng/scs)
+                               (map f dom/scs))))])
 
 (require-for-cond-contract "proposition.rkt")
 

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)