comparison lisp/emacs-lisp/bytecomp.el @ 83395:b31326248cf6

Merged from [e-mail]--gnu-2005 (patch 142-148, 615-628) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-615 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-616 Add lisp/mh-e/.arch-inventory * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-617 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-618 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-619 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-620 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-621 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-622 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-623 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-624 Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords. * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-625 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-626 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-627 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-628 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-142 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-143 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-144 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-145 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-146 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-147 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-148 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-435

83394:7d093d9d4479

;; to that symbol's character position.  Similarly, if we encounter a
;; variable reference, like in (1+ foo), we remove `foo' from the
;; list.  If our current position is after the symbol's position, we
;; assume we've already passed that point, and look for the next
;; occurrence of the symbol.
;; So your're probably asking yourself: Isn't this function a
;; gross hack?  And the answer, of course, would be yes.
(defun byte-compile-set-symbol-position (sym &optional allow-previous)
  (when byte-compile-read-position
    (let (last entry)

	    (princ `(if macro-declaration-function
			(funcall macro-declaration-function
				 ',name ',declaration))
		   outbuffer)))))

    (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
	   (code (byte-compile-byte-code-maker new-one)))
      (if this-one
	  (setcdr this-one new-one)
	(set this-kind
	     (cons (cons name new-one) (symbol-value this-kind))))

;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
(defun byte-compile-lambda (fun)
  (unless (eq 'lambda (car-safe fun))
    (error "Not a lambda list: %S" fun))
  (byte-compile-set-symbol-position 'lambda)
  (byte-compile-check-lambda-list (nth 1 fun))
  (let* ((arglist (nth 1 fun))
	 (byte-compile-bound-variables
	  (nconc (and (memq 'free-vars byte-compile-warnings)
		      (delq '&rest (delq '&optional (copy-sequence arglist))))

That command is designed for interactive use only" fn))
	   (if (and handler
		    (or (not (byte-compile-version-cond
			      byte-compile-compatibility))
			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
	       (progn
		 (byte-compile-set-symbol-position fn)
		 (funcall handler form))
	     (when (memq 'callargs byte-compile-warnings)
	       (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
		   (byte-compile-nogroup-warn form))
	       (byte-compile-callargs-warn form))
	     (byte-compile-normal-call form))

      (progn
	(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
	 (list 'fset
	       (list 'quote (nth 1 form))
	       (byte-compile-byte-code-maker
		(byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
	(byte-compile-discard))
    ;; We prefer to generate a defalias form so it will record the function
    ;; definition just like interpreting a defun.
    (byte-compile-form
     (list 'defalias
	   (list 'quote (nth 1 form))
	   (byte-compile-byte-code-maker
	    (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
     t))
  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect
   (list (list 'fset (list 'quote (nth 1 form))
	       (let ((code (byte-compile-byte-code-maker
			    (byte-compile-lambda
			     (cons 'lambda (cdr (cdr form)))))))
		 (if (eq (car-safe code) 'make-byte-code)
		     (list 'cons ''macro code)
		   (list 'quote (cons 'macro (eval code))))))
	 (list 'quote (nth 1 form)))))

83395:b31326248cf6

;; to that symbol's character position.  Similarly, if we encounter a
;; variable reference, like in (1+ foo), we remove `foo' from the
;; list.  If our current position is after the symbol's position, we
;; assume we've already passed that point, and look for the next
;; occurrence of the symbol.
;;
;; This function should not be called twice for the same occurrence of
;; a symbol, and it should not be called for symbols generated by the
;; byte compiler itself; because rather than just fail looking up the
;; symbol, we may find an occurrence of the symbol further ahead, and
;; then `byte-compile-last-position' as advanced too far.
;;
;; So your're probably asking yourself: Isn't this function a
;; gross hack?  And the answer, of course, would be yes.
(defun byte-compile-set-symbol-position (sym &optional allow-previous)
  (when byte-compile-read-position
    (let (last entry)

	    (princ `(if macro-declaration-function
			(funcall macro-declaration-function
				 ',name ',declaration))
		   outbuffer)))))

    (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
	   (code (byte-compile-byte-code-maker new-one)))
      (if this-one
	  (setcdr this-one new-one)
	(set this-kind
	     (cons (cons name new-one) (symbol-value this-kind))))

;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
;; for symbols generated by the byte compiler itself.
(defun byte-compile-lambda (fun &optional add-lambda)
  (if add-lambda
      (setq fun (cons 'lambda fun))
    (unless (eq 'lambda (car-safe fun))
      (error "Not a lambda list: %S" fun))
    (byte-compile-set-symbol-position 'lambda))
  (byte-compile-check-lambda-list (nth 1 fun))
  (let* ((arglist (nth 1 fun))
	 (byte-compile-bound-variables
	  (nconc (and (memq 'free-vars byte-compile-warnings)
		      (delq '&rest (delq '&optional (copy-sequence arglist))))

That command is designed for interactive use only" fn))
	   (if (and handler
		    (or (not (byte-compile-version-cond
			      byte-compile-compatibility))
			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
               (funcall handler form)
	     (when (memq 'callargs byte-compile-warnings)
	       (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
		   (byte-compile-nogroup-warn form))
	       (byte-compile-callargs-warn form))
	     (byte-compile-normal-call form))

      (progn
	(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
	 (list 'fset
	       (list 'quote (nth 1 form))
	       (byte-compile-byte-code-maker
		(byte-compile-lambda (cdr (cdr form)) t))))
	(byte-compile-discard))
    ;; We prefer to generate a defalias form so it will record the function
    ;; definition just like interpreting a defun.
    (byte-compile-form
     (list 'defalias
	   (list 'quote (nth 1 form))
	   (byte-compile-byte-code-maker
	    (byte-compile-lambda (cdr (cdr form)) t)))
     t))
  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect
   (list (list 'fset (list 'quote (nth 1 form))
	       (let ((code (byte-compile-byte-code-maker
			    (byte-compile-lambda (cdr (cdr form)) t))))
		 (if (eq (car-safe code) 'make-byte-code)
		     (list 'cons ''macro code)
		   (list 'quote (cons 'macro (eval code))))))
	 (list 'quote (nth 1 form)))))