diff options
| author | Mattias EngdegÄrd | 2019-05-21 12:19:38 +0200 |
|---|---|---|
| committer | Mattias EngdegÄrd | 2019-06-19 11:20:58 +0200 |
| commit | b8c74742c0238fe15b1cdc9a7f6ee021d038368f (patch) | |
| tree | d2d51fb226584f28017cb04ef8c3d173e83f1e87 | |
| parent | 36ab408207d7adf94fd1396922e0df38d746a948 (diff) | |
| download | emacs-b8c74742c0238fe15b1cdc9a7f6ee021d038368f.tar.gz emacs-b8c74742c0238fe15b1cdc9a7f6ee021d038368f.zip | |
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.el | 15 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/pcase-tests.el | 6 |
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 | |||
| 785 | ((eq 'or (caar matches)) | 785 | ((eq 'or (caar matches)) |
| 786 | (let* ((alts (cdar matches)) | 786 | (let* ((alts (cdar matches)) |
| 787 | (var (if (eq (caar alts) 'match) (cadr (car alts)))) | 787 | (var (if (eq (caar alts) 'match) (cadr (car alts)))) |
| 788 | (simples '()) (others '()) (memql-ok t)) | 788 | (simples '()) (others '()) (mem-fun 'memq)) |
| 789 | (when var | 789 | (when var |
| 790 | (dolist (alt alts) | 790 | (dolist (alt alts) |
| 791 | (if (and (eq (car alt) 'match) (eq var (cadr alt)) | 791 | (if (and (eq (car alt) 'match) (eq var (cadr alt)) |
| 792 | (let ((upat (cddr alt))) | 792 | (let ((upat (cddr alt))) |
| 793 | (eq (car-safe upat) 'quote))) | 793 | (eq (car-safe upat) 'quote))) |
| 794 | (let ((val (cadr (cddr alt)))) | 794 | (let ((val (cadr (cddr alt)))) |
| 795 | (unless (or (integerp val) (symbolp val)) | 795 | (cond ((integerp val) |
| 796 | (setq memql-ok nil)) | 796 | (when (eq mem-fun 'memq) |
| 797 | (push (cadr (cddr alt)) simples)) | 797 | (setq mem-fun 'memql))) |
| 798 | ((not (symbolp val)) | ||
| 799 | (setq mem-fun 'member))) | ||
| 800 | (push val simples)) | ||
| 798 | (push alt others)))) | 801 | (push alt others)))) |
| 799 | (cond | 802 | (cond |
| 800 | ((null alts) (error "Please avoid it") (pcase--u rest)) | 803 | ((null alts) (error "Please avoid it") (pcase--u rest)) |
| 801 | ;; Yes, we can use `memql' (or `member')! | 804 | ;; Yes, we can use `memql' (or `member')! |
| 802 | ((> (length simples) 1) | 805 | ((> (length simples) 1) |
| 803 | (pcase--u1 (cons `(match ,var | 806 | (pcase--u1 (cons `(match ,var |
| 804 | . (pred (pcase--flip | 807 | . (pred (pcase--flip ,mem-fun ',simples))) |
| 805 | ,(if memql-ok #'memql #'member) | ||
| 806 | ',simples))) | ||
| 807 | (cdr matches)) | 808 | (cdr matches)) |
| 808 | code vars | 809 | code vars |
| 809 | (if (null others) rest | 810 | (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 @@ | |||
| 51 | 51 | ||
| 52 | (ert-deftest pcase-tests-member () | 52 | (ert-deftest pcase-tests-member () |
| 53 | (should (pcase-tests-grep | 53 | (should (pcase-tests-grep |
| 54 | 'memql (macroexpand-all '(pcase x ((or 1 2 3) body))))) | 54 | 'memq (macroexpand-all '(pcase x ((or 'a 'b 'c) body))))) |
| 55 | (should (pcase-tests-grep | 55 | (should (pcase-tests-grep |
| 56 | 'member (macroexpand-all '(pcase x ((or "a" 2 3) body))))) | 56 | 'memql (macroexpand-all '(pcase x ((or 1 2 3 'a) body))))) |
| 57 | (should (pcase-tests-grep | ||
| 58 | 'member (macroexpand-all '(pcase x ((or "a" 2 3 'a) body))))) | ||
| 57 | (should-not (pcase-tests-grep | 59 | (should-not (pcase-tests-grep |
| 58 | 'memq (macroexpand-all '(pcase x ((or "a" 2 3) body))))) | 60 | 'memq (macroexpand-all '(pcase x ((or "a" 2 3) body))))) |
| 59 | (should-not (pcase-tests-grep | 61 | (should-not (pcase-tests-grep |