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.

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 489a9724fc465433e0dd00b73ff01ade76f1732e..5b1d958e6c2d8c56f82e34e8749e62ade76def9a 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4306,9 +4306,6 @@ This function is never called when `lexical-binding' is nil."
 \f
 ;; 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)