;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
-;;; Copyright (c) 1991, 1994, 2000, 2001 Free Software Foundation, Inc.
+;;; Copyright (c) 1991, 1994, 2000, 2001, 2002 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; You can, however, make a faster pig."
;;
;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
-;; makes it be a VW Bug with fuel injection and a turbocharger... You're
+;; makes it be a VW Bug with fuel injection and a turbocharger... You're
;; still not going to make it go faster than 70 mph, but it might be easier
;; to get it there.
;;
;; Simple defsubsts often produce forms like
;; (let ((v1 (f1)) (v2 (f2)) ...)
;; (FN v1 v2 ...))
-;; It would be nice if we could optimize this to
+;; It would be nice if we could optimize this to
;; (FN (f1) (f2) ...)
;; but we can't unless FN is dynamically-safe (it might be dynamically
;; referring to the bindings that the lambda arglist established.)
;; One of the uncountable lossages introduced by dynamic scope...
;;
-;; Maybe there should be a control-structure that says "turn on
+;; Maybe there should be a control-structure that says "turn on
;; fast-and-loose type-assumptive optimizations here." Then when
;; we see a form like (car foo) we can from then on assume that
;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic
+;; But, this won't win much because of (you guessed it) dynamic
;; scope. Anything down the stack could change the value.
;; (Another reason it doesn't work is that it is perfectly valid
;; to call car with a null argument.) A better approach might
;;
;; However, if there was even a single let-binding around the COND,
;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return." Adding a
+;; byte-op between the final "call" and "return." Adding a
;; Bunbind_all byteop would fix this.
;;
;; (defun foo (x y z) ... (foo a b c))
;;
;; Wouldn't it be nice if Emacs Lisp had lexical scope.
;;
-;; Idea: the form (lexical-scope) in a file means that the file may be
-;; compiled lexically. This proclamation is file-local. Then, within
+;; Idea: the form (lexical-scope) in a file means that the file may be
+;; compiled lexically. This proclamation is file-local. Then, within
;; that file, "let" would establish lexical bindings, and "let-dynamic"
;; would do things the old way. (Or we could use CL "declare" forms.)
;; We'd have to notice defvars and defconsts, since those variables should
;; in the file being compiled (doing a boundp check isn't good enough.)
;; Fdefvar() would have to be modified to add something to the plist.
;;
-;; A major disadvantage of this scheme is that the interpreter and compiler
-;; would have different semantics for files compiled with (dynamic-scope).
+;; A major disadvantage of this scheme is that the interpreter and compiler
+;; would have different semantics for files compiled with (dynamic-scope).
;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked
+;; modify the interpreter to obey this (unless the loader was hacked
;; in some grody way, but that's a really bad idea.)
;; Other things to consider:
;;;;; error free also they may act as true-constants.
;;;(disassemble (lambda (x) (and (point) (foo))))
-;;;;; When
+;;;;; When
;;;;; - all but one arguments to a function are constant
;;;;; - the non-constant argument is an if-expression (cond-expression?)
;;;;; then the outer function can be distributed. If the guarding
(defun byte-inline-lapcode (lap)
(setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
-
(defun byte-compile-inline-expand (form)
(let* ((name (car form))
(fn (or (cdr (assq name byte-compile-function-environment))
form))))))
;;; ((lambda ...) ...)
-;;;
+;;;
(defun byte-compile-unfold-lambda (form &optional name)
(or name (setq name "anonymous lambda"))
(let ((lambda (car form))
(byte-compile-warn
"attempt to open-code `%s' with too many arguments" name))
form)
-
+
;; The following leads to infinite recursion when loading a
;; file containing `(defsubst f () (f))', and then trying to
;; byte-compile that file.
;(setq body (mapcar 'byte-optimize-form body)))
-
- (let ((newform
+
+ (let ((newform
(if bindings
(cons 'let (cons (nreverse bindings) body))
(cons 'progn body))))
(cons (byte-optimize-form (nth 1 form) t)
(cons (byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (cdr (cdr (cdr form))) t)))))
-
+
((memq fn '(save-excursion save-restriction save-current-buffer))
;; those subrs which have an implicit progn; it's not quite good
;; enough to treat these like normal function calls.
;; This can turn (save-excursion ...) into (save-excursion) which
;; will be optimized away in the lap-optimize pass.
(cons fn (byte-optimize-body (cdr form) for-effect)))
-
+
((eq fn 'with-output-to-temp-buffer)
;; this is just like the above, except for the first argument.
(cons fn
(cons
(byte-optimize-form (nth 1 form) nil)
(byte-optimize-body (cdr (cdr form)) for-effect))))
-
+
((eq fn 'if)
(when (< (length form) 3)
(byte-compile-warn "too few arguments for `if'"))
(cons
(byte-optimize-form (nth 2 form) for-effect)
(byte-optimize-body (nthcdr 3 form) for-effect)))))
-
+
((memq fn '(and or)) ; remember, and/or are control structures.
;; take forms off the back until we can't any more.
;; In the future it could conceivably be a problem that the
(byte-compile-log
" all subforms of %s called for effect; deleted" form))
(and backwards
- (cons fn (nreverse backwards))))
+ (cons fn (nreverse (mapcar 'byte-optimize-form backwards)))))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
((eq fn 'interactive)
(byte-compile-warn "misplaced interactive spec: `%s'"
(prin1-to-string form))
nil)
-
+
((memq fn '(defun defmacro function
condition-case save-window-excursion))
;; These forms are compiled as constants or by breaking out
(cons fn
(cons (byte-optimize-form (nth 1 form) for-effect)
(cdr (cdr form)))))
-
+
((eq fn 'catch)
;; the body of a catch is compiled (and thus optimized) as a
;; top-level form, so don't do it here. The tag is never
(cons (byte-optimize-form (nth 1 form) nil)
(cdr (cdr form)))))
+ ((eq fn 'ignore)
+ ;; Don't treat the args to `ignore' as being
+ ;; computed for effect. We want to avoid the warnings
+ ;; that might occur if they were treated that way.
+ ;; However, don't actually bother calling `ignore'.
+ `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
+
;; If optimization is on, this is the only place that macros are
;; expanded. If optimization is off, then macroexpansion happens
;; in byte-compile-form. Otherwise, the macros are already expanded
(not (eq form
(setq form (compiler-macroexpand form)))))
(byte-optimize-form form for-effect))
-
+
((not (symbolp fn))
(byte-compile-warn "`%s' is a malformed function"
(prin1-to-string fn))
((and for-effect (setq tmp (get fn 'side-effect-free))
(or byte-compile-delete-errors
(eq tmp 'error-free)
+ ;; Detect the expansion of (pop foo).
+ ;; There is no need to compile the call to `car' there.
+ (and (eq fn 'car)
+ (eq (car-safe (cadr form)) 'prog1)
+ (let ((var (cadr (cadr form)))
+ (last (nth 2 (cadr form))))
+ (and (symbolp var)
+ (null (nthcdr 3 (cadr form)))
+ (eq (car-safe last) 'setq)
+ (eq (cadr last) var)
+ (eq (car-safe (nth 2 last)) 'cdr)
+ (eq (cadr (nth 2 last)) var))))
(progn
(byte-compile-warn "`%s' called for effect"
- (prin1-to-string form))
+ (prin1-to-string (car form)))
nil)))
(byte-compile-log " %s called for effect; deleted" fn)
;; appending a nil here might not be necessary, but it can't hurt.
(byte-optimize-form
(cons 'progn (append (cdr form) '(nil))) t))
-
+
(t
;; Otherwise, no args can be considered to be for-effect,
;; even if the called function is for-effect, because we
((keywordp ,form))))
;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time. This optimizer
+;; evaluate as much as possible at compile-time. This optimizer
;; assumes that the function is associative, like + or *.
(defun byte-optimize-associative-math (form)
(let ((args nil)
(cons (/ (nth 1 form) last)
(byte-compile-butlast (cdr (cdr form)))))
last nil))))
- (cond
+ (cond
;;; ((null (cdr (cdr form)))
;;; (nth 1 form))
((eq (nth 1 form) 0)
(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-;; I'm not convinced that this is necessary. Doesn't the optimizer loop
+;; I'm not convinced that this is necessary. Doesn't the optimizer loop
;; take care of this? - Jamie
;; I think this may some times be necessary to reduce ie (quote 5) to 5,
;; so arithmetic optimizers recognize the numeric constant. - Hallvard
(put 'nth 'byte-optimizer 'byte-optimize-nth)
(defun byte-optimize-nth (form)
- (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1)))
- (list 'car (if (zerop (nth 1 form))
- (nth 2 form)
- (list 'cdr (nth 2 form))))
- (byte-optimize-predicate form)))
+ (if (= (safe-length form) 3)
+ (if (memq (nth 1 form) '(0 1))
+ (list 'car (if (zerop (nth 1 form))
+ (nth 2 form)
+ (list 'cdr (nth 2 form))))
+ (byte-optimize-predicate form))
+ form))
(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
(defun byte-optimize-nthcdr (form)
- (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))
- (byte-optimize-predicate form)
- (let ((count (nth 1 form)))
- (setq form (nth 2 form))
- (while (>= (setq count (1- count)) 0)
- (setq form (list 'cdr form)))
- form)))
+ (if (= (safe-length form) 3)
+ (if (memq (nth 1 form) '(0 1 2))
+ (let ((count (nth 1 form)))
+ (setq form (nth 2 form))
+ (while (>= (setq count (1- count)) 0)
+ (setq form (list 'cdr form)))
+ form)
+ (byte-optimize-predicate form))
+ form))
(put 'concat 'byte-optimizer 'byte-optimize-concat)
(defun byte-optimize-concat (form)
form)))
;; Avoid having to write forward-... with a negative arg for speed.
+;; Fixme: don't be limited to constant args.
(put 'backward-char 'byte-optimizer 'byte-optimize-backward-char)
(defun byte-optimize-backward-char (form)
(cond ((and (= 2 (safe-length form))
((= 1 (safe-length form))
'(char-after (1- (point))))
(t form)))
+
+;; Fixme: delete-char -> delete-region (byte-coded)
+;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
+;; string-make-multibyte for constant args.
+
+(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
+(defun byte-optimize-featurep (form)
+ ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can
+ ;; safely optimize away this test.
+ (if (equal '((quote xemacs)) (cdr-safe form))
+ nil
+ form))
+
+(put 'set 'byte-optimizer 'byte-optimize-set)
+(defun byte-optimize-set (form)
+ (let ((var (car-safe (cdr-safe form))))
+ (cond
+ ((and (eq (car-safe var) 'quote) (consp (cdr var)))
+ `(setq ,(cadr var) ,@(cddr form)))
+ ((and (eq (car-safe var) 'make-local-variable)
+ (eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
+ (consp (cdr var)))
+ `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
+ (t form))))
\f
-;;; enumerating those functions which need not be called if the returned
+;;; enumerating those functions which need not be called if the returned
;;; value is not used. That is, something like
;;; (progn (list (something-with-side-effects) (yow))
;;; (foo))
;;; state, so that constant folding them would be wrong,
;;; but we don't do constant folding based on this list.
+;;; However, at present the only optimization we normally do
+;;; is delete calls that need not occur, and we only do that
+;;; with the error-free functions.
+
;;; I wonder if I missed any :-\)
(let ((side-effect-free-fns
'(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
length local-variable-if-set-p local-variable-p log log10 logand
logb logior lognot logxor lsh
make-list make-string make-symbol
- marker-buffer max member memq min mod
+ marker-buffer max member memq min mod multibyte-char-to-unibyte
next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
prefix-numeric-value previous-window prin1-to-string propertize
region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp string-to-char
string-to-int string-to-number substring sxhash symbol-function
- symbol-name symbol-plist symbol-value
+ symbol-name symbol-plist symbol-value string-make-unibyte
+ string-make-multibyte string-as-multibyte string-as-unibyte
tan truncate
unibyte-char-to-multibyte upcase user-full-name
user-login-name user-original-login-name user-variable-p
zerop))
(side-effect-and-error-free-fns
'(arrayp atom
- bobp bolp bool-vector-p
+ bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
current-buffer current-global-map current-indentation
byte-current-buffer byte-interactive-p))
(defconst byte-compile-side-effect-free-ops
- (nconc
+ (nconc
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
;;; varbind pop-up-windows
;;; not
;;;
-;;; we break the program, because it will appear that pop-up-windows and
+;;; we break the program, because it will appear that pop-up-windows and
;;; old-pop-ups are not EQ when really they are. So we have to know what
;;; the BOOL variables are, and not perform this optimization on them.
;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
;;
;; it is wrong to do the same thing for the -else-pop variants.
- ;;
+ ;;
((and (or (eq 'byte-goto-if-nil (car lap0))
(eq 'byte-goto-if-not-nil (car lap0))) ; gotoX
(eq 'byte-goto (car lap1)) ; gotoY
str (concat str " %s")
i (1+ i))))
(if opt-p
- (let ((tagstr
+ (let ((tagstr
(if (eq 'TAG (car (car tmp)))
(format "%d:" (car (cdr (car tmp))))
(or (car tmp) ""))))
(byte-goto-if-not-nil-else-pop .
byte-goto-if-nil-else-pop))))
newtag)
-
+
(nth 1 newtag)
)
(setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
byte-optimize-lapcode))))
nil)
+;;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1
;;; byte-opt.el ends here