Add 'rx' pattern for pcase.

* lisp/emacs-lisp/rx.el (rx): New pcase macro.
* test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add unit test.

4 files changed, 69 insertions, 1 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 4cb02bf518a..f43491b6306 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1555,6 +1555,9 @@ manual.
 ** 'tcl-auto-fill-mode' is now declared obsolete.  Its functionality
 can be replicated simply by setting 'comment-auto-fill-only-comments'.
 
+** New pcase pattern 'rx' to match against a rx-style regular
+expression.
+
 
 * Changes in Emacs 26.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4a06ab25d3e..b40161104d2 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -930,6 +930,5 @@ QPAT can take the following forms:
    ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
    (t (error "Unknown QPAT: %S" qpat))))
 
-
 (provide 'pcase)
 ;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 386232c6eef..b66f2c6d512 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1169,6 +1169,62 @@ enclosed in `(and ...)'.
          (rx-to-string `(and ,@regexps) t))
         (t
          (rx-to-string (car regexps) t))))
+
+
+(pcase-defmacro rx (&rest regexps)
+  "Build a `pcase' pattern matching `rx' regexps.
+The REGEXPS are interpreted as by `rx'.  The pattern matches if
+the regular expression so constructed matches the object, as if
+by `string-match'.
+
+In addition to the usual `rx' constructs, REGEXPS can contain the
+following constructs:
+
+  (let VAR FORM...)  creates a new explicitly numbered submatch
+                     that matches FORM and binds the match to
+                     VAR.
+  (backref VAR)      creates a backreference to the submatch
+                     introduced by a previous (let VAR ...)
+                     construct.
+
+The VARs are associated with explicitly numbered submatches
+starting from 1.  Multiple occurrences of the same VAR refer to
+the same submatch.
+
+If a case matches, the match data is modified as usual so you can
+use it in the case body, but you still have to pass the correct
+string as argument to `match-string'."
+  (let* ((vars ())
+         (rx-constituents
+          `((let
+             ,(lambda (form)
+                (rx-check form)
+                (let ((var (cadr form)))
+                  (cl-check-type var symbol)
+                  (let ((i (or (cl-position var vars :test #'eq)
+                               (prog1 (length vars)
+                                 (setq vars `(,@vars ,var))))))
+                    (rx-form `(submatch-n ,(1+ i) ,@(cddr form))))))
+             1 nil)
+            (backref
+             ,(lambda (form)
+                (rx-check form)
+                (rx-backref
+                 `(backref ,(let ((var (cadr form)))
+                              (if (integerp var) var
+                                (1+ (cl-position var vars :test #'eq)))))))
+             1 1
+             ,(lambda (var)
+                (cond ((integerp var) (rx-check-backref var))
+                      ((memq var vars) t)
+                      (t (error "rx `backref' variable must be one of %s: %s"
+                                vars var)))))
+            ,@rx-constituents))
+         (regexp (rx-to-string `(seq ,@regexps) :no-group)))
+    `(and (pred (string-match ,regexp))
+          ,@(cl-loop for i from 1
+                     for var in vars
+                     collect `(app (match-string ,i) ,var)))))
 
 ;; ;; sregex.el replacement
 
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 8b7945c9d27..8f353b7e863 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -33,5 +33,15 @@
                                   (number-sequence ?< ?\])
                                   (number-sequence ?- ?:))))))
 
+(ert-deftest rx-pcase ()
+  (should (equal (pcase "a 1 2 3 1 1 b"
+                   ((rx (let u (+ digit)) space
+                        (let v (+ digit)) space
+                        (let v (+ digit)) space
+                        (backref u) space
+                        (backref 1))
+                    (list u v)))
+                 '("1" "3"))))
+
 (provide 'rx-tests)
 ;; rx-tests.el ends here.