repair syntax-local-lift-require to top level

In `syntax-local-lift-require`, avoid scope adjustments intended
to deal with `require` forms that are compiled in one namespace
and evaluated in another.
This commit is contained in:
Matthew Flatt 2015-10-28 21:10:40 -04:00
parent 0edd781928
commit d17cc6039b
2 changed files with 31 additions and 5 deletions

View File

@ -1600,6 +1600,29 @@ case of module-leve bindings; it doesn't cover local bindings.
(require (rename-in 'shadows-a-racket-base-binding-and-exports-all
[path? other-path?]))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check `syntax-local-lift-require` on an
;; spec that doesn't have the target environment's
;; context:
(module has-a-submodule-that-exports-x racket
(module b racket/base
(define x 1)
(provide x))
(define-syntax (lifted-require-of-x stx)
(syntax-case stx ()
[(_ mod)
(let ([x (car (generate-temporaries '(x)))])
(syntax-local-lift-require
#`(rename mod #,x x)
x))]))
(provide lifted-require-of-x))
(require 'has-a-submodule-that-exports-x)
(test 1 values (lifted-require-of-x (submod 'has-a-submodule-that-exports-x b)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View File

@ -12581,12 +12581,14 @@ static Scheme_Object *check_require_form(Scheme_Env *env, Scheme_Object *form)
}
static Scheme_Object *
do_require_execute(Scheme_Env *env, Scheme_Object *form)
do_require_execute(Scheme_Env *env, Scheme_Object *form, int to_context)
{
Scheme_Object *modidx;
if (to_context) {
/* Use the current top-level context: */
form = scheme_stx_from_generic_to_module_context(form, env->stx_context);
}
/* Check for collisions again, in case there's a difference between
compile and run times: */
@ -12608,7 +12610,8 @@ Scheme_Object *
scheme_top_level_require_execute(Scheme_Object *data)
{
do_require_execute(scheme_environment_from_dummy(SCHEME_PTR1_VAL(data)),
SCHEME_PTR2_VAL(data));
SCHEME_PTR2_VAL(data),
1);
return scheme_void;
}
@ -12674,7 +12677,7 @@ Scheme_Object *scheme_toplevel_require_for_expand(Scheme_Object *module_path,
form = scheme_revert_use_site_scopes(form, cenv);
do_require_execute(cenv->genv, form);
do_require_execute(cenv->genv, form, 0);
return form;
}