Small LAP peephole optimization

[Dmitry Antipov]

Hello again,

this is a minor LAP peephole optimization intended to remove redundant
'(byte-constant 0) (byte-plus . 0)' byte code insns. As an obvious
example, for

(disassemble (byte-compile '(lambda (x y) (+ x (* 2 y)))))

it will produce

0       varref    x
1       varref    y
2       dup
3       plus
4       plus
5       return

instead of current

0       varref    x
1       varref    y
2       dup
3       plus
4       constant  0
5       plus
6       plus
7       return

During full bootstrap, this small optimization is performed for more
than 100 LAPs, thus removing ~400 byte code insns. It was also tested by
byte-force-recompile of all lisp, and hopefully it works.

There are also a few cosmetic cleanups.

Dmitry

Index: lisp/emacs-lisp/byte-opt.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/emacs-lisp/byte-opt.el,v
retrieving revision 1.94
diff -u -r1.94 byte-opt.el
--- lisp/emacs-lisp/byte-opt.el 11 Apr 2007 17:10:42 -0000      1.94
+++ lisp/emacs-lisp/byte-opt.el 9 May 2007 06:43:58 -0000
@@ -1526,6 +1526,21 @@
                      (setcdr lap0 0))
                     ((error "Optimizer error: too much on the stack"))))
              ;;
+             ;; constant 0 plus --> <deleted>
+             ;;
+             ((and (eq (car lap0) 'byte-constant)
+                   (numberp (cadr lap0))
+                   (zerop (cadr lap0))
+                   (eq (car lap1) 'byte-plus))
+              (let ((tmp lap) (head nil))
+                (while (not (eq lap0 (car tmp)))
+                  (setq head (append head (list (car tmp)))
+                        tmp (cdr tmp)))
+                (byte-compile-log-lap "  %s %s\t-->\t<deleted>" lap0 lap1)
+                (setq rest (cddr rest)
+                      lap (nconc head rest)
+                      keep-going t)))
+             ;;
              ;; goto*-X X:  -->  X:
              ;;
              ((and (memq (car lap0) byte-goto-ops)
@@ -1537,10 +1552,9 @@
                      (setcar lap0 (setq tmp 'byte-discard))
                      (setcdr lap0 0))
                     ((error "Depth conflict at tag %d" (nth 2 lap0))))
-              (and (memq byte-optimize-log '(t byte))
-                   (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
-                                     (nth 1 lap1) (nth 1 lap1)
-                                     tmp (nth 1 lap1)))
+              (byte-compile-log-lap "  (goto %s) %s:\t-->\t%s %s:"
+                                    (nth 1 lap1) (nth 1 lap1)
+                                    tmp (nth 1 lap1))
               (setq keep-going t))
              ;;
              ;; varset-X varref-X  -->  dup varset-X
@@ -1672,8 +1686,8 @@
                     (while (not (eq tmp tmp2))
                       (setq tmp2 (cdr tmp2)
                             str (concat str " dup")))
-                    (byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
-                                          lap0 str lap0 lap0 str)))
+                    (byte-compile-log-lap-1 "  %s%s %s\t-->\t%s%s dup"
+                                            lap0 str lap0 lap0 str)))
               (setq keep-going t)
               (setcar (car tmp) 'byte-dup)
               (setcdr (car tmp) 0)
@@ -1684,9 +1698,8 @@
              ;;
              ((and (eq (car lap0) 'TAG)
                    (eq (car lap1) 'TAG))
-              (and (memq byte-optimize-log '(t byte))
-                   (byte-compile-log "  adjacent tags %d and %d merged"
-                                     (nth 1 lap1) (nth 1 lap0)))
+              (byte-compile-log-lap "  adjacent tags %d and %d merged"
+                                    (nth 1 lap1) (nth 1 lap0))
               (setq tmp3 lap)
               (while (setq tmp2 (rassq lap0 tmp3))
                 (setcdr tmp2 lap1)
@@ -1698,8 +1711,7 @@
              ;;
              ((and (eq 'TAG (car lap0))
                    (not (rassq lap0 lap)))
-              (and (memq byte-optimize-log '(t byte))
-                   (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
+              (byte-compile-log-lap "  unused tag %d removed" (nth 1 lap0))
               (setq lap (delq lap0 lap)
                     keep-going t))
              ;;