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

`equal?' hashing: shortcut and some caching for structure transparency

Browse Source
This commit is contained in:
Matthew Flatt 2013-02-27 10:33:35 -07:00
parent 8a08cfcbbf
commit 773496642b
3 changed files with 41 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/racket/src/hash.c
View File

@ -930,6 +930,7 @@ END_XFORM_SKIP;
typedef struct Hash_Info { typedef struct Hash_Info {
intptr_t depth; /* always odd */ intptr_t depth; /* always odd */
Scheme_Object *recur; Scheme_Object *recur;
Scheme_Object *insp; /* obtained lazily */
} Hash_Info; } Hash_Info;
static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi); static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi);
@ -942,6 +943,7 @@ static Scheme_Object *hash_recur(int argc, Scheme_Object **argv, Scheme_Object *
hi = (Hash_Info *)SCHEME_PRIM_CLOSURE_ELS(prim)[0]; hi = (Hash_Info *)SCHEME_PRIM_CLOSURE_ELS(prim)[0];
hi->depth += 2; hi->depth += 2;
hi->insp = NULL; /* in case recursive call is `parameterize'd */
v = to_signed_hash(equal_hash_key(argv[0], 0, hi)); v = to_signed_hash(equal_hash_key(argv[0], 0, hi));
@ -1297,8 +1299,16 @@ static uintptr_t equal_hash_key(Scheme_Object *o, uintptr_t k, Hash_Info *hi)
} }
} else { } else {
Scheme_Object *insp; Scheme_Object *insp;
insp = scheme_get_param(scheme_current_config(), MZCONFIG_INSPECTOR); if (scheme_struct_is_transparent(o))
if (scheme_inspector_sees_part(o, insp, -2)) { insp = NULL;
else {
insp = hi->insp;
if (!insp) {
insp = scheme_get_param(scheme_current_config(), MZCONFIG_INSPECTOR);
hi->insp = insp;
}
}
if (!insp || scheme_inspector_sees_part(o, insp, -2)) {
int i; int i;
Scheme_Structure *s1 = (Scheme_Structure *)o; Scheme_Structure *s1 = (Scheme_Structure *)o;
@ -1476,6 +1486,7 @@ intptr_t scheme_equal_hash_key(Scheme_Object *o)
hi.depth = 1; hi.depth = 1;
hi.recur = NULL; hi.recur = NULL;
hi.insp = NULL;
return to_signed_hash(equal_hash_key(o, 0, &hi)); return to_signed_hash(equal_hash_key(o, 0, &hi));
} }
@ -1486,6 +1497,7 @@ intptr_t scheme_equal_hash_key2(Scheme_Object *o)
hi.depth = 1; hi.depth = 1;
hi.recur = NULL; hi.recur = NULL;
hi.insp = NULL;
return to_signed_hash(equal_hash_key2(o, &hi)); return to_signed_hash(equal_hash_key2(o, &hi));
} }
@ -1753,8 +1765,15 @@ static uintptr_t equal_hash_key2(Scheme_Object *o, Hash_Info *hi)
} }
} else { } else {
Scheme_Object *insp; Scheme_Object *insp;
insp = scheme_get_param(scheme_current_config(), MZCONFIG_INSPECTOR); if (scheme_struct_is_transparent(o))
if (scheme_inspector_sees_part(o, insp, -2)) { insp = NULL;
else {
if (!insp) {
insp = scheme_get_param(scheme_current_config(), MZCONFIG_INSPECTOR);
hi->insp = insp;
}
}
if (!insp || scheme_inspector_sees_part(o, insp, -2)) {
int i; int i;
uintptr_t k = 0; uintptr_t k = 0;
Scheme_Structure *s1 = (Scheme_Structure *)o; Scheme_Structure *s1 = (Scheme_Structure *)o;

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

@ -817,6 +817,7 @@ typedef struct Scheme_Struct_Property {
} Scheme_Struct_Property; } Scheme_Struct_Property;
int scheme_inspector_sees_part(Scheme_Object *s, Scheme_Object *insp, int pos); int scheme_inspector_sees_part(Scheme_Object *s, Scheme_Object *insp, int pos);
int scheme_struct_is_transparent(Scheme_Object *s);
typedef struct Scheme_Struct_Type { typedef struct Scheme_Struct_Type {
Scheme_Inclhash_Object iso; /* scheme_struct_type_type */ Scheme_Inclhash_Object iso; /* scheme_struct_type_type */

17
src/racket/src/struct.c
View File

@ -3051,6 +3051,23 @@ int scheme_inspector_sees_part(Scheme_Object *s, Scheme_Object *insp, int pos)
} }
} }
int scheme_struct_is_transparent(Scheme_Object *s)
{
Scheme_Struct_Type *stype;
int p;
if (SCHEME_CHAPERONEP(s))
s = SCHEME_CHAPERONE_VAL(s);
stype = ((Scheme_Structure *)s)->stype;
for (p = stype->name_pos; p--; ) {
if (SCHEME_TRUEP(stype->parent_types[p]->inspector))
return 0;
}
return 1;
}
#define STRUCT_mPROCP(o, v) \ #define STRUCT_mPROCP(o, v) \
(SCHEME_PRIMP(o) && ((((Scheme_Primitive_Proc *)o)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK) == (v))) (SCHEME_PRIMP(o) && ((((Scheme_Primitive_Proc *)o)->pp.flags & SCHEME_PRIM_OTHER_TYPE_MASK) == (v)))