allowing shadowing of initial imports (3.99.0.20)
svn: r9025
This commit is contained in:
Matthew Flatt
parent
3c4eb57e76
commit
b26702358a
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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: */
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user