aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-06-04 22:35:40 -0400
committerStefan Monnier2013-06-04 22:35:40 -0400
commit208d0342a3bfc4f6bba6c79e43e0dc937b5ca69a (patch)
tree6883553d749d02894eeb54ecc973b4cec21ec9a2
parentbfa3acd65ba6e8cbaf66a4f3f61810ffba7b3fad (diff)
downloademacs-208d0342a3bfc4f6bba6c79e43e0dc937b5ca69a.tar.gz
emacs-208d0342a3bfc4f6bba6c79e43e0dc937b5ca69a.zip
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.
-rw-r--r--lisp/ChangeLog31
-rw-r--r--lisp/emacs-lisp/bytecomp.el159
-rw-r--r--lisp/emacs-lisp/cconv.el15
-rw-r--r--lisp/emacs-lisp/cl-lib.el4
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el8
-rw-r--r--lisp/emacs-lisp/macroexp.el15
7 files changed, 144 insertions, 90 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a4f52b506fb..6d9a21fda9a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,32 @@
12013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 Fix compilation error with simultaneous dynamic+lexical scoping.
4 Add warning when a defvar appears after the first let-binding.
5 * emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var.
6 (byte-compile-close-variables): Initialize it.
7 (byte-compile--declare-var): New function.
8 (byte-compile-file-form-defvar)
9 (byte-compile-file-form-define-abbrev-table)
10 (byte-compile-file-form-custom-declare-variable): Use it.
11 (byte-compile-make-lambda-lexenv): Change the argument. Simplify.
12 (byte-compile-lambda): Share call to byte-compile-arglist-vars.
13 (byte-compile-bind): Handle dynamic bindings that shadow
14 lexical bindings.
15 (byte-compile-unbind): Make arg non-optional.
16 (byte-compile-let): Simplify.
17 * emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var.
18 (cconv--analyse-function, cconv-analyse-form): Populate it.
19 Protect byte-compile-bound-variables to limit the scope of defvars.
20 (cconv-analyse-form): Add missing rule for (defvar <foo>).
21 Remove unneeded rule for `declare'.
22
23 * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2
24 so as to avoid depending on cl-adjoin at run-time.
25 * emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes.
26
27 * emacs-lisp/macroexp.el (macroexp--compiling-p): New function.
28 (macroexp--warn-and-return): Use it.
29
12013-06-05 Leo Liu <sdl.web@gmail.com> 302013-06-05 Leo Liu <sdl.web@gmail.com>
2 31
3 * eshell/esh-mode.el (eshell-mode): Fix key bindings. 32 * eshell/esh-mode.el (eshell-mode): Fix key bindings.
@@ -17,7 +46,7 @@
17 * emacs-lisp/lisp.el: Use lexical-binding. 46 * emacs-lisp/lisp.el: Use lexical-binding.
18 (lisp--local-variables-1, lisp--local-variables): New functions. 47 (lisp--local-variables-1, lisp--local-variables): New functions.
19 (lisp--local-variables-completion-table): New var. 48 (lisp--local-variables-completion-table): New var.
20 (lisp-completion-at-point): Use it to provide completion of let-bound vars. 49 (lisp-completion-at-point): Use it complete let-bound vars.
21 50
22 * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros 51 * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros
23 eagerly (bug#14422). 52 eagerly (bug#14422).
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c910acdbc14..aa28c747ff6 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -411,6 +411,9 @@ specify different fields to sort on."
411(defvar byte-compile-bound-variables nil 411(defvar byte-compile-bound-variables nil
412 "List of dynamic variables bound in the context of the current form. 412 "List of dynamic variables bound in the context of the current form.
413This list lives partly on the stack.") 413This list lives partly on the stack.")
414(defvar byte-compile-lexical-variables nil
415 "List of variables that have been treated as lexical.
416Filled in `cconv-analyse-form' but initialized and consulted here.")
414(defvar byte-compile-const-variables nil 417(defvar byte-compile-const-variables nil
415 "List of variables declared as constants during compilation of this file.") 418 "List of variables declared as constants during compilation of this file.")
416(defvar byte-compile-free-references) 419(defvar byte-compile-free-references)
@@ -1489,6 +1492,7 @@ extra args."
1489 (byte-compile--outbuffer nil) 1492 (byte-compile--outbuffer nil)
1490 (byte-compile-function-environment nil) 1493 (byte-compile-function-environment nil)
1491 (byte-compile-bound-variables nil) 1494 (byte-compile-bound-variables nil)
1495 (byte-compile-lexical-variables nil)
1492 (byte-compile-const-variables nil) 1496 (byte-compile-const-variables nil)
1493 (byte-compile-free-references nil) 1497 (byte-compile-free-references nil)
1494 (byte-compile-free-assignments nil) 1498 (byte-compile-free-assignments nil)
@@ -2245,15 +2249,24 @@ list that represents a doc string reference.
2245 2249
2246(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) 2250(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
2247(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) 2251(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
2248(defun byte-compile-file-form-defvar (form) 2252
2249 (when (and (symbolp (nth 1 form)) 2253(defun byte-compile--declare-var (sym)
2250 (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) 2254 (when (and (symbolp sym)
2255 (not (string-match "[-*/:$]" (symbol-name sym)))
2251 (byte-compile-warning-enabled-p 'lexical)) 2256 (byte-compile-warning-enabled-p 'lexical))
2252 (byte-compile-warn "global/dynamic var `%s' lacks a prefix" 2257 (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
2253 (nth 1 form))) 2258 sym))
2254 (push (nth 1 form) byte-compile-bound-variables) 2259 (when (memq sym byte-compile-lexical-variables)
2255 (if (eq (car form) 'defconst) 2260 (setq byte-compile-lexical-variables
2256 (push (nth 1 form) byte-compile-const-variables)) 2261 (delq sym byte-compile-lexical-variables))
2262 (byte-compile-warn "Variable `%S' declared after its first use" sym))
2263 (push sym byte-compile-bound-variables))
2264
2265(defun byte-compile-file-form-defvar (form)
2266 (let ((sym (nth 1 form)))
2267 (byte-compile--declare-var sym)
2268 (if (eq (car form) 'defconst)
2269 (push sym byte-compile-const-variables)))
2257 (if (and (null (cddr form)) ;No `value' provided. 2270 (if (and (null (cddr form)) ;No `value' provided.
2258 (eq (car form) 'defvar)) ;Just a declaration. 2271 (eq (car form) 'defvar)) ;Just a declaration.
2259 nil 2272 nil
@@ -2267,7 +2280,7 @@ list that represents a doc string reference.
2267 'byte-compile-file-form-define-abbrev-table) 2280 'byte-compile-file-form-define-abbrev-table)
2268(defun byte-compile-file-form-define-abbrev-table (form) 2281(defun byte-compile-file-form-define-abbrev-table (form)
2269 (if (eq 'quote (car-safe (car-safe (cdr form)))) 2282 (if (eq 'quote (car-safe (car-safe (cdr form))))
2270 (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) 2283 (byte-compile--declare-var (car-safe (cdr (cadr form)))))
2271 (byte-compile-keep-pending form)) 2284 (byte-compile-keep-pending form))
2272 2285
2273(put 'custom-declare-variable 'byte-hunk-handler 2286(put 'custom-declare-variable 'byte-hunk-handler
@@ -2275,7 +2288,7 @@ list that represents a doc string reference.
2275(defun byte-compile-file-form-custom-declare-variable (form) 2288(defun byte-compile-file-form-custom-declare-variable (form)
2276 (when (byte-compile-warning-enabled-p 'callargs) 2289 (when (byte-compile-warning-enabled-p 'callargs)
2277 (byte-compile-nogroup-warn form)) 2290 (byte-compile-nogroup-warn form))
2278 (push (nth 1 (nth 1 form)) byte-compile-bound-variables) 2291 (byte-compile--declare-var (nth 1 (nth 1 form)))
2279 (byte-compile-keep-pending form)) 2292 (byte-compile-keep-pending form))
2280 2293
2281(put 'require 'byte-hunk-handler 'byte-compile-file-form-require) 2294(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."
2576 "Return a list of the variables in the lambda argument list ARGLIST." 2589 "Return a list of the variables in the lambda argument list ARGLIST."
2577 (remq '&rest (remq '&optional arglist))) 2590 (remq '&rest (remq '&optional arglist)))
2578 2591
2579(defun byte-compile-make-lambda-lexenv (form) 2592(defun byte-compile-make-lambda-lexenv (args)
2580 "Return a new lexical environment for a lambda expression FORM." 2593 "Return a new lexical environment for a lambda expression FORM."
2581 ;; See if this is a closure or not 2594 (let* ((lexenv nil)
2582 (let ((args (byte-compile-arglist-vars (cadr form)))) 2595 (stackpos 0))
2583 (let ((lexenv nil)) 2596 ;; Add entries for each argument.
2584 ;; Fill in the initial stack contents 2597 (dolist (arg args)
2585 (let ((stackpos 0)) 2598 (push (cons arg stackpos) lexenv)
2586 ;; Add entries for each argument 2599 (setq stackpos (1+ stackpos)))
2587 (dolist (arg args) 2600 ;; Return the new lexical environment.
2588 (push (cons arg stackpos) lexenv) 2601 lexenv))
2589 (setq stackpos (1+ stackpos)))
2590 ;; Return the new lexical environment
2591 lexenv))))
2592 2602
2593(defun byte-compile-make-args-desc (arglist) 2603(defun byte-compile-make-args-desc (arglist)
2594 (let ((mandatory 0) 2604 (let ((mandatory 0)
@@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself."
2626 (byte-compile-set-symbol-position 'lambda)) 2636 (byte-compile-set-symbol-position 'lambda))
2627 (byte-compile-check-lambda-list (nth 1 fun)) 2637 (byte-compile-check-lambda-list (nth 1 fun))
2628 (let* ((arglist (nth 1 fun)) 2638 (let* ((arglist (nth 1 fun))
2639 (arglistvars (byte-compile-arglist-vars arglist))
2629 (byte-compile-bound-variables 2640 (byte-compile-bound-variables
2630 (append (and (not lexical-binding) 2641 (append (if (not lexical-binding) arglistvars)
2631 (byte-compile-arglist-vars arglist))
2632 byte-compile-bound-variables)) 2642 byte-compile-bound-variables))
2633 (body (cdr (cdr fun))) 2643 (body (cdr (cdr fun)))
2634 (doc (if (stringp (car body)) 2644 (doc (if (stringp (car body))
@@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself."
2676 ;; args (since lambda expressions should be 2686 ;; args (since lambda expressions should be
2677 ;; closed by now). 2687 ;; closed by now).
2678 (and lexical-binding 2688 (and lexical-binding
2679 (byte-compile-make-lambda-lexenv fun)) 2689 (byte-compile-make-lambda-lexenv
2690 arglistvars))
2680 reserved-csts))) 2691 reserved-csts)))
2681 ;; Build the actual byte-coded function. 2692 ;; Build the actual byte-coded function.
2682 (cl-assert (eq 'byte-code (car-safe compiled))) 2693 (cl-assert (eq 'byte-code (car-safe compiled)))
@@ -3862,9 +3873,8 @@ that suppresses all warnings during execution of BODY."
3862 "Emit byte-codes to push the initialization value for CLAUSE on the stack. 3873 "Emit byte-codes to push the initialization value for CLAUSE on the stack.
3863Return the offset in the form (VAR . OFFSET)." 3874Return the offset in the form (VAR . OFFSET)."
3864 (let* ((var (if (consp clause) (car clause) clause))) 3875 (let* ((var (if (consp clause) (car clause) clause)))
3865 ;; We record the stack position even of dynamic bindings and 3876 ;; We record the stack position even of dynamic bindings; we'll put
3866 ;; variables in non-stack lexical environments; we'll put 3877 ;; them in the proper place later.
3867 ;; them in the proper place below.
3868 (prog1 (cons var byte-compile-depth) 3878 (prog1 (cons var byte-compile-depth)
3869 (if (consp clause) 3879 (if (consp clause)
3870 (byte-compile-form (cadr clause)) 3880 (byte-compile-form (cadr clause))
@@ -3882,33 +3892,41 @@ Return the offset in the form (VAR . OFFSET)."
3882INIT-LEXENV should be a lexical-environment alist describing the 3892INIT-LEXENV should be a lexical-environment alist describing the
3883positions of the init value that have been pushed on the stack. 3893positions of the init value that have been pushed on the stack.
3884Return non-nil if the TOS value was popped." 3894Return non-nil if the TOS value was popped."
3885 ;; The presence of lexical bindings mean that we may have to 3895 ;; The mix of lexical and dynamic bindings mean that we may have to
3886 ;; juggle things on the stack, to move them to TOS for 3896 ;; juggle things on the stack, to move them to TOS for
3887 ;; dynamic binding. 3897 ;; dynamic binding.
3888 (cond ((not (byte-compile-not-lexical-var-p var)) 3898 (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
3889 ;; VAR is a simple stack-allocated lexical variable 3899 ;; VAR is a simple stack-allocated lexical variable.
3890 (push (assq var init-lexenv) 3900 (progn (push (assq var init-lexenv)
3891 byte-compile--lexical-environment) 3901 byte-compile--lexical-environment)
3892 nil) 3902 nil)
3893 ((eq var (caar init-lexenv)) 3903 ;; VAR should be dynamically bound.
3894 ;; VAR is dynamic and is on the top of the 3904 (while (assq var byte-compile--lexical-environment)
3895 ;; stack, so we can just bind it like usual 3905 ;; This dynamic binding shadows a lexical binding.
3896 (byte-compile-dynamic-variable-bind var) 3906 (setq byte-compile--lexical-environment
3897 t) 3907 (remq (assq var byte-compile--lexical-environment)
3898 (t 3908 byte-compile--lexical-environment)))
3899 ;; VAR is dynamic, but we have to get its 3909 (cond
3900 ;; value out of the middle of the stack 3910 ((eq var (caar init-lexenv))
3901 (let ((stack-pos (cdr (assq var init-lexenv)))) 3911 ;; VAR is dynamic and is on the top of the
3902 (byte-compile-stack-ref stack-pos) 3912 ;; stack, so we can just bind it like usual.
3903 (byte-compile-dynamic-variable-bind var) 3913 (byte-compile-dynamic-variable-bind var)
3904 ;; Now we have to store nil into its temporary 3914 t)
3905 ;; stack position to avoid problems with GC 3915 (t
3906 (byte-compile-push-constant nil) 3916 ;; VAR is dynamic, but we have to get its
3907 (byte-compile-stack-set stack-pos)) 3917 ;; value out of the middle of the stack.
3908 nil))) 3918 (let ((stack-pos (cdr (assq var init-lexenv))))
3909 3919 (byte-compile-stack-ref stack-pos)
3910(defun byte-compile-unbind (clauses init-lexenv 3920 (byte-compile-dynamic-variable-bind var)
3911 &optional preserve-body-value) 3921 ;; Now we have to store nil into its temporary
3922 ;; stack position so it doesn't prevent the value from being GC'd.
3923 ;; FIXME: Not worth the trouble.
3924 ;; (byte-compile-push-constant nil)
3925 ;; (byte-compile-stack-set stack-pos)
3926 )
3927 nil))))
3928
3929(defun byte-compile-unbind (clauses init-lexenv preserve-body-value)
3912 "Emit byte-codes to unbind the variables bound by CLAUSES. 3930 "Emit byte-codes to unbind the variables bound by CLAUSES.
3913CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a 3931CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
3914lexical-environment alist describing the positions of the init value that 3932lexical-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,
3916then an additional value on the top of the stack, above any lexical binding 3934then an additional value on the top of the stack, above any lexical binding
3917slots, is preserved, so it will be on the top of the stack after all 3935slots, is preserved, so it will be on the top of the stack after all
3918binding slots have been popped." 3936binding slots have been popped."
3919 ;; Unbind dynamic variables 3937 ;; Unbind dynamic variables.
3920 (let ((num-dynamic-bindings 0)) 3938 (let ((num-dynamic-bindings 0))
3921 (dolist (clause clauses) 3939 (dolist (clause clauses)
3922 (unless (assq (if (consp clause) (car clause) clause) 3940 (unless (assq (if (consp clause) (car clause) clause)
@@ -3927,14 +3945,15 @@ binding slots have been popped."
3927 ;; Pop lexical variables off the stack, possibly preserving the 3945 ;; Pop lexical variables off the stack, possibly preserving the
3928 ;; return value of the body. 3946 ;; return value of the body.
3929 (when init-lexenv 3947 (when init-lexenv
3930 ;; INIT-LEXENV contains all init values left on the stack 3948 ;; INIT-LEXENV contains all init values left on the stack.
3931 (byte-compile-discard (length init-lexenv) preserve-body-value))) 3949 (byte-compile-discard (length init-lexenv) preserve-body-value)))
3932 3950
3933(defun byte-compile-let (form) 3951(defun byte-compile-let (form)
3934 "Generate code for the `let' form FORM." 3952 "Generate code for the `let' or `let*' form FORM."
3935 (let ((clauses (cadr form)) 3953 (let ((clauses (cadr form))
3936 (init-lexenv nil)) 3954 (init-lexenv nil)
3937 (when (eq (car form) 'let) 3955 (is-let (eq (car form) 'let)))
3956 (when is-let
3938 ;; First compute the binding values in the old scope. 3957 ;; First compute the binding values in the old scope.
3939 (dolist (var clauses) 3958 (dolist (var clauses)
3940 (push (byte-compile-push-binding-init var) init-lexenv))) 3959 (push (byte-compile-push-binding-init var) init-lexenv)))
@@ -3946,28 +3965,20 @@ binding slots have been popped."
3946 ;; For `let', do it in reverse order, because it makes no 3965 ;; For `let', do it in reverse order, because it makes no
3947 ;; semantic difference, but it is a lot more efficient since the 3966 ;; semantic difference, but it is a lot more efficient since the
3948 ;; values are now in reverse order on the stack. 3967 ;; values are now in reverse order on the stack.
3949 (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses)) 3968 (dolist (var (if is-let (reverse clauses) clauses))
3950 (unless (eq (car form) 'let) 3969 (unless is-let
3951 (push (byte-compile-push-binding-init var) init-lexenv)) 3970 (push (byte-compile-push-binding-init var) init-lexenv))
3952 (let ((var (if (consp var) (car var) var))) 3971 (let ((var (if (consp var) (car var) var)))
3953 (cond ((null lexical-binding) 3972 (if (byte-compile-bind var init-lexenv)
3954 ;; If there are no lexical bindings, we can do things simply. 3973 (pop init-lexenv))))
3955 (byte-compile-dynamic-variable-bind var))
3956 ((byte-compile-bind var init-lexenv)
3957 (pop init-lexenv)))))
3958 ;; Emit the body. 3974 ;; Emit the body.
3959 (let ((init-stack-depth byte-compile-depth)) 3975 (let ((init-stack-depth byte-compile-depth))
3960 (byte-compile-body-do-effect (cdr (cdr form))) 3976 (byte-compile-body-do-effect (cdr (cdr form)))
3961 ;; Unbind the variables. 3977 ;; Unbind both lexical and dynamic variables.
3962 (if lexical-binding 3978 (cl-assert (or (eq byte-compile-depth init-stack-depth)
3963 ;; Unbind both lexical and dynamic variables. 3979 (eq byte-compile-depth (1+ init-stack-depth))))
3964 (progn 3980 (byte-compile-unbind clauses init-lexenv
3965 (cl-assert (or (eq byte-compile-depth init-stack-depth) 3981 (> byte-compile-depth init-stack-depth))))))
3966 (eq byte-compile-depth (1+ init-stack-depth))))
3967 (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
3968 init-stack-depth)))
3969 ;; Unbind dynamic variables.
3970 (byte-compile-out 'byte-unbind (length clauses)))))))
3971 3982
3972 3983
3973 3984
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ee84a9f69ba..761e33c059d 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -81,7 +81,6 @@
81;; and other oddities. 81;; and other oddities.
82;; - new byte codes for unwind-protect, catch, and condition-case so that 82;; - new byte codes for unwind-protect, catch, and condition-case so that
83;; closures aren't needed at all. 83;; closures aren't needed at all.
84;; - inline source code of different binding mode by first compiling it.
85;; - a reference to a var that is known statically to always hold a constant 84;; - a reference to a var that is known statically to always hold a constant
86;; should be turned into a byte-constant rather than a byte-stack-ref. 85;; should be turned into a byte-constant rather than a byte-stack-ref.
87;; Hmm... right, that's called constant propagation and could be done here, 86;; Hmm... right, that's called constant propagation and could be done here,
@@ -95,6 +94,7 @@
95 94
96;; (defmacro dlet (binders &rest body) 95;; (defmacro dlet (binders &rest body)
97;; ;; Works in both lexical and non-lexical mode. 96;; ;; Works in both lexical and non-lexical mode.
97;; (declare (indent 1) (debug let))
98;; `(progn 98;; `(progn
99;; ,@(mapcar (lambda (binder) 99;; ,@(mapcar (lambda (binder)
100;; `(defvar ,(if (consp binder) (car binder) binder))) 100;; `(defvar ,(if (consp binder) (car binder) binder)))
@@ -489,6 +489,7 @@ places where they originally did not directly appear."
489(unless (fboundp 'byte-compile-not-lexical-var-p) 489(unless (fboundp 'byte-compile-not-lexical-var-p)
490 ;; Only used to test the code in non-lexbind Emacs. 490 ;; Only used to test the code in non-lexbind Emacs.
491 (defalias 'byte-compile-not-lexical-var-p 'boundp)) 491 (defalias 'byte-compile-not-lexical-var-p 'boundp))
492(defvar byte-compile-lexical-variables)
492 493
493(defun cconv--analyse-use (vardata form varkind) 494(defun cconv--analyse-use (vardata form varkind)
494 "Analyze the use of a variable. 495 "Analyze the use of a variable.
@@ -530,6 +531,7 @@ FORM is the parent form that binds this var."
530 ;; outside of it. 531 ;; outside of it.
531 (envcopy 532 (envcopy
532 (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) 533 (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
534 (byte-compile-bound-variables byte-compile-bound-variables)
533 (newenv envcopy)) 535 (newenv envcopy))
534 ;; Push it before recursing, so cconv-freevars-alist contains entries in 536 ;; Push it before recursing, so cconv-freevars-alist contains entries in
535 ;; the order they'll be used by closure-convert-rec. 537 ;; the order they'll be used by closure-convert-rec.
@@ -541,6 +543,7 @@ FORM is the parent form that binds this var."
541 (format "Argument %S is not a lexical variable" arg))) 543 (format "Argument %S is not a lexical variable" arg)))
542 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... 544 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
543 (t (let ((varstruct (list arg nil nil nil nil))) 545 (t (let ((varstruct (list arg nil nil nil nil)))
546 (cl-pushnew arg byte-compile-lexical-variables)
544 (push (cons (list arg) (cdr varstruct)) newvars) 547 (push (cons (list arg) (cdr varstruct)) newvars)
545 (push varstruct newenv))))) 548 (push varstruct newenv)))))
546 (dolist (form body) ;Analyze body forms. 549 (dolist (form body) ;Analyze body forms.
@@ -579,6 +582,7 @@ and updates the data stored in ENV."
579 (let ((orig-env env) 582 (let ((orig-env env)
580 (newvars nil) 583 (newvars nil)
581 (var nil) 584 (var nil)
585 (byte-compile-bound-variables byte-compile-bound-variables)
582 (value nil)) 586 (value nil))
583 (dolist (binder binders) 587 (dolist (binder binders)
584 (if (not (consp binder)) 588 (if (not (consp binder))
@@ -592,6 +596,7 @@ and updates the data stored in ENV."
592 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) 596 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
593 597
594 (unless (byte-compile-not-lexical-var-p var) 598 (unless (byte-compile-not-lexical-var-p var)
599 (cl-pushnew var byte-compile-lexical-variables)
595 (let ((varstruct (list var nil nil nil nil))) 600 (let ((varstruct (list var nil nil nil nil)))
596 (push (cons binder (cdr varstruct)) newvars) 601 (push (cons binder (cdr varstruct)) newvars)
597 (push varstruct env)))) 602 (push varstruct env))))
@@ -616,7 +621,8 @@ and updates the data stored in ENV."
616 621
617 (`((lambda . ,_) . ,_) ; First element is lambda expression. 622 (`((lambda . ,_) . ,_) ; First element is lambda expression.
618 (byte-compile-log-warning 623 (byte-compile-log-warning
619 "Use of deprecated ((lambda ...) ...) form" t :warning) 624 (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
625 t :warning)
620 (dolist (exp `((function ,(car form)) . ,(cdr form))) 626 (dolist (exp `((function ,(car form)) . ,(cdr form)))
621 (cconv-analyse-form exp env))) 627 (cconv-analyse-form exp env)))
622 628
@@ -645,6 +651,7 @@ and updates the data stored in ENV."
645 (`(track-mouse . ,body) 651 (`(track-mouse . ,body)
646 (cconv--analyse-function () body env form)) 652 (cconv--analyse-function () body env form))
647 653
654 (`(defvar ,var) (push var byte-compile-bound-variables))
648 (`(,(or `defconst `defvar) ,var ,value . ,_) 655 (`(,(or `defconst `defvar) ,var ,value . ,_)
649 (push var byte-compile-bound-variables) 656 (push var byte-compile-bound-variables)
650 (cconv-analyse-form value env)) 657 (cconv-analyse-form value env))
@@ -668,7 +675,9 @@ and updates the data stored in ENV."
668 ;; seem worth the trouble. 675 ;; seem worth the trouble.
669 (dolist (form forms) (cconv-analyse-form form nil))) 676 (dolist (form forms) (cconv-analyse-form form nil)))
670 677
671 (`(declare . ,_) nil) ;The args don't contain code. 678 ;; `declare' should now be macro-expanded away (and if they're not, we're
679 ;; in trouble because they *can* contain code nowadays).
680 ;; (`(declare . ,_) nil) ;The args don't contain code.
672 681
673 (`(,_ . ,body-forms) ; First element is a function or whatever. 682 (`(,_ . ,body-forms) ; First element is a function or whatever.
674 (dolist (form body-forms) (cconv-analyse-form form env))) 683 (dolist (form body-forms) (cconv-analyse-form form env)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index f3bf70b0190..52f123c83ec 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -156,8 +156,8 @@ an element already on the list.
156 ;; earlier and should have triggered them already. 156 ;; earlier and should have triggered them already.
157 (with-no-warnings ,place) 157 (with-no-warnings ,place)
158 (setq ,place (cons ,var ,place)))) 158 (setq ,place (cons ,var ,place))))
159 (list 'setq place (cl-list* 'cl-adjoin x place keys))) 159 `(setq ,place (cl-adjoin ,x ,place ,@keys)))
160 (cl-list* 'cl-callf2 'cl-adjoin x place keys))) 160 `(cl-callf2 cl-adjoin ,x ,place ,@keys)))
161 161
162(defun cl--set-elt (seq n val) 162(defun cl--set-elt (seq n val)
163 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) 163 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index af19db63f30..33ee7c0bbd2 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when 267;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp 268;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) 269;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
270;;;;;; "cl-macs" "cl-macs.el" "b839ad3781c4f2f849df0639b4eba166") 270;;;;;; "cl-macs" "cl-macs.el" "80cb53f97b21adb6069c43c38a2e094d")
271;;; Generated autoloads from cl-macs.el 271;;; Generated autoloads from cl-macs.el
272 272
273(autoload 'cl--compiler-macro-list* "cl-macs" "\ 273(autoload 'cl--compiler-macro-list* "cl-macs" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 4aae2c6efe5..66ad8e769b5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2763,10 +2763,10 @@ surrounded by (cl-block NAME ...).
2763 2763
2764;;;###autoload 2764;;;###autoload
2765(defun cl--compiler-macro-adjoin (form a list &rest keys) 2765(defun cl--compiler-macro-adjoin (form a list &rest keys)
2766 (if (and (cl--simple-expr-p a) (cl--simple-expr-p list) 2766 (if (memq :key keys) form
2767 (not (memq :key keys))) 2767 (macroexp-let2 macroexp-copyable-p va a
2768 `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) 2768 (macroexp-let2 macroexp-copyable-p vlist list
2769 form)) 2769 `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
2770 2770
2771(defun cl--compiler-macro-get (_form sym prop &optional def) 2771(defun cl--compiler-macro-get (_form sym prop &optional def)
2772 (if def 2772 (if def
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 6bb796434fd..e8b513fcd3e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -111,15 +111,20 @@ and also to avoid outputting the warning during normal execution."
111 (funcall (eval (cadr form))) 111 (funcall (eval (cadr form)))
112 (byte-compile-constant nil))) 112 (byte-compile-constant nil)))
113 113
114(defun macroexp--compiling-p ()
115 "Return non-nil if we're macroexpanding for the compiler."
116 ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
117 ;; macro-expansion will be processed by the byte-compiler, we check
118 ;; circumstantial evidence.
119 (member '(declare-function . byte-compile-macroexpand-declare-function)
120 macroexpand-all-environment))
121
122
114(defun macroexp--warn-and-return (msg form) 123(defun macroexp--warn-and-return (msg form)
115 (let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) 124 (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
116 (cond 125 (cond
117 ((null msg) form) 126 ((null msg) form)
118 ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this 127 ((macroexp--compiling-p)
119 ;; macro-expansion will be processed by the byte-compiler, we check
120 ;; circumstantial evidence.
121 ((member '(declare-function . byte-compile-macroexpand-declare-function)
122 macroexpand-all-environment)
123 `(progn 128 `(progn
124 (macroexp--funcall-if-compiled ',when-compiled) 129 (macroexp--funcall-if-compiled ',when-compiled)
125 ,form)) 130 ,form))