]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/byte-opt.el
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
[gnu-emacs] / lisp / emacs-lisp / byte-opt.el
index 7bfa75dbaaf6e2481f97d97f76f0685e50ab1383..7d47d809673684a6fb82f8bff7c0773e94fbd598 100644 (file)
@@ -1,9 +1,11 @@
-;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
+;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
 
 
-;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;     Hallvard Furuseth <hbf@ulrik.uio.no>
+;; Maintainer: FSF
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: internal
 
 ;; This file is part of GNU Emacs.
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
-;;; ========================================================================
-;;; "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
-;;; 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.
-;;;
-
-;;; TO DO:
-;;;
-;;; (apply '(lambda (x &rest y) ...) 1 (foo))
-;;;
-;;; collapse common subexpressions
-;;;
-;;; maintain a list of functions known not to access any global variables
-;;; (actually, give them a 'dynamically-safe property) and then
-;;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
-;;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
-;;; by recursing on this, we might be able to eliminate the entire let.
-;;; However certain variables should never have their bindings optimized
-;;; away, because they affect everything.
-;;;   (put 'debug-on-error 'binding-is-magic t)
-;;;   (put 'debug-on-abort 'binding-is-magic t)
-;;;   (put 'inhibit-quit 'binding-is-magic t)
-;;;   (put 'quit-flag 'binding-is-magic t)
-;;; others?
-;;;
-;;; Simple defsubsts often produce forms like
-;;;    (let ((v1 (f1)) (v2 (f2)) ...)
-;;;       (FN v1 v2 ...))
-;;; 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 
-;;; 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 
-;;; scope.  Anything down the stack could change the value.
-;;;
-;;; It would be nice if redundant sequences could be factored out as well,
-;;; when they are known to have no side-effects:
-;;;   (list (+ a b c) (+ a b c))   -->  a b add c add dup list-2
-;;; but beware of traps like
-;;;   (cons (list x y) (list x y))
-;;;
-;;; Tail-recursion elimination is not really possible in Emacs Lisp.
-;;; Tail-recursion elimination is almost always impossible when all variables
-;;; have dynamic scope, but given that the "return" byteop requires the
-;;; binding stack to be empty (rather than emptying it itself), there can be
-;;; no truly tail-recursive Emacs Lisp functions that take any arguments or
-;;; make any bindings.
-;;;
-;;; Here is an example of an Emacs Lisp function which could safely be
-;;; byte-compiled tail-recursively:
-;;;
-;;;  (defun tail-map (fn list)
-;;;    (cond (list
-;;;           (funcall fn (car list))
-;;;           (tail-map fn (cdr list)))))
-;;;
-;;; 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 
-;;; Bunbind_all byteop would fix this.
-;;;
-;;;   (defun foo (x y z) ... (foo a b c))
-;;;   ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
-;;;   ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
-;;;   ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
-;;;
-;;; this also can be considered tail recursion:
-;;;
-;;;   ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
-;;; could generalize this by doing the optimization
-;;;   (goto X) ... X: (return)  -->  (return)
-;;;
-;;; But this doesn't solve all of the problems: although by doing tail-
-;;; recursion elimination in this way, the call-stack does not grow, the
-;;; binding-stack would grow with each recursive step, and would eventually
-;;; overflow.  I don't believe there is any way around this without lexical
-;;; scope.
-;;;
-;;; 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 
-;;; 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
-;;; always be dynamic, and attempting to do a lexical binding of them
-;;; should simply do a dynamic binding instead.
-;;; But!  We need to know about variables that were not necessarily defvarred
-;;; 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).  
-;;; 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 
-;;; in some grody way, but that's a really bad idea.)
-;;;
-;;; Really the Right Thing is to make lexical scope the default across
-;;; the board, in the interpreter and compiler, and just FIX all of 
-;;; the code that relies on dynamic scope of non-defvarred variables.
+;; ========================================================================
+;; "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
+;; 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.
+;;
+
+;; TO DO:
+;;
+;; (apply (lambda (x &rest y) ...) 1 (foo))
+;;
+;; maintain a list of functions known not to access any global variables
+;; (actually, give them a 'dynamically-safe property) and then
+;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
+;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
+;; by recursing on this, we might be able to eliminate the entire let.
+;; However certain variables should never have their bindings optimized
+;; away, because they affect everything.
+;;   (put 'debug-on-error 'binding-is-magic t)
+;;   (put 'debug-on-abort 'binding-is-magic t)
+;;   (put 'debug-on-next-call 'binding-is-magic t)
+;;   (put 'inhibit-quit 'binding-is-magic t)
+;;   (put 'quit-flag 'binding-is-magic t)
+;;   (put 't 'binding-is-magic t)
+;;   (put 'nil 'binding-is-magic t)
+;; possibly also
+;;   (put 'gc-cons-threshold 'binding-is-magic t)
+;;   (put 'track-mouse 'binding-is-magic t)
+;; others?
+;;
+;; Simple defsubsts often produce forms like
+;;    (let ((v1 (f1)) (v2 (f2)) ...)
+;;       (FN v1 v2 ...))
+;; 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
+;; 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
+;; 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
+;; be to allow type-specification of the form
+;;   (put 'foo 'arg-types '(float (list integer) dynamic))
+;;   (put 'foo 'result-type 'bool)
+;; It should be possible to have these types checked to a certain
+;; degree.
+;;
+;; collapse common subexpressions
+;;
+;; It would be nice if redundant sequences could be factored out as well,
+;; when they are known to have no side-effects:
+;;   (list (+ a b c) (+ a b c))   -->  a b add c add dup list-2
+;; but beware of traps like
+;;   (cons (list x y) (list x y))
+;;
+;; Tail-recursion elimination is not really possible in Emacs Lisp.
+;; Tail-recursion elimination is almost always impossible when all variables
+;; have dynamic scope, but given that the "return" byteop requires the
+;; binding stack to be empty (rather than emptying it itself), there can be
+;; no truly tail-recursive Emacs Lisp functions that take any arguments or
+;; make any bindings.
+;;
+;; Here is an example of an Emacs Lisp function which could safely be
+;; byte-compiled tail-recursively:
+;;
+;;  (defun tail-map (fn list)
+;;    (cond (list
+;;           (funcall fn (car list))
+;;           (tail-map fn (cdr list)))))
+;;
+;; 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
+;; Bunbind_all byteop would fix this.
+;;
+;;   (defun foo (x y z) ... (foo a b c))
+;;   ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
+;;   ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
+;;   ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
+;;
+;; this also can be considered tail recursion:
+;;
+;;   ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
+;; could generalize this by doing the optimization
+;;   (goto X) ... X: (return)  -->  (return)
+;;
+;; But this doesn't solve all of the problems: although by doing tail-
+;; recursion elimination in this way, the call-stack does not grow, the
+;; binding-stack would grow with each recursive step, and would eventually
+;; overflow.  I don't believe there is any way around this without lexical
+;; scope.
+;;
+;; 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
+;; 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
+;; always be dynamic, and attempting to do a lexical binding of them
+;; should simply do a dynamic binding instead.
+;; But!  We need to know about variables that were not necessarily defvarred
+;; 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).
+;; 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
+;; in some grody way, but that's a really bad idea.)
+
+;; Other things to consider:
+
+;; ;; Associative math should recognize subcalls to identical function:
+;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
+;; ;; This should generate the same as (1+ x) and (1- x)
+
+;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
+;; ;; An awful lot of functions always return a non-nil value.  If they're
+;; ;; error free also they may act as true-constants.
+
+;; (disassemble (lambda (x) (and (point) (foo))))
+;; ;; 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
+;; ;; condition is side-effect-free [assignment-free] then the other
+;; ;; arguments may be any expressions.  Since, however, the code size
+;; ;; can increase this way they should be "simple".  Compare:
+
+;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
+;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
+
+;; ;; (car (cons A B)) -> (prog1 A B)
+;; (disassemble (lambda (x) (car (cons (foo) 42))))
+
+;; ;; (cdr (cons A B)) -> (progn A B)
+;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
+
+;; ;; (car (list A B ...)) -> (prog1 A B ...)
+;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
+
+;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
+;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
+
 
 ;;; Code:
 
 
 ;;; Code:
 
+(require 'bytecomp)
+
 (defun byte-compile-log-lap-1 (format &rest args)
   (if (aref byte-code-vector 0)
 (defun byte-compile-log-lap-1 (format &rest args)
   (if (aref byte-code-vector 0)
-      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
+      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
   (byte-compile-log-1
    (apply 'format format
      (let (c a)
   (byte-compile-log-1
    (apply 'format format
      (let (c a)
-       (mapcar '(lambda (arg)
+       (mapcar (lambda (arg)
                  (if (not (consp arg))
                      (if (and (symbolp arg)
                               (string-match "^byte-" (symbol-name arg)))
                  (if (not (consp arg))
                      (if (and (symbolp arg)
                               (string-match "^byte-" (symbol-name arg)))
               args)))))
 
 (defmacro byte-compile-log-lap (format-string &rest args)
               args)))))
 
 (defmacro byte-compile-log-lap (format-string &rest args)
-  (list 'and
-       '(memq byte-optimize-log '(t byte))
-       (cons 'byte-compile-log-lap-1
-             (cons format-string args))))
+  `(and (memq byte-optimize-log '(t byte))
+       (byte-compile-log-lap-1 ,format-string ,@args)))
 
 \f
 ;;; byte-compile optimizers to support inlining
 
 \f
 ;;; byte-compile optimizers to support inlining
   "byte-optimize-handler for the `inline' special-form."
   (cons 'progn
        (mapcar
   "byte-optimize-handler for the `inline' special-form."
   (cons 'progn
        (mapcar
-        '(lambda (sexp)
-           (let ((fn (car-safe sexp)))
-             (if (and (symbolp fn)
-                   (or (cdr (assq fn byte-compile-function-environment))
-                     (and (fboundp fn)
-                       (not (or (cdr (assq fn byte-compile-macro-environment))
-                                (and (consp (setq fn (symbol-function fn)))
-                                     (eq (car fn) 'macro))
-                                (subrp fn))))))
-                 (byte-compile-inline-expand sexp)
-               sexp)))
+        (lambda (sexp)
+          (let ((f (car-safe sexp)))
+            (if (and (symbolp f)
+                     (or (cdr (assq f byte-compile-function-environment))
+                         (not (or (not (fboundp f))
+                                  (cdr (assq f byte-compile-macro-environment))
+                                  (and (consp (setq f (symbol-function f)))
+                                       (eq (car f) 'macro))
+                                  (subrp f)))))
+                (byte-compile-inline-expand sexp)
+              sexp)))
         (cdr form))))
 
 
         (cdr form))))
 
 
 (defun byte-inline-lapcode (lap)
   (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
 
 (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))
                 (and (fboundp name) (symbol-function name)))))
     (if (null fn)
        (progn
 (defun byte-compile-inline-expand (form)
   (let* ((name (car form))
         (fn (or (cdr (assq name byte-compile-function-environment))
                 (and (fboundp name) (symbol-function name)))))
     (if (null fn)
        (progn
-         (byte-compile-warn "attempt to inline %s before it was defined" name)
+         (byte-compile-warn "attempt to inline `%s' before it was defined"
+                            name)
          form)
       ;; else
          form)
       ;; else
+      (when (and (consp fn) (eq (car fn) 'autoload))
+       (load (nth 1 fn))
+       (setq fn (or (and (fboundp name) (symbol-function name))
+                    (cdr (assq name byte-compile-function-environment)))))
       (if (and (consp fn) (eq (car fn) 'autoload))
       (if (and (consp fn) (eq (car fn) 'autoload))
-         (load (nth 1 fn)))
-      (if (and (consp fn) (eq (car fn) 'autoload))
-         (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
-      (if (symbolp fn)
+         (error "File `%s' didn't define `%s'" (nth 1 fn) name))
+      (if (and (symbolp fn) (not (eq fn t)))
          (byte-compile-inline-expand (cons fn (cdr form)))
        (if (byte-code-function-p fn)
          (byte-compile-inline-expand (cons fn (cdr form)))
        (if (byte-code-function-p fn)
-           (cons (list 'lambda (aref fn 0)
-                       (list 'byte-code (aref fn 1) (aref fn 2) (aref fn 3)))
-                 (cdr form))
-         (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name))
-         (cons fn (cdr form)))))))
-
-;;; ((lambda ...) ...)
-;;; 
+           (let (string)
+             (fetch-bytecode fn)
+             (setq string (aref fn 1))
+             ;; Isn't it an error for `string' not to be unibyte??  --stef
+             (if (fboundp 'string-as-unibyte)
+                 (setq string (string-as-unibyte string)))
+             (cons `(lambda ,(aref fn 0)
+                      (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
+                   (cdr form)))
+         (if (eq (car-safe fn) 'lambda)
+             (cons fn (cdr form))
+           ;; Give up on inlining.
+           form))))))
+
+;; ((lambda ...) ...)
 (defun byte-compile-unfold-lambda (form &optional name)
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
 (defun byte-compile-unfold-lambda (form &optional name)
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
                                    bindings)
                     values nil))
              ((and (not optionalp) (null values))
                                    bindings)
                     values nil))
              ((and (not optionalp) (null values))
-              (byte-compile-warn "attempt to open-code %s with too few arguments" name)
+              (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
               (setq arglist nil values 'too-few))
              (t
               (setq bindings (cons (list (car arglist) (car values))
               (setq arglist nil values 'too-few))
              (t
               (setq bindings (cons (list (car arglist) (car values))
          (progn
            (or (eq values 'too-few)
                (byte-compile-warn
          (progn
            (or (eq values 'too-few)
                (byte-compile-warn
-                "attempt to open-code %s with too many arguments" name))
+                "attempt to open-code `%s' with too many arguments" name))
            form)
            form)
-       (let ((newform 
+
+       ;; 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
               (if bindings
                   (cons 'let (cons (nreverse bindings) body))
                 (cons 'progn body))))
               (if bindings
                   (cons 'let (cons (nreverse bindings) body))
                 (cons 'progn body))))
             form))
          ((eq fn 'quote)
           (if (cdr (cdr form))
             form))
          ((eq fn 'quote)
           (if (cdr (cdr form))
-              (byte-compile-warn "malformed quote form: %s"
+              (byte-compile-warn "malformed quote form: `%s'"
                                  (prin1-to-string form)))
           ;; map (quote nil) to nil to simplify optimizer logic.
           ;; map quoted constants to nil if for-effect (just because).
                                  (prin1-to-string form)))
           ;; map (quote nil) to nil to simplify optimizer logic.
           ;; map quoted constants to nil if for-effect (just because).
           ;; are more deeply nested are optimized first.
           (cons fn
             (cons
           ;; are more deeply nested are optimized first.
           (cons fn
             (cons
-             (mapcar '(lambda (binding)
+             (mapcar (lambda (binding)
                         (if (symbolp binding)
                             binding
                           (if (cdr (cdr binding))
                         (if (symbolp binding)
                             binding
                           (if (cdr (cdr binding))
-                              (byte-compile-warn "malformed let binding: %s"
+                              (byte-compile-warn "malformed let binding: `%s'"
                                                  (prin1-to-string binding)))
                           (list (car binding)
                                 (byte-optimize-form (nth 1 binding) nil))))
                                                  (prin1-to-string binding)))
                           (list (car binding)
                                 (byte-optimize-form (nth 1 binding) nil))))
              (byte-optimize-body (cdr (cdr form)) for-effect))))
          ((eq fn 'cond)
           (cons fn
              (byte-optimize-body (cdr (cdr form)) for-effect))))
          ((eq fn 'cond)
           (cons fn
-                (mapcar '(lambda (clause)
+                (mapcar (lambda (clause)
                            (if (consp clause)
                                (cons
                                 (byte-optimize-form (car clause) nil)
                                 (byte-optimize-body (cdr clause) for-effect))
                            (if (consp clause)
                                (cons
                                 (byte-optimize-form (car clause) nil)
                                 (byte-optimize-body (cdr clause) for-effect))
-                             (byte-compile-warn "malformed cond form: %s"
+                             (byte-compile-warn "malformed cond form: `%s'"
                                                 (prin1-to-string clause))
                              clause))
                         (cdr form))))
                                                 (prin1-to-string clause))
                              clause))
                         (cdr form))))
             (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)))))
             (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))
+
+         ((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)))
           ;; 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 '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)
          ((eq fn 'if)
+          (when (< (length form) 3)
+            (byte-compile-warn "too few arguments for `if'"))
           (cons fn
             (cons (byte-optimize-form (nth 1 form) nil)
               (cons
                (byte-optimize-form (nth 2 form) for-effect)
                (byte-optimize-body (nthcdr 3 form) for-effect)))))
           (cons fn
             (cons (byte-optimize-form (nth 1 form) nil)
               (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
          ((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
                     (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)
             (cons fn (mapcar 'byte-optimize-form (cdr form)))))
 
          ((eq fn 'interactive)
-          (byte-compile-warn "misplaced interactive spec: %s"
+          (byte-compile-warn "misplaced interactive spec: `%s'"
                              (prin1-to-string form))
           nil)
                              (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
          ((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)))))
           (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
          ((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)))))
 
                 (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
          ;; 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
                    (setq form (macroexpand form
                                            byte-compile-macro-environment))))
           (byte-optimize-form form for-effect))
                    (setq form (macroexpand form
                                            byte-compile-macro-environment))))
           (byte-optimize-form form for-effect))
-         
+
+         ;; Support compiler macros as in cl.el.
+         ((and (fboundp 'compiler-macroexpand)
+               (symbolp (car-safe form))
+               (get (car-safe form) 'cl-compiler-macro)
+               (not (eq form
+                        (with-no-warnings
+                         (setq form (compiler-macroexpand form))))))
+          (byte-optimize-form form for-effect))
+
          ((not (symbolp fn))
          ((not (symbolp fn))
-          (or (eq 'mocklisp (car-safe fn)) ; ha!
-              (byte-compile-warn "%s is a malformed function"
-                                 (prin1-to-string fn)))
+          (byte-compile-warn "`%s' is a malformed function"
+                             (prin1-to-string fn))
           form)
 
          ((and for-effect (setq tmp (get fn 'side-effect-free))
                (or byte-compile-delete-errors
                    (eq tmp 'error-free)
           form)
 
          ((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
                    (progn
-                     (byte-compile-warn "%s called for effect"
-                                        (prin1-to-string form))
+                     (byte-compile-warn "`%s' called for effect"
+                                        (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))
                      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
          (t
           ;; Otherwise, no args can be considered to be for-effect,
           ;; even if the called function is for-effect, because we
     (nreverse result)))
 
 \f
     (nreverse result)))
 
 \f
-;;; some source-level optimizers
-;;;
-;;; when writing optimizers, be VERY careful that the optimizer returns
-;;; something not EQ to its argument if and ONLY if it has made a change.
-;;; This implies that you cannot simply destructively modify the list;
-;;; you must return something not EQ to it if you make an optimization.
-;;;
-;;; It is now safe to optimize code such that it introduces new bindings.
+;; some source-level optimizers
+;;
+;; when writing optimizers, be VERY careful that the optimizer returns
+;; something not EQ to its argument if and ONLY if it has made a change.
+;; This implies that you cannot simply destructively modify the list;
+;; you must return something not EQ to it if you make an optimization.
+;;
+;; 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.
 
 ;; 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)))))
+  `(cond ((consp ,form) (eq (car ,form) 'quote))
+        ((not (symbolp ,form)))
+        ((eq ,form t))
+        ((keywordp ,form))))
 
 ;; If the function is being called with constant numeric args,
 
 ;; 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)
 ;; assumes that the function is associative, like + or *.
 (defun byte-optimize-associative-math (form)
   (let ((args nil)
        form)))
 
 ;; If the function is being called with constant numeric args,
        form)))
 
 ;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer 
-;; assumes that the function is nonassociative, like - or /.
+;; evaluate as much as possible at compile-time.  This optimizer
+;; assumes that the function satisfies
+;;   (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
+;; like - and /.
 (defun byte-optimize-nonassociative-math (form)
   (if (or (not (numberp (car (cdr form))))
          (not (numberp (car (cdr (cdr form))))))
 (defun byte-optimize-nonassociative-math (form)
   (if (or (not (numberp (car (cdr form))))
          (not (numberp (car (cdr (cdr form))))))
 ;;      (byte-optimize-two-args-right form)
 ;;      form))
 
 ;;      (byte-optimize-two-args-right form)
 ;;      form))
 
+(defun byte-optimize-approx-equal (x y)
+  (<= (* (abs (- x y)) 100) (abs (+ x y))))
+
+;; Collect all the constants from FORM, after the STARTth arg,
+;; and apply FUN to them to make one argument at the end.
+;; For functions that can handle floats, that optimization
+;; can be incorrect because reordering can cause an overflow
+;; that would otherwise be avoided by encountering an arg that is a float.
+;; We avoid this problem by (1) not moving float constants and
+;; (2) not moving anything if it would cause an overflow.
 (defun byte-optimize-delay-constants-math (form start fun)
   ;; Merge all FORM's constants from number START, call FUN on them
   ;; and put the result at the end.
 (defun byte-optimize-delay-constants-math (form start fun)
   ;; Merge all FORM's constants from number START, call FUN on them
   ;; and put the result at the end.
-  (let ((rest (nthcdr (1- start) form)))
+  (let ((rest (nthcdr (1- start) form))
+       (orig form)
+       ;; t means we must check for overflow.
+       (overflow (memq fun '(+ *))))
     (while (cdr (setq rest (cdr rest)))
     (while (cdr (setq rest (cdr rest)))
-      (if (numberp (car rest))
+      (if (integerp (car rest))
          (let (constants)
            (setq form (copy-sequence form)
                  rest (nthcdr (1- start) form))
            (while (setq rest (cdr rest))
          (let (constants)
            (setq form (copy-sequence form)
                  rest (nthcdr (1- start) form))
            (while (setq rest (cdr rest))
-             (cond ((numberp (car rest))
+             (cond ((integerp (car rest))
                     (setq constants (cons (car rest) constants))
                     (setcar rest nil))))
                     (setq constants (cons (car rest) constants))
                     (setcar rest nil))))
-           (setq form (nconc (delq nil form)
-                             (list (apply fun (nreverse constants))))))))
+           ;; If necessary, check now for overflow
+           ;; that might be caused by reordering.
+           (if (and overflow
+                    ;; We have overflow if the result of doing the arithmetic
+                    ;; on floats is not even close to the result
+                    ;; of doing it on integers.
+                    (not (byte-optimize-approx-equal
+                           (apply fun (mapcar 'float constants))
+                           (float (apply fun constants)))))
+               (setq form orig)
+             (setq form (nconc (delq nil form)
+                               (list (apply fun (nreverse constants)))))))))
     form))
 
 (defun byte-optimize-plus (form)
     form))
 
 (defun byte-optimize-plus (form)
         (condition-case ()
             (eval form)
           (error form)))
         (condition-case ()
             (eval form)
           (error form)))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;     ((null (cdr (cdr form))) (nth 1 form))
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker).
+;;;    ((null (cdr (cdr form))) (nth 1 form))
+       ((null (cddr form))
+        (if (numberp (nth 1 form))
+            (nth 1 form)
+          form))
+       ((and (null (nthcdr 3 form))
+             (or (memq (nth 1 form) '(1 -1))
+                 (memq (nth 2 form) '(1 -1))))
+        ;; Optimize (+ x 1) into (1+ x) and (+ x -1) into (1- x).
+        (let ((integer
+               (if (memq (nth 1 form) '(1 -1))
+                   (nth 1 form)
+                 (nth 2 form)))
+              (other
+               (if (memq (nth 1 form) '(1 -1))
+                   (nth 2 form)
+                 (nth 1 form))))
+          (list (if (eq integer 1) '1+ '1-)
+                other)))
        (t form)))
 
 (defun byte-optimize-minus (form)
        (t form)))
 
 (defun byte-optimize-minus (form)
           ;; (- x y ... 0)  --> (- x y ...)
           (setq form (copy-sequence form))
           (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
           ;; (- x y ... 0)  --> (- x y ...)
           (setq form (copy-sequence form))
           (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
+         ((equal (nthcdr 2 form) '(1))
+          (setq form (list '1- (nth 1 form))))
+         ((equal (nthcdr 2 form) '(-1))
+          (setq form (list '1+ (nth 1 form))))
          ;; If form is (- CONST foo... CONST), merge first and last.
          ((and (numberp (nth 1 form))
                (numberp last))
           (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
                             (delq last (copy-sequence (nthcdr 3 form))))))))
          ;; If form is (- CONST foo... CONST), merge first and last.
          ((and (numberp (nth 1 form))
                (numberp last))
           (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
                             (delq last (copy-sequence (nthcdr 3 form))))))))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker).
 ;;;  (if (eq (nth 2 form) 0)
 ;;;      (nth 1 form)                  ; (- x 0)  -->  x
     (byte-optimize-predicate
 ;;;  (if (eq (nth 2 form) 0)
 ;;;      (nth 1 form)                  ; (- x 0)  -->  x
     (byte-optimize-predicate
   (setq form (byte-optimize-delay-constants-math form 1 '*))
   ;; If there is a constant in FORM, it is now the last element.
   (cond ((null (cdr form)) 1)
   (setq form (byte-optimize-delay-constants-math form 1 '*))
   ;; If there is a constant in FORM, it is now the last element.
   (cond ((null (cdr form)) 1)
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker or if it appears in other arithmetic).
+;;;  It is not safe to delete the function entirely
+;;;  (actually, it would be safe if we know the sole arg
+;;;  is not a marker or if it appears in other arithmetic).
 ;;;    ((null (cdr (cdr form))) (nth 1 form))
        ((let ((last (car (reverse form))))
 ;;;    ((null (cdr (cdr form))) (nth 1 form))
        ((let ((last (car (reverse form))))
-          (cond ((eq 0 last)  (list 'progn (cdr form)))
+          (cond ((eq 0 last)  (cons 'progn (cdr form)))
                 ((eq 1 last)  (delq 1 (copy-sequence form)))
                 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
                 ((and (eq 2 last)
                 ((eq 1 last)  (delq 1 (copy-sequence form)))
                 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
                 ((and (eq 2 last)
   (let ((last (car (reverse (cdr (cdr form))))))
     (if (numberp last)
        (cond ((= (length form) 3)
   (let ((last (car (reverse (cdr (cdr form))))))
     (if (numberp last)
        (cond ((= (length form) 3)
-              ;; Don't shrink to less than two arguments--would get an error.
-              nil)
+              (if (and (numberp (nth 1 form))
+                       (not (zerop last))
+                       (condition-case nil
+                           (/ (nth 1 form) last)
+                         (error nil)))
+                  (setq form (list 'progn (/ (nth 1 form) last)))))
              ((= last 1)
               (setq form (byte-compile-butlast form)))
              ((numberp (nth 1 form))
              ((= last 1)
               (setq form (byte-compile-butlast form)))
              ((numberp (nth 1 form))
                                (cons (/ (nth 1 form) last)
                                      (byte-compile-butlast (cdr (cdr form)))))
                     last 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)
 ;;;      ((null (cdr (cdr form)))
 ;;;       (nth 1 form))
          ((eq (nth 1 form) 0)
                       (delq 0 (copy-sequence form)))))
         ((and (eq (car-safe form) 'logior)
               (memq -1 form))
                       (delq 0 (copy-sequence form)))))
         ((and (eq (car-safe form) 'logior)
               (memq -1 form))
-         (delq -1 (copy-sequence form)))
+         (cons 'progn (cdr form)))
         (form))))
 
 
         (form))))
 
 
 
 (put '=   'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'eq  'byte-optimizer 'byte-optimize-binary-predicate)
 
 (put '=   'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'eq  'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eql 'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'equal   'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'equal   'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
 (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
 
 
 (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
 ;; 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
 (defun byte-optimize-quote (form)
   (if (or (consp (nth 1 form))
          (and (symbolp (nth 1 form))
 (defun byte-optimize-quote (form)
   (if (or (consp (nth 1 form))
          (and (symbolp (nth 1 form))
-              (not (memq (nth 1 form) '(nil t)))))
+              (not (byte-compile-const-symbol-p form))))
       form
     (nth 1 form)))
 
       form
     (nth 1 form)))
 
               (list 'if clause (nth 2 form))
             form))
          ((or (nth 3 form) (nthcdr 4 form))
               (list 'if clause (nth 2 form))
             form))
          ((or (nth 3 form) (nthcdr 4 form))
-          (list 'if (list 'not clause)
+          (list 'if
+                ;; Don't make a double negative;
+                ;; instead, take away the one that is there.
+                (if (and (consp clause) (memq (car clause) '(not null))
+                         (= (length clause) 2)) ; (not xxxx) or (not (xxxx))
+                    (nth 1 clause)
+                  (list 'not clause))
                 (if (nthcdr 4 form)
                     (cons 'progn (nthcdr 3 form))
                   (nth 3 form))))
                 (if (nthcdr 4 form)
                     (cons 'progn (nthcdr 3 form))
                   (nth 3 form))))
           (list 'progn clause nil)))))
 
 (defun byte-optimize-while (form)
           (list 'progn clause nil)))))
 
 (defun byte-optimize-while (form)
+  (when (< (length form) 2)
+    (byte-compile-warn "too few arguments for `while'"))
   (if (nth 1 form)
       form))
 
   (if (nth 1 form)
       form))
 
 
 
 (defun byte-optimize-funcall (form)
 
 
 (defun byte-optimize-funcall (form)
-  ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...)
-  ;; (funcall 'foo ...) ==> (foo ...)
+  ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
+  ;; (funcall foo ...) ==> (foo ...)
   (let ((fn (nth 1 form)))
     (if (memq (car-safe fn) '(quote function))
        (cons (nth 1 fn) (cdr (cdr form)))
   (let ((fn (nth 1 form)))
     (if (memq (car-safe fn) '(quote function))
        (cons (nth 1 fn) (cdr (cdr form)))
            (if (listp (nth 1 last))
                (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
                  (nconc (list 'funcall fn) butlast
            (if (listp (nth 1 last))
                (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
                  (nconc (list 'funcall fn) butlast
-                        (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
+                        (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
              (byte-compile-warn
              (byte-compile-warn
-              "last arg to apply can't be a literal atom: %s"
+              "last arg to apply can't be a literal atom: `%s'"
               (prin1-to-string last))
              nil))
        form)))
               (prin1-to-string last))
              nil))
        form)))
         form)
         ;; The body is nil
        ((eq (car form) 'let)
         form)
         ;; The body is nil
        ((eq (car form) 'let)
-        (append '(progn) (mapcar 'car (mapcar 'cdr (nth 1 form))) '(nil)))
+        (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
+                '(nil)))
        (t
         (let ((binds (reverse (nth 1 form))))
           (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
        (t
         (let ((binds (reverse (nth 1 form))))
           (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
 
 (put 'nth 'byte-optimizer 'byte-optimize-nth)
 (defun byte-optimize-nth (form)
 
 (put 'nth 'byte-optimizer 'byte-optimize-nth)
 (defun byte-optimize-nth (form)
-  (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)))
+  (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)
 
 (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
 (defun byte-optimize-nthcdr (form)
-  (let ((count (nth 1 form)))
-    (if (not (memq count '(0 1 2)))
-       (byte-optimize-predicate form)
-      (setq form (nth 2 form))
-      (while (natnump (setq count (1- count)))
-       (setq form (list 'cdr 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-pure-func)
+(put 'symbol-name 'byte-optimizer 'byte-optimize-pure-func)
+(put 'regexp-opt 'byte-optimizer 'byte-optimize-pure-func)
+(put 'regexp-quote 'byte-optimizer 'byte-optimize-pure-func)
+(defun byte-optimize-pure-func (form)
+  "Do constant folding for pure functions.
+This assumes that the function will not have any side-effects and that
+its return value depends solely on its arguments.
+If the function can signal an error, this might change the semantics
+of FORM by signaling the error at compile-time."
+  (let ((args (cdr form))
+       (constant t))
+    (while (and args constant)
+      (or (byte-compile-constp (car args))
+         (setq constant nil))
+      (setq args (cdr args)))
+    (if constant
+       (eval form)
       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))
+             (numberp (nth 1 form)))
+        (list 'forward-char (eval (- (nth 1 form)))))
+       ((= 1 (safe-length form))
+        '(forward-char -1))
+       (t form)))
+
+(put 'backward-word 'byte-optimizer 'byte-optimize-backward-word)
+(defun byte-optimize-backward-word (form)
+  (cond ((and (= 2 (safe-length form))
+             (numberp (nth 1 form)))
+        (list 'forward-word (eval (- (nth 1 form)))))
+       ((= 1 (safe-length form))
+        '(forward-word -1))
+       (t form)))
+
+(put 'char-before 'byte-optimizer 'byte-optimize-char-before)
+(defun byte-optimize-char-before (form)
+  (cond ((= 2 (safe-length form))
+        `(char-after (1- ,(nth 1 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
 \f
-;;; 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))
-;;; may safely be turned into
-;;;    (progn (progn (something-with-side-effects) (yow))
-;;;           (foo))
-;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
-
-;;; I wonder if I missed any :-\)
+;; 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))
+;; may safely be turned into
+;;    (progn (progn (something-with-side-effects) (yow))
+;;           (foo))
+;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
+
+;; Some of these functions have the side effect of allocating memory
+;; and it would be incorrect to replace two calls with one.
+;; But we don't try to do those kinds of optimizations,
+;; so it is safe to list such functions here.
+;; Some of these functions return values that depend on environment
+;; 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
         assoc assq
         boundp buffer-file-name buffer-local-variables buffer-modified-p
 (let ((side-effect-free-fns
        '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
         assoc assq
         boundp buffer-file-name buffer-local-variables buffer-modified-p
-        buffer-substring
-        capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p
-        copy-marker cos count-lines
-        default-boundp default-value documentation downcase
-        elt exp expt fboundp featurep
+        buffer-substring byte-code-function-p
+        capitalize car-less-than-car car cdr ceiling char-after char-before
+        char-equal char-to-string char-width
+        compare-strings concat coordinates-in-window-p
+        copy-alist copy-sequence copy-marker cos count-lines
+        decode-time default-boundp default-value documentation downcase
+        elt exp expt encode-time error-message-string
+        fboundp fceiling featurep ffloor
         file-directory-p file-exists-p file-locked-p file-name-absolute-p
         file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
         file-directory-p file-exists-p file-locked-p file-name-absolute-p
         file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
-        float floor format
-        get get-buffer get-buffer-window getenv get-file-buffer
-        int-to-string
-        length log log10 logand logb logior lognot logxor lsh
-        marker-buffer max member memq min mod
+        float float-time floor format format-time-string frame-visible-p
+        fround ftruncate
+        get gethash get-buffer get-buffer-window getenv get-file-buffer
+        hash-table-count
+        int-to-string intern-soft
+        keymap-parent
+        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 multibyte-char-to-unibyte
         next-window nth nthcdr number-to-string
         next-window nth nthcdr number-to-string
-        parse-colon-path previous-window
-        radians-to-degrees rassq regexp-quote reverse round
-        sin sqrt string< string= string-equal string-lessp string-to-char
-        string-to-int string-to-number substring symbol-plist
-        tan upcase user-variable-p vconcat
+        parse-colon-path plist-get plist-member
+        prefix-numeric-value previous-window prin1-to-string propertize
+        radians-to-degrees rassq rassoc read-from-string regexp-quote
+        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 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
+        vconcat
         window-buffer window-dedicated-p window-edges window-height
         window-hscroll window-minibuffer-p window-width
         zerop))
       (side-effect-and-error-free-fns
        '(arrayp atom
         window-buffer window-dedicated-p window-edges window-height
         window-hscroll window-minibuffer-p window-width
         zerop))
       (side-effect-and-error-free-fns
        '(arrayp atom
-        bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
+        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
         car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
-        current-buffer
-        dot dot-marker eobp eolp eq eql equal eventp floatp framep
+        current-buffer current-global-map current-indentation
+        current-local-map current-minor-mode-maps current-time
+        current-time-string current-time-zone
+        eobp eolp eq equal eventp
+        floatp following-char framep
         get-largest-window get-lru-window
         get-largest-window get-lru-window
+        hash-table-p
         identity ignore integerp integer-or-marker-p interactive-p
         invocation-directory invocation-name
         identity ignore integerp integer-or-marker-p interactive-p
         invocation-directory invocation-name
-        keymapp list listp
+        keymapp
+        line-beginning-position line-end-position list listp
         make-marker mark mark-marker markerp memory-limit minibuffer-window
         mouse-movement-p
         natnump nlistp not null number-or-marker-p numberp
         one-window-p overlayp
         make-marker mark mark-marker markerp memory-limit minibuffer-window
         mouse-movement-p
         natnump nlistp not null number-or-marker-p numberp
         one-window-p overlayp
-        point point-marker point-min point-max processp
-        selected-window sequencep stringp subrp symbolp syntax-table-p
-        user-full-name user-login-name user-original-login-name
+        point point-marker point-min point-max preceding-char processp
+        recent-keys recursion-depth
+        safe-length selected-frame selected-window sequencep
+        standard-case-table standard-syntax-table stringp subrp symbolp
+        syntax-table syntax-table-p
+        this-command-keys this-command-keys-vector this-single-command-keys
+        this-single-command-raw-keys
         user-real-login-name user-real-uid user-uid
         user-real-login-name user-real-uid user-uid
-        vector vectorp
-        window-configuration-p window-live-p windowp)))
+        vector vectorp visible-frame-list
+        wholenump window-configuration-p window-live-p windowp)))
   (while side-effect-free-fns
     (put (car side-effect-free-fns) 'side-effect-free t)
     (setq side-effect-free-fns (cdr side-effect-free-fns)))
   (while side-effect-free-fns
     (put (car side-effect-free-fns) 'side-effect-free t)
     (setq side-effect-free-fns (cdr side-effect-free-fns)))
 (defconst byte-constref-ops
   '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
 
 (defconst byte-constref-ops
   '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
 
-;;; This function extracts the bitfields from variable-length opcodes.
-;;; Originally defined in disass.el (which no longer uses it.)
+;; This function extracts the bitfields from variable-length opcodes.
+;; Originally defined in disass.el (which no longer uses it.)
 
 (defun disassemble-offset ()
   "Don't call this!"
   ;; fetch and return the offset for the current opcode.
 
 (defun disassemble-offset ()
   "Don't call this!"
   ;; fetch and return the offset for the current opcode.
-  ;; return NIL if this opcode has no offset
+  ;; return nil if this opcode has no offset
   ;; OP, PTR and BYTES are used and set dynamically
   (defvar op)
   (defvar ptr)
   ;; OP, PTR and BYTES are used and set dynamically
   (defvar op)
   (defvar ptr)
         (aref bytes ptr))))
 
 
         (aref bytes ptr))))
 
 
-;;; This de-compiler is used for inline expansion of compiled functions,
-;;; and by the disassembler.
-;;;
-;;; This list contains numbers, which are pc values,
-;;; before each instruction.
+;; This de-compiler is used for inline expansion of compiled functions,
+;; and by the disassembler.
+;;
+;; This list contains numbers, which are pc values,
+;; before each instruction.
 (defun byte-decompile-bytecode (bytes constvec)
   "Turns BYTECODE into lapcode, referring to CONSTVEC."
   (let ((byte-compile-constants nil)
 (defun byte-decompile-bytecode (bytes constvec)
   "Turns BYTECODE into lapcode, referring to CONSTVEC."
   (let ((byte-compile-constants nil)
 ;; before each insn (or its label).
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
   (let ((length (length bytes))
 ;; before each insn (or its label).
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
   (let ((length (length bytes))
-       (ptr 0) optr tag tags op offset
+       (ptr 0) optr tags op offset
        lap tmp
        lap tmp
-       endtag
-       (retcount 0))
+       endtag)
     (while (not (= ptr length))
       (or make-spliceable
          (setq lap (cons ptr lap)))
     (while (not (= ptr length))
       (or make-spliceable
          (setq lap (cons ptr lap)))
                                             tags)))))))
            ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t)
                   ((memq op byte-constref-ops)))
                                             tags)))))))
            ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t)
                   ((memq op byte-constref-ops)))
-            (setq tmp (aref constvec offset)
+            (setq tmp (if (>= offset (length constvec))
+                          (list 'out-of-range offset)
+                        (aref constvec offset))
                   offset (if (eq op 'byte-constant)
                              (byte-compile-get-constant tmp)
                            (or (assq tmp byte-compile-variables)
                   offset (if (eq op 'byte-constant)
                              (byte-compile-get-constant tmp)
                            (or (assq tmp byte-compile-variables)
 (defconst byte-after-unbind-ops
    '(byte-constant byte-dup
      byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
 (defconst byte-after-unbind-ops
    '(byte-constant byte-dup
      byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
-     byte-eq byte-equal byte-not
+     byte-eq byte-not
      byte-cons byte-list1 byte-list2   ; byte-list3 byte-list4
      byte-interactive-p)
    ;; How about other side-effect-free-ops?  Is it safe to move an
    ;; error invocation (such as from nth) out of an unwind-protect?
      byte-cons byte-list1 byte-list2   ; byte-list3 byte-list4
      byte-interactive-p)
    ;; How about other side-effect-free-ops?  Is it safe to move an
    ;; error invocation (such as from nth) out of an unwind-protect?
+   ;; No, it is not, because the unwind-protect forms can alter
+   ;; the inside of the object to which nth would apply.
+   ;; For the same reason, byte-equal was deleted from this list.
    "Byte-codes that can be moved past an unbind.")
 
 (defconst byte-compile-side-effect-and-error-free-ops
    "Byte-codes that can be moved past an unbind.")
 
 (defconst byte-compile-side-effect-and-error-free-ops
     byte-current-buffer byte-interactive-p))
 
 (defconst byte-compile-side-effect-free-ops
     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
    '(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
      byte-member byte-assq byte-quo byte-rem)
    byte-compile-side-effect-and-error-free-ops))
 
      byte-member byte-assq byte-quo byte-rem)
    byte-compile-side-effect-and-error-free-ops))
 
-;;; This piece of shit is because of the way DEFVAR_BOOL() variables work.
-;;; Consider the code
-;;;
-;;;    (defun foo (flag)
-;;;      (let ((old-pop-ups pop-up-windows)
-;;;            (pop-up-windows flag))
-;;;        (cond ((not (eq pop-up-windows old-pop-ups))
-;;;               (setq old-pop-ups pop-up-windows)
-;;;               ...))))
-;;;
-;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
-;;; something else.  But if we optimize
-;;;
-;;;    varref flag
-;;;    varbind pop-up-windows
-;;;    varref pop-up-windows
-;;;    not
-;;; to
-;;;    varref flag
-;;;    dup
-;;;    varbind pop-up-windows
-;;;    not
-;;;
-;;; 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.
-;;;
-(defconst byte-boolean-vars
-  '(abbrev-all-caps abbrevs-changed byte-metering-on
-    check-protected-fields completion-auto-help completion-ignore-case
-    cursor-in-echo-area debug-on-next-call debug-on-quit
-    defining-kbd-macro delete-exited-processes
-    enable-recursive-minibuffers
-    highlight-nonselected-windows indent-tabs-mode
-    insert-default-directory inverse-video load-in-progress
-    menu-prompting mode-line-inverse-video no-redraw-on-reenter
-    noninteractive parse-sexp-ignore-comments pop-up-frames
-    pop-up-windows print-escape-newlines print-escape-newlines
-    truncate-partial-width-windows visible-bell vms-stmlf-recfm
-    words-include-escapes x-save-under)
-  "DEFVAR_BOOL variables.  Giving these any non-nil value sets them to t.
-If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
-may generate incorrect code.")
+;; This crock is because of the way DEFVAR_BOOL variables work.
+;; Consider the code
+;;
+;;     (defun foo (flag)
+;;       (let ((old-pop-ups pop-up-windows)
+;;             (pop-up-windows flag))
+;;         (cond ((not (eq pop-up-windows old-pop-ups))
+;;                (setq old-pop-ups pop-up-windows)
+;;                ...))))
+;;
+;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
+;; something else.  But if we optimize
+;;
+;;     varref flag
+;;     varbind pop-up-windows
+;;     varref pop-up-windows
+;;     not
+;; to
+;;     varref flag
+;;     dup
+;;     varbind pop-up-windows
+;;     not
+;;
+;; 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.
+
+;; The variable `byte-boolean-vars' is now primitive and updated
+;; automatically by DEFVAR_BOOL.
 
 (defun byte-optimize-lapcode (lap &optional for-effect)
 
 (defun byte-optimize-lapcode (lap &optional for-effect)
-  "Simple peephole optimizer.  LAP is both modified and returned."
-  (let (lap0 off0
-       lap1 off1
-       lap2 off2
+  "Simple peephole optimizer.  LAP is both modified and returned.
+If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
+  (let (lap0
+       lap1
+       lap2
        (keep-going 'first-time)
        (add-depth 0)
        rest tmp tmp2 tmp3
        (keep-going 'first-time)
        (add-depth 0)
        rest tmp tmp2 tmp3
@@ -1328,7 +1583,8 @@ may generate incorrect code.")
                 (if (memq (car lap0) '(byte-constant byte-dup))
                     (progn
                       (setq tmp (if (or (not tmp)
                 (if (memq (car lap0) '(byte-constant byte-dup))
                     (progn
                       (setq tmp (if (or (not tmp)
-                                        (memq (car (cdr lap0)) '(nil t)))
+                                        (byte-compile-const-symbol-p
+                                         (car (cdr lap0))))
                                     (cdr lap0)
                                   (byte-compile-get-constant t)))
                       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
                                     (cdr lap0)
                                   (byte-compile-get-constant t)))
                       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
@@ -1383,7 +1639,7 @@ may generate incorrect code.")
              ;; 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.
              ;; 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
              ((and (or (eq 'byte-goto-if-nil (car lap0))
                        (eq 'byte-goto-if-not-nil (car lap0)))  ; gotoX
                    (eq 'byte-goto (car lap1))                  ; gotoY
@@ -1486,9 +1742,9 @@ may generate incorrect code.")
                                   str (concat str " %s")
                                   i (1+ i))))
                 (if opt-p
                                   str (concat str " %s")
                                   i (1+ i))))
                 (if opt-p
-                    (let ((tagstr 
+                    (let ((tagstr
                            (if (eq 'TAG (car (car tmp)))
                            (if (eq 'TAG (car (car tmp)))
-                               (format "%d:" (cdr (car tmp)))
+                               (format "%d:" (car (cdr (car tmp))))
                              (or (car tmp) ""))))
                       (if (< i 6)
                           (apply 'byte-compile-log-lap-1
                              (or (car tmp) ""))))
                       (if (< i 6)
                           (apply 'byte-compile-log-lap-1
@@ -1667,7 +1923,7 @@ may generate incorrect code.")
                                     (byte-goto-if-not-nil-else-pop .
                                      byte-goto-if-nil-else-pop))))
                        newtag)
                                     (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)))
                  (nth 1 newtag)
                  )
                 (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
@@ -1700,20 +1956,21 @@ may generate incorrect code.")
       (setq lap0 (car rest)
            lap1 (nth 1 rest))
       (if (memq (car lap0) byte-constref-ops)
       (setq lap0 (car rest)
            lap1 (nth 1 rest))
       (if (memq (car lap0) byte-constref-ops)
-         (if (eq (cdr lap0) 'byte-constant)
-             (or (memq (cdr lap0) byte-compile-variables)
-                 (setq byte-compile-variables (cons (cdr lap0)
-                                                    byte-compile-variables)))
-           (or (memq (cdr lap0) byte-compile-constants)
+         (if (or (eq (car lap0) 'byte-constant)
+                 (eq (car lap0) 'byte-constant2))
+             (unless (memq (cdr lap0) byte-compile-constants)
                (setq byte-compile-constants (cons (cdr lap0)
                (setq byte-compile-constants (cons (cdr lap0)
-                                                  byte-compile-constants)))))
+                                                  byte-compile-constants)))
+           (unless (memq (cdr lap0) byte-compile-variables)
+             (setq byte-compile-variables (cons (cdr lap0)
+                                                byte-compile-variables)))))
       (cond (;;
             ;; const-C varset-X const-C  -->  const-C dup varset-X
             ;; const-C varbind-X const-C  -->  const-C dup varbind-X
             ;;
             (and (eq (car lap0) 'byte-constant)
                  (eq (car (nth 2 rest)) 'byte-constant)
       (cond (;;
             ;; const-C varset-X const-C  -->  const-C dup varset-X
             ;; const-C varbind-X const-C  -->  const-C dup varbind-X
             ;;
             (and (eq (car lap0) 'byte-constant)
                  (eq (car (nth 2 rest)) 'byte-constant)
-                 (eq (cdr lap0) (car (nth 2 rest)))
+                 (eq (cdr lap0) (cdr (nth 2 rest)))
                  (memq (car lap1) '(byte-varbind byte-varset)))
             (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
                                   lap0 lap1 lap0 lap0 lap1)
                  (memq (car lap1) '(byte-varbind byte-varset)))
             (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
                                   lap0 lap1 lap0 lap0 lap1)
@@ -1735,7 +1992,7 @@ may generate incorrect code.")
               (setq tmp2 t))
             (if tmp2
                 (byte-compile-log-lap
               (setq tmp2 t))
             (if tmp2
                 (byte-compile-log-lap
-                 "  %s [dup/%s]... %s\t-->\t%s dup..." lap0 lap0 lap0)))
+                 "  %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0)))
            ;;
            ;; unbind-N unbind-M  -->  unbind-(N+M)
            ;;
            ;;
            ;; unbind-N unbind-M  -->  unbind-(N+M)
            ;;
@@ -1752,7 +2009,7 @@ may generate incorrect code.")
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)
 
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)
 
-(provide 'byte-optimize)
+(provide 'byte-opt)
 
 \f
 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
 
 \f
 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
@@ -1763,10 +2020,10 @@ may generate incorrect code.")
      (assq 'byte-code (symbol-function 'byte-optimize-form))
      (let ((byte-optimize nil)
           (byte-compile-warnings nil))
      (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)))
+       (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-form
                 byte-optimize-body
                 byte-optimize-predicate
@@ -1776,4 +2033,5 @@ may generate incorrect code.")
                 byte-optimize-lapcode))))
  nil)
 
                 byte-optimize-lapcode))))
  nil)
 
+;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1
 ;;; byte-opt.el ends here
 ;;; byte-opt.el ends here