diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl index 22fdf38dba..896b182311 100644 --- a/collects/scribblings/reference/syntax.scrbl +++ b/collects/scribblings/reference/syntax.scrbl @@ -1178,7 +1178,9 @@ module. The @scheme[module-path] must be as for @scheme[require], and it supplies the initial bindings for the body @scheme[form]s. That is, it is treated like a @scheme[(require module-path)] prefix before the -@scheme[form]s. +@scheme[form]s, except that the bindings introduced by +@scheme[module-path] can be shadowed by definitions and +@scheme[require]s in the module body @scheme[form]s. If a single @scheme[form] is provided, then it is partially expanded in a @tech{module-begin context}. If the expansion leads to diff --git a/collects/tests/mzscheme/module.ss b/collects/tests/mzscheme/module.ss index d144dbef81..c5009988de 100644 --- a/collects/tests/mzscheme/module.ss +++ b/collects/tests/mzscheme/module.ss @@ -122,7 +122,7 @@ (syntax-test #'(module m mzscheme (require (rename n n not-there)))) (syntax-test #'(module m mzscheme (require (rename n n m extra)))) -(syntax-test #'(module m mzscheme (define car 5))) +(syntax-test #'(module m mzscheme (require mzscheme) (define car 5))) (syntax-test #'(module m mzscheme (define x 6) (define x 5))) (syntax-test #'(module m mzscheme (define x 10) (define-syntax x 10))) (syntax-test #'(module m mzscheme (define-syntax x 10) (define x 10))) @@ -130,6 +130,13 @@ ;; Cyclic re-def of n: (syntax-test #'(module n n 10)) +;; It's now ok to shadow the initial import: +(module _shadow_ mzscheme + (define car 5) + (provide car)) + +(test 5 dynamic-require ''_shadow_ 'car) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check namespace-attach-module: diff --git a/doc/release-notes/mzscheme/MzScheme_4.txt b/doc/release-notes/mzscheme/MzScheme_4.txt index db103c3c3d..b31f3d1e30 100644 --- a/doc/release-notes/mzscheme/MzScheme_4.txt +++ b/doc/release-notes/mzscheme/MzScheme_4.txt @@ -80,6 +80,10 @@ but we start with an enumeration of changes: is terminated by the end-of-file) and the absence of the redundant identifier `my-library'. + - Bindings introduced by a module's language (i.e., its initial + import) can be shadowed by definitions and imports in the module + body. + - Under Unix, "~" is no longer automatically expanded to a user's home directory. The `expand-user-path' function from `scheme/base' explicitly expands the abbreviation (but this function should be diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 36e8c9e698..85743cde54 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,5 +1,5 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,49,57,50,0,0,0,1,0,0,6,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,50,48,50,0,0,0,1,0,0,6,0, 9,0,14,0,17,0,24,0,31,0,35,0,48,0,55,0,60,0,65,0,69, 0,78,0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0, 155,0,177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107, @@ -14,11 +14,11 @@ 117,101,115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108, 97,109,98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105, 111,110,45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101, -115,98,10,34,11,8,163,207,94,159,2,16,34,34,159,2,15,34,34,16,20, +115,98,10,34,11,8,164,207,94,159,2,16,34,34,159,2,15,34,34,16,20, 2,3,2,2,2,5,2,2,2,6,2,2,2,7,2,2,2,8,2,2,2, 9,2,2,2,10,2,2,2,4,2,2,2,11,2,2,2,12,2,2,97,35, -11,8,163,207,93,159,2,15,34,35,16,2,2,13,161,2,2,35,2,13,2, -2,2,13,97,10,11,11,8,163,207,16,0,97,10,36,11,8,163,207,16,0, +11,8,164,207,93,159,2,15,34,35,16,2,2,13,161,2,2,35,2,13,2, +2,2,13,97,10,11,11,8,164,207,16,0,97,10,36,11,8,164,207,16,0, 13,16,4,34,29,11,11,2,2,11,18,98,64,104,101,114,101,8,31,8,30, 8,29,8,28,8,27,27,248,22,180,3,23,196,1,249,22,173,3,80,158,37, 34,251,22,73,2,17,248,22,88,23,200,2,12,249,22,63,2,1,248,22,90, @@ -28,14 +28,14 @@ 35,34,35,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,173,3, 80,158,37,34,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,12,248, 22,65,23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4, -11,11,2,18,3,1,7,101,110,118,55,51,48,52,16,4,11,11,2,19,3, -1,7,101,110,118,55,51,48,53,27,248,22,65,248,22,180,3,23,197,1,28, +11,11,2,18,3,1,7,101,110,118,55,51,48,53,16,4,11,11,2,19,3, +1,7,101,110,118,55,51,48,54,27,248,22,65,248,22,180,3,23,197,1,28, 248,22,71,23,194,2,20,15,159,35,34,35,28,248,22,71,248,22,65,23,195, 2,248,22,64,193,249,22,173,3,80,158,37,34,250,22,73,2,20,248,22,73, 249,22,73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21, 2,21,249,22,63,2,4,248,22,65,23,205,1,18,100,11,8,31,8,30,8, -29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,48,55, -16,4,11,11,2,19,3,1,7,101,110,118,55,51,48,56,248,22,180,3,193, +29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,48,56, +16,4,11,11,2,19,3,1,7,101,110,118,55,51,48,57,248,22,180,3,193, 27,248,22,180,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27, 248,22,65,248,22,180,3,23,197,1,249,22,173,3,80,158,37,34,28,248,22, 51,248,22,174,3,248,22,64,23,198,2,27,249,22,2,32,0,89,162,8,44, @@ -65,8 +65,8 @@ 65,202,251,22,73,2,17,28,249,22,140,8,248,22,174,3,248,22,64,23,201, 2,64,101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22, 65,23,201,1,249,22,63,2,3,248,22,65,23,203,1,99,8,31,8,30,8, -29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,51,48, -16,4,11,11,2,19,3,1,7,101,110,118,55,51,51,49,18,158,94,10,64, +29,8,28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,55,51,51,49, +16,4,11,11,2,19,3,1,7,101,110,118,55,51,51,50,18,158,94,10,64, 118,111,105,100,8,47,27,248,22,65,248,22,180,3,196,249,22,173,3,80,158, 37,34,28,248,22,51,248,22,174,3,248,22,64,197,250,22,73,2,26,248,22, 73,248,22,64,199,248,22,88,198,27,248,22,174,3,248,22,64,197,250,22,73, @@ -100,7 +100,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2046); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,49,57,60,0,0,0,1,0,0,3,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,50,48,60,0,0,0,1,0,0,3,0, 16,0,21,0,38,0,53,0,71,0,87,0,97,0,115,0,135,0,151,0,169, 0,200,0,229,0,251,0,9,1,15,1,29,1,34,1,44,1,52,1,80,1, 112,1,157,1,202,1,226,1,9,2,11,2,68,2,158,3,167,3,208,3,42, @@ -342,12 +342,12 @@ EVAL_ONE_SIZED_STR((char *)expr, 5013); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,49,57,8,0,0,0,1,0,0,6,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,50,48,8,0,0,0,1,0,0,6,0, 19,0,34,0,48,0,62,0,76,0,111,0,0,0,243,0,0,0,65,113,117, 111,116,101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69, 35,37,110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97, 109,122,11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1, -68,35,37,107,101,114,110,101,108,11,98,10,34,11,8,165,209,97,159,2,2, +68,35,37,107,101,114,110,101,108,11,98,10,34,11,8,166,209,97,159,2,2, 34,34,159,2,3,34,34,159,2,4,34,34,159,2,5,34,34,159,2,6,34, 34,16,0,159,34,20,102,159,34,16,1,20,24,65,98,101,103,105,110,16,0, 83,158,40,20,99,137,69,35,37,98,117,105,108,116,105,110,29,11,11,10,10, @@ -359,7 +359,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 282); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,49,57,52,0,0,0,1,0,0,3,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,9,51,46,57,57,46,48,46,50,48,52,0,0,0,1,0,0,3,0, 14,0,41,0,47,0,60,0,74,0,96,0,122,0,134,0,152,0,172,0,184, 0,200,0,223,0,3,1,8,1,13,1,18,1,23,1,54,1,58,1,66,1, 74,1,82,1,185,1,230,1,253,1,32,2,67,2,101,2,111,2,145,2,155, diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index dd91a46b93..925a11779d 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -545,7 +545,7 @@ void scheme_finish_kernel(Scheme_Env *env) scheme_extend_module_rename(rn, kernel_modidx, exs[i], exs[i], kernel_modidx, exs[i], 0, scheme_make_integer(0), NULL, 0); } - scheme_seal_module_rename(rn); + scheme_seal_module_rename(rn, STX_SEAL_ALL); scheme_sys_wraps(NULL); @@ -666,7 +666,7 @@ Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env) /* Add a module mapping for all kernel provides: */ scheme_extend_module_rename_with_kernel(rn, kernel_modidx); - scheme_seal_module_rename(rn); + scheme_seal_module_rename(rn, STX_SEAL_ALL); w = scheme_datum_to_syntax(kernel_symbol, scheme_false, scheme_false, 0, 0); w = scheme_add_rename(w, rn); @@ -1870,7 +1870,8 @@ static int do_add_simple_require_renames(Scheme_Object *rn, Scheme_Module *im, Scheme_Module_Phase_Exports *pt, Scheme_Object *idx, Scheme_Object *marshal_phase_index, - Scheme_Object *src_phase_index) + Scheme_Object *src_phase_index, + int can_override) { int i, saw_mb, numvals; Scheme_Object **exs, **exss, **exsns, *midx, *info, *vec, *nml, *mark_src; @@ -1910,7 +1911,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, saw_mb = 1; if (required) { - vec = scheme_make_vector(7, NULL); + vec = scheme_make_vector(8, NULL); nml = scheme_make_pair(idx, scheme_null); SCHEME_VEC_ELS(vec)[0] = nml; SCHEME_VEC_ELS(vec)[1] = midx; @@ -1919,6 +1920,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, SCHEME_VEC_ELS(vec)[4] = exs[i]; SCHEME_VEC_ELS(vec)[5] = orig_src; SCHEME_VEC_ELS(vec)[6] = mark_src; + SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false); scheme_hash_set(required, exs[i], vec); } } @@ -1934,7 +1936,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, numvals = kernel->me->rt->num_var_provides; for (i = kernel->me->rt->num_provides; i--; ) { if (!SAME_OBJ(pt->kernel_exclusion, exs[i])) { - vec = scheme_make_vector(7, NULL); + vec = scheme_make_vector(8, NULL); nml = scheme_make_pair(idx, scheme_null); SCHEME_VEC_ELS(vec)[0] = nml; SCHEME_VEC_ELS(vec)[1] = kernel_modidx; @@ -1943,6 +1945,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, SCHEME_VEC_ELS(vec)[4] = exs[i]; SCHEME_VEC_ELS(vec)[5] = orig_src; SCHEME_VEC_ELS(vec)[6] = mark_src; + SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false); scheme_hash_set(required, exs[i], vec); } } @@ -1983,7 +1986,8 @@ static int add_simple_require_renames(Scheme_Object *orig_src, Scheme_Hash_Table *tables, Scheme_Module *im, Scheme_Object *idx, Scheme_Object *import_shift /* = src_phase_index */, - Scheme_Object *only_export_phase) + Scheme_Object *only_export_phase, + int can_override) { int saw_mb; Scheme_Object *phase; @@ -1994,7 +1998,8 @@ static int add_simple_require_renames(Scheme_Object *orig_src, get_required_from_tables(tables, import_shift), orig_src, im, im->me->rt, idx, scheme_make_integer(0), - import_shift); + import_shift, + can_override); else saw_mb = 0; @@ -2008,7 +2013,8 @@ static int add_simple_require_renames(Scheme_Object *orig_src, get_required_from_tables(tables, phase), orig_src, im, im->me->et, idx, scheme_make_integer(1), - import_shift); + import_shift, + can_override); } if (im->me->dt @@ -2017,7 +2023,8 @@ static int add_simple_require_renames(Scheme_Object *orig_src, get_required_from_tables(tables, scheme_false), orig_src, im, im->me->dt, idx, scheme_false, - import_shift); + import_shift, + can_override); } if (im->me->other_phases) { @@ -2036,7 +2043,8 @@ static int add_simple_require_renames(Scheme_Object *orig_src, get_required_from_tables(tables, phase), orig_src, im, (Scheme_Module_Phase_Exports *)val, idx, key, - import_shift); + import_shift, + can_override); } } } @@ -2142,6 +2150,8 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env) } if (l) { + /* Shouldn't we do initial import first, to get shadowing + right? Somehow, it seems to work this way. */ for (; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { idx = SCHEME_CAR(l); name = scheme_module_resolve(idx, 0); @@ -2151,7 +2161,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env) else im = (Scheme_Module *)scheme_hash_get(menv->module_registry, name); - add_simple_require_renames(NULL, rns, NULL, im, idx, shift, NULL); + add_simple_require_renames(NULL, rns, NULL, im, idx, shift, NULL, 0); } } } @@ -4694,7 +4704,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, scheme_extend_module_rename_with_kernel(rn, kernel_modidx); saw_mb = 1; } else { - saw_mb = add_simple_require_renames(NULL, rn_set, NULL, iim, iidx, scheme_make_integer(0), NULL); + saw_mb = add_simple_require_renames(NULL, rn_set, NULL, iim, iidx, scheme_make_integer(0), NULL, 1); } if (rec[drec].comp) @@ -4914,7 +4924,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, scheme_null)))); } - /* Not required, or required from same module: */ + /* Check not required, or required from same module: */ vec = scheme_hash_get(required, name); if (vec) { Scheme_Object *srcs; @@ -4927,34 +4937,40 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, and also add source phase for re-provides. */ nml = scheme_make_pair(nominal_modidx, SCHEME_VEC_ELS(vec)[0]); SCHEME_VEC_ELS(vec)[0] = nml; + SCHEME_VEC_ELS(vec)[7] = scheme_false; return; } - srcs = scheme_null; - if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[5])) { - srcs = scheme_make_pair(SCHEME_VEC_ELS(vec)[5], srcs); - /* don't use error_write_to_string_w_max since this is code */ - if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) { - fromsrc = scheme_write_to_string_w_max(scheme_syntax_to_datum(SCHEME_VEC_ELS(vec)[5], 0, NULL), - &fromsrclen, 32); - fromsrc_colon = ":"; + if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7])) { + /* can override */ + } else { + /* error: already imported */ + srcs = scheme_null; + if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[5])) { + srcs = scheme_make_pair(SCHEME_VEC_ELS(vec)[5], srcs); + /* don't use error_write_to_string_w_max since this is code */ + if (SCHEME_TRUEP(scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_SRCLOC))) { + fromsrc = scheme_write_to_string_w_max(scheme_syntax_to_datum(SCHEME_VEC_ELS(vec)[5], 0, NULL), + &fromsrclen, 32); + fromsrc_colon = ":"; + } } - } - if (!fromsrc) { - fromsrc = "a different source"; - fromsrclen = strlen(fromsrc); + if (!fromsrc) { + fromsrc = "a different source"; + fromsrclen = strlen(fromsrc); + } + + if (err_src) + srcs = scheme_make_pair(err_src, srcs); + + scheme_wrong_syntax_with_more_sources("module", prnt_name, err_src, srcs, + "identifier already imported from%s %t", + fromsrc_colon, fromsrc, fromsrclen); } - - if (err_src) - srcs = scheme_make_pair(err_src, srcs); - - scheme_wrong_syntax_with_more_sources("module", prnt_name, err_src, srcs, - "identifier already imported from%s %t", - fromsrc_colon, fromsrc, fromsrclen); } - /* Not syntax: */ + /* Check not syntax: */ if (syntax) { if (scheme_lookup_in_table(syntax, (const char *)name)) { scheme_wrong_syntax("module", prnt_name, form, "imported identifier already defined"); @@ -4962,7 +4978,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, } /* Remember require: */ - vec = scheme_make_vector(7, NULL); + vec = scheme_make_vector(8, NULL); nml = scheme_make_pair(nominal_modidx, scheme_null); SCHEME_VEC_ELS(vec)[0] = nml; SCHEME_VEC_ELS(vec)[1] = modidx; @@ -4971,9 +4987,26 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, SCHEME_VEC_ELS(vec)[4] = prnt_name; SCHEME_VEC_ELS(vec)[5] = (err_src ? err_src : scheme_false); SCHEME_VEC_ELS(vec)[6] = (mark_src ? mark_src : scheme_false); + SCHEME_VEC_ELS(vec)[7] = scheme_false; scheme_hash_set(required, name, vec); } +static int check_already_required(Scheme_Hash_Table *required, Scheme_Object *name) +{ + Scheme_Object *vec; + + vec = scheme_hash_get(required, name); + if (vec) { + if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7])) { + scheme_hash_set(required, name, NULL); + return 0; + } + return 1; + } + + return 0; +} + static Scheme_Object *stx_sym(Scheme_Object *name, Scheme_Object *_genv) { return scheme_tl_id_sym((Scheme_Env *)_genv, name, NULL, 2, NULL); @@ -5169,7 +5202,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, add_simple_require_renames(orig_src, rn_set, tables, iim, nmidx, scheme_make_integer(0), - NULL); + NULL, 1); } { @@ -5321,7 +5354,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, } /* Not required: */ - if (scheme_hash_get(required, name)) { + if (check_already_required(required, name)) { scheme_wrong_syntax("module", orig_name, e, "identifier is already imported"); return NULL; } @@ -5409,7 +5442,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, } /* Not required: */ - if (scheme_hash_get(for_stx ? et_required : required, name)) { + if (check_already_required(for_stx ? et_required : required, name)) { scheme_wrong_syntax("module", orig_name, e, (for_stx ? "identifier is already imported for syntax" @@ -5540,6 +5573,12 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, } /* first = a list of (cons semi-expanded-expression kind) */ + /* Bound names will be re-bound at this point: */ + if (rec[drec].comp || (rec[drec].depth != -2)) { + scheme_seal_module_rename_set(rn_set, STX_SEAL_BOUND); + scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_BOUND); + } + /* Pass 2 */ SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer); @@ -5696,8 +5735,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, } if (rec[drec].comp || (rec[drec].depth != -2)) { - scheme_seal_module_rename_set(rn_set); - scheme_seal_module_rename_set(post_ex_rn_set); + scheme_seal_module_rename_set(rn_set, STX_SEAL_ALL); + scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_ALL); } /* Compute provides for re-provides and all-defs-out: */ diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index c6cf9c1d6f..5696f1398e 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -673,8 +673,10 @@ Scheme_Hash_Table *scheme_get_module_rename_marked_names(Scheme_Object *set, Sch void scheme_append_rename_set_to_env(Scheme_Object *rns, Scheme_Env *env); -void scheme_seal_module_rename(Scheme_Object *rn); -void scheme_seal_module_rename_set(Scheme_Object *rns); +void scheme_seal_module_rename(Scheme_Object *rn, int level); +void scheme_seal_module_rename_set(Scheme_Object *rns, int level); +#define STX_SEAL_BOUND 1 +#define STX_SEAL_ALL 2 Scheme_Object *scheme_make_module_rename(Scheme_Object *phase, int kind, Scheme_Hash_Table *mns); void scheme_extend_module_rename(Scheme_Object *rn, Scheme_Object *modname, diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index c852aebedf..3f75df5f22 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "3.99.0.19" +#define MZSCHEME_VERSION "3.99.0.20" #define MZSCHEME_VERSION_X 3 #define MZSCHEME_VERSION_Y 99 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 19 +#define MZSCHEME_VERSION_W 20 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index ee760b9bb8..702bdd4f42 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -125,7 +125,8 @@ XFORM_NONGCING static int prefab_p(Scheme_Object *o) typedef struct Module_Renames { Scheme_Object so; /* scheme_rename_table_type */ - char plus_kernel, kind, needs_unmarshal, sealed; + char plus_kernel, kind, needs_unmarshal; + char sealed; /* 1 means bound won't change; 2 means unbound won't change, either */ Scheme_Object *phase; Scheme_Object *plus_kernel_nominal_source; Scheme_Object *set_identity; @@ -1190,25 +1191,25 @@ Scheme_Object *scheme_make_module_rename(Scheme_Object *phase, int kind, Scheme_ return (Scheme_Object *)mr; } -void scheme_seal_module_rename(Scheme_Object *rn) +void scheme_seal_module_rename(Scheme_Object *rn, int level) { - ((Module_Renames *)rn)->sealed = 1; + ((Module_Renames *)rn)->sealed = level; } -void scheme_seal_module_rename_set(Scheme_Object *_rns) +void scheme_seal_module_rename_set(Scheme_Object *_rns, int level) { Module_Renames_Set *rns = (Module_Renames_Set *)_rns; - rns->sealed = 1; + rns->sealed = level; if (rns->rt) - rns->rt->sealed = 1; + rns->rt->sealed = level; if (rns->et) - rns->et->sealed = 1; + rns->et->sealed = level; if (rns->other_phases) { int i; for (i = 0; i < rns->other_phases->size; i++) { if (rns->other_phases->vals[i]) { - ((Module_Renames *)rns->other_phases->vals[i])->sealed = 1; + ((Module_Renames *)rns->other_phases->vals[i])->sealed = level; } } } @@ -1216,7 +1217,7 @@ void scheme_seal_module_rename_set(Scheme_Object *_rns) static void check_not_sealed(Module_Renames *mrn) { - if (mrn->sealed) + if (mrn->sealed >= STX_SEAL_ALL) scheme_signal_error("internal error: attempt to change sealed module rename"); } @@ -1691,7 +1692,7 @@ static void unmarshal_rename(Module_Renames *mrn, } if (sealed) - mrn->sealed = 1; + mrn->sealed = sealed; } /******************** wrap manipulations ********************/ @@ -3684,7 +3685,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ { WRAP_POS wraps; Scheme_Object *result, *result_from; - int is_in_module = 0, skip_other_mods = 0, can_cache = 1; + int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL; Scheme_Object *phase = orig_phase; Scheme_Object *bdg = NULL; @@ -3698,8 +3699,10 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ while (1) { if (WRAP_POS_END_P(wraps)) { - if (result) - can_cache = 1; /* If it becomes bound, it can't become unbound. */ + int can_cache = (sealed >= STX_SEAL_ALL); + + if (result) + can_cache = (sealed >= STX_SEAL_BOUND); /* If it becomes bound, it can't become unbound. */ if (!result) result = SCHEME_STX_VAL(a); @@ -3723,8 +3726,8 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if ((!is_in_module || (mrns->kind != mzMOD_RENAME_TOPLEVEL)) && !skip_other_mods) { - if (!mrns->sealed) - can_cache = 0; + if (mrns->sealed < sealed) + sealed = mrns->sealed; } mrn = extract_renames(mrns, phase); @@ -3739,8 +3742,8 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ /* Module rename: */ Scheme_Object *rename, *glob_id; - if (!mrn->sealed) - can_cache = 0; + if (mrn->sealed < sealed) + sealed = mrn->sealed; if (mrn->needs_unmarshal) { /* Use resolve_env to trigger unmarshal, so that we @@ -4730,7 +4733,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, if (mrn) { if (mrn->kind == mzMOD_RENAME_MARKED) { /* Not useful if there's no marked names. */ - redundant = (mrn->sealed + redundant = ((mrn->sealed >= STX_SEAL_ALL) && (!mrn->marked_names || !mrn->marked_names->count)); if (!redundant) { /* Otherwise, watch out for multiple instances of the same rename: */ @@ -5670,7 +5673,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, scheme_unmarshal_wrap_set(ut, local_key, (Scheme_Object *)mrn); - scheme_seal_module_rename((Scheme_Object *)mrn); + scheme_seal_module_rename((Scheme_Object *)mrn, STX_SEAL_ALL); a = (Scheme_Object *)mrn; } else if (SAME_OBJ(a, scheme_true)