large refactor of CCHash, main type is now 'a -> int

src/core/CCHash.ml

@@ -3,67 +3,72 @@
 
 (** {1 Hash combinators} *)
 
-type t = int
+type hash = int
+
+type 'a t = 'a -> hash
 
 type 'a sequence = ('a -> unit) -> unit
 type 'a gen = unit -> 'a option
 type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 
-type state = int
+let combine f s x = Hashtbl.seeded_hash s (f x)
-
-type 'a hash_fun = 'a -> state -> state
-
-let combine f x s = Hashtbl.seeded_hash s (f x)
 
 let combine2 a b = Hashtbl.seeded_hash a b
 
-let init : state = 0
+let combine3 a b c =
-let finish i = i
+  combine2 (combine2 a b) c
 
-let apply f x = f x init
+let combine4 a b c d =
+  combine2 (combine2 a b) (combine2 c d)
 
 (** {2 Combinators} *)
 
-let int i s = combine2 s (Int64.of_int i)
+let const h _ = h
-let bool x s = combine2 s (if x then 1L else 2L)
-let char x s = combine2 s (Int64.of_int (Char.code x))
-let int32 x s = combine2 s (Int64.of_int32 x)
-let int64 x s = combine2 s x
-let nativeint x s = combine2 s (Int64.of_nativeint x)
 
-let slice x i len s =
+let int i = i land max_int
+let bool b = if b then 1 else 2
+let char x = Char.code x
+let int32 (x:int32) = Hashtbl.hash x
+let int64 (x:int64) = Hashtbl.hash x
+let nativeint (x:nativeint) = Hashtbl.hash x
+let string (x:string) = Hashtbl.hash x
+
+let slice x i len =
   let j=i+len in
   let rec aux i s =
-    if i=j then s else aux (i+1) (char x.[i] s)
+    if i=j then s else aux (i+1) (combine2 (char x.[i]) s)
   in
-  aux i s
+  aux i 0
 
-let rec list f l s = match l with
+let opt f = function
-  | [] -> s
+  | None -> 42
-  | x::l' -> list f l' (f x s)
+  | Some x -> combine2 43 (f x)
 
-let array f a s = Array.fold_right f a s
+let list f l = List.fold_left (combine f) 0x42 l
+let array f l = Array.fold_left (combine f) 0x42 l
 
-let opt f o h = match o with
+let pair f g (x,y) = combine2 (f x) (g y)
-  | None -> h
+let triple f g h (x,y,z) = combine2 (combine2 (f x) (g y)) (h z)
-  | Some x -> f x h
+let quad f g h i (x,y,z,w) = combine2 (combine2 (f x) (g y)) (combine2 (h z) (i w))
-let pair h1 h2 (x,y) s = h2 y (h1 x s)
-let triple h1 h2 h3 (x,y,z) s = h3 z (h2 y (h1 x s))
-
-let string x s = slice x 0 (String.length x) s
 
 let if_ b then_ else_ h =
   if b then then_ h else else_ h
 
-let seq f seq s =
+let poly x = Hashtbl.hash x
-  let s = ref s in
-  seq (fun x -> s := f x !s);
-  !s
 
-let rec gen f g s = match g () with
+let seq f seq =
-  | None -> s
+  let h = ref 0x43 in
-  | Some x -> gen f g (f x s)
+  seq (fun x -> h := combine f !h x);
+  !h
 
-let rec klist f l s = match l () with
+let gen f g =
-  | `Nil -> s
+  let rec aux s = match g () with
-  | `Cons (x,l') -> klist f l' (f x s)
+    | None -> s
+    | Some x -> aux (combine2 s (f x))
+  in aux 0x42
+
+let klist f l =
+  let rec aux l s = match l () with
+    | `Nil -> s
+    | `Cons (x,tail) -> aux tail (combine2 s (f x))
+  in aux l 0x42

src/core/CCHash.mli

@@ -5,56 +5,54 @@
 
 (** {2 Definitions} *)
 
-type t = int
+type hash = int
 (** A hash value is a positive integer *)
 
-type state
+type 'a t = 'a -> hash
+(** A hash function for values of type ['a] *)
 
-type 'a hash_fun = 'a -> state -> state
+val const : hash -> _ t
-(** Hash function for values of type ['a], merging a fingerprint of the
+(** [return h] hashes any value into [h]. Use with caution!. *)
-    value into the state of type [t] *)
 
-val init : state
+val int : int t
-(** Initial value *)
+val bool : bool t
-
+val char : char t
-val finish : state -> int
+val int32 : int32 t
-(** Extract a usable hash value *)
+val int64 : int64 t
-
+val nativeint : nativeint t
-val apply : 'a hash_fun -> 'a -> int
+val slice : string -> int -> int t
-(** Apply a hash function to a value.
-    [apply f x] is the same as [finish (f x init)] *)
-
-val int : int hash_fun
-val bool : bool hash_fun
-val char : char hash_fun
-val int32 : int32 hash_fun
-val int64 : int64 hash_fun
-val nativeint : nativeint hash_fun
-val slice : string -> int -> int hash_fun
 (** [slice s i len state] hashes the slice [i, ... i+len-1] of [s]
     into [state] *)
 
-val combine : ('a -> int) -> 'a hash_fun
+val string : string t
 
-val string : string hash_fun
+val list : 'a t -> 'a list t
+val array : 'a t -> 'a array t
+val opt : 'a t -> 'a option t
+val pair : 'a t -> 'b t -> ('a * 'b) t
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
 
-val list : 'a hash_fun -> 'a list hash_fun
+val if_ : bool -> 'a t -> 'a t -> 'a t
-
-val array : 'a hash_fun -> 'a array hash_fun
-
-val opt : 'a hash_fun -> 'a option hash_fun
-val pair : 'a hash_fun -> 'b hash_fun -> ('a * 'b) hash_fun
-val triple : 'a hash_fun -> 'b hash_fun -> 'c hash_fun -> ('a * 'b * 'c) hash_fun
-
-val if_ : bool -> 'a hash_fun -> 'a hash_fun -> 'a hash_fun
 (** Decide which hash function to use depending on the boolean *)
 
+val poly : 'a t
+(** the regular polymorphic hash function *)
+
+(** {2 Base hash combinators} *)
+
+val combine : 'a t -> hash -> 'a -> hash
+
+val combine2 : hash -> hash -> hash
+val combine3 : hash -> hash -> hash -> hash
+val combine4 : hash -> hash -> hash -> hash -> hash
+
 (** {2 Iterators} *)
 
 type 'a sequence = ('a -> unit) -> unit
 type 'a gen = unit -> 'a option
 type 'a klist = unit -> [`Nil | `Cons of 'a * 'a klist]
 
-val seq : 'a hash_fun -> 'a sequence hash_fun
+val seq : 'a t -> 'a sequence t
-val gen : 'a hash_fun -> 'a gen hash_fun
+val gen : 'a t -> 'a gen t
-val klist : 'a hash_fun -> 'a klist hash_fun
+val klist : 'a t -> 'a klist t