Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 01:34:21 +00:00
Code Issues Projects Releases Packages Wiki Activity

Try and be more careful about propagation of lexical environment.

Browse source 
* src/eval.c (apply_lambda, funcall_lambda): Remove lexenv arg.
(Feval): Always eval in the empty environment.
(eval_sub): New function.  Use it for all calls to Feval that should
evaluate in the lexical environment of the caller.
Pass `closure's as is to apply_lambda.
(Ffuncall): Pass `closure's as is to funcall_lambda.
(funcall_lambda): Extract lexenv for `closure's, when applicable.
Also use lexical scoping for the &rest argument, if applicable.
* src/lisp.h (eval_sub): Declare.
* src/lread.c (readevalloop): Remove `evalfun' argument.
* src/print.c (Fwith_output_to_temp_buffer):
* src/data.c (Fsetq_default): Use eval_sub.
* lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push.
This commit is contained in:
Stefan Monnier 2010-12-13 22:37:44 -05:00
parent 7a600d54c0
commit defb141157
11 changed files with 110 additions and 89 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lisp/ChangeLog
View file

@ -1,3 +1,7 @@
2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push.
2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (with-lexical-binding): Remove.

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

@ -2979,6 +2979,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
;; Given BYTECOMP-BODY, compile it and return a new body.
(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
;; FIXME: lexbind. Check all callers!
(setq bytecomp-body
(byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
(cond ((eq (car-safe bytecomp-body) 'progn)
@ -4083,8 +4084,8 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
(defun byte-compile-track-mouse (form)
(byte-compile-form
`(funcall '(lambda nil
(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
`(funcall #'(lambda nil
(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
(defun byte-compile-condition-case (form)
(let* ((var (nth 1 form))
@ -4121,11 +4122,10 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
;; "`%s' is not a known condition name (in condition-case)"
;; condition))
)
(setq compiled-clauses
(cons (cons condition
(byte-compile-top-level-body
(cdr clause) for-effect))
compiled-clauses)))
(push (cons condition
(byte-compile-top-level-body
(cdr clause) for-effect))
compiled-clauses))
(setq clauses (cdr clauses)))
(byte-compile-push-constant (nreverse compiled-clauses)))
(byte-compile-out 'byte-condition-case 0)))
@ -4244,7 +4244,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)."
`(if (not (default-boundp ',var)) (setq-default ,var ,value))))
(when (eq fun 'defconst)
;; This will signal an appropriate error at runtime.
`(eval ',form)))
`(eval ',form))) ;FIXME: lexbind
`',var))))
(defun byte-compile-autoload (form)

16
src/ChangeLog
View file

@ -1,3 +1,19 @@
2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca>
Try and be more careful about propagation of lexical environment.
* eval.c (apply_lambda, funcall_lambda): Remove lexenv arg.
(Feval): Always eval in the empty environment.
(eval_sub): New function. Use it for all calls to Feval that should
evaluate in the lexical environment of the caller.
Pass `closure's as is to apply_lambda.
(Ffuncall): Pass `closure's as is to funcall_lambda.
(funcall_lambda): Extract lexenv for `closure's, when applicable.
Also use lexical scoping for the &rest argument, if applicable.
* lisp.h (eval_sub): Declare.
* lread.c (readevalloop): Remove `evalfun' argument.
* print.c (Fwith_output_to_temp_buffer):
* data.c (Fsetq_default): Use eval_sub.
2010-12-13 Stefan Monnier <monnier@iro.umontreal.ca>
Make the effect of (defvar foo) local.

8
src/bytecode.c
View file

@ -901,7 +901,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
case Bsave_window_excursion:
BEFORE_POTENTIAL_GC ();
TOP = Fsave_window_excursion (TOP);
TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
@ -915,13 +915,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
TOP = internal_catch (TOP, Feval, v1);
TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
}
case Bunwind_protect:
record_unwind_protect (Fprogn, POP);
record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */
break;
case Bcondition_case:
@ -930,7 +930,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
handlers = POP;
body = POP;
BEFORE_POTENTIAL_GC ();
TOP = internal_lisp_condition_case (TOP, body, handlers);
TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
}

2
src/callint.c
View file

@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of
input = specs;
/* Compute the arg values using the user's expression. */
GCPRO2 (input, filter_specs);
specs = Feval (specs);
specs = Feval (specs); /* FIXME: lexbind */
UNGCPRO;
if (i != num_input_events || !NILP (record_flag))
{

2
src/data.c
View file

@ -1452,7 +1452,7 @@ usage: (setq-default [VAR VALUE]...) */)
do
{
val = Feval (Fcar (Fcdr (args_left)));
val = eval_sub (Fcar (Fcdr (args_left)));
symbol = XCAR (args_left);
Fset_default (symbol, val);
args_left = Fcdr (XCDR (args_left));

133
src/eval.c
View file

@ -178,10 +178,8 @@ int handling_signal;
Lisp_Object Vmacro_declaration_function;
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args,
Lisp_Object lexenv);
static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *,
Lisp_Object);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *);
static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
void
@ -308,7 +306,7 @@ usage: (or CONDITIONS...) */)
while (CONSP (args))
{
val = Feval (XCAR (args));
val = eval_sub (XCAR (args));
if (!NILP (val))
break;
args = XCDR (args);
@ -332,7 +330,7 @@ usage: (and CONDITIONS...) */)
while (CONSP (args))
{
val = Feval (XCAR (args));
val = eval_sub (XCAR (args));
if (NILP (val))
break;
args = XCDR (args);
@ -354,11 +352,11 @@ usage: (if COND THEN ELSE...) */)
struct gcpro gcpro1;
GCPRO1 (args);
cond = Feval (Fcar (args));
cond = eval_sub (Fcar (args));
UNGCPRO;
if (!NILP (cond))
return Feval (Fcar (Fcdr (args)));
return eval_sub (Fcar (Fcdr (args)));
return Fprogn (Fcdr (Fcdr (args)));
}
@ -382,7 +380,7 @@ usage: (cond CLAUSES...) */)
while (!NILP (args))
{
clause = Fcar (args);
val = Feval (Fcar (clause));
val = eval_sub (Fcar (clause));
if (!NILP (val))
{
if (!EQ (XCDR (clause), Qnil))
@ -408,7 +406,7 @@ usage: (progn BODY...) */)
while (CONSP (args))
{
val = Feval (XCAR (args));
val = eval_sub (XCAR (args));
args = XCDR (args);
}
@ -438,9 +436,9 @@ usage: (prog1 FIRST BODY...) */)
do
{
if (!(argnum++))
val = Feval (Fcar (args_left));
val = eval_sub (Fcar (args_left));
else
Feval (Fcar (args_left));
eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP(args_left));
@ -473,9 +471,9 @@ usage: (prog2 FORM1 FORM2 BODY...) */)
do
{
if (!(argnum++))
val = Feval (Fcar (args_left));
val = eval_sub (Fcar (args_left));
else
Feval (Fcar (args_left));
eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP (args_left));
@ -507,10 +505,10 @@ usage: (setq [SYM VAL]...) */)
do
{
val = Feval (Fcar (Fcdr (args_left)));
val = eval_sub (Fcar (Fcdr (args_left)));
sym = Fcar (args_left);
/* Like for Feval, we do not check declared_special here since
/* Like for eval_sub, we do not check declared_special here since
it's been done when let-binding. */
if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
&& SYMBOLP (sym)
@ -870,7 +868,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
}
if (NILP (tem))
Fset_default (sym, Feval (Fcar (tail)));
Fset_default (sym, eval_sub (Fcar (tail)));
else
{ /* Check if there is really a global binding rather than just a let
binding that shadows the global unboundness of the var. */
@ -935,7 +933,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
error ("Too many arguments");
tem = Feval (Fcar (Fcdr (args)));
tem = eval_sub (Fcar (Fcdr (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
@ -1049,7 +1047,7 @@ usage: (let* VARLIST BODY...) */)
else
{
var = Fcar (elt);
val = Feval (Fcar (Fcdr (elt)));
val = eval_sub (Fcar (Fcdr (elt)));
}
if (!NILP (lexenv) && SYMBOLP (var)
@ -1117,7 +1115,7 @@ usage: (let VARLIST BODY...) */)
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
temps [argnum++] = Feval (Fcar (Fcdr (elt)));
temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
gcpro2.nvars = argnum;
}
UNGCPRO;
@ -1166,7 +1164,7 @@ usage: (while TEST BODY...) */)
test = Fcar (args);
body = Fcdr (args);
while (!NILP (Feval (test)))
while (!NILP (eval_sub (test)))
{
QUIT;
Fprogn (body);
@ -1268,7 +1266,7 @@ usage: (catch TAG BODY...) */)
struct gcpro gcpro1;
GCPRO1 (args);
tag = Feval (Fcar (args));
tag = eval_sub (Fcar (args));
UNGCPRO;
return internal_catch (tag, Fprogn, Fcdr (args));
}
@ -1401,7 +1399,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */)
int count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
val = Feval (Fcar (args));
val = eval_sub (Fcar (args));
return unbind_to (count, val);
}
@ -1502,7 +1500,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
h.tag = &c;
handlerlist = &h;
val = Feval (bodyform);
val = eval_sub (bodyform);
catchlist = c.next;
handlerlist = h.next;
return val;
@ -2316,6 +2314,16 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname)
DEFUN ("eval", Feval, Seval, 1, 1, 0,
doc: /* Evaluate FORM and return its value. */)
(Lisp_Object form)
{
int count = SPECPDL_INDEX ();
specbind (Qinternal_interpreter_environment, Qnil);
return unbind_to (count, eval_sub (form));
}
/* Eval a sub-expression of the current expression (i.e. in the same
lexical scope). */
Lisp_Object
eval_sub (Lisp_Object form)
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
@ -2424,7 +2432,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
while (!NILP (args_left))
{
vals[argnum++] = Feval (Fcar (args_left));
vals[argnum++] = eval_sub (Fcar (args_left));
args_left = Fcdr (args_left);
gcpro3.nvars = argnum;
}
@ -2445,7 +2453,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
maxargs = XSUBR (fun)->max_args;
for (i = 0; i < maxargs; args_left = Fcdr (args_left))
{
argvals[i] = Feval (Fcar (args_left));
argvals[i] = eval_sub (Fcar (args_left));
gcpro3.nvars = ++i;
}
@ -2502,7 +2510,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
}
}
if (FUNVECP (fun))
val = apply_lambda (fun, original_args, Qnil);
val = apply_lambda (fun, original_args);
else
{
if (EQ (fun, Qunbound))
@ -2518,20 +2526,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
goto retry;
}
if (EQ (funcar, Qmacro))
val = Feval (apply1 (Fcdr (fun), original_args));
else if (EQ (funcar, Qlambda))
val = apply_lambda (fun, original_args,
/* Only pass down the current lexical environment
if FUN is lexically embedded in FORM. */
(CONSP (original_fun)
? Vinternal_interpreter_environment
: Qnil));
else if (EQ (funcar, Qclosure)
&& CONSP (XCDR (fun))
&& CONSP (XCDR (XCDR (fun)))
&& EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
val = apply_lambda (XCDR (XCDR (fun)), original_args,
XCAR (XCDR (fun)));
val = eval_sub (apply1 (Fcdr (fun), original_args));
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
val = apply_lambda (fun, original_args);
else
xsignal1 (Qinvalid_function, original_fun);
}
@ -3189,7 +3187,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
if (FUNVECP (fun))
val = funcall_lambda (fun, numargs, args + 1, Qnil);
val = funcall_lambda (fun, numargs, args + 1);
else
{
if (EQ (fun, Qunbound))
@ -3199,14 +3197,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1, Qnil);
else if (EQ (funcar, Qclosure)
&& CONSP (XCDR (fun))
&& CONSP (XCDR (XCDR (fun)))
&& EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1,
XCAR (XCDR (fun)));
if (EQ (funcar, Qlambda)
|| EQ (funcar, Qclosure))
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
do_autoload (fun, original_fun);
@ -3226,7 +3219,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
apply_lambda (Lisp_Object fun, Lisp_Object args)
{
Lisp_Object args_left;
Lisp_Object numargs;
@ -3246,7 +3239,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
for (i = 0; i < XINT (numargs);)
{
tem = Fcar (args_left), args_left = Fcdr (args_left);
tem = Feval (tem);
tem = eval_sub (tem);
arg_vector[i++] = tem;
gcpro1.nvars = i;
}
@ -3256,7 +3249,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv)
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv);
tem = funcall_lambda (fun, XINT (numargs), arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
if (backtrace_list->debug_on_exit)
@ -3321,10 +3314,9 @@ funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args)
static Lisp_Object
funcall_lambda (Lisp_Object fun, int nargs,
register Lisp_Object *arg_vector,
Lisp_Object lexenv)
register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next;
Lisp_Object val, syms_left, next, lexenv;
int count = SPECPDL_INDEX ();
int i, optional, rest;
@ -3358,6 +3350,14 @@ funcall_lambda (Lisp_Object fun, int nargs,
if (CONSP (fun))
{
if (EQ (XCAR (fun), Qclosure))
{
fun = XCDR (fun); /* Drop `closure'. */
lexenv = XCAR (fun);
fun = XCDR (fun); /* Drop the lexical environment. */
}
else
lexenv = Qnil;
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
@ -3365,7 +3365,10 @@ funcall_lambda (Lisp_Object fun, int nargs,
xsignal1 (Qinvalid_function, fun);
}
else if (COMPILEDP (fun))
syms_left = AREF (fun, COMPILED_ARGLIST);
{
syms_left = AREF (fun, COMPILED_ARGLIST);
lexenv = Qnil;
}
else
abort ();
@ -3382,23 +3385,21 @@ funcall_lambda (Lisp_Object fun, int nargs,
rest = 1;
else if (EQ (next, Qand_optional))
optional = 1;
else if (rest)
{
specbind (next, Flist (nargs - i, &arg_vector[i]));
i = nargs;
}
else
{
Lisp_Object val;
/* Get the argument's actual value. */
if (i < nargs)
if (rest)
{
val = Flist (nargs - i, &arg_vector[i]);
i = nargs;
}
else if (i < nargs)
val = arg_vector[i++];
else if (!optional)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
else
val = Qnil;
/* Bind the argument. */
if (!NILP (lexenv) && SYMBOLP (next)
/* FIXME: there's no good reason to allow dynamic-scoping

1
src/lisp.h
View file

@ -2972,6 +2972,7 @@ extern void signal_error (const char *, Lisp_Object) NO_RETURN;
EXFUN (Fautoload, 5);
EXFUN (Fcommandp, 2);
EXFUN (Feval, 1);
extern Lisp_Object eval_sub (Lisp_Object form);
EXFUN (Fapply, MANY);
EXFUN (Ffuncall, MANY);
EXFUN (Fbacktrace, 0);

14
src/lread.c
View file

@ -220,8 +220,7 @@ static Lisp_Object Vbytecomp_version_regexp;
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
static void readevalloop (Lisp_Object, FILE*, Lisp_Object,
Lisp_Object (*) (Lisp_Object), int,
static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
@ -1355,13 +1354,13 @@ Return t if the file exists and loads successfully. */)
if (! version || version >= 22)
readevalloop (Qget_file_char, stream, hist_file_name,
Feval, 0, Qnil, Qnil, Qnil, Qnil);
0, Qnil, Qnil, Qnil, Qnil);
else
{
/* We can't handle a file which was compiled with
byte-compile-dynamic by older version of Emacs. */
specbind (Qload_force_doc_strings, Qt);
readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
}
unbind_to (count, Qnil);
@ -1726,7 +1725,6 @@ static void
readevalloop (Lisp_Object readcharfun,
FILE *stream,
Lisp_Object sourcename,
Lisp_Object (*evalfun) (Lisp_Object),
int printflag,
Lisp_Object unibyte, Lisp_Object readfun,
Lisp_Object start, Lisp_Object end)
@ -1872,7 +1870,7 @@ readevalloop (Lisp_Object readcharfun,
unbind_to (count1, Qnil);
/* Now eval what we just read. */
val = (*evalfun) (val);
val = eval_sub (val);
if (printflag)
{
@ -1935,7 +1933,7 @@ This function preserves the position of point. */)
BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
if (lisp_file_lexically_bound_p (buf))
Fset (Qlexical_binding, Qt);
readevalloop (buf, 0, filename, Feval,
readevalloop (buf, 0, filename,
!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
@ -1969,7 +1967,7 @@ This function does not move point. */)
specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
/* readevalloop calls functions which check the type of start and end. */
readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
readevalloop (cbuf, 0, XBUFFER (cbuf)->filename,
!NILP (printflag), Qnil, read_function,
start, end);

1
src/minibuf.c
View file

@ -1026,6 +1026,7 @@ is a string to insert in the minibuffer before reading.
Such arguments are used as in `read-from-minibuffer'.) */)
(Lisp_Object prompt, Lisp_Object initial_contents)
{
/* FIXME: lexbind. */
return Feval (read_minibuf (Vread_expression_map, initial_contents,
prompt, Qnil, 1, Qread_expression_history,
make_number (0), Qnil, 0, 0));

2
src/print.c
View file

@ -652,7 +652,7 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
Lisp_Object buf, val;
GCPRO1(args);
name = Feval (Fcar (args));
name = eval_sub (Fcar (args));
CHECK_STRING (name);
temp_output_buffer_setup (SDATA (name));
buf = Vstandard_output;