From 1914345af4510eb72e91efbe46732ab43e1b5820 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 10 Apr 2012 13:45:21 -0600 Subject: [PATCH] fix submodule re-`expand' problem Closes PR 12691 Merge to 5.3 --- collects/tests/racket/submodule.rktl | 19 +++++++++++++++++++ src/racket/src/compenv.c | 16 +++++++++------- src/racket/src/compile.c | 2 +- src/racket/src/error.c | 2 +- src/racket/src/module.c | 2 +- src/racket/src/schpriv.h | 3 ++- src/racket/src/syntax.c | 13 +++++++++---- 7 files changed, 42 insertions(+), 15 deletions(-) diff --git a/collects/tests/racket/submodule.rktl b/collects/tests/racket/submodule.rktl index afda6faf85..b0b31f6bbd 100644 --- a/collects/tests/racket/submodule.rktl +++ b/collects/tests/racket/submodule.rktl @@ -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: diff --git a/src/racket/src/compenv.c b/src/racket/src/compenv.c index cbf3eb9d20..03a94ce4e0 100644 --- a/src/racket/src/compenv.c +++ b/src/racket/src/compenv.c @@ -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 #, then find_id is now a symbol, otherwise it's still an identifier. */ diff --git a/src/racket/src/compile.c b/src/racket/src/compile.c index 87acb124ee..6158eeee3e 100644 --- a/src/racket/src/compile.c +++ b/src/racket/src/compile.c @@ -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 diff --git a/src/racket/src/error.c b/src/racket/src/error.c index 961622c0f1..2c1298d03e 100644 --- a/src/racket/src/error.c +++ b/src/racket/src/error.c @@ -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 { diff --git a/src/racket/src/module.c b/src/racket/src/module.c index ae59047cdc..76730dbd78 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -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)) { diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 0bdcbc4408..969b26f9f2 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -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); diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 6933d8c60a..d2d9f92508 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -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)