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

improve module-path-index sharing for a module declaration

Browse Source 
To support module caching, module path indexes must be cloned
for each use of the cached module, so that path resolutions
don't collide. Cloning was previously implemented at the point
of shifting the modidx based on the module instantiation name,
but now its cloned at declaration time. This result in better
sharing of module-path resolutions, which in turn speeds up
compile-time instantiation of modules, which in turn speeds up
interactions & examples in documentation (as much as 10% for the
Guide, for example).

Furthermore, the reverse cache within a modidx may have been
used improperly during cloning, and that's not a problem in
the new implementation.
This commit is contained in:
Matthew Flatt 2012-06-28 11:42:20 -06:00
parent d181b32192
commit aa0d21b7dd
2 changed files with 109 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/racket/src/env.c
View File

@ -1053,6 +1053,9 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
menv2->require_names = menv->require_names;
menv2->et_require_names = menv->et_require_names;
menv2->tt_require_names = menv->tt_require_names;
menv2->dt_require_names = menv->dt_require_names;
menv2->other_require_names = menv->other_require_names;
if (menv->phase <= clone_phase) {
menv2->toplevel = menv->toplevel;

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

@ -3768,10 +3768,32 @@ Scheme_Object *module_resolve_in_namespace(Scheme_Object *modidx, Scheme_Env *en
return _module_resolve(modidx, NULL, env, load_it);
}
static Scheme_Object *do_modidx_shift(Scheme_Object *modidx,
static Scheme_Object *clone_modidx(Scheme_Object *modidx, Scheme_Object *src_modidx)
{
Scheme_Object *base;
if (SAME_OBJ(modidx, src_modidx))
return modidx;
if (!SAME_TYPE(SCHEME_TYPE(modidx), scheme_module_index_type))
return modidx;
/* Need to shift relative part? */
base = ((Scheme_Modidx *)modidx)->base;
if (!SCHEME_FALSEP(base)) {
/* FIXME: depth */
base = clone_modidx(base, src_modidx);
}
return scheme_make_modidx(((Scheme_Modidx *)modidx)->path,
base,
scheme_false);
}
Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
Scheme_Object *shift_from_modidx,
Scheme_Object *shift_to_modidx,
int must_clone)
Scheme_Object *shift_to_modidx)
{
Scheme_Object *base;
@ -3789,7 +3811,7 @@ static Scheme_Object *do_modidx_shift(Scheme_Object *modidx,
if (!SCHEME_FALSEP(base)) {
/* FIXME: depth */
Scheme_Object *sbase;
sbase = do_modidx_shift(base, shift_from_modidx, shift_to_modidx, must_clone);
sbase = scheme_modidx_shift(base, shift_from_modidx, shift_to_modidx);
if (!SAME_OBJ(base, sbase)) {
/* There was a shift in the relative part. */
@ -3872,25 +3894,11 @@ static Scheme_Object *do_modidx_shift(Scheme_Object *modidx,
return smodidx;
}
} else if (must_clone) {
/* cloning here ensures that module resolution doesn't mutate
module-declaration code that might be cached */
modidx = scheme_make_modidx(((Scheme_Modidx *)modidx)->path,
scheme_false,
scheme_false);
}
return modidx;
}
Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
Scheme_Object *shift_from_modidx,
Scheme_Object *shift_to_modidx)
{
return do_modidx_shift(modidx, shift_from_modidx, shift_to_modidx, 0);
}
void scheme_clear_modidx_cache(void)
{
Scheme_Modidx *sbm, *next;
@ -4529,6 +4537,76 @@ static void show_done(const char *what, Scheme_Env *menv, int v1, int v2, int i,
# define show_done(w, m, v1, v2, i, bp) /* nothing */
#endif
static void clone_require_names(Scheme_Module *m, Scheme_Object *phase)
{
Scheme_Object *np, *np_first, *np_last, *l, *reqs;
if (SAME_OBJ(phase, scheme_make_integer(0))) {
reqs = m->requires;
} else if (SAME_OBJ(phase, scheme_make_integer(1))) {
reqs = m->et_requires;
} else if (SAME_OBJ(phase, scheme_make_integer(-1))) {
reqs = m->tt_requires;
} else if (SAME_OBJ(phase, scheme_false)) {
reqs = m->dt_requires;
} else {
if (m->other_requires) {
reqs = scheme_hash_get(m->other_requires, phase);
if (!reqs)
reqs = scheme_null;
} else
reqs = scheme_null;
}
if (SCHEME_NULLP(reqs)) return;
np_first = scheme_null;
np_last = NULL;
for (l = reqs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
np = cons(clone_modidx(SCHEME_CAR(l), m->me->src_modidx), scheme_null);
if (np_last)
SCHEME_CDR(np_last) = np;
else
np_first = np;
np_last = np;
}
np = np_first;
if (SAME_OBJ(phase, scheme_make_integer(0))) {
m->requires = np;
} else if (SAME_OBJ(phase, scheme_make_integer(1))) {
m->et_requires = np;
} else if (SAME_OBJ(phase, scheme_make_integer(-1))) {
m->tt_requires = np;
} else if (SAME_OBJ(phase, scheme_false)) {
m->dt_requires = np;
} else {
scheme_hash_set(m->other_requires, phase, np);
}
}
static void clone_all_require_names(Scheme_Module *m)
{
clone_require_names(m, scheme_make_integer(0));
clone_require_names(m, scheme_make_integer(1));
clone_require_names(m, scheme_make_integer(-1));
clone_require_names(m, scheme_false);
if (m->other_requires) {
Scheme_Hash_Table *ht;
intptr_t i;
ht = scheme_clone_hash_table(m->other_requires);
m->other_requires = ht;
for (i = 0; i < ht->size; i++) {
if (ht->vals[i]) {
clone_require_names(m, ht->keys[i]);
}
}
}
}
static void compute_require_names(Scheme_Env *menv, Scheme_Object *phase,
Scheme_Env *load_env, Scheme_Object *syntax_idx)
{
@ -4571,10 +4649,9 @@ static void compute_require_names(Scheme_Env *menv, Scheme_Object *phase,
np_last = NULL;
for (l = reqs; !SCHEME_NULLP(l); l = SCHEME_CDR(l)) {
midx = do_modidx_shift(SCHEME_CAR(l),
midx = scheme_modidx_shift(SCHEME_CAR(l),
menv->module->me->src_modidx,
(syntax_idx ? syntax_idx : menv->link_midx),
1);
(syntax_idx ? syntax_idx : menv->link_midx));
if (load_env)
module_load(scheme_module_resolve(midx, 1), load_env, NULL);
@ -5944,6 +6021,12 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv,
0);
}
if (m->code_key) {
/* clone `requires', etc., so that different uses of the cached
module don't share resolution of modiule paths in modidxs */
clone_all_require_names(m);
}
config = scheme_current_config();
if (!prefix)