From: Mattias Engdegård <mattiase@acm.org>
Date: Tue, 21 May 2019 10:19:38 +0000 (+0200)
Subject: Tighter pcase or-pattern member function selection (bug#36139)
X-Git-Tag: emacs-27.0.90~2408
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b8c74742c0238fe15b1cdc9a7f6ee021d038368f;p=emacs.git

Tighter pcase or-pattern member function selection (bug#36139)

* lisp/emacs-lisp/pcase.el (pcase--u1):
Use the most specific of `memq', `memql' and `member' in or-patterns
with constant cases.  This improves performance and may help the byte-code
compiler generate a switch.
* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-member):
Add mixed-type or-pattern test cases.
---

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index a644453a948..ae2cf8eb02f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -785,25 +785,26 @@ Otherwise, it defers to REST which is a list of branches of the form
    ((eq 'or (caar matches))
     (let* ((alts (cdar matches))
            (var (if (eq (caar alts) 'match) (cadr (car alts))))
-           (simples '()) (others '()) (memql-ok t))
+           (simples '()) (others '()) (mem-fun 'memq))
       (when var
         (dolist (alt alts)
           (if (and (eq (car alt) 'match) (eq var (cadr alt))
                    (let ((upat (cddr alt)))
                      (eq (car-safe upat) 'quote)))
               (let ((val (cadr (cddr alt))))
-                (unless (or (integerp val) (symbolp val))
-                  (setq memql-ok nil))
-                (push (cadr (cddr alt)) simples))
+                (cond ((integerp val)
+                       (when (eq mem-fun 'memq)
+                         (setq mem-fun 'memql)))
+                      ((not (symbolp val))
+                       (setq mem-fun 'member)))
+                (push val simples))
             (push alt others))))
       (cond
        ((null alts) (error "Please avoid it") (pcase--u rest))
        ;; Yes, we can use `memql' (or `member')!
        ((> (length simples) 1)
         (pcase--u1 (cons `(match ,var
-                                 . (pred (pcase--flip
-                                          ,(if memql-ok #'memql #'member)
-                                          ',simples)))
+                                 . (pred (pcase--flip ,mem-fun ',simples)))
                          (cdr matches))
                    code vars
                    (if (null others) rest
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index af8c9a3f3c3..e8c0b8219c5 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -51,9 +51,11 @@
 
 (ert-deftest pcase-tests-member ()
   (should (pcase-tests-grep
-           'memql (macroexpand-all '(pcase x ((or 1 2 3) body)))))
+           'memq (macroexpand-all '(pcase x ((or 'a 'b 'c) body)))))
   (should (pcase-tests-grep
-           'member (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
+           'memql (macroexpand-all '(pcase x ((or 1 2 3 'a) body)))))
+  (should (pcase-tests-grep
+           'member (macroexpand-all '(pcase x ((or "a" 2 3 'a) body)))))
   (should-not (pcase-tests-grep
                'memq (macroexpand-all '(pcase x ((or "a" 2 3) body)))))
   (should-not (pcase-tests-grep