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

Strength-reduce equal', eql', member' and memql'

Browse source 
When comparing against symbols, turn `equal' and `eql' into `eq',
and `member' and `memql' into `memq'.

* lisp/emacs-lisp/byte-opt.el (byte-optimize--constant-symbol-p)
(byte-optimize-equal, byte-optimize-member): New.
(member, memql, equal, eql): Use new byte-optimizers.
This commit is contained in:
Mattias Engdegård 2019-06-19 13:26:58 +02:00
parent d58fc4e8ec
commit d8aba87a0d
1 changed files with 34 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

35
lisp/emacs-lisp/byte-opt.el
View file

@ -834,6 +834,36 @@
(if (= 1 (length (cdr form))) "" "s"))
form))
(defun byte-optimize--constant-symbol-p (expr)
"Whether EXPR is a constant symbol."
(and (macroexp-const-p expr) (symbolp (eval expr))))
(defun byte-optimize-equal (form)
;; Replace `equal' or `eql' with `eq' if at least one arg is a symbol.
(byte-optimize-binary-predicate
(if (= (length (cdr form)) 2)
(if (or (byte-optimize--constant-symbol-p (nth 1 form))
(byte-optimize--constant-symbol-p (nth 2 form)))
(cons 'eq (cdr form))
form)
;; Arity errors reported elsewhere.
form)))
(defun byte-optimize-member (form)
;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
;; or the second arg is a list of symbols.
(if (= (length (cdr form)) 2)
(if (or (byte-optimize--constant-symbol-p (nth 1 form))
(let ((arg2 (nth 2 form)))
(and (macroexp-const-p arg2)
(let ((listval (eval arg2)))
(and (listp listval)
(not (memq nil (mapcar #'symbolp listval))))))))
(cons 'memq (cdr form))
form)
;; Arity errors reported elsewhere.
form))
(defun byte-optimize-memq (form)
;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
(if (/= (length (cdr form)) 2)
@ -879,6 +909,8 @@
(put 'identity 'byte-optimizer 'byte-optimize-identity)
(put 'memq 'byte-optimizer 'byte-optimize-memq)
(put 'memql 'byte-optimizer 'byte-optimize-member)
(put 'member 'byte-optimizer 'byte-optimize-member)
(put '+ 'byte-optimizer 'byte-optimize-plus)
(put '* 'byte-optimizer 'byte-optimize-multiply)
@ -889,7 +921,8 @@
(put '= 'byte-optimizer 'byte-optimize-binary-predicate)
(put 'eq 'byte-optimizer 'byte-optimize-binary-predicate)
(put 'equal 'byte-optimizer 'byte-optimize-binary-predicate)
(put 'eql 'byte-optimizer 'byte-optimize-equal)
(put 'equal 'byte-optimizer 'byte-optimize-equal)
(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)