[elpa] externals/xr 7160235 02/10: Refactor repetition subsumption check to avoid code duplication

[Mattias Engdegård]

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

    Refactor repetition subsumption check to avoid code duplication
---
 xr-test.el |  2 +-
 xr.el      | 52 +++++++++-------------------------------------------
 2 files changed, 10 insertions(+), 44 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index 2001a39..a46cf60 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -602,7 +602,7 @@
              '((13 . "First item in repetition subsumes last item 
(wrapped)"))))
     (should (equal
              (xr-lint "\\(?3:a*xa*\\)\\{7\\}")
-             '((14 . "First item in repetition subsumes last item 
(wrapped)"))))
+             '((14 . "Last item in repetition subsumes first item 
(wrapped)"))))
     ))
 
 (ert-deftest xr-skip-set ()
diff --git a/xr.el b/xr.el
index 985f4d8..3e09ac0 100644
--- a/xr.el
+++ b/xr.el
@@ -490,11 +490,11 @@ like (* (* X) ... (* X))."
       (when (cddr operands)
         (let* ((first (car operands))
                (last (car (last operands)))
-               (subsumption (xr--adjacent-subsumption first last)))
+               (subsumption (xr--adjacent-subsumption last first)))
           (when subsumption
             (xr--report
              warnings pos
-             (if (eq subsumption 'a-subsumes-b)
+             (if (eq subsumption 'b-subsumes-a)
                  "First item in repetition subsumes last item (wrapped)"
                "Last item in repetition subsumes first item (wrapped)"))))))))
 
@@ -743,48 +743,14 @@ like (* (* X) ... (* X))."
          (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), in the sense that the
-          ;; sequence is equivalent to just (Rx X), if:
-          ;;       X matches a superset of Y
-          ;;   and Rx can match infinitely many times
-          ;;   and Ry can match zero times
-          ;;   and Ry is non-greedy if Rx is non-greedy.
-          ;; 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
-                  (let ((op (car item))
-                        (prev-op (car prev-item)))
-                    ;; Test the same condition twice, but mirrored.
-                    (cond
-                     ((and (memq op '(zero-or-more opt *? ??))
-                           (memq prev-op '(zero-or-more one-or-more *? +?))
-                           (not (and (memq prev-op '(*? +?))
-                                     (memq op '(zero-or-more opt))))
-                           (xr--superset-p prev-expr expr))
-                      (xr--report
-                       warnings item-start
-                       "Repetition subsumed by preceding repetition"))
-                     ((and (memq prev-op '(zero-or-more opt *? ??))
-                           (memq op '(zero-or-more one-or-more *? +?))
-                           (not (and (memq op '(*? +?))
-                                     (memq prev-op '(zero-or-more opt))))
-                           (xr--superset-p expr prev-expr))
-                      (xr--report
-                       warnings item-start
-                       "Repetition subsumes preceding repetition")))))))))))
+                 (prev-item (cadr sequence))
+                 (subsumption (xr--adjacent-subsumption prev-item item)))
+            (when subsumption
+              (xr--report warnings item-start
+                          (if (eq subsumption 'a-subsumes-b)
+                              "Repetition subsumed by preceding repetition"
+                            "Repetition subsumes preceding repetition")))))))
 
     (let ((item-seq (xr--rev-join-seq sequence)))
       (cond ((null item-seq)