[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
emacs-27 5fcb97d: Fix cond jump table compilation (bug#42919)
From: |
Mattias Engdegård |
Subject: |
emacs-27 5fcb97d: Fix cond jump table compilation (bug#42919) |
Date: |
Wed, 19 Aug 2020 13:16:32 -0400 (EDT) |
branch: emacs-27
commit 5fcb97dabd3f7b00ebc574d6be4bad16a64482de
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Fix cond jump table compilation (bug#42919)
This bug affected compilation of
(cond ((member '(some list) variable) ...) ...)
While equal is symmetric, member is not; in the latter case the
arguments must be a variable and a constant list, in that order.
Reported by Ikumi Keita.
* lisp/emacs-lisp/bytecomp.el (byte-compile--cond-switch-prefix):
Don't treat equality and member predicates in the same way; only
the former are symmetric in their arguments.
* test/lisp/emacs-lisp/bytecomp-tests.el
(byte-opt-testsuite-arith-data): Add test cases.
---
lisp/emacs-lisp/bytecomp.el | 52 ++++++++++++++++++----------------
test/lisp/emacs-lisp/bytecomp-tests.el | 15 +++++++++-
2 files changed, 42 insertions(+), 25 deletions(-)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 5479e65..90745a3 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4172,40 +4172,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
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index a16adfe..3aba9af 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -347,7 +347,20 @@
((eq x 't) 99)
(t 999))))
'((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c)
- (t c) (x "a") (x "c") (x c) (x d) (x e))))
+ (t c) (x "a") (x "c") (x c) (x d) (x e)))
+
+ (mapcar (lambda (x) (cond ((member '(a . b) x) 1)
+ ((equal x '(c)) 2)))
+ '(((a . b)) a b (c) (d)))
+ (mapcar (lambda (x) (cond ((memq '(a . b) x) 1)
+ ((equal x '(c)) 2)))
+ '(((a . b)) a b (c) (d)))
+ (mapcar (lambda (x) (cond ((member '(a b) x) 1)
+ ((equal x '(c)) 2)))
+ '(((a b)) a b (c) (d)))
+ (mapcar (lambda (x) (cond ((memq '(a b) x) 1)
+ ((equal x '(c)) 2)))
+ '(((a b)) a b (c) (d))))
"List of expression for test.
Each element will be executed by interpreter and with
bytecompiled code, and their results compared.")
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- emacs-27 5fcb97d: Fix cond jump table compilation (bug#42919),
Mattias Engdegård <=