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

more laziness in instantiation of higher phases

Browse Source
This commit is contained in:
Matthew Flatt 2010-06-30 07:27:45 -06:00
parent 788a144118
commit 459dff9f37
7 changed files with 124 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -874,6 +874,7 @@ Scheme_Env *make_empty_inited_env(int toplevel_size)
Scheme_Env *env;
Scheme_Object *vector;
Scheme_Hash_Table* hash_table;
Scheme_Module_Registry *reg;
env = make_env(NULL, toplevel_size);
@ -882,12 +883,15 @@ Scheme_Env *make_empty_inited_env(int toplevel_size)
SCHEME_VEC_ELS(vector)[0] = (Scheme_Object *)hash_table;
env->modchain = vector;
hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
env->module_registry = hash_table;
env->module_registry->iso.so.type = scheme_module_registry_type;
reg = MALLOC_ONE_TAGGED(Scheme_Module_Registry);
reg->so.type = scheme_module_registry_type;
env->module_registry = reg;
hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
env->export_registry = hash_table;
reg->loaded = hash_table;
hash_table = scheme_make_hash_table(SCHEME_hash_ptr);
reg->exports = hash_table;
env->label_env = NULL;
return env;
@ -920,12 +924,10 @@ static Scheme_Env *make_env(Scheme_Env *base, int toplevel_size)
if (base) {
env->modchain = base->modchain;
env->module_registry = base->module_registry;
env->export_registry = base->export_registry;
env->label_env = base->label_env;
} else {
env->modchain = NULL;
env->module_registry = NULL;
env->export_registry = NULL;
env->label_env = NULL;
}
@ -977,7 +979,6 @@ void scheme_prepare_exp_env(Scheme_Env *env)
eenv->module = env->module;
eenv->module_registry = env->module_registry;
eenv->export_registry = env->export_registry;
eenv->insp = env->insp;
modchain = SCHEME_VEC_ELS(env->modchain)[1];
@ -1018,7 +1019,6 @@ void scheme_prepare_template_env(Scheme_Env *env)
eenv->module = env->module;
eenv->module_registry = env->module_registry;
eenv->export_registry = env->export_registry;
eenv->insp = env->insp;
modchain = SCHEME_VEC_ELS(env->modchain)[2];
@ -1058,7 +1058,6 @@ void scheme_prepare_label_env(Scheme_Env *env)
lenv->module = env->module;
lenv->module_registry = env->module_registry;
lenv->export_registry = env->export_registry;
lenv->insp = env->insp;
modchain = scheme_make_vector(5, scheme_false);
@ -1090,7 +1089,6 @@ Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Obje
menv2->module = menv->module;
menv2->module_registry = ns->module_registry;
menv2->export_registry = ns->export_registry;
menv2->insp = menv->insp;
if (menv->phase < clone_phase)
@ -4450,7 +4448,7 @@ namespace_mapped_symbols(int argc, Scheme_Object *argv[])
}
if (env->rename_set)
scheme_list_module_rename(env->rename_set, mapped, env->export_registry);
scheme_list_module_rename(env->rename_set, mapped, env->module_registry->exports);
l = scheme_null;
for (i = mapped->size; i--; ) {

8
src/racket/src/eval.c
View File

@ -6204,7 +6204,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
if (genv->rename_set) {
form = scheme_add_rename(form, genv->rename_set);
/* this "phase shift" just attaches the namespace's module registry: */
form = scheme_stx_phase_shift(form, 0, NULL, NULL, genv->export_registry);
form = scheme_stx_phase_shift(form, 0, NULL, NULL, genv->module_registry->exports);
}
return form;
@ -6298,7 +6298,7 @@ static void *compile_k(void)
form = scheme_stx_phase_shift(form, 0,
genv->module->me->src_modidx,
genv->module->self_modidx,
genv->export_registry);
genv->module_registry->exports);
}
}
@ -10364,7 +10364,7 @@ Scheme_Object *scheme_eval_compiled_stx_string(Scheme_Object *expr, Scheme_Env *
result = scheme_make_vector(len - 1, NULL);
for (i = 0; i < len - 1; i++) {
s = scheme_stx_phase_shift(SCHEME_VEC_ELS(expr)[i], shift, orig, modidx, env->export_registry);
s = scheme_stx_phase_shift(SCHEME_VEC_ELS(expr)[i], shift, orig, modidx, env->module_registry->exports);
SCHEME_VEC_ELS(result)[i] = s;
}
@ -11572,7 +11572,7 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
if (rp->num_stxes) {
i = rp->num_toplevels;
v = scheme_stx_phase_shift_as_rename(now_phase - src_phase, src_modidx, now_modidx,
genv ? genv->export_registry : NULL);
genv ? genv->module_registry->exports : NULL);
if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) {
/* Put lazy-shift info in a[i]: */
Scheme_Object **ls;

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

@ -718,7 +718,7 @@ void scheme_save_initial_module_set(Scheme_Env *env)
}
initial_modules_env = env;
ht = env->module_registry;
ht = env->module_registry->loaded;
c = ht->size;
count = 0;
@ -775,7 +775,7 @@ void scheme_install_initial_module_set(Scheme_Env *env)
a[2] = (Scheme_Object *)env;
/* Make sure module is running: */
m = (Scheme_Module *)scheme_hash_get(initial_modules_env->module_registry, a[1]);
m = (Scheme_Module *)scheme_hash_get(initial_modules_env->module_registry->loaded, a[1]);
start_module(m, initial_modules_env, 0, a[1], 0, 1, 0, scheme_null);
namespace_attach_module(3, a);
@ -1413,7 +1413,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
if (!menv) {
/* Assert: name == argv[1] */
/* Module at least declared? */
if (scheme_hash_get(from_env->module_registry, name))
if (scheme_hash_get(from_env->module_registry->loaded, name))
scheme_arg_mismatch("namespace-attach-module",
"module not instantiated (in the source namespace): ",
name);
@ -1435,7 +1435,7 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
else
m2 = NULL;
} else {
m2 = (Scheme_Module *)scheme_hash_get(to_env->module_registry, name);
m2 = (Scheme_Module *)scheme_hash_get(to_env->module_registry->loaded, name);
if (m2 && SAME_OBJ(m2, menv->module))
m2 = NULL;
}
@ -1738,8 +1738,8 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
LOG_ATTACH(printf("Copying no-phase %s\n", scheme_write_to_string(name, NULL)));
m2 = (Scheme_Module *)scheme_hash_get(from_env->module_registry, name);
scheme_hash_set(to_env->module_registry, name, (Scheme_Object *)m2);
m2 = (Scheme_Module *)scheme_hash_get(from_env->module_registry->loaded, name);
scheme_hash_set(to_env->module_registry->loaded, name, (Scheme_Object *)m2);
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(from_env->label_env->modchain), name);
menv2 = scheme_copy_module_env(menv, to_env->label_env, to_env->label_env->modchain, menv->phase + 1);
@ -1806,8 +1806,8 @@ static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[])
check_phase(menv2, NULL, phase);
scheme_hash_set(MODCHAIN_TABLE(to_modchain), name, (Scheme_Object *)menv2);
}
scheme_hash_set(to_env->module_registry, name, (Scheme_Object *)menv->module);
scheme_hash_set(to_env->export_registry, name, (Scheme_Object *)menv->module->me);
scheme_hash_set(to_env->module_registry->loaded, name, (Scheme_Object *)menv->module);
scheme_hash_set(to_env->module_registry->exports, name, (Scheme_Object *)menv->module->me);
/* Push name onto notify list: */
if (!same_namespace)
@ -2543,7 +2543,7 @@ void scheme_prep_namespace_rename(Scheme_Env *menv)
else if (SAME_OBJ(name, flfxnum_modname))
im = scheme_get_flfxnum_env()->module;
else
im = (Scheme_Module *)scheme_hash_get(menv->module_registry, name);
im = (Scheme_Module *)scheme_hash_get(menv->module_registry->loaded, name);
add_simple_require_renames(NULL, rns, NULL, im, idx, shift, NULL, 0);
}
@ -2580,7 +2580,7 @@ Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env)
modchain = env->modchain;
menv = (Scheme_Env *)scheme_hash_get(MODCHAIN_TABLE(modchain), name);
if (!menv) {
if (scheme_hash_get(env->module_registry, name))
if (scheme_hash_get(env->module_registry->loaded, name))
scheme_arg_mismatch("module->namespace",
"module not instantiated in the current namespace: ",
name);
@ -2645,7 +2645,7 @@ static Scheme_Module *module_to_(const char *who, int argc, Scheme_Object *argv[
m = scheme_get_flfxnum_env()->module;
else {
env = scheme_get_env(NULL);
m = (Scheme_Module *)scheme_hash_get(env->module_registry, name);
m = (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name);
}
if (!m)
@ -3038,7 +3038,7 @@ static Scheme_Object *module_export_protected_p(int argc, Scheme_Object **argv)
else if (SAME_OBJ(modname, flfxnum_modname))
mv = (Scheme_Object *)scheme_get_flfxnum_env()->module;
else
mv = scheme_hash_get(env->module_registry, modname);
mv = scheme_hash_get(env->module_registry->loaded, modname);
if (!mv) {
scheme_arg_mismatch("module-provide-protected?",
"unknown module (in the source namespace): ",
@ -3335,7 +3335,7 @@ static Scheme_Module *module_load(Scheme_Object *name, Scheme_Env *env, const ch
else {
Scheme_Module *m;
m = (Scheme_Module *)scheme_hash_get(env->module_registry, name);
m = (Scheme_Module *)scheme_hash_get(env->module_registry->loaded, name);
if (!m) {
char *mred_note;
@ -3812,7 +3812,7 @@ static int wait_registry(Scheme_Env *env)
Scheme_Object *lock, *a[1];
while (1) {
lock = scheme_hash_get(env->module_registry, scheme_false);
lock = scheme_hash_get(env->module_registry->loaded, scheme_false);
if (!lock)
return 1;
@ -3830,15 +3830,15 @@ static void lock_registry(Scheme_Env *env)
Scheme_Object *lock;
lock = scheme_make_pair(scheme_make_sema(0),
(Scheme_Object *) scheme_current_thread);
scheme_hash_set(env->module_registry, scheme_false, lock);
scheme_hash_set(env->module_registry->loaded, scheme_false, lock);
}
static void unlock_registry(Scheme_Env *env)
{
Scheme_Object *lock;
lock = scheme_hash_get(env->module_registry, scheme_false);
lock = scheme_hash_get(env->module_registry->loaded, scheme_false);
scheme_post_sema(SCHEME_CAR(lock));
scheme_hash_set(env->module_registry, scheme_false, NULL);
scheme_hash_set(env->module_registry->loaded, scheme_false, NULL);
}
XFORM_NONGCING static long make_key(int base_phase, int eval_exp, int eval_run)
@ -3980,6 +3980,7 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
{
Scheme_Object *new_cycle_list, *midx, *l;
Scheme_Module *im;
int max_template_depth = 1;
new_cycle_list = scheme_make_pair(menv->module->modname, cycle_list);
@ -4017,6 +4018,9 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
midx,
eval_exp, eval_run, base_phase,
new_cycle_list);
if ((im->template_depth + 1) > max_template_depth)
max_template_depth = im->template_depth + 1;
}
}
@ -4028,6 +4032,9 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
if (im->template_depth > max_template_depth)
max_template_depth = im->template_depth;
}
scheme_prepare_exp_env(menv);
@ -4042,6 +4049,9 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, menv->exp_env, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
if ((im->template_depth - 1) > max_template_depth)
max_template_depth = im->template_depth - 1;
}
}
@ -4076,6 +4086,9 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
midx,
eval_exp, eval_run, base_phase,
new_cycle_list);
if ((im->template_depth - SCHEME_INT_VAL(phase)) > max_template_depth)
max_template_depth = im->template_depth - SCHEME_INT_VAL(phase);
}
} else {
compute_require_names(menv, phase, env, syntax_idx);
@ -4097,11 +4110,26 @@ static void chain_start_module(Scheme_Env *menv, Scheme_Env *env, int eval_exp,
im = module_load(scheme_module_resolve(midx, 1), env, NULL);
start_module(im, menv2, 0, midx, eval_exp, eval_run, base_phase, new_cycle_list);
if ((im->template_depth - SCHEME_INT_VAL(phase)) > max_template_depth)
max_template_depth = im->template_depth - SCHEME_INT_VAL(phase);
}
}
}
}
}
if (max_template_depth > menv->module->template_depth)
menv->module->template_depth = max_template_depth;
if (!env->module_registry->cycled) {
Scheme_Hash_Table *ht;
ht = scheme_make_hash_table(SCHEME_hash_ptr);
env->module_registry->cycled = ht;
}
scheme_hash_set(env->module_registry->cycled,
menv->module->modname,
scheme_true);
}
typedef struct Start_Module_Args {
@ -4403,6 +4431,16 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
menv->did_starts = v;
}
if ((env->phase > base_phase)
&& menv->module->template_depth
&& ((env->phase - (menv->module->template_depth - 1)) > (base_phase + 2))
&& env->module_registry->cycled
&& scheme_hash_get(env->module_registry->cycled,
menv->module->modname)) {
/* Skip chain start, because we won't get back to the base phase,
and we've already traversed the module's imports before to load
any needed modules. */
} else
chain_start_module_w_push(menv, env, eval_exp, eval_run, base_phase, cycle_list, syntax_idx);
if (restart) {
@ -4746,12 +4784,12 @@ Scheme_Env *scheme_primitive_module(Scheme_Object *name, Scheme_Env *for_env)
me->modsrc = src;
}
scheme_hash_set(for_env->export_registry, m->modname, (Scheme_Object *)m->me);
scheme_hash_set(for_env->module_registry->exports, m->modname, (Scheme_Object *)m->me);
insp = scheme_make_inspector(insp);
env->insp = insp;
scheme_hash_set(for_env->module_registry, m->modname, (Scheme_Object *)m);
scheme_hash_set(for_env->module_registry->loaded, m->modname, (Scheme_Object *)m);
return env;
}
@ -5232,8 +5270,8 @@ module_execute(Scheme_Object *data)
}
m->insp = insp;
scheme_hash_set(env->module_registry, m->modname, (Scheme_Object *)m);
scheme_hash_set(env->export_registry, m->modname, (Scheme_Object *)m->me);
scheme_hash_set(env->module_registry->loaded, m->modname, (Scheme_Object *)m);
scheme_hash_set(env->module_registry->exports, m->modname, (Scheme_Object *)m->me);
/* Replacing an already-running or already-syntaxing module? */
if (old_menv) {
@ -6505,7 +6543,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
/* Redefining a module? */
redef_modname = env->genv->module->modname;
if (!scheme_hash_get(env->genv->module_registry, redef_modname))
if (!scheme_hash_get(env->genv->module_registry->loaded, redef_modname))
redef_modname = NULL;
/* Expand each expression in form up to `begin', `define-values', `define-syntax',
@ -9254,7 +9292,7 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
} else {
if (!export_registry) {
env = scheme_get_env(scheme_current_config());
export_registry = env->export_registry;
export_registry = env->module_registry->exports;
}
me = (Scheme_Module_Exports *)scheme_hash_get(export_registry, name);

29
src/racket/src/mzmark.c
View File

@ -2100,7 +2100,6 @@ static int namespace_val_MARK(void *p, struct NewGC *gc) {
gcMARK2(e->module, gc);
gcMARK2(e->module_registry, gc);
gcMARK2(e->export_registry, gc);
gcMARK2(e->insp, gc);
gcMARK2(e->rename_set, gc);
@ -2139,7 +2138,6 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(e->module, gc);
gcFIXUP2(e->module_registry, gc);
gcFIXUP2(e->export_registry, gc);
gcFIXUP2(e->insp, gc);
gcFIXUP2(e->rename_set, gc);
@ -2177,6 +2175,33 @@ static int namespace_val_FIXUP(void *p, struct NewGC *gc) {
#define namespace_val_IS_CONST_SIZE 1
static int module_reg_val_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Registry));
}
static int module_reg_val_MARK(void *p, struct NewGC *gc) {
Scheme_Module_Registry *r = (Scheme_Module_Registry *)p;
gcMARK2(r->loaded, gc);
gcMARK2(r->exports, gc);
gcMARK2(r->cycled, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Registry));
}
static int module_reg_val_FIXUP(void *p, struct NewGC *gc) {
Scheme_Module_Registry *r = (Scheme_Module_Registry *)p;
gcFIXUP2(r->loaded, gc);
gcFIXUP2(r->exports, gc);
gcFIXUP2(r->cycled, gc);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Registry));
}
#define module_reg_val_IS_ATOMIC 0
#define module_reg_val_IS_CONST_SIZE 1
static int random_state_val_SIZE(void *p, struct NewGC *gc) {
return
gcBYTES_TO_WORDS(sizeof(Scheme_Random_State));

11
src/racket/src/mzmarksrc.c
View File

@ -834,7 +834,6 @@ namespace_val {
gcMARK2(e->module, gc);
gcMARK2(e->module_registry, gc);
gcMARK2(e->export_registry, gc);
gcMARK2(e->insp, gc);
gcMARK2(e->rename_set, gc);
@ -868,6 +867,16 @@ namespace_val {
gcBYTES_TO_WORDS(sizeof(Scheme_Env));
}
module_reg_val {
mark:
Scheme_Module_Registry *r = (Scheme_Module_Registry *)p;
gcMARK2(r->loaded, gc);
gcMARK2(r->exports, gc);
gcMARK2(r->cycled, gc);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Module_Registry));
}
random_state_val {
mark:
size:

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

@ -2764,6 +2764,14 @@ Scheme_Object *scheme_set_transformer_proc(Scheme_Object *o);
/* namespaces and modules */
/*========================================================================*/
typedef struct Scheme_Module_Registry {
Scheme_Object so; /* scheme_module_registry_type */
Scheme_Hash_Table *loaded; /* symbol -> module ; loaded modules,
shared with modules in same space */
Scheme_Hash_Table *exports; /* symbol -> module-exports */
Scheme_Hash_Table *cycled; /* resolved module paths that have been traversed */
} Scheme_Module_Registry;
struct Scheme_Env {
Scheme_Object so; /* scheme_namespace_type */
@ -2771,9 +2779,7 @@ struct Scheme_Env {
struct Scheme_Module *module; /* NULL => top-level */
Scheme_Hash_Table *module_registry; /* symbol -> module ; loaded modules,
shared with modules in same space */
Scheme_Hash_Table *export_registry; /* symbol -> module-exports */
Scheme_Module_Registry *module_registry;
Scheme_Object *insp; /* instantiation-time inspector, for granting
protected access and certificates */
@ -2872,6 +2878,8 @@ typedef struct Scheme_Module
Scheme_Env *primitive;
Scheme_Object *rn_stx;
long template_depth;
} Scheme_Module;
typedef struct Scheme_Module_Phase_Exports

2
src/racket/src/type.c
View File

@ -577,7 +577,7 @@ void scheme_register_traversers(void)
GC_REG_TRAV(scheme_thread_dead_type, small_object);
GC_REG_TRAV(scheme_hash_table_type, hash_table_val);
GC_REG_TRAV(scheme_bucket_table_type, bucket_table_val);
GC_REG_TRAV(scheme_module_registry_type, hash_table_val);
GC_REG_TRAV(scheme_module_registry_type, module_reg_val);
GC_REG_TRAV(scheme_namespace_type, namespace_val);
GC_REG_TRAV(scheme_random_state_type, random_state_val);