Automated Resyntax fixes

typed-racket-lib/typed-racket/types/base-abbrev.rkt

@@ -102,15 +102,11 @@
   (foldr -pair b l))
 
 ;; Recursive types
-(define-syntax -v
-  (syntax-rules ()
-    [(_ x) (make-F 'x)]))
+(define-syntax-rule (-v x)
+  (make-F 'x))
 
-(define-syntax -mu
-  (syntax-rules ()
-    [(_ var ty)
-     (let ([var (-v var)])
-       (make-Mu 'var ty))]))
+(define-syntax-rule (-mu var ty)
+  (let ([var (-v var)]) (make-Mu 'var ty)))
 
 ;; Results
 (define/cond-contract (-result t [pset -tt-propset] [o -empty-obj])
@@ -493,31 +489,20 @@
 
 
 ;; Convenient syntax for polymorphic types
-(define-syntax -poly
-  (syntax-rules ()
-    [(_ (vars ...) ty)
-     (let ([vars (-v vars)] ...)
-       (make-Poly (list 'vars ...) ty))]))
-
-(define-syntax -polydots
-  (syntax-rules ()
-    [(_ (vars ... dotted) ty)
-     (let ([dotted (-v dotted)]
-           [vars (-v vars)] ...)
-       (make-PolyDots (list 'vars ... 'dotted) ty))]))
-
-(define-syntax -polyrow
-  (syntax-rules ()
-    [(_ (var) consts ty)
-     (let ([var (-v var)])
-       (make-PolyRow (list 'var) ty consts))]))
+(define-syntax-rule (-poly (vars ...) ty)
+  (let ([vars (-v vars)] ...) (make-Poly (list 'vars ...) ty)))
+
+(define-syntax-rule (-polydots (vars ... dotted) ty)
+  (let ([dotted (-v dotted)]
+        [vars (-v vars)] ...)
+    (make-PolyDots (list 'vars ... 'dotted) ty)))
+
+(define-syntax-rule (-polyrow (var) consts ty)
+  (let ([var (-v var)]) (make-PolyRow (list 'var) ty consts)))
 
 ;; abbreviation for existential types
-(define-syntax -some
-  (syntax-rules ()
-    [(_ (vars ...) ty)
-     (let ([vars (-v vars)] ...)
-       (make-Some (list 'vars ...) ty))]))
+(define-syntax-rule (-some (vars ...) ty)
+  (let ([vars (-v vars)] ...) (make-Some (list 'vars ...) ty)))
 
 ;; abbreviation for existential type results
 (define-syntax -some-res

typed-racket-lib/typed-racket/types/classes.rkt

@@ -88,9 +88,9 @@
   (match-define (Row: inits fields methods augments _) row)
   ;; check a given clause type (e.g., init, field)
   (define (check-clauses row-dict absence-set)
-    (for ([(name _) (in-dict row-dict)])
-      (when (member name absence-set)
-        (fail name))))
+    (for ([(name _) (in-dict row-dict)]
+          #:when (member name absence-set))
+      (fail name)))
   (check-clauses inits init-absents)
   (check-clauses fields field-absents)
   (check-clauses methods method-absents)

typed-racket-lib/typed-racket/types/generalize.rkt

@@ -45,15 +45,15 @@
         [(Pair: t1 (== -Null)) (-lst t1)]
         [(MPair: t1 (== -Null)) (-mlst t1)]
         [(or (Pair: t1 t2) (MPair: t1 t2))
-         (let ([t-new (loop t2)])
-           (define -lst-type
-             ((match t*
-                [(Pair: _ _) -lst]
-                [(MPair: _ _) -mlst])
-              t1))
-           (if (type-equiv? -lst-type t-new)
-               -lst-type
-               (exit t)))]
+         (define t-new (loop t2))
+         (define -lst-type
+           ((match t*
+              [(Pair: _ _) -lst]
+              [(MPair: _ _) -mlst])
+            t1))
+         (if (type-equiv? -lst-type t-new)
+             -lst-type
+             (exit t))]
         [(ListDots: t bound) (-lst (substitute Univ bound t))]
         [(? (lambda (t) (subtype t -Symbol))) -Symbol]
         [(== -True) -Boolean]

typed-racket-lib/typed-racket/types/kw-types.rkt

@@ -31,8 +31,7 @@
   ;; the kw protocol puts the arguments in keyword-sorted order in the
   ;; function header, so we need to sort the types to match
   (define sorted-kws
-    (sort keywords (λ (kw1 kw2) (keyword<? (Keyword-kw kw1)
-                                           (Keyword-kw kw2)))))
+    (sort keywords keyword<? #:key Keyword-kw))
 
   (define pos-opt-arg-types
     (append (for/list ([t (in-list optional-arg-types)]
@@ -148,9 +147,7 @@
 (define (calculate-mandatory-args orig-arrows)
   ;; sorted order is important, our loops below rely on this order
   (define arity-sorted-arrows
-    (sort orig-arrows
-          (λ (a1 a2) (>= (Arrow-max-arity a1)
-                         (Arrow-max-arity a2)))))
+    (sort orig-arrows >= #:key Arrow-max-arity))
   (for/fold ([mand-arg-table '()])
             ([arrow (in-list arity-sorted-arrows)])
     (cond
@@ -172,36 +169,38 @@
     ;; set and set->list to retain determinism
     (remove-duplicates
      (for/list ([(arrow arrow-mand-arg-count) (in-assoc mand-arg-table)])
-       (match arrow
-         [(Arrow: dom rst kws rng rng-T+)
-          (define kws* (if actual-kws
-                           (handle-extra-or-missing-kws kws actual-kws)
-                           kws))
-          (define kw-opts-supplied (if actual-kws
-                                       (lambda-kws-opt-supplied actual-kws)
-                                       '()))
-          (define mand-arg-count (if actual-kws
-                                     (lambda-kws-pos-mand-count actual-kws)
-                                     arrow-mand-arg-count))
-          (define opt-arg-count (- (length dom) mand-arg-count))
-          (define extra-opt-arg-count
-            ;; In case `dom` has too many arguments that we try to treat
-            ;; as optional:
-            (if actual-kws
-                (max 0 (- opt-arg-count (length (lambda-kws-pos-opt-supplied? actual-kws))))
-                0))
-          (convert kws*
-                   kw-opts-supplied
-                   (take dom mand-arg-count)
-                   (drop dom mand-arg-count)
-                   (if actual-kws
-                       (append (lambda-kws-pos-opt-supplied? actual-kws)
-                               (make-list extra-opt-arg-count #f))
-                       (make-list opt-arg-count #f))
-                   rng
-                   rst
-                   split?
-                   rng-T+)]))))
+       (match-define (Arrow: dom rst kws rng rng-T+) arrow)
+       (define kws*
+         (if actual-kws
+             (handle-extra-or-missing-kws kws actual-kws)
+             kws))
+       (define kw-opts-supplied
+         (if actual-kws
+             (lambda-kws-opt-supplied actual-kws)
+             '()))
+       (define mand-arg-count
+         (if actual-kws
+             (lambda-kws-pos-mand-count actual-kws)
+             arrow-mand-arg-count))
+       (define opt-arg-count (- (length dom) mand-arg-count))
+       (define extra-opt-arg-count
+         ;; In case `dom` has too many arguments that we try to treat
+         ;; as optional:
+         (if actual-kws
+             (max 0 (- opt-arg-count (length (lambda-kws-pos-opt-supplied? actual-kws))))
+             0))
+       (convert kws*
+                kw-opts-supplied
+                (take dom mand-arg-count)
+                (drop dom mand-arg-count)
+                (if actual-kws
+                    (append (lambda-kws-pos-opt-supplied? actual-kws)
+                            (make-list extra-opt-arg-count #f))
+                    (make-list opt-arg-count #f))
+                rng
+                rst
+                split?
+                rng-T+))))
   (apply cl->* fns))
 
 ;; kw-convert : Type (Option LambdaKeywords) [Boolean] -> Type
@@ -269,7 +268,7 @@
                                  (take opt-types to-take))
                          (erase-props/Values rng)
                          #:kws actual-kws
-                         #:rest (if (= to-take opt-types-count) rest-type #f)
+                         #:rest (and (= to-take opt-types-count) rest-type)
                          #:T+ rng-T+)))]
              [else (int-err "unsupported arrs in keyword function type")])]
       [(Poly-names: names f) (make-Poly names (loop f))]

typed-racket-lib/typed-racket/types/match-expanders.rkt

@@ -75,7 +75,7 @@
          (app (λ (t) (Listof? t #t)) (? Type? elem-pat)))])))
 
 
-(define-simple-macro (make-Listof-pred listof-pred?:id pair-matcher:id)
+(define-syntax-parse-rule (make-Listof-pred listof-pred?:id pair-matcher:id)
   (define (listof-pred? t [simple? #f])
     (match t
       [(Mu-unsafe:

typed-racket-lib/typed-racket/types/printer.rkt

@@ -132,7 +132,7 @@
 (define name-ref->sexp
   (match-lambda
     [(? syntax? name-ref) (syntax-e name-ref)]
-    [(cons lvl arg) `(,lvl ,arg)]))
+    [(cons lvl arg) (list lvl arg)]))
 
 ;; prop->sexp : Prop -> S-expression
 ;; Print a Prop (see prop-rep.rkt) to the given port
@@ -149,20 +149,19 @@
      ;; instead of (<= x y) (<= y x) when we have both inequalities
      (define-values (leqs others) (partition LeqProp? ps))
      (define-values (eqs simple-leqs)
-       (for/fold ([eqs '()] [simple-leqs '()])
+       (for/fold ([eqs '()]
+                  [simple-leqs '()])
                  ([leq (in-list leqs)])
-         (match leq
-           [(LeqProp: lhs rhs)
-            (define flip (-leq rhs lhs))
-            (cond
-              [(not (member flip leqs))
-               (values eqs (cons leq simple-leqs))]
-              [(member flip eqs) (values eqs simple-leqs)]
-              [else (values (cons leq eqs) simple-leqs)])])))
+         (match-define (LeqProp: lhs rhs) leq)
+         (define flip (-leq rhs lhs))
+         (cond
+           [(not (member flip leqs)) (values eqs (cons leq simple-leqs))]
+           [(member flip eqs) (values eqs simple-leqs)]
+           [else (values (cons leq eqs) simple-leqs)])))
      (let ([simple-leqs (map prop->sexp simple-leqs)]
            [eqs (for/list ([leq (in-list eqs)])
-                  (match leq
-                    [(LeqProp: lhs rhs) `(= ,(object->sexp lhs) ,(object->sexp rhs))]))]
+                  (match-define (LeqProp: lhs rhs) leq)
+                  `(= ,(object->sexp lhs) ,(object->sexp rhs)))]
            [others (map prop->sexp others)])
        (match (append eqs simple-leqs others)
          [(list sexp) sexp]
@@ -317,37 +316,36 @@
          valid-names))
   ;; some types in the union may not be coverable by the candidates
   ;; (e.g. type variables, etc.)
-  (define-values (uncoverable coverable)
-    (values (apply set-subtract elems (map cdr candidates))
-            (set-intersect elems (apply set-union null (map cdr candidates)))))
+  (define uncoverable (apply set-subtract elems (map cdr candidates)))
+  (define coverable (set-intersect elems (apply set-union null (map cdr candidates))))
   ;; set cover, greedy algorithm, ~lg n approximation
   (let loop ([to-cover   coverable]
              [candidates candidates]
              [coverage   '()])
-    (cond [(null? to-cover) ; done
-           (define coverage-names (map car coverage))
-           ;; to allow :type to cue the user on unexpanded aliases
-           ;; only union types can flow here, and any of those could be expanded
-           (set-box! (current-print-unexpanded)
-                     (append coverage-names (unbox (current-print-unexpanded))))
-           ;; reverse here to retain the old ordering from when srfi/1 was
-           ;; used to process the list sets
-           (values coverage-names (reverse uncoverable))] ; we want the names
-          [else
-           ;; pick the candidate that covers the most uncovered types
-           (define (covers-how-many? c)
-             (length (set-intersect (cdr c) to-cover)))
-           (define-values (next _)
-             (for/fold ([next      (car candidates)]
-                        [max-cover (covers-how-many? (car candidates))])
-                 ([c (in-list candidates)])
-               (let ([how-many? (covers-how-many? c)])
-                 (if (> how-many? max-cover)
-                     (values c how-many?)
-                     (values next max-cover)))))
-           (loop (set-subtract to-cover (cdr next))
-                 (remove next candidates)
-                 (cons next coverage))])))
+    (cond
+      [(null? to-cover) ; done
+       (define coverage-names (map car coverage))
+       ;; to allow :type to cue the user on unexpanded aliases
+       ;; only union types can flow here, and any of those could be expanded
+       (set-box! (current-print-unexpanded)
+                 (append coverage-names (unbox (current-print-unexpanded))))
+       ;; reverse here to retain the old ordering from when srfi/1 was
+       ;; used to process the list sets
+       (values coverage-names (reverse uncoverable))] ; we want the names
+      [else
+       ;; pick the candidate that covers the most uncovered types
+       (define (covers-how-many? c)
+         (length (set-intersect (cdr c) to-cover)))
+       (define next
+         (for/fold ([next (car candidates)]
+                    [max-cover (covers-how-many? (car candidates))]
+                    #:result next)
+                   ([c (in-list candidates)])
+           (let ([how-many? (covers-how-many? c)])
+             (if (> how-many? max-cover)
+                 (values c how-many?)
+                 (values next max-cover)))))
+       (loop (set-subtract to-cover (cdr next)) (remove next candidates) (cons next coverage))])))
 
 ;; arr->sexp : arr -> s-expression
 ;; Convert an arr (see type-rep.rkt) to its printable form
@@ -365,11 +363,10 @@
       ;; as long as the resulting s-expressions are `display`ed
       ;; this is fine, though it may not pretty-print well.
       (for/list ([kw (in-list kws)])
-        (match kw
-          [(Keyword: k t req?)
-           (if req?
-               (format "~a ~a" k (type->sexp t))
-               (format "[~a ~a]" k (type->sexp t)))]))
+        (match-define (Keyword: k t req?) kw)
+        (if req?
+            (format "~a ~a" k (type->sexp t))
+            (format "[~a ~a]" k (type->sexp t))))
       (match rst
         [(Rest: (list rst-t)) `(,(type->sexp rst-t) *)]
         [(Rest: rst-ts) `(#:rest-star ,(map type->sexp rst-ts))]
@@ -461,8 +458,9 @@
         (define-values (pre mid) (split-at lst to-drop))
         (define-values (sub post) (split-at mid n))
         (list pre sub post)))
-    (apply append (for/list ([i (range (length lst) 0 -1)])
-                    (sublist-n i lst))))
+    (for*/list ([i (range (length lst) 0 -1)]
+                [v (in-list (sublist-n i lst))])
+      v))
   (let loop ([left-to-cover arrs])
     ;; try to match the largest sublists possible that correspond to
     ;; ->* types and then the remainder are formatted normally
@@ -478,16 +476,15 @@
 ;; case-lambda->sexp : Type -> S-expression
 ;; Convert a case-> type to an s-expression
 (define (case-lambda->sexp type)
-  (match type
-    [(Fun: arrows)
-     (match arrows
-       [(list) '(case->)]
-       [(list a) (arr->sexp a)]
-       [(and arrs (list a b ...))
-        (define cover (cover-case-lambda arrs))
-        (if (> (length cover) 1)
-            `(case-> ,@cover)
-            (car cover))])]))
+  (match-define (Fun: arrows) type)
+  (match arrows
+    [(list) '(case->)]
+    [(list a) (arr->sexp a)]
+    [(and arrs (list a b ...))
+     (define cover (cover-case-lambda arrs))
+     (if (> (length cover) 1)
+         `(case-> ,@cover)
+         (car cover))]))
 
 ;; class->sexp : Class [#:object? Boolean] -> S-expression
 ;; Convert a class or object type to an s-expression
@@ -512,11 +509,11 @@
          (cons 'field
                (for/list ([name+type (in-list fields)])
                  (match-define (list name type) name+type)
-                 `(,name ,(type->sexp type)))))))
+                 (list name (type->sexp type)))))))
   (define methods*
     (for/list ([name+type (in-list methods)])
       (match-define (list name type) name+type)
-      `(,name ,(type->sexp type))))
+      (list name (type->sexp type))))
   (define augments*
     (cond [(or object? (null? augments)) '()]
           [else (list (cons 'augment augments))]))
@@ -613,7 +610,7 @@
      (=> fail)
      (unless (null? ignored-names) (fail))
      (define fuel (current-print-type-fuel))
-     (cond [(> fuel 0)
+     (cond [(positive? fuel)
             (parameterize ([current-print-type-fuel (sub1 fuel)])
               ;; if we still have fuel, print the expanded type and
               ;; add the name to the ignored list so that the union