master fb63a64 1/2: Mark more functions pure (bug#42147)

[Mattias Engdegård]

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

    Mark more functions pure (bug#42147)
    
    Extend the list of 'pure' functions to many predicates and numerical
    functions that we are reasonably confident will give portable results.
    Also include various list and array accessors, because our use of purity
    in the byte compiler isn't affected by the mutability of arguments.
    
    * lisp/emacs-lisp/byte-opt.el: Update example in comment.
    (pure-fns): Add many functions.
    (byte-optimize-form-code-walker) Don't signal errors during evaluation
    of calls to pure functions with constant arguments at compile time,
    since such calls are not necessarily reachable.
---
 lisp/emacs-lisp/byte-opt.el | 49 ++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 42 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index bf9e6a7..971e4dd 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -557,7 +557,10 @@
           (let ((args (mapcar #'byte-optimize-form (cdr form))))
             (if (and (get fn 'pure)
                      (byte-optimize-all-constp args))
-                  (list 'quote (apply fn (mapcar #'eval args)))
+                 (let ((arg-values (mapcar #'eval args)))
+                   (condition-case nil
+                       (list 'quote (apply fn arg-values))
+                     (error (cons fn args))))
               (cons fn args)))))))
 
 (defun byte-optimize-all-constp (list)
@@ -1274,9 +1277,9 @@
 ;; Pure functions are side-effect free functions whose values depend
 ;; only on their arguments, not on the platform.  For these functions,
 ;; calls with constant arguments can be evaluated at compile time.
-;; This may shift runtime errors to compile time.  For example, logand
-;; is pure since its results are machine-independent, whereas ash is
-;; not pure because (ash 1 29)'s value depends on machine word size.
+;; For example, ash is pure since its results are machine-independent,
+;; whereas lsh is not pure because (lsh -1 -1)'s value depends on the
+;; fixnum range.
 ;;
 ;; When deciding whether a function is pure, do not worry about
 ;; mutable strings or markers, as they are so unlikely in real code
@@ -1286,9 +1289,41 @@
 ;; values if a marker is moved.
 
 (let ((pure-fns
-       '(% concat logand logcount logior lognot logxor
-        regexp-opt regexp-quote
-        string-to-char string-to-syntax symbol-name)))
+       '(concat regexp-opt regexp-quote
+        string-to-char string-to-syntax symbol-name
+         eq eql
+         = /= < <= => > min max
+         + - * / % mod abs ash 1+ 1- sqrt
+         logand logior lognot logxor logcount
+         copysign isnan ldexp float logb
+         floor ceiling round truncate
+         ffloor fceiling fround ftruncate
+         string= string-equal string< string-lessp
+         consp atom listp nlistp propert-list-p
+         sequencep arrayp vectorp stringp bool-vector-p hash-table-p
+         null not
+         numberp integerp floatp natnump characterp
+         integer-or-marker-p number-or-marker-p char-or-string-p
+         symbolp keywordp
+         type-of
+         identity ignore
+
+         ;; The following functions are pure up to mutation of their
+         ;; arguments.  This is pure enough for the purposes of
+         ;; constant folding, but not necessarily for all kinds of
+         ;; code motion.
+         car cdr car-safe cdr-safe nth nthcdr last
+         equal
+         length safe-length
+         memq memql member
+         ;; `assoc' and `assoc-default' are excluded since they are
+         ;; impure if the test function is (consider `string-match').
+         assq rassq rassoc
+         plist-get lax-plist-get plist-member
+         aref elt
+         bool-vector-subsetp
+         bool-vector-count-population bool-vector-count-consecutive
+         )))
   (while pure-fns
     (put (car pure-fns) 'pure t)
     (setq pure-fns (cdr pure-fns)))