procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Better compilation of n-ary comparisons

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2023-01-28 16:26:37 +01:00
parent e2b37f901d
commit e55855c5a1
2 changed files with 63 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
lisp/emacs-lisp/byte-opt.el
View file

@ -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)

38
lisp/emacs-lisp/bytecomp.el
View file

@ -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))