Add `macroexp--dynamic-variable-p`

This predicate can be used for discriminating between lexically and
dynamically bound variables during macro-expansion (only).
It is restricted to internal use for the time being.

* lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment):
Use macroexpand--all-toplevel.
* lisp/emacs-lisp/macroexp.el (macroexp-dynamic-variable-p): New.
(macroexp--expand-all): Maintain macroexp--dynvars.
(macroexpand-all): Rebind macroexp--dynvars.
(macroexpand--all-toplevel): New.
(internal-macroexpand-for-load): Use macroexpand--all-toplevel.
* src/eval.c (eval_sub): Transfer defvar declarations from
Vinternal_interpreter_environment into macroexp--dynvars during
lazy macro-expansion.
* src/lread.c (readevalloop): Rebind macroexp--dynvars around
read-and-evaluate operations.
(syms_of_lread): Define macroexp--dynvars.
* test/lisp/emacs-lisp/macroexp-resources/vk.el: New file.
* test/lisp/emacs-lisp/macroexp-tests.el (macroexp-tests--run-emacs)
(macroexp-tests--eval-in-subprocess)
(macroexp-tests--byte-compile-in-subprocess)
(macroexp--tests-dynamic-variable-p): Add tests.

6 files changed, 244 insertions, 21 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index a98c9197a06..11107ec0f6d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -510,7 +510,7 @@ Return the compile-time value of FORM."
                               ;; 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)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index a20c424e2bd..c04cbb7fffd 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -289,6 +289,16 @@ is executed without being compiled first."
           `(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'.
@@ -316,28 +326,32 @@ Assumes the caller has bound `macroexpand-all-environment'."
                                         (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,
@@ -421,6 +435,14 @@ Assumes the caller has bound `macroexpand-all-environment'."
 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)))
 
@@ -706,7 +728,7 @@ test of free variables in the following ways:
         (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,
diff --git a/src/eval.c b/src/eval.c
index fe29564aa2d..ddf455e4d78 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2608,6 +2608,19 @@ eval_sub (Lisp_Object form)
 	     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);
diff --git a/src/lread.c b/src/lread.c
index 5a2f1bc54e5..49925764146 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2209,6 +2209,7 @@ readevalloop (Lisp_Object readcharfun,
   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 ()
@@ -5469,4 +5470,10 @@ This variable's value can only be set via file-local variables.
 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;
 }
diff --git a/test/lisp/emacs-lisp/macroexp-resources/vk.el b/test/lisp/emacs-lisp/macroexp-resources/vk.el
new file mode 100644
index 00000000000..8bbd94ac666
--- /dev/null
+++ b/test/lisp/emacs-lisp/macroexp-resources/vk.el
@@ -0,0 +1,126 @@
+;;; 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)
diff --git a/test/lisp/emacs-lisp/macroexp-tests.el b/test/lisp/emacs-lisp/macroexp-tests.el
index 89d3882d1da..292c11ac6cd 100644
--- a/test/lisp/emacs-lisp/macroexp-tests.el
+++ b/test/lisp/emacs-lisp/macroexp-tests.el
@@ -24,6 +24,9 @@
 
 ;;; Code:
 
+(require 'macroexp)
+(require 'ert-x)
+
 (ert-deftest macroexp--tests-fgrep ()
   (should (equal (macroexp--fgrep '((x) (y)) '([x] z ((u))))
                  '((x))))
@@ -67,6 +70,58 @@
     (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