mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Implement `hash' for structs.
* libguile/hash.c (scm_hasher): Call `scm_i_struct_hash' upon `scm_tcs_struct'. * libguile/struct.c (scm_i_struct_hash): New function. * libguile/struct.h (scm_i_struct_hash): New declaration. * test-suite/tests/structs.test ("hash"): New test prefix.
This commit is contained in:
parent
6996f07f57
commit
8ac870dee4
4 changed files with 98 additions and 2 deletions
|
@ -922,6 +922,55 @@ scm_struct_ihashq (SCM obj, unsigned long n, void *closure)
|
|||
return SCM_UNPACK (obj) % n;
|
||||
}
|
||||
|
||||
/* Return the hash of struct OBJ, modulo N. Traverse OBJ's fields to
|
||||
compute the result, unless DEPTH is zero. */
|
||||
unsigned long
|
||||
scm_i_struct_hash (SCM obj, unsigned long n, size_t depth)
|
||||
#define FUNC_NAME "hash"
|
||||
{
|
||||
SCM layout;
|
||||
scm_t_bits *data;
|
||||
size_t struct_size, field_num;
|
||||
unsigned long hash;
|
||||
|
||||
SCM_VALIDATE_STRUCT (1, obj);
|
||||
|
||||
layout = SCM_STRUCT_LAYOUT (obj);
|
||||
struct_size = scm_i_symbol_length (layout) / 2;
|
||||
data = SCM_STRUCT_DATA (obj);
|
||||
|
||||
hash = SCM_UNPACK (SCM_STRUCT_VTABLE (obj)) % n;
|
||||
if (depth > 0)
|
||||
for (field_num = 0; field_num < struct_size; field_num++)
|
||||
{
|
||||
int protection;
|
||||
|
||||
protection = scm_i_symbol_ref (layout, field_num * 2 + 1);
|
||||
if (protection != 'h' && protection != 'o')
|
||||
{
|
||||
int type;
|
||||
type = scm_i_symbol_ref (layout, field_num * 2);
|
||||
switch (type)
|
||||
{
|
||||
case 'p':
|
||||
hash ^= scm_hasher (SCM_PACK (data[field_num]), n,
|
||||
depth / 2);
|
||||
break;
|
||||
case 'u':
|
||||
hash ^= data[field_num] % n;
|
||||
break;
|
||||
default:
|
||||
/* Ignore 's' fields. */;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* FIXME: Tail elements should be taken into account. */
|
||||
|
||||
return hash % n;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0,
|
||||
(SCM vtable),
|
||||
"Return the name of the vtable @var{vtable}.")
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue