Add `union' and `intersection' to rx (bug#37849)

These character set operations, together with `not' for set
complement, improve the compositionality of rx, and reduce duplication
in complicated cases.  Named character classes are not permitted in
set operations.

* lisp/emacs-lisp/rx.el (rx--translate-any): Split into multiple
functions.
(rx--foldl, rx--parse-any, rx--generate-alt, rx--intervals-to-alt)
(rx--complement-intervals, rx--intersect-intervals)
(rx--union-intervals, rx--charset-intervals, rx--charset-union)
(rx--charset-all, rx--charset-intersection, rx--translate-union)
(rx--translate-intersection): New.
(rx--translate-not, rx--translate-form, rx--builtin-forms, rx):
Add `union' and `intersection'.
* test/lisp/emacs-lisp/rx-tests.el (rx-union ,rx-def-in-union)
(rx-intersection, rx-def-in-intersection): New tests.
* doc/lispref/searching.texi (Rx Constructs):
* etc/NEWS:
Document `union' and `intersection'.

1 files changed, 57 insertions, 0 deletions

diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 317dae2990b..0cd2c9590b7 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -274,6 +274,63 @@
   (should (equal (rx (not (not ascii)) (not (not (not (any "a-z")))))
                  "[[:ascii:]][^a-z]")))
 
+(ert-deftest rx-union ()
+  (should (equal (rx (union))
+                 "\\`a\\`"))
+  (should (equal (rx (union (any "ba")))
+                 "[ab]"))
+  (should (equal (rx (union (any "a-f") (any "c-k" ?y) (any ?r "x-z")))
+                 "[a-krx-z]"))
+  (should (equal (rx (union (not (any "a-m")) (not (any "f-p"))))
+                 "[^f-m]"))
+  (should (equal (rx (union (any "e-m") (not (any "a-z"))))
+                 "[^a-dn-z]"))
+  (should (equal (rx (union (not (any "g-r")) (not (any "t"))))
+                 "[^z-a]"))
+  (should (equal (rx (not (union (not (any "g-r")) (not (any "t")))))
+                 "\\`a\\`"))
+  (should (equal (rx (union (union (any "a-f") (any "u-z"))
+                            (any "g-r")))
+                 "[a-ru-z]"))
+  (should (equal (rx (union (intersection (any "c-z") (any "a-g"))
+                            (not (any "a-k"))))
+                 "[^abh-k]")))
+
+(ert-deftest rx-def-in-union ()
+  (rx-let ((a (any "badc"))
+           (b (union a (any "def"))))
+    (should (equal(rx (union b (any "q")))
+                  "[a-fq]"))))
+
+(ert-deftest rx-intersection ()
+  (should (equal (rx (intersection))
+                 "[^z-a]"))
+  (should (equal (rx (intersection (any "ba")))
+                 "[ab]"))
+  (should (equal (rx (intersection (any "a-j" "u-z") (any "c-k" ?y)
+                                   (any "a-i" "x-z")))
+                 "[c-iy]"))
+  (should (equal (rx (intersection (not (any "a-m")) (not (any "f-p"))))
+                 "[^a-p]"))
+  (should (equal (rx (intersection (any "a-z") (not (any "g-q"))))
+                 "[a-fr-z]"))
+  (should (equal (rx (intersection (any "a-d") (any "e")))
+                 "\\`a\\`"))
+  (should (equal (rx (not (intersection (any "a-d") (any "e"))))
+                 "[^z-a]"))
+  (should (equal (rx (intersection (any "d-u")
+                                   (intersection (any "e-z") (any "a-m"))))
+                 "[e-m]"))
+  (should (equal (rx (intersection (union (any "a-f") (any "f-t"))
+                                   (any "e-w")))
+                 "[e-t]")))
+
+(ert-deftest rx-def-in-intersection ()
+  (rx-let ((a (any "a-g"))
+           (b (intersection a (any "d-j"))))
+    (should (equal(rx (intersection b (any "e-k")))
+                  "[e-g]"))))
+
 (ert-deftest rx-group ()
   (should (equal (rx (group nonl) (submatch "x")
                      (group-n 3 "y") (submatch-n 13 "z") (backref 1))