Moved normalized-arity?, arity=?, and arity-includes? into racket/function.

collects/racket/function.rkt

@@ -2,7 +2,8 @@
 
 (require (for-syntax racket/base syntax/name) racket/private/norm-arity)
 
-(provide identity const thunk thunk* negate curry curryr normalize-arity)
+(provide identity const thunk thunk* negate curry curryr
+         normalize-arity normalized-arity? arity=? arity-includes?)
 
 (define (identity x) x)
 
@@ -80,3 +81,94 @@
 
 (define curry  (make-curry #f))
 (define curryr (make-curry #t))
+
+(define (normalized-arity? a)
+  (unless (procedure-arity? a)
+          (raise-argument-error 'normalized-arity? "procedure-arity?" a))
+  (or (null? a)
+      (arity? a)
+      (and (list? a)
+           ((length a) . >= . 2)
+           (andmap arity? a)
+           (if (ormap arity-at-least? a)
+               (non-empty-non-singleton-sorted-list-ending-with-arity? a)
+               (non-singleton-non-empty-sorted-list? a)))))
+
+(define (arity? a)
+  (or (exact-nonnegative-integer? a)
+      (and (arity-at-least? a)
+           (exact-nonnegative-integer? (arity-at-least-value a)))))
+
+;; non-empty-non-singleton-sorted-list-ending-with-arity? : xx -> boolean
+;; know that 'a' is a list of at least 2 elements
+(define (non-empty-non-singleton-sorted-list-ending-with-arity? a)
+  (let loop ([bound (car a)]
+             [lst (cdr a)])
+    (cond
+      [(null? (cdr lst))
+       (and (arity-at-least? (car lst))
+            (> (arity-at-least-value (car lst)) (+ 1 bound)))]
+      [else
+       (and (exact-nonnegative-integer? (car lst))
+            ((car lst) . > . bound)
+            (loop (car lst)
+                  (cdr lst)))])))
+
+(define (non-empty-sorted-list? a)
+  (and (pair? a)
+       (sorted-list? a)))
+
+(define (non-singleton-non-empty-sorted-list? a)
+  (and (pair? a)
+       (pair? (cdr a))
+       (sorted-list? a)))
+
+(define (sorted-list? a)
+  (or (null? a)
+      (sorted/bounded-list? (cdr a) (car a))))
+
+(define (sorted/bounded-list? a bound)
+  (or (null? a)
+      (and (number? (car a))
+           (< bound (car a))
+           (sorted/bounded-list? (cdr a) (car a)))))
+
+(define (arity-supports-number? arity n)
+  (cond
+    [(exact-nonnegative-integer? arity) (= arity n)]
+    [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
+    [(list? arity)
+     (for/or {[elem (in-list arity)]}
+       (arity-supports-number? elem n))]))
+
+(define (arity-supports-at-least? arity n)
+  (cond
+    [(exact-nonnegative-integer? arity) #f]
+    [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
+    [(list? arity)
+     (define min-at-least
+       (for/fold {[min-at-least #f]} {[elem (in-list arity)]}
+         (cond
+           [(exact-nonnegative-integer? elem) min-at-least]
+           [(arity-at-least? elem)
+            (cond
+              [(not min-at-least) (arity-at-least-value elem)]
+              [else (min min-at-least (arity-at-least-value elem))])])))
+     (cond
+       [(not min-at-least) #f]
+       [else
+        (for/and {[i (in-range n min-at-least)]}
+          (arity-supports-number? arity i))])]))
+
+(define (arity-includes? one two)
+  (cond
+    [(exact-nonnegative-integer? two)
+     (arity-supports-number? one two)]
+    [(arity-at-least? two)
+     (arity-supports-at-least? one (arity-at-least-value two))]
+    [(list? two)
+     (for/and {[elem (in-list two)]}
+       (arity-includes? one elem))]))
+
+(define (arity=? one two)
+  (and (arity-includes? one two) (arity-includes? two one)))

collects/tests/racket/basic.rktl

@@ -4,7 +4,7 @@
 (Section 'basic)
 
 (require scheme/flonum
-         racket/private/norm-arity)
+         racket/function)
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -1986,100 +1986,6 @@
   ;; predicate: normalize-arity produces a normalized arity
   ;;
 
-  (define (normalized-arity? a)
-    (or (null? a)
-        (arity? a)
-        (and (list? a)
-             ((length a) . >= . 2)
-             (andmap arity? a)
-             (if (arity-at-least? (last a))
-                 (non-empty-non-singleton-sorted-list-ending-with-arity? a)
-                 (non-singleton-non-empty-sorted-list? a)))))
-  
-  (define (arity? a)
-    (or (nat? a)
-        (and (arity-at-least? a)
-             (nat? (arity-at-least-value a)))))
-  
-  (define (nat? a)
-    (and (number? a)
-         (integer? a)
-         (a . >= . 0)))
-  
-  ;; non-empty-non-singleton-sorted-list-ending-with-arity? : xx -> boolean
-  ;; know that 'a' is a list of at least 2 elements
-  (define (non-empty-non-singleton-sorted-list-ending-with-arity? a)
-    (let loop ([bound (car a)]
-               [lst (cdr a)])
-      (cond
-        [(null? (cdr lst))
-         (and (arity-at-least? (car lst))
-              (> (arity-at-least-value (car lst)) (+ 1 bound)))]
-        [else
-         (and (nat? (car lst))
-              ((car lst) . > . bound)
-              (loop (car lst)
-                    (cdr lst)))])))
-  
-  (define (non-empty-sorted-list? a)
-    (and (pair? a)
-         (sorted-list? a)))
-  
-  (define (non-singleton-non-empty-sorted-list? a)
-    (and (pair? a)
-         (pair? (cdr a))
-         (sorted-list? a)))
-  
-  (define (sorted-list? a)
-    (or (null? a)
-        (sorted/bounded-list? (cdr a) (car a))))
-  
-  (define (sorted/bounded-list? a bound)
-    (or (null? a)
-        (and (number? (car a))
-             (< bound (car a))
-             (sorted/bounded-list? (cdr a) (car a)))))
-
-  (define (arity-supports-number? arity n)
-    (cond
-      [(exact-nonnegative-integer? arity) (= arity n)]
-      [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
-      [(list? arity)
-       (for/or {[elem (in-list arity)]}
-         (arity-supports-number? elem n))]))
-
-  (define (arity-supports-at-least? arity n)
-    (cond
-      [(exact-nonnegative-integer? arity) #f]
-      [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
-      [(list? arity)
-       (define min-at-least
-         (for/fold {[min-at-least #f]} {[elem (in-list arity)]}
-           (cond
-             [(exact-nonnegative-integer? elem) min-at-least]
-             [(arity-at-least? elem)
-              (cond
-                [(not min-at-least) (arity-at-least-value elem)]
-                [else (min min-at-least (arity-at-least-value elem))])])))
-       (cond
-         [(not min-at-least) #f]
-         [else
-          (for/and {[i (in-range n min-at-least)]}
-            (arity-supports-number? arity i))])]))
-
-  (define (arity-supports? one two)
-    (cond
-      [(exact-nonnegative-integer? two)
-       (arity-supports-number? one two)]
-      [(arity-at-least? two)
-       (arity-supports-at-least? one (arity-at-least-value two))]
-      [(list? two)
-       (for/and {[elem (in-list two)]}
-         (arity-supports? one elem))]))
-
-  (define (arity=? one two)
-    (and (arity-supports? one two) (arity-supports? two one)))
-
   (define (normalized-arity=? original normalized)
     (and
       (normalized-arity? normalized)