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

fixed context for id in lifted defn

Browse Source 
svn: r233
This commit is contained in:
Matthew Flatt 2005-06-22 21:37:07 +00:00
parent e4a71a9b3c
commit 4ff341f837
4 changed files with 16 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3289,7 +3289,7 @@ local_lift_expr(int argc, Scheme_Object *argv[])
expr = scheme_stx_activate_certs(expr);
expr = cp(data, id, expr, orig_env);
expr = cp(data, &id, expr, orig_env);
expr = scheme_make_pair(expr, SCHEME_VEC_ELS(vec)[0]);
SCHEME_VEC_ELS(vec)[0] = expr;

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

@ -2564,7 +2564,7 @@ Scheme_Object *scheme_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
return scheme_compile_expand_expr(form, env, erec, drec, 0);
}
static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env)
static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env)
{
Scheme_Comp_Env **ip = (Scheme_Comp_Env **)_ip, *naya;
@ -2572,9 +2572,9 @@ static Scheme_Object *pair_lifted(Scheme_Object *_ip, Scheme_Object *id, Scheme_
(*ip)->next = naya;
*ip = naya;
scheme_add_compilation_binding(0, id, naya);
scheme_add_compilation_binding(0, *_id, naya);
return icons(id, icons(expr, scheme_null));
return icons(*_id, icons(expr, scheme_null));
}
static Scheme_Object *compile_expand_expr_lift_to_let_k(void);
@ -4757,15 +4757,15 @@ Scheme_Object *scheme_get_stop_expander(void)
}
Scheme_Object *
scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env)
scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env)
{
Scheme_Object *l;
/* Registers marked id: */
scheme_tl_id_sym(env->genv, id, 2);
scheme_tl_id_sym(env->genv, *_id, 2);
l = icons(scheme_datum_to_syntax(define_values_symbol, scheme_false, sys_wraps, 0, 0),
icons(scheme_make_immutable_pair(id, scheme_null),
icons(scheme_make_immutable_pair(*_id, scheme_null),
icons(expr,
scheme_null)));

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

@ -3449,16 +3449,16 @@ static Scheme_Object *add_req(Scheme_Object *imods, Scheme_Object *requires)
return requires;
}
static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *_env)
static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *_env)
{
Scheme_Comp_Env *env;
Scheme_Object *self_modidx, *rn, *name;
Scheme_Object *self_modidx, *rn, *name, *id;
env = (Scheme_Comp_Env *)SCHEME_VEC_ELS(data)[0];
self_modidx = SCHEME_VEC_ELS(data)[1];
rn = SCHEME_VEC_ELS(data)[2];
name = scheme_tl_id_sym(env->genv, id, 2);
name = scheme_tl_id_sym(env->genv, *_id, 2);
/* Create the bucket, indicating that the name will be defined: */
scheme_add_global_symbol(name, scheme_undefined, env->genv);
@ -3466,7 +3466,10 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object *id, Sc
/* Add a renaming: */
scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0);
return scheme_make_lifted_defn(scheme_sys_wraps(env), id, expr, _env);
id = scheme_add_rename(*_id, rn);
*_id = id;
return scheme_make_lifted_defn(scheme_sys_wraps(env), _id, expr, _env);
}
static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,

4
src/mzscheme/src/schpriv.h
View File

@ -1546,7 +1546,7 @@ Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env,
Scheme_Comp_Env *upto);
typedef Scheme_Object *(*Scheme_Lift_Capture_Proc)(Scheme_Object *, Scheme_Object *, Scheme_Object *, Scheme_Comp_Env *);
typedef Scheme_Object *(*Scheme_Lift_Capture_Proc)(Scheme_Object *, Scheme_Object **, Scheme_Object *, Scheme_Comp_Env *);
void scheme_frame_captures_lifts(Scheme_Comp_Env *env, Scheme_Lift_Capture_Proc cp, Scheme_Object *data);
Scheme_Object *scheme_frame_get_lifts(Scheme_Comp_Env *env);
@ -1785,7 +1785,7 @@ void scheme_ill_formed(Mz_CPort *port);
extern Scheme_Object *scheme_inferred_name_symbol;
Scheme_Object *scheme_check_name_property(Scheme_Object *stx, Scheme_Object *current_name);
Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object *id, Scheme_Object *expr, Scheme_Comp_Env *env);
Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **id, Scheme_Object *expr, Scheme_Comp_Env *env);
/*========================================================================*/
/* namespaces and modules */