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

Clean up and improve compilation of arithmetic (bug#42597)

Browse source 
* 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.
This commit is contained in:
Mattias Engdegård 2020-08-03 16:29:06 +02:00
parent 204273c3b9
commit 0facaeec1a
2 changed files with 62 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

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

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