Move define/match to racket/match

collects/mzlib/scribblings/match.scrbl

@@ -31,6 +31,7 @@ follows:
 @; ------------------------------------------------------------
 
 @deftogether[(
+@defform[(define/match (head args) match*-clause ...)]
 @defform[(match-lambda clause ...)]
 @defform[(match-lambda* clause ...)]
 @defform[(match-let ([pat expr] ...) body ...+)]

collects/racket/match/define-forms.rkt

@@ -5,23 +5,47 @@
                      (only-in racket/list append* remove-duplicates)
                      unstable/sequence
                      syntax/parse
+                     syntax/parse/experimental/template
                      (only-in racket/match/patterns bound-vars)
                      (only-in racket/match/gen-match go go/one)))
 
 (provide define-forms)
 
+;; syntax classes for `define/match`
+(begin-for-syntax
+  (define-syntax-class function-header
+    (pattern ((~or header:function-header name:id) . args:args)
+             #:attr params
+             (template ((?@ . (?? header.params ()))
+                        . args.params))))
+
+  (define-syntax-class args
+    (pattern (arg:arg ...)
+             #:attr params #'(arg.name ...))
+    (pattern (arg:arg ... . rest:id)
+             #:attr params #'(arg.name ... rest)))
+
+  (define-splicing-syntax-class arg
+    #:attributes (name)
+    (pattern name:id)
+    (pattern [name:id default])
+    (pattern (~seq kw:keyword name:id))
+    (pattern (~seq kw:keyword [name:id default]))))
+
 (define-syntax-rule (define-forms parse-id
                       match match* match-lambda match-lambda*
 		      match-lambda** match-let match-let*
                       match-let-values match-let*-values
 		      match-define match-define-values match-letrec
-		      match/values match/derived match*/derived)
+		      match/values match/derived match*/derived
+                      define/match)
   (...
    (begin
      (provide match match* match-lambda match-lambda* match-lambda**
 	      match-let match-let* match-let-values match-let*-values
               match-define match-define-values match-letrec
-	      match/values match/derived match*/derived match-define-values)
+	      match/values match/derived match*/derived match-define-values
+              define/match)
      (define-syntax (match* stx)
        (syntax-parse stx
          [(_ es . clauses)
@@ -144,4 +168,12 @@
             (quasisyntax/loc stx
               (define-values #,bound-vars-list
                 (match/values rhs
-                  [(pats ...) (values . #,bound-vars-list)]))))])))))
+                  [(pats ...) (values . #,bound-vars-list)]))))]))
+
+     (define-syntax (define/match stx)
+       (syntax-parse stx
+         [(_ ?header:function-header ?clause ...)
+          (template
+           (define ?header
+             (match* (?? ?header.params)
+               ?clause ...)))])))))

collects/racket/match/legacy-match.rkt

@@ -17,4 +17,5 @@
 (define-forms parse/legacy
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
   match-let-values match-let*-values
-  match-define match-define-values match-letrec match/values match/derived match*/derived)
+  match-define match-define-values match-letrec match/values match/derived match*/derived
+  define/match)

collects/racket/match/match.rkt

@@ -27,4 +27,5 @@
   match match* match-lambda match-lambda* match-lambda** match-let match-let*
   match-let-values match-let*-values
   match-define match-define-values match-letrec match/values
-  match/derived match*/derived)
+  match/derived match*/derived
+  define/match)

collects/scribblings/reference/match.scrbl

@@ -383,6 +383,50 @@ exactly @racket[n] patterns. At least one clause is required to determine how
 many values to expect from @racket[expr].
 }
 
+@defform/subs[
+  (define/match (head args)
+    match*-clause ...)
+  ([head id (head args)]
+   [args (code:line arg ...)
+         (code:line arg ... @#,racketparenfont{.} rest-id)]
+   [arg arg-id
+        [arg-id default-expr]
+        (code:line keyword arg-id)
+        (code:line keyword [arg-id default-expr])]
+   [match*-clause [(pat ...+) body ...+]
+                  [(pat ...+) (=> id) body ...+]])
+]{
+  Binds @racket[id] to a procedure that is defined by pattern matching
+  clauses using @racket[match*]. Each clause takes a sequence of
+  patterns that correspond to the arguments in the function header.
+  The arguments are ordered as they appear in the function header for
+  matching purposes.
+
+  The function header may contain optional or keyword arguments, or
+  may be in curried form.
+
+  @defexamples[#:eval match-eval
+    (define/match (fact n)
+      [(0) 1]
+      [(n) (* n (fact (sub1 n)))])
+    (fact 5)
+
+    (define/match ((f x) #:y [y '(1 2 3)])
+      [((regexp #rx"p+") `(,a 2 3)) a]
+      [(_ _) #f])
+    ((f "ape") #:y '(5 2 3))
+    ((f "dog"))
+
+    (define/match (g x y . rst)
+      [(0 0 '()) #t]
+      [(5 5 '(5 5)) #t]
+      [(_ _ _) #f])
+    (g 0 0)
+    (g 5 5 5 5)
+    (g 1 2)
+  ]
+}
+
 @defform[(match-lambda clause ...)]{
 
 Equivalent to @racket[(lambda (id) (match id clause ...))].

collects/tests/match/define-match.rkt

@@ -1,7 +1,6 @@
 #lang racket/base
 
-(require rackunit
-         unstable/match)
+(require rackunit racket/match)
 
 (define/match ((curried x) y)
   [((? number? x) y) (+ x y)]
@@ -41,3 +40,18 @@
 (check-false (f))
 (check-false (f 2))
 (check-false (f 2 4 5))
+
+(require (prefix-in legacy: mzlib/match))
+(legacy:define/match (fact-2 n)
+  [(0) 1]
+  [(n) (* n (fact (sub1 n)))])
+
+(check-equal? (fact-2 0) 1)
+(check-equal? (fact-2 5) 120)
+
+(legacy:define/match (list-fun lst)
+  [((1 2 3)) #t]
+  [((_ _ _ )) #f])
+
+(check-equal? (list-fun '(1 2 3)) #t)
+(check-equal? (list-fun '(4 5 6)) #f)

collects/unstable/match.rkt

@@ -3,8 +3,7 @@
 (require racket/class
          racket/match
          (for-syntax racket/base)
-         (for-syntax syntax/parse
-                     syntax/parse/experimental/template))
+         (for-syntax syntax/parse))
 
 (provide match? as object)
 
@@ -15,38 +14,6 @@
   (syntax-rules ()
     [(as ([x e] ...) p ...) (and (app (lambda (y) e) x) ... p ...)]))
 
-;; Added by asumu
-;; Comprehensive `define` procedure form for match
-(provide define/match)
-
-(begin-for-syntax
-  (define-syntax-class function-header
-    (pattern ((~or header:function-header name:id) . args:args)
-             #:attr params
-             (template ((?@ . (?? header.params ()))
-                        . args.params))))
-
-  (define-syntax-class args
-    (pattern (arg:arg ...)
-             #:attr params #'(arg.name ...))
-    (pattern (arg:arg ... . rest:id)
-             #:attr params #'(arg.name ... rest)))
-
-  (define-splicing-syntax-class arg
-    #:attributes (name)
-    (pattern name:id)
-    (pattern [name:id default])
-    (pattern (~seq kw:keyword name:id))
-    (pattern (~seq kw:keyword [name:id default]))))
-
-(define-syntax (define/match stx)
-  (syntax-parse stx
-    [(_ ?header:function-header ?clause ...)
-     (template
-      (define ?header
-        (match* (?? ?header.params)
-          ?clause ...)))]))
-
 ;; Added by asumu
 ;; Match expander for objects from racket/class
 (define-match-expander object