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

fix inconsistency in cross-module inlined variable reference

Browse Source 
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:
Matthew Flatt 2016-03-10 10:08:36 -07:00
parent de0fbf2648
commit cbba4e75f9
4 changed files with 42 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/src/racket/src/compenv.c
View File

@ -1128,7 +1128,8 @@ static void check_taint(Scheme_Object *find_id)
"cannot use identifier tainted by macro transformation"); "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]; char buf[20];
sprintf(buf, "struct%d", shape); sprintf(buf, "struct%d", shape);
return scheme_intern_symbol(buf); 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) if (_inline_variant)
*_inline_variant = mod_constant; *_inline_variant = mod_constant;
is_constant = 2; 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)) { } else if (SAME_TYPE(SCHEME_TYPE(mod_constant), scheme_inline_variant_type)) {
if (_inline_variant) { if (_inline_variant) {
/* In case the inline variant includes references to module /* In case the inline variant includes references to module

18
racket/src/racket/src/module.c
View File

@ -4824,13 +4824,13 @@ Scheme_Object *scheme_check_accessible_in_module_instance(Scheme_Env *env,
_is_constant); _is_constant);
} }
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env, 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 *symbol, int position,
Scheme_Object *current_insp, Scheme_Object *binding_insp, Scheme_Object *current_insp, Scheme_Object *binding_insp,
Scheme_Object **_is_constant) Scheme_Object **_is_constant)
{ {
Scheme_Module *module; Scheme_Module *module;
Scheme_Object *modname; Scheme_Object *modname, *pos;
int would_complain = 0; int would_complain = 0;
modname = scheme_module_resolve(modidx, 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) if (!module)
return 0; 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, symbol, NULL,
current_insp, binding_insp, current_insp, binding_insp,
position, 0, position, 1,
NULL, NULL, NULL, NULL,
NULL, NULL,
&would_complain, &would_complain,
_is_constant); _is_constant);
return !would_complain; return (would_complain
? NULL
: (pos ? pos : scheme_make_integer(position)));
} }

38
racket/src/racket/src/resolve.c
View File

@ -3131,7 +3131,7 @@ static Scheme_Object *unresolve_toplevel(Scheme_Object *rdata, Unresolve_Info *u
/* Cannot refer to a lift across a module boundary. */ /* Cannot refer to a lift across a module boundary. */
return_NULL; return_NULL;
} else { } else {
Scheme_Object *hv, *modidx, *mod_constant; Scheme_Object *hv, *modidx, *mod_constant, *sym, *npos, *shape;
int flags, is_constant; int flags, is_constant;
int sym_pos; int sym_pos;
intptr_t mod_defn_phase; 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; mod_defn_phase = ui->toplevel_ref_phase;
modidx = ui->to_modidx; modidx = ui->to_modidx;
sym_pos = -1; sym_pos = -1;
hv = scheme_hash_module_variable(ui->opt_env, modidx, sym = v;
v, ui->opt_insp,
sym_pos, mod_defn_phase, is_constant,
NULL);
} else { } else {
Module_Variable *mv = (Module_Variable *)v; Module_Variable *mv = (Module_Variable *)v;
MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(v), scheme_module_variable_type)); MZ_ASSERT(SAME_TYPE(SCHEME_TYPE(v), scheme_module_variable_type));
mod_defn_phase = mv->mod_phase; mod_defn_phase = mv->mod_phase;
modidx = scheme_modidx_shift(mv->modidx, ui->from_modidx, ui->to_modidx); modidx = scheme_modidx_shift(mv->modidx, ui->from_modidx, ui->to_modidx);
hv = scheme_hash_module_variable(ui->opt_env, modidx, sym = mv->sym;
mv->sym, ui->opt_insp,
mv->pos, mv->mod_phase, is_constant,
mv->shape);
v = mv->sym;
sym_pos = mv->pos; sym_pos = mv->pos;
} }
mod_constant = NULL; mod_constant = NULL;
if (!scheme_check_accessible_in_module_name(modidx, mod_defn_phase, ui->opt_env, npos = scheme_check_accessible_in_module_name(modidx, mod_defn_phase, ui->opt_env,
v, sym_pos, sym, sym_pos,
ui->opt_insp, NULL, ui->opt_insp, NULL,
&mod_constant)) &mod_constant);
if (!npos)
return_NULL; 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: */ /* Check whether this variable is already known in the optimzation context: */
v = scheme_hash_get(ui->comp_prefix->toplevels, hv); v = scheme_hash_get(ui->comp_prefix->toplevels, hv);
if (!v) { if (!v) {

9
racket/src/racket/src/schpriv.h
View File

@ -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, Scheme_Object **symbols, Scheme_Hash_Table *symbol_table,
int fuel); 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); intptr_t scheme_get_struct_proc_shape(int k, Simple_Stuct_Type_Info *sinfo);
Scheme_Object *scheme_make_struct_proc_shape(intptr_t k); Scheme_Object *scheme_make_struct_proc_shape(intptr_t k);
#define STRUCT_PROC_SHAPE_STRUCT 0 #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, int *_protected, int *_unexported,
Scheme_Env *from_env, int *_would_complain, Scheme_Env *from_env, int *_would_complain,
Scheme_Object **_is_constant); Scheme_Object **_is_constant);
int scheme_check_accessible_in_module_name(Scheme_Object *modidx, intptr_t mod_phase, Scheme_Env *env, 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 *symbol, int position,
Scheme_Object *current_insp, Scheme_Object *binding_insp, Scheme_Object *current_insp, Scheme_Object *binding_insp,
Scheme_Object **_is_constant); Scheme_Object **_is_constant);
Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name, int mod_phase); 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, Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,