From 176777b05f94cacd200b2bbab14a8c1db0568f4d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 22 Jul 2015 07:00:12 -0600 Subject: [PATCH] adjust transfer of compiled in one namespace and run in another Formerly, compiling a definition in one namespace and evaluating it in another would cause the definition to take place in the original namespace --- unless the compiled code is marshaled to a byte string and back. Adjust the "linking" process to redirect the variable definition and any references to the new namespace. (This is a change relative to the compiler with the old macro expander.) Also, repair a compiled `require` form along similar lines. (This is *not* a change relative to the compiler with the old macro expander; the mismatch is part of the motivation for changing `define` handling.) --- .../tests/racket/namespac.rktl | 47 +++++++++++++++++++ racket/src/racket/src/env.c | 8 +++- racket/src/racket/src/eval.c | 4 +- racket/src/racket/src/module.c | 11 +++-- racket/src/racket/src/schpriv.h | 1 + racket/src/racket/src/syntax.c | 5 ++ 6 files changed, 68 insertions(+), 8 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/namespac.rktl b/pkgs/racket-test-core/tests/racket/namespac.rktl index 809fdaf3d9..ce61775ebe 100644 --- a/pkgs/racket-test-core/tests/racket/namespac.rktl +++ b/pkgs/racket-test-core/tests/racket/namespac.rktl @@ -321,6 +321,53 @@ (test cons eval 'cons ns) (test 2 eval 'extra ns)) +;; ---------------------------------------- +;; Check that compilation in one namespace can +;; be transferred to another namespace + +(let () + ;; transfer a `require` + (define c + (parameterize ([current-namespace (make-base-namespace)]) + (compile '(require racket/base)))) + (parameterize ([current-namespace (make-base-empty-namespace)]) + (test (void) 'eval (eval c)) + (test add1 eval 'add1))) + +(let () + ;; transfer a definition, reference is visible, original + ;; namespace is unchanged + (define-values (c get) + (parameterize ([current-namespace (make-base-namespace)]) + (define c (compile '(define one 1))) + (values + c + (eval '(lambda () one))))) + (parameterize ([current-namespace (make-base-empty-namespace)]) + (test (void) 'eval (eval c)) + (test 1 eval 'one) + (err/rt-test (get) exn:fail:contract:variable?))) + +(let () + ;; transfer a definition of a macro-introduced variable, and + ;; check access via a syntax object that is compiled at the same time: + (define-values (c get) + (parameterize ([current-namespace (make-base-namespace)]) + (eval '(define-syntax-rule (m id) + (begin + (define one 1) + (define id (quote-syntax one)) + one))) + (define c (compile '(m id))) + (values + c + (eval '(lambda () one))))) + (parameterize ([current-namespace (make-base-empty-namespace)]) + (test 1 'eval (eval c)) + (err/rt-test (eval 'one) exn:fail:syntax?) + (test 1 eval (eval 'id)) + (err/rt-test (get) exn:fail:contract:variable?))) + ;; ---------------------------------------- (report-errs) diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index 223f4c92d5..ca46f6f9fb 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -1575,8 +1575,12 @@ void scheme_shadow(Scheme_Env *env, Scheme_Object *n, Scheme_Object *val, int as } else id = NULL; - if (!id) - return; + if (!id) { + if (env->module) + return; + id = scheme_datum_to_syntax(n, scheme_false, scheme_false, 0, 0); + id = scheme_stx_add_module_context(id, env->stx_context); + } if (env->binding_names_need_shift) { id = scheme_stx_shift(id, scheme_make_integer(env->phase - env->mod_phase), diff --git a/racket/src/racket/src/eval.c b/racket/src/racket/src/eval.c index bd4c12adaf..fac245e05d 100644 --- a/racket/src/racket/src/eval.c +++ b/racket/src/racket/src/eval.c @@ -1004,8 +1004,10 @@ static Scheme_Object *link_toplevel(Scheme_Object **exprs, int which, Scheme_Env home = scheme_get_bucket_home(b); - if (!env || !home || !home->module) + if (!env || !home) return (Scheme_Object *)b; + else if (!home->module) + return (Scheme_Object *)scheme_global_bucket((Scheme_Object *)b->key, env); else return link_module_variable(home->module->modname, (Scheme_Object *)b->key, diff --git a/racket/src/racket/src/module.c b/racket/src/racket/src/module.c index 7662f9adda..6df3c0f974 100644 --- a/racket/src/racket/src/module.c +++ b/racket/src/racket/src/module.c @@ -12472,13 +12472,13 @@ do_require_execute(Scheme_Env *env, Scheme_Object *form) { Scheme_Object *modidx; + /* Use the current top-level context: */ + form = scheme_stx_add_module_context(form, env->stx_context); + /* Check for collisions again, in case there's a difference between compile and run times: */ modidx = check_require_form(env, form); - /* Use the current top-level context: */ - form = scheme_stx_push_module_context(form, env->stx_context); - parse_requires(form, env->phase, modidx, env, NULL, env->stx_context, NULL, NULL, @@ -12518,8 +12518,9 @@ static Scheme_Object *do_require(Scheme_Object *form, Scheme_Comp_Env *env, (void)check_require_form(env->genv, form); if (rec && rec[drec].comp) { - form = scheme_revert_use_site_scopes(form, env); - + /* Remove all context specific to the compile-time environment: */ + form = scheme_stx_remove_module_context(form, env->genv->stx_context); + /* Dummy lets us access a top-level environment: */ dummy = scheme_make_environment_dummy(env); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 022317015b..3099f85466 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -1195,6 +1195,7 @@ Scheme_Object *scheme_make_module_context(Scheme_Object *insp, Scheme_Object *scheme_module_context_at_phase(Scheme_Object *mc, Scheme_Object *phase); Scheme_Object *scheme_stx_add_module_context(Scheme_Object *stx, Scheme_Object *mc); +Scheme_Object *scheme_stx_remove_module_context(Scheme_Object *stx, Scheme_Object *mc); Scheme_Object *scheme_stx_add_module_frame_context(Scheme_Object *stx, Scheme_Object *mc); Scheme_Object *scheme_stx_adjust_module_use_site_context(Scheme_Object *stx, Scheme_Object *mc, int mode); Scheme_Object *scheme_stx_introduce_to_module_context(Scheme_Object *stx, Scheme_Object *mc); diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 7c07df1536..39b7b640e4 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -4320,6 +4320,11 @@ Scheme_Object *scheme_stx_add_module_context(Scheme_Object *stx, Scheme_Object * return adjust_module_context_except(stx, mc, NULL, SCHEME_STX_ADD); } +Scheme_Object *scheme_stx_remove_module_context(Scheme_Object *stx, Scheme_Object *mc) +{ + return adjust_module_context_except(stx, mc, NULL, SCHEME_STX_REMOVE); +} + Scheme_Object *scheme_stx_push_module_context(Scheme_Object *stx, Scheme_Object *mc) { Scheme_Object *intro_multi_scope = SCHEME_VEC_ELS(mc)[4];