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

fix submodule re-`expand' problem

Browse Source 
Closes PR 12691

Merge to 5.3
This commit is contained in:
Matthew Flatt 2012-04-10 13:45:21 -06:00
parent c64c55b86f
commit 1914345af4
7 changed files with 42 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/tests/racket/submodule.rktl
View File

@ -298,6 +298,25 @@
(struct node (height))
(node-height 0))))
(expand
(expand
#'(module m racket/base
(define-syntax-rule (go x)
(begin
(define other 1)
(define-syntax-rule (x) other)))
(go f)
(module* test #f
(f)))))
(expand
(expand
#'(module m racket/base
(define (f #:opt [opt 3])
opt)
(module* test #f
(f)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; `begin-for-syntax' doesn't affect `module' with non-#f language:

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

@ -1152,15 +1152,18 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
/* Last chance before making up a new name. If we're processing a
module body generated by `expand', then we picked a name last
time around. We can't pick a new name now, otherwise
"redundant" module renamings wouldn't be redundant. (See
simpify in "syntax.c".) So check for a context-determined
existing rename. */
if (!SCHEME_HASHTP((Scheme_Object *)env) && env->module && (mode < 2)) {
"redundant" module renamings wouldn't be redundant (see
simpify in "syntax.c") and submodules won't re-expand correctly.
So, check for a context-determined existing rename. */
if (!SCHEME_HASHTP((Scheme_Object *)env) && env->module && (mode <= 2)) {
Scheme_Object *mod, *nm = id;
int skipped;
mod = scheme_stx_module_name(NULL, &nm, scheme_make_integer(env->phase), NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL);
NULL, NULL, NULL, NULL, NULL, &skipped);
if (mod /* must refer to env->module, otherwise there would
have been an error before getting here */
&& !SAME_OBJ(mod, scheme_undefined)
&& ((skipped == 0) || (mode < 2))
&& NOT_SAME_OBJ(nm, sym))
/* It has a rename already! */
best_match = nm;
@ -1210,7 +1213,6 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
break;
}
}
/* Otherwise, increment counter and try again... */
}
}
@ -1824,7 +1826,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
src_find_id = find_id;
modidx = scheme_stx_module_name(NULL, &find_id, scheme_make_integer(phase), NULL, NULL, &mod_defn_phase,
NULL, NULL, NULL, NULL, &rename_insp);
NULL, NULL, NULL, NULL, &rename_insp, NULL);
/* If modidx and modidx is not #<undefined>, then find_id is now a
symbol, otherwise it's still an identifier. */

2
src/racket/src/compile.c
View File

@ -5186,7 +5186,7 @@ int scheme_check_top_identifier_bound(Scheme_Object *c, Scheme_Env *genv, int di
bad = 0;
} else {
modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(genv->phase), NULL, NULL, NULL,
NULL, NULL, NULL, NULL, NULL);
NULL, NULL, NULL, NULL, NULL, NULL);
if (modidx) {
/* If it's an access path, resolve it: */
if (genv->module

2
src/racket/src/error.c
View File

@ -1709,7 +1709,7 @@ static void do_wrong_syntax(const char *where,
phase = scheme_current_thread->current_local_env->genv->phase;
else phase = 0;
scheme_stx_module_name(0, &first, scheme_make_integer(phase), &mod, &nomwho,
NULL, NULL, NULL, NULL, NULL, NULL);
NULL, NULL, NULL, NULL, NULL, NULL, NULL);
}
}
} else {

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

@ -9500,7 +9500,7 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name,
mod = scheme_stx_module_name(NULL, &id, phase,
_implicit_nominal_mod, _implicit_nominal_name,
&mod_phase,
NULL, NULL, NULL, NULL, &rename_insp);
NULL, NULL, NULL, NULL, &rename_insp, NULL);
if (_implicit_mod_phase) *_implicit_mod_phase = mod_phase;
if (mod && SAME_TYPE(SCHEME_TYPE(mod), scheme_module_index_type)) {

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

@ -1057,7 +1057,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *recur,
Scheme_Object **nominal_src_phase,
Scheme_Object **lex_env,
int *_sealed,
Scheme_Object **rename_insp);
Scheme_Object **rename_insp,
int *_binding_marks_skipped);
Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a);
int scheme_stx_parallel_is_used(Scheme_Object *sym, Scheme_Object *stx);

13
src/racket/src/syntax.c
View File

@ -2012,7 +2012,8 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn,
&nominal_src_phase,
&lex_env,
_sealed,
&rename_insp);
&rename_insp,
NULL);
if (SCHEME_SYMBOLP(nom2))
nominal_name = nom2;
@ -4642,7 +4643,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur,
Scheme_Object **nominal_src_phase, /* phase level of export from nominal modidx */
Scheme_Object **lex_env,
int *_sealed,
Scheme_Object **insp)
Scheme_Object **insp,
int *_binding_marks_skipped)
/* If module bound, result is module idx, and a is set to source name.
If lexically bound, result is scheme_undefined, a is unchanged,
and nominal_name is NULL or a free_id=? renamed id.
@ -4660,7 +4662,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur,
names[5] = NULL;
names[6] = NULL;
modname = resolve_env(*a, phase, 1, names, NULL, NULL, _sealed ? &rib_dep : NULL, 0, free_id_recur);
modname = resolve_env(*a, phase, 1, names, NULL, _binding_marks_skipped,
_sealed ? &rib_dep : NULL, 0, free_id_recur);
if (_sealed) *_sealed = !rib_dep;
@ -4694,6 +4697,7 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur,
} else {
if (nominal_name) *nominal_name = NULL;
if (_sealed) *_sealed = 1;
if (_binding_marks_skipped) *_binding_marks_skipped = -1;
return NULL;
}
}
@ -5150,7 +5154,7 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id)
bind = scheme_stx_module_name(free_id_recur,
&id, phase, &nominal_modidx, &nominal_name,
&mod_phase, &src_phase_index, &nominal_src_phase,
&lex_env, NULL, &insp);
&lex_env, NULL, &insp, NULL);
release_recur_table(free_id_recur);
if (SCHEME_SYMBOLP(nom2))
@ -8301,6 +8305,7 @@ static Scheme_Object *do_module_binding(char *name, int argc, Scheme_Object **ar
&nominal_src_phase,
NULL,
NULL,
NULL,
NULL);
if (!m)