emacs-diffs
[Top][All Lists]
Advanced

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

master f3fce3a71c 1/2: Simplify and speed up parts of elisp optimiser


From: Mattias Engdegård
Subject: master f3fce3a71c 1/2: Simplify and speed up parts of elisp optimiser
Date: Wed, 8 Feb 2023 08:32:26 -0500 (EST)

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

    Simplify and speed up parts of elisp optimiser
    
    * lisp/emacs-lisp/byte-opt.el (byte-optimize-constant-args): Simplify.
    (byte-optimize--constant-symbol-p): Speed up.
    (byteopt--eval-const): New.
    (byte-optimize-member, byte-optimize-concat, byte-optimize-append):
    Use byteopt--eval-const instead of eval which is much slower.
---
 lisp/emacs-lisp/byte-opt.el | 41 +++++++++++++++++++++++++----------------
 1 file changed, 25 insertions(+), 16 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e0c769c7e6..b7e21db688 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1019,16 +1019,14 @@ for speeding up processing.")
      (t form))))
 
 (defun byte-optimize-constant-args (form)
-  (let ((ok t)
-       (rest (cdr form)))
-    (while (and rest ok)
-      (setq ok (macroexp-const-p (car rest))
-           rest (cdr rest)))
-    (if ok
-       (condition-case ()
-           (list 'quote (eval form))
-         (error form))
-       form)))
+  (let ((rest (cdr form)))
+    (while (and rest (macroexp-const-p (car rest)))
+      (setq rest (cdr rest)))
+    (if rest
+       form
+      (condition-case ()
+         (list 'quote (eval form t))
+       (error form)))))
 
 (defun byte-optimize-identity (form)
   (if (and (cdr form) (null (cdr (cdr form))))
@@ -1036,8 +1034,19 @@ for speeding up processing.")
     form))
 
 (defun byte-optimize--constant-symbol-p (expr)
-  "Whether EXPR is a constant symbol."
-  (and (macroexp-const-p expr) (symbolp (eval expr))))
+  "Whether EXPR is a constant symbol, like (quote hello), nil, t, or :keyword."
+  (if (consp expr)
+      (and (memq (car expr) '(quote function))
+           (symbolp (cadr expr)))
+    (or (memq expr '(nil t))
+        (keywordp expr))))
+
+(defsubst byteopt--eval-const (expr)
+  "Evaluate EXPR which must be a constant (quoted or self-evaluating).
+Ie, (macroexp-const-p EXPR) must be true."
+  (if (consp expr)
+      (cadr expr)                   ; assumed to be 'VALUE or #'SYMBOL
+    expr))
 
 (defun byte-optimize--fixnump (o)
   "Return whether O is guaranteed to be a fixnum in all Emacsen.
@@ -1074,7 +1083,7 @@ See Info node `(elisp) Integer Basics'."
         (byte-optimize--fixnump (nth 1 form))
         (let ((arg2 (nth 2 form)))
           (and (macroexp-const-p arg2)
-               (let ((listval (eval arg2)))
+               (let ((listval (byteopt--eval-const arg2)))
                  (and (listp listval)
                       (not (memq nil (mapcar
                                       (lambda (o)
@@ -1131,7 +1140,7 @@ See Info node `(elisp) Integer Basics'."
             val)
         (while (and args (macroexp-const-p (car args))
                     (progn
-                      (setq val (eval (car args)))
+                      (setq val (byteopt--eval-const (car args)))
                       (and (or (stringp val)
                                (and (or (listp val) (vectorp val))
                                     (not (memq nil
@@ -1528,7 +1537,7 @@ See Info node `(elisp) Integer Basics'."
              (cond
               ((macroexp-const-p arg)
                ;; constant arg
-               (let ((val (eval arg)))
+               (let ((val (byteopt--eval-const arg)))
                  (cond
                   ;; Elide empty arguments (nil, empty string, etc).
                   ((zerop (length val))
@@ -1538,7 +1547,7 @@ See Info node `(elisp) Integer Basics'."
                    (loop (cdr args)
                          (cons
                           (list 'quote
-                                (append (eval prev) val nil))
+                                (append (byteopt--eval-const prev) val nil))
                           (cdr newargs))))
                   (t (loop (cdr args) (cons arg newargs))))))
 



reply via email to

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