From 80ba4c170756049a101b4e6692882ac30ba5e1a5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 25 May 2022 17:53:39 -0400 Subject: eval.c: New functions `defvar-1` and `defconst-1` (bug#55156) The bytecode interpreter can't directly call special forms, so the byte-compiler usually converts special forms into some sequence of byte codes (basically, providing a duplicate definition of the special form). There are still two exceptions to this: `defconst` and `defvar`, where the compiler instead generates a convoluted chunk of code like: (funcall '(lambda (x) (defvar x )) ) where the quote makes sure we keep the function non-compiled, so as to end up running the special form at run time. Get rid of this workaround by introducing `defvar-1` and `defconst-1` which provide a *functional* interface to the functionality of the corresponding special form. * src/eval.c (defvar, Fdefvar_1, Fdefconst_1): New functions, extracted from `Fdefvar` and `Fdefconst`. (Fdefvar, Fdefconst): Use them. (syms_of_eval): `defsubr` the new functions. * lisp/emacs-lisp/bytecomp.el (byte-compile-tmp-var): Delete const. (byte-compile-defvar): Simplify using the new functions. * doc/lispref/variables.texi (Defining Variables): Adjust the doc of `defvar` to reflect the actual semantics implemented. --- src/eval.c | 78 ++++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 25 deletions(-) (limited to 'src/eval.c') diff --git a/src/eval.c b/src/eval.c index 08e2dce61e4..c3be1dc12c8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -756,6 +756,33 @@ value. */) return Qnil; } +static Lisp_Object +defvar (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring, bool eval) +{ + Lisp_Object tem; + + CHECK_SYMBOL (sym); + + tem = Fdefault_boundp (sym); + + /* Do it before evaluating the initial value, for self-references. */ + Finternal__define_uninitialized_variable (sym, docstring); + + if (NILP (tem)) + Fset_default (sym, eval ? eval_sub (initvalue) : initvalue); + else + { /* Check if there is really a global binding rather than just a let + binding that shadows the global unboundness of the var. */ + union specbinding *binding = default_toplevel_binding (sym); + if (binding && EQ (specpdl_old_value (binding), Qunbound)) + { + set_specpdl_old_value (binding, + eval ? eval_sub (initvalue) : initvalue); + } + } + return sym; +} + DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0, doc: /* Define SYMBOL as a variable, and return SYMBOL. You are not required to define a variable in order to use it, but @@ -770,12 +797,10 @@ value. If SYMBOL is buffer-local, its default value is what is set; buffer-local values are not affected. If INITVALUE is missing, SYMBOL's value is not set. -If SYMBOL has a local binding, then this form affects the local -binding. This is usually not what you want. Thus, if you need to -load a file defining variables, with this form or with `defconst' or -`defcustom', you should always load that file _outside_ any bindings -for these variables. (`defconst' and `defcustom' behave similarly in -this respect.) +If SYMBOL is let-bound, then this form does not affect the local let +binding but the toplevel default binding instead, like +`set-toplevel-default-binding`. +(`defcustom' behaves similarly in this respect.) The optional argument DOCSTRING is a documentation string for the variable. @@ -786,7 +811,7 @@ To define a buffer-local variable, use `defvar-local'. usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - Lisp_Object sym, tem, tail; + Lisp_Object sym, tail; sym = XCAR (args); tail = XCDR (args); @@ -798,24 +823,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); Lisp_Object exp = XCAR (tail); - - tem = Fdefault_boundp (sym); tail = XCDR (tail); - - /* Do it before evaluating the initial value, for self-references. */ - Finternal__define_uninitialized_variable (sym, CAR (tail)); - - if (NILP (tem)) - Fset_default (sym, eval_sub (exp)); - else - { /* Check if there is really a global binding rather than just a let - binding that shadows the global unboundness of the var. */ - union specbinding *binding = default_toplevel_binding (sym); - if (binding && EQ (specpdl_old_value (binding), Qunbound)) - { - set_specpdl_old_value (binding, eval_sub (exp)); - } - } + return defvar (sym, exp, CAR (tail), true); } else if (!NILP (Vinternal_interpreter_environment) && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) @@ -834,6 +843,14 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) return sym; } +DEFUN ("defvar-1", Fdefvar_1, Sdefvar_1, 2, 3, 0, + doc: /* Like `defvar' but as a function. +More specifically behaves like (defvar SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + return defvar (sym, initvalue, docstring, false); +} + DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0, doc: /* Define SYMBOL as a constant variable. This declares that neither programs nor users should ever change the @@ -863,9 +880,18 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) error ("Too many arguments"); docstring = XCAR (XCDR (XCDR (args))); } + tem = eval_sub (XCAR (XCDR (args))); + return Fdefconst_1 (sym, tem, docstring); +} +DEFUN ("defconst-1", Fdefconst_1, Sdefconst_1, 2, 3, 0, + doc: /* Like `defconst' but as a function. +More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) + (Lisp_Object sym, Lisp_Object initvalue, Lisp_Object docstring) +{ + CHECK_SYMBOL (sym); + Lisp_Object tem = initvalue; Finternal__define_uninitialized_variable (sym, docstring); - tem = eval_sub (XCAR (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ @@ -4333,9 +4359,11 @@ alist of active lexical bindings. */); defsubr (&Sdefault_toplevel_value); defsubr (&Sset_default_toplevel_value); defsubr (&Sdefvar); + defsubr (&Sdefvar_1); defsubr (&Sdefvaralias); DEFSYM (Qdefvaralias, "defvaralias"); defsubr (&Sdefconst); + defsubr (&Sdefconst_1); defsubr (&Sinternal__define_uninitialized_variable); defsubr (&Smake_var_non_special); defsubr (&Slet); -- cgit v1.2.1