Better compilation of char-before, backward-char and backward-word

Implement char-before, backward-char and backward-word as compiler
macros instead of byte-compile handlers so that the source-level
optimiser gets to simplify the result.  In particular, this removes
some branches.

* lisp/emacs-lisp/bytecomp.el (byte-compile-char-before)
(byte-compile-backward-char, byte-compile-backward-word): Remove.
(bytecomp--char-before, bytecomp--backward-char)
(bytecomp--backward-word): New.
This commit is contained in:
Mattias Engdegård 2023-07-27 11:51:26 +02:00
parent e055c635b0
commit 93eccb5e04

View file

@ -4306,9 +4306,6 @@ This function is never called when `lexical-binding' is nil."
;; more complicated compiler macros
(byte-defop-compiler char-before)
(byte-defop-compiler backward-char)
(byte-defop-compiler backward-word)
(byte-defop-compiler list)
(byte-defop-compiler concat)
(byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
@ -4319,40 +4316,6 @@ This function is never called when `lexical-binding' is nil."
(byte-defop-compiler (/ byte-quo) byte-compile-quo)
(byte-defop-compiler nconc)
;; Is this worth it? Both -before and -after are written in C.
(defun byte-compile-char-before (form)
(cond ((or (= 1 (length form))
(and (= 2 (length form)) (not (nth 1 form))))
(byte-compile-form '(char-after (1- (point)))))
((= 2 (length form))
(byte-compile-form (list 'char-after (if (numberp (nth 1 form))
(1- (nth 1 form))
`(1- (or ,(nth 1 form)
(point)))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
;; backward-... ==> forward-... with negated argument.
;; Is this worth it? Both -backward and -forward are written in C.
(defun byte-compile-backward-char (form)
(cond ((or (= 1 (length form))
(and (= 2 (length form)) (not (nth 1 form))))
(byte-compile-form '(forward-char -1)))
((= 2 (length form))
(byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
(- (nth 1 form))
`(- (or ,(nth 1 form) 1))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
(defun byte-compile-backward-word (form)
(cond ((or (= 1 (length form))
(and (= 2 (length form)) (not (nth 1 form))))
(byte-compile-form '(forward-word -1)))
((= 2 (length form))
(byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
(- (nth 1 form))
`(- (or ,(nth 1 form) 1))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
(defun byte-compile-list (form)
(let ((count (length (cdr form))))
(cond ((= count 0)
@ -5797,6 +5760,28 @@ and corresponding effects."
(put 'remq 'compiler-macro #'bytecomp--check-memq-args)
(put 'delq 'compiler-macro #'bytecomp--check-memq-args)
;; Implement `char-before', `backward-char' and `backward-word' in
;; terms of `char-after', `forward-char' and `forward-word' which have
;; their own byte-ops.
(put 'char-before 'compiler-macro #'bytecomp--char-before)
(defun bytecomp--char-before (form &optional arg &rest junk-args)
(if junk-args
form ; arity error
`(char-after (1- (or ,arg (point))))))
(put 'backward-char 'compiler-macro #'bytecomp--backward-char)
(defun bytecomp--backward-char (form &optional arg &rest junk-args)
(if junk-args
form ; arity error
`(forward-char (- (or ,arg 1)))))
(put 'backward-word 'compiler-macro #'bytecomp--backward-word)
(defun bytecomp--backward-word (form &optional arg &rest junk-args)
(if junk-args
form ; arity error
`(forward-word (- (or ,arg 1)))))
(provide 'byte-compile)
(provide 'bytecomp)