Lines Matching refs:arity
1 (module norm-arity '#%kernel
3 (#%provide normalize-arity)
5 ;; normalize-arity : (or/c arity (listof arity))
7 ;; arity
10 ;; (list (make-arity-at-least nat))))
12 ;; where arity = nat | (make-arity-at-least nat)
17 ;; - at most one arity-at-least, always at the end
20 (define (normalize-arity arity)
21 (unless (procedure-arity? arity)
22 (raise-argument-error 'normalize-arity "procedure-arity?" arity))
23 (if (pair? arity)
24 (let* ([reversed (reverse-sort-arity arity)]
25 [normalized (normalize-reversed-arity reversed '())]
26 [simplified (normalize-singleton-arity normalized)])
28 arity))
30 (define (normalize-singleton-arity arity)
31 (if (and (pair? arity) (null? (cdr arity)))
32 (car arity)
33 arity))
35 (define (normalize-reversed-arity arity tail)
36 (if (pair? arity)
37 (normalize-reversed-arity (cdr arity) (arity-insert (car arity) tail))
40 (define (arity-insert elem arity)
41 (if (pair? arity)
42 (let ([next (car arity)])
43 (if (arity-at-least? next)
44 (let ([next-value (arity-at-least-value next)])
45 (if (arity-at-least? elem)
46 ;; arity-at-least + arity-at-least
47 (let ([elem-value (arity-at-least-value elem)])
49 (cons elem (cdr arity))
50 arity))
51 ;; number + arity-at-least
53 (cons elem arity)
55 (cons (arity-at-least elem) (cdr arity))
56 arity))))
59 (cons elem arity)
60 arity)))
61 (cons elem arity)))
63 (define (reverse-sort-arity arity)
64 (sort arity arity>?))
66 (define (arity>? a b)
67 (if (arity-at-least? a)
68 (if (arity-at-least? b)
69 (> (arity-at-least-value a) (arity-at-least-value b))
71 (if (arity-at-least? b)