Follow function aliases for side-effect-free and pure properties

This way we don't need to set these properties on aliases at all;
it was always easy to forget doing so.

* lisp/emacs-lisp/byte-opt.el (byte-opt--fget): New function.
(byte-optimize-form-code-walker, byte-optimize-form): Use it.
(side-effect-free-fns, side-effect-and-error-free-fns, pure-fns):
Remove aliases from lists, leaving only built-in functions.
This commit is contained in:
Mattias Engdegård 2023-02-23 14:04:55 +01:00
parent 1bed13111b
commit 1defa5000b

View file

@ -272,6 +272,14 @@ for speeding up processing.")
. ,(cdr case)))
cases)))
(defsubst byte-opt--fget (f prop)
"Simpler and faster version of `function-get'."
(let ((val nil))
(while (and (symbolp f) f
(null (setq val (get f prop))))
(setq f (symbol-function f)))
val))
(defun byte-optimize-form-code-walker (form for-effect)
;;
;; For normal function calls, We can just mapcar the optimizer the cdr. But
@ -497,7 +505,7 @@ for speeding up processing.")
form)
((guard (when for-effect
(if-let ((tmp (get fn 'side-effect-free)))
(if-let ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
@ -516,7 +524,7 @@ for speeding up processing.")
;; even if the called function is for-effect, because we
;; don't know anything about that function.
(let ((form (cons fn (mapcar #'byte-optimize-form (cdr form)))))
(if (get fn 'pure)
(if (byte-opt--fget fn 'pure)
(byte-optimize-constant-args form)
form))))))
@ -538,7 +546,7 @@ for speeding up processing.")
;; until a fixpoint has been reached.
(and (consp form)
(symbolp (car form))
(let ((opt (function-get (car form) 'byte-optimizer)))
(let ((opt (byte-opt--fget (car form) 'byte-optimizer)))
(and opt
(let ((old form)
(new (funcall opt form)))
@ -1661,7 +1669,7 @@ See Info node `(elisp) Integer Basics'."
frame-visible-p fround ftruncate
get gethash get-buffer get-buffer-window get-file-buffer
hash-table-count
int-to-string intern-soft isnan
intern-soft isnan
keymap-parent
ldexp
length length< length> length=
@ -1675,23 +1683,22 @@ See Info node `(elisp) Integer Basics'."
prefix-numeric-value previous-window prin1-to-string propertize
rassq rassoc read-from-string
regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp
string>
sin sqrt string string-equal string-lessp
string-search string-to-char
string-to-number string-to-syntax substring
sxhash sxhash-equal sxhash-eq sxhash-eql
symbol-function symbol-name symbol-plist symbol-value string-make-unibyte
sxhash-equal sxhash-eq sxhash-eql
symbol-function symbol-name symbol-plist symbol-value
string-make-unibyte
string-make-multibyte string-as-multibyte string-as-unibyte
string-to-multibyte
take tan time-convert truncate
unibyte-char-to-multibyte upcase user-full-name
user-login-name user-original-login-name
user-login-name
vconcat
window-at window-body-height
window-body-width window-buffer window-dedicated-p window-display-table
window-combination-limit window-frame window-fringes
window-height window-hscroll window-inside-edges
window-inside-absolute-pixel-edges window-inside-pixel-edges
window-hscroll
window-left-child window-left-column window-margins window-minibuffer-p
window-next-buffers window-next-sibling window-new-normal
window-new-total window-normal-size window-parameter window-parameters
@ -1699,7 +1706,7 @@ See Info node `(elisp) Integer Basics'."
window-prev-sibling window-scroll-bars
window-start window-text-height window-top-child window-top-line
window-total-height window-total-width window-use-time window-vscroll
window-width))
))
(side-effect-and-error-free-fns
'(arrayp atom
bobp bolp bool-vector-p
@ -1716,7 +1723,7 @@ See Info node `(elisp) Integer Basics'."
keymapp keywordp
list listp
make-marker mark-marker markerp max-char
natnump nlistp not null number-or-marker-p numberp
natnump nlistp null number-or-marker-p numberp
overlayp
point point-marker point-min point-max preceding-char
processp proper-list-p
@ -1763,11 +1770,11 @@ See Info node `(elisp) Integer Basics'."
copysign isnan ldexp float logb
floor ceiling round truncate
ffloor fceiling fround ftruncate
string= string-equal string< string-lessp string>
string-equal string-lessp
string-search
consp atom listp nlistp proper-list-p
sequencep arrayp vectorp stringp bool-vector-p hash-table-p
null not
null
numberp integerp floatp natnump characterp
integer-or-marker-p number-or-marker-p char-or-string-p
symbolp keywordp