syntax.rkt (4033B)
1 #lang racket/base 2 3 (provide kw-formals->arity+keywords 4 kw-formals->arity 5 kw-formals->required-kws 6 kw-formals->allowed-kws 7 ) 8 9 (require racket/list 10 syntax/parse 11 "../arity+keywords.rkt") 12 (module+ test 13 (require rackunit)) 14 15 ;; kw-formals->arity+keywords : Syntax -> Arity+Keywords 16 (define (kw-formals->arity+keywords stx) 17 (syntax-parse stx 18 [((~or arg1:id 19 (~seq kw2:keyword arg2:id) 20 (~seq kw3:keyword [arg3:id default3:expr])) 21 ... 22 (~or [arg4:id default4:expr] 23 (~seq kw5:keyword arg5:id) 24 (~seq kw6:keyword [arg6:id default6:expr])) 25 ...) 26 (arity+keywords 27 (range (length (syntax->list #'[arg1 ...])) 28 (add1 (length (syntax->list #'[arg1 ... arg4 ...])))) 29 (syntax->datum #'[kw2 ... kw5 ...]) 30 (syntax->datum #'[kw2 ... kw5 ... kw3 ... kw6 ...]))] 31 [((~or arg1:id 32 (~seq kw2:keyword arg2:id) 33 (~seq kw3:keyword [arg3:id default3:expr])) 34 ... 35 (~or [arg4:id default4:expr] 36 (~seq kw5:keyword arg5:id) 37 (~seq kw6:keyword [arg6:id default6:expr])) 38 ... 39 . rst:id) 40 (arity+keywords 41 (arity-at-least (length (syntax->list #'[arg1 ...]))) 42 (syntax->datum #'[kw2 ... kw5 ...]) 43 (syntax->datum #'[kw2 ... kw5 ... kw3 ... kw6 ...]))] 44 )) 45 46 ;; kw-formals->arity : Syntax -> Normalized-Arity 47 (define (kw-formals->arity stx) 48 (arity+keywords-arity (kw-formals->arity+keywords stx))) 49 50 ;; kw-formals->required-kws : Syntax -> (Listof Keyword) 51 (define (kw-formals->required-kws stx) 52 (arity+keywords-required-kws (kw-formals->arity+keywords stx))) 53 54 ;; kw-formals->allowed-kws : Syntax -> (Listof Keyword) 55 (define (kw-formals->allowed-kws stx) 56 (arity+keywords-allowed-kws (kw-formals->arity+keywords stx))) 57 58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 59 60 (module+ test 61 ;; without keywords 62 (check-equal? (kw-formals->arity+keywords #'()) (arity+keywords 0 '() '())) 63 (check-equal? (kw-formals->arity+keywords #'(a)) (arity+keywords 1 '() '())) 64 (check-equal? (kw-formals->arity+keywords #'(a b c d e)) (arity+keywords 5 '() '())) 65 (check-equal? (kw-formals->arity+keywords #'(a b [c 2])) 66 (arity+keywords (list 2 3) '() '())) 67 (check-equal? (kw-formals->arity+keywords #'(a b [c 2] [d 3])) 68 (arity+keywords (list 2 3 4) '() '())) 69 (check-equal? (kw-formals->arity+keywords #'rst) 70 (arity+keywords (arity-at-least 0) '() '())) 71 (check-equal? (kw-formals->arity+keywords #'(a b . rst)) 72 (arity+keywords (arity-at-least 2) '() '())) 73 (check-equal? (kw-formals->arity+keywords #'(a b [c 2] [d 3] . rst)) 74 (arity+keywords (arity-at-least 2) '() '())) 75 ;; with keywords 76 (check-equal? (kw-formals->arity+keywords #'(#:a a)) (arity+keywords 0 '(#:a) '(#:a))) 77 (check-equal? (kw-formals->arity+keywords #'(#:a [a 0])) (arity+keywords 0 '() '(#:a))) 78 (check-equal? (kw-formals->arity+keywords #'(a #:b b)) (arity+keywords 1 '(#:b) '(#:b))) 79 (check-equal? (kw-formals->arity+keywords #'(a #:b [b 1])) (arity+keywords 1 '() '(#:b))) 80 (check-equal? (kw-formals->arity+keywords #'(a #:b b #:c [c 2] d e)) 81 (arity+keywords 3 '(#:b) '(#:b #:c))) 82 (check-equal? (kw-formals->arity+keywords #'(a #:b [b 1] c [d 3] #:e e)) 83 (arity+keywords (list 2 3) '(#:e) '(#:b #:e))) 84 (check-equal? (kw-formals->arity+keywords #'(a #:b b c #:d [d 3] [e 2] #:f f [g 3])) 85 (arity+keywords (list 2 3 4) '(#:b #:f) '(#:b #:d #:f))) 86 (check-equal? (kw-formals->arity+keywords #'(#:a a . rst)) 87 (arity+keywords (arity-at-least 0) '(#:a) '(#:a))) 88 (check-equal? (kw-formals->arity+keywords #'(a #:b [b 1] c #:d d . rst)) 89 (arity+keywords (arity-at-least 2) '(#:d) '(#:b #:d))) 90 (check-equal? (kw-formals->arity+keywords #'(a #:b b c [d 2] [e 3] . rst)) 91 (arity+keywords (arity-at-least 2) '(#:b) '(#:b))) 92 ) 93