Better compilation of n-ary comparisons

Transform n-ary comparisons to a chain of binary comparisons in the
Lisp optimiser instead of in codegen, to allow for subsequent
optimisations.  This generalises the transform, so that

   (< 1 X 10)  ->  (let ((x X)) (and (< 1 x) (< x 10)))

where (< 1 x) is then flipped to (> x 1) in codegen since it's
slightly more efficient to have the constant argument last.  Arguments
that are neither constants nor variables are given temporary bindings.

This results in about 2× speedup for 3-ary comparisons of fixnums with
nontrivial arguments, and also improves the code slightly for binary
comparisons with a constant first argument.

* lisp/emacs-lisp/byte-opt.el (byte-opt--nary-comparison): New,
set as the `byte-optimizer` property for =, <, <=, >, and >=.
* lisp/emacs-lisp/bytecomp.el (byte-compile-and-folded):
Rename to...
(byte-compile-cmp): ...and rewrite.

1 files changed, 43 insertions, 1 deletions

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index b1a46d520e6..4d39e28fc8e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -975,6 +975,43 @@ for speeding up processing.")
    (t ;; Moving the constant to the end can enable some lapcode optimizations.
     (list (car form) (nth 2 form) (nth 1 form)))))
 
+(defun byte-opt--nary-comparison (form)
+  "Optimise n-ary comparisons such as `=', `<' etc."
+  (let ((nargs (length (cdr form))))
+    (cond
+     ((= nargs 1)
+      `(progn (cadr form) t))
+     ((>= nargs 3)
+      ;; At least 3 arguments: transform to N-1 binary comparisons,
+      ;; since those have their own byte-ops which are particularly
+      ;; fast for fixnums.
+      (let* ((op (car form))
+             (bindings nil)
+             (rev-args nil))
+        (if (memq nil (mapcar #'macroexp-copyable-p (cddr form)))
+            ;; At least one arg beyond the first is non-constant non-variable:
+            ;; create temporaries for all args to guard against side-effects.
+            ;; The optimiser will eliminate trivial bindings later.
+            (let ((i 1))
+              (dolist (arg (cdr form))
+                (let ((var (make-symbol (format "arg%d" i))))
+                  (push var rev-args)
+                  (push (list var arg) bindings)
+                  (setq i (1+ i)))))
+          ;; All args beyond the first are copyable: no temporary variables
+          ;; required.
+          (setq rev-args (reverse (cdr form))))
+        (let ((prev (car rev-args))
+              (exprs nil))
+          (dolist (arg (cdr rev-args))
+            (push (list op arg prev) exprs)
+            (setq prev arg))
+          (let ((and-expr (cons 'and exprs)))
+            (if bindings
+                (list 'let (nreverse bindings) and-expr)
+              and-expr)))))
+     (t form))))
+
 (defun byte-optimize-constant-args (form)
   (let ((ok t)
 	(rest (cdr form)))
@@ -1130,13 +1167,18 @@ See Info node `(elisp) Integer Basics'."
 (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-eq)
 (put 'eql   'byte-optimizer #'byte-optimize-equal)
 (put 'equal 'byte-optimizer #'byte-optimize-equal)
 (put 'string= 'byte-optimizer #'byte-optimize-binary-predicate)
 (put 'string-equal 'byte-optimizer #'byte-optimize-binary-predicate)
 
+(put '=  'byte-optimizer #'byte-opt--nary-comparison)
+(put '<  'byte-optimizer #'byte-opt--nary-comparison)
+(put '<= 'byte-optimizer #'byte-opt--nary-comparison)
+(put '>  'byte-optimizer #'byte-opt--nary-comparison)
+(put '>= 'byte-optimizer #'byte-opt--nary-comparison)
+
 (put 'string-greaterp 'byte-optimizer #'byte-optimize-string-greaterp)
 (put 'string> 'byte-optimizer #'byte-optimize-string-greaterp)