Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 251:677f6a0ee643 r20-5b24

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b24
author cvs
date Mon, 13 Aug 2007 10:19:59 +0200
parents 51092a27c943
children 6330739388db
comparison
equal deleted inserted replaced
250:f385a461c9aa 251:677f6a0ee643
25 25
26 ;;; Synched up with: FSF 19.30. 26 ;;; Synched up with: FSF 19.30.
27 27
28 ;;; Commentary: 28 ;;; Commentary:
29 29
30 ;;; ======================================================================== 30 ;; ========================================================================
31 ;;; "No matter how hard you try, you can't make a racehorse out of a pig. 31 ;; "No matter how hard you try, you can't make a racehorse out of a pig.
32 ;;; You can, however, make a faster pig." 32 ;; You can, however, make a faster pig."
33 ;;; 33 ;;
34 ;;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code 34 ;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
35 ;;; makes it be a VW Bug with fuel injection and a turbocharger... You're 35 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're
36 ;;; still not going to make it go faster than 70 mph, but it might be easier 36 ;; still not going to make it go faster than 70 mph, but it might be easier
37 ;;; to get it there. 37 ;; to get it there.
38 ;;; 38 ;;
39 39
40 ;;; TO DO: 40 ;; TO DO:
41 ;;; 41 ;;
42 ;;; (apply '(lambda (x &rest y) ...) 1 (foo)) 42 ;; (apply '(lambda (x &rest y) ...) 1 (foo))
43 ;;; 43 ;;
44 ;;; maintain a list of functions known not to access any global variables 44 ;; maintain a list of functions known not to access any global variables
45 ;;; (actually, give them a 'dynamically-safe property) and then 45 ;; (actually, give them a 'dynamically-safe property) and then
46 ;;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==> 46 ;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==>
47 ;;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> ) 47 ;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
48 ;;; by recursing on this, we might be able to eliminate the entire let. 48 ;; by recursing on this, we might be able to eliminate the entire let.
49 ;;; However certain variables should never have their bindings optimized 49 ;; However certain variables should never have their bindings optimized
50 ;;; away, because they affect everything. 50 ;; away, because they affect everything.
51 ;;; (put 'debug-on-error 'binding-is-magic t) 51 ;; (put 'debug-on-error 'binding-is-magic t)
52 ;;; (put 'debug-on-abort 'binding-is-magic t) 52 ;; (put 'debug-on-abort 'binding-is-magic t)
53 ;;; (put 'debug-on-next-call 'binding-is-magic t) 53 ;; (put 'debug-on-next-call 'binding-is-magic t)
54 ;;; (put 'mocklisp-arguments 'binding-is-magic t) 54 ;; (put 'mocklisp-arguments 'binding-is-magic t)
55 ;;; (put 'inhibit-quit 'binding-is-magic t) 55 ;; (put 'inhibit-quit 'binding-is-magic t)
56 ;;; (put 'quit-flag 'binding-is-magic t) 56 ;; (put 'quit-flag 'binding-is-magic t)
57 ;;; (put 't 'binding-is-magic t) 57 ;; (put 't 'binding-is-magic t)
58 ;;; (put 'nil 'binding-is-magic t) 58 ;; (put 'nil 'binding-is-magic t)
59 ;;; possibly also 59 ;; possibly also
60 ;;; (put 'gc-cons-threshold 'binding-is-magic t) 60 ;; (put 'gc-cons-threshold 'binding-is-magic t)
61 ;;; (put 'track-mouse 'binding-is-magic t) 61 ;; (put 'track-mouse 'binding-is-magic t)
62 ;;; others? 62 ;; others?
63 ;;; 63 ;;
64 ;;; Simple defsubsts often produce forms like 64 ;; Simple defsubsts often produce forms like
65 ;;; (let ((v1 (f1)) (v2 (f2)) ...) 65 ;; (let ((v1 (f1)) (v2 (f2)) ...)
66 ;;; (FN v1 v2 ...)) 66 ;; (FN v1 v2 ...))
67 ;;; It would be nice if we could optimize this to 67 ;; It would be nice if we could optimize this to
68 ;;; (FN (f1) (f2) ...) 68 ;; (FN (f1) (f2) ...)
69 ;;; but we can't unless FN is dynamically-safe (it might be dynamically 69 ;; but we can't unless FN is dynamically-safe (it might be dynamically
70 ;;; referring to the bindings that the lambda arglist established.) 70 ;; referring to the bindings that the lambda arglist established.)
71 ;;; One of the uncountable lossages introduced by dynamic scope... 71 ;; One of the uncountable lossages introduced by dynamic scope...
72 ;;; 72 ;;
73 ;;; Maybe there should be a control-structure that says "turn on 73 ;; Maybe there should be a control-structure that says "turn on
74 ;;; fast-and-loose type-assumptive optimizations here." Then when 74 ;; fast-and-loose type-assumptive optimizations here." Then when
75 ;;; we see a form like (car foo) we can from then on assume that 75 ;; we see a form like (car foo) we can from then on assume that
76 ;;; the variable foo is of type cons, and optimize based on that. 76 ;; the variable foo is of type cons, and optimize based on that.
77 ;;; But, this won't win much because of (you guessed it) dynamic 77 ;; But, this won't win much because of (you guessed it) dynamic
78 ;;; scope. Anything down the stack could change the value. 78 ;; scope. Anything down the stack could change the value.
79 ;;; (Another reason it doesn't work is that it is perfectly valid 79 ;; (Another reason it doesn't work is that it is perfectly valid
80 ;;; to call car with a null argument.) A better approach might 80 ;; to call car with a null argument.) A better approach might
81 ;;; be to allow type-specification of the form 81 ;; be to allow type-specification of the form
82 ;;; (put 'foo 'arg-types '(float (list integer) dynamic)) 82 ;; (put 'foo 'arg-types '(float (list integer) dynamic))
83 ;;; (put 'foo 'result-type 'bool) 83 ;; (put 'foo 'result-type 'bool)
84 ;;; It should be possible to have these types checked to a certain 84 ;; It should be possible to have these types checked to a certain
85 ;;; degree. 85 ;; degree.
86 ;;; 86 ;;
87 ;;; collapse common subexpressions 87 ;; collapse common subexpressions
88 ;;; 88 ;;
89 ;;; It would be nice if redundant sequences could be factored out as well, 89 ;; It would be nice if redundant sequences could be factored out as well,
90 ;;; when they are known to have no side-effects: 90 ;; when they are known to have no side-effects:
91 ;;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2 91 ;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2
92 ;;; but beware of traps like 92 ;; but beware of traps like
93 ;;; (cons (list x y) (list x y)) 93 ;; (cons (list x y) (list x y))
94 ;;; 94 ;;
95 ;;; Tail-recursion elimination is not really possible in Emacs Lisp. 95 ;; Tail-recursion elimination is not really possible in Emacs Lisp.
96 ;;; Tail-recursion elimination is almost always impossible when all variables 96 ;; Tail-recursion elimination is almost always impossible when all variables
97 ;;; have dynamic scope, but given that the "return" byteop requires the 97 ;; have dynamic scope, but given that the "return" byteop requires the
98 ;;; binding stack to be empty (rather than emptying it itself), there can be 98 ;; binding stack to be empty (rather than emptying it itself), there can be
99 ;;; no truly tail-recursive Emacs Lisp functions that take any arguments or 99 ;; no truly tail-recursive Emacs Lisp functions that take any arguments or
100 ;;; make any bindings. 100 ;; make any bindings.
101 ;;; 101 ;;
102 ;;; Here is an example of an Emacs Lisp function which could safely be 102 ;; Here is an example of an Emacs Lisp function which could safely be
103 ;;; byte-compiled tail-recursively: 103 ;; byte-compiled tail-recursively:
104 ;;; 104 ;;
105 ;;; (defun tail-map (fn list) 105 ;; (defun tail-map (fn list)
106 ;;; (cond (list 106 ;; (cond (list
107 ;;; (funcall fn (car list)) 107 ;; (funcall fn (car list))
108 ;;; (tail-map fn (cdr list))))) 108 ;; (tail-map fn (cdr list)))))
109 ;;; 109 ;;
110 ;;; However, if there was even a single let-binding around the COND, 110 ;; However, if there was even a single let-binding around the COND,
111 ;;; it could not be byte-compiled, because there would be an "unbind" 111 ;; it could not be byte-compiled, because there would be an "unbind"
112 ;;; byte-op between the final "call" and "return." Adding a 112 ;; byte-op between the final "call" and "return." Adding a
113 ;;; Bunbind_all byteop would fix this. 113 ;; Bunbind_all byteop would fix this.
114 ;;; 114 ;;
115 ;;; (defun foo (x y z) ... (foo a b c)) 115 ;; (defun foo (x y z) ... (foo a b c))
116 ;;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return) 116 ;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
117 ;;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return) 117 ;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
118 ;;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return) 118 ;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
119 ;;; 119 ;;
120 ;;; this also can be considered tail recursion: 120 ;; this also can be considered tail recursion:
121 ;;; 121 ;;
122 ;;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return) 122 ;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
123 ;;; could generalize this by doing the optimization 123 ;; could generalize this by doing the optimization
124 ;;; (goto X) ... X: (return) --> (return) 124 ;; (goto X) ... X: (return) --> (return)
125 ;;; 125 ;;
126 ;;; But this doesn't solve all of the problems: although by doing tail- 126 ;; But this doesn't solve all of the problems: although by doing tail-
127 ;;; recursion elimination in this way, the call-stack does not grow, the 127 ;; recursion elimination in this way, the call-stack does not grow, the
128 ;;; binding-stack would grow with each recursive step, and would eventually 128 ;; binding-stack would grow with each recursive step, and would eventually
129 ;;; overflow. I don't believe there is any way around this without lexical 129 ;; overflow. I don't believe there is any way around this without lexical
130 ;;; scope. 130 ;; scope.
131 ;;; 131 ;;
132 ;;; Wouldn't it be nice if Emacs Lisp had lexical scope. 132 ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
133 ;;; 133 ;;
134 ;;; Idea: the form (lexical-scope) in a file means that the file may be 134 ;; Idea: the form (lexical-scope) in a file means that the file may be
135 ;;; compiled lexically. This proclamation is file-local. Then, within 135 ;; compiled lexically. This proclamation is file-local. Then, within
136 ;;; that file, "let" would establish lexical bindings, and "let-dynamic" 136 ;; that file, "let" would establish lexical bindings, and "let-dynamic"
137 ;;; would do things the old way. (Or we could use CL "declare" forms.) 137 ;; would do things the old way. (Or we could use CL "declare" forms.)
138 ;;; We'd have to notice defvars and defconsts, since those variables should 138 ;; We'd have to notice defvars and defconsts, since those variables should
139 ;;; always be dynamic, and attempting to do a lexical binding of them 139 ;; always be dynamic, and attempting to do a lexical binding of them
140 ;;; should simply do a dynamic binding instead. 140 ;; should simply do a dynamic binding instead.
141 ;;; But! We need to know about variables that were not necessarily defvarred 141 ;; But! We need to know about variables that were not necessarily defvarred
142 ;;; in the file being compiled (doing a boundp check isn't good enough.) 142 ;; in the file being compiled (doing a boundp check isn't good enough.)
143 ;;; Fdefvar() would have to be modified to add something to the plist. 143 ;; Fdefvar() would have to be modified to add something to the plist.
144 ;;; 144 ;;
145 ;;; A major disadvantage of this scheme is that the interpreter and compiler 145 ;; A major disadvantage of this scheme is that the interpreter and compiler
146 ;;; would have different semantics for files compiled with (dynamic-scope). 146 ;; would have different semantics for files compiled with (dynamic-scope).
147 ;;; Since this would be a file-local optimization, there would be no way to 147 ;; Since this would be a file-local optimization, there would be no way to
148 ;;; modify the interpreter to obey this (unless the loader was hacked 148 ;; modify the interpreter to obey this (unless the loader was hacked
149 ;;; in some grody way, but that's a really bad idea.) 149 ;; in some grody way, but that's a really bad idea.)
150 ;;; 150 ;;
151 ;;; HA! HA! HA! RMS removed the following paragraph from his version of 151 ;; Opinions are mixed on the following paragraph. -slb.
152 ;;; byte-opt.el, proving once again his stubborn refusal to accept any 152 ;;
153 ;;; developments in computer science that occurred after the late 1970's. 153 ;; Really the Right Thing is to make lexical scope the default across
154 ;;; 154 ;; the board, in the interpreter and compiler, and just FIX all of
155 ;;; Really the Right Thing is to make lexical scope the default across 155 ;; the code that relies on dynamic scope of non-defvarred variables.
156 ;;; the board, in the interpreter and compiler, and just FIX all of
157 ;;; the code that relies on dynamic scope of non-defvarred variables.
158 156
159 ;; Other things to consider: 157 ;; Other things to consider:
160 158
161 ;;;;; Associative math should recognize subcalls to identical function: 159 ;; Associative math should recognize subcalls to identical function:
162 ;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) 160 ;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
163 ;;;;; This should generate the same as (1+ x) and (1- x) 161 ;; This should generate the same as (1+ x) and (1- x)
164 162
165 ;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1)))) 163 ;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
166 ;;;;; An awful lot of functions always return a non-nil value. If they're 164 ;; An awful lot of functions always return a non-nil value. If they're
167 ;;;;; error free also they may act as true-constants. 165 ;; error free also they may act as true-constants.
168 166
169 ;;;(disassemble (lambda (x) (and (point) (foo)))) 167 ;;(disassemble (lambda (x) (and (point) (foo))))
170 ;;;;; When 168 ;; When
171 ;;;;; - all but one arguments to a function are constant 169 ;; - all but one arguments to a function are constant
172 ;;;;; - the non-constant argument is an if-expression (cond-expression?) 170 ;; - the non-constant argument is an if-expression (cond-expression?)
173 ;;;;; then the outer function can be distributed. If the guarding 171 ;; then the outer function can be distributed. If the guarding
174 ;;;;; condition is side-effect-free [assignment-free] then the other 172 ;; condition is side-effect-free [assignment-free] then the other
175 ;;;;; arguments may be any expressions. Since, however, the code size 173 ;; arguments may be any expressions. Since, however, the code size
176 ;;;;; can increase this way they should be "simple". Compare: 174 ;; can increase this way they should be "simple". Compare:
177 175
178 ;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c))) 176 ;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
179 ;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) 177 ;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
180 178
181 ;;;;; (car (cons A B)) -> (progn B A) 179 ;; (car (cons A B)) -> (progn B A)
182 ;;;(disassemble (lambda (x) (car (cons (foo) 42)))) 180 ;;(disassemble (lambda (x) (car (cons (foo) 42))))
183 181
184 ;;;;; (cdr (cons A B)) -> (progn A B) 182 ;; (cdr (cons A B)) -> (progn A B)
185 ;;;(disassemble (lambda (x) (cdr (cons 42 (foo))))) 183 ;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
186 184
187 ;;;;; (car (list A B ...)) -> (progn B ... A) 185 ;; (car (list A B ...)) -> (progn B ... A)
188 ;;;(disassemble (lambda (x) (car (list (foo) 42 (bar))))) 186 ;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
189 187
190 ;;;;; (cdr (list A B ...)) -> (progn A (list B ...)) 188 ;; (cdr (list A B ...)) -> (progn A (list B ...))
191 ;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar))))) 189 ;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
192 190
193 191
194 ;;; Code: 192 ;;; Code:
195 193
196 (require 'byte-compile "bytecomp") 194 (require 'byte-compile "bytecomp")