Add match*? to unstable/match
This commit is contained in:
parent
3d6776680c
commit
12e5bc645b
|
@ -21,4 +21,17 @@
|
|||
(test
|
||||
(match (list 1 2 3)
|
||||
[(as ([a 0]) (list b c d)) (list a b c d)])
|
||||
(list 0 1 2 3)))))
|
||||
(list 0 1 2 3)))
|
||||
(test-suite "match*?"
|
||||
(test
|
||||
(check-true (match*? (1 2 3)
|
||||
(a b c)
|
||||
(#f y z))))
|
||||
(test
|
||||
(check-true (match*? (1 2 3)
|
||||
(a b #f)
|
||||
(x y z))))
|
||||
(test
|
||||
(check-false (match*? (1 2 3)
|
||||
(a #f c)
|
||||
(#f y z)))))))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(for-syntax racket/base)
|
||||
(for-syntax syntax/parse))
|
||||
|
||||
(provide match? as object)
|
||||
(provide match? match*? as object)
|
||||
|
||||
(define-syntax-rule (match? e p ...)
|
||||
(match e [p #t] ... [_ #f]))
|
||||
|
@ -14,6 +14,14 @@
|
|||
(syntax-rules ()
|
||||
[(as ([x e] ...) p ...) (and (app (lambda (y) e) x) ... p ...)]))
|
||||
|
||||
;; Added by asumu
|
||||
;; Like match? but with match*
|
||||
(define-syntax (match*? stx)
|
||||
(syntax-parse stx
|
||||
[(_ (e ...) (p ...) ...)
|
||||
(with-syntax ([(?_ ...) (generate-temporaries #'(e ...))])
|
||||
#'(match* (e ...) [(p ...) #t] ... [(?_ ...) #f]))]))
|
||||
|
||||
;; Added by asumu
|
||||
;; Match expander for objects from racket/class
|
||||
(define-match-expander object
|
||||
|
|
|
@ -48,6 +48,25 @@ result value of @racket[rhs-expr], and continues matching each subsequent
|
|||
|
||||
@addition[@author+email["Asumu Takikawa" "asumu@racket-lang.org"]]
|
||||
|
||||
@defform[(match*? (val-expr ...) (pat ...) ...)]{
|
||||
|
||||
Similar to @racket[match?], but uses @racket[match*] and accepts
|
||||
multiple @racket[val-expr] and corresponding @racket[pat] in each
|
||||
clause to match on.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(match*? (1 2 3)
|
||||
(a b c)
|
||||
(x #f z))
|
||||
(match*? (1 2 3)
|
||||
(a (? odd?) c)
|
||||
(x y z))
|
||||
(match*? (#f #f #f)
|
||||
(1 2 3)
|
||||
(4 5 6))
|
||||
]}
|
||||
|
||||
@defform/subs[
|
||||
(define/match (head args)
|
||||
match*-clause ...)
|
||||
|
|
Loading…
Reference in New Issue
Block a user