expander: fix 'module-begin expansion with definition contexts

Using `(local-expand <expr> 'module-begin <stops> def-ctx)` didn't
work right, because definitions added to `def-ctx` were not visible.
(While adding definitions before `module-begin` expansion is an unusual
thing to do, there's no reason that it has to fail.)
This commit is contained in:
Matthew Flatt 2017-10-28 10:07:23 -06:00
parent 033cd43b8f
commit 512910c83f
6 changed files with 28 additions and 0 deletions

View File

@ -1716,6 +1716,24 @@
#'([(b (b ...)) ...] ...)))
(lambda (exn) (regexp-match? #rx"incompatible ellipsis" (exn-message exn))))
;; ----------------------------------------
;; Check that expansion to `#%module-begin` is prepared to handle
;; definition contexts
(module make-definition-context-during-module-begin racket/base
(require (for-syntax racket/base))
(define-syntax (bind-and-expand stx)
(syntax-case stx ()
[(_ x form ...)
(let ()
(define ctx (syntax-local-make-definition-context))
(syntax-local-bind-syntaxes (list #'x) #'(λ (stx) (println stx) #'(void)) ctx)
(local-expand #'(#%plain-module-begin form ...) 'module-begin '() ctx))]))
(module* a #f (bind-and-expand x x))
(module* b #f (bind-and-expand x (list x))))
;; ----------------------------------------
(report-errs)

View File

@ -1364,6 +1364,11 @@ scheme_compile_lookup(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
if (!frame->vals)
p += frame->num_bindings;
if (!frame->next->next && frame->next->intdef_next) {
frame = frame->next->intdef_next;
continue;
}
}
if (!(flags & SCHEME_OUT_OF_CONTEXT_OK)) {

View File

@ -9787,6 +9787,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
cenv = scheme_new_comp_env(env->genv, env->insp, frame_scopes,
SCHEME_TOPLEVEL_FRAME | SCHEME_KEEP_SCOPES_FRAME);
cenv->observer = env->observer;
cenv->intdef_next = xenv;
}
lift_data = scheme_make_vector(3, NULL);

View File

@ -17,6 +17,7 @@ static int mark_comp_env_MARK(void *p, struct NewGC *gc) {
gcMARK2(e->prefix, gc);
gcMARK2(e->next, gc);
gcMARK2(e->use_scopes_next, gc);
gcMARK2(e->intdef_next, gc);
gcMARK2(e->scopes, gc);
gcMARK2(e->value_name, gc);
gcMARK2(e->observer, gc);
@ -56,6 +57,7 @@ static int mark_comp_env_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(e->prefix, gc);
gcFIXUP2(e->next, gc);
gcFIXUP2(e->use_scopes_next, gc);
gcFIXUP2(e->intdef_next, gc);
gcFIXUP2(e->scopes, gc);
gcFIXUP2(e->value_name, gc);
gcFIXUP2(e->observer, gc);

View File

@ -1294,6 +1294,7 @@ mark_comp_env {
gcMARK2(e->prefix, gc);
gcMARK2(e->next, gc);
gcMARK2(e->use_scopes_next, gc);
gcMARK2(e->intdef_next, gc);
gcMARK2(e->scopes, gc);
gcMARK2(e->value_name, gc);
gcMARK2(e->observer, gc);

View File

@ -2878,6 +2878,7 @@ typedef struct Scheme_Comp_Env
struct Scheme_Comp_Env *next;
struct Scheme_Comp_Env *use_scopes_next; /* fast-forward for use-site scope revert */
struct Scheme_Comp_Env *intdef_next; /* when `next` = NULL, can be non-null to continue binding search */
} Scheme_Comp_Env;
#define LAMBDA_HAS_REST 1