emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 1defa5000b1 1/3: Follow function aliases for `side-effect-free` a


From: Mattias Engdegård
Subject: master 1defa5000b1 1/3: Follow function aliases for `side-effect-free` and `pure` properties
Date: Fri, 24 Feb 2023 10:54:15 -0500 (EST)

branch: master
commit 1defa5000b1881817c515d7979661fbdc6fc0968
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 lisp/emacs-lisp/byte-opt.el | 37 ++++++++++++++++++++++---------------
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 456ec06a141..d60e3a9dae7 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]