byte-code optimizations

[Paul Pogonyshev <pogonyshev@gmx.net>]

Hi.

Are you interested in byte-code optimizations?  I think I found
a rather good one, specifically targeted at `c[ad][ad]r' substs.
It can be generalized further, though.

Consider this hypothetical function:

	(lambda (x)
	  (cons (caar x) (cddr x)))

With current Emacs byte-compiler we get

	M-: (disassemble (lambda (x) (cons (caar x) (cddr x))))

byte code:
  args: (x)
0	varref	  x
1	dup	  
2	varbind	  x
3	car	  
4	car	  
5	unbind	  1
6	varref	  x
7	dup	  
8	varbind	  x
9	cdr	  
10	cdr	  
11	unbind	  1
12	cons	  
13	return	  

With the patch (see the very end of this message), this, however,
reduces simply to

byte code:
  args: (x)
0	varref	  x
1	car	  
2	car	  
3	varref	  x
4	cdr	  
5	cdr	  
6	cons	  
7	return	  

In other words, it squeezes the unnecessary binding out of each
`c[ad][ad]r'.  Three commands per each substitution.  This is a
lightweight (and special-cases-only) implementation of a TODO
item in `byte-opt.el'.

If you are interested, I can polish the patch and generalize it
a bit.

Currently, there is one unresolved problem with the patch.  In
`byte-opt.el' top comment it is mentioned that ``However certain
variables should never have their bindings optimized away,
because they affect everything.'' (i.e. `debug-on-error').

I doubt this is particularly important for bindings followed
by car/cdr sequences, but it is certainly better not to left
open pits.

There is also an obvious way to improve: in addition to
`byte-c[ad]r' certain other byte commands can be allowed in
sequences, i.e. `byte-not'.

Comments and suggestions are welcome.

Paul



--- byte-opt.el	22 Mar 2004 13:21:08 -0200	1.75
+++ byte-opt.el	18 Sep 2004 11:04:59 -0200	
@@ -1993,6 +1993,22 @@ If FOR-EFFECT is non-nil, the return val
 		 (byte-compile-log-lap
 		  "  %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0)))
 	    ;;
+	    ;; dup varbind-X [car/cdr ...] unbind-1 --> [car/cdr ...]
+	    ;;
+	    ((and (eq 'byte-dup     (car lap0))
+		  (eq 'byte-varbind (car lap1)))
+	     (setq tmp (cdr rest))
+	     (while (memq (caar (setq tmp (cdr tmp))) '(byte-car byte-cdr)))
+	     (when (and (eq 'byte-unbind (caar tmp)) (= 1 (cdar tmp)))
+	       ;; Throw away  dup varbind-X
+	       (setcar rest (nth 2 rest))
+	       (setcdr rest (nthcdr 3 rest))
+	       ;; Throw away unbind-1
+	       (setcar tmp (nth 1 tmp))
+	       (setcdr tmp (nthcdr 2 tmp))
+	       (byte-compile-log-lap
+		"  dup %s [car/cdr ...] unbind-1\t-->\t[car/cdr...]" lap1)))
+	    ;;
 	    ;; unbind-N unbind-M  -->  unbind-(N+M)
 	    ;;
 	    ((and (eq 'byte-unbind (car lap0))