summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-10-12 23:03:39 +0200
committerLudovic Courtès <ludo@gnu.org>2012-10-12 23:21:39 +0200
commit8ac870dee4397c3b3f0ac24b072e88e87b91e47e (patch)
treec5e2484df42fcd1e7f1c5abae0b3cdc84cd68df7 /libguile
parent6996f07f577416505b2e33e5967f9fcc933559b7 (diff)
downloadguile-8ac870dee4397c3b3f0ac24b072e88e87b91e47e.tar.gz
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.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/hash.c7
-rw-r--r--libguile/struct.c49
-rw-r--r--libguile/struct.h2
3 files changed, 56 insertions, 2 deletions
diff --git a/libguile/hash.c b/libguile/hash.c
index a79f03d95..8b00a0cb1 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1997, 2000, 2001, 2003, 2004, 2006, 2008,
+ * 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -223,6 +224,8 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
significant_bits = (scm_t_uintptr) SCM_POINTER_VALUE (obj) >> 4UL;
return (size_t) significant_bits % n;
}
+ case scm_tcs_struct:
+ return scm_i_struct_hash (obj, n, d);
case scm_tc7_wvect:
case scm_tc7_vector:
{
diff --git a/libguile/struct.c b/libguile/struct.c
index 5837b7c42..db1687ef8 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -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}.")
diff --git a/libguile/struct.h b/libguile/struct.h
index 3072f24bf..643fd9dc9 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -193,6 +193,8 @@ SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *);
SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2);
SCM_INTERNAL unsigned long scm_struct_ihashq (SCM, unsigned long, void *);
+SCM_INTERNAL unsigned long scm_i_struct_hash (SCM s, unsigned long n,
+ size_t depth);
SCM_INTERNAL SCM scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words);
SCM_INTERNAL void scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj);
SCM_INTERNAL void scm_init_struct (void);