diff --git a/racket/src/racket/src/compenv.c b/racket/src/racket/src/compenv.c index d765f33231..db0e5d97ef 100644 --- a/racket/src/racket/src/compenv.c +++ b/racket/src/racket/src/compenv.c @@ -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 diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index a916c3909e..f9b0c17379 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -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))); } diff --git a/racket/src/racket/src/resolve.c b/racket/src/racket/src/resolve.c index bd4edcf2e4..c057aedd0d 100644 --- a/racket/src/racket/src/resolve.c +++ b/racket/src/racket/src/resolve.c @@ -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) { diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 64434e3b17..795c6c95a8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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,