mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-07 23:10:28 -08:00
Fix compilation error with simultaneous dynamic+lexical scoping.
Add warning when a defvar appears after the first let-binding. * lisp/emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var. (byte-compile-close-variables): Initialize it. (byte-compile--declare-var): New function. (byte-compile-file-form-defvar) (byte-compile-file-form-define-abbrev-table) (byte-compile-file-form-custom-declare-variable): Use it. (byte-compile-make-lambda-lexenv): Change the argument. Simplify. (byte-compile-lambda): Share call to byte-compile-arglist-vars. (byte-compile-bind): Handle dynamic bindings that shadow lexical bindings. (byte-compile-unbind): Make arg non-optional. (byte-compile-let): Simplify. * lisp/emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var. (cconv--analyse-function, cconv-analyse-form): Populate it. Protect byte-compile-bound-variables to limit the scope of defvars. (cconv-analyse-form): Add missing rule for (defvar <foo>). Remove unneeded rule for `declare'. * lisp/emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2 so as to avoid depending on cl-adjoin at run-time. * lisp/emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes. * lisp/emacs-lisp/macroexp.el (macroexp--compiling-p): New function. (macroexp--warn-and-return): Use it.
This commit is contained in:
parent
bfa3acd65b
commit
208d0342a3
7 changed files with 143 additions and 89 deletions
|
|
@ -411,6 +411,9 @@ specify different fields to sort on."
|
|||
(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)
|
||||
|
|
@ -1489,6 +1492,7 @@ extra args."
|
|||
(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)
|
||||
|
|
@ -2245,15 +2249,24 @@ list that represents a doc string reference.
|
|||
|
||||
(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
|
||||
|
|
@ -2267,7 +2280,7 @@ list that represents a doc string reference.
|
|||
'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
|
||||
|
|
@ -2275,7 +2288,7 @@ list that represents a doc string reference.
|
|||
(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)
|
||||
|
|
@ -2576,19 +2589,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
"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)
|
||||
|
|
@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself."
|
|||
(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))
|
||||
|
|
@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself."
|
|||
;; 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)))
|
||||
|
|
@ -3862,9 +3873,8 @@ that suppresses all warnings during execution of BODY."
|
|||
"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))
|
||||
|
|
@ -3882,33 +3892,41 @@ Return the offset in the form (VAR . OFFSET)."
|
|||
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)))
|
||||
(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
|
||||
&optional preserve-body-value)
|
||||
(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
|
||||
|
|
@ -3916,7 +3934,7 @@ have been pushed on the stack. If PRESERVE-BODY-VALUE is true,
|
|||
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)
|
||||
|
|
@ -3927,14 +3945,15 @@ binding slots have been popped."
|
|||
;; 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)))
|
||||
|
|
@ -3946,28 +3965,20 @@ binding slots have been popped."
|
|||
;; 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))))))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue