procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add macroexp--dynamic-variable-p

Browse source 
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.
This commit is contained in:
Mattias Engdegård 2021-12-11 21:39:19 +01:00
parent 3259f399d4
commit 8706f6fde1
6 changed files with 244 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/emacs-lisp/bytecomp.el
View file

@ -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)

60
lisp/emacs-lisp/macroexp.el
View file

@ -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,

13
src/eval.c
View file

@ -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);

7
src/lread.c
View file

@ -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;
}

126
test/lisp/emacs-lisp/macroexp-resources/vk.el Normal file
View file

@ -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)

57
test/lisp/emacs-lisp/macroexp-tests.el
View file

@ -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