comparison lisp/emacs-lisp/bytecomp.el @ 46136:79f132657570

(byte-compile-warning-types): Rename cl-func to cl-functions. Enable it by default. (byte-compile-file-form-eval-boundary): Turn off cl-functions warnings if the file loads cl. (byte-compile-initial-macro-environment): For eval-and-compile, use byte-compile-eval-before-compile to eval. (byte-compile-eval-before-compile): New function to turn off cl-functions when appropriate, for eval-and-compile. (byte-compile-warnings): Add cl-func option. (byte-compile-cl-warn): New function. (byte-compile-form): Use it, to warn about calling cl functions.

46135:742f54d0aedb

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.100 $")

;; This file is part of GNU Emacs.

;; 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

  "*If true, the byte-compiler reports warnings with `error'."
  :group 'bytecomp
  :type 'boolean)

(defconst byte-compile-warning-types
  '(redefine callargs free-vars unresolved obsolete noruntime))
(defcustom byte-compile-warnings t
  "*List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be be:

  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 definition.
  redefine    function cell redefined from a macro to a lambda or vice
              versa, or redefined to take a different number of arguments.
  obsolete    obsolete variables and functions."
  :group 'bytecomp
  :type '(choice (const :tag "All" t)
		 (set :menu-tag "Some"
		      (const free-vars) (const unresolved)
		      (const callargs) (const redefined)
		      (const obsolete) (const noruntime))))

(defcustom byte-compile-generate-call-tree nil
  "*Non-nil means collect call-graph information when compiling.
This records functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.

    (eval-when-compile . (lambda (&rest body)
			   (list 'quote
				 (byte-compile-eval (byte-compile-top-level
						     (cons 'progn body))))))
    (eval-and-compile . (lambda (&rest body)
			  (eval (cons 'progn body))
			  (cons 'progn body))))
  "The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")

	  (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	    (let ((s (pop hist-nil-new)))
	      (when (symbolp s)
		(put s 'byte-compile-noruntime t)))))))))


;;; byte compiler messages

(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)

		 (byte-compile-arglist-signature-string (cons min max))))

	      (setq byte-compile-unresolved-functions
		    (delq calls byte-compile-unresolved-functions)))))
      )))

(defun byte-compile-print-syms (str1 strn syms)
  (when syms
    (byte-compile-set-symbol-position (car syms) t))
  (cond ((and (cdr syms) (not noninteractive))

	    (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
  (eval form)
  (byte-compile-keep-pending form 'byte-compile-normal-call))

(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)

			      byte-compile-compatibility))
			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
	       (funcall handler form)
	     (if (memq 'callargs byte-compile-warnings)
		 (byte-compile-callargs-warn form))
	     (byte-compile-normal-call form))))
	((and (or (byte-code-function-p (car form))
		  (eq (car-safe (car form)) 'lambda))
	      ;; if the form comes out the same way it went in, that's
	      ;; because it was malformed, and we couldn't unfold it.
	      (not (eq form (setq form (byte-compile-unfold-lambda form)))))

46136:79f132657570

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.101 $")

;; This file is part of GNU Emacs.

;; 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

  "*If true, the byte-compiler reports warnings with `error'."
  :group 'bytecomp
  :type 'boolean)

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

  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 definition.
  redefine    function cell redefined from a macro to a lambda or vice
              versa, or redefined to take a different number of arguments.
  obsolete    obsolete variables and functions.
  noruntime   functions that may not be defined at runtime (typically
              defined only under `eval-when-compile').
  cl-functions    calls to runtime functions from the CL package (as 
		  distinguished from macros and aliases)."
  :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))))

(defcustom byte-compile-generate-call-tree nil
  "*Non-nil means collect call-graph information when compiling.
This records functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.

    (eval-when-compile . (lambda (&rest body)
			   (list 'quote
				 (byte-compile-eval (byte-compile-top-level
						     (cons 'progn body))))))
    (eval-and-compile . (lambda (&rest body)
			  (byte-compile-eval-before-compile (cons 'progn body))
			  (cons 'progn body))))
  "The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")

	  (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	    (let ((s (pop hist-nil-new)))
	      (when (symbolp s)
		(put s 'byte-compile-noruntime t)))))))))

(defun byte-compile-eval-before-compile (form)
  "Evaluate FORM for `eval-and-compile'."
  (let ((hist-nil-orig current-load-list))
    (prog1 (eval form)
      ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
      (let ((tem current-load-list))
	(while (not (eq tem hist-nil-orig))
	  (when (equal (car tem) '(require . cl))
	    (setq byte-compile-warnings
		  (remq 'cl-functions byte-compile-warnings)))
	  (setq tem (cdr tem)))))))

;;; byte compiler messages

(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)

		 (byte-compile-arglist-signature-string (cons min max))))

	      (setq byte-compile-unresolved-functions
		    (delq calls byte-compile-unresolved-functions)))))
      )))

(defun byte-compile-cl-warn (form)
  "Warn if FORM is a call of a function from the CL package."
  (let* ((func (car-safe form))
	 (library
	  (if func
	      (cond ((eq (car-safe func) 'autoload)
		     (nth 1 func))
		    ((symbol-file func))))))
    (if (and library
	     (string-match "^cl\\>" library)
	     ;; Aliases which won't have been expended at this point.
	     ;; These aren't all aliases of subrs, so not trivial to
	     ;; avoid hardwiring the list.
	     (not (memq func
			'(cl-block-wrapper cl-block-throw values values-list
			  multiple-value-list multiple-value-call nth-value
			  copy-seq first second rest endp cl-member))))
	(byte-compile-warn "Function `%s' from cl package called at runtime"
			   func)))
  form)

(defun byte-compile-print-syms (str1 strn syms)
  (when syms
    (byte-compile-set-symbol-position (car syms) t))
  (cond ((and (cdr syms) (not noninteractive))

	    (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
  (let ((old-load-list current-load-list))
    (eval form)
    ;; (require 'cl) turns off warnings for cl functions.
    (let ((tem current-load-list))
      (while (not (eq tem old-load-list))
	(when (equal (car tem) '(require . cl))
	  (setq byte-compile-warnings
		(remq 'cl-functions byte-compile-warnings)))
	(setq tem (cdr tem)))))
  (byte-compile-keep-pending form 'byte-compile-normal-call))

(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)

			      byte-compile-compatibility))
			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
	       (funcall handler form)
	     (if (memq 'callargs byte-compile-warnings)
		 (byte-compile-callargs-warn form))
	     (byte-compile-normal-call form))
	   (if (memq 'cl-functions byte-compile-warnings)
	       (byte-compile-cl-warn form))))
	((and (or (byte-code-function-p (car form))
		  (eq (car-safe (car form)) 'lambda))
	      ;; if the form comes out the same way it went in, that's
	      ;; because it was malformed, and we couldn't unfold it.
	      (not (eq form (setq form (byte-compile-unfold-lambda form)))))