;; whether to compile as byte-compile-form
;; or byte-compile-file-form.
(let ((expanded
- (macroexpand-all
+ (macroexpand--all-toplevel
form
macroexpand-all-environment)))
(eval expanded lexical-binding)
`(let ,(nreverse bindings) . ,body)
(macroexp-progn body)))))
+(defun macroexp--dynamic-variable-p (var)
+ "Whether the variable VAR is dynamically scoped.
+Only valid during macro-expansion."
+ (defvar byte-compile-bound-variables)
+ (or (not lexical-binding)
+ (special-variable-p var)
+ (memq var macroexp--dynvars)
+ (and (boundp 'byte-compile-bound-variables)
+ (memq var byte-compile-bound-variables))))
+
(defun macroexp--expand-all (form)
"Expand all macros in FORM.
This is an internal version of `macroexpand-all'.
(cddr form))
(cdr form))
form))
- (`(,(or 'defvar 'defconst) . ,_) (macroexp--all-forms form 2))
+ (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_)
+ (push name macroexp--dynvars)
+ (macroexp--all-forms form 2))
(`(function ,(and f `(lambda . ,_)))
- (macroexp--cons 'function
- (macroexp--cons (macroexp--all-forms f 2)
- nil
- (cdr form))
- form))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons 'function
+ (macroexp--cons (macroexp--all-forms f 2)
+ nil
+ (cdr form))
+ form)))
(`(,(or 'function 'quote) . ,_) form)
(`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body)
pcase--dontcare))
- (macroexp--cons
- fun
- (macroexp--cons
- (macroexp--all-clauses bindings 1)
- (if (null body)
- (macroexp-unprogn
- (macroexp-warn-and-return
- (format "Empty %s body" fun)
- nil nil 'compile-only))
- (macroexp--all-forms body))
- (cdr form))
- form))
+ (let ((macroexp--dynvars macroexp--dynvars))
+ (macroexp--cons
+ fun
+ (macroexp--cons
+ (macroexp--all-clauses bindings 1)
+ (if (null body)
+ (macroexp-unprogn
+ (macroexp-warn-and-return
+ (format "Empty %s body" fun)
+ nil nil 'compile-only))
+ (macroexp--all-forms body))
+ (cdr form))
+ form)))
(`(,(and fun `(lambda . ,_)) . ,args)
;; Embedded lambda in function position.
;; If the byte-optimizer is loaded, try to unfold this,
If no macros are expanded, FORM is returned unchanged.
The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation."
+ (let ((macroexpand-all-environment environment)
+ (macroexp--dynvars macroexp--dynvars))
+ (macroexp--expand-all form)))
+
+;; This function is like `macroexpand-all' but for use with top-level
+;; forms. It does not dynbind `macroexp--dynvars' because we want
+;; top-level `defvar' declarations to be recorded in that variable.
+(defun macroexpand--all-toplevel (form &optional environment)
(let ((macroexpand-all-environment environment))
(macroexp--expand-all form)))
(let ((macroexp--pending-eager-loads
(cons load-file-name macroexp--pending-eager-loads)))
(if full-p
- (macroexpand-all form)
+ (macroexpand--all-toplevel form)
(macroexpand form)))
(error
;; Hopefully this shouldn't happen thanks to the cycle detection,
interpreted using lexical-binding or not. */
specbind (Qlexical_binding,
NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
+
+ /* Make the macro aware of any defvar declarations in scope. */
+ Lisp_Object dynvars = Vmacroexp__dynvars;
+ for (Lisp_Object p = Vinternal_interpreter_environment;
+ !NILP (p); p = XCDR(p))
+ {
+ Lisp_Object e = XCAR (p);
+ if (SYMBOLP (e))
+ dynvars = Fcons(e, dynvars);
+ }
+ if (!EQ (dynvars, Vmacroexp__dynvars))
+ specbind (Qmacroexp__dynvars, dynvars);
+
exp = apply1 (Fcdr (fun), original_args);
exp = unbind_to (count1, exp);
val = eval_sub (exp);
specbind (Qinternal_interpreter_environment,
(NILP (lex_bound) || EQ (lex_bound, Qunbound)
? Qnil : list1 (Qt)));
+ specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
/* Ensure sourcename is absolute, except whilst preloading. */
if (!will_dump_p ()
See Info node `(elisp)Shorthands' for more details. */);
Vread_symbol_shorthands = Qnil;
DEFSYM (Qobarray_cache, "obarray-cache");
+
+ DEFSYM (Qmacroexp__dynvars, "macroexp--dynvars");
+ DEFVAR_LISP ("macroexp--dynvars", Vmacroexp__dynvars,
+ doc: /* List of variables declared dynamic in the current scope.
+Only valid during macro-expansion. Internal use only. */);
+ Vmacroexp__dynvars = Qnil;
}
--- /dev/null
+;;; vk.el --- test code for macroexp-tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(require 'macroexp)
+
+(defmacro vk-variable-kind (var)
+ (if (macroexp--dynamic-variable-p var) ''dyn ''lex))
+
+(defvar vk-a 1)
+(defconst vk-b 2)
+(defvar vk-c)
+
+(defun vk-f1 (x)
+ (defvar vk-u1)
+ (let ((vk-a 10)
+ (vk-b 20)
+ (vk-c 30)
+ (vk-u1 40)
+ (y 50))
+ (ignore vk-a vk-b vk-c vk-u1 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-c) ; dyn
+ (vk-variable-kind vk-u1) ; dyn
+ (vk-variable-kind x) ; lex
+ (vk-variable-kind y)))) ; lex
+
+(eval-and-compile
+ (defvar vk-u2)
+ (defun vk-f2 (x)
+ (defvar vk-v2)
+ (let ((vk-u2 11)
+ (vk-v2 12)
+ (y 13))
+ (ignore vk-u2 vk-v2 x y)
+ (list
+ (vk-variable-kind vk-u2) ; dyn
+ (vk-variable-kind vk-v2) ; dyn
+ (vk-variable-kind x) ; lex
+ (vk-variable-kind y))))) ; lex
+
+(eval-when-compile
+ (defvar vk-u3)
+ (defun vk-f3 (x)
+ (defvar vk-v3)
+ (let ((vk-a 23)
+ (vk-b 24)
+ (vk-u3 25)
+ (vk-v3 26)
+ (y 27))
+ (ignore vk-a vk-b vk-u3 vk-v3 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-u3) ; dyn
+ (vk-variable-kind vk-v3) ; dyn
+ (vk-variable-kind x) ; lex
+ (vk-variable-kind y))))) ; lex
+
+(defconst vk-val3 (eval-when-compile (vk-f3 0)))
+
+(defconst vk-f4 '(lambda (x)
+ (defvar vk-v4)
+ (let ((vk-v4 31)
+ (y 32))
+ (ignore vk-v4 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v4) ; dyn
+ (vk-variable-kind x) ; dyn
+ (vk-variable-kind y))))) ; dyn
+
+(defconst vk-f5 '(closure (t) (x)
+ (defvar vk-v5)
+ (let ((vk-v5 41)
+ (y 42))
+ (ignore vk-v5 x y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v5) ; dyn
+ (vk-variable-kind x) ; lex
+ (vk-variable-kind y))))) ; lex
+
+(defun vk-f6 ()
+ (eval '(progn
+ (defvar vk-v6)
+ (let ((vk-v6 51)
+ (y 52))
+ (ignore vk-v6 y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v6) ; dyn
+ (vk-variable-kind vk-y)))))) ; dyn
+
+(defun vk-f7 ()
+ (eval '(progn
+ (defvar vk-v7)
+ (let ((vk-v7 51)
+ (y 52))
+ (ignore vk-v7 y)
+ (list
+ (vk-variable-kind vk-a) ; dyn
+ (vk-variable-kind vk-b) ; dyn
+ (vk-variable-kind vk-v7) ; dyn
+ (vk-variable-kind vk-y)))) ; lex
+ t))
+
+(provide 'vk)
;;; Code:
+(require 'macroexp)
+(require 'ert-x)
+
(ert-deftest macroexp--tests-fgrep ()
(should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u))))
'((x))))
(should (equal "m1.el"
(file-name-nondirectory macroexp--m1-tests-comp-filename)))))
+(defun macroexp-tests--run-emacs (&rest args)
+ "Run Emacs in batch mode with ARGS, return output."
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (with-temp-buffer
+ (let ((res (apply #'call-process emacs nil t nil
+ "-Q" "--batch" args))
+ (output (buffer-string)))
+ (unless (equal res 0)
+ (message "%s" output)
+ (error "Inferior Emacs exited with status %S" res))
+ output))))
+
+(defun macroexp-tests--eval-in-subprocess (file expr)
+ (let ((output (macroexp-tests--run-emacs
+ "-l" file (format "--eval=(print %S)" expr))))
+ (car (read-from-string output))))
+
+(defun macroexp-tests--byte-compile-in-subprocess (file)
+ "Byte-compile FILE using a subprocess to avoid contaminating the lisp state."
+ (let ((output (macroexp-tests--run-emacs "-f" "batch-byte-compile" file)))
+ (when output
+ (message "%s" output))))
+
+(ert-deftest macroexp--tests-dynamic-variable-p ()
+ "Test `macroexp--dynamic-variable-p'."
+ (let* ((vk-el (ert-resource-file "vk.el"))
+ (vk-elc (concat vk-el "c"))
+ (expr '(list (vk-f1 0)
+ (vk-f2 0)
+ vk-val3
+ (funcall vk-f4 0)
+ (funcall vk-f5 0)
+ (vk-f6)
+ (vk-f7))))
+ ;; We compile and run the test in separate processes for complete
+ ;; isolation between test cases.
+ (should (equal (macroexp-tests--eval-in-subprocess vk-el expr)
+ '((dyn dyn dyn dyn lex lex)
+ (dyn dyn lex lex)
+ (dyn dyn dyn dyn lex lex)
+ (dyn dyn dyn dyn dyn)
+ (dyn dyn dyn lex lex)
+ (dyn dyn dyn dyn)
+ (dyn dyn dyn lex))))
+ (macroexp-tests--byte-compile-in-subprocess vk-el)
+ (should (equal (macroexp-tests--eval-in-subprocess vk-elc expr)
+ '((dyn dyn dyn dyn lex lex)
+ (dyn dyn lex lex)
+ (dyn dyn dyn dyn lex lex)
+ (dyn dyn dyn dyn dyn)
+ (dyn dyn dyn lex lex)
+ (dyn dyn dyn dyn)
+ (dyn dyn dyn lex))))))
-(provide 'macroexp-tests)
;;; macroexp-tests.el ends here
projects / emacs.git / commitdiff