diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 258 |
1 files changed, 154 insertions, 104 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b9c864a6792..3e3bfe2a074 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,6 +1,6 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code -;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, 2003 +;; Copyright (C) 1985,86,87,92,94,1998,2000,01,02,03,2004 ;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> @@ -8,10 +8,6 @@ ;; Maintainer: FSF ;; Keywords: lisp -;;; This version incorporates changes up to version 2.10 of the -;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.134 $") - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -75,7 +71,7 @@ ;; User customization variables: ;; ;; byte-compile-verbose Whether to report the function currently being -;; compiled in the minibuffer; +;; compiled in the echo area; ;; byte-optimize Whether to do optimizations; this may be ;; t, nil, 'source, or 'byte; ;; byte-optimize-log Whether to report (in excruciating detail) @@ -130,7 +126,7 @@ ;; (baz 0)) ;; ;; o It is possible to open-code a function in the same file it is defined -;; in without having to load that file before compiling it. the +;; in without having to load that file before compiling it. The ;; byte-compiler has been modified to remember function definitions in ;; the compilation environment in the same way that it remembers macro ;; definitions. @@ -251,7 +247,9 @@ if you change this variable." :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 :type 'boolean) @@ -351,6 +349,9 @@ Elements of the list may be be: (const callargs) (const redefine) (const obsolete) (const noruntime) (const cl-functions)))) +(defvar byte-compile-not-obsolete-var nil + "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. This records functions were called and from where. @@ -441,6 +442,11 @@ Each element looks like (FUNCTIONNAME . DEFINITION). It is Used for warnings when the function is not known to be defined or is later defined with incorrect args.") +(defvar byte-compile-noruntime-functions nil + "Alist of functions called that may not be defined when the compiled code is run. +Used for warnings about calling a function that is defined during compilation +but won't necessarily be defined when the compiled file is loaded.") + (defvar byte-compile-tag-number 0) (defvar byte-compile-output nil "Alist describing contents to put in byte code string. @@ -773,7 +779,7 @@ otherwise pop it") (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. -Each function's symbol gets marked with the `byte-compile-noruntime' property." +Each function's symbol gets added to `byte-compile-noruntime-functions'." (let ((hist-orig load-history) (hist-nil-orig current-load-list)) (prog1 (eval form) @@ -791,17 +797,17 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (cond ((symbolp s) (unless (memq s old-autoloads) - (put s 'byte-compile-noruntime t))) + (push s byte-compile-noruntime-functions))) ((and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)) ((and (consp s) (eq 'autoload (car s))) - (put (cdr s) 'byte-compile-noruntime t))))))) + (push (cdr s) byte-compile-noruntime-functions))))))) ;; Go through current-load-list for the locally defined funs. (let (old-autoloads) (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) (let ((s (pop hist-nil-new))) (when (and (symbolp s) (not (memq s old-autoloads))) - (put s 'byte-compile-noruntime t)) + (push s byte-compile-noruntime-functions)) (when (and (consp s) (eq t (car s))) (push (cdr s) old-autoloads)))))))))) @@ -926,7 +932,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (when (or (and byte-compile-current-file (not (equal byte-compile-current-file byte-compile-last-logged-file))) - (and byte-compile-last-warned-form + (and byte-compile-current-form (not (eq byte-compile-current-form byte-compile-last-warned-form)))) (insert (format "\nIn %s:\n" form))) @@ -972,7 +978,8 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (setq default-directory dir) (unless was-same (insert (format "Entering directory `%s'\n" default-directory)))) - (setq byte-compile-last-logged-file byte-compile-current-file) + (setq byte-compile-last-logged-file byte-compile-current-file + byte-compile-last-warned-form nil) ;; Do this after setting default-directory. (unless (eq major-mode 'compilation-mode) (compilation-mode)) @@ -982,7 +989,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." ;; Also log the current function and file if not already done. (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) - (warning-group-format "") + (warning-type-format "") (warning-fill-prefix (if fill " "))) (display-warning 'bytecomp string level "*Compile-Log*"))) @@ -1166,10 +1173,11 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." "requires" "accepts only") (byte-compile-arglist-signature-string sig)))) + (byte-compile-format-warn form) ;; Check to see if the function will be available at runtime ;; and/or remember its arity if it's unknown. (or (and (or sig (fboundp (car form))) ; might be a subr or autoload. - (not (get (car form) 'byte-compile-noruntime))) + (not (memq (car form) byte-compile-noruntime-functions))) (eq (car form) byte-compile-current-form) ; ## this doesn't work ; with recursion. ;; It's a currently-undefined function. @@ -1183,6 +1191,32 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (cons (list (car form) n) byte-compile-unresolved-functions))))))) +(defun byte-compile-format-warn (form) + "Warn if FORM is `format'-like with inconsistent args. +Applies if head of FORM is a symbol with non-nil property +`byte-compile-format-like' and first arg is a constant string. +Then check the number of format fields matches the number of +extra args." + (when (and (symbolp (car form)) + (stringp (nth 1 form)) + (get (car form) 'byte-compile-format-like)) + (let ((nfields (with-temp-buffer + (insert (nth 1 form)) + (goto-char 1) + (let ((n 0)) + (while (re-search-forward "%." nil t) + (unless (eq ?% (char-after (1+ (match-beginning 0)))) + (setq n (1+ n)))) + n))) + (nargs (- (length form) 2))) + (unless (= nargs nfields) + (byte-compile-warn + "`%s' called with %d args to fill %d format field(s)" (car form) + nargs nfields))))) + +(dolist (elt '(format message error)) + (put elt 'byte-compile-format-like t)) + ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) @@ -1250,7 +1284,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property." (let ((func (car-safe form))) (if (and byte-compile-cl-functions (memq func byte-compile-cl-functions) - ;; Aliases which won't have been expended at this point. + ;; Aliases which won't have been expanded at this point. ;; These aren't all aliases of subrs, so not trivial to ;; avoid hardwiring the list. (not (memq func @@ -1455,7 +1489,8 @@ recompile every `.el' file that already has a `.elc' file." source dest) (dolist (file files) (setq source (expand-file-name file directory)) - (if (and (not (member file '("." ".." "RCS" "CVS"))) + (if (and (not (member file '("RCS" "CVS"))) + (not (eq ?\. (aref file 0))) (file-directory-p source) (not (file-symlink-p source))) ;; This file is a subdirectory. Handle them differently. @@ -1573,11 +1608,14 @@ The value is non-nil if there were no errors, nil if errors." ;; compile this file. (if (with-current-buffer input-buffer no-byte-compile) (progn - (message "%s not compiled because of `no-byte-compile: %s'" - (file-relative-name filename) - (with-current-buffer input-buffer no-byte-compile)) - (if (file-exists-p target-file) - (condition-case nil (delete-file target-file) (error nil))) + ;; (message "%s not compiled because of `no-byte-compile: %s'" + ;; (file-relative-name filename) + ;; (with-current-buffer input-buffer no-byte-compile)) + (when (file-exists-p target-file) + (message "%s deleted because of `no-byte-compile: %s'" + (file-relative-name target-file) + (buffer-local-value 'no-byte-compile input-buffer)) + (condition-case nil (delete-file target-file) (error nil))) ;; We successfully didn't compile this file. 'no-byte-compile) (when byte-compile-verbose @@ -1654,7 +1692,7 @@ The value is non-nil if there were no errors, nil if errors." ;;;###autoload (defun compile-defun (&optional arg) "Compile and evaluate the current top-level form. -Print the result in the minibuffer. +Print the result in the echo area. With argument, insert value in current buffer after the form." (interactive "P") (save-excursion @@ -1818,10 +1856,7 @@ With argument, insert value in current buffer after the form." " on " (current-time-string) "\n;;; from file " filename "\n") (insert ";;; in Emacs version " emacs-version "\n") - (insert ";;; with bytecomp version " - (progn (string-match "[0-9.]+" byte-compile-version) - (match-string 0 byte-compile-version)) - "\n;;; " + (insert ";;; " (cond ((eq byte-optimize 'source) "with source-level optimization only") ((eq byte-optimize 'byte) "with byte-level optimization only") @@ -2449,17 +2484,19 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (cdr (cdr int)) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))) - ;; If the interactive spec is a call to `list', - ;; don't compile it, because `call-interactively' - ;; looks at the args of `list'. + ;; If the interactive spec is a call to `list', don't + ;; compile it, because `call-interactively' looks at the + ;; args of `list'. Actually, compile it to get warnings, + ;; but don't use the result. (let ((form (nth 1 int))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (or (eq (car-safe form) 'list) - (setq int (list 'interactive - (byte-compile-top-level (nth 1 int))))))) + (if (eq (car-safe form) 'list) + (byte-compile-top-level (nth 1 int)) + (setq int (list 'interactive + (byte-compile-top-level (nth 1 int))))))) ((cdr int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string int))))) @@ -2705,7 +2742,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (symbolp var) "constant" "nonvariable") (prin1-to-string var)) (if (and (get var 'byte-obsolete-variable) - (memq 'obsolete byte-compile-warnings)) + (memq 'obsolete byte-compile-warnings) + (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 @@ -2735,7 +2773,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (defmacro byte-compile-get-constant (const) `(or (if (stringp ,const) - (assoc ,const byte-compile-constants) + (assoc-default ,const byte-compile-constants + 'equal-including-properties nil) (assq ,const byte-compile-constants)) (car (setq byte-compile-constants (cons (list ,const) byte-compile-constants))))) @@ -3262,51 +3301,55 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop)) ,tag)) +(defmacro byte-compile-maybe-guarded (condition &rest body) + "Execute forms in BODY, potentially guarded by CONDITION. +CONDITION is the test in an `if' form or in a `cond' clause. +BODY is to compile the first arm of the if or the body of the +cond clause. If CONDITION is of the form `(foundp 'foo)' +or `(boundp 'foo)', the relevant warnings from BODY about foo +being undefined will be suppressed." + (declare (indent 1) (debug t)) + `(let* ((fbound + (if (eq 'fboundp (car-safe ,condition)) + (and (eq 'quote (car-safe (nth 1 ,condition))) + ;; Ignore if the symbol is already on the + ;; unresolved list. + (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol + byte-compile-unresolved-functions)) + (nth 1 (nth 1 ,condition))))) + (bound (if (or (eq 'boundp (car-safe ,condition)) + (eq 'default-boundp (car-safe ,condition))) + (and (eq 'quote (car-safe (nth 1 ,condition))) + (nth 1 (nth 1 ,condition))))) + ;; Maybe add to the bound list. + (byte-compile-bound-variables + (if bound + (cons bound byte-compile-bound-variables) + byte-compile-bound-variables))) + (progn ,@body) + ;; Maybe remove the function symbol from the unresolved list. + (if fbound + (setq byte-compile-unresolved-functions + (delq (assq fbound byte-compile-unresolved-functions) + byte-compile-unresolved-functions))))) + (defun byte-compile-if (form) (byte-compile-form (car (cdr form))) ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' ;; and avoid warnings about the relevent symbols in the consequent. - (let* ((clause (nth 1 form)) - (fbound (if (eq 'fboundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - ;; Ignore if the symbol is already on the - ;; unresolved list. - (not (assq - (nth 1 (nth 1 clause)) ; the relevant symbol - byte-compile-unresolved-functions)) - (nth 1 (nth 1 clause))))) - (bound (if (eq 'boundp (car-safe clause)) - (and (eq 'quote (car-safe (nth 1 clause))) - (nth 1 (nth 1 clause))))) - (donetag (byte-compile-make-tag))) + (let ((clause (nth 1 form)) + (donetag (byte-compile-make-tag))) (if (null (nthcdr 3 form)) ;; No else-forms (progn (byte-compile-goto-if nil for-effect donetag) - ;; Maybe add to the bound list. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) + (byte-compile-maybe-guarded clause (byte-compile-form (nth 2 form) for-effect)) - ;; Maybe remove the function symbol from the unresolved list. - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) (byte-compile-out-tag donetag)) (let ((elsetag (byte-compile-make-tag))) (byte-compile-goto 'byte-goto-if-nil elsetag) - ;; As above for the first form. - (let ((byte-compile-bound-variables - (if bound - (cons bound byte-compile-bound-variables) - byte-compile-bound-variables))) - (byte-compile-form (nth 2 form) for-effect)) - (if fbound - (setq byte-compile-unresolved-functions - (delq (assq fbound byte-compile-unresolved-functions) - byte-compile-unresolved-functions))) + (byte-compile-maybe-guarded clause + (byte-compile-form (nth 2 form) for-effect)) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag elsetag) (byte-compile-body (cdr (cdr (cdr form))) for-effect) @@ -3329,17 +3372,20 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (null (cdr clause)) ;; First clause is a singleton. (byte-compile-goto-if t for-effect donetag) - (setq nexttag (byte-compile-make-tag)) - (byte-compile-goto 'byte-goto-if-nil nexttag) - (byte-compile-body (cdr clause) for-effect) - (byte-compile-goto 'byte-goto donetag) - (byte-compile-out-tag nexttag))))) + (setq nexttag (byte-compile-make-tag)) + (byte-compile-goto 'byte-goto-if-nil nexttag) + (byte-compile-maybe-guarded (car clause) + (byte-compile-body (cdr clause) for-effect)) + (byte-compile-goto 'byte-goto donetag) + (byte-compile-out-tag nexttag))))) ;; Last clause - (and (cdr clause) (not (eq (car clause) t)) - (progn (byte-compile-form (car clause)) - (byte-compile-goto-if nil for-effect donetag) - (setq clause (cdr clause)))) - (byte-compile-body-do-effect clause) + (let ((guard (car clause))) + (and (cdr clause) (not (eq guard t)) + (progn (byte-compile-form guard) + (byte-compile-goto-if nil for-effect donetag) + (setq clause (cdr clause)))) + (byte-compile-maybe-guarded guard + (byte-compile-body-do-effect clause))) (byte-compile-out-tag donetag))) (defun byte-compile-and (form) @@ -3610,13 +3656,14 @@ If FORM is a lambda or a macro, byte-compile it as a function." fun var string)) `(put ',var 'variable-documentation ,string)) (if (cddr form) ; `value' provided - (if (eq fun 'defconst) - ;; `defconst' sets `var' unconditionally. - (let ((tmp (make-symbol "defconst-tmp-var"))) - `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) - ,value)) - ;; `defvar' sets `var' only when unbound. - `(if (not (default-boundp ',var)) (setq-default ,var ,value))) + (let ((byte-compile-not-obsolete-var var)) + (if (eq fun 'defconst) + ;; `defconst' sets `var' unconditionally. + (let ((tmp (make-symbol "defconst-tmp-var"))) + `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) + ,value)) + ;; `defvar' sets `var' only when unbound. + `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) (when (eq fun 'defconst) ;; This will signal an appropriate error at runtime. `(eval ',form))) @@ -3921,27 +3968,29 @@ already up-to-date." (kill-emacs (if error 1 0)))) (defun batch-byte-compile-file (file) - (condition-case err + (if debug-on-error (byte-compile-file file) - (file-error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" + (condition-case err + (byte-compile-file file) + (file-error + (message (if (cdr err) + ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) - (let ((destfile (byte-compile-dest-file file))) - (if (file-exists-p destfile) - (delete-file destfile))) - nil) - (error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" + file + (get (car err) 'error-message) + (prin1-to-string (cdr err))) + (let ((destfile (byte-compile-dest-file file))) + (if (file-exists-p destfile) + (delete-file destfile))) + nil) + (error + (message (if (cdr err) + ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) - nil))) + file + (get (car err) 'error-message) + (prin1-to-string (cdr err))) + nil)))) ;;;###autoload (defun batch-byte-recompile-directory () @@ -4036,4 +4085,5 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'." (run-hooks 'bytecomp-load-hook) +;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a ;;; bytecomp.el ends here |