From 12e5bc645bf6e4c8c74cd6460efefccbf5a5680d Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 7 Jun 2013 14:31:46 -0400
Subject: [PATCH] Add match*? to unstable/match

---
 collects/tests/unstable/match.rkt         | 15 ++++++++++++++-
 collects/unstable/match.rkt               | 10 +++++++++-
 collects/unstable/scribblings/match.scrbl | 19 +++++++++++++++++++
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/collects/tests/unstable/match.rkt b/collects/tests/unstable/match.rkt
index 4a4b55d780..59966edc60 100644
--- a/collects/tests/unstable/match.rkt
+++ b/collects/tests/unstable/match.rkt
@@ -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)))))))
diff --git a/collects/unstable/match.rkt b/collects/unstable/match.rkt
index 9fdd8d7277..d40270f8a2 100644
--- a/collects/unstable/match.rkt
+++ b/collects/unstable/match.rkt
@@ -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
diff --git a/collects/unstable/scribblings/match.scrbl b/collects/unstable/scribblings/match.scrbl
index 2ba2ee03f9..f5a0ea4b9c 100644
--- a/collects/unstable/scribblings/match.scrbl
+++ b/collects/unstable/scribblings/match.scrbl
@@ -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 ...)