diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index 66ca5c9f04..d62036f285 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -2597,7 +2597,7 @@ void scheme_unbound_global(Scheme_Bucket *b) name, errmsg, name, - home->module->modsrc, + scheme_get_modsrc(home->module), phase, phase_note); } else { diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index bf6a289fed..bf698d4783 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -848,6 +848,10 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, menv = scheme_module_access(modname, env, mod_phase); if (!menv) { + Scheme_Object *modsrc; + modsrc = (env->module + ? scheme_get_modsrc(env->module) + : scheme_false); scheme_wrong_syntax("link", NULL, varname, "namespace mismatch;\n" " reference to a module that is not available\n" @@ -858,7 +862,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, env->phase, modname, mod_phase, - env->module ? env->module->modsrc : scheme_false); + modsrc); return NULL; } @@ -911,6 +915,10 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, } if (bad_reason) { + Scheme_Object *modsrc; + modsrc = (env->module + ? scheme_get_modsrc(env->module) + : scheme_false); scheme_wrong_syntax("link", NULL, varname, "bad variable linkage;\n" " reference to a variable that %s\n" @@ -922,7 +930,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, env->phase, modname, mod_phase, - env->module ? env->module->modsrc : scheme_false); + modsrc); } if (!(((Scheme_Bucket_With_Flags *)bkt)->flags & (GLOB_IS_IMMUTATED | GLOB_IS_LINKED))) @@ -1892,7 +1900,7 @@ void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val, : "constant") : "variable"), (Scheme_Object *)b->key, - home->module->modsrc); + scheme_get_modsrc(home->module)); } else { scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key, "%s: " CANNOT_SET_ERROR_STR ";\n" diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 0f8425f3f6..fdb83a93d7 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -169,9 +169,6 @@ static int phaseless_rhs(Scheme_Object *val, int var_count, int phase); #define cons scheme_make_pair -/* We'd prefer a field like modsrc, but with submodule info like modname: */ -#define MODSRCNAME modname - /* global read-only kernel stuff */ READ_ONLY static Scheme_Object *kernel_modname; READ_ONLY static Scheme_Object *kernel_symbol; @@ -1302,7 +1299,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], scheme_contract_error(errname, "name is provided as syntax", "name", 1, name, - "module", 1, srcm->MODSRCNAME, + "module", 1, scheme_get_modsrc(srcm), NULL); } } @@ -1363,7 +1360,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], scheme_contract_error(errname, "name is not provided", "name", 1, name, - "module", 1, srcm->MODSRCNAME, + "module", 1, scheme_get_modsrc(srcm), NULL); } return NULL; @@ -1419,14 +1416,14 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], scheme_contract_error(errname, "name is protected", "name", 1, name, - "module", 1, srcm->MODSRCNAME, + "module", 1, scheme_get_modsrc(srcm), NULL); } if (!menv || !menv->toplevel) { scheme_contract_error(errname, "module inialization failed", - "module", 1, srcm->MODSRCNAME, + "module", 1, scheme_get_modsrc(srcm), NULL); } @@ -4487,7 +4484,7 @@ static void check_certified(Scheme_Object *stx, "access disallowed by code inspector to %s %s from module: %D", prot ? "protected" : "unexported", var ? "variable" : "syntax", - env->module->MODSRCNAME); + scheme_get_modsrc(env->module)); } } } @@ -4706,7 +4703,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object intptr_t srclen; if (from_env->module) - srcstr = scheme_display_to_string(from_env->module->MODSRCNAME, &srclen); + srcstr = scheme_display_to_string(scheme_get_modsrc(from_env->module), &srclen); else { srcstr = ""; srclen = 0; @@ -4722,7 +4719,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object srclen ? " importing module: " : "", srcstr, srclen, srclen ? "\n" : "", - env->module->MODSRCNAME, + scheme_get_modsrc(env->module), env->mod_phase, (position >= 0) ? " and at the expected position" : ""); } @@ -4836,7 +4833,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, " but need (dynamic-require .... 0)\n" " module: %D\n" " phase: %d", - menv->module->MODSRCNAME, + scheme_get_modsrc(menv->module), mod_phase); return NULL; } @@ -5611,7 +5608,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart, if (SAME_OBJ(m->modname, SCHEME_CAR(l))) { scheme_contract_error("module", "import cycle detected", - "module in cycle", 1, m->MODSRCNAME, + "module in cycle", 1, scheme_get_modsrc(m), NULL); } } @@ -5781,7 +5778,7 @@ static void eval_module_body(Scheme_Env *menv, Scheme_Env *env) } #ifdef MZ_USE_JIT - (void)scheme_module_run_start(menv, env, scheme_make_pair(menv->module->MODSRCNAME, scheme_true)); + (void)scheme_module_run_start(menv, env, scheme_make_pair(scheme_get_modsrc(menv->module), scheme_true)); #else (void)scheme_module_run_finish(menv, env); #endif @@ -6665,6 +6662,22 @@ Scheme_Object *scheme_module_execute(Scheme_Object *data, Scheme_Env *genv) return do_module_execute(data, genv, 1, 0, NULL, NULL); } +Scheme_Object *scheme_get_modsrc(Scheme_Module *mod) +{ + Scheme_Object *p, *p2; + + p = scheme_resolved_module_path_value(mod->modname); + if (SCHEME_PAIRP(p)) { + /* Construct a submodule path based on `modsrc` instead of `modname`. */ + p2 = scheme_resolved_module_path_value(mod->modsrc); + if (SAME_OBJ(SCHEME_CAR(p), p2)) + return mod->modname; + else + return scheme_intern_resolved_module_path(scheme_make_pair(p2, SCHEME_CDR(p))); + } else + return mod->modsrc; +} + static Scheme_Object *rebuild_et_vec(Scheme_Object *naya, Scheme_Object *vec, Resolve_Prefix *rp) { Scheme_Object *vec2; diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index d26f037d3d..7219ae4bda 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3579,6 +3579,8 @@ char *scheme_submodule_path_to_string(Scheme_Object *p, intptr_t *_len); Scheme_Object *scheme_annotate_existing_submodules(Scheme_Object *orig_fm, int incl_star); +Scheme_Object *scheme_get_modsrc(Scheme_Module *m); + /*========================================================================*/ /* errors and exceptions */ /*========================================================================*/