improve equal-hash-code
on interned symbols
Compute an `equal?` hash code for `read`able values that is a constant, at least for a given version of Racket. Only (interned) symbols failed to have that property before.
This commit is contained in:
parent
3617e1f81e
commit
97d951af54
|
@ -12,7 +12,7 @@
|
||||||
|
|
||||||
(define collection 'multi)
|
(define collection 'multi)
|
||||||
|
|
||||||
(define version "6.4.0.11")
|
(define version "6.4.0.12")
|
||||||
|
|
||||||
(define deps `("racket-lib"
|
(define deps `("racket-lib"
|
||||||
["racket" #:version ,version]))
|
["racket" #:version ,version]))
|
||||||
|
|
|
@ -532,7 +532,16 @@ the returned number is the same.}
|
||||||
Returns a @tech{fixnum}; for any two calls with @racket[equal?] values,
|
Returns a @tech{fixnum}; for any two calls with @racket[equal?] values,
|
||||||
the returned number is the same. A hash code is computed even when
|
the returned number is the same. A hash code is computed even when
|
||||||
@racket[v] contains a cycle through pairs, vectors, boxes, and/or
|
@racket[v] contains a cycle through pairs, vectors, boxes, and/or
|
||||||
inspectable structure fields. See also @racket[gen:equal+hash].}
|
inspectable structure fields. See also @racket[gen:equal+hash].
|
||||||
|
|
||||||
|
For any @racket[v] that could be produced by @racket[read], if
|
||||||
|
@racket[v2] is produced by @racket[read] for the same input
|
||||||
|
characters, the @racket[(equal-hash-code v)] is the same as
|
||||||
|
@racket[(equal-hash-code v2)] --- even if @racket[v] and @racket[v2]
|
||||||
|
do not exist at the same time (and therefore could not be compared by
|
||||||
|
calling @racket[equal?]).
|
||||||
|
|
||||||
|
@history[#:changed "6.4.0.12" @elem{Strengthened guarantee for @racket[read]able values.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(equal-secondary-hash-code [v any/c]) fixnum?]{
|
@defproc[(equal-secondary-hash-code [v any/c]) fixnum?]{
|
||||||
|
|
|
@ -2650,8 +2650,14 @@
|
||||||
(set-a-y! an-a 8)
|
(set-a-y! an-a 8)
|
||||||
(test v equal-hash-code an-a))
|
(test v equal-hash-code an-a))
|
||||||
|
|
||||||
|
;; Check that `equal-hash-code` is consistent for interned symbols:
|
||||||
|
(let ()
|
||||||
|
(define v (random))
|
||||||
|
(define k (equal-hash-code (string->symbol (format "sym:~a" v))))
|
||||||
|
(collect-garbage 'minor)
|
||||||
|
(test k equal-hash-code (string->symbol (format "sym:~a" v))))
|
||||||
|
|
||||||
;; Try to build a hash table whose indexes fonr't fit in 32 bits:
|
;; Try to build a hash table whose indexes don't fit in 32 bits:
|
||||||
(let ()
|
(let ()
|
||||||
(struct a (x)
|
(struct a (x)
|
||||||
#:property
|
#:property
|
||||||
|
|
|
@ -128,6 +128,31 @@ uintptr_t PTR_TO_LONG(Scheme_Object *o)
|
||||||
# define PTR_TO_LONG(p) ((uintptr_t)(p)>>2)
|
# define PTR_TO_LONG(p) ((uintptr_t)(p)>>2)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
void scheme_install_symbol_hash_code(Scheme_Object *sym, uintptr_t h)
|
||||||
|
{
|
||||||
|
#ifdef MZ_PRECISE_GC
|
||||||
|
/* Record a hash code for the symbol as its `eq?` hash code ---
|
||||||
|
intended mainly to make `equal?` hashing depend only on the
|
||||||
|
symbol content */
|
||||||
|
short v;
|
||||||
|
|
||||||
|
v = sym->keyex;
|
||||||
|
|
||||||
|
if (!(v & 0xFFFC)) {
|
||||||
|
v |= (short)(h & ~0x7);
|
||||||
|
#ifdef OBJHEAD_HAS_HASH_BITS
|
||||||
|
if (GC_is_allocated(sym)) {
|
||||||
|
OBJHEAD_HASH_BITS(sym) = (h >> 16);
|
||||||
|
v |= GCABLE_OBJ_HASH_BIT;
|
||||||
|
} else
|
||||||
|
v &= ~GCABLE_OBJ_HASH_BIT;
|
||||||
|
#endif
|
||||||
|
if (!v) v = 0x1AD0;
|
||||||
|
sym->keyex = v;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
#define FILL_FACTOR 1.4
|
#define FILL_FACTOR 1.4
|
||||||
|
|
||||||
#define MIN_HTABLE_SIZE 8
|
#define MIN_HTABLE_SIZE 8
|
||||||
|
@ -1474,6 +1499,10 @@ XFORM_NONGCING static uintptr_t fast_equal_hash_key(Scheme_Object *o, uintptr_t
|
||||||
} else
|
} else
|
||||||
return k + PTR_TO_LONG(o);
|
return k + PTR_TO_LONG(o);
|
||||||
}
|
}
|
||||||
|
# else
|
||||||
|
case scheme_keyword_type:
|
||||||
|
case scheme_symbol_type:
|
||||||
|
return PTR_TO_LONG(o);
|
||||||
# endif
|
# endif
|
||||||
default:
|
default:
|
||||||
{
|
{
|
||||||
|
|
|
@ -194,6 +194,8 @@ intptr_t scheme_hash_key(Scheme_Object *o);
|
||||||
#endif
|
#endif
|
||||||
typedef int (*Compare_Proc)(void *v1, void *v2);
|
typedef int (*Compare_Proc)(void *v1, void *v2);
|
||||||
|
|
||||||
|
XFORM_NONGCING void scheme_install_symbol_hash_code(Scheme_Object *sym, uintptr_t h);
|
||||||
|
|
||||||
Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]);
|
Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]);
|
||||||
|
|
||||||
#define REGISTER_SO(x) MZ_REGISTER_STATIC(x)
|
#define REGISTER_SO(x) MZ_REGISTER_STATIC(x)
|
||||||
|
|
|
@ -13,12 +13,12 @@
|
||||||
consistently.)
|
consistently.)
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#define MZSCHEME_VERSION "6.4.0.11"
|
#define MZSCHEME_VERSION "6.4.0.12"
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_X 6
|
#define MZSCHEME_VERSION_X 6
|
||||||
#define MZSCHEME_VERSION_Y 4
|
#define MZSCHEME_VERSION_Y 4
|
||||||
#define MZSCHEME_VERSION_Z 0
|
#define MZSCHEME_VERSION_Z 0
|
||||||
#define MZSCHEME_VERSION_W 11
|
#define MZSCHEME_VERSION_W 12
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||||
|
|
|
@ -129,6 +129,11 @@ static Scheme_Object *symbol_bucket(Scheme_Hash_Table *table,
|
||||||
h ^= (h << 5) + (h >> 2) + 0xA0A0;
|
h ^= (h << 5) + (h >> 2) + 0xA0A0;
|
||||||
h ^= (h << 5) + (h >> 2) + 0x0505;
|
h ^= (h << 5) + (h >> 2) + 0x0505;
|
||||||
|
|
||||||
|
if (naya) {
|
||||||
|
/* record hash code (or some fragment of it) for `equal?` hashing: */
|
||||||
|
scheme_install_symbol_hash_code(naya, h);
|
||||||
|
}
|
||||||
|
|
||||||
h = h & mask;
|
h = h & mask;
|
||||||
h2 = h2 & mask;
|
h2 = h2 & mask;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user