suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

avoid intermediate syntax objects for binding comparison

Browse Source 
The expander no longer needs to generate certain phase-N
identifiers, since we now have a comparison operation that
uses different phases for each of two identifiers.
This commit is contained in:
Matthew Flatt 2012-05-02 13:53:50 -06:00
parent 376b31cf28
commit 4581a7addf
5 changed files with 44 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/racket/include/schthread.h
View File

@ -148,14 +148,6 @@ typedef struct Thread_Local_Variables {
struct Scheme_Prompt *available_regular_prompt_;
struct Scheme_Dynamic_Wind *available_prompt_dw_;
struct Scheme_Meta_Continuation *available_prompt_mc_;
struct Scheme_Object *cached_beg_stx_;
struct Scheme_Object *cached_mod_stx_;
struct Scheme_Object *cached_modstar_stx_;
struct Scheme_Object *cached_mod_beg_stx_;
struct Scheme_Object *cached_dv_stx_;
struct Scheme_Object *cached_ds_stx_;
struct Scheme_Object *cached_bfs_stx_;
int cached_stx_phase_;
struct Scheme_Object *cwv_stx_;
int cwv_stx_phase_;
struct Scheme_Cont *offstack_cont_;
@ -503,14 +495,6 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
#define available_regular_prompt XOA (scheme_get_thread_local_variables()->available_regular_prompt_)
#define available_prompt_dw XOA (scheme_get_thread_local_variables()->available_prompt_dw_)
#define available_prompt_mc XOA (scheme_get_thread_local_variables()->available_prompt_mc_)
#define cached_beg_stx XOA (scheme_get_thread_local_variables()->cached_beg_stx_)
#define cached_mod_stx XOA (scheme_get_thread_local_variables()->cached_mod_stx_)
#define cached_modstar_stx XOA (scheme_get_thread_local_variables()->cached_modstar_stx_)
#define cached_mod_beg_stx XOA (scheme_get_thread_local_variables()->cached_mod_beg_stx_)
#define cached_dv_stx XOA (scheme_get_thread_local_variables()->cached_dv_stx_)
#define cached_ds_stx XOA (scheme_get_thread_local_variables()->cached_ds_stx_)
#define cached_bfs_stx XOA (scheme_get_thread_local_variables()->cached_bfs_stx_)
#define cached_stx_phase XOA (scheme_get_thread_local_variables()->cached_stx_phase_)
#define cwv_stx XOA (scheme_get_thread_local_variables()->cwv_stx_)
#define cwv_stx_phase XOA (scheme_get_thread_local_variables()->cwv_stx_phase_)
#define offstack_cont XOA (scheme_get_thread_local_variables()->offstack_cont_)

74
src/racket/src/fun.c
View File

@ -114,14 +114,6 @@ THREAD_LOCAL_DECL(static Scheme_Prompt *available_cws_prompt);
THREAD_LOCAL_DECL(static Scheme_Prompt *available_regular_prompt);
THREAD_LOCAL_DECL(static Scheme_Dynamic_Wind *available_prompt_dw);
THREAD_LOCAL_DECL(static Scheme_Meta_Continuation *available_prompt_mc);
THREAD_LOCAL_DECL(static Scheme_Object *cached_beg_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_modstar_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_mod_beg_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_dv_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_ds_stx);
THREAD_LOCAL_DECL(static Scheme_Object *cached_bfs_stx);
THREAD_LOCAL_DECL(static int cached_stx_phase);
THREAD_LOCAL_DECL(static Scheme_Cont *offstack_cont);
THREAD_LOCAL_DECL(static Scheme_Overflow *offstack_overflow);
@ -625,13 +617,6 @@ scheme_init_fun (Scheme_Env *env)
void
scheme_init_fun_places()
{
REGISTER_SO(cached_beg_stx);
REGISTER_SO(cached_mod_stx);
REGISTER_SO(cached_modstar_stx);
REGISTER_SO(cached_mod_beg_stx);
REGISTER_SO(cached_dv_stx);
REGISTER_SO(cached_ds_stx);
REGISTER_SO(cached_bfs_stx);
REGISTER_SO(offstack_cont);
REGISTER_SO(offstack_overflow);
}
@ -1634,63 +1619,18 @@ cert_with_specials(Scheme_Object *code,
name = scheme_stx_taint_disarm(code, NULL);
name = SCHEME_STX_CAR(name);
if (SCHEME_STX_SYMBOLP(name)) {
Scheme_Object *beg_stx, *mod_stx, *modstar_stx, *mod_beg_stx, *dv_stx, *ds_stx, *bfs_stx;
if (!phase) {
mod_stx = scheme_module_stx;
modstar_stx = scheme_modulestar_stx;
beg_stx = scheme_begin_stx;
mod_beg_stx = scheme_module_begin_stx;
dv_stx = scheme_define_values_stx;
ds_stx = scheme_define_syntaxes_stx;
bfs_stx = scheme_begin_for_syntax_stx;
} else if (phase == cached_stx_phase) {
beg_stx = cached_beg_stx;
mod_stx = cached_mod_stx;
modstar_stx = cached_modstar_stx;
mod_beg_stx = cached_mod_beg_stx;
dv_stx = cached_dv_stx;
ds_stx = cached_ds_stx;
bfs_stx = cached_bfs_stx;
} else {
Scheme_Object *sr;
sr = scheme_sys_wraps_phase(scheme_make_integer(phase));
beg_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_begin_stx), scheme_false,
sr, 0, 0);
mod_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_module_stx), scheme_false,
sr, 0, 0);
modstar_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_modulestar_stx), scheme_false,
sr, 0, 0);
mod_beg_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_module_begin_stx), scheme_false,
sr, 0, 0);
dv_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_values_stx), scheme_false,
sr, 0, 0);
ds_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_define_syntaxes_stx), scheme_false,
sr, 0, 0);
bfs_stx = scheme_datum_to_syntax(SCHEME_STX_VAL(scheme_begin_for_syntax_stx), scheme_false,
sr, 0, 0);
cached_beg_stx = beg_stx;
cached_mod_stx = mod_stx;
cached_modstar_stx = modstar_stx;
cached_mod_beg_stx = mod_beg_stx;
cached_dv_stx = dv_stx;
cached_ds_stx = ds_stx;
cached_bfs_stx = bfs_stx;
cached_stx_phase = phase;
}
if (scheme_stx_module_eq(beg_stx, name, phase)
|| scheme_stx_module_eq(mod_stx, name, phase)
|| scheme_stx_module_eq(modstar_stx, name, phase)
|| scheme_stx_module_eq(mod_beg_stx, name, phase)) {
if (scheme_stx_module_eq_x(scheme_begin_stx, name, phase)
|| scheme_stx_module_eq_x(scheme_module_stx, name, phase)
|| scheme_stx_module_eq_x(scheme_modulestar_stx, name, phase)
|| scheme_stx_module_eq_x(scheme_module_begin_stx, name, phase)) {
trans = 1;
next_cadr_deflt = 0;
} else if (scheme_stx_module_eq(bfs_stx, name, phase)) {
} else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, name, phase)) {
trans = 1;
next_cadr_deflt = 0;
phase_delta = 1;
} else if (scheme_stx_module_eq(dv_stx, name, phase)
|| scheme_stx_module_eq(ds_stx, name, phase)) {
} else if (scheme_stx_module_eq_x(scheme_define_values_stx, name, phase)
|| scheme_stx_module_eq_x(scheme_define_syntaxes_stx, name, phase)) {
trans = 1;
next_cadr_deflt = 1;
}

110
src/racket/src/module.c
View File

@ -149,7 +149,7 @@ static Scheme_Object *fixup_expanded(Scheme_Object *expanded_l,
int kind);
static void check_formerly_unbound(Scheme_Object *unbounds, Scheme_Comp_Env *env);
static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv);
static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_begin_for_syntax_stx);
static Scheme_Object *scheme_sys_wraps_phase_worker(intptr_t p);
@ -289,8 +289,7 @@ static void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Objec
Scheme_Hash_Table *tables,
Scheme_Hash_Tree *all_defs,
Scheme_Comp_Env *cenv, Scheme_Compile_Info *rec, int drec,
Scheme_Object **_expanded,
Scheme_Object *begin_stx);
Scheme_Object **_expanded);
static int compute_reprovides(Scheme_Hash_Table *all_provided,
Scheme_Hash_Table *all_reprovided,
Scheme_Module *mod_for_requires,
@ -6363,21 +6362,15 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm,
if (SCHEME_STX_PAIRP(v1)) {
v2 = SCHEME_STX_CAR(v1);
if (SCHEME_STX_SYMBOLP(v2)) {
if (scheme_stx_module_eq3(scheme_module_stx, v2,
scheme_make_integer(0), scheme_make_integer(phase),
NULL)
|| scheme_stx_module_eq3(scheme_modulestar_stx, v2,
scheme_make_integer(0), scheme_make_integer(phase),
NULL)) {
if (scheme_stx_module_eq_x(scheme_module_stx, v2, phase)
|| scheme_stx_module_eq_x(scheme_modulestar_stx, v2, phase)) {
/* found a submodule */
v2 = SCHEME_STX_CDR(fm);
naya = phase_shift_skip_submodules(v2, old_midx, new_midx, phase);
if (SAME_OBJ(naya, v2))
naya = phase_shift_tail(naya, old_midx, new_midx);
return rebuild_with_phase_shift(fm, v1, naya, old_midx, new_midx);
} else if (scheme_stx_module_eq3(scheme_begin_for_syntax_stx, v2,
scheme_make_integer(0), scheme_make_integer(phase),
NULL)) {
} else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, v2, phase)) {
/* found `begin-for-syntax': */
naya = phase_shift_skip_submodules(v1, old_midx, new_midx, phase+1);
v2 = SCHEME_STX_CDR(fm);
@ -7797,8 +7790,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
Scheme_Object *lifted_reqs = scheme_null, *req_data, *unbounds = scheme_null;
int maybe_has_lifts = 0, expand_ends = (phase == 0);
Scheme_Object *observer, *vec, *end_statements;
Scheme_Object *sv[8], *define_values_stx, *begin_stx, *define_syntaxes_stx, *begin_for_syntax_stx;
Scheme_Object *req_stx, *prov_stx, *module_stx, *modulestar_stx;
Scheme_Object *begin_for_syntax_stx;
const char *who = "module";
#ifdef DO_STACK_CHECK
@ -7859,17 +7851,8 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
| SCHEME_FOR_STOPS),
env);
install_stops(xenv, phase, sv);
install_stops(xenv, phase, &begin_for_syntax_stx);
define_values_stx = sv[0];
begin_stx = sv[1];
define_syntaxes_stx = sv[2];
begin_for_syntax_stx = sv[3];
req_stx = sv[4];
prov_stx = sv[5];
modulestar_stx = sv[6];
module_stx = sv[7];
first = scheme_null;
last = NULL;
@ -8014,7 +7997,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
else
fst = NULL;
if (fst && SCHEME_STX_SYMBOLP(fst) && scheme_stx_module_eq(begin_stx, fst, phase)) {
if (fst && SCHEME_STX_SYMBOLP(fst) && scheme_stx_module_eq_x(scheme_begin_stx, fst, phase)) {
fm = SCHEME_STX_CDR(fm);
e = scheme_add_rename(e, bxs->post_ex_rn_set);
SCHEME_EXPAND_OBSERVE_RENAME_ONE(observer, e);
@ -8055,7 +8038,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
fst = SCHEME_STX_CAR(e);
if (SCHEME_STX_SYMBOLP(fst)) {
if (scheme_stx_module_eq(define_values_stx, fst, phase)) {
if (scheme_stx_module_eq_x(scheme_define_values_stx, fst, phase)) {
/************ define-values *************/
Scheme_Object *vars, *val;
@ -8110,8 +8093,8 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
kind = DEFN_MODFORM_KIND;
} else if (scheme_stx_module_eq(define_syntaxes_stx, fst, phase)
|| scheme_stx_module_eq(begin_for_syntax_stx, fst, phase)) {
} else if (scheme_stx_module_eq_x(scheme_define_syntaxes_stx, fst, phase)
|| scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, fst, phase)) {
/************ define-syntaxes & begin-for-syntax *************/
/* Define the macro: */
Scheme_Compile_Info mrec, erec1;
@ -8125,7 +8108,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
int use_post_ex = 0;
int max_let_depth;
for_stx = scheme_stx_module_eq(begin_for_syntax_stx, fst, phase);
for_stx = scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, fst, phase);
SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
@ -8317,7 +8300,7 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
kind = DONE_MODFORM_KIND;
} else if (scheme_stx_module_eq(req_stx, fst, phase)) {
} else if (scheme_stx_module_eq_x(require_stx, fst, phase)) {
/************ require *************/
SCHEME_EXPAND_OBSERVE_ENTER_PRIM(observer, e);
SCHEME_EXPAND_OBSERVE_PRIM_REQUIRE(observer);
@ -8337,21 +8320,21 @@ static Scheme_Object *do_module_begin_at_phase(Scheme_Object *form, Scheme_Comp_
SCHEME_EXPAND_OBSERVE_EXIT_PRIM(observer, e);
kind = DONE_MODFORM_KIND;
} else if (scheme_stx_module_eq(prov_stx, fst, phase)) {
} else if (scheme_stx_module_eq_x(provide_stx, fst, phase)) {
/************ provide *************/
/* remember it for pass 3 */
p = scheme_make_pair(scheme_make_pair(e, scheme_make_integer(phase)),
bxs->saved_provides);
bxs->saved_provides = p;
kind = PROVIDE_MODFORM_KIND;
} else if (scheme_stx_module_eq(module_stx, fst, phase)
|| scheme_stx_module_eq(modulestar_stx, fst, phase)) {
} else if (scheme_stx_module_eq_x(scheme_module_stx, fst, phase)
|| scheme_stx_module_eq_x(scheme_modulestar_stx, fst, phase)) {
/************ module[*] *************/
/* check outer syntax & name, then expand pre-module or remember for post-module pass */
Scheme_Object *name = NULL;
int is_star;
is_star = scheme_stx_module_eq(modulestar_stx, fst, phase);
is_star = scheme_stx_module_eq_x(scheme_modulestar_stx, fst, phase);
if (SCHEME_STX_PAIRP(e)) {
p = SCHEME_STX_CDR(e);
@ -8704,7 +8687,7 @@ static Scheme_Object *expand_all_provides(Scheme_Object *form,
Scheme_Object *saved_provides;
Scheme_Object *observer, *expanded_provides = scheme_null;
int provide_phase;
Scheme_Object *e, *ex, *p_begin_stx, *fst;
Scheme_Object *e, *ex, *fst;
Scheme_Comp_Env *pcenv;
observer = rec[drec].observer;
@ -8734,13 +8717,8 @@ static Scheme_Object *expand_all_provides(Scheme_Object *form,
pcenv = scheme_new_comp_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME);
else
pcenv = scheme_new_expand_env(penv, penv->insp, SCHEME_TOPLEVEL_FRAME);
p_begin_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin"),
scheme_false,
scheme_sys_wraps_phase_worker(provide_phase),
0, 0);
} else {
pcenv = cenv;
p_begin_stx = scheme_begin_stx;
}
parse_provides(form, fst, e, provide_phase,
@ -8750,8 +8728,7 @@ static Scheme_Object *expand_all_provides(Scheme_Object *form,
bxs->tables,
bxs->all_defs,
pcenv, rec, drec,
&ex,
p_begin_stx);
&ex);
if (keep_expanded)
expanded_provides = scheme_make_pair(ex, expanded_provides);
@ -8825,31 +8802,21 @@ static Scheme_Object *fixup_expanded(Scheme_Object *expanded_l,
`expanded_provides'. The provides in `expanded_l' and
`expanded_provides' are matched up by order. */
{
Scheme_Object *p, *e, *fst, *prov_stx, *begin_for_syntax_stx, *l;
Scheme_Object *p, *e, *fst, *prov_stx, *l;
if (phase == 0) {
if (kind == PROVIDE_MODFORM_KIND)
prov_stx = provide_stx;
else
prov_stx = scheme_modulestar_stx;
begin_for_syntax_stx = scheme_begin_for_syntax_stx;
} else {
e = scheme_sys_wraps_phase_worker(phase);
begin_for_syntax_stx = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, e, 0, 0);
if (kind == PROVIDE_MODFORM_KIND)
prov_stx = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, e, 0, 0);
else
prov_stx = scheme_datum_to_syntax(scheme_intern_symbol("module*"), scheme_false, e, 0, 0);
}
if (kind == PROVIDE_MODFORM_KIND)
prov_stx = provide_stx;
else
prov_stx = scheme_modulestar_stx;
for (p = expanded_l; !SCHEME_NULLP(p); p = SCHEME_CDR(p)) {
e = SCHEME_CAR(p);
if (SCHEME_STX_PAIRP(e)) {
fst = SCHEME_STX_CAR(e);
if (scheme_stx_module_eq(prov_stx, fst, phase)) {
if (scheme_stx_module_eq_x(prov_stx, fst, phase)) {
SCHEME_CAR(p) = SCHEME_CAR(expanded_provides);
expanded_provides = SCHEME_CDR(expanded_provides);
} else if (scheme_stx_module_eq(begin_for_syntax_stx, fst, phase)) {
} else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, fst, phase)) {
l = scheme_flatten_syntax_list(e, NULL);
l = scheme_copy_list(l);
expanded_provides = fixup_expanded(SCHEME_CDR(l), expanded_provides, phase + 1, kind);
@ -8910,7 +8877,7 @@ static void check_formerly_unbound(Scheme_Object *unbounds,
}
}
static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv)
static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **_begin_for_syntax_stx)
{
Scheme_Object *stop, *w, *s;
@ -8923,6 +8890,7 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv)
scheme_set_local_syntax(1, scheme_define_values_stx, stop, xenv);
scheme_set_local_syntax(2, scheme_define_syntaxes_stx, stop, xenv);
scheme_set_local_syntax(3, scheme_begin_for_syntax_stx, stop, xenv);
*_begin_for_syntax_stx = scheme_begin_for_syntax_stx;
scheme_set_local_syntax(4, require_stx, stop, xenv);
scheme_set_local_syntax(5, provide_stx, stop, xenv);
scheme_set_local_syntax(6, set_stx, stop, xenv);
@ -8940,33 +8908,20 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv)
scheme_set_local_syntax(18, expression_stx, stop, xenv);
scheme_set_local_syntax(19, scheme_modulestar_stx, stop, xenv);
scheme_set_local_syntax(20, scheme_module_stx, stop, xenv);
sv[0] = scheme_define_values_stx;
sv[1] = scheme_begin_stx;
sv[2] = scheme_define_syntaxes_stx;
sv[3] = scheme_begin_for_syntax_stx;
sv[4] = require_stx;
sv[5] = provide_stx;
sv[6] = scheme_modulestar_stx;
sv[7] = scheme_module_stx;
} else {
w = scheme_sys_wraps_phase_worker(phase);
s = scheme_datum_to_syntax(scheme_intern_symbol("begin"), scheme_false, w, 0, 0);
sv[1] = s;
scheme_set_local_syntax(0, s, stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("define-values"), scheme_false, w, 0, 0);
sv[0] = s;
scheme_set_local_syntax(1, s, stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("define-syntaxes"), scheme_false, w, 0, 0);
sv[2] = s;
scheme_set_local_syntax(2, s, stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("begin-for-syntax"), scheme_false, w, 0, 0);
sv[3] = s;
scheme_set_local_syntax(3, s, stop, xenv);
*_begin_for_syntax_stx = s;
s = scheme_datum_to_syntax(scheme_intern_symbol("#%require"), scheme_false, w, 0, 0);
sv[4] = s;
scheme_set_local_syntax(4, s, stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("#%provide"), scheme_false, w, 0, 0);
sv[5] = s;
scheme_set_local_syntax(5, s, stop, xenv);
scheme_set_local_syntax(6, scheme_datum_to_syntax(scheme_intern_symbol("set!"), scheme_false, w, 0, 0), stop, xenv);
scheme_set_local_syntax(7, scheme_datum_to_syntax(scheme_intern_symbol("#%app"), scheme_false, w, 0, 0), stop, xenv);
@ -8982,10 +8937,8 @@ static void install_stops(Scheme_Comp_Env *xenv, int phase, Scheme_Object **sv)
scheme_set_local_syntax(17, scheme_datum_to_syntax(scheme_intern_symbol("#%variable-reference"), scheme_false, w, 0, 0), stop, xenv);
scheme_set_local_syntax(18, scheme_datum_to_syntax(scheme_intern_symbol("#%expression"), scheme_false, w, 0, 0), stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("module*"), scheme_false, w, 0, 0);
sv[6] = s;
scheme_set_local_syntax(19, s, stop, xenv);
s = scheme_datum_to_syntax(scheme_intern_symbol("module"), scheme_false, w, 0, 0);
sv[7] = s;
scheme_set_local_syntax(20, s, stop, xenv);
}
}
@ -10044,8 +9997,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
Scheme_Hash_Table *tables,
Scheme_Hash_Tree *all_defs,
Scheme_Comp_Env *cenv, Scheme_Compile_Info *rec, int drec,
Scheme_Object **_expanded,
Scheme_Object *begin_stx)
Scheme_Object **_expanded)
{
Scheme_Object *l, *rebuilt = scheme_null, *protect_stx = NULL;
int protect_cnt = 0, mode_cnt = 0, expanded = 0;
@ -10182,7 +10134,7 @@ void parse_provides(Scheme_Object *form, Scheme_Object *fst, Scheme_Object *e,
else {
rest = SCHEME_CAR(p);
if (!SCHEME_STX_SYMBOLP(rest)
|| !scheme_stx_module_eq(begin_stx, rest, at_phase)) {
|| !scheme_stx_module_eq_x(scheme_begin_stx, rest, at_phase)) {
p = NULL;
}
}

1
src/racket/src/schpriv.h
View File

@ -1043,6 +1043,7 @@ Scheme_Object *scheme_stx_content(Scheme_Object *o);
Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist);
int scheme_stx_module_eq(Scheme_Object *a, Scheme_Object *b, intptr_t phase);
int scheme_stx_module_eq_x(Scheme_Object *a, Scheme_Object *b, intptr_t b_phase);
int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase, Scheme_Object *asym);
int scheme_stx_module_eq3(Scheme_Object *a, Scheme_Object *b,
Scheme_Object *a_phase, Scheme_Object *b_phase,

5
src/racket/src/syntax.c
View File

@ -4626,6 +4626,11 @@ int scheme_stx_module_eq(Scheme_Object *a, Scheme_Object *b, intptr_t phase)
return scheme_stx_module_eq3(a, b, scheme_make_integer(phase), scheme_make_integer(phase), NULL);
}
int scheme_stx_module_eq_x(Scheme_Object *a, Scheme_Object *b, intptr_t b_phase)
{
return scheme_stx_module_eq3(a, b, scheme_make_integer(0), scheme_make_integer(b_phase), NULL);
}
Scheme_Object *scheme_stx_get_module_eq_sym(Scheme_Object *a, Scheme_Object *phase)
{
if (SCHEME_STXP(a))