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

fix rename trans `free-identifier=?' propagation in int-def context

Browse Source 
Closes PR 12333
This commit is contained in:
Matthew Flatt 2011-11-02 10:02:19 -06:00
parent c7a0f1bef8
commit 98cde53fa0
2 changed files with 32 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/tests/racket/macro.rktl
View File

@ -602,6 +602,32 @@
#'#f)
(two))
;; ----------------------------------------
;; Check `free-identifier=?' propagation,
;; definition contexts, and `syntax-local-bind-syntaxes'
(let ()
(define-syntax (compare stx)
(define id0 (cadr (syntax->list stx)))
(unless (free-identifier=? id0 #'compare)
(error "`free-identifier=? test failed on int-def binding"))
#'10)
(define-syntax (invoke stx)
(define id1 (cadr (syntax->list stx)))
(define id2 ((make-syntax-introducer) (datum->syntax #false 'dummy)))
(define d-ctx (syntax-local-make-definition-context #false))
(define e-ctx (list (gensym)))
(syntax-local-bind-syntaxes
(list id2)
#`(make-rename-transformer #'#,id1)
d-ctx)
(internal-definition-context-seal d-ctx)
(local-expand #`(#,id2 #,id2) e-ctx (list #'quote) d-ctx))
(test 10 'ten (invoke compare)))
;; ----------------------------------------
(report-errs)

11
src/racket/src/eval.c
View File

@ -5159,7 +5159,7 @@ static Scheme_Object *
local_eval(int argc, Scheme_Object **argv)
{
Scheme_Comp_Env *env, *stx_env, *old_stx_env;
Scheme_Object *l, *a, *rib, *expr, *names, *observer;
Scheme_Object *l, *a, *rib, *expr, *names, *rn_names, *observer;
int cnt = 0, pos;
observer = scheme_get_expand_observe();
@ -5215,6 +5215,9 @@ local_eval(int argc, Scheme_Object **argv)
scheme_set_local_syntax(cnt++, SCHEME_CAR(l), scheme_false, stx_env);
}
/* Extend shared rib with renamings */
scheme_add_env_renames(rib, stx_env, old_stx_env);
stx_env->in_modidx = scheme_current_thread->current_local_modidx;
if (!SCHEME_FALSEP(expr)) {
Scheme_Compile_Expand_Info rec;
@ -5233,15 +5236,13 @@ local_eval(int argc, Scheme_Object **argv)
scheme_prepare_compile_env(stx_env->genv->exp_env);
pos = 0;
expr = scheme_add_rename_rib(expr, rib);
scheme_bind_syntaxes("local syntax definition", names, expr,
rn_names = scheme_named_map_1(NULL, scheme_add_rename_rib, names, rib);
scheme_bind_syntaxes("local syntax definition", rn_names, expr,
stx_env->genv->exp_env, stx_env->insp, &rec, 0,
stx_env, stx_env,
&pos, rib);
}
/* Extend shared rib with renamings */
scheme_add_env_renames(rib, stx_env, old_stx_env);
/* Remember extended environment */
((void **)SCHEME_PTR1_VAL(argv[2]))[0] = stx_env;
if (!((void **)SCHEME_PTR1_VAL(argv[2]))[2])