branch: externals/xr commit 7160235fe06fdbd8814d9384f4239c9a6e8ad809 Author: Mattias Engdegård <matti...@acm.org> Commit: Mattias Engdegård <matti...@acm.org>
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)