From 0facaeec1a37481536b6cef13c88d9728c2ec29b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 3 Aug 2020 16:29:06 +0200 Subject: [PATCH] Clean up and improve compilation of arithmetic (bug#42597) * lisp/emacs-lisp/byte-opt.el (byte-optimize-associative-math) (byte-optimize-min-max): Transform 3-arg min/max call into two 2-arg calls, which is faster. * lisp/emacs-lisp/bytecomp.el (byte-compile-associative): Rename to... (byte-compile-variadic-numeric): ...this function and simplify, fixing incorrect comments. The 3-arg strength reduction is now always done in the optimisers and is no longer needed here. (byte-compile-min-max): New function. (byte-compile-minus): Simplify, remove incorrect comment, and use byte-compile-variadic-numeric. (byte-compile-quo): Simplify and fix comment. --- lisp/emacs-lisp/byte-opt.el | 29 ++++++++---- lisp/emacs-lisp/bytecomp.el | 93 +++++++++++++++++-------------------- 2 files changed, 62 insertions(+), 60 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0d9c449b3b4..4987596bf95 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -648,14 +648,23 @@ (setq args (cons (car rest) args))) (setq rest (cdr rest))) (if (cdr constants) - (if args - (list (car form) - (apply (car form) constants) - (if (cdr args) - (cons (car form) (nreverse args)) - (car args))) - (apply (car form) constants)) - form))) + (let ((const (apply (car form) (nreverse constants)))) + (if args + (append (list (car form) const) + (nreverse args)) + const)) + form))) + +(defun byte-optimize-min-max (form) + "Optimize `min' and `max'." + (let ((opt (byte-optimize-associative-math form))) + (if (and (consp opt) (memq (car opt) '(min max)) + (= (length opt) 4)) + ;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops. + (list (car opt) + (list (car opt) (nth 1 opt) (nth 2 opt)) + (nth 3 opt)) + opt))) ;; Use OP to reduce any leading prefix of constant numbers in the list ;; (cons ACCUM ARGS) down to a single number, and return the @@ -878,8 +887,8 @@ (put '* 'byte-optimizer #'byte-optimize-multiply) (put '- 'byte-optimizer #'byte-optimize-minus) (put '/ 'byte-optimizer #'byte-optimize-divide) -(put 'max 'byte-optimizer #'byte-optimize-associative-math) -(put 'min 'byte-optimizer #'byte-optimize-associative-math) +(put 'max 'byte-optimizer #'byte-optimize-min-max) +(put 'min 'byte-optimizer #'byte-optimize-min-max) (put '= 'byte-optimizer #'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer #'byte-optimize-binary-predicate) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8f76a3abb99..7ae8749ab40 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3580,10 +3580,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler (% byte-rem) 2) (byte-defop-compiler aset 3) -(byte-defop-compiler max byte-compile-associative) -(byte-defop-compiler min byte-compile-associative) -(byte-defop-compiler (+ byte-plus) byte-compile-associative) -(byte-defop-compiler (* byte-mult) byte-compile-associative) +(byte-defop-compiler max byte-compile-min-max) +(byte-defop-compiler min byte-compile-min-max) +(byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric) +(byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric) ;;####(byte-defop-compiler move-to-column 1) (byte-defop-compiler-1 interactive byte-compile-noop) @@ -3730,30 +3730,36 @@ discarding." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (byte-compile-out 'byte-constant (nth 1 form)))) -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -;; We treat the one-arg case, as in (+ x), like (* x 1). -;; in order to convert markers to numbers, and trigger expected errors. -(defun byte-compile-associative (form) +;; Compile a pure function that accepts zero or more numeric arguments +;; and has an opcode for the binary case. +;; Single-argument calls are assumed to be numeric identity and are +;; compiled as (* x 1) in order to convert markers to numbers and +;; trigger type errors. +(defun byte-compile-variadic-numeric (form) + (pcase (length form) + (1 + ;; No args: use the identity value for the operation. + (byte-compile-constant (eval form))) + (2 + ;; One arg: compile (OP x) as (* x 1). This is identity for + ;; all numerical values including -0.0, infinities and NaNs. + (byte-compile-form (nth 1 form)) + (byte-compile-constant 1) + (byte-compile-out (get '* 'byte-opcode) 0)) + (3 + (byte-compile-form (nth 1 form)) + (byte-compile-form (nth 2 form)) + (byte-compile-out (get (car form) 'byte-opcode) 0)) + (_ + ;; >2 args: compile as a single function call. + (byte-compile-normal-call form)))) + +(defun byte-compile-min-max (form) + "Byte-compile calls to `min' or `max'." (if (cdr form) - (let ((opcode (get (car form) 'byte-opcode)) - args) - (if (and (< 3 (length form)) - (memq opcode (list (get '+ 'byte-opcode) - (get '* 'byte-opcode)))) - ;; Don't use binary operations for > 2 operands, as that - ;; may cause overflow/truncation in float operations. - (byte-compile-normal-call form) - (setq args (copy-sequence (cdr form))) - (byte-compile-form (car args)) - (setq args (cdr args)) - (or args (setq args '(1) - opcode (get '* 'byte-opcode))) - (dolist (arg args) - (byte-compile-form arg) - (byte-compile-out opcode 0)))) - (byte-compile-constant (eval form)))) + (byte-compile-variadic-numeric form) + ;; No args: warn and emit code that raises an error when executed. + (byte-compile-normal-call form))) ;; more complicated compiler macros @@ -3768,7 +3774,7 @@ discarding." (byte-defop-compiler indent-to) (byte-defop-compiler insert) (byte-defop-compiler-1 function byte-compile-function-form) -(byte-defop-compiler-1 - byte-compile-minus) +(byte-defop-compiler (- byte-diff) byte-compile-minus) (byte-defop-compiler (/ byte-quo) byte-compile-quo) (byte-defop-compiler nconc) @@ -3835,30 +3841,17 @@ discarding." ((byte-compile-normal-call form))))) (defun byte-compile-minus (form) - (let ((len (length form))) - (cond - ((= 1 len) (byte-compile-constant 0)) - ((= 2 len) - (byte-compile-form (cadr form)) - (byte-compile-out 'byte-negate 0)) - ((= 3 len) - (byte-compile-form (nth 1 form)) - (byte-compile-form (nth 2 form)) - (byte-compile-out 'byte-diff 0)) - ;; Don't use binary operations for > 2 operands, as that may - ;; cause overflow/truncation in float operations. - (t (byte-compile-normal-call form))))) + (if (/= (length form) 2) + (byte-compile-variadic-numeric form) + (byte-compile-form (cadr form)) + (byte-compile-out 'byte-negate 0))) (defun byte-compile-quo (form) - (let ((len (length form))) - (cond ((< len 2) - (byte-compile-subr-wrong-args form "1 or more")) - ((= len 3) - (byte-compile-two-args form)) - (t - ;; Don't use binary operations for > 2 operands, as that - ;; may cause overflow/truncation in float operations. - (byte-compile-normal-call form))))) + (if (= (length form) 3) + (byte-compile-two-args form) + ;; N-ary `/' is not the left-reduction of binary `/' because if any + ;; argument is a float, then everything is done in floating-point. + (byte-compile-normal-call form))) (defun byte-compile-nconc (form) (let ((len (length form))) -- 2.39.2