diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index fb01fc6e83..4ff3f2e1b2 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -5092,10 +5092,11 @@ do_local_lift_expr(const char *who, int stx_pos, int argc, Scheme_Object *argv[] expr = scheme_make_pair(expr, SCHEME_VEC_ELS(vec)[0]); SCHEME_VEC_ELS(vec)[0] = expr; + SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(scheme_get_expand_observe(), ids, orig_expr); + rev_ids = scheme_null; for (; !SCHEME_NULLP(ids); ids = SCHEME_CDR(ids)) { id = SCHEME_CAR(ids); - SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(scheme_get_expand_observe(), id, orig_expr); id = scheme_add_remove_mark(id, local_mark); rev_ids = scheme_make_pair(id, rev_ids); } @@ -5184,6 +5185,7 @@ static Scheme_Object *local_lift_require(int argc, Scheme_Object *argv[]) { Scheme_Comp_Env *env; Scheme_Object *local_mark, *mark, *data, *pr, *form; + Scheme_Object *orig_form, *req_form; long phase; if (!SCHEME_STXP(argv[1])) @@ -5227,11 +5229,16 @@ static Scheme_Object *local_lift_require(int argc, Scheme_Object *argv[]) pr = scheme_make_pair(form, SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[6]); SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[6] = pr; - form = argv[1]; + req_form = form; + orig_form = argv[1]; + + form = orig_form; form = scheme_add_remove_mark(form, local_mark); form = scheme_add_remove_mark(form, mark); form = scheme_add_remove_mark(form, local_mark); + SCHEME_EXPAND_OBSERVE_LIFT_REQUIRE(scheme_get_expand_observe(), req_form, orig_form, form); + return form; } @@ -5270,6 +5277,8 @@ static Scheme_Object *local_lift_provide(int argc, Scheme_Object *argv[]) scheme_make_pair(form, scheme_null)), form, scheme_false, 0, 0); + SCHEME_EXPAND_OBSERVE_LIFT_PROVIDE(scheme_get_expand_observe(), form); + pr = scheme_make_pair(form, SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[7]); SCHEME_VEC_ELS(COMPILE_DATA(env)->lifts)[7] = pr; diff --git a/src/mzscheme/src/schexpobs.h b/src/mzscheme/src/schexpobs.h index 9c51750921..0f98d65e09 100644 --- a/src/mzscheme/src/schexpobs.h +++ b/src/mzscheme/src/schexpobs.h @@ -129,10 +129,15 @@ extern Scheme_Object *scheme_get_expand_observe(); #define SCHEME_EXPAND_OBSERVE_MODULE_LIFT_END_LOOP(observer,stx) \ _SCHEME_EXPOBS(observer,135,stx) -#define SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(obs,id,stx) \ - _SCHEME_EXPOBS(obs,129,scheme_make_pair(id,stx)) +#define SCHEME_EXPAND_OBSERVE_LOCAL_LIFT(obs,ids,stx) \ + _SCHEME_EXPOBS(obs,129,scheme_make_pair(ids,stx)) #define SCHEME_EXPAND_OBSERVE_LIFT_STATEMENT(obs,stx) \ _SCHEME_EXPOBS(obs,134,stx) +#define SCHEME_EXPAND_OBSERVE_LIFT_REQUIRE(obs,req,form,mform) \ + _SCHEME_EXPOBS(obs,150,scheme_make_pair(req,scheme_make_pair(form,mform))) +#define SCHEME_EXPAND_OBSERVE_LIFT_PROVIDE(obs,form) \ + _SCHEME_EXPOBS(obs,151,form) + #define SCHEME_EXPAND_OBSERVE_ENTER_LOCAL(obs,stx) \ _SCHEME_EXPOBS(obs,130,stx) #define SCHEME_EXPAND_OBSERVE_EXIT_LOCAL(obs,stx) \ @@ -169,4 +174,6 @@ extern Scheme_Object *scheme_get_expand_observe(); #define SCHEME_EXPAND_OBSERVE_RENAME_ONE(obs,val) \ _SCHEME_EXPOBS(obs,148,val) +/* next: 152 */ + #endif