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:
parent
033cd43b8f
commit
512910c83f
|
@ -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)
|
||||
|
|
|
@ -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)) {
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user