From bcbedc56a3c50b942136109fe970db958ef09de0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Tue, 6 Sep 2016 22:26:40 +0200
Subject: [PATCH] Allow dotted list syntax for match expanders, e.g. (match v
 [(some-match-expander a b c . d) (displayln (list a b c d))])

---
 .../scribblings/reference/match.scrbl         | 24 +++++++++++++++++++
 pkgs/racket-test/tests/match/main.rkt         | 19 +++++++++++++++
 racket/collects/racket/match/parse.rkt        |  2 +-
 3 files changed, 44 insertions(+), 1 deletion(-)

diff --git a/pkgs/racket-doc/scribblings/reference/match.scrbl b/pkgs/racket-doc/scribblings/reference/match.scrbl
index 7f8ef3d7d7..15278a86bc 100644
--- a/pkgs/racket-doc/scribblings/reference/match.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/match.scrbl
@@ -646,6 +646,30 @@ expander and @racket[len] always returns @racket[0].
   (len nil)
   (len (cons 1 nil))
   (len (cons 1 (cons 2 nil)))]
+
+Match expanders accept any syntax pair whose first element is an
+@racket[identifier?] bound to the expander. The following example
+shows a match expander which can be called with an improper syntax
+list of the form @racket[(expander a b . rest)].
+@examples[#:label #f
+  #:eval match-eval
+  (eval:no-prompt
+   (define-match-expander my-vector
+     (λ (stx)
+       (syntax-case stx ()
+         [(_ pat ...)
+          #'(vector pat ...)]
+         [(_ pat ... . rest-pat)
+          #'(app vector->list (list-rest pat ... rest-pat))]))))
+  (match #(1 2 3 4 5)
+   [(my-vector a b . rest)
+     (list->vector (append rest (list a b)))])]
+
+@history[
+ #:changed "6.9.0.2"
+ @elem{Match expanders now allowed any syntax pair whose first element is an 
+  @racket[identifier?] bound to the expander. The example above did not work
+  with previous versions.}]
 }
 
 @defthing[prop:match-expander struct-type-property?]{
diff --git a/pkgs/racket-test/tests/match/main.rkt b/pkgs/racket-test/tests/match/main.rkt
index 9a77411425..4eb42f6713 100644
--- a/pkgs/racket-test/tests/match/main.rkt
+++ b/pkgs/racket-test/tests/match/main.rkt
@@ -158,6 +158,25 @@
                 (check = 7 (match (list (make-point 2 3))
                              [(list (Point (app add1 x) (app add1 y))) (+ x y)]))
                 ))
+
+   (test-case "Expander which accepts a dotted list syntax"
+              (let ()
+                (define-match-expander bar
+                  (lambda (stx)
+                    (syntax-case stx ()
+                      [(_ a b . c)
+                       #'(and (app sub1 c) (app a b))]))
+                  +)
+                ;; check that it works as a pattern
+                (check = 3 (match 4 [(bar add1 5 . x) x]))
+                ;; check that sub-patterns still work on the dotted argument
+                (check = 3 (match 4 [(bar add1 5 . (? number? y)) y]))
+                (check = 3 (match 4 [(bar add1 5 ? number? y) y]))
+                ;; check that it works inside other patterns, e.g. a list
+                (check-equal? '(4 6 8) (match '(5 7 9)
+                                         [(list (bar add1 number? . x) ...) x]))
+                ;; check that it works as an expression
+                (check = 12 (apply bar '(3 4 5))))) ; bar works like +
    ))
 
 (define simple-tests 
diff --git a/racket/collects/racket/match/parse.rkt b/racket/collects/racket/match/parse.rkt
index 07e0546902..9a2a6f6d63 100644
--- a/racket/collects/racket/match/parse.rkt
+++ b/racket/collects/racket/match/parse.rkt
@@ -35,7 +35,7 @@
                                   regexp pregexp list-rest list-no-order hash-table
                                   quasiquote mcons list* mlist)
                 (lambda (x y) (eq? (syntax-e x) (syntax-e y)))
-    [(expander args ...)
+    [(expander . args)
      (and (identifier? #'expander)
           (syntax-local-value/record #'expander match-expander?))
      (match-expander-transform