fix inferred-name propagation for internal-definition contexts

Set the name while checking for an immediate expansion when
no other forms follow.
This commit is contained in:
Matthew Flatt 2015-09-19 19:25:34 -06:00
parent 7ee29b0239
commit 6dfc20d3ec
2 changed files with 19 additions and 0 deletions

View File

@ -134,4 +134,14 @@
5))
#rx"^(?!.*unmentionable)")
(test 'norm values
(let-syntax ([m (lambda (stx)
#`'#,(syntax-local-name))])
(define norm
(let ()
(define x 8)
(m)))
norm))
(report-errs)

View File

@ -5918,6 +5918,8 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
int more = 1, is_last;
is_last = SCHEME_STX_NULLP(SCHEME_STX_CDR(forms));
if (is_last)
env->value_name = orig_vname;
result = forms;
@ -5925,6 +5927,9 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
define-values, define-syntax, etc.: */
first = scheme_check_immediate_macro(first, env, rec, drec, &gval, is_last);
if (is_last)
env->value_name = NULL;
if (SAME_OBJ(gval, scheme_begin_syntax)) {
/* Inline content */
Scheme_Object *orig_forms = forms;
@ -6141,7 +6146,11 @@ compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env,
first = scheme_datum_to_syntax(first, forms, forms, 0, 0);
SCHEME_EXPAND_OBSERVE_NEXT(env->observer);
is_last = SCHEME_STX_NULLP(SCHEME_STX_CDR(result));
if (is_last)
env->value_name = orig_vname;
first = scheme_check_immediate_macro(first, env, rec, drec, &gval, is_last);
if (is_last)
env->value_name = NULL;
more = 1;
if (NOT_SAME_OBJ(gval, scheme_define_values_syntax)
&& NOT_SAME_OBJ(gval, scheme_define_syntaxes_syntax)) {