Specializing hash functions for widely used types.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16933 85f007b7-540e-0410-9357-904b9bb8a0f7

5 files changed, 37 insertions, 8 deletions

diff --git a/lib/cString.ml b/lib/cString.ml
index 823a356797..551b628342 100644
--- a/lib/cString.ml
+++ b/lib/cString.ml
@@ -46,6 +46,7 @@ module type ExtS =
 sig
   include S
   external equal : string -> string -> bool = "caml_string_equal" "noalloc"
+  val hash : string -> int
   val is_empty : string -> bool
   val explode : string -> string list
   val implode : string list -> string
@@ -67,6 +68,16 @@ include String
 
 external equal : string -> string -> bool = "caml_string_equal" "noalloc"
 
+let rec hash len s i accu =
+  if i = len then accu
+  else
+    let c = Char.code (String.unsafe_get s i) in
+    hash len s (succ i) (accu * 19 + c)
+
+let hash s =
+  let len = String.length s in
+  hash len s 0 0
+
 let explode s =
   let rec explode_rec n =
     if n >= String.length s then
diff --git a/lib/cString.mli b/lib/cString.mli
index 6ecbe888af..d8a19c8e4c 100644
--- a/lib/cString.mli
+++ b/lib/cString.mli
@@ -52,6 +52,9 @@ sig
   external equal : string -> string -> bool = "caml_string_equal" "noalloc"
   (** Equality on strings *)
 
+  val hash : string -> int
+  (** Hashing on strings. Should be compatible with generic one. *)
+
   val is_empty : string -> bool
   (** Test whether a string is empty. *)
 
diff --git a/lib/hashcons.ml b/lib/hashcons.ml
index 33f2c578fe..3a8a86e3ee 100644
--- a/lib/hashcons.ml
+++ b/lib/hashcons.ml
@@ -117,9 +117,10 @@ let register_hcons h u =
 (* Basic hashcons modules for string and obj. Integers do not need be
    hashconsed.  *)
 
+module type HashedType = sig type t val hash : t -> int end
+
 (* list *)
-module type SomeData = sig type t end
-module Hlist (D:SomeData) =
+module Hlist (D:HashedType) =
   Make(
     struct
       type t = D.t list
@@ -133,7 +134,12 @@ module Hlist (D:SomeData) =
           | [], [] -> true
           | x1::l1, x2::l2 -> x1==x2 && l1==l2
           | _ -> false
-      let hash = Hashtbl.hash
+      let rec hash accu = function
+      | [] -> accu
+      | x :: l ->
+        let accu = Hashset.Combine.combine (D.hash x) accu in
+        hash accu l
+      let hash l = hash 0 l
     end)
 
 (* string *)
@@ -143,7 +149,16 @@ module Hstring = Make(
     type u = unit
     let hashcons () s =(* incr accesstr;*) s
     external equal : string -> string -> bool = "caml_string_equal" "noalloc"
-    let hash = Hashtbl.hash
+    (** Copy from CString *)
+    let rec hash len s i accu =
+      if i = len then accu
+      else
+        let c = Char.code (String.unsafe_get s i) in
+        hash len s (succ i) (accu * 19 + c)
+
+    let hash s =
+      let len = String.length s in
+      hash len s 0 0
   end)
 
 (* Obj.t *)
diff --git a/lib/hashcons.mli b/lib/hashcons.mli
index 255cb0430a..cf3a09af4a 100644
--- a/lib/hashcons.mli
+++ b/lib/hashcons.mli
@@ -83,12 +83,12 @@ val recursive2_hcons :
 
 (** {6 Hashconsing of usual structures} *)
 
+module type HashedType = sig type t val hash : t -> int end
+
 module Hstring : (S with type t = string and type u = unit)
 (** Hashconsing of strings.  *)
 
-module type SomeData = sig type t end
-
-module Hlist (D:SomeData) :
+module Hlist (D:HashedType) :
   (S with type t = D.t list and type u = (D.t list -> D.t list)*(D.t->D.t))
 (** Hashconsing of lists.  *)
 
diff --git a/lib/int.ml b/lib/int.ml
index a85cf400d6..6eb4260657 100644
--- a/lib/int.ml
+++ b/lib/int.ml
@@ -12,7 +12,7 @@ external equal : int -> int -> bool = "%eq"
 
 external compare : int -> int -> int = "caml_int_compare"
 
-let hash i = i land max_int
+let hash i = i land 0x3FFFFFFF
 
 module Self =
 struct