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).
+ cl-functions calls to runtime functions (as distinguished from macros and
+ aliases) from the old CL package (not the newer cl-lib).
interactive-only
commands that normally shouldn't be called from Lisp code.
+ lexical global/dynamic variables lacking a prefix.
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.
(defvar byte-compile-bound-variables nil
"List of dynamic variables bound in the context of the current form.
This list lives partly on the stack.")
+(defvar byte-compile-lexical-variables nil
+ "List of variables that have been treated as lexical.
+Filled in `cconv-analyse-form' but initialized and consulted here.")
(defvar byte-compile-const-variables nil
"List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references)
(byte-compile--outbuffer nil)
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
+ (byte-compile-lexical-variables nil)
(byte-compile-const-variables nil)
(byte-compile-free-references nil)
(byte-compile-free-assignments nil)
(setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
+ ;; The next 2 tests avoid compiling lock files
(file-readable-p source)
+ (not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
(not (string-equal dir-locals-file
(file-name-nondirectory source))))
(load (if (file-exists-p dest) dest filename)))
'no-byte-compile)))
+(defvar byte-compile-level 0 ; bug#13787
+ "Depth of a recursive byte compilation.")
+
;;;###autoload
(defun byte-compile-file (filename &optional load)
"Compile a file of Lisp code named FILENAME into a file of byte code.
(setq target-file (byte-compile-dest-file filename))
(setq byte-compile-dest-file target-file)
(with-current-buffer
- (setq input-buffer (get-buffer-create " *Compiler Input*"))
+ ;; It would be cleaner to use a temp buffer, but if there was
+ ;; an error, we leave this buffer around for diagnostics.
+ ;; Its name is documented in the lispref.
+ (setq input-buffer (get-buffer-create
+ (concat " *Compiler Input*"
+ (if (zerop byte-compile-level) ""
+ (format "-%s" byte-compile-level)))))
(erase-buffer)
(setq buffer-file-coding-system nil)
;; Always compile an Emacs Lisp file as multibyte
;; within byte-compile-from-buffer lingers in that buffer.
(setq output-buffer
(save-current-buffer
- (byte-compile-from-buffer input-buffer)))
+ (let ((byte-compile-level (1+ byte-compile-level)))
+ (byte-compile-from-buffer input-buffer))))
(if byte-compiler-error-flag
nil
(when byte-compile-verbose
(byte-compile-close-variables
(with-current-buffer
(setq byte-compile--outbuffer
- (get-buffer-create " *Compiler Output*"))
+ (get-buffer-create
+ (concat " *Compiler Output*"
+ (if (<= byte-compile-level 1) ""
+ (format "-%s" (1- byte-compile-level))))))
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
(widen)
(delete-char delta))))
-(defun byte-compile-insert-header (filename outbuffer)
+(defun byte-compile-insert-header (_filename outbuffer)
"Insert a header at the start of OUTBUFFER.
Call from the source buffer."
(let ((dynamic-docstrings byte-compile-dynamic-docstrings)
;; >4 byte x version %d
(insert
";ELC" 23 "\000\000\000\n"
- ";;; Compiled by "
- (or (and (boundp 'user-mail-address) user-mail-address)
- (concat (user-login-name) "@" (system-name)))
- " on " (current-time-string) "\n"
- ";;; from file " filename "\n"
+ ";;; Compiled\n"
";;; in Emacs version " emacs-version "\n"
";;; with"
(cond
byte-compile-maxdepth 0
byte-compile-output nil))))
+(defvar byte-compile-force-lexical-warnings nil)
+
(defun byte-compile-preprocess (form &optional _for-effect)
(setq form (macroexpand-all form byte-compile-macro-environment))
;; FIXME: We should run byte-optimize-form here, but it currently does not
;; macroexpand-all.
;; (if (memq byte-optimize '(t source))
;; (setq form (byte-optimize-form form for-effect)))
- (if lexical-binding
- (cconv-closure-convert form)
- form))
+ (cond
+ (lexical-binding (cconv-closure-convert form))
+ (byte-compile-force-lexical-warnings (cconv-warnings-only form))
+ (t form)))
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (form)
(and (let ((form form))
(while (if (setq form (cdr form)) (macroexp-const-p (car form))))
(null form)) ;Constants only
- (eval (nth 5 form)) ;Macro
+ (memq (eval (nth 5 form)) '(t macro)) ;Macro
(eval form)) ;Define the autoload.
;; Avoid undefined function warnings for the autoload.
(when (and (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
- (symbolp (nth 1 (nth 1 form)))
- ;; Don't add it if it's already defined. Otherwise, it might
- ;; hide the actual definition.
- (not (fboundp (nth 1 (nth 1 form)))))
- (push (cons (nth 1 (nth 1 form))
- (cons 'autoload (cdr (cdr form))))
- byte-compile-function-environment)
+ (symbolp (nth 1 (nth 1 form))))
+ ;; Don't add it if it's already defined. Otherwise, it might
+ ;; hide the actual definition. However, do remove any entry from
+ ;; byte-compile-noruntime-functions, in case we have an autoload
+ ;; of foo-func following an (eval-when-compile (require 'foo)).
+ (unless (fboundp (nth 1 (nth 1 form)))
+ (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
;; 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 (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions)
+ (setq byte-compile-noruntime-functions
+ (delq (nth 1 (nth 1 form)) byte-compile-noruntime-functions)
+ 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 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile-file-form-defvar (form)
- (when (and (symbolp (nth 1 form))
- (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
+
+(defun byte-compile--declare-var (sym)
+ (when (and (symbolp sym)
+ (not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical))
(byte-compile-warn "global/dynamic var `%s' lacks a prefix"
- (nth 1 form)))
- (push (nth 1 form) byte-compile-bound-variables)
- (if (eq (car form) 'defconst)
- (push (nth 1 form) byte-compile-const-variables))
+ sym))
+ (when (memq sym byte-compile-lexical-variables)
+ (setq byte-compile-lexical-variables
+ (delq sym byte-compile-lexical-variables))
+ (byte-compile-warn "Variable `%S' declared after its first use" sym))
+ (push sym byte-compile-bound-variables))
+
+(defun byte-compile-file-form-defvar (form)
+ (let ((sym (nth 1 form)))
+ (byte-compile--declare-var sym)
+ (if (eq (car form) 'defconst)
+ (push sym byte-compile-const-variables)))
(if (and (null (cddr form)) ;No `value' provided.
(eq (car form) 'defvar)) ;Just a declaration.
nil
'byte-compile-file-form-define-abbrev-table)
(defun byte-compile-file-form-define-abbrev-table (form)
(if (eq 'quote (car-safe (car-safe (cdr form))))
- (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
+ (byte-compile--declare-var (car-safe (cdr (cadr form)))))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
(defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (push (nth 1 (nth 1 form)) byte-compile-bound-variables)
+ (byte-compile--declare-var (nth 1 (nth 1 form)))
(byte-compile-keep-pending form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
"Return a list of the variables in the lambda argument list ARGLIST."
(remq '&rest (remq '&optional arglist)))
-(defun byte-compile-make-lambda-lexenv (form)
+(defun byte-compile-make-lambda-lexenv (args)
"Return a new lexical environment for a lambda expression FORM."
- ;; See if this is a closure or not
- (let ((args (byte-compile-arglist-vars (cadr form))))
- (let ((lexenv nil))
- ;; Fill in the initial stack contents
- (let ((stackpos 0))
- ;; Add entries for each argument
- (dolist (arg args)
- (push (cons arg stackpos) lexenv)
- (setq stackpos (1+ stackpos)))
- ;; Return the new lexical environment
- lexenv))))
+ (let* ((lexenv nil)
+ (stackpos 0))
+ ;; Add entries for each argument.
+ (dolist (arg args)
+ (push (cons arg stackpos) lexenv)
+ (setq stackpos (1+ stackpos)))
+ ;; Return the new lexical environment.
+ lexenv))
(defun byte-compile-make-args-desc (arglist)
(let ((mandatory 0)
(byte-compile-set-symbol-position 'lambda))
(byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
+ (arglistvars (byte-compile-arglist-vars arglist))
(byte-compile-bound-variables
- (append (and (not lexical-binding)
- (byte-compile-arglist-vars arglist))
+ (append (if (not lexical-binding) arglistvars)
byte-compile-bound-variables))
(body (cdr (cdr fun)))
(doc (if (stringp (car body))
;; args (since lambda expressions should be
;; closed by now).
(and lexical-binding
- (byte-compile-make-lambda-lexenv fun))
+ (byte-compile-make-lambda-lexenv
+ arglistvars))
reserved-csts)))
;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled)))
(byte-defop-compiler (/ byte-quo) byte-compile-quo)
(byte-defop-compiler nconc)
+;; Is this worth it? Both -before and -after are written in C.
(defun byte-compile-char-before (form)
- (cond ((= 2 (length form))
+ (cond ((or (= 1 (length form))
+ (and (= 2 (length form)) (not (nth 1 form))))
+ (byte-compile-form '(char-after (1- (point)))))
+ ((= 2 (length form))
(byte-compile-form (list 'char-after (if (numberp (nth 1 form))
(1- (nth 1 form))
- `(1- ,(nth 1 form))))))
- ((= 1 (length form))
- (byte-compile-form '(char-after (1- (point)))))
+ `(1- (or ,(nth 1 form)
+ (point)))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
;; backward-... ==> forward-... with negated argument.
+;; Is this worth it? Both -backward and -forward are written in C.
(defun byte-compile-backward-char (form)
- (cond ((= 2 (length form))
+ (cond ((or (= 1 (length form))
+ (and (= 2 (length form)) (not (nth 1 form))))
+ (byte-compile-form '(forward-char -1)))
+ ((= 2 (length form))
(byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
(- (nth 1 form))
- `(- ,(nth 1 form))))))
- ((= 1 (length form))
- (byte-compile-form '(forward-char -1)))
+ `(- (or ,(nth 1 form) 1))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
(defun byte-compile-backward-word (form)
- (cond ((= 2 (length form))
+ (cond ((or (= 1 (length form))
+ (and (= 2 (length form)) (not (nth 1 form))))
+ (byte-compile-form '(forward-word -1)))
+ ((= 2 (length form))
(byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
(- (nth 1 form))
- `(- ,(nth 1 form))))))
- ((= 1 (length form))
- (byte-compile-form '(forward-word -1)))
+ `(- (or ,(nth 1 form) 1))))))
(t (byte-compile-subr-wrong-args form "0-1"))))
(defun byte-compile-list (form)
"Emit byte-codes to push the initialization value for CLAUSE on the stack.
Return the offset in the form (VAR . OFFSET)."
(let* ((var (if (consp clause) (car clause) clause)))
- ;; We record the stack position even of dynamic bindings and
- ;; variables in non-stack lexical environments; we'll put
- ;; them in the proper place below.
+ ;; We record the stack position even of dynamic bindings; we'll put
+ ;; them in the proper place later.
(prog1 (cons var byte-compile-depth)
(if (consp clause)
(byte-compile-form (cadr clause))
INIT-LEXENV should be a lexical-environment alist describing the
positions of the init value that have been pushed on the stack.
Return non-nil if the TOS value was popped."
- ;; The presence of lexical bindings mean that we may have to
+ ;; The mix of lexical and dynamic bindings mean that we may have to
;; juggle things on the stack, to move them to TOS for
;; dynamic binding.
- (cond ((not (byte-compile-not-lexical-var-p var))
- ;; VAR is a simple stack-allocated lexical variable
- (push (assq var init-lexenv)
- byte-compile--lexical-environment)
- nil)
- ((eq var (caar init-lexenv))
- ;; VAR is dynamic and is on the top of the
- ;; stack, so we can just bind it like usual
- (byte-compile-dynamic-variable-bind var)
- t)
- (t
- ;; VAR is dynamic, but we have to get its
- ;; value out of the middle of the stack
- (let ((stack-pos (cdr (assq var init-lexenv))))
- (byte-compile-stack-ref stack-pos)
- (byte-compile-dynamic-variable-bind var)
- ;; Now we have to store nil into its temporary
- ;; stack position to avoid problems with GC
- (byte-compile-push-constant nil)
- (byte-compile-stack-set stack-pos))
- nil)))
-
-(defun byte-compile-unbind (clauses init-lexenv
- &optional preserve-body-value)
+ (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
+ ;; VAR is a simple stack-allocated lexical variable.
+ (progn (push (assq var init-lexenv)
+ byte-compile--lexical-environment)
+ nil)
+ ;; VAR should be dynamically bound.
+ (while (assq var byte-compile--lexical-environment)
+ ;; This dynamic binding shadows a lexical binding.
+ (setq byte-compile--lexical-environment
+ (remq (assq var byte-compile--lexical-environment)
+ byte-compile--lexical-environment)))
+ (cond
+ ((eq var (caar init-lexenv))
+ ;; VAR is dynamic and is on the top of the
+ ;; stack, so we can just bind it like usual.
+ (byte-compile-dynamic-variable-bind var)
+ t)
+ (t
+ ;; VAR is dynamic, but we have to get its
+ ;; value out of the middle of the stack.
+ (let ((stack-pos (cdr (assq var init-lexenv))))
+ (byte-compile-stack-ref stack-pos)
+ (byte-compile-dynamic-variable-bind var)
+ ;; Now we have to store nil into its temporary
+ ;; stack position so it doesn't prevent the value from being GC'd.
+ ;; FIXME: Not worth the trouble.
+ ;; (byte-compile-push-constant nil)
+ ;; (byte-compile-stack-set stack-pos)
+ )
+ nil))))
+
+(defun byte-compile-unbind (clauses init-lexenv preserve-body-value)
"Emit byte-codes to unbind the variables bound by CLAUSES.
CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
lexical-environment alist describing the positions of the init value that
then an additional value on the top of the stack, above any lexical binding
slots, is preserved, so it will be on the top of the stack after all
binding slots have been popped."
- ;; Unbind dynamic variables
+ ;; Unbind dynamic variables.
(let ((num-dynamic-bindings 0))
(dolist (clause clauses)
(unless (assq (if (consp clause) (car clause) clause)
;; Pop lexical variables off the stack, possibly preserving the
;; return value of the body.
(when init-lexenv
- ;; INIT-LEXENV contains all init values left on the stack
+ ;; INIT-LEXENV contains all init values left on the stack.
(byte-compile-discard (length init-lexenv) preserve-body-value)))
(defun byte-compile-let (form)
- "Generate code for the `let' form FORM."
+ "Generate code for the `let' or `let*' form FORM."
(let ((clauses (cadr form))
- (init-lexenv nil))
- (when (eq (car form) 'let)
+ (init-lexenv nil)
+ (is-let (eq (car form) 'let)))
+ (when is-let
;; First compute the binding values in the old scope.
(dolist (var clauses)
(push (byte-compile-push-binding-init var) init-lexenv)))
;; For `let', do it in reverse order, because it makes no
;; semantic difference, but it is a lot more efficient since the
;; values are now in reverse order on the stack.
- (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses))
- (unless (eq (car form) 'let)
+ (dolist (var (if is-let (reverse clauses) clauses))
+ (unless is-let
(push (byte-compile-push-binding-init var) init-lexenv))
(let ((var (if (consp var) (car var) var)))
- (cond ((null lexical-binding)
- ;; If there are no lexical bindings, we can do things simply.
- (byte-compile-dynamic-variable-bind var))
- ((byte-compile-bind var init-lexenv)
- (pop init-lexenv)))))
+ (if (byte-compile-bind var init-lexenv)
+ (pop init-lexenv))))
;; Emit the body.
(let ((init-stack-depth byte-compile-depth))
(byte-compile-body-do-effect (cdr (cdr form)))
- ;; Unbind the variables.
- (if lexical-binding
- ;; Unbind both lexical and dynamic variables.
- (progn
- (cl-assert (or (eq byte-compile-depth init-stack-depth)
- (eq byte-compile-depth (1+ init-stack-depth))))
- (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
- init-stack-depth)))
- ;; Unbind dynamic variables.
- (byte-compile-out 'byte-unbind (length clauses)))))))
+ ;; Unbind both lexical and dynamic variables.
+ (cl-assert (or (eq byte-compile-depth init-stack-depth)
+ (eq byte-compile-depth (1+ init-stack-depth))))
+ (byte-compile-unbind clauses init-lexenv
+ (> byte-compile-depth init-stack-depth))))))
\f
(byte-compile-set-symbol-position 'autoload)
(and (macroexp-const-p (nth 1 form))
(macroexp-const-p (nth 5 form))
- (eval (nth 5 form)) ; macro-p
+ (memq (eval (nth 5 form)) '(t macro)) ; macro-p
(not (fboundp (eval (nth 1 form))))
(byte-compile-warn
"The compiler ignores `autoload' except at top level. You should
lam))
(unless (byte-compile-file-form-defmumble
name macro arglist body rest)
+ (when macro
+ (if (null fun)
+ (message "Macro %s unrecognized, won't work in file" name)
+ (message "Macro %s partly recognized, trying our luck" name)
+ (push (cons name (eval fun))
+ byte-compile-macro-environment)))
(byte-compile-keep-pending form))))
;; We used to just do: (byte-compile-normal-call form)
'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
-
-(byte-defop-compiler-1 add-to-list byte-compile-add-to-list)
-(defun byte-compile-add-to-list (form)
- ;; FIXME: This could be used for `set' as well, except that it's got
- ;; its own opcode, so the final `byte-compile-normal-call' needs to
- ;; be replaced with something else.
- (pcase form
- (`(,fun ',var . ,_)
- (byte-compile-check-variable var 'assign)
- (if (assq var byte-compile--lexical-environment)
- (byte-compile-log-warning
- (format "%s cannot use lexical var `%s'" fun var)
- nil :error)
- (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
- (boundp var)
- (memq var byte-compile-bound-variables)
- (memq var byte-compile-free-references))
- (byte-compile-warn "assignment to free variable `%S'" var)
- (push var byte-compile-free-references)))))
- (byte-compile-normal-call form))
\f
;;; tags
HCoop / bpt / emacs.git / blobdiff