[elpa] externals/xr 4794315 4/5: Check for sequence of subsuming repetitions

[Mattias Engdegård]

branch: externals/xr
commit 47943158113efd4a6e36006a2c95ed164aacadf0
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Check for sequence of subsuming repetitions
    
    This check finds things like [ab]+b?, where one term (b? in this case)
    can be removed because it is subsumed by the other. This can indicate
    an error in the regexp, but also potentially slow matches because
    there are multiple ways to match strings (consider a*a*).
    
    The exact rules are: both terms are repetitions, one operand matches a
    superset of the other, the subsumed repetition can match 0 times, and
    the subsuming repetition can match infinitely many times.
---
 xr-test.el | 10 ++++++++++
 xr.el      | 37 +++++++++++++++++++++++++++++++++++--
 2 files changed, 45 insertions(+), 2 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index f995bfa..26d0653 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -440,6 +440,16 @@
                  '((4 . "Branch matches superset of a previous branch"))))
   (should (equal (xr-lint "abc\\|abcd*e?")
                  '((5 . "Branch matches superset of a previous branch"))))
+  (should (equal (xr-lint "[ab]+a?,a?[ab]+,[ab]*a*,a*[ab]*")
+                 '((6 . "Repetition subsumed by preceding repetition")
+                   (14 . "Repetition subsumes preceding repetition")
+                   (22 . "Repetition subsumed by preceding repetition")
+                   (30 . "Repetition subsumes preceding repetition"))))
+  (should (equal (xr-lint "[^a]+b*,a?.*,a*a*,a*a+")
+                 '((6 . "Repetition subsumed by preceding repetition")
+                   (11 . "Repetition subsumes preceding repetition")
+                   (16 . "Repetition subsumed by preceding repetition")
+                   (21 . "Repetition subsumes preceding repetition"))))
   )
 
 (ert-deftest xr-skip-set ()
diff --git a/xr.el b/xr.el
index 4802b76..46a96bf 100644
--- a/xr.el
+++ b/xr.el
@@ -467,7 +467,7 @@ UPPER may be nil, meaning infinity."
 (defun xr--parse-seq (warnings)
   (let ((sequence nil))                 ; reversed
     (while (not (looking-at (rx (or "\\|" "\\)" eos))))
-      (let ((_item-start (point)))
+      (let ((item-start (point)))
         (cond
          ;; ^ - only special at beginning of sequence
          ((looking-at (rx "^"))
@@ -694,7 +694,40 @@ UPPER may be nil, meaning infinity."
                         (format "Escaped non-special character `%s'"
                                 (xr--escape-string (match-string 2) nil)))))
 
-         (t (error "Backslash at end of regexp")))))
+         (t (error "Backslash at end of regexp")))
+
+        (when (and warnings (cdr sequence))
+          ;; Check for subsuming repetitions in sequence: (Rx X) (Ry Y)
+          ;; where Rx and Ry are repetition operators, and X and Y are 
operands.
+          ;; We conclude that (Rx X) subsumes (Ry Y) if Rx can match
+          ;; infinitely many times, Ry can match zero times,
+          ;; and X matches a superset of Y. Example: [ab]+a?
+          (let* ((item (car sequence))
+                 (expr (and (consp item)
+                            (memq (car item)
+                                  '(zero-or-more one-or-more opt *? +? ??))
+                            (xr--make-seq (cdr item)))))
+            (when expr
+              (let* ((prev-item (cadr sequence))
+                     (prev-expr
+                      (and (consp prev-item)
+                           (memq (car prev-item)
+                                 '(zero-or-more one-or-more opt *? +? ??))
+                           (xr--make-seq (cdr prev-item)))))
+                (when prev-expr
+                  (cond
+                   ((and (memq (car item) '(zero-or-more opt *? ??))
+                         (memq (car prev-item)
+                               '(zero-or-more one-or-more *? +?))
+                         (xr--superset-p prev-expr expr))
+                    (xr--report warnings item-start
+                                "Repetition subsumed by preceding repetition"))
+                   ((and (memq (car prev-item) '(zero-or-more opt *? ??))
+                         (memq (car item) '(zero-or-more one-or-more *? +?))
+                         (xr--superset-p expr prev-expr))
+                    (xr--report
+                     warnings item-start
+                     "Repetition subsumes preceding repetition"))))))))))
 
     (let ((item-seq (xr--rev-join-seq sequence)))
       (cond ((null item-seq)