bug#27659: 26.0.50; Add string-matched-text: string-match + match-string

[Philipp Stephani <p.stephani2@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 670 bytes --]

Tino Calancha <tino.calancha@gmail.com> schrieb am Mi., 12. Juli 2017 um
08:16 Uhr:

> Severity: wishlist
>
> Just wondering if the following is of any interest:
>
> (defun string-matched-text (regexp string num &optional start)
>   ""
>   (when (string-match regexp string start)
>     (match-string num string)))
>
> Then,
>
> (let ((str "foo-123"))
>   (when (string-match "[[:alpha:]]+-\\([0-9]+\\)" str)
>     (match-string 1 str)))
> => "123"
>
> is equivalent to:
> (string-matched-text "[[:alpha:]]+-\\([0-9]+\\)" "foo-123" 1)
> => "123"
>

This looks useful, but I think it would be even better to add it as a pcase
macro to be composable (see attached patch).

[-- Attachment #1.2: Type: text/html, Size: 1095 bytes --]

[-- Attachment #2: 0001-Add-rx-pattern-for-pcase.txt --]
[-- Type: text/plain, Size: 4322 bytes --]

From b95f7477887a283134a19021b8d21ee466d457c3 Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Thu, 20 Jul 2017 21:36:18 +0200
Subject: [PATCH] Add 'rx' pattern for pcase.

* lisp/emacs-lisp/pcase.el (rx): New pcase macro.
* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-rx): Add unit test.
---
 etc/NEWS                            |  3 +++
 lisp/emacs-lisp/pcase.el            | 47 +++++++++++++++++++++++++++++++++++++
 test/lisp/emacs-lisp/pcase-tests.el |  9 +++++++
 3 files changed, 59 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index 954fe0d547..a16db7f4e0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1521,6 +1521,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.
+
 \f
 * 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 4a06ab25d3..2273840916 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -54,6 +54,7 @@
 ;;; Code:
 
 (require 'macroexp)
+(require 'rx)
 
 ;; Macro-expansion of pcase is reasonably fast, so it's not a problem
 ;; when byte-compiling a file, but when interpreting the code, if the pcase
@@ -930,6 +931,52 @@ pcase--u1
    ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
    (t (error "Unknown QPAT: %S" qpat))))
 
+(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'.
+
+Within the case code, the match data is bound as usual, but you
+still have to pass the correct string as argument to
+`match-string'.
+
+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 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."
+  (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-var ,(lambda (form)
+                            (rx-check form)
+                            (rx-form
+                             `(backref ,(1+ (cl-position (cadr form) vars
+                                                         :test #'eq)))))
+                         1 1 ,(lambda (var) (memq var vars)))
+            ,@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)))))
 
 (provide 'pcase)
 ;;; pcase.el ends here
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index ef0b2f6b24..a887b460b1 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -67,6 +67,15 @@ pcase-tests-grep
 (ert-deftest pcase-tests-vectors ()
   (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
 
+(ert-deftest pcase-tests-rx ()
+  (should (equal (pcase "a 1 2 3 1 b"
+                   ((rx (let u (+ digit)) space
+                        (let v (+ digit)) space
+                        (let v (+ digit)) space
+                        (backref-var u))
+                    (list u v)))
+                 '("1" "3"))))
+
 ;; Local Variables:
 ;; no-byte-compile: t
 ;; End:
-- 
2.14.0.rc0.284.gd933b75aa4-goog