From 98cde53fa0923b274d29114a22727277e76d0100 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 2 Nov 2011 10:02:19 -0600 Subject: [PATCH] =?UTF-8?q?fix=20rename=20trans=20`free-identifier=3D=3F'?= =?UTF-8?q?=20propagation=20in=20int-def=20context?= Closes PR 12333 --- collects/tests/racket/macro.rktl | 26 ++++++++++++++++++++++++++ src/racket/src/eval.c | 11 ++++++----- 2 files changed, 32 insertions(+), 5 deletions(-) diff --git a/collects/tests/racket/macro.rktl b/collects/tests/racket/macro.rktl index 96f98a9fc9..ebf8261244 100644 --- a/collects/tests/racket/macro.rktl +++ b/collects/tests/racket/macro.rktl @@ -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) diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index 654a2df52f..975b4b8a1b 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -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])