master e55855c5a1e 1/2: Better compilation of n-ary comparisons

[Mattias Engdegård]

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

    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.
---
 lisp/emacs-lisp/byte-opt.el | 44 +++++++++++++++++++++++++++++++++++++++++++-
 lisp/emacs-lisp/bytecomp.el | 38 ++++++++++++++++++++------------------
 2 files changed, 63 insertions(+), 19 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)
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index aa9521e5a65..bfb9be4712b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -3748,7 +3748,7 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
                                      '((0 . byte-compile-no-args)
                                        (1 . byte-compile-one-arg)
                                        (2 . byte-compile-two-args)
-                                       (2-and . byte-compile-and-folded)
+                                        (2-cmp . byte-compile-cmp)
                                        (3 . byte-compile-three-args)
                                        (0-1 . byte-compile-zero-or-one-arg)
                                        (1-2 . byte-compile-one-or-two-args)
@@ -3827,11 +3827,11 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
 (byte-defop-compiler cons              2)
 (byte-defop-compiler aref              2)
 (byte-defop-compiler set               2)
-(byte-defop-compiler (= byte-eqlsign)  2-and)
-(byte-defop-compiler (< byte-lss)      2-and)
-(byte-defop-compiler (> byte-gtr)      2-and)
-(byte-defop-compiler (<= byte-leq)     2-and)
-(byte-defop-compiler (>= byte-geq)     2-and)
+(byte-defop-compiler (= byte-eqlsign)  2-cmp)
+(byte-defop-compiler (< byte-lss)      2-cmp)
+(byte-defop-compiler (> byte-gtr)      2-cmp)
+(byte-defop-compiler (<= byte-leq)     2-cmp)
+(byte-defop-compiler (>= byte-geq)     2-cmp)
 (byte-defop-compiler get               2)
 (byte-defop-compiler nth               2)
 (byte-defop-compiler substring         1-3)
@@ -3895,18 +3895,20 @@ If it is nil, then the handler is 
\"byte-compile-SYMBOL.\""
     (byte-compile-form (nth 2 form))
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
-(defun byte-compile-and-folded (form)
-  "Compile calls to functions like `<='.
-These implicitly `and' together a bunch of two-arg bytecodes."
-  (let ((l (length form)))
-    (cond
-     ((< l 3) (byte-compile-form `(progn ,(nth 1 form) t)))
-     ((= l 3) (byte-compile-two-args form))
-     ;; Don't use `cl-every' here (see comment where we require cl-lib).
-     ((not (memq nil (mapcar #'macroexp-copyable-p (nthcdr 2 form))))
-      (byte-compile-form `(and (,(car form) ,(nth 1 form) ,(nth 2 form))
-                              (,(car form) ,@(nthcdr 2 form)))))
-     (t (byte-compile-normal-call form)))))
+(defun byte-compile-cmp (form)
+  "Compile calls to numeric comparisons such as `<', `=' etc."
+  ;; Lisp-level transforms should already have reduced valid calls to 2 args.
+  (if (not (= (length form) 3))
+      (byte-compile-subr-wrong-args form "1 or more")
+    (byte-compile-two-args
+     (if (macroexp-const-p (nth 1 form))
+         ;; First argument is constant: flip it so that the constant
+         ;; is last, which may allow more lapcode optimisations.
+         (let* ((op (car form))
+                (flipped-op (cdr (assq op '((< . >) (<= . >=)
+                                            (> . <) (>= . <=) (= . =))))))
+           (list flipped-op (nth 2 form) (nth 1 form)))
+       form))))
 
 (defun byte-compile-three-args (form)
   (if (not (= (length form) 4))