suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

merged changes for macro stepper

Browse Source 
svn: r4860
This commit is contained in:
Matthew Flatt 2006-11-15 08:01:48 +00:00
parent 96897e5f92
commit 4e1276dd58
4 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/mzscheme/src/env.c
View File

@ -3950,10 +3950,9 @@ local_lift_expr(int argc, Scheme_Object *argv[])
expr = scheme_make_pair(expr, SCHEME_VEC_ELS(vec)[0]);
SCHEME_VEC_ELS(vec)[0] = expr;
id = scheme_add_remove_mark(id, local_mark);
SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(scheme_get_expand_observe(), id, orig_expr);
id = scheme_add_remove_mark(id, local_mark);
return id;
}

1
src/mzscheme/src/eval.c
View File

@ -4826,6 +4826,7 @@ compile_expand_expr_lift_to_let(Scheme_Object *form, Scheme_Comp_Env *env,
icons(o, scheme_null)));
}
form = scheme_datum_to_syntax(o, orig_form, scheme_false, 0, 0);
SCHEME_EXPAND_OBSERVE_LETLIFT_LOOP(rec[drec].observer, form);
form = compile_expand_expr_lift_to_let(form, env, recs, 1);
if (rec[drec].comp)
scheme_merge_compile_recs(rec, drec, recs, 2);

12
src/mzscheme/src/module.c
View File

@ -4038,7 +4038,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
fm = scheme_named_map_1(NULL, add_a_rename, fm, post_ex_et_rn);
fm = scheme_named_map_1(NULL, add_a_rename, fm, post_ex_tt_rn);
fm = scheme_append(fst, scheme_make_pair(e, fm));
SCHEME_EXPAND_OBSERVE_LIFT_LOOP(observer, fst);
SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observer, fst);
} else {
/* No lifts added... */
if (SCHEME_STX_PAIRP(e))
@ -4056,7 +4056,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
if (SCHEME_STX_NULLP(fm)) {
fm = scheme_frame_get_end_statement_lifts(xenv);
fm = scheme_reverse(fm);
SCHEME_EXPAND_OBSERVE_LIFT_END_LOOP(observer, fm);
SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer, fm);
maybe_has_lifts = 0;
if (SCHEME_NULLP(fm)) {
e = NULL;
@ -4631,13 +4631,13 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
if (SCHEME_STX_NULLP(fm) && maybe_has_lifts) {
fm = scheme_frame_get_end_statement_lifts(xenv);
fm = scheme_reverse(fm);
SCHEME_EXPAND_OBSERVE_LIFT_END_LOOP(observer, fm);
SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer, fm);
maybe_has_lifts = 0;
}
}
/* first = a list of (cons semi-expanded-expression normal?) */
/* Phase 2 */
/* Pass 2 */
SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer);
if (rec[drec].comp) {
@ -4692,6 +4692,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
p = SCHEME_CDR(p);
} else {
/* Lifts - insert them and try again */
SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observer, scheme_copy_list(l));
e = scheme_make_pair(e, scheme_false); /* don't re-compile/-expand */
SCHEME_CAR(p) = e;
for (ll = l; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
@ -4704,7 +4705,6 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
} else {
first = p;
}
SCHEME_EXPAND_OBSERVE_LIFT_LOOP(observer, first);
}
} else {
SCHEME_CAR(p) = e;
@ -4715,7 +4715,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
/* If we're out of declarations, check for lifted-to-end: */
if (SCHEME_NULLP(p) && maybe_has_lifts) {
p = scheme_frame_get_end_statement_lifts(cenv);
SCHEME_EXPAND_OBSERVE_LIFT_END_LOOP(observer, scheme_reverse(p));
SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer, scheme_reverse(p));
p = scheme_reverse(p);
for (ll = p; SCHEME_PAIRP(ll); ll = SCHEME_CDR(ll)) {
e = scheme_make_pair(SCHEME_CAR(ll), scheme_true);

6
src/mzscheme/src/schexpobs.h
View File

@ -117,7 +117,11 @@ extern Scheme_Object *scheme_get_expand_observe();
#define SCHEME_EXPAND_OBSERVE_LIFT_LOOP(observer,stx) \
_SCHEME_EXPOBS(observer,128,stx)
#define SCHEME_EXPAND_OBSERVE_LIFT_END_LOOP(observer,stx) \
#define SCHEME_EXPAND_OBSERVE_LETLIFT_LOOP(observer,stx) \
_SCHEME_EXPOBS(observer,136,stx)
#define SCHEME_EXPAND_OBSERVE_MODULE_LIFT_LOOP(observe,stxs) \
_SCHEME_EXPOBS(observer,137,stxs)
#define SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer,stx) \
_SCHEME_EXPOBS(observer,135,stx)
#define SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(obs,id,stx) \