comparison lisp/emacs-lisp/bytecomp.el @ 28402:843e552813e3

Doc fixes. (byte-compile-file-form-autoload): Update byte-compile-function-environment.

28401:65f19ae2c578

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Maintainer: FSF
;; Keywords: lisp

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

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

;;  + compile-time warning messages for:
;;    - functions being redefined with incompatible arglists;
;;    - functions being redefined as macros, or vice-versa;
;;    - functions or macros defined multiple times in the same file;
;;    - functions being called with the incorrect number of arguments;
;;    - functions being called which are not defined globally, in the 
;;      file, or as autoloads;
;;    - assignment and reference of undeclared free variables;
;;    - various syntax errors;
;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
;;  + correct compilation of top-level uses of macros;

;; User customization variables:
;;
;; byte-compile-verbose	Whether to report the function currently being
;;				compiled in the minibuffer;
;; 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)

;;  o	You can also open-code one particular call to a function without
;;	open-coding all calls.  Use the 'inline' form to do this, like so:
;;
;;		(inline (foo 1 2 3))	;; `foo' will be open-coded
;;	or...
;;		(inline			;;  `foo' and `baz' will be 
;;		 (foo 1 2 3 (bar 5))	;; open-coded, but `bar' will not.
;;		 (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

;;  o  The form `eval-and-compile' is similar to eval-when-compile, but
;;	the whole form is evalled both at compile-time and at run-time.
;;
;;  o  The command compile-defun is analogous to eval-defun.
;;
;;  o  If you run byte-compile-file on a filename which is visited in a 
;;     buffer, and that buffer is modified, you are asked whether you want
;;     to save the buffer before compiling.
;;
;;  o  byte-compiled files now start with the string `;ELC'.
;;     Some versions of `file' can be customized to recognize that.

  :type 'boolean)

;; (defvar byte-compile-generate-emacs19-bytecodes
;;         (not (or (and (boundp 'epoch::version) epoch::version)
;; 		 (string-lessp emacs-version "19")))
;;   "*If this is true, then the byte-compiler will generate bytecode which 
;; makes use of byte-ops which are present only in Emacs 19.  Code generated
;; this way can never be run in Emacs 18, and may even cause it to crash.")

(defcustom byte-optimize t
  "*Enables optimization in the byte compiler.

;; (defvar byte-compile-overwrite-file t
;;   "If nil, old .elc files are deleted before the new is saved, and .elc
;; files will have the same modes as the corresponding .el file.  Otherwise,
;; existing .elc files will simply be overwritten, and the existing modes
;; will not be changed.  If this variable is nil, then an .elc file which 
;; is a symbolic link will be turned into a normal file, instead of the file
;; which the link points to being overwritten.")

(defvar byte-compile-constants nil
  "List of all constants encountered during compilation of this form.")

   "for reference to a constant with vector index >= byte-constant-limit")
(byte-defop 130  0 byte-goto "for unconditional jump")
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
(byte-defop 133 -1 byte-goto-if-nil-else-pop
  "to examine top-of-stack, jump and don't pop it if it's nil, 
otherwise pop it")
(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
  "to examine top-of-stack, jump and don't pop it if it's non nil, 
otherwise pop it")

(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
(byte-defop 136 -1 byte-discard "to discard one value from stack")
(byte-defop 137  1 byte-dup     "to duplicate the top of the stack")

(byte-defop 141 -1 byte-catch
  "for catch.  Takes, on stack, the tag and an expression for the body")
(byte-defop 142 -1 byte-unwind-protect
  "for unwind-protect.  Takes, on stack, an expression for the unwind-action")

;; For condition-case.  Takes, on stack, the variable to bind, 
;; an expression for the body, and a list of clauses.
(byte-defop 143 -2 byte-condition-case)

;; For entry to with-output-to-temp-buffer.
;; Takes, on stack, the buffer name.

;;;
;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
;;; where instruction is a symbol naming a byte-code instruction,
;;; and parameter is an argument to that instruction, if any.
;;;
;;; The instruction can be the pseudo-op TAG, which means that this position 
;;; in the instruction stream is a target of a goto.  (car PARAMETER) will be
;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
;;; parameter for some goto op.
;;;
;;; If the operation is varbind, varref, varset or push-constant, then the

;;     (verbose byte-compile-verbose (t nil) val)
;;     (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
;; 	      val)))

;; Inhibit v18/v19 selectors if the version is hardcoded.
;; #### This should print a warning if the user tries to change something 
;; than can't be changed because the running compiler doesn't support it.
;; (cond
;;  ((byte-compile-single-version)
;;   (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
;; 	  (list (byte-compile-version-cond

(defsubst byte-compile-const-symbol-p (symbol)
  (or (memq symbol '(nil t))
      (keywordp symbol)))

(defmacro byte-compile-constp (form)
  ;; Returns non-nil if FORM is a constant.
  `(cond ((consp ,form) (eq (car ,form) 'quote))
	 ((not (symbolp ,form)))
	 ((byte-compile-const-symbol-p ,form))))

(defmacro byte-compile-close-variables (&rest body)

	  (load target-file))
      t)))

;;(defun byte-compile-and-load-file (&optional filename)
;;  "Compile a file of Lisp code named FILENAME into a file of byte code,
;;and then load it.  The output file's name is made by appending \"c\" to 
;;the end of FILENAME."
;;  (interactive)
;;  (if filename ; I don't get it, (interactive-p) doesn't always work
;;      (byte-compile-file filename t)
;;    (let ((current-prefix-arg '(4)))

  (and (let ((form form))
	 (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
	 (null form))			;Constants only
       (eval (nth 5 form))		;Macro
       (eval form))			;Define the autoload.
  (if (stringp (nth 3 form))
      form
    ;; No doc string, so we can compile this as a normal form.
    (byte-compile-keep-pending form 'byte-compile-normal-call)))

  (cond ((eq (car-safe body) 'progn)
	 (cdr body))
	(body
	 (list body))))

;; This is the recursive entry point for compiling each subform of an 
;; expression.
;; If for-effect is non-nil, byte-compile-form will output a byte-discard
;; before terminating (ie no value will be left on the stack).
;; A byte-compile handler may, when for-effect is non-nil, choose output code
;; which does not leave a value on the stack, and then set for-effect to nil

                   (prin1-to-string condition)))
;;                ((not (or (eq condition 't)
;;			  (and (stringp (get condition 'error-message))
;;			       (consp (get condition 'error-conditions)))))
;;                 (byte-compile-warn
;;                   "%s is not a known condition name (in condition-case)" 
;;                   condition))
		)
	  (setq compiled-clauses
		(cons (cons condition
			    (byte-compile-top-level-body

	   ;; Put the defined variable in this library's load-history entry
	   ;; just as a real defvar would.
	   (list 'setq 'current-load-list
		 (list 'cons (list 'quote var)
		       'current-load-list))
	   (if string 
	       (list 'put (list 'quote var) ''variable-documentation string))
	   (list 'quote var)))))

(defun byte-compile-autoload (form)
  (and (byte-compile-constp (nth 1 form))
       (byte-compile-constp (nth 5 form))
       (eval (nth 5 form))  ; macro-p
       (not (fboundp (eval (nth 1 form))))
       (byte-compile-warn
	"The compiler ignores `autoload' except at top level.  You should 
     probably put the autoload of the macro `%s' at top-level."
	(eval (nth 1 form))))
  (byte-compile-normal-call form))

;; Lambda's in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (form)
  (error "`lambda' used as function name is invalid"))

;; Compile normally, but deal with warnings for the function being defined.

28402:843e552813e3

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Maintainer: FSF
;; Keywords: lisp

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

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

;;  + compile-time warning messages for:
;;    - functions being redefined with incompatible arglists;
;;    - functions being redefined as macros, or vice-versa;
;;    - functions or macros defined multiple times in the same file;
;;    - functions being called with the incorrect number of arguments;
;;    - functions being called which are not defined globally, in the
;;      file, or as autoloads;
;;    - assignment and reference of undeclared free variables;
;;    - various syntax errors;
;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
;;  + correct compilation of top-level uses of macros;

;; User customization variables:
;;
;; byte-compile-verbose	Whether to report the function currently being
;;				compiled in the minibuffer;
;; 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)

;;  o	You can also open-code one particular call to a function without
;;	open-coding all calls.  Use the 'inline' form to do this, like so:
;;
;;		(inline (foo 1 2 3))	;; `foo' will be open-coded
;;	or...
;;		(inline			;;  `foo' and `baz' will be
;;		 (foo 1 2 3 (bar 5))	;; open-coded, but `bar' will not.
;;		 (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

;;  o  The form `eval-and-compile' is similar to eval-when-compile, but
;;	the whole form is evalled both at compile-time and at run-time.
;;
;;  o  The command compile-defun is analogous to eval-defun.
;;
;;  o  If you run byte-compile-file on a filename which is visited in a
;;     buffer, and that buffer is modified, you are asked whether you want
;;     to save the buffer before compiling.
;;
;;  o  byte-compiled files now start with the string `;ELC'.
;;     Some versions of `file' can be customized to recognize that.

  :type 'boolean)

;; (defvar byte-compile-generate-emacs19-bytecodes
;;         (not (or (and (boundp 'epoch::version) epoch::version)
;; 		 (string-lessp emacs-version "19")))
;;   "*If this is true, then the byte-compiler will generate bytecode which
;; makes use of byte-ops which are present only in Emacs 19.  Code generated
;; this way can never be run in Emacs 18, and may even cause it to crash.")

(defcustom byte-optimize t
  "*Enables optimization in the byte compiler.

;; (defvar byte-compile-overwrite-file t
;;   "If nil, old .elc files are deleted before the new is saved, and .elc
;; files will have the same modes as the corresponding .el file.  Otherwise,
;; existing .elc files will simply be overwritten, and the existing modes
;; will not be changed.  If this variable is nil, then an .elc file which
;; is a symbolic link will be turned into a normal file, instead of the file
;; which the link points to being overwritten.")

(defvar byte-compile-constants nil
  "List of all constants encountered during compilation of this form.")

   "for reference to a constant with vector index >= byte-constant-limit")
(byte-defop 130  0 byte-goto "for unconditional jump")
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
(byte-defop 133 -1 byte-goto-if-nil-else-pop
  "to examine top-of-stack, jump and don't pop it if it's nil,
otherwise pop it")
(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
  "to examine top-of-stack, jump and don't pop it if it's non nil,
otherwise pop it")

(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
(byte-defop 136 -1 byte-discard "to discard one value from stack")
(byte-defop 137  1 byte-dup     "to duplicate the top of the stack")

(byte-defop 141 -1 byte-catch
  "for catch.  Takes, on stack, the tag and an expression for the body")
(byte-defop 142 -1 byte-unwind-protect
  "for unwind-protect.  Takes, on stack, an expression for the unwind-action")

;; For condition-case.  Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
(byte-defop 143 -2 byte-condition-case)

;; For entry to with-output-to-temp-buffer.
;; Takes, on stack, the buffer name.

;;;
;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
;;; where instruction is a symbol naming a byte-code instruction,
;;; and parameter is an argument to that instruction, if any.
;;;
;;; The instruction can be the pseudo-op TAG, which means that this position
;;; in the instruction stream is a target of a goto.  (car PARAMETER) will be
;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
;;; parameter for some goto op.
;;;
;;; If the operation is varbind, varref, varset or push-constant, then the

;;     (verbose byte-compile-verbose (t nil) val)
;;     (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
;; 	      val)))

;; Inhibit v18/v19 selectors if the version is hardcoded.
;; #### This should print a warning if the user tries to change something
;; than can't be changed because the running compiler doesn't support it.
;; (cond
;;  ((byte-compile-single-version)
;;   (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
;; 	  (list (byte-compile-version-cond

(defsubst byte-compile-const-symbol-p (symbol)
  (or (memq symbol '(nil t))
      (keywordp symbol)))

(defmacro byte-compile-constp (form)
  "Return non-nil if FORM is a constant."
  `(cond ((consp ,form) (eq (car ,form) 'quote))
	 ((not (symbolp ,form)))
	 ((byte-compile-const-symbol-p ,form))))

(defmacro byte-compile-close-variables (&rest body)

	  (load target-file))
      t)))

;;(defun byte-compile-and-load-file (&optional filename)
;;  "Compile a file of Lisp code named FILENAME into a file of byte code,
;;and then load it.  The output file's name is made by appending \"c\" to
;;the end of FILENAME."
;;  (interactive)
;;  (if filename ; I don't get it, (interactive-p) doesn't always work
;;      (byte-compile-file filename t)
;;    (let ((current-prefix-arg '(4)))

  (and (let ((form form))
	 (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
	 (null form))			;Constants only
       (eval (nth 5 form))		;Macro
       (eval form))			;Define the autoload.
  ;; Avoid undefined function warnings for the autoload.
  (if (and (consp (nth 1 form))
	   (eq (car (nth 1 form)) 'quote)
	   (consp (cdr (nth 1 form)))
	   (symbolp (nth 1 (nth 1 form))))
      (add-to-list 'byte-compile-function-environment
		   (cons (nth 1 (nth 1 form))
			 form)))
  (if (stringp (nth 3 form))
      form
    ;; No doc string, so we can compile this as a normal form.
    (byte-compile-keep-pending form 'byte-compile-normal-call)))

  (cond ((eq (car-safe body) 'progn)
	 (cdr body))
	(body
	 (list body))))

;; This is the recursive entry point for compiling each subform of an
;; expression.
;; If for-effect is non-nil, byte-compile-form will output a byte-discard
;; before terminating (ie no value will be left on the stack).
;; A byte-compile handler may, when for-effect is non-nil, choose output code
;; which does not leave a value on the stack, and then set for-effect to nil

                   (prin1-to-string condition)))
;;                ((not (or (eq condition 't)
;;			  (and (stringp (get condition 'error-message))
;;			       (consp (get condition 'error-conditions)))))
;;                 (byte-compile-warn
;;                   "%s is not a known condition name (in condition-case)"
;;                   condition))
		)
	  (setq compiled-clauses
		(cons (cons condition
			    (byte-compile-top-level-body

	   ;; Put the defined variable in this library's load-history entry
	   ;; just as a real defvar would.
	   (list 'setq 'current-load-list
		 (list 'cons (list 'quote var)
		       'current-load-list))
	   (if string
	       (list 'put (list 'quote var) ''variable-documentation string))
	   (list 'quote var)))))

(defun byte-compile-autoload (form)
  (and (byte-compile-constp (nth 1 form))
       (byte-compile-constp (nth 5 form))
       (eval (nth 5 form))  ; macro-p
       (not (fboundp (eval (nth 1 form))))
       (byte-compile-warn
	"The compiler ignores `autoload' except at top level.  You should
     probably put the autoload of the macro `%s' at top-level."
	(eval (nth 1 form))))
  (byte-compile-normal-call form))

;; Lambdas in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (form)
  (error "`lambda' used as function name is invalid"))

;; Compile normally, but deal with warnings for the function being defined.