Abstract out function that checks ->* style types

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

@@ -9,7 +9,7 @@
  (utils tc-utils)
  (env type-name-env)
  (rep rep-utils)
- (types resolve union)
+ (types resolve union utils)
  (prefix-in t: (types abbrev numeric-tower))
  (private parse-type syntax-properties)
  racket/match racket/syntax racket/list
@@ -348,30 +348,7 @@
       ;;  since this code would generate contracts that accept any number of arguments between
       ;;  2 and 6, which is wrong.
       ;; TODO sufficient condition, but may not be necessary
-      [(and
+      [(has-optional-args? arrs)
-        (> (length arrs) 1)
-        ;; Keyword args, range and rest specs all the same.
-        (let* ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws)
-                                       (list rng rest-spec kws)])
-                        arrs)]
-               [first-x (first xs)])
-          (for/and ([x (in-list (rest xs))])
-            (equal? x first-x)))
-        ;; Positionals are monotonically increasing by at most one.
-        (let-values ([(_ ok?)
-                      (for/fold ([positionals (arr-dom (first arrs))]
-                                 [ok-so-far?  #t])
-                          ([arr (in-list (rest arrs))])
-                        (match arr
-                          [(arr: dom _ _ _ _)
-                           (define ldom         (length dom))
-                           (define lpositionals (length positionals))
-                           (values dom
-                                   (and ok-so-far?
-                                        (or (= ldom lpositionals)
-                                            (= ldom (add1 lpositionals)))
-                                        (equal? positionals (take dom lpositionals))))]))])
-          ok?))
        (match* ((first arrs) (last arrs))
          [((arr: first-dom (Values: (list (Result: rngs (FilterSet: (Top:) (Top:)) (Empty:)) ...)) rst #f kws)
            (arr: last-dom _ _ _ _)) ; all but dom is the same for all

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/utils.rkt

@@ -75,6 +75,36 @@
 
 (provide to-be-abstr)
 
+;; has-optional-args? : (Listof arr) -> Boolean
+;; Check if the given arrs meet the necessary conditions to be printed
+;; with a ->* constructor or for generating a ->* contract
+(define (has-optional-args? arrs)
+ (and (> (length arrs) 1)
+      ;; No polydots
+      (for/and ([arr (in-list arrs)])
+        (match arr [(arr: _ _ _ drest _) (not drest)]))
+      ;; Keyword args, range and rest specs all the same.
+      (let* ([xs (map (match-lambda [(arr: _ rng rest-spec _ kws)
+                                (list rng rest-spec kws)])
+                      arrs)]
+             [first-x (first xs)])
+        (for/and ([x (in-list (rest xs))])
+          (equal? x first-x)))
+      ;; Positionals are monotonically increasing by at most one.
+      (let-values ([(_ ok?)
+                    (for/fold ([positionals (arr-dom (first arrs))]
+                               [ok-so-far?  #t])
+                              ([arr (in-list (rest arrs))])
+                      (match arr
+                        [(arr: dom _ _ _ _)
+                         (define ldom         (length dom))
+                         (define lpositionals (length positionals))
+                         (values dom
+                                 (and ok-so-far?
+                                      (or (= ldom lpositionals)
+                                          (= ldom (add1 lpositionals)))
+                                      (equal? positionals (take dom lpositionals))))]))])
+        ok?)))
 
 (provide/cond-contract
  [unfold (Mu? . -> . Type/c)]
@@ -85,5 +115,6 @@
  [fi (Rep? . -> . (listof symbol?))]
  [fv/list ((listof Type/c) . -> . (set/c symbol?))]
  [current-poly-struct (parameter/c (or/c #f poly?))]
+ [has-optional-args? (-> (listof arr?) any)]
  )