diff options
| author | Michael Albinus <michael.albinus@gmx.de> | 2020-08-25 15:29:38 +0200 |
|---|---|---|
| committer | Michael Albinus <michael.albinus@gmx.de> | 2020-08-25 15:29:38 +0200 |
| commit | 36f2f67c96d44c82ce31dafb38cd4e2622a5a372 (patch) | |
| tree | 61f4d8cb918bfc22c7deab7258f00e2ae36d4482 /lisp/emacs-lisp | |
| parent | 478c2e23620eeda65030458762a843231f7e9b35 (diff) | |
| parent | 44104a607aeb7fd73bf7edcbbe6a508eee36dd0f (diff) | |
| download | emacs-36f2f67c96d44c82ce31dafb38cd4e2622a5a372.tar.gz emacs-36f2f67c96d44c82ce31dafb38cd4e2622a5a372.tar.bz2 emacs-36f2f67c96d44c82ce31dafb38cd4e2622a5a372.zip | |
Merge from origin/emacs-27
44104a607a Fix error in GMP test
e26e63444d Add Feature testing for Windows binaries
4e2caef384 ; * src/character.c (str_as_multibyte): Fix the commentary.
d3a4ce8420 Revert "; * etc/NEWS: Remove temporary note on documentati...
16f00e36dc * admin/admin.el (set-version): Trap yet another NEWS error.
121be3e118 ; * etc/NEWS: Remove temporary note on documentation. (Bu...
5fcb97dabd Fix cond jump table compilation (bug#42919)
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 52 |
1 files changed, 28 insertions, 24 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7ae8749ab40..966990bac96 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4132,40 +4132,44 @@ Return (TAIL VAR TEST CASES), where: (switch-var nil) (switch-test 'eq)) (while (pcase (car clauses) - (`((,fn ,expr1 ,expr2) . ,body) + (`((,(and fn (or 'eq 'eql 'equal)) ,expr1 ,expr2) . ,body) (let* ((vars (byte-compile--cond-vars expr1 expr2)) (var (car vars)) (value (cdr vars))) (and var (or (eq var switch-var) (not switch-var)) - (cond - ((memq fn '(eq eql equal)) + (progn (setq switch-var var) (setq switch-test (byte-compile--common-test switch-test fn)) (unless (member value keys) (push value keys) (push (cons (list value) (or body '(t))) cases)) - t) - ((and (memq fn '(memq memql member)) - (listp value) - ;; Require a non-empty body, since the member - ;; function value depends on the switch - ;; argument. - body) - (setq switch-var var) - (setq switch-test - (byte-compile--common-test - switch-test (cdr (assq fn '((memq . eq) - (memql . eql) - (member . equal)))))) - (let ((vals nil)) - (dolist (elem value) - (unless (funcall fn elem keys) - (push elem vals))) - (when vals - (setq keys (append vals keys)) - (push (cons (nreverse vals) body) cases))) - t)))))) + t)))) + (`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body) + (and (symbolp var) + (or (eq var switch-var) (not switch-var)) + (macroexp-const-p expr) + ;; Require a non-empty body, since the member + ;; function value depends on the switch argument. + body + (let ((value (eval expr))) + (and (proper-list-p value) + (progn + (setq switch-var var) + (setq switch-test + (byte-compile--common-test + switch-test + (cdr (assq fn '((memq . eq) + (memql . eql) + (member . equal)))))) + (let ((vals nil)) + (dolist (elem value) + (unless (funcall fn elem keys) + (push elem vals))) + (when vals + (setq keys (append vals keys)) + (push (cons (nreverse vals) body) cases))) + t)))))) (setq clauses (cdr clauses))) ;; Assume that a single switch is cheaper than two or more discrete ;; compare clauses. This could be tuned, possibly taking into |