summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2019-05-21 12:19:38 +0200
committerMattias EngdegÄrd <mattiase@acm.org>2019-06-19 11:20:58 +0200
commitb8c74742c0238fe15b1cdc9a7f6ee021d038368f (patch)
treed2d51fb226584f28017cb04ef8c3d173e83f1e87
parent36ab408207d7adf94fd1396922e0df38d746a948 (diff)
downloademacs-b8c74742c0238fe15b1cdc9a7f6ee021d038368f.tar.gz
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.
-rw-r--r--lisp/emacs-lisp/pcase.el15
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el6
2 files changed, 12 insertions, 9 deletions
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