From e55855c5a1e85e230d2860c973358a34eb72da64 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 28 Jan 2023 16:26:37 +0100 Subject: Better compilation of n-ary comparisons MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) (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 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) -- cgit v1.2.3