comparison lisp/emacs-lisp/bytecomp.el @ 105806:83e7d269fc49

(byte-compile-warning-types, byte-compile-warnings): Add `constants' as an option. (byte-compile-callargs-warn, byte-compile-arglist-warn) (display-call-tree): Update for byte-compile-fdefinition possibly returning `(macro lambda ...)'. (Bug#4778) (byte-compile-variable-ref, byte-compile-setq-default): Respect `constants' member of byte-compile-warnings.

105805:d29fa94d860d

;;    - various syntax errors;
;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
;;  + correct compilation of top-level uses of macros;
;;  + the ability to generate a histogram of functions called.

;; User customization variables:
;;
;; byte-compile-verbose	Whether to report the function currently being
;;				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)
;;				exactly which optimizations have been made.
;;				This may be t, nil, 'source, or 'byte;
;; byte-compile-error-on-warn	Whether to stop compilation when a warning is
;;				produced;
;; byte-compile-delete-errors	Whether the optimizer may delete calls or
;;				variable references that are side-effect-free
;;				except that they may return an error.
;; byte-compile-generate-call-tree	Whether to generate a histogram of
;;				function calls.  This can be useful for
;;				finding unused functions, as well as simple
;;				performance metering.
;; byte-compile-warnings	List of warnings to issue, or t.  May contain
;;				`free-vars' (references to variables not in the
;;					     current lexical scope)
;;				`unresolved' (calls to unknown functions)
;;				`callargs'  (lambda calls with args that don't
;;					     match the lambda's definition)
;;				`redefine'  (function cell redefined from
;;					     a macro to a lambda or vice versa,
;;					     or redefined to take other args)
;;				`obsolete'  (obsolete variables and functions)
;;				`noruntime' (calls to functions only defined
;;					     within `eval-when-compile')
;;				`cl-functions' (calls to CL functions)
;;				`interactive-only' (calls to commands that are
;;						   not good to call from Lisp)
;;				`make-local' (dubious calls to
;;					      `make-variable-buffer-local')
;;                              `mapcar'     (mapcar called for effect)
;; byte-compile-compatibility	Whether the compiler should
;;				generate .elc files which can be loaded into
;;				generic emacs 18.
;; emacs-lisp-file-regexp	Regexp for the extension of source-files;
;;				see also the function byte-compile-dest-file.

;; New Features:
;;
;;  o	The form `defsubst' is just like `defun', except that the function
;;	generated will be open-coded in compiled code which uses it.  This

  :type 'boolean)

(defconst byte-compile-warning-types
  '(redefine callargs free-vars unresolved
	     obsolete noruntime cl-functions interactive-only
	     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).

Elements of the list may be:

		  distinguished from macros and aliases).
  interactive-only
	      commands that normally shouldn't be called from Lisp code.
  make-local  calls to make-variable-buffer-local that may be incorrect.
  mapcar      mapcar called for effect.

If the list begins with `not', then the remaining elements specify warnings to
suppress.  For example, (not mapcar) will suppress warnings about mapcar."
  :group 'bytecomp
  :type `(choice (const :tag "All" t)
		 (set :menu-tag "Some"
		      (const free-vars) (const unresolved)
		      (const callargs) (const redefine)
		      (const obsolete) (const noruntime)
		      (const cl-functions) (const interactive-only)
		      (const make-local) (const mapcar))))
;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)

;;;###autoload
(defun byte-compile-warnings-safe-p (x)
  "Return non-nil if X is valid as a value of `byte-compile-warnings'."

;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
  (let* ((def (or (byte-compile-fdefinition (car form) nil)
		  (byte-compile-fdefinition (car form) t)))
	 (sig (if (and def (not (eq def t)))
		  (byte-compile-arglist-signature
		   (if (memq (car-safe def) '(declared lambda))
		       (nth 1 def)
		     (if (byte-code-function-p def)
			 (aref def 0)
		       '(&rest def))))
		(if (and (fboundp (car form))
			 (subrp (symbol-function (car form))))
		    (subr-arity (symbol-function (car form))))))
	 (ncall (length (cdr form))))
    ;; Check many or unevalled from subr-arity.

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
    (if (and old (not (eq old t)))
	(let ((sig1 (byte-compile-arglist-signature
		      (if (eq 'lambda (car-safe old))
			  (nth 1 old)
			(if (byte-code-function-p old)
			    (aref old 0)
			  '(&rest def)))))
	      (sig2 (byte-compile-arglist-signature (nth 2 form))))
	  (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
	    (byte-compile-set-symbol-position (nth 1 form))
	    (byte-compile-warn
	     "%s %s used to take %s %s, now takes %s"
	     (if (eq (car form) 'defun) "function" "macro")
	     (nth 1 form)
	     (byte-compile-arglist-signature-string sig1)
	     (if (equal sig1 '(1 . 1)) "argument" "arguments")
	     (byte-compile-arglist-signature-string sig2))))
      ;; This is the first definition.  See if previous calls are compatible.
      (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
	    nums sig min max)
	(if calls
	    (progn

  (when (symbolp bytecomp-var)
    (byte-compile-set-symbol-position bytecomp-var))
  (if (or (not (symbolp bytecomp-var))
	  (byte-compile-const-symbol-p bytecomp-var
				       (not (eq base-op 'byte-varref))))
      (byte-compile-warn
       (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
	     ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
	     (t "variable reference to %s `%s'"))
       (if (symbolp bytecomp-var) "constant" "nonvariable")
       (prin1-to-string bytecomp-var))
    (and (get bytecomp-var 'byte-obsolete-variable)
	 (not (memq bytecomp-var byte-compile-not-obsolete-vars))
	 (byte-compile-warn-obsolete bytecomp-var))
    (if (byte-compile-warning-enabled-p 'free-vars)
	(if (eq base-op 'byte-varbind)

(defun byte-compile-setq-default (form)
  (let ((bytecomp-args (cdr form))
	setters)
    (while bytecomp-args
      (let ((var (car bytecomp-args)))
	(if (or (not (symbolp var))
		(byte-compile-const-symbol-p var t))
	    (byte-compile-warn
	     "variable assignment to %s `%s'"
	     (if (symbolp var) "constant" "nonvariable")
	     (prin1-to-string var)))
	(push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
	      setters))
      (setq bytecomp-args (cdr (cdr bytecomp-args))))
    (byte-compile-form (cons 'progn (nreverse setters)))))

                (insert "\n"))))
	(setq rest (cdr rest)))

      (message "Generating call tree...(finding uncalled functions...)")
      (setq rest byte-compile-call-tree)
      (let ((uncalled nil))
	(while rest
	  (or (nth 1 (car rest))
	      (null (setq f (car (car rest))))
	      (functionp (byte-compile-fdefinition f t))
	      (commandp (byte-compile-fdefinition f nil))
	      (setq uncalled (cons f uncalled)))
	  (setq rest (cdr rest)))
	(if uncalled
	    (let ((fill-prefix "  "))
	      (insert "Noninteractive functions not known to be called:\n  ")
	      (setq p (point))
	      (insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
	      (fill-region-as-paragraph p (point)))))
      )
    (message "Generating call tree...done.")
    ))


;;;###autoload
(defun batch-byte-compile-if-not-done ()
  "Like `byte-compile-file' but doesn't recompile if already up to date.

105806:83e7d269fc49

;;    - various syntax errors;
;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
;;  + correct compilation of top-level uses of macros;
;;  + the ability to generate a histogram of functions called.

;; User customization variables: M-x customize-group bytecomp

;; New Features:
;;
;;  o	The form `defsubst' is just like `defun', except that the function
;;	generated will be open-coded in compiled code which uses it.  This

  :type 'boolean)

(defconst byte-compile-warning-types
  '(redefine callargs free-vars unresolved
	     obsolete noruntime cl-functions interactive-only
	     make-local mapcar constants)
  "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).

Elements of the list may be:

		  distinguished from macros and aliases).
  interactive-only
	      commands that normally shouldn't be called from Lisp code.
  make-local  calls to make-variable-buffer-local that may be incorrect.
  mapcar      mapcar called for effect.
  constants   let-binding of, or assignment to, constants/nonvariables.

If the list begins with `not', then the remaining elements specify warnings to
suppress.  For example, (not mapcar) will suppress warnings about mapcar."
  :group 'bytecomp
  :type `(choice (const :tag "All" t)
		 (set :menu-tag "Some"
		      (const free-vars) (const unresolved)
		      (const callargs) (const redefine)
		      (const obsolete) (const noruntime)
		      (const cl-functions) (const interactive-only)
		      (const make-local) (const mapcar) (const constants))))
;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)

;;;###autoload
(defun byte-compile-warnings-safe-p (x)
  "Return non-nil if X is valid as a value of `byte-compile-warnings'."

;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
  (let* ((def (or (byte-compile-fdefinition (car form) nil)
		  (byte-compile-fdefinition (car form) t)))
	 (sig (if (and def (not (eq def t)))
		  (progn
		    (and (eq (car-safe def) 'macro)
			 (eq (car-safe (cdr-safe def)) 'lambda)
			 (setq def (cdr def)))
		    (byte-compile-arglist-signature
		     (if (memq (car-safe def) '(declared lambda))
			 (nth 1 def)
		       (if (byte-code-function-p def)
			   (aref def 0)
			 '(&rest def)))))
		(if (and (fboundp (car form))
			 (subrp (symbol-function (car form))))
		    (subr-arity (symbol-function (car form))))))
	 (ncall (length (cdr form))))
    ;; Check many or unevalled from subr-arity.

;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
    (if (and old (not (eq old t)))
	(progn
	  (and (eq 'macro (car-safe old))
	       (eq 'lambda (car-safe (cdr-safe old)))
	       (setq old (cdr old)))
	  (let ((sig1 (byte-compile-arglist-signature
		       (if (eq 'lambda (car-safe old))
			   (nth 1 old)
			 (if (byte-code-function-p old)
			     (aref old 0)
			   '(&rest def)))))
		(sig2 (byte-compile-arglist-signature (nth 2 form))))
	    (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
	      (byte-compile-set-symbol-position (nth 1 form))
	      (byte-compile-warn
	       "%s %s used to take %s %s, now takes %s"
	       (if (eq (car form) 'defun) "function" "macro")
	       (nth 1 form)
	       (byte-compile-arglist-signature-string sig1)
	       (if (equal sig1 '(1 . 1)) "argument" "arguments")
	       (byte-compile-arglist-signature-string sig2)))))
      ;; This is the first definition.  See if previous calls are compatible.
      (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
	    nums sig min max)
	(if calls
	    (progn

  (when (symbolp bytecomp-var)
    (byte-compile-set-symbol-position bytecomp-var))
  (if (or (not (symbolp bytecomp-var))
	  (byte-compile-const-symbol-p bytecomp-var
				       (not (eq base-op 'byte-varref))))
      (if (byte-compile-warning-enabled-p 'constants)
	  (byte-compile-warn
	   (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
		 ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
		 (t "variable reference to %s `%s'"))
	   (if (symbolp bytecomp-var) "constant" "nonvariable")
	   (prin1-to-string bytecomp-var)))
    (and (get bytecomp-var 'byte-obsolete-variable)
	 (not (memq bytecomp-var byte-compile-not-obsolete-vars))
	 (byte-compile-warn-obsolete bytecomp-var))
    (if (byte-compile-warning-enabled-p 'free-vars)
	(if (eq base-op 'byte-varbind)

(defun byte-compile-setq-default (form)
  (let ((bytecomp-args (cdr form))
	setters)
    (while bytecomp-args
      (let ((var (car bytecomp-args)))
	(and (or (not (symbolp var))
		 (byte-compile-const-symbol-p var t))
	     (byte-compile-warning-enabled-p 'constants)
	     (byte-compile-warn
	      "variable assignment to %s `%s'"
	      (if (symbolp var) "constant" "nonvariable")
	      (prin1-to-string var)))
	(push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
	      setters))
      (setq bytecomp-args (cdr (cdr bytecomp-args))))
    (byte-compile-form (cons 'progn (nreverse setters)))))

                (insert "\n"))))
	(setq rest (cdr rest)))

      (message "Generating call tree...(finding uncalled functions...)")
      (setq rest byte-compile-call-tree)
      (let (uncalled def)
	(while rest
	  (or (nth 1 (car rest))
	      (null (setq f (caar rest)))
	      (progn
		(setq def (byte-compile-fdefinition f t))
		(and (eq (car-safe def) 'macro)
		     (eq (car-safe (cdr-safe def)) 'lambda)
		     (setq def (cdr def)))
		(functionp def))
	      (progn
		(setq def (byte-compile-fdefinition f nil))
		(and (eq (car-safe def) 'macro)
		     (eq (car-safe (cdr-safe def)) 'lambda)
		     (setq def (cdr def)))
		(commandp def))
	      (setq uncalled (cons f uncalled)))
	  (setq rest (cdr rest)))
	(if uncalled
	    (let ((fill-prefix "  "))
	      (insert "Noninteractive functions not known to be called:\n  ")
	      (setq p (point))
	      (insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
	      (fill-region-as-paragraph p (point))))))
    (message "Generating call tree...done.")))


;;;###autoload
(defun batch-byte-compile-if-not-done ()
  "Like `byte-compile-file' but doesn't recompile if already up to date.