From c10293e168f752607ae51edd09922505927c29b1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 3 Jul 2020 20:13:50 +0200 Subject: Relax portable number check in byte compiler (bug#42147) With bignums, the set of representable integers is no longer platform-dependent, and since we use nothing but IEEE754 64-bit floats, all numbers are now portable. Take advantage of this fact to simplify constant-folding in the byte compiler, allowing it to be applied more widely. * lisp/emacs-lisp/byte-opt.el (byte-opt--portable-max) (byte-opt--portable-min, byte-opt--portable-numberp): Remove. (byte-opt--arith-reduce, byte-optimize-minus, byte-optimize-1+) (byte-optimize-1-): Simplify: any number will do, and if N is a number, then so are -N, N+1 and N-1. --- lisp/emacs-lisp/byte-opt.el | 39 +++++++++------------------------------ 1 file changed, 9 insertions(+), 30 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 12bde8faf39..bf9e6a728a3 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -672,36 +672,18 @@ (apply (car form) constants)) form))) -;; Portable Emacs integers fall in this range. -(defconst byte-opt--portable-max #x1fffffff) -(defconst byte-opt--portable-min (- -1 byte-opt--portable-max)) - -;; True if N is a number that works the same on all Emacs platforms. -;; Portable Emacs fixnums are exactly representable as floats on all -;; Emacs platforms, and (except for -0.0) any floating-point number -;; that equals one of these integers must be the same on all -;; platforms. Although other floating-point numbers such as 0.5 are -;; also portable, it can be tricky to characterize them portably so -;; they are not optimized. -(defun byte-opt--portable-numberp (n) - (and (numberp n) - (<= byte-opt--portable-min n byte-opt--portable-max) - (= n (floor n)) - (not (and (floatp n) (zerop n) - (condition-case () (< (/ n) 0) (error)))))) - -;; Use OP to reduce any leading prefix of portable numbers in the list -;; (cons ACCUM ARGS) down to a single portable number, and return the +;; Use OP to reduce any leading prefix of constant numbers in the list +;; (cons ACCUM ARGS) down to a single number, and return the ;; resulting list A of arguments. The idea is that applying OP to A ;; is equivalent to (but likely more efficient than) applying OP to ;; (cons ACCUM ARGS), on any Emacs platform. Do not make any special ;; provision for (- X) or (/ X); for example, it is the caller’s ;; responsibility that (- 1 0) should not be "optimized" to (- 1). (defun byte-opt--arith-reduce (op accum args) - (when (byte-opt--portable-numberp accum) + (when (numberp accum) (let (accum1) - (while (and (byte-opt--portable-numberp (car args)) - (byte-opt--portable-numberp + (while (and (numberp (car args)) + (numberp (setq accum1 (condition-case () (funcall op accum (car args)) (error)))) @@ -746,12 +728,11 @@ ;; (- x -1) --> (1+ x) ((equal (cdr args) '(-1)) (list '1+ (car args))) - ;; (- n) -> -n, where n and -n are portable numbers. + ;; (- n) -> -n, where n and -n are constant numbers. ;; This must be done separately since byte-opt--arith-reduce ;; is not applied to (- n). ((and (null (cdr args)) - (byte-opt--portable-numberp (car args)) - (byte-opt--portable-numberp (- (car args)))) + (numberp (car args))) (- (car args))) ;; not further optimized ((equal args (cdr form)) form) @@ -761,8 +742,7 @@ (let ((args (cdr form))) (when (null (cdr args)) (let ((n (car args))) - (when (and (byte-opt--portable-numberp n) - (byte-opt--portable-numberp (1+ n))) + (when (numberp n) (setq form (1+ n)))))) form) @@ -770,8 +750,7 @@ (let ((args (cdr form))) (when (null (cdr args)) (let ((n (car args))) - (when (and (byte-opt--portable-numberp n) - (byte-opt--portable-numberp (1- n))) + (when (numberp n) (setq form (1- n)))))) form) -- cgit v1.2.3 From fb63a64d2159be9cd9bf63a0a6ebff582e385528 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 5 Jul 2020 13:47:34 +0200 Subject: 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(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index bf9e6a728a3..971e4ddbcc9 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))) -- cgit v1.2.3 From 3f990c3cccf85e64399bf98ea3e61cb618e8455c Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 6 Jul 2020 17:38:52 +0200 Subject: Simplify byte-code optimisation of pure functions Most pure functions need no explicit optimisation; we can do away with almost all uses of byte-optimize-predicate (now renamed to byte-optimize-constant-args, since it is not just for predicates). Also remove some superfluous arity warnings. * lisp/emacs-lisp/byte-opt.el (byte-optimize-identity, byte-optimize-memq) (byte-optimize-nth, byte-optimize-nthcdr): Remove arity warnings and simplify. * lisp/emacs-lisp/byte-opt.el (<, >, <=, >=, not, null, consp, listp) (symbolp, stringp, string<, string-lessp, proper-list-p, logand) (logior, logxor, lognot, car, cdr, car-safe, cdr-safe): Remove superfluous byte-optimizer property. (byte-optimize-predicate): Rename to byte-optimize-constant-args. All uses changed. --- lisp/emacs-lisp/byte-opt.el | 57 +++++++++++---------------------------------- 1 file changed, 14 insertions(+), 43 deletions(-) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 971e4ddbcc9..646994a37c1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -795,7 +795,7 @@ (t ;; This can enable some lapcode optimizations. (list (car form) (nth 2 form) (nth 1 form))))) -(defun byte-optimize-predicate (form) +(defun byte-optimize-constant-args (form) (let ((ok t) (rest (cdr form))) (while (and rest ok) @@ -810,9 +810,6 @@ (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) (nth 1 form) - (byte-compile-warn "identity called with %d arg%s, but requires 1" - (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) form)) (defun byte-optimize--constant-symbol-p (expr) @@ -847,19 +844,16 @@ (defun byte-optimize-memq (form) ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) - (if (/= (length (cdr form)) 2) - (byte-compile-warn "memq called with %d arg%s, but requires 2" - (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) - (let ((list (nth 2 form))) - (when (and (eq (car-safe list) 'quote) + (if (= (length (cdr form)) 2) + (let ((list (nth 2 form))) + (if (and (eq (car-safe list) 'quote) (listp (setq list (cadr list))) (= (length list) 1)) - (setq form (byte-optimize-and - `(and ,(byte-optimize-predicate - `(eq ,(nth 1 form) ',(nth 0 list))) - ',list))))) - (byte-optimize-predicate form))) + `(and (eq ,(nth 1 form) ',(nth 0 list)) + ',list) + form)) + ;; Arity errors reported elsewhere. + form)) (defun byte-optimize-concat (form) "Merge adjacent constant arguments to `concat'." @@ -907,31 +901,8 @@ (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) -(put '< 'byte-optimizer 'byte-optimize-predicate) -(put '> 'byte-optimizer 'byte-optimize-predicate) -(put '<= 'byte-optimizer 'byte-optimize-predicate) -(put '>= 'byte-optimizer 'byte-optimize-predicate) (put '1+ 'byte-optimizer 'byte-optimize-1+) (put '1- 'byte-optimizer 'byte-optimize-1-) -(put 'not 'byte-optimizer 'byte-optimize-predicate) -(put 'null 'byte-optimizer 'byte-optimize-predicate) -(put 'consp 'byte-optimizer 'byte-optimize-predicate) -(put 'listp 'byte-optimizer 'byte-optimize-predicate) -(put 'symbolp 'byte-optimizer 'byte-optimize-predicate) -(put 'stringp 'byte-optimizer 'byte-optimize-predicate) -(put 'string< 'byte-optimizer 'byte-optimize-predicate) -(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) -(put 'proper-list-p 'byte-optimizer 'byte-optimize-predicate) - -(put 'logand 'byte-optimizer 'byte-optimize-predicate) -(put 'logior 'byte-optimizer 'byte-optimize-predicate) -(put 'logxor 'byte-optimizer 'byte-optimize-predicate) -(put 'lognot 'byte-optimizer 'byte-optimize-predicate) - -(put 'car 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr 'byte-optimizer 'byte-optimize-predicate) -(put 'car-safe 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) (put 'concat 'byte-optimizer 'byte-optimize-concat) @@ -962,7 +933,7 @@ nil)) ((null (cdr (cdr form))) (nth 1 form)) - ((byte-optimize-predicate form)))) + ((byte-optimize-constant-args form)))) (defun byte-optimize-or (form) ;; Throw away nil's, and simplify if less than 2 args. @@ -975,7 +946,7 @@ (setq form (copy-sequence form) rest (setcdr (memq (car rest) form) nil)))) (if (cdr (cdr form)) - (byte-optimize-predicate form) + (byte-optimize-constant-args form) (nth 1 form)))) (defun byte-optimize-cond (form) @@ -1122,7 +1093,7 @@ (list 'car (if (zerop (nth 1 form)) (nth 2 form) (list 'cdr (nth 2 form)))) - (byte-optimize-predicate form)) + form) form)) (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) @@ -1134,7 +1105,7 @@ (while (>= (setq count (1- count)) 0) (setq form (list 'cdr form))) form) - (byte-optimize-predicate form)) + form) form)) ;; Fixme: delete-char -> delete-region (byte-coded) @@ -2208,7 +2179,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (or noninteractive (message "compiling %s...done" x))) '(byte-optimize-form byte-optimize-body - byte-optimize-predicate + byte-optimize-constant-args byte-optimize-binary-predicate ;; Inserted some more than necessary, to speed it up. byte-optimize-form-code-walker -- cgit v1.2.3 From df3ece9d2ed61c9526dbf718e3c96d72bd53dccb Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Mon, 6 Jul 2020 12:51:04 +0200 Subject: Optimise assoc and rassoc with symbol key to assq and rassq This is the same transformation made for member to memq. * lisp/emacs-lisp/byte-opt.el (byte-optimize-assoc): New function. (assoc, rassoc): Set the byte-optimizer property. --- lisp/emacs-lisp/byte-opt.el | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'lisp/emacs-lisp/byte-opt.el') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 646994a37c1..194ceee176f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -842,6 +842,15 @@ ;; Arity errors reported elsewhere. form)) +(defun byte-optimize-assoc (form) + ;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq', + ;; if the first arg is a symbol. + (if (and (= (length form) 3) + (byte-optimize--constant-symbol-p (nth 1 form))) + (cons (if (eq (car form) 'assoc) 'assq 'rassq) + (cdr form)) + form)) + (defun byte-optimize-memq (form) ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar)) (if (= (length (cdr form)) 2) @@ -886,6 +895,8 @@ (put 'memq 'byte-optimizer 'byte-optimize-memq) (put 'memql 'byte-optimizer 'byte-optimize-member) (put 'member 'byte-optimizer 'byte-optimize-member) +(put 'assoc 'byte-optimizer 'byte-optimize-assoc) +(put 'rassoc 'byte-optimizer 'byte-optimize-assoc) (put '+ 'byte-optimizer 'byte-optimize-plus) (put '* 'byte-optimizer 'byte-optimize-multiply) -- cgit v1.2.3