1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00

(byte-compile-compatibility): Doc fix.

(byte-compile-format-warn): New.
(byte-compile-callargs-warn): Use it.
(Format, message, error): Add byte-compile-format-like property.
(byte-compile-maybe-guarded): New.
(byte-compile-if, byte-compile-cond): Use it.
(byte-compile-lambda): Compile interactive forms, just to make
warnings about them.
This commit is contained in:
Richard M. Stallman 2004-01-29 17:58:16 +00:00
parent 750e563f99
commit ab43c85050
2 changed files with 123 additions and 53 deletions

View file

@ -1,3 +1,31 @@
2004-01-29 Tue Jari Aalto <jari.aalto <AT> poboxes.com>
* progmodes/executable.el (executable-command-find-posix-p):
New. Check if find handles arguments Posix-style.
* progmodes/grep.el (grep-compute-defaults):
Use executable-command-find-posix-p.
(grep-find): Check `grep-find-command'.
* filecache.el (file-cache-find-posix-p): Deleted.
(file-cache-add-directory-using-find):
Use `executable-command-find-posix-p'
2004-01-29 Dave Love <fx@gnu.org>
* emacs-lisp/lisp.el (beginning-of-defun-raw, end-of-defun):
Iterate the hook function if arg is given.
(mark-defun, narrow-to-defun): Change order of finding the limits.
* emacs-lisp/bytecomp.el (byte-compile-compatibility): Doc fix.
(byte-compile-format-warn): New.
(byte-compile-callargs-warn): Use it.
(Format, message, error): Add byte-compile-format-like property.
(byte-compile-maybe-guarded): New.
(byte-compile-if, byte-compile-cond): Use it.
(byte-compile-lambda): Compile interactive forms,
just to make warnings about them.
2004-01-29 Jonathan Yavner <jyavner@member.fsf.org> 2004-01-29 Jonathan Yavner <jyavner@member.fsf.org>
* ses.el (ses-initial-column-width): Increase to 14, so it will * ses.el (ses-initial-column-width): Increase to 14, so it will

View file

@ -10,7 +10,7 @@
;;; This version incorporates changes up to version 2.10 of the ;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler. ;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.140 $") (defconst byte-compile-version "$Revision: 2.141 $")
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -251,7 +251,9 @@ if you change this variable."
:type 'boolean) :type 'boolean)
(defcustom byte-compile-compatibility nil (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 :group 'bytecomp
:type 'boolean) :type 'boolean)
@ -444,6 +446,11 @@ Each element looks like (FUNCTIONNAME . DEFINITION). It is
Used for warnings when the function is not known to be defined or is later Used for warnings when the function is not known to be defined or is later
defined with incorrect args.") 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-tag-number 0)
(defvar byte-compile-output nil (defvar byte-compile-output nil
"Alist describing contents to put in byte code string. "Alist describing contents to put in byte code string.
@ -776,7 +783,7 @@ otherwise pop it")
(defun byte-compile-eval (form) (defun byte-compile-eval (form)
"Eval FORM and mark the functions defined therein. "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) (let ((hist-orig load-history)
(hist-nil-orig current-load-list)) (hist-nil-orig current-load-list))
(prog1 (eval form) (prog1 (eval form)
@ -794,17 +801,17 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
(cond (cond
((symbolp s) ((symbolp s)
(unless (memq s old-autoloads) (unless (memq s old-autoloads)
(put s 'byte-compile-noruntime t))) (push s byte-compile-noruntime-functions)))
((and (consp s) (eq t (car s))) ((and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)) (push (cdr s) old-autoloads))
((and (consp s) (eq 'autoload (car s))) ((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. ;; Go through current-load-list for the locally defined funs.
(let (old-autoloads) (let (old-autoloads)
(while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
(let ((s (pop hist-nil-new))) (let ((s (pop hist-nil-new)))
(when (and (symbolp s) (not (memq s old-autoloads))) (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))) (when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))))) (push (cdr s) old-autoloads))))))))))
@ -1170,10 +1177,11 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
"requires" "requires"
"accepts only") "accepts only")
(byte-compile-arglist-signature-string sig)))) (byte-compile-arglist-signature-string sig))))
(byte-compile-format-warn form)
;; Check to see if the function will be available at runtime ;; Check to see if the function will be available at runtime
;; and/or remember its arity if it's unknown. ;; and/or remember its arity if it's unknown.
(or (and (or sig (fboundp (car form))) ; might be a subr or autoload. (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 (eq (car form) byte-compile-current-form) ; ## this doesn't work
; with recursion. ; with recursion.
;; It's a currently-undefined function. ;; It's a currently-undefined function.
@ -1187,6 +1195,32 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
(cons (list (car form) n) (cons (list (car form) n)
byte-compile-unresolved-functions))))))) 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 ;; Warn if the function or macro is being redefined with a different
;; number of arguments. ;; number of arguments.
(defun byte-compile-arglist-warn (form macrop) (defun byte-compile-arglist-warn (form macrop)
@ -1254,7 +1288,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
(let ((func (car-safe form))) (let ((func (car-safe form)))
(if (and byte-compile-cl-functions (if (and byte-compile-cl-functions
(memq func 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 ;; These aren't all aliases of subrs, so not trivial to
;; avoid hardwiring the list. ;; avoid hardwiring the list.
(not (memq func (not (memq func
@ -2453,17 +2487,19 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (cdr (cdr int)) (if (cdr (cdr int))
(byte-compile-warn "malformed interactive spec: %s" (byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int))) (prin1-to-string int)))
;; If the interactive spec is a call to `list', ;; If the interactive spec is a call to `list', don't
;; don't compile it, because `call-interactively' ;; compile it, because `call-interactively' looks at the
;; looks at the args of `list'. ;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
(let ((form (nth 1 int))) (let ((form (nth 1 int)))
(while (memq (car-safe form) '(let let* progn save-excursion)) (while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form)) (while (consp (cdr form))
(setq form (cdr form))) (setq form (cdr form)))
(setq form (car form))) (setq form (car form)))
(or (eq (car-safe form) 'list) (if (eq (car-safe form) 'list)
(setq int (list 'interactive (byte-compile-top-level (nth 1 int))
(byte-compile-top-level (nth 1 int))))))) (setq int (list 'interactive
(byte-compile-top-level (nth 1 int)))))))
((cdr int) ((cdr int)
(byte-compile-warn "malformed interactive spec: %s" (byte-compile-warn "malformed interactive spec: %s"
(prin1-to-string int))))) (prin1-to-string int)))))
@ -3265,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)) (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag)) ,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) (defun byte-compile-if (form)
(byte-compile-form (car (cdr form))) (byte-compile-form (car (cdr form)))
;; Check whether we have `(if (fboundp ...' or `(if (boundp ...' ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
;; and avoid warnings about the relevent symbols in the consequent. ;; and avoid warnings about the relevent symbols in the consequent.
(let* ((clause (nth 1 form)) (let ((clause (nth 1 form))
(fbound (if (eq 'fboundp (car-safe clause)) (donetag (byte-compile-make-tag)))
(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)))
(if (null (nthcdr 3 form)) (if (null (nthcdr 3 form))
;; No else-forms ;; No else-forms
(progn (progn
(byte-compile-goto-if nil for-effect donetag) (byte-compile-goto-if nil for-effect donetag)
;; Maybe add to the bound list. (byte-compile-maybe-guarded clause
(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)) (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)) (byte-compile-out-tag donetag))
(let ((elsetag (byte-compile-make-tag))) (let ((elsetag (byte-compile-make-tag)))
(byte-compile-goto 'byte-goto-if-nil elsetag) (byte-compile-goto 'byte-goto-if-nil elsetag)
;; As above for the first form. (byte-compile-maybe-guarded clause
(let ((byte-compile-bound-variables (byte-compile-form (nth 2 form) for-effect))
(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-goto 'byte-goto donetag) (byte-compile-goto 'byte-goto donetag)
(byte-compile-out-tag elsetag) (byte-compile-out-tag elsetag)
(byte-compile-body (cdr (cdr (cdr form))) for-effect) (byte-compile-body (cdr (cdr (cdr form))) for-effect)
@ -3332,14 +3372,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(if (null (cdr clause)) (if (null (cdr clause))
;; First clause is a singleton. ;; First clause is a singleton.
(byte-compile-goto-if t for-effect donetag) (byte-compile-goto-if t for-effect donetag)
(setq nexttag (byte-compile-make-tag)) (setq nexttag (byte-compile-make-tag))
(byte-compile-goto 'byte-goto-if-nil nexttag) (byte-compile-goto 'byte-goto-if-nil nexttag)
(byte-compile-body (cdr clause) for-effect) (byte-compile-maybe-guarded (car clause)
(byte-compile-goto 'byte-goto donetag) (byte-compile-body (cdr clause) for-effect))
(byte-compile-out-tag nexttag))))) (byte-compile-goto 'byte-goto donetag)
(byte-compile-out-tag nexttag)))))
;; Last clause ;; Last clause
(and (cdr clause) (not (eq (car clause) t)) (and (cdr clause) (not (eq (car clause) t))
(progn (byte-compile-form (car clause)) (progn (byte-compile-maybe-guarded (car clause)
(byte-compile-form (car clause)))
(byte-compile-goto-if nil for-effect donetag) (byte-compile-goto-if nil for-effect donetag)
(setq clause (cdr clause)))) (setq clause (cdr clause))))
(byte-compile-body-do-effect clause) (byte-compile-body-do-effect clause)