procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix cond jump table compilation (bug#42919)

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2020-08-19 14:59:29 +02:00
parent 362ca83a3b
commit 5fcb97dabd
2 changed files with 42 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
lisp/emacs-lisp/bytecomp.el
View file

@ -4172,40 +4172,44 @@ Return (TAIL VAR TEST CASES), where:
(switch-var nil) (switch-var nil)
(switch-test 'eq)) (switch-test 'eq))
(while (pcase (car clauses) (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)) (let* ((vars (byte-compile--cond-vars expr1 expr2))
(var (car vars)) (var (car vars))
(value (cdr vars))) (value (cdr vars)))
(and var (or (eq var switch-var) (not switch-var)) (and var (or (eq var switch-var) (not switch-var))
(cond (progn
((memq fn '(eq eql equal))
(setq switch-var var) (setq switch-var var)
(setq switch-test (setq switch-test
(byte-compile--common-test switch-test fn)) (byte-compile--common-test switch-test fn))
(unless (member value keys) (unless (member value keys)
(push value keys) (push value keys)
(push (cons (list value) (or body '(t))) cases)) (push (cons (list value) (or body '(t))) cases))
t) t))))
((and (memq fn '(memq memql member)) (`((,(and fn (or 'memq 'memql 'member)) ,var ,expr) . ,body)
(listp value) (and (symbolp var)
;; Require a non-empty body, since the member (or (eq var switch-var) (not switch-var))
;; function value depends on the switch (macroexp-const-p expr)
;; argument. ;; Require a non-empty body, since the member
body) ;; function value depends on the switch argument.
(setq switch-var var) body
(setq switch-test (let ((value (eval expr)))
(byte-compile--common-test (and (proper-list-p value)
switch-test (cdr (assq fn '((memq . eq) (progn
(memql . eql) (setq switch-var var)
(member . equal)))))) (setq switch-test
(let ((vals nil)) (byte-compile--common-test
(dolist (elem value) switch-test
(unless (funcall fn elem keys) (cdr (assq fn '((memq . eq)
(push elem vals))) (memql . eql)
(when vals (member . equal))))))
(setq keys (append vals keys)) (let ((vals nil))
(push (cons (nreverse vals) body) cases))) (dolist (elem value)
t)))))) (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))) (setq clauses (cdr clauses)))
;; Assume that a single switch is cheaper than two or more discrete ;; Assume that a single switch is cheaper than two or more discrete
;; compare clauses. This could be tuned, possibly taking into ;; compare clauses. This could be tuned, possibly taking into

15
test/lisp/emacs-lisp/bytecomp-tests.el
View file

@ -347,7 +347,20 @@
((eq x 't) 99) ((eq x 't) 99)
(t 999)))) (t 999))))
'((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c) '((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. "List of expression for test.
Each element will be executed by interpreter and with Each element will be executed by interpreter and with
bytecompiled code, and their results compared.") bytecompiled code, and their results compared.")