master 0facaee 2/2: Clean up and improve compilation of arithmetic (bug#42597)

[Mattias Engdegård]

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

    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 0d9c449..4987596 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 8f76a3a..7ae8749 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)))