fix inconsistency in cross-module inlined variable reference
The variable's position in its module was wrong, and possibly the shape info. The demodularizer test exposed the inconsistency.
This commit is contained in:
parent
de0fbf2648
commit
cbba4e75f9
|
@ -1128,7 +1128,8 @@ static void check_taint(Scheme_Object *find_id)
|
|||
"cannot use identifier tainted by macro transformation");
|
||||
}
|
||||
|
||||
static Scheme_Object *intern_struct_proc_shape(int shape) {
|
||||
Scheme_Object *scheme_intern_struct_proc_shape(int shape)
|
||||
{
|
||||
char buf[20];
|
||||
sprintf(buf, "struct%d", shape);
|
||||
return scheme_intern_symbol(buf);
|
||||
|
@ -1577,7 +1578,7 @@ scheme_compile_lookup(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
|
|||
if (_inline_variant)
|
||||
*_inline_variant = mod_constant;
|
||||
is_constant = 2;
|
||||
shape = intern_struct_proc_shape(SCHEME_PROC_SHAPE_MODE(mod_constant));
|
||||
shape = scheme_intern_struct_proc_shape(SCHEME_PROC_SHAPE_MODE(mod_constant));
|
||||
} else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type)) {
|
||||
if (_inline_variant) {
|
||||
/* In case the inline variant includes references to module
|
||||
|
|
|
@ -4824,13 +4824,13 @@ Scheme_Object *scheme_check_accessible_in_module_instance(Scheme_Env *env,
|
|||
_is_constant);
|
||||
}
|
||||
|
||||
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
|
||||
Scheme_Object *symbol, int position,
|
||||
Scheme_Object *current_insp, Scheme_Object *binding_insp,
|
||||
Scheme_Object **_is_constant)
|
||||
Scheme_Object *scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
|
||||
Scheme_Object *symbol, int position,
|
||||
Scheme_Object *current_insp, Scheme_Object *binding_insp,
|
||||
Scheme_Object **_is_constant)
|
||||
{
|
||||
Scheme_Module *module;
|
||||
Scheme_Object *modname;
|
||||
Scheme_Object *modname, *pos;
|
||||
int would_complain = 0;
|
||||
|
||||
modname = scheme_module_resolve(modidx, 0);
|
||||
|
@ -4839,16 +4839,18 @@ int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_p
|
|||
if (!module)
|
||||
return 0;
|
||||
|
||||
(void)check_accessible_in_module(module, mod_phase, scheme_make_inspector(module->insp),
|
||||
pos = check_accessible_in_module(module, mod_phase, scheme_make_inspector(module->insp),
|
||||
symbol, NULL,
|
||||
current_insp, binding_insp,
|
||||
position, 0,
|
||||
position, 1,
|
||||
NULL, NULL,
|
||||
NULL,
|
||||
&would_complain,
|
||||
_is_constant);
|
||||
|
||||
return !would_complain;
|
||||
return (would_complain
|
||||
? NULL
|
||||
: (pos ? pos : scheme_make_integer(position)));
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -3131,7 +3131,7 @@ static Scheme_Object *unresolve_toplevel(Scheme_Object *rdata, Unresolve_Info *u
|
|||
/* Cannot refer to a lift across a module boundary. */
|
||||
return_NULL;
|
||||
} else {
|
||||
Scheme_Object *hv, *modidx, *mod_constant;
|
||||
Scheme_Object *hv, *modidx, *mod_constant, *sym, *npos, *shape;
|
||||
int flags, is_constant;
|
||||
int sym_pos;
|
||||
intptr_t mod_defn_phase;
|
||||
|
@ -3162,30 +3162,40 @@ static Scheme_Object *unresolve_toplevel(Scheme_Object *rdata, Unresolve_Info *u
|
|||
mod_defn_phase = ui->toplevel_ref_phase;
|
||||
modidx = ui->to_modidx;
|
||||
sym_pos = -1;
|
||||
hv = scheme_hash_module_variable(ui->opt_env, modidx,
|
||||
v, ui->opt_insp,
|
||||
sym_pos, mod_defn_phase, is_constant,
|
||||
NULL);
|
||||
sym = v;
|
||||
} else {
|
||||
Module_Variable *mv = (Module_Variable *)v;
|
||||
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(v), scheme_module_variable_type));
|
||||
mod_defn_phase = mv->mod_phase;
|
||||
modidx = scheme_modidx_shift(mv->modidx, ui->from_modidx, ui->to_modidx);
|
||||
hv = scheme_hash_module_variable(ui->opt_env, modidx,
|
||||
mv->sym, ui->opt_insp,
|
||||
mv->pos, mv->mod_phase, is_constant,
|
||||
mv->shape);
|
||||
v = mv->sym;
|
||||
sym = mv->sym;
|
||||
sym_pos = mv->pos;
|
||||
}
|
||||
|
||||
mod_constant = NULL;
|
||||
if (!scheme_check_accessible_in_module_name(modidx, mod_defn_phase, ui->opt_env,
|
||||
v, sym_pos,
|
||||
ui->opt_insp, NULL,
|
||||
&mod_constant))
|
||||
npos = scheme_check_accessible_in_module_name(modidx, mod_defn_phase, ui->opt_env,
|
||||
sym, sym_pos,
|
||||
ui->opt_insp, NULL,
|
||||
&mod_constant);
|
||||
if (!npos)
|
||||
return_NULL;
|
||||
|
||||
if (sym_pos < 0)
|
||||
sym_pos = SCHEME_INT_VAL(npos);
|
||||
|
||||
shape = NULL;
|
||||
if (mod_constant) {
|
||||
if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_struct_proc_shape_type))
|
||||
shape = scheme_intern_struct_proc_shape(SCHEME_PROC_SHAPE_MODE(mod_constant));
|
||||
else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type))
|
||||
shape = scheme_get_or_check_procedure_shape(mod_constant, NULL);
|
||||
}
|
||||
|
||||
hv = scheme_hash_module_variable(ui->opt_env, modidx,
|
||||
sym, ui->opt_insp,
|
||||
sym_pos, mod_defn_phase, is_constant,
|
||||
shape);
|
||||
|
||||
/* Check whether this variable is already known in the optimzation context: */
|
||||
v = scheme_hash_get(ui->comp_prefix->toplevels, hv);
|
||||
if (!v) {
|
||||
|
|
|
@ -3486,6 +3486,7 @@ Scheme_Object *scheme_is_simple_make_struct_type(Scheme_Object *app, int vals, i
|
|||
Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
|
||||
int fuel);
|
||||
|
||||
Scheme_Object *scheme_intern_struct_proc_shape(int shape);
|
||||
intptr_t scheme_get_struct_proc_shape(int k, Simple_Stuct_Type_Info *sinfo);
|
||||
Scheme_Object *scheme_make_struct_proc_shape(intptr_t k);
|
||||
#define STRUCT_PROC_SHAPE_STRUCT 0
|
||||
|
@ -3905,10 +3906,10 @@ Scheme_Object *scheme_check_accessible_in_module_instance(Scheme_Env *env,
|
|||
int *_protected, int *_unexported,
|
||||
Scheme_Env *from_env, int *_would_complain,
|
||||
Scheme_Object **_is_constant);
|
||||
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
|
||||
Scheme_Object *symbol, int position,
|
||||
Scheme_Object *current_insp, Scheme_Object *binding_insp,
|
||||
Scheme_Object **_is_constant);
|
||||
Scheme_Object *scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env,
|
||||
Scheme_Object *symbol, int position,
|
||||
Scheme_Object *current_insp, Scheme_Object *binding_insp,
|
||||
Scheme_Object **_is_constant);
|
||||
Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase);
|
||||
|
||||
Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
|
||||
|
|
Loading…
Reference in New Issue
Block a user