diff options
| author | Stefan Monnier | 2013-06-04 22:35:40 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-06-04 22:35:40 -0400 |
| commit | 208d0342a3bfc4f6bba6c79e43e0dc937b5ca69a (patch) | |
| tree | 6883553d749d02894eeb54ecc973b4cec21ec9a2 | |
| parent | bfa3acd65ba6e8cbaf66a4f3f61810ffba7b3fad (diff) | |
| download | emacs-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/ChangeLog | 31 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 159 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 15 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/macroexp.el | 15 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-06-05 Leo Liu <sdl.web@gmail.com> | 30 | 2013-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. |
| 413 | This list lives partly on the stack.") | 413 | This list lives partly on the stack.") |
| 414 | (defvar byte-compile-lexical-variables nil | ||
| 415 | "List of variables that have been treated as lexical. | ||
| 416 | Filled 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. |
| 3863 | Return the offset in the form (VAR . OFFSET)." | 3874 | Return 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)." | |||
| 3882 | INIT-LEXENV should be a lexical-environment alist describing the | 3892 | INIT-LEXENV should be a lexical-environment alist describing the |
| 3883 | positions of the init value that have been pushed on the stack. | 3893 | positions of the init value that have been pushed on the stack. |
| 3884 | Return non-nil if the TOS value was popped." | 3894 | Return 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. |
| 3913 | CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a | 3931 | CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a |
| 3914 | lexical-environment alist describing the positions of the init value that | 3932 | 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, | |||
| 3916 | then an additional value on the top of the stack, above any lexical binding | 3934 | then an additional value on the top of the stack, above any lexical binding |
| 3917 | slots, is preserved, so it will be on the top of the stack after all | 3935 | slots, is preserved, so it will be on the top of the stack after all |
| 3918 | binding slots have been popped." | 3936 | binding 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)) |