[Guile-commits] GNU Guile branch, master, updated. v2.1.0-49-g9d01333

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=9d013330154852bc2309947adaa30b32418642c0

The branch, master has been updated
       via  9d013330154852bc2309947adaa30b32418642c0 (commit)
       via  92e35e8daa4c46b08fabf84407ff8435033af87f (commit)
       via  d1d1c5dea556e993255fa1508fe87464567f64d4 (commit)
       via  71f89dd7e9e62407140d6e43dc15490705df98e3 (commit)
      from  7914b2b0690ecd65c89a80e2451f44f0e0d64940 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 9d013330154852bc2309947adaa30b32418642c0
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 26 01:44:48 2011 +0200

    update `hash'
    
    * libguile/hash.c (scm_raw_ihash): Rename from `hasher'.  Remove the
      modulo argument; we expect the caller to deal with that.  Use
      scm_i_hashq for immediates and non-immediate integers.  Use
      scm_raw_ihashq on pointers too.  Update the vector and pairs hashing
      code.  There is still some work to do here.
      (scm_ihashv, scm_ihash): Adapt.

commit 92e35e8daa4c46b08fabf84407ff8435033af87f
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 26 00:42:17 2011 +0200

    don't downcase characters before hashing them
    
    * libguile/hash.c (hasher, scm_ihashv): Don't downcase characters before
      hashing them.  That is silly.

commit d1d1c5dea556e993255fa1508fe87464567f64d4
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 26 00:38:47 2011 +0200

    scm_hasher is static
    
    * libguile/hash.c (hasher): Make static.
    * libguile/hash.h: Remove scm_hasher.

commit 71f89dd7e9e62407140d6e43dc15490705df98e3
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 26 00:37:24 2011 +0200

    add thomas wang's integer hash function; use it for hashq, hashv
    
    * libguile/hash.c (scm_raw_ihashq): Add Thomas Wang's integer hash
      function, from http://www.cris.com/~Ttwang/tech/inthash.htm.
      (scm_ihashq, scm_ihashv): Use it here.

-----------------------------------------------------------------------

Summary of changes:
 libguile/hash.c |  174 ++++++++++++++++++++----------------------------------
 libguile/hash.h |    1 -
 2 files changed, 65 insertions(+), 110 deletions(-)

diff --git a/libguile/hash.c b/libguile/hash.c
index b620b16..ab47008 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -224,132 +224,91 @@ scm_i_utf8_string_hash (const char *str, size_t len)
 }
 
 
-/* Dirk:FIXME:: why downcase for characters? (2x: scm_hasher, scm_ihashv) */
-/* Dirk:FIXME:: scm_hasher could be made static. */
-
-
-unsigned long
-scm_hasher(SCM obj, unsigned long n, size_t d)
+/* Thomas Wang's integer hasher, from
+   http://www.cris.com/~Ttwang/tech/inthash.htm.  */
+static unsigned long
+scm_raw_ihashq (scm_t_bits key)
 {
-  switch (SCM_ITAG3 (obj)) {
-  case scm_tc3_int_1: 
-  case scm_tc3_int_2:
-    return SCM_I_INUM(obj) % n;   /* SCM_INUMP(obj) */
-  case scm_tc3_imm24:
-    if (SCM_CHARP(obj))
-      return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n;
-    switch (SCM_UNPACK (obj)) {
-    case SCM_EOL_BITS:
-      d = 256; 
-      break;
-    case SCM_BOOL_T_BITS:
-      d = 257; 
-      break;
-    case SCM_BOOL_F_BITS:
-      d = 258; 
-      break;
-    case SCM_EOF_VAL_BITS:
-      d = 259; 
-      break;
-    default: 
-      d = 263;         /* perhaps should be error */
+  if (sizeof (key) < 8)
+    {
+      key = (key ^ 61) ^ (key >> 16);
+      key = key + (key << 3);
+      key = key ^ (key >> 4);
+      key = key * 0x27d4eb2d;
+      key = key ^ (key >> 15);
+    }
+  else
+    {
+      key = (~key) + (key << 21); // key = (key << 21) - key - 1;
+      key = key ^ (key >> 24);
+      key = (key + (key << 3)) + (key << 8); // key * 265
+      key = key ^ (key >> 14);
+      key = (key + (key << 2)) + (key << 4); // key * 21
+      key = key ^ (key >> 28);
+      key = key + (key << 31);
     }
-    return d % n;
-  default: 
-    return 263 % n;    /* perhaps should be error */
-  case scm_tc3_cons:
-    switch SCM_TYP7(obj) {
-    default: 
-      return 263 % n;
+  key >>= 2; /* Ensure that it fits in a fixnum.  */
+  return key;
+}
+
+/* `depth' is used to limit recursion. */
+static unsigned long
+scm_raw_ihash (SCM obj, size_t depth)
+{
+  if (SCM_IMP (obj))
+    return scm_raw_ihashq (SCM_UNPACK (obj));
+
+  switch (SCM_TYP7(obj))
+    {
+      /* FIXME: do better for structs, variables, ...  Also the hashes
+         are currently associative, which ain't the right thing.  */
     case scm_tc7_smob:
-      return 263 % n;
+      return scm_raw_ihashq (SCM_TYP16 (obj));
     case scm_tc7_number:
-      switch SCM_TYP16 (obj) {
-      case scm_tc16_big:
-        return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n)));
-      case scm_tc16_real:
-       {
-         double r = SCM_REAL_VALUE (obj);
-         if (floor (r) == r && !isinf (r) && !isnan (r))
-           {
-             obj = scm_inexact_to_exact (obj);
-             return scm_to_ulong (scm_modulo (obj, scm_from_ulong (n)));
-           }
-       }
-        /* Fall through */
-      case scm_tc16_complex:
-      case scm_tc16_fraction:
-       obj = scm_number_to_string (obj, scm_from_int (10));
-        /* Fall through */
-      }
-      /* Fall through */
+      if (scm_is_integer (obj))
+        {
+          SCM n = SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM);
+          if (scm_is_inexact (obj))
+            obj = scm_inexact_to_exact (obj);
+          return scm_raw_ihashq (scm_to_ulong (scm_modulo (obj, n)));
+        }
+      else
+        return scm_i_string_hash (scm_number_to_string (obj, scm_from_int 
(10)));
     case scm_tc7_string:
-      {
-       unsigned long hash =
-         scm_i_string_hash (obj) % n;
-       return hash;
-      }
+      return scm_i_string_hash (obj);
     case scm_tc7_symbol:
-      return scm_i_symbol_hash (obj) % n;
+      return scm_i_symbol_hash (obj);
     case scm_tc7_pointer:
-      {
-       /* Pointer objects are typically used to store addresses of heap
-          objects.  On most platforms, these are at least 3-byte
-          aligned (on x86_64-*-gnu, `malloc' returns 4-byte aligned
-          addresses), so get rid of the least significant bits.  */
-       scm_t_uintptr significant_bits;
-
-       significant_bits = (scm_t_uintptr) SCM_POINTER_VALUE (obj) >> 4UL;
-       return (size_t) significant_bits  % n;
-      }
+      return scm_raw_ihashq ((scm_t_uintptr) SCM_POINTER_VALUE (obj));
     case scm_tc7_wvect:
     case scm_tc7_vector:
       {
        size_t len = SCM_SIMPLE_VECTOR_LENGTH (obj);
-       if (len > 5)
-         {
-           size_t i = d/2;
-           unsigned long h = 1;
-           while (i--)
-             {
-               SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
-               h = ((h << 8) + (scm_hasher (elt, n, 2))) % n;
-             }
-           return h;
-         }
-       else
-         {
-           size_t i = len;
-           unsigned long h = (n)-1;
-           while (i--)
-             {
-               SCM elt = SCM_SIMPLE_VECTOR_REF (obj, h % len);
-               h = ((h << 8) + (scm_hasher (elt, n, d/len))) % n;
-             }
-           return h;
-         }
+        size_t i = depth / 2;
+        unsigned long h = scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
+        while (i--)
+          h ^= scm_raw_ihash (scm_c_vector_ref (obj, h % len), i);
+        return h;
       }
     case scm_tcs_cons_imcar: 
     case scm_tcs_cons_nimcar:
-      if (d) return (scm_hasher (SCM_CAR (obj), n, d/2)
-                     + scm_hasher (SCM_CDR (obj), n, d/2)) % n;
-      else return 1;
-    case scm_tc7_port:
-      return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
-    case scm_tc7_program:
-      return 262 % n;
+      if (depth)
+        return (scm_raw_ihash (SCM_CAR (obj), depth / 2)
+                ^ scm_raw_ihash (SCM_CDR (obj), depth / 2));
+      else
+        return scm_raw_ihashq (scm_tc3_cons);
+    default:
+      return scm_raw_ihashq (SCM_CELL_WORD_0 (obj));
     }
-  }
 }
 
 
 
 
-
 unsigned long
 scm_ihashq (SCM obj, unsigned long n)
 {
-  return (SCM_UNPACK (obj) >> 1) % n;
+  return scm_raw_ihashq (SCM_UNPACK (obj)) % n;
 }
 
 
@@ -379,13 +338,10 @@ SCM_DEFINE (scm_hashq, "hashq", 2, 0, 0,
 unsigned long
 scm_ihashv (SCM obj, unsigned long n)
 {
-  if (SCM_CHARP(obj))
-    return ((unsigned long) (scm_c_downcase (SCM_CHAR (obj)))) % n; /* 
downcase!?!! */
-
   if (SCM_NUMP(obj))
-    return (unsigned long) scm_hasher(obj, n, 10);
+    return scm_raw_ihash (obj, 10) % n;
   else
-    return SCM_UNPACK (obj) % n;
+    return scm_raw_ihashq (SCM_UNPACK (obj)) % n;
 }
 
 
@@ -415,7 +371,7 @@ SCM_DEFINE (scm_hashv, "hashv", 2, 0, 0,
 unsigned long
 scm_ihash (SCM obj, unsigned long n)
 {
-  return (unsigned long) scm_hasher (obj, n, 10);
+  return (unsigned long) scm_raw_ihash (obj, 10) % n;
 }
 
 SCM_DEFINE (scm_hash, "hash", 2, 0, 0,
diff --git a/libguile/hash.h b/libguile/hash.h
index 3077486..d3e42f1 100644
--- a/libguile/hash.h
+++ b/libguile/hash.h
@@ -36,7 +36,6 @@ SCM_INTERNAL unsigned long scm_i_utf8_string_hash (const char 
*str,
                                                    size_t len);
 
 SCM_INTERNAL unsigned long scm_i_string_hash (SCM str);
-SCM_API unsigned long scm_hasher (SCM obj, unsigned long n, size_t d);
 SCM_API unsigned long scm_ihashq (SCM obj, unsigned long n);
 SCM_API SCM scm_hashq (SCM obj, SCM n);
 SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n);


hooks/post-receive
-- 
GNU Guile