(defcustom emacs-lisp-file-regexp "\\.el\\'"
"Regexp which matches Emacs Lisp source files.
-You may want to redefine the function `byte-compile-dest-file'
-if you change this variable."
+If you change this, you might want to set `byte-compile-dest-file-function'."
:group 'bytecomp
:type 'regexp)
+(defcustom byte-compile-dest-file-function nil
+ "Function for the function `byte-compile-dest-file' to call.
+It should take one argument, the name of an Emacs Lisp source
+file name, and return the name of the compiled file."
+ :group 'bytecomp
+ :type '(choice (const nil) function)
+ :version "23.2")
+
;; This enables file name handlers such as jka-compr
;; to remove parts of the file name that should not be copied
;; through to the output file name.
(or (fboundp 'byte-compile-dest-file)
;; The user may want to redefine this along with emacs-lisp-file-regexp,
;; so only define it if it is undefined.
+ ;; Note - redefining this function is obsolete as of 23.2.
+ ;; Customize byte-compile-dest-file-function instead.
(defun byte-compile-dest-file (filename)
"Convert an Emacs Lisp source file name to a compiled file name.
-If FILENAME matches `emacs-lisp-file-regexp' (by default, files
-with the extension `.el'), add `c' to it; otherwise add `.elc'."
- (setq filename (byte-compiler-base-file-name filename))
- (setq filename (file-name-sans-versions filename))
- (cond ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
+If `byte-compile-dest-file-function' is non-nil, uses that
+function to do the work. Otherwise, if FILENAME matches
+`emacs-lisp-file-regexp' (by default, files with the extension `.el'),
+adds `c' to it; otherwise adds `.elc'."
+ (if byte-compile-dest-file-function
+ (funcall byte-compile-dest-file-function filename)
+ (setq filename (file-name-sans-versions
+ (byte-compiler-base-file-name filename)))
+ (cond ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line
- goto-line)
+ goto-line comint-run)
"List of commands that are not meant to be called from Lisp.")
-(defvar byte-compile-not-obsolete-var nil
- "If non-nil, this is a variable that shouldn't be reported as obsolete.")
+(defvar byte-compile-not-obsolete-vars nil
+ "If non-nil, a list of variables that shouldn't be reported as obsolete.")
+
+(defvar byte-compile-not-obsolete-funcs nil
+ "If non-nil, a list of functions that shouldn't be reported as obsolete.")
(defcustom byte-compile-generate-call-tree nil
"Non-nil means collect call-graph information when compiling.
Each element looks like (FUNCTIONNAME . DEFINITION). It is
\(FUNCTIONNAME . nil) when a function is redefined as a macro.
It is \(FUNCTIONNAME . t) when all we know is that it was defined,
-and we don't know the definition.")
+and we don't know the definition. For an autoloaded function, DEFINITION
+has the form (autoload . FILENAME).")
(defvar byte-compile-unresolved-functions nil
"Alist of undefined functions to which calls have been compiled.
\f
;;; compile-time evaluation
+(defun byte-compile-cl-file-p (file)
+ "Return non-nil if FILE is one of the CL files."
+ (and (stringp file)
+ (string-match "^cl\\>" (file-name-nondirectory file))))
+
(defun byte-compile-eval (form)
"Eval FORM and mark the functions defined therein.
Each function's symbol gets added to `byte-compile-noruntime-functions'."
old-autoloads)
;; Make sure the file was not already loaded before.
(unless (or (assoc (car xs) hist-orig)
- (equal (car xs) "cl"))
+ ;; Don't give both the "noruntime" and
+ ;; "cl-functions" warning for the same function.
+ ;; FIXME This seems incorrect - these are two
+ ;; independent warnings. For example, you may be
+ ;; choosing to see the cl warnings but ignore them.
+ ;; You probably don't want to ignore noruntime in the
+ ;; same way.
+ (and (byte-compile-warning-enabled-p 'cl-functions)
+ (byte-compile-cl-file-p (car xs))))
(dolist (s xs)
(cond
((symbolp s)
(push (cdr s) old-autoloads)))))))
(when (byte-compile-warning-enabled-p 'cl-functions)
(let ((hist-new load-history))
- ;; Go through load-history, look for newly loaded files
- ;; and mark all the functions defined therein.
- (while (and hist-new (not (eq hist-new hist-orig)))
- (let ((xs (pop hist-new)))
- ;; Make sure the file was not already loaded before.
- (and (stringp (car xs))
- (string-match "^cl\\>" (file-name-nondirectory (car xs)))
- (not (assoc (car xs) hist-orig))
- (byte-compile-find-cl-functions)))))))))
+ ;; Go through load-history, looking for the cl files.
+ ;; Since new files are added at the start of load-history,
+ ;; we scan the new history until the tail matches the old.
+ (while (and (not byte-compile-cl-functions)
+ hist-new (not (eq hist-new hist-orig)))
+ ;; We used to check if the file had already been loaded,
+ ;; but it is better to check non-nil byte-compile-cl-functions.
+ (and (byte-compile-cl-file-p (car (pop hist-new)))
+ (byte-compile-find-cl-functions))))))))
(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.
+ ;; FIXME Why does it do that - just as a hack?
+ ;; There are other ways to do this nowadays.
(let ((tem current-load-list))
(while (not (eq tem hist-nil-orig))
(when (equal (car tem) '(require . cl))
(obsolete (or funcp (get symbol 'byte-obsolete-variable)))
(instead (car obsolete))
(asof (if funcp (nth 2 obsolete) (cdr obsolete))))
- (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
- (if funcp "function" "variable")
- (if asof (concat " (as of Emacs " asof ")") "")
- (cond ((stringp instead)
- (concat "; " instead))
- (instead
- (format "; use `%s' instead." instead))
- (t "."))))))
+ (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
+ (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
+ (if funcp "function" "variable")
+ (if asof (concat " (as of Emacs " asof ")") "")
+ (cond ((stringp instead)
+ (concat "; " instead))
+ (instead
+ (format "; use `%s' instead." instead))
+ (t ".")))))))
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
\f
;;; sanity-checking arglists
-;; If a function has an entry saying (FUNCTION . t).
-;; that means we know it is defined but we don't know how.
-;; If a function has an entry saying (FUNCTION . nil),
-;; that means treat it as not defined.
(defun byte-compile-fdefinition (name macro-p)
+ ;; If a function has an entry saying (FUNCTION . t).
+ ;; that means we know it is defined but we don't know how.
+ ;; If a function has an entry saying (FUNCTION . nil),
+ ;; that means treat it as not defined.
(let* ((list (if macro-p
byte-compile-macro-environment
byte-compile-function-environment))
(and (not macro-p)
(byte-code-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
- (if (and (not macro-p) (byte-code-function-p fn))
- fn
- (and (consp fn)
- (if (eq 'macro (car fn))
- (cdr fn)
- (if macro-p
- nil
- (if (eq 'autoload (car fn))
- nil
- fn)))))))))
+ (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
+ ;; Could be a subr.
+ (symbol-function fn)
+ fn)
+ advertised-signature-table t)))
+ (cond
+ ((listp advertised)
+ (if macro-p
+ `(macro lambda ,advertised)
+ `(lambda ,advertised)))
+ ((and (not macro-p) (byte-code-function-p fn)) fn)
+ ((not (consp fn)) nil)
+ ((eq 'macro (car fn)) (cdr fn))
+ (macro-p nil)
+ ((eq 'autoload (car fn)) nil)
+ (t fn)))))))
(defun byte-compile-arglist-signature (arglist)
(let ((args 0)
(defvar byte-compile-cl-functions nil
"List of functions defined in CL.")
+;; Can't just add this to cl-load-hook, because that runs just before
+;; the forms from cl.el get added to load-history.
(defun byte-compile-find-cl-functions ()
(unless byte-compile-cl-functions
(dolist (elt load-history)
- (when (and (stringp (car elt))
- (string-match
- "^cl\\>" (file-name-nondirectory (car elt))))
- (dolist (e (cdr elt))
- (when (memq (car-safe e) '(autoload defun))
- (push (cdr e) byte-compile-cl-functions)))))))
+ (and (byte-compile-cl-file-p (car elt))
+ (dolist (e (cdr elt))
+ ;; Includes the cl-foo functions that cl autoloads.
+ (when (memq (car-safe e) '(autoload defun))
+ (push (cdr e) byte-compile-cl-functions)))))))
(defun byte-compile-cl-warn (form)
"Warn if FORM is a call of a function from the CL package."
symbol itself."
(or (memq symbol '(nil t))
(keywordp symbol)
- (if any-value (memq symbol byte-compile-const-variables))))
+ (if any-value
+ (or (memq symbol byte-compile-const-variables)
+ ;; FIXME: We should provide a less intrusive way to find out
+ ;; is a variable is "constant".
+ (and (boundp symbol)
+ (condition-case nil
+ (progn (set symbol (symbol-value symbol)) nil)
+ (setting-constant t)))))))
(defmacro byte-compile-constp (form)
"Return non-nil if FORM is a constant."
;; of the boundp test in byte-compile-variable-ref.
;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html
;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html
+;; Note that similar considerations apply to command-line-1 in startup.el.
;;;###autoload
(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
bytecomp-force)
(insert (nth 2 info)))))
nil)
-(defun byte-compile-keep-pending (form &optional handler)
+(defun byte-compile-keep-pending (form &optional bytecomp-handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form t)))
- (if handler
+ (if bytecomp-handler
(let ((for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
;; the output regularly.
(and (memq (car-safe form) '(fset defalias))
(nthcdr 300 byte-compile-output)
(byte-compile-flush-pending))
- (funcall handler form)
+ (funcall bytecomp-handler form)
(if for-effect
(byte-compile-discard)))
(byte-compile-form form t))
(defun byte-compile-file-form (form)
(let ((byte-compile-current-form nil) ; close over this for warnings.
- handler)
+ bytecomp-handler)
(cond
((not (consp form))
(byte-compile-keep-pending form))
((and (symbolp (car form))
- (setq handler (get (car form) 'byte-hunk-handler)))
- (cond ((setq form (funcall handler form))
+ (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
+ (cond ((setq form (funcall bytecomp-handler form))
(byte-compile-flush-pending)
(byte-compile-output-file-form form))))
((eq form (setq form (macroexpand form byte-compile-macro-environment)))
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
;; Avoid undefined function warnings for the autoload.
- (if (and (consp (nth 1 form))
+ (when (and (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
(symbolp (nth 1 (nth 1 form))))
- (push (cons (nth 1 (nth 1 form))
- (cons 'autoload (cdr (cdr form))))
- byte-compile-function-environment))
+ (push (cons (nth 1 (nth 1 form))
+ (cons 'autoload (cdr (cdr form))))
+ byte-compile-function-environment)
+ ;; If an autoload occurs _before_ the first call to a function,
+ ;; byte-compile-callargs-warn does not add an entry to
+ ;; byte-compile-unresolved-functions. Here we mimic the logic
+ ;; of byte-compile-callargs-warn so as not to warn if the
+ ;; autoload comes _after_ the function call.
+ ;; Alternatively, similar logic could go in
+ ;; byte-compile-warn-about-unresolved-functions.
+ (or (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions)
+ (setq byte-compile-unresolved-functions
+ (delq (assq (nth 1 (nth 1 form))
+ byte-compile-unresolved-functions)
+ byte-compile-unresolved-functions))))
(if (stringp (nth 3 form))
form
;; No doc string, so we can compile this as a normal form.
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
- (let ((args (mapcar 'eval (cdr form))))
+ (let ((args (mapcar 'eval (cdr form)))
+ (hist-orig load-history)
+ hist-new)
(apply 'require args)
- ;; Detect (require 'cl) in a way that works even if cl is already loaded.
- (when (and (member (car args) '("cl" cl))
- (byte-compile-warning-enabled-p 'cl-functions))
- (byte-compile-warn "cl package required at runtime")
- (byte-compile-disable-warning 'cl-functions)))
+ (when (byte-compile-warning-enabled-p 'cl-functions)
+ ;; Detect (require 'cl) in a way that works even if cl is already loaded.
+ (if (member (car args) '("cl" cl))
+ (progn
+ (byte-compile-warn "cl package required at runtime")
+ (byte-compile-disable-warning 'cl-functions))
+ ;; We may have required something that causes cl to be loaded, eg
+ ;; the uncompiled version of a file that requires cl when compiling.
+ (setq hist-new load-history)
+ (while (and (not byte-compile-cl-functions)
+ hist-new (not (eq hist-new hist-orig)))
+ (and (byte-compile-cl-file-p (car (pop hist-new)))
+ (byte-compile-find-cl-functions))))))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
;; Return nil so the forms are not output twice.
nil)
+(put 'with-no-warnings 'byte-hunk-handler
+ 'byte-compile-file-form-with-no-warnings)
+(defun byte-compile-file-form-with-no-warnings (form)
+ ;; cf byte-compile-file-form-progn.
+ (let (byte-compile-warnings)
+ (mapc 'byte-compile-file-form (cdr form))
+ nil))
+
;; This handler is not necessary, but it makes the output from dont-compile
;; and similar macros cleaner.
(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
(defun byte-compile-file-form-defmacro (form)
(byte-compile-file-form-defmumble form t))
+(defun byte-compile-defmacro-declaration (form)
+ "Generate code for declarations in macro definitions.
+Remove declarations from the body of the macro definition
+by side-effects."
+ (let ((tail (nthcdr 2 form))
+ (res '()))
+ (when (stringp (car (cdr tail)))
+ (setq tail (cdr tail)))
+ (while (and (consp (car (cdr tail)))
+ (eq (car (car (cdr tail))) 'declare))
+ (let ((declaration (car (cdr tail))))
+ (setcdr tail (cdr (cdr tail)))
+ (push `(if macro-declaration-function
+ (funcall macro-declaration-function
+ ',(car (cdr form)) ',declaration))
+ res)))
+ res))
+
(defun byte-compile-file-form-defmumble (form macrop)
(let* ((bytecomp-name (car (cdr form)))
(bytecomp-this-kind (if macrop 'byte-compile-macro-environment
;; Generate code for declarations in macro definitions.
;; Remove declarations from the body of the macro definition.
(when macrop
- (let ((tail (nthcdr 2 form)))
- (when (stringp (car (cdr tail)))
- (setq tail (cdr tail)))
- (while (and (consp (car (cdr tail)))
- (eq (car (car (cdr tail))) 'declare))
- (let ((declaration (car (cdr tail))))
- (setcdr tail (cdr (cdr tail)))
- (prin1 `(if macro-declaration-function
- (funcall macro-declaration-function
- ',bytecomp-name ',declaration))
- bytecomp-outbuffer)))))
+ (dolist (decl (byte-compile-defmacro-declaration form))
+ (prin1 decl bytecomp-outbuffer)))
(let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
(code (byte-compile-byte-code-maker new-one)))
;; 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)
+(defun byte-compile-lambda (bytecomp-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))
+ (setq bytecomp-fun (cons 'lambda bytecomp-fun))
+ (unless (eq 'lambda (car-safe bytecomp-fun))
+ (error "Not a lambda list: %S" bytecomp-fun))
(byte-compile-set-symbol-position 'lambda))
- (byte-compile-check-lambda-list (nth 1 fun))
- (let* ((arglist (nth 1 fun))
+ (byte-compile-check-lambda-list (nth 1 bytecomp-fun))
+ (let* ((bytecomp-arglist (nth 1 bytecomp-fun))
(byte-compile-bound-variables
(nconc (and (byte-compile-warning-enabled-p 'free-vars)
- (delq '&rest (delq '&optional (copy-sequence arglist))))
+ (delq '&rest
+ (delq '&optional (copy-sequence bytecomp-arglist))))
byte-compile-bound-variables))
- (body (cdr (cdr fun)))
- (doc (if (stringp (car body))
- (prog1 (car body)
+ (bytecomp-body (cdr (cdr bytecomp-fun)))
+ (bytecomp-doc (if (stringp (car bytecomp-body))
+ (prog1 (car bytecomp-body)
;; Discard the doc string
;; unless it is the last element of the body.
- (if (cdr body)
- (setq body (cdr body))))))
- (int (assq 'interactive body)))
+ (if (cdr bytecomp-body)
+ (setq bytecomp-body (cdr bytecomp-body))))))
+ (bytecomp-int (assq 'interactive bytecomp-body)))
;; Process the interactive spec.
- (when int
+ (when bytecomp-int
(byte-compile-set-symbol-position 'interactive)
;; Skip (interactive) if it is in front (the most usual location).
- (if (eq int (car body))
- (setq body (cdr body)))
- (cond ((consp (cdr int))
- (if (cdr (cdr int))
+ (if (eq bytecomp-int (car bytecomp-body))
+ (setq bytecomp-body (cdr bytecomp-body)))
+ (cond ((consp (cdr bytecomp-int))
+ (if (cdr (cdr bytecomp-int))
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))
+ (prin1-to-string bytecomp-int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
- (let ((form (nth 1 int)))
+ (let ((form (nth 1 bytecomp-int)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
(if (eq (car-safe form) 'list)
- (byte-compile-top-level (nth 1 int))
- (setq int (list 'interactive
- (byte-compile-top-level (nth 1 int)))))))
- ((cdr int)
+ (byte-compile-top-level (nth 1 bytecomp-int))
+ (setq bytecomp-int (list 'interactive
+ (byte-compile-top-level
+ (nth 1 bytecomp-int)))))))
+ ((cdr bytecomp-int)
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))))
+ (prin1-to-string bytecomp-int)))))
;; Process the body.
- (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
+ (let ((compiled (byte-compile-top-level
+ (cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
(if (and (eq 'byte-code (car-safe compiled))
(not (byte-compile-version-cond
byte-compile-compatibility)))
(apply 'make-byte-code
- (append (list arglist)
+ (append (list bytecomp-arglist)
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
- (if (or doc int)
- (list doc))
+ (if (or bytecomp-doc bytecomp-int)
+ (list bytecomp-doc))
;; optionally, the interactive spec.
- (if int
- (list (nth 1 int)))))
+ (if bytecomp-int
+ (list (nth 1 bytecomp-int)))))
(setq compiled
- (nconc (if int (list int))
+ (nconc (if bytecomp-int (list bytecomp-int))
(cond ((eq (car-safe compiled) 'progn) (cdr compiled))
(compiled (list compiled)))))
- (nconc (list 'lambda arglist)
- (if (or doc (stringp (car compiled)))
- (cons doc (cond (compiled)
- (body (list nil))))
+ (nconc (list 'lambda bytecomp-arglist)
+ (if (or bytecomp-doc (stringp (car compiled)))
+ (cons bytecomp-doc (cond (compiled)
+ (bytecomp-body (list nil))))
compiled))))))
(defun byte-compile-constants-vector ()
((cdr body) (cons 'progn (nreverse body)))
((car body)))))
-;; Given BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (body &optional for-effect)
- (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
- (cond ((eq (car-safe body) 'progn)
- (cdr body))
- (body
- (list body))))
+;; Given BYTECOMP-BODY, compile it and return a new body.
+(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
+ (setq bytecomp-body
+ (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
+ (cond ((eq (car-safe bytecomp-body) 'progn)
+ (cdr bytecomp-body))
+ (bytecomp-body
+ (list bytecomp-body))))
(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
(defun byte-compile-declare-function (form)
(setq for-effect nil))
(t (byte-compile-variable-ref 'byte-varref form))))
((symbolp (car form))
- (let* ((fn (car form))
- (handler (get fn 'byte-compile)))
- (when (byte-compile-const-symbol-p fn)
- (byte-compile-warn "`%s' called as a function" fn))
+ (let* ((bytecomp-fn (car form))
+ (bytecomp-handler (get bytecomp-fn 'byte-compile)))
+ (when (byte-compile-const-symbol-p bytecomp-fn)
+ (byte-compile-warn "`%s' called as a function" bytecomp-fn))
(and (byte-compile-warning-enabled-p 'interactive-only)
- (memq fn byte-compile-interactive-only-functions)
+ (memq bytecomp-fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
-That command is designed for interactive use only" fn))
- (if (and handler
+That command is designed for interactive use only" bytecomp-fn))
+ (when (byte-compile-warning-enabled-p 'callargs)
+ (if (memq bytecomp-fn
+ '(custom-declare-group custom-declare-variable
+ custom-declare-face))
+ (byte-compile-nogroup-warn form))
+ (byte-compile-callargs-warn form))
+ (if (and bytecomp-handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
;; `cl-byte-compile-compiler-macro' but if CL isn't
;; loaded, this function doesn't exist.
- (or (not (memq handler '(cl-byte-compile-compiler-macro)))
- (functionp handler))
+ (or (not (memq bytecomp-handler
+ '(cl-byte-compile-compiler-macro)))
+ (functionp bytecomp-handler))
(not (and (byte-compile-version-cond
byte-compile-compatibility)
- (get (get fn 'byte-opcode) 'emacs19-opcode))))
- (funcall handler form)
- (when (byte-compile-warning-enabled-p 'callargs)
- (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
- (byte-compile-nogroup-warn form))
- (byte-compile-callargs-warn form))
+ (get (get bytecomp-fn 'byte-opcode)
+ 'emacs19-opcode))))
+ (funcall bytecomp-handler form)
(byte-compile-normal-call form))
(if (byte-compile-warning-enabled-p 'cl-functions)
(byte-compile-cl-warn form))))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
-(defun byte-compile-variable-ref (base-op var)
- (when (symbolp var)
- (byte-compile-set-symbol-position var))
- (if (or (not (symbolp var))
- (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
+(defun byte-compile-variable-ref (base-op bytecomp-var)
+ (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 var) "constant" "nonvariable")
- (prin1-to-string var))
- (and (get var 'byte-obsolete-variable)
- (not (eq var byte-compile-not-obsolete-var))
- (byte-compile-warn-obsolete var))
+ (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)
- (push var byte-compile-bound-variables)
- (or (boundp var)
- (memq var byte-compile-bound-variables)
+ (push bytecomp-var byte-compile-bound-variables)
+ (or (boundp bytecomp-var)
+ (memq bytecomp-var byte-compile-bound-variables)
(if (eq base-op 'byte-varset)
- (or (memq var byte-compile-free-assignments)
+ (or (memq bytecomp-var byte-compile-free-assignments)
(progn
- (byte-compile-warn "assignment to free variable `%s'" var)
- (push var byte-compile-free-assignments)))
- (or (memq var byte-compile-free-references)
+ (byte-compile-warn "assignment to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-assignments)))
+ (or (memq bytecomp-var byte-compile-free-references)
(progn
- (byte-compile-warn "reference to free variable `%s'" var)
- (push var byte-compile-free-references))))))))
- (let ((tmp (assq var byte-compile-variables)))
+ (byte-compile-warn "reference to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-references))))))))
+ (let ((tmp (assq bytecomp-var byte-compile-variables)))
(unless tmp
- (setq tmp (list var))
+ (setq tmp (list bytecomp-var))
(push tmp byte-compile-variables))
(byte-compile-out base-op tmp)))
;; which have special byte codes just for speed.
(defmacro byte-defop-compiler (function &optional compile-handler)
- ;; add a compiler-form for FUNCTION.
- ;; If function is a symbol, then the variable "byte-SYMBOL" must name
- ;; the opcode to be used. If function is a list, the first element
- ;; is the function and the second element is the bytecode-symbol.
- ;; The second element may be nil, meaning there is no opcode.
- ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
- ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
- ;; If it is nil, then the handler is "byte-compile-SYMBOL."
+ "Add a compiler-form for FUNCTION.
+If function is a symbol, then the variable \"byte-SYMBOL\" must name
+the opcode to be used. If function is a list, the first element
+is the function and the second element is the bytecode-symbol.
+The second element may be nil, meaning there is no opcode.
+COMPILE-HANDLER is the function to use to compile this byte-op, or
+may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
+If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(let (opcode)
(if (symbolp function)
(setq opcode (intern (concat "byte-" (symbol-name function))))
(byte-defop-compiler-1 quote-form)
(defun byte-compile-setq (form)
- (let ((args (cdr form)))
- (if args
- (while args
- (byte-compile-form (car (cdr args)))
- (or for-effect (cdr (cdr args))
+ (let ((bytecomp-args (cdr form)))
+ (if bytecomp-args
+ (while bytecomp-args
+ (byte-compile-form (car (cdr bytecomp-args)))
+ (or for-effect (cdr (cdr bytecomp-args))
(byte-compile-out 'byte-dup 0))
- (byte-compile-variable-ref 'byte-varset (car args))
- (setq args (cdr (cdr args))))
+ (byte-compile-variable-ref 'byte-varset (car bytecomp-args))
+ (setq bytecomp-args (cdr (cdr bytecomp-args))))
;; (setq), with no arguments.
(byte-compile-form nil for-effect))
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
- (let ((args (cdr form))
+ (let ((bytecomp-args (cdr form))
setters)
- (while args
- (setq setters
- (cons (list 'set-default (list 'quote (car args)) (car (cdr args)))
- setters))
- (setq args (cdr (cdr args))))
+ (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)))))
(defun byte-compile-quote (form)
\f
;;; control structures
-(defun byte-compile-body (body &optional for-effect)
- (while (cdr body)
- (byte-compile-form (car body) t)
- (setq body (cdr body)))
- (byte-compile-form (car body) for-effect))
+(defun byte-compile-body (bytecomp-body &optional for-effect)
+ (while (cdr bytecomp-body)
+ (byte-compile-form (car bytecomp-body) t)
+ (setq bytecomp-body (cdr bytecomp-body)))
+ (byte-compile-form (car bytecomp-body) for-effect))
-(defsubst byte-compile-body-do-effect (body)
- (byte-compile-body body for-effect)
+(defsubst byte-compile-body-do-effect (bytecomp-body)
+ (byte-compile-body bytecomp-body for-effect)
(setq for-effect nil))
(defsubst byte-compile-form-do-effect (form)
BODY is the code to compile in the first arm of the if or the body of
the cond clause. If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
-being undefined will be suppressed.
+being undefined (or obsolete) will be suppressed.
If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(append bound-list byte-compile-bound-variables)
byte-compile-bound-variables)))
(unwind-protect
- (progn ,@body)
+ ;; If things not being bound at all is ok, so must them being obsolete.
+ ;; Note that we add to the existing lists since Tramp (ab)uses
+ ;; this feature.
+ (let ((byte-compile-not-obsolete-vars
+ (append byte-compile-not-obsolete-vars bound-list))
+ (byte-compile-not-obsolete-funcs
+ (append byte-compile-not-obsolete-funcs fbound-list)))
+ ,@body)
;; Maybe remove the function symbol from the unresolved list.
(dolist (fbound fbound-list)
(when fbound
(defun byte-compile-and (form)
(let ((failtag (byte-compile-make-tag))
- (args (cdr form)))
- (if (null args)
+ (bytecomp-args (cdr form)))
+ (if (null bytecomp-args)
(byte-compile-form-do-effect t)
- (byte-compile-and-recursion args failtag))))
+ (byte-compile-and-recursion bytecomp-args failtag))))
;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-or (form)
(let ((wintag (byte-compile-make-tag))
- (args (cdr form)))
- (if (null args)
+ (bytecomp-args (cdr form)))
+ (if (null bytecomp-args)
(byte-compile-form-do-effect nil)
- (byte-compile-or-recursion args wintag))))
+ (byte-compile-or-recursion bytecomp-args wintag))))
;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
(varlist (reverse (car (cdr form)))))
(dolist (var varlist)
- (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
+ (byte-compile-variable-ref 'byte-varbind
+ (if (consp var) (car var) var)))
(byte-compile-body-do-effect (cdr (cdr form)))
(byte-compile-out 'byte-unbind (length (car (cdr 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)))))
+ (let ((decls (byte-compile-defmacro-declaration form))
+ (code (byte-compile-byte-code-maker
+ (byte-compile-lambda (cdr (cdr form)) t))))
+ `((defalias ',(nth 1 form)
+ ,(if (eq (car-safe code) 'make-byte-code)
+ `(cons 'macro ,code)
+ `'(macro . ,(eval code))))
+ ,@decls
+ ',(nth 1 form)))))
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
fun var string))
`(put ',var 'variable-documentation ,string))
(if (cddr form) ; `value' provided
- (let ((byte-compile-not-obsolete-var var))
+ (let ((byte-compile-not-obsolete-vars (list var)))
(if (eq fun 'defconst)
;; `defconst' sets `var' unconditionally.
(let ((tmp (make-symbol "defconst-tmp-var")))
(byte-compile-form (cons 'progn (cdr form)))))
;; Warn about misuses of make-variable-buffer-local.
-(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
+(byte-defop-compiler-1 make-variable-buffer-local
+ byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
(if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
(byte-compile-warning-enabled-p 'make-local))
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(error "`batch-byte-compile' is to be used only with -batch"))
- (let ((error nil))
+ (let ((bytecomp-error nil))
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
;; Directory as argument.
(file-exists-p bytecomp-dest)
(file-newer-than-file-p bytecomp-source bytecomp-dest))
(if (null (batch-byte-compile-file bytecomp-source))
- (setq error t)))))
+ (setq bytecomp-error t)))))
;; Specific file argument
(if (or (not noforce)
(let* ((bytecomp-source (car command-line-args-left))
(or (not (file-exists-p bytecomp-dest))
(file-newer-than-file-p bytecomp-source bytecomp-dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq error t))))
+ (setq bytecomp-error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (kill-emacs (if error 1 0))))
+ (kill-emacs (if bytecomp-error 1 0))))
(defun batch-byte-compile-file (bytecomp-file)
(if debug-on-error
(prin1-to-string (cdr err)))
nil))))
+(defun byte-compile-refresh-preloaded ()
+ "Reload any Lisp file that was changed since Emacs was dumped.
+Use with caution."
+ (let* ((argv0 (car command-line-args))
+ (emacs-file (executable-find argv0)))
+ (if (not (and emacs-file (file-executable-p emacs-file)))
+ (message "Can't find %s to refresh preloaded Lisp files" argv0)
+ (dolist (f (reverse load-history))
+ (setq f (car f))
+ (if (string-match "elc\\'" f) (setq f (substring f 0 -1)))
+ (when (and (file-readable-p f)
+ (file-newer-than-file-p f emacs-file))
+ (message "Reloading stale %s" (file-name-nondirectory f))
+ (condition-case nil
+ (load f 'noerror nil 'nosuffix)
+ ;; Probably shouldn't happen, but in case of an error, it seems
+ ;; at least as useful to ignore it as it is to stop compilation.
+ (error nil)))))))
+
;;;###autoload
(defun batch-byte-recompile-directory (&optional arg)
"Run `byte-recompile-directory' on the dirs remaining on the command line.