Commit 208d0342 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent bfa3acd6
2013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
Fix compilation error with simultaneous dynamic+lexical scoping.
Add warning when a defvar appears after the first let-binding.
* 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.
* 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'.
* emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2
so as to avoid depending on cl-adjoin at run-time.
* emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes.
* emacs-lisp/macroexp.el (macroexp--compiling-p): New function.
(macroexp--warn-and-return): Use it.
2013-06-05 Leo Liu <sdl.web@gmail.com> 2013-06-05 Leo Liu <sdl.web@gmail.com>
   
* eshell/esh-mode.el (eshell-mode): Fix key bindings. * eshell/esh-mode.el (eshell-mode): Fix key bindings.
...@@ -17,7 +46,7 @@ ...@@ -17,7 +46,7 @@
* emacs-lisp/lisp.el: Use lexical-binding. * emacs-lisp/lisp.el: Use lexical-binding.
(lisp--local-variables-1, lisp--local-variables): New functions. (lisp--local-variables-1, lisp--local-variables): New functions.
(lisp--local-variables-completion-table): New var. (lisp--local-variables-completion-table): New var.
(lisp-completion-at-point): Use it to provide completion of let-bound vars. (lisp-completion-at-point): Use it complete let-bound vars.
   
* emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros
eagerly (bug#14422). eagerly (bug#14422).
...@@ -411,6 +411,9 @@ specify different fields to sort on." ...@@ -411,6 +411,9 @@ specify different fields to sort on."
(defvar byte-compile-bound-variables nil (defvar byte-compile-bound-variables nil
"List of dynamic variables bound in the context of the current form. "List of dynamic variables bound in the context of the current form.
This list lives partly on the stack.") 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 (defvar byte-compile-const-variables nil
"List of variables declared as constants during compilation of this file.") "List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references) (defvar byte-compile-free-references)
...@@ -1489,6 +1492,7 @@ extra args." ...@@ -1489,6 +1492,7 @@ extra args."
(byte-compile--outbuffer nil) (byte-compile--outbuffer nil)
(byte-compile-function-environment nil) (byte-compile-function-environment nil)
(byte-compile-bound-variables nil) (byte-compile-bound-variables nil)
(byte-compile-lexical-variables nil)
(byte-compile-const-variables nil) (byte-compile-const-variables nil)
(byte-compile-free-references nil) (byte-compile-free-references nil)
(byte-compile-free-assignments nil) (byte-compile-free-assignments nil)
...@@ -2245,15 +2249,24 @@ list that represents a doc string reference. ...@@ -2245,15 +2249,24 @@ list that represents a doc string reference.
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst '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)) (defun byte-compile--declare-var (sym)
(not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) (when (and (symbolp sym)
(not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical)) (byte-compile-warning-enabled-p 'lexical))
(byte-compile-warn "global/dynamic var `%s' lacks a prefix" (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
(nth 1 form))) sym))
(push (nth 1 form) byte-compile-bound-variables) (when (memq sym byte-compile-lexical-variables)
(if (eq (car form) 'defconst) (setq byte-compile-lexical-variables
(push (nth 1 form) byte-compile-const-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. (if (and (null (cddr form)) ;No `value' provided.
(eq (car form) 'defvar)) ;Just a declaration. (eq (car form) 'defvar)) ;Just a declaration.
nil nil
...@@ -2267,7 +2280,7 @@ list that represents a doc string reference. ...@@ -2267,7 +2280,7 @@ list that represents a doc string reference.
'byte-compile-file-form-define-abbrev-table) 'byte-compile-file-form-define-abbrev-table)
(defun byte-compile-file-form-define-abbrev-table (form) (defun byte-compile-file-form-define-abbrev-table (form)
(if (eq 'quote (car-safe (car-safe (cdr 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)) (byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler (put 'custom-declare-variable 'byte-hunk-handler
...@@ -2275,7 +2288,7 @@ list that represents a doc string reference. ...@@ -2275,7 +2288,7 @@ list that represents a doc string reference.
(defun byte-compile-file-form-custom-declare-variable (form) (defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs) (when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form)) (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)) (byte-compile-keep-pending form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (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,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." "Return a list of the variables in the lambda argument list ARGLIST."
(remq '&rest (remq '&optional 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." "Return a new lexical environment for a lambda expression FORM."
;; See if this is a closure or not (let* ((lexenv nil)
(let ((args (byte-compile-arglist-vars (cadr form)))) (stackpos 0))
(let ((lexenv nil)) ;; Add entries for each argument.
;; Fill in the initial stack contents (dolist (arg args)
(let ((stackpos 0)) (push (cons arg stackpos) lexenv)
;; Add entries for each argument (setq stackpos (1+ stackpos)))
(dolist (arg args) ;; Return the new lexical environment.
(push (cons arg stackpos) lexenv) lexenv))
(setq stackpos (1+ stackpos)))
;; Return the new lexical environment
lexenv))))
(defun byte-compile-make-args-desc (arglist) (defun byte-compile-make-args-desc (arglist)
(let ((mandatory 0) (let ((mandatory 0)
...@@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself." ...@@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself."
(byte-compile-set-symbol-position 'lambda)) (byte-compile-set-symbol-position 'lambda))
(byte-compile-check-lambda-list (nth 1 fun)) (byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun)) (let* ((arglist (nth 1 fun))
(arglistvars (byte-compile-arglist-vars arglist))
(byte-compile-bound-variables (byte-compile-bound-variables
(append (and (not lexical-binding) (append (if (not lexical-binding) arglistvars)
(byte-compile-arglist-vars arglist))
byte-compile-bound-variables)) byte-compile-bound-variables))
(body (cdr (cdr fun))) (body (cdr (cdr fun)))
(doc (if (stringp (car body)) (doc (if (stringp (car body))
...@@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself." ...@@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself."
;; args (since lambda expressions should be ;; args (since lambda expressions should be
;; closed by now). ;; closed by now).
(and lexical-binding (and lexical-binding
(byte-compile-make-lambda-lexenv fun)) (byte-compile-make-lambda-lexenv
arglistvars))
reserved-csts))) reserved-csts)))
;; Build the actual byte-coded function. ;; Build the actual byte-coded function.
(cl-assert (eq 'byte-code (car-safe compiled))) (cl-assert (eq 'byte-code (car-safe compiled)))
...@@ -3862,9 +3873,8 @@ that suppresses all warnings during execution of BODY." ...@@ -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. "Emit byte-codes to push the initialization value for CLAUSE on the stack.
Return the offset in the form (VAR . OFFSET)." Return the offset in the form (VAR . OFFSET)."
(let* ((var (if (consp clause) (car clause) clause))) (let* ((var (if (consp clause) (car clause) clause)))
;; We record the stack position even of dynamic bindings and ;; We record the stack position even of dynamic bindings; we'll put
;; variables in non-stack lexical environments; we'll put ;; them in the proper place later.
;; them in the proper place below.
(prog1 (cons var byte-compile-depth) (prog1 (cons var byte-compile-depth)
(if (consp clause) (if (consp clause)
(byte-compile-form (cadr clause)) (byte-compile-form (cadr clause))
...@@ -3882,33 +3892,41 @@ Return the offset in the form (VAR . OFFSET)." ...@@ -3882,33 +3892,41 @@ Return the offset in the form (VAR . OFFSET)."
INIT-LEXENV should be a lexical-environment alist describing the INIT-LEXENV should be a lexical-environment alist describing the
positions of the init value that have been pushed on the stack. positions of the init value that have been pushed on the stack.
Return non-nil if the TOS value was popped." 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 ;; juggle things on the stack, to move them to TOS for
;; dynamic binding. ;; dynamic binding.
(cond ((not (byte-compile-not-lexical-var-p var)) (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
;; VAR is a simple stack-allocated lexical variable ;; VAR is a simple stack-allocated lexical variable.
(push (assq var init-lexenv) (progn (push (assq var init-lexenv)
byte-compile--lexical-environment) byte-compile--lexical-environment)
nil) nil)
((eq var (caar init-lexenv)) ;; VAR should be dynamically bound.
;; VAR is dynamic and is on the top of the (while (assq var byte-compile--lexical-environment)
;; stack, so we can just bind it like usual ;; This dynamic binding shadows a lexical binding.
(byte-compile-dynamic-variable-bind var) (setq byte-compile--lexical-environment
t) (remq (assq var byte-compile--lexical-environment)
(t byte-compile--lexical-environment)))
;; VAR is dynamic, but we have to get its (cond
;; value out of the middle of the stack ((eq var (caar init-lexenv))
(let ((stack-pos (cdr (assq var init-lexenv)))) ;; VAR is dynamic and is on the top of the
(byte-compile-stack-ref stack-pos) ;; stack, so we can just bind it like usual.
(byte-compile-dynamic-variable-bind var) (byte-compile-dynamic-variable-bind var)
;; Now we have to store nil into its temporary t)
;; stack position to avoid problems with GC (t
(byte-compile-push-constant nil) ;; VAR is dynamic, but we have to get its
(byte-compile-stack-set stack-pos)) ;; value out of the middle of the stack.
nil))) (let ((stack-pos (cdr (assq var init-lexenv))))
(byte-compile-stack-ref stack-pos)
(defun byte-compile-unbind (clauses init-lexenv (byte-compile-dynamic-variable-bind var)
&optional preserve-body-value) ;; 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. "Emit byte-codes to unbind the variables bound by CLAUSES.
CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
lexical-environment alist describing the positions of the init value that 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,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 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 slots, is preserved, so it will be on the top of the stack after all
binding slots have been popped." binding slots have been popped."
;; Unbind dynamic variables ;; Unbind dynamic variables.
(let ((num-dynamic-bindings 0)) (let ((num-dynamic-bindings 0))
(dolist (clause clauses) (dolist (clause clauses)
(unless (assq (if (consp clause) (car clause) clause) (unless (assq (if (consp clause) (car clause) clause)
...@@ -3927,14 +3945,15 @@ binding slots have been popped." ...@@ -3927,14 +3945,15 @@ binding slots have been popped."
;; Pop lexical variables off the stack, possibly preserving the ;; Pop lexical variables off the stack, possibly preserving the
;; return value of the body. ;; return value of the body.
(when init-lexenv (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))) (byte-compile-discard (length init-lexenv) preserve-body-value)))
(defun byte-compile-let (form) (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)) (let ((clauses (cadr form))
(init-lexenv nil)) (init-lexenv nil)
(when (eq (car form) 'let) (is-let (eq (car form) 'let)))
(when is-let
;; First compute the binding values in the old scope. ;; First compute the binding values in the old scope.
(dolist (var clauses) (dolist (var clauses)
(push (byte-compile-push-binding-init var) init-lexenv))) (push (byte-compile-push-binding-init var) init-lexenv)))
...@@ -3946,28 +3965,20 @@ binding slots have been popped." ...@@ -3946,28 +3965,20 @@ binding slots have been popped."
;; For `let', do it in reverse order, because it makes no ;; For `let', do it in reverse order, because it makes no
;; semantic difference, but it is a lot more efficient since the ;; semantic difference, but it is a lot more efficient since the
;; values are now in reverse order on the stack. ;; values are now in reverse order on the stack.
(dolist (var (if (eq (car form) 'let) (reverse clauses) clauses)) (dolist (var (if is-let (reverse clauses) clauses))
(unless (eq (car form) 'let) (unless is-let
(push (byte-compile-push-binding-init var) init-lexenv)) (push (byte-compile-push-binding-init var) init-lexenv))
(let ((var (if (consp var) (car var) var))) (let ((var (if (consp var) (car var) var)))
(cond ((null lexical-binding) (if (byte-compile-bind var init-lexenv)
;; If there are no lexical bindings, we can do things simply. (pop init-lexenv))))
(byte-compile-dynamic-variable-bind var))
((byte-compile-bind var init-lexenv)
(pop init-lexenv)))))
;; Emit the body. ;; Emit the body.
(let ((init-stack-depth byte-compile-depth)) (let ((init-stack-depth byte-compile-depth))
(byte-compile-body-do-effect (cdr (cdr form))) (byte-compile-body-do-effect (cdr (cdr form)))
;; Unbind the variables. ;; Unbind both lexical and dynamic variables.
(if lexical-binding (cl-assert (or (eq byte-compile-depth init-stack-depth)
;; Unbind both lexical and dynamic variables. (eq byte-compile-depth (1+ init-stack-depth))))
(progn (byte-compile-unbind clauses init-lexenv
(cl-assert (or (eq byte-compile-depth init-stack-depth) (> 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)))))))
......
...@@ -81,7 +81,6 @@ ...@@ -81,7 +81,6 @@
;; and other oddities. ;; and other oddities.
;; - new byte codes for unwind-protect, catch, and condition-case so that ;; - new byte codes for unwind-protect, catch, and condition-case so that
;; closures aren't needed at all. ;; closures aren't needed at all.
;; - inline source code of different binding mode by first compiling it.
;; - a reference to a var that is known statically to always hold a constant ;; - a reference to a var that is known statically to always hold a constant
;; should be turned into a byte-constant rather than a byte-stack-ref. ;; should be turned into a byte-constant rather than a byte-stack-ref.
;; Hmm... right, that's called constant propagation and could be done here, ;; Hmm... right, that's called constant propagation and could be done here,
...@@ -95,6 +94,7 @@ ...@@ -95,6 +94,7 @@
;; (defmacro dlet (binders &rest body) ;; (defmacro dlet (binders &rest body)
;; ;; Works in both lexical and non-lexical mode. ;; ;; Works in both lexical and non-lexical mode.
;; (declare (indent 1) (debug let))
;; `(progn ;; `(progn
;; ,@(mapcar (lambda (binder) ;; ,@(mapcar (lambda (binder)
;; `(defvar ,(if (consp binder) (car binder) binder))) ;; `(defvar ,(if (consp binder) (car binder) binder)))
...@@ -489,6 +489,7 @@ places where they originally did not directly appear." ...@@ -489,6 +489,7 @@ places where they originally did not directly appear."
(unless (fboundp 'byte-compile-not-lexical-var-p) (unless (fboundp 'byte-compile-not-lexical-var-p)
;; Only used to test the code in non-lexbind Emacs. ;; Only used to test the code in non-lexbind Emacs.
(defalias 'byte-compile-not-lexical-var-p 'boundp)) (defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
(defun cconv--analyse-use (vardata form varkind) (defun cconv--analyse-use (vardata form varkind)
"Analyze the use of a variable. "Analyze the use of a variable.
...@@ -530,6 +531,7 @@ FORM is the parent form that binds this var." ...@@ -530,6 +531,7 @@ FORM is the parent form that binds this var."
;; outside of it. ;; outside of it.
(envcopy (envcopy
(mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
(byte-compile-bound-variables byte-compile-bound-variables)
(newenv envcopy)) (newenv envcopy))
;; Push it before recursing, so cconv-freevars-alist contains entries in ;; Push it before recursing, so cconv-freevars-alist contains entries in
;; the order they'll be used by closure-convert-rec. ;; the order they'll be used by closure-convert-rec.
...@@ -541,6 +543,7 @@ FORM is the parent form that binds this var." ...@@ -541,6 +543,7 @@ FORM is the parent form that binds this var."
(format "Argument %S is not a lexical variable" arg))) (format "Argument %S is not a lexical variable" arg)))
((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
(t (let ((varstruct (list arg nil nil nil nil))) (t (let ((varstruct (list arg nil nil nil nil)))
(cl-pushnew arg byte-compile-lexical-variables)
(push (cons (list arg) (cdr varstruct)) newvars) (push (cons (list arg) (cdr varstruct)) newvars)
(push varstruct newenv))))) (push varstruct newenv)))))
(dolist (form body) ;Analyze body forms. (dolist (form body) ;Analyze body forms.
...@@ -579,6 +582,7 @@ and updates the data stored in ENV." ...@@ -579,6 +582,7 @@ and updates the data stored in ENV."
(let ((orig-env env) (let ((orig-env env)
(newvars nil) (newvars nil)
(var nil) (var nil)
(byte-compile-bound-variables byte-compile-bound-variables)
(value nil)) (value nil))
(dolist (binder binders) (dolist (binder binders)
(if (not (consp binder)) (if (not (consp binder))
...@@ -592,6 +596,7 @@ and updates the data stored in ENV." ...@@ -592,6 +596,7 @@ and updates the data stored in ENV."
(cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
(unless (byte-compile-not-lexical-var-p var) (unless (byte-compile-not-lexical-var-p var)
(cl-pushnew var byte-compile-lexical-variables)
(let ((varstruct (list var nil nil nil nil))) (let ((varstruct (list var nil nil nil nil)))
(push (cons binder (cdr varstruct)) newvars) (push (cons binder (cdr varstruct)) newvars)
(push varstruct env)))) (push varstruct env))))
...@@ -616,7 +621,8 @@ and updates the data stored in ENV." ...@@ -616,7 +621,8 @@ and updates the data stored in ENV."
(`((lambda . ,_) . ,_) ; First element is lambda expression. (`((lambda . ,_) . ,_) ; First element is lambda expression.
(byte-compile-log-warning (byte-compile-log-warning
"Use of deprecated ((lambda ...) ...) form" t :warning) (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
t :warning)
(dolist (exp `((function ,(car form)) . ,(cdr form))) (dolist (exp `((function ,(car form)) . ,(cdr form)))
(cconv-analyse-form exp env))) (cconv-analyse-form exp env)))
...@@ -645,6 +651,7 @@ and updates the data stored in ENV." ...@@ -645,6 +651,7 @@ and updates the data stored in ENV."
(`(track-mouse . ,body) (`(track-mouse . ,body)
(cconv--analyse-function () body env form)) (cconv--analyse-function () body env form))
(`(defvar ,var) (push var byte-compile-bound-variables))
(`(,(or `defconst `defvar) ,var ,value . ,_) (`(,(or `defconst `defvar) ,var ,value . ,_)
(push var byte-compile-bound-variables) (push var byte-compile-bound-variables)
(cconv-analyse-form value env)) (cconv-analyse-form value env))
...@@ -668,7 +675,9 @@ and updates the data stored in ENV." ...@@ -668,7 +675,9 @@ and updates the data stored in ENV."
;; seem worth the trouble. ;; seem worth the trouble.
(dolist (form forms) (cconv-analyse-form form nil))) (dolist (form forms) (cconv-analyse-form form nil)))
(`(declare . ,_) nil) ;The args don't contain code. ;; `declare' should now be macro-expanded away (and if they're not, we're
;; in trouble because they *can* contain code nowadays).
;; (`(declare . ,_) nil) ;The args don't contain code.
(`(,_ . ,body-forms) ; First element is a function or whatever. (`(,_ . ,body-forms) ; First element is a function or whatever.
(dolist (form body-forms) (cconv-analyse-form form env))) (dolist (form body-forms) (cconv-analyse-form form env)))
......
...@@ -156,8 +156,8 @@ an element already on the list. ...@@ -156,8 +156,8 @@ an element already on the list.
;; earlier and should have triggered them already. ;; earlier and should have triggered them already.
(with-no-warnings ,place) (with-no-warnings ,place)
(setq ,place (cons ,var ,place)))) (setq ,place (cons ,var ,place))))
(list 'setq place (cl-list* 'cl-adjoin x place keys))) `(setq ,place (cl-adjoin ,x ,place ,@keys)))
(cl-list* 'cl-callf2 'cl-adjoin x place keys))) `(cl-callf2 cl-adjoin ,x ,place ,@keys)))
(defun cl--set-elt (seq n val) (defun cl--set-elt (seq n val)
(if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
......
...@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ...@@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'.
;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
;;;;;; "cl-macs" "cl-macs.el" "b839ad3781c4f2f849df0639b4eba166") ;;;;;; "cl-macs" "cl-macs.el" "80cb53f97b21adb6069c43c38a2e094d")
;;; Generated autoloads from cl-macs.el ;;; Generated autoloads from cl-macs.el
(autoload 'cl--compiler-macro-list* "cl-macs" "\ (autoload 'cl--compiler-macro-list* "cl-macs" "\
......
...@@ -2763,10 +2763,10 @@ surrounded by (cl-block NAME ...). ...@@ -2763,10 +2763,10 @@ surrounded by (cl-block NAME ...).
;;;###autoload ;;;###autoload
(defun cl--compiler-macro-adjoin (form a list &rest keys) (defun cl--compiler-macro-adjoin (form a list &rest keys)
(if (and (cl--simple-expr-p a) (cl--simple-expr-p list) (if (memq :key keys) form
(not (memq :key keys))) (macroexp-let2 macroexp-copyable-p va a
`(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) (macroexp-let2 macroexp-copyable-p vlist list
form)) `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
(defun cl--compiler-macro-get (_form sym prop &optional def) (defun cl--compiler-macro-get (_form sym prop &optional def)
(if def (if def
......
...@@ -111,15 +111,20 @@ and also to avoid outputting the warning during normal execution." ...@@ -111,15 +111,20 @@ and also to avoid outputting the warning during normal execution."
(funcall (eval (cadr form))) (funcall (eval (cadr form)))
(byte-compile-constant nil))) (byte-compile-constant nil)))
(defun macroexp--compiling-p ()
"Return non-nil if we're macroexpanding for the compiler."
;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
;; macro-expansion will be processed by the byte-compiler, we check
;; circumstantial evidence.
(member '(declare-function . byte-compile-macroexpand-declare-function)
macroexpand-all-environment))
(defun macroexp--warn-and-return (msg form) (defun macroexp--warn-and-return (msg form)
(let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
(cond (cond
((null msg) form) ((null msg) form)
;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this ((macroexp--compiling-p)
;; macro-expansion will be processed by the byte-compiler, we check
;; circumstantial evidence.
((member '(declare-function . byte-compile-macroexpand-declare-function)
macroexpand-all-environment)
`(progn `(progn
(macroexp--funcall-if-compiled ',when-compiled) (macroexp--funcall-if-compiled ',when-compiled)
,form)) ,form))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment