From 8706f6fde13729bf330693cfd163773583e526a9 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sat, 11 Dec 2021 21:39:19 +0100 Subject: 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. --- lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/macroexp.el | 60 ++++++++---- src/eval.c | 13 +++ src/lread.c | 7 ++ test/lisp/emacs-lisp/macroexp-resources/vk.el | 126 ++++++++++++++++++++++++++ test/lisp/emacs-lisp/macroexp-tests.el | 57 +++++++++++- 6 files changed, 244 insertions(+), 21 deletions(-) create mode 100644 test/lisp/emacs-lisp/macroexp-resources/vk.el 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 . + +(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 -- cgit v1.2.3