add `pattern-case` and `pattern-case-filter`

pull/10/head
Matthew Butterick 8 years ago
parent 41a898b268
commit 92a949c08e

@ -7,7 +7,9 @@
(send t compute-racket-amount-to-indent pos (λ(x)
(case x
[("with-pattern"
"with-shared-id") 'lambda]
"with-shared-id"
"pattern-case"
"pattern-case-filter") 'lambda]
[("define-macro"
"define-macro-cases"
"define-cases") 'define]

@ -25,18 +25,28 @@
(module+ test
(require rackunit))
(define-macro (pattern-case-filter STX-ARG PAT+BODY ...)
#'(let* ([arg STX-ARG]
[stxs (or (and (syntax? arg) (syntax->list arg)) arg)])
(unless (and (list? stxs) (andmap syntax? stxs))
(raise-syntax-error 'pattern-case-filter
(format "~v cannot be made into a list of syntax objects" (syntax->datum arg))))
(for*/list ([stx (in-list stxs)]
[result (in-value (pattern-case stx PAT+BODY ... [else #f]))]
#:when result)
result)))
(define-macro-cases case-pattern
(define-macro-cases pattern-case
[(_ STX-ARG
[PAT . BODY] ...
[else . ELSEBODY]) (with-syntax ([(LITERAL ...) (generate-literals #'(PAT ...))])
#'(syntax-case STX-ARG (LITERAL ...)
[PAT . BODY] ...
[else . ELSEBODY]))]
[(_ STX-ARG
PAT+BODY ...) #'(case-pattern STX-ARG
[(_ STX-ARG PAT+BODY ...)
#'(pattern-case STX-ARG
PAT+BODY ...
[else (raise-syntax-error 'case-pattern
[else (raise-syntax-error 'pattern-case
(format "unable to match pattern for ~v" (syntax->datum STX-ARG)))])])
(define-macro-cases with-pattern

Loading…
Cancel
Save