summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2017-01-22 19:47:45 -0800
committerKaz Kylheku <kaz@kylheku.com>2017-01-22 19:47:45 -0800
commit959c41f90a86a3327e586806bb9b46a9a76e8b05 (patch)
tree0bb741d8d870eadd5dfa94220f6b6941236d1c82
parente121e2a143925a2ca79e974f131ec2da762a52dc (diff)
downloadtxr-959c41f90a86a3327e586806bb9b46a9a76e8b05.tar.gz
txr-959c41f90a86a3327e586806bb9b46a9a76e8b05.tar.bz2
txr-959c41f90a86a3327e586806bb9b46a9a76e8b05.zip
bugfix: expansion order in face of param macros.
We are following an incorrect expansion order for parameters and bodies in the face of parameter macros. We are expanding the body first, using the raw, untransformed parameters, which is wrong. Secondly, we then neglect to expand the body which emerges from param expansion. The fix is to pass the unexpanded body to expand_params. Then expand the body which emerges. This also fixes another bug: the macro env passed to param expanders is documented as excluding the parameters. This is now actually true. * eval.c (expand_macrolet, expand_tree_cases, expand_catch_clause): Rearrange expansion logic surrounding call to expand_params. (do_expand): Likewise, and also introduce expansion for the sys:with-dyn-rebinds operator. This is now needed because under the new order, with-dyn-rebinds is now introduced into unexpanded code. If it isn't expanded, then it then wrongly protects its enclosed forms from expansion.
-rw-r--r--eval.c60
1 files changed, 33 insertions, 27 deletions
diff --git a/eval.c b/eval.c
index 34a1ef8c..1fcf33fb 100644
--- a/eval.c
+++ b/eval.c
@@ -1895,10 +1895,10 @@ static val expand_macrolet(val form, val menv)
val macro = car(macs);
val name = pop(&macro);
val params = pop(&macro);
- val new_menv = make_var_shadowing_env(menv, get_param_syms(params));
- val macro_ex = expand_forms(macro, new_menv);
- cons_bind (params_ex, macro_out,
- expand_params(params, macro_ex, menv, t, form));
+ cons_bind (params_ex, macro_ex,
+ expand_params(params, macro, menv, t, form));
+ val new_menv = make_var_shadowing_env(menv, get_param_syms(params_ex));
+ val macro_out = expand_forms(macro_ex, new_menv);
val block = rlcp_tree(cons(block_s, cons(name, macro_out)), macro_ex);
builtin_reject_test(op, name, form);
@@ -1978,10 +1978,10 @@ static val expand_tree_cases(val cases, val menv, val form)
} else {
val dstr_args = car(onecase);
val forms = cdr(onecase);
- val new_menv = make_var_shadowing_env(menv, get_param_syms(dstr_args));
- val forms_ex0 = expand_forms(forms, new_menv);
- cons_bind (dstr_args_ex, forms_ex,
- expand_params(dstr_args, forms_ex0, menv, t, form));
+ cons_bind (dstr_args_ex, forms_ex0,
+ expand_params(dstr_args, forms, menv, t, form));
+ val new_menv = make_var_shadowing_env(menv, get_param_syms(dstr_args_ex));
+ val forms_ex = expand_forms(forms_ex0, new_menv);
val rest_ex = expand_tree_cases(cdr(cases), menv, form);
if (dstr_args_ex == dstr_args && forms_ex == forms &&
@@ -3743,10 +3743,10 @@ static val expand_catch_clause(val form, val menv)
val sym = first(form);
val params = second(form);
val body = rest(rest(form));
- val new_menv = make_var_shadowing_env(menv, get_param_syms(params));
- val body_ex0 = expand_forms(body, new_menv);
- cons_bind (params_ex, body_ex,
- expand_params(params, body_ex0, menv, nil, form));
+ cons_bind (params_ex, body_ex0,
+ expand_params(params, body, menv, nil, form));
+ val new_menv = make_var_shadowing_env(menv, get_param_syms(params_ex));
+ val body_ex = expand_forms(body_ex0, new_menv);
if (!symbolp(sym))
eval_error(form, lit("catch: ~s isn't a symbol"), sym, nao);
if (body == body_ex && params == params_ex)
@@ -3922,10 +3922,10 @@ static val do_expand(val form, val menv)
{
val params = second(form);
val body = rest(rest(form));
- val new_menv = make_var_shadowing_env(menv, get_param_syms(params));
- val body_ex0 = expand_progn(body, new_menv);
- cons_bind (params_ex, body_ex,
- expand_params(params, body_ex0, menv, nil, form));
+ cons_bind (params_ex, body_ex0,
+ expand_params(params, body, menv, nil, form));
+ val new_menv = make_var_shadowing_env(menv, get_param_syms(params_ex));
+ val body_ex = expand_progn(body_ex0, new_menv);
if (body == body_ex && params == params_ex)
return form;
@@ -3941,15 +3941,15 @@ static val do_expand(val form, val menv)
uw_register_tentative_def(cons(fun_s, name));
{
- val inter_env = make_var_shadowing_env(menv, get_param_syms(params));
+ val body = rest(rest(rest(form)));
+ cons_bind (params_ex, body_ex0,
+ expand_params(params, body, menv,
+ eq(sym, defmacro_s), form));
+ val inter_env = make_var_shadowing_env(menv, get_param_syms(params_ex));
val new_menv = if3(sym == defun_s,
make_fun_shadowing_env(inter_env, cons(name, nil)),
inter_env);
- val body = rest(rest(rest(form)));
- val body_ex0 = expand_progn(body, new_menv);
- cons_bind (params_ex, body_ex,
- expand_params(params, body_ex0, menv,
- eq(sym, defmacro_s), form));
+ val body_ex = expand_progn(body_ex0, new_menv);
val form_ex = form;
if (body != body_ex || params != params_ex)
@@ -3971,9 +3971,9 @@ static val do_expand(val form, val menv)
val body = args;
val new_menv = make_var_shadowing_env(menv, get_param_syms(params));
val ctx_expr_ex = expand(expr, menv);
- val body_ex0 = expand_progn(body, new_menv);
- cons_bind (params_ex, body_ex,
- expand_params(params, body_ex0, menv, t, form));
+ cons_bind (params_ex, body_ex0,
+ expand_params(params, body, menv, t, form));
+ val body_ex = expand_progn(body_ex0, new_menv);
val expr_ex = expand(expr, new_menv);
if (sym == mac_param_bind_s) {
@@ -3988,8 +3988,14 @@ static val do_expand(val form, val menv)
if (params_ex == params && expr_ex == expr && body_ex == body)
return form;
return rlcp(cons(sym, cons(params_ex, cons(expr_ex, body_ex))), form);
- } else if (sym == quote_s || sym == fun_s || sym == with_dyn_rebinds_s ||
- sym == dvbind_s) {
+ } else if (sym == with_dyn_rebinds_s) {
+ val body = rest(form);
+ val syms = pop(&body);
+ val body_ex = expand_progn(body, menv);
+ if (body_ex == body)
+ return form;
+ return rlcp(cons(sym, cons(syms, body_ex)), form);
+ } else if (sym == quote_s || sym == fun_s || sym == dvbind_s) {
return form;
} else if (sym == for_op_s) {
val vars = second(form);