;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
"Emacs Lisp byte-compiler."
:group 'lisp)
-(defcustom emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
- "\\.EL\\(;[0-9]+\\)?$"
- "\\.el$")
- "*Regexp which matches Emacs Lisp source files.
+(defcustom emacs-lisp-file-regexp "\\.el\\'"
+ "Regexp which matches Emacs Lisp source files.
You may want to redefine the function `byte-compile-dest-file'
if you change this variable."
:group 'bytecomp
with the extension `.el'), add `c' to it; otherwise add `.elc'."
(setq filename (byte-compiler-base-file-name filename))
(setq filename (file-name-sans-versions filename))
- (cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
+ (cond ((string-match emacs-lisp-file-regexp filename)
(concat (substring filename 0 (match-beginning 0)) ".elc"))
(t (concat filename ".elc")))))
(defcustom byte-compile-verbose
(and (not noninteractive) (> baud-rate search-slow-speed))
- "*Non-nil means print messages describing progress of byte-compiler."
+ "Non-nil means print messages describing progress of byte-compiler."
:group 'bytecomp
:type 'boolean)
(defcustom byte-compile-compatibility nil
- "*Non-nil means generate output that can run in Emacs 18.
+ "Non-nil means generate output that can run in Emacs 18.
This only means that it can run in principle, if it doesn't require
facilities that have been added more recently."
:group 'bytecomp
;; this way can never be run in Emacs 18, and may even cause it to crash.")
(defcustom byte-optimize t
- "*Enable optimization in the byte compiler.
+ "Enable optimization in the byte compiler.
Possible values are:
nil - no optimization
t - all optimizations
(const :tag "byte-level" byte)))
(defcustom byte-compile-delete-errors nil
- "*If non-nil, the optimizer may delete forms that may signal an error.
+ "If non-nil, the optimizer may delete forms that may signal an error.
This includes variable references and calls to functions such as `car'."
:group 'bytecomp
:type 'boolean)
;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
(defcustom byte-compile-dynamic-docstrings t
- "*If non-nil, compile doc strings for lazy access.
-We bury the doc strings of functions and variables
-inside comments in the file, and bring them into core only when they
-are actually needed.
+ "If non-nil, compile doc strings for lazy access.
+We bury the doc strings of functions and variables inside comments in
+the file, and bring them into core only when they are actually needed.
When this option is true, if you load the compiled file and then move it,
you won't be able to find the documentation of anything in that file.
;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
(defcustom byte-optimize-log nil
- "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
+ "If true, the byte-compiler will log its optimizations into *Compile-Log*.
If this is 'source, then only source-level optimizations will be logged.
If it is 'byte, then only byte-level optimizations will be logged."
:group 'bytecomp
(const :tag "byte-level" byte)))
(defcustom byte-compile-error-on-warn nil
- "*If true, the byte-compiler reports warnings with `error'."
+ "If true, the byte-compiler reports warnings with `error'."
:group 'bytecomp
:type 'boolean)
make-local mapcar)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
- "*List of warnings that the byte-compiler should issue (t for all).
+ "List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be:
;;;###autoload
(defun byte-compile-warnings-safe-p (x)
+ "Return non-nil if X is valid as a value of `byte-compile-warnings'."
(or (booleanp x)
(and (listp x)
(if (eq (car x) 'not) (setq x (cdr x))
t)
(equal (mapcar
(lambda (e)
- (when (memq e '(free-vars unresolved
- callargs redefine
- obsolete noruntime
- cl-functions interactive-only
- make-local mapcar))
+ (when (memq e byte-compile-warning-types)
e))
x)
x))))
"If non-nil, this is a variable that shouldn't be reported as obsolete.")
(defcustom byte-compile-generate-call-tree nil
- "*Non-nil means collect call-graph information when compiling.
+ "Non-nil means collect call-graph information when compiling.
This records which functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.
If the value is neither t nor nil, compilation asks you whether to display
:type '(choice (const :tag "Yes" t) (const :tag "No" nil)
(other :tag "Ask" lambda)))
-(defvar byte-compile-call-tree nil "Alist of functions and their call tree.
+(defvar byte-compile-call-tree nil
+ "Alist of functions and their call tree.
Each element looks like
\(FUNCTION CALLERS CALLS\)
FUNCTION.")
(defcustom byte-compile-call-tree-sort 'name
- "*If non-nil, sort the call tree.
+ "If non-nil, sort the call tree.
The values `name', `callers', `calls', `calls+callers'
specify different fields to sort on."
:group 'bytecomp
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-group nil)
(defvar byte-compile-current-buffer nil)
;; Log something that isn't a warning.
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
+(defun byte-compile-warn-obsolete (symbol)
+ "Warn that SYMBOL (a variable or function) is obsolete."
+ (when (byte-compile-warning-enabled-p 'obsolete)
+ (let* ((funcp (get symbol 'byte-obsolete-info))
+ (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
+ (instead (car obsolete))
+ (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+ (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
+ (if funcp "function" "variable")
+ (if asof (concat " (as of Emacs " asof ")") "")
+ (cond ((stringp instead)
+ (concat "; " instead))
+ (instead
+ (format "; use `%s' instead." instead))
+ (t "."))))))
+
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
(setq byte-compiler-error-flag t)
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
- (let* ((new (get (car form) 'byte-obsolete-info))
- (handler (nth 1 new))
- (when (nth 2 new)))
- (byte-compile-set-symbol-position (car form))
- (if (byte-compile-warning-enabled-p 'obsolete)
- (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car new))
- (car new)
- (format "use `%s' instead." (car new)))))
- (funcall (or handler 'byte-compile-normal-call) form)))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-warn-obsolete (car form))
+ (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
+ 'byte-compile-normal-call) form))
\f
;; Compiler options
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
- (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
- (or (not (eq (car-safe name) 'quote))
+ (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
+ byte-compile-current-group)
+ ;; The group will be provided implicitly.
+ nil
+ (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+ (name (cadr form)))
+ (or (not (eq (car-safe name) 'quote))
(and (eq (car form) 'custom-declare-group)
(equal name ''emacs))
(plist-get keyword-args :group)
(byte-compile-warn
"%s for `%s' fails to specify containing group"
(cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))))
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))
+ ;; Update the current group, if needed.
+ (if (and byte-compile-current-file ;Only when byte-compiling a whole file.
+ (eq (car form) 'custom-declare-group)
+ (eq (car-safe name) 'quote))
+ (setq byte-compile-current-group (cadr name))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(when (and (stringp (car elt))
(string-match
"^cl\\>" (file-name-nondirectory (car elt))))
- (setq byte-compile-cl-functions
- (append byte-compile-cl-functions
- (cdr elt)))))
- (let ((tail byte-compile-cl-functions))
- (while tail
- (if (and (consp (car tail))
- (eq (car (car tail)) 'autoload))
- (setcar tail (cdr (car tail))))
- (setq tail (cdr tail))))))
+ (dolist (e (cdr elt))
+ (when (memq (car-safe e) '(autoload defun))
+ (push (cdr e) byte-compile-cl-functions)))))))
(defun byte-compile-cl-warn (form)
"Warn if FORM is a call of a function from the CL package."
(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
bytecomp-force)
"Recompile every `.el' file in BYTECOMP-DIRECTORY that needs recompilation.
-This is if a `.elc' file exists but is older than the `.el' file.
+This happens when a `.elc' file exists but is older than the `.el' file.
Files in subdirectories of BYTECOMP-DIRECTORY are processed also.
If the `.elc' file does not exist, normally this function *does not*
(format " in %d directories" dir-count) "")))))
(defvar no-byte-compile nil
- "Non-nil to prevent byte-compiling of emacs-lisp code.
+ "Non-nil to prevent byte-compiling of Emacs Lisp code.
This is normally set in local file variables at the end of the elisp file:
;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
(defun byte-compile-file (bytecomp-filename &optional load)
"Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code.
The output file's name is generated by passing BYTECOMP-FILENAME to the
-`byte-compile-dest-file' function (which see).
+function `byte-compile-dest-file' (which see).
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors."
;; (interactive "fByte compile file: \nP")
;; Force logging of the file name for each file compiled.
(setq byte-compile-last-logged-file nil)
(let ((byte-compile-current-file bytecomp-filename)
+ (byte-compile-current-group nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (let ((vms-stmlf-recfm t))
(if (file-writable-p target-file)
;; We must disable any code conversion here.
(let ((coding-system-for-write 'no-conversion))
(if (file-exists-p target-file)
"cannot overwrite file"
"directory not writable or nonexistent")
- target-file))))
+ target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
(defun compile-defun (&optional arg)
"Compile and evaluate the current top-level form.
Print the result in the echo area.
-With argument, insert value in current buffer after the form."
+With argument ARG, insert value in current buffer after the form."
(interactive "P")
(save-excursion
(end-of-defun)
before INFO and the FORM but after the doc string itself.
If SPECINDEX is non-nil, it is the index in FORM
of the function bytecode string. In that case,
-we output that argument and the following argument (the constants vector)
-together, for lazy loading.
+we output that argument and the following argument
+\(the constants vector) together, for lazy loading.
QUOTED says that we have to put a quote before the
list that represents a doc string reference.
`autoload' and `custom-declare-variable' need that."
(t "variable reference to %s `%s'"))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
- (if (and (get var 'byte-obsolete-variable)
- (byte-compile-warning-enabled-p 'obsolete)
- (not (eq var byte-compile-not-obsolete-var)))
- (let* ((ob (get var 'byte-obsolete-variable))
- (when (cdr ob)))
- (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car ob))
- (car ob)
- (format "use `%s' instead." (car ob))))))
+ (and (get var 'byte-obsolete-variable)
+ (not (eq var byte-compile-not-obsolete-var))
+ (byte-compile-warn-obsolete var))
(if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(defun byte-compile-associative (form)
(if (cdr form)
(let ((opcode (get (car form) 'byte-opcode))
- (args (copy-sequence (cdr form))))
- (byte-compile-form (car args))
- (setq args (cdr args))
- (or args (setq args '(0)
- opcode (get '+ 'byte-opcode)))
- (dolist (arg args)
- (byte-compile-form arg)
- (byte-compile-out opcode 0)))
+ args)
+ (if (and (< 3 (length form))
+ (memq opcode (list (get '+ 'byte-opcode)
+ (get '* 'byte-opcode))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)
+ (setq args (copy-sequence (cdr form)))
+ (byte-compile-form (car args))
+ (setq args (cdr args))
+ (or args (setq args '(0)
+ opcode (get '+ 'byte-opcode)))
+ (dolist (arg args)
+ (byte-compile-form arg)
+ (byte-compile-out opcode 0))))
(byte-compile-constant (eval form))))
\f
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
- (if (null (setq form (cdr form)))
- (byte-compile-constant 0)
- (byte-compile-form (car form))
- (if (cdr form)
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-diff 0))
- (byte-compile-out 'byte-negate 0))))
+ (let ((len (length form)))
+ (cond
+ ((= 1 len) (byte-compile-constant 0))
+ ((= 2 len)
+ (byte-compile-form (cadr form))
+ (byte-compile-out 'byte-negate 0))
+ ((= 3 len)
+ (byte-compile-form (nth 1 form))
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out 'byte-diff 0))
+ ;; Don't use binary operations for > 2 operands, as that may
+ ;; cause overflow/truncation in float operations.
+ (t (byte-compile-normal-call form)))))
(defun byte-compile-quo (form)
(let ((len (length form)))
(cond ((<= len 2)
(byte-compile-subr-wrong-args form "2 or more"))
+ ((= len 3)
+ (byte-compile-two-args form))
(t
- (byte-compile-form (car (setq form (cdr form))))
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-quo 0))))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)))))
(defun byte-compile-nconc (form)
(let ((len (length form)))
(defmacro byte-compile-maybe-guarded (condition &rest body)
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
-BODY is the code to compile first arm of the if or the body of the
-cond clause. If CONDITION's value is of the form (fboundp 'foo)
+BODY is the code to compile in the first arm of the if or the body of
+the cond clause. If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
being undefined will be suppressed.