unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Implement ‘hash’ for structs
@ 2012-10-09 22:43 Ludovic Courtès
  2012-10-10  2:59 ` Mark H Weaver
  0 siblings, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2012-10-09 22:43 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 303 bytes --]

Hello!

As incredible as it may seem, ‘hash’ until now always returned 263 % n
for structs, leading to interesting experiences when using structs as
hash table keys.

The attached patch provides a simple hasher for structs.

I’ll commit it within a few days if there are no objections.

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4659 bytes --]

diff --git a/libguile/hash.c b/libguile/hash.c
index a79f03d..597e845 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);
     case scm_tc7_wvect:
     case scm_tc7_vector:
       {
diff --git a/libguile/struct.c b/libguile/struct.c
index 5837b7c..6287163 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -922,6 +922,52 @@ scm_struct_ihashq (SCM obj, unsigned long n, void *closure)
   return SCM_UNPACK (obj) % n;
 }
 
+unsigned long
+scm_i_struct_hash (SCM obj, unsigned long n)
+#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 = (unsigned long) SCM_PACK (SCM_STRUCT_VTABLE (obj));
+  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':
+	      if (!scm_is_eq (obj, SCM_PACK (data[field_num])))
+		hash ^= scm_ihash (SCM_PACK (data[field_num]), n);
+	      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 3072f24..69692ac 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -193,6 +193,7 @@ 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, unsigned long);
 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);
diff --git a/test-suite/tests/structs.test b/test-suite/tests/structs.test
index 431a014..6074dfb 100644
--- a/test-suite/tests/structs.test
+++ b/test-suite/tests/structs.test
@@ -126,7 +126,42 @@
      (not (or (equal? (make-ball red "Bob") (make-ball green "Bob"))
 	      (equal? (make-ball red "Bob") (make-ball red "Bill"))))))
 
+\f
+(with-test-prefix "hash"
+
+  (pass-if "simple structs"
+    (let* ((vtable (make-vtable "pr"))
+           (s1     (make-struct vtable 0 "hello"))
+           (s2     (make-struct vtable 0 "hello")))
+      (= (hash s1 7777) (hash s2 7777))))
+
+  (pass-if "different structs"
+    (let* ((vtable (make-vtable "pr"))
+           (s1     (make-struct vtable 0 "hello"))
+           (s2     (make-struct vtable 0 "world")))
+      (or (not (= (hash s1 7777) (hash s2 7777)))
+          (throw 'unresolved))))
+
+  (pass-if "different struct types"
+    (let* ((v1 (make-vtable "pr"))
+           (v2 (make-vtable "pr"))
+           (s1 (make-struct v1 0 "hello"))
+           (s2 (make-struct v2 0 "hello")))
+      (or (not (= (hash s1 7777) (hash s2 7777)))
+          (throw 'unresolved))))
 
+  (pass-if "more complex structs"
+    (let ((s1 (make-ball red (string-copy "Bob")))
+          (s2 (make-ball red (string-copy "Bob"))))
+      (= (hash s1 7777) (hash s2 7777))))
+
+  (pass-if "struct with weird fields"
+    (let* ((vtable (make-vtable "prurph"))
+           (s1     (make-struct vtable 0 "hello" 123 "invisible-secret1"))
+           (s2     (make-struct vtable 0 "hello" 123 "invisible-secret2")))
+      (= (hash s1 7777) (hash s2 7777)))))
+
+\f
 ;;
 ;; make-struct
 ;;

^ permalink raw reply related	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2012-10-12 21:48 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2012-10-09 22:43 [PATCH] Implement ‘hash’ for structs Ludovic Courtès
2012-10-10  2:59 ` Mark H Weaver
2012-10-10 20:36   ` Ludovic Courtès
2012-10-11 13:00     ` Mark H Weaver
2012-10-11 14:24       ` Ludovic Courtès
2012-10-12 21:48       ` Ludovic Courtès

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).