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

chage some quadratic-time parts of internal-defn expansion to linear

Browse Source 
svn: r18109
This commit is contained in:
Matthew Flatt 2010-02-17 14:12:07 +00:00
parent 526c76ddca
commit ea90a07c86
4 changed files with 45 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/mzscheme/src/env.c
View File

@ -177,7 +177,7 @@ static void init_compile_data(Scheme_Comp_Env *env);
#define COMPILE_DATA(e) (&((Scheme_Full_Comp_Env *)e)->data)
#define SCHEME_NON_SIMPLE_FRAME (SCHEME_NO_RENAME | SCHEME_CAPTURE_WITHOUT_RENAME \
| SCHEME_FOR_STOPS | SCHEME_FOR_INTDEF | SCHEME_CAPTURE_LIFTED)
| SCHEME_FOR_STOPS | SCHEME_CAPTURE_LIFTED)
#define ASSERT_IS_VARIABLE_BUCKET(b) /* if (((Scheme_Object *)b)->type != scheme_variable_type) abort() */

2
src/mzscheme/src/mzmark.c
View File

@ -5286,6 +5286,7 @@ static int lex_rib_MARK(void *p) {
gcMARK(rib->rename);
gcMARK(rib->timestamp);
gcMARK(rib->sealed);
gcMARK(rib->mapped_names);
gcMARK(rib->next);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Lexical_Rib));
@ -5296,6 +5297,7 @@ static int lex_rib_FIXUP(void *p) {
gcFIXUP(rib->rename);
gcFIXUP(rib->timestamp);
gcFIXUP(rib->sealed);
gcFIXUP(rib->mapped_names);
gcFIXUP(rib->next);
return
gcBYTES_TO_WORDS(sizeof(Scheme_Lexical_Rib));

1
src/mzscheme/src/mzmarksrc.c
View File

@ -2164,6 +2164,7 @@ lex_rib {
gcMARK(rib->rename);
gcMARK(rib->timestamp);
gcMARK(rib->sealed);
gcMARK(rib->mapped_names);
gcMARK(rib->next);
size:
gcBYTES_TO_WORDS(sizeof(Scheme_Lexical_Rib));

41
src/mzscheme/src/stxobj.c
View File

@ -213,6 +213,7 @@ typedef struct Scheme_Lexical_Rib {
Scheme_Object *rename; /* a vector for a lexical rename */
Scheme_Object *timestamp;
int *sealed;
Scheme_Object *mapped_names; /* only in the initial link; int or hash table */
struct Scheme_Lexical_Rib *next;
} Scheme_Lexical_Rib;
@ -1168,6 +1169,8 @@ void scheme_add_rib_rename(Scheme_Object *ro, Scheme_Object *rename)
{
Scheme_Lexical_Rib *rib, *naya;
Scheme_Object *next;
Scheme_Hash_Table *mapped_names;
int i;
naya = MALLOC_ONE_TAGGED(Scheme_Lexical_Rib);
naya->so.type = scheme_lexical_rib_type;
@ -1186,6 +1189,31 @@ void scheme_add_rib_rename(Scheme_Object *ro, Scheme_Object *rename)
SCHEME_CDR(unsealed_dependencies) = NULL;
unsealed_dependencies = next;
}
if (!rib->mapped_names)
rib->mapped_names = scheme_make_integer(1);
else if (SCHEME_INTP(rib->mapped_names)) {
rib->mapped_names = scheme_make_integer(SCHEME_INT_VAL(rib->mapped_names) + 1);
if (SCHEME_INT_VAL(rib->mapped_names) > 32) {
/* Build the initial table */
mapped_names = scheme_make_hash_table(SCHEME_hash_ptr);
while (naya) {
for (i = SCHEME_RENAME_LEN(naya->rename); i--; ) {
scheme_hash_set(mapped_names,
SCHEME_STX_SYM(SCHEME_VEC_ELS(naya->rename)[2+i]),
scheme_true);
}
naya = naya->next;
}
rib->mapped_names = (Scheme_Object *)mapped_names;
}
} else {
for (i = SCHEME_RENAME_LEN(naya->rename); i--; ) {
scheme_hash_set((Scheme_Hash_Table *)rib->mapped_names,
SCHEME_STX_SYM(SCHEME_VEC_ELS(naya->rename)[2+i]),
scheme_true);
}
}
}
void scheme_drop_first_rib_rename(Scheme_Object *ro)
@ -4747,6 +4775,11 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
} else {
recur_skip_ribs = add_skip_set(rib->timestamp, recur_skip_ribs);
did_rib = rib;
if (rib->mapped_names
&& !SCHEME_INTP(rib->mapped_names)
&& !scheme_hash_get((Scheme_Hash_Table *)rib->mapped_names, SCHEME_STX_VAL(a)))
rib = NULL; /* no need to check individual renames */
else
rib = rib->next; /* First rib record has no rename */
}
} else
@ -4952,7 +4985,13 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
rename = WRAP_POS_FIRST(wraps);
if (SCHEME_RIBP(rename)) {
rib = ((Scheme_Lexical_Rib *)rename)->next;
rib = (Scheme_Lexical_Rib *)rename;
if (rib->mapped_names
&& !SCHEME_INTP(rib->mapped_names)
&& !scheme_hash_get((Scheme_Hash_Table *)rib->mapped_names, SCHEME_STX_VAL(a)))
rib = NULL; /* no need to check individual renames */
else
rib = rib->next;
rename = NULL;
} else {
rib = NULL;