diff options
Diffstat (limited to 'lisp/emacs-lisp/byte-opt.el')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 95 |
1 files changed, 59 insertions, 36 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d4c21e5ddb8..f49aff90a20 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -31,7 +31,7 @@ ;; "No matter how hard you try, you can't make a racehorse out of a pig. ;; You can, however, make a faster pig." ;; -;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code +;; 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 ;; still not going to make it go faster than 70 mph, but it might be easier ;; to get it there. @@ -185,6 +185,7 @@ ;;; Code: (require 'bytecomp) +(eval-when-compile (require 'cl)) (defun byte-compile-log-lap-1 (format &rest args) (if (aref byte-code-vector 0) @@ -627,13 +628,24 @@ ;; ;; It is now safe to optimize code such that it introduces new bindings. -;; I'd like this to be a defsubst, but let's not be self-referential... -(defmacro byte-compile-trueconstp (form) - ;; Returns non-nil if FORM is a non-nil constant. - `(cond ((consp ,form) (eq (car ,form) 'quote)) - ((not (symbolp ,form))) - ((eq ,form t)) - ((keywordp ,form)))) +(defsubst byte-compile-trueconstp (form) + "Return non-nil if FORM always evaluates to a non-nil value." + (cond ((consp form) + (case (car form) + (quote (cadr form)) + (progn (byte-compile-trueconstp (car (last (cdr form))))))) + ((not (symbolp form))) + ((eq form t)) + ((keywordp form)))) + +(defsubst byte-compile-nilconstp (form) + "Return non-nil if FORM always evaluates to a nil value." + (cond ((consp form) + (case (car form) + (quote (null (cadr form))) + (progn (byte-compile-nilconstp (car (last (cdr form))))))) + ((not (symbolp form)) nil) + ((null form)))) ;; If the function is being called with constant numeric args, ;; evaluate as much as possible at compile-time. This optimizer @@ -992,17 +1004,17 @@ (setq rest form) (while (setq rest (cdr rest)) (cond ((byte-compile-trueconstp (car-safe (car rest))) - (cond ((eq rest (cdr form)) - (setq form - (if (cdr (car rest)) - (if (cdr (cdr (car rest))) - (cons 'progn (cdr (car rest))) - (nth 1 (car rest))) - (car (car rest))))) + ;; This branch will always be taken: kill the subsequent ones. + (cond ((eq rest (cdr form)) ;First branch of `cond'. + (setq form `(progn ,@(car rest)))) ((cdr rest) (setq form (copy-sequence form)) (setcdr (memq (car rest) form) nil))) - (setq rest nil))))) + (setq rest nil)) + ((and (consp (car rest)) + (byte-compile-nilconstp (caar rest))) + ;; This branch will never be taken: kill its body. + (setcdr (car rest) nil))))) ;; ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... )) (if (eq 'cond (car-safe form)) @@ -1016,17 +1028,26 @@ form)) (defun byte-optimize-if (form) + ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>)) ;; (if <true-constant> <then> <else...>) ==> <then> ;; (if <false-constant> <then> <else...>) ==> (progn <else...>) ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>)) ;; (if <test> <then> nil) ==> (if <test> <then>) (let ((clause (nth 1 form))) - (cond ((byte-compile-trueconstp clause) - (nth 2 form)) - ((null clause) - (if (nthcdr 4 form) - (cons 'progn (nthcdr 3 form)) - (nth 3 form))) + (cond ((and (eq (car-safe clause) 'progn) + ;; `clause' is a proper list. + (null (cdr (last clause)))) + (if (null (cddr clause)) + ;; A trivial `progn'. + (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) + (nconc (butlast clause) + (list + (byte-optimize-if + `(if ,(car (last clause)) ,@(nthcdr 2 form))))))) + ((byte-compile-trueconstp clause) + `(progn ,clause ,(nth 2 form))) + ((byte-compile-nilconstp clause) + `(progn ,clause ,@(nthcdr 3 form))) ((nth 2 form) (if (equal '(nil) (nthcdr 3 form)) (list 'if clause (nth 2 form)) @@ -1139,9 +1160,11 @@ (defun byte-optimize-featurep (form) ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we ;; can safely optimize away this test. - (if (member (cdr-safe form) '((quote xemacs) (quote sxemacs))) + (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs)))) nil - form)) + (if (member (cdr-safe form) '(((quote emacs)))) + t + form))) (put 'set 'byte-optimizer 'byte-optimize-set) (defun byte-optimize-set (form) @@ -1328,7 +1351,7 @@ ;; This list contains numbers, which are pc values, ;; before each instruction. (defun byte-decompile-bytecode (bytes constvec) - "Turns BYTECODE into lapcode, referring to CONSTVEC." + "Turn BYTECODE into lapcode, referring to CONSTVEC." (let ((byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0)) @@ -1998,17 +2021,17 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (assq 'byte-code (symbol-function 'byte-optimize-form)) (let ((byte-optimize nil) (byte-compile-warnings nil)) - (mapcar (lambda (x) - (or noninteractive (message "compiling %s..." x)) - (byte-compile x) - (or noninteractive (message "compiling %s...done" x))) - '(byte-optimize-form - byte-optimize-body - byte-optimize-predicate - byte-optimize-binary-predicate - ;; Inserted some more than necessary, to speed it up. - byte-optimize-form-code-walker - byte-optimize-lapcode)))) + (mapc (lambda (x) + (or noninteractive (message "compiling %s..." x)) + (byte-compile x) + (or noninteractive (message "compiling %s...done" x))) + '(byte-optimize-form + byte-optimize-body + byte-optimize-predicate + byte-optimize-binary-predicate + ;; Inserted some more than necessary, to speed it up. + byte-optimize-form-code-walker + byte-optimize-lapcode)))) nil) ;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1 |