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:
parent
0edd781928
commit
d17cc6039b
|
@ -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)))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
/* Use the current top-level context: */
|
||||
form = scheme_stx_from_generic_to_module_context(form, env->stx_context);
|
||||
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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue
Block a user