From 3ab6be3cc213d5b3a25722a1f8c197df21882fca Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Wed, 6 Jun 2018 13:54:11 +0700
Subject: [PATCH] Add a functorized hashtable with all the functions we expect
 to stdune

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/stdune/hashable.ml     |  5 ++++
 src/stdune/hashtbl.ml      | 52 +++++++++++++++++++++++++++++++++++---
 src/stdune/hashtbl.mli     | 20 ++++++++++++++-
 src/stdune/hashtbl_intf.ml | 11 ++++++++
 4 files changed, 83 insertions(+), 5 deletions(-)
 create mode 100644 src/stdune/hashable.ml
 create mode 100644 src/stdune/hashtbl_intf.ml

diff --git a/src/stdune/hashable.ml b/src/stdune/hashable.ml
new file mode 100644
index 00000000..48565d44
--- /dev/null
+++ b/src/stdune/hashable.ml
@@ -0,0 +1,5 @@
+module type S = sig
+  type t
+  val equal : t -> t -> bool
+  val hash : t -> int
+end
diff --git a/src/stdune/hashtbl.ml b/src/stdune/hashtbl.ml
index c33652b3..51c16c1c 100644
--- a/src/stdune/hashtbl.ml
+++ b/src/stdune/hashtbl.ml
@@ -1,3 +1,5 @@
+module type S = Hashtbl_intf.S
+
 include struct
   [@@@warning "-32"]
 
@@ -7,19 +9,61 @@ include struct
     | exception Not_found -> None
 end
 
-include MoreLabels.Hashtbl
+module Make(H : Hashable.S) = struct
+  include MoreLabels.Hashtbl.Make(H)
+
+  include struct
+    [@@@warning "-32"]
+
+    let find_opt t key =
+      match find t key with
+      | x -> Some x
+      | exception Not_found -> None
+  end
+
+  include struct
+    let find = find_opt
+    let add t key data = add t ~key ~data
+
+    let find_or_add t key ~f =
+      match find t key with
+      | Some x -> x
+      | None ->
+        let x = f key in
+        add t key x;
+        x
+
+    let foldi t ~init ~f =
+      fold t ~init ~f:(fun ~key ~data acc -> f key data acc)
+    let fold  t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
+  end
+end
+
+open MoreLabels.Hashtbl
+
+type nonrec ('a, 'b) t = ('a, 'b) t
+
+let hash = hash
+let create = create
+let add = add
+let replace = replace
+let length = length
+let remove = remove
+let mem = mem
 
 let find = find_opt
 
+let add t key data = add t ~key ~data
+
 let find_or_add t key ~f =
   match find t key with
   | Some x -> x
   | None ->
     let x = f key in
-    add t ~key ~data:x;
+    add t key x;
     x
 
-let add t key data = add t ~key ~data
-
 let foldi t ~init ~f = fold  t ~init ~f:(fun ~key ~data acc -> f key data acc)
 let fold  t ~init ~f = foldi t ~init ~f:(fun _ x -> f x)
+
+let iter t ~f = iter ~f t
diff --git a/src/stdune/hashtbl.mli b/src/stdune/hashtbl.mli
index bf5947e9..7630949c 100644
--- a/src/stdune/hashtbl.mli
+++ b/src/stdune/hashtbl.mli
@@ -1,4 +1,20 @@
-include module type of struct include MoreLabels.Hashtbl end
+module type S = Hashtbl_intf.S
+
+module Make(Key : Hashable.S) : S with type key = Key.t
+
+type ('a, 'b) t = ('a, 'b) MoreLabels.Hashtbl.t
+
+val hash : 'a -> int
+
+val create : ?random:bool -> int -> ('a, 'b) t
+
+val remove : ('a, _) t -> 'a -> unit
+
+val length : (_, _) t -> int
+
+val iter : ('a, 'b) t -> f:(key:'a -> data:'b -> unit) -> unit
+
+val replace : ('a, 'b) t -> key:'a -> data:'b -> unit
 
 val add : ('a, 'b) t -> 'a -> 'b -> unit
 
@@ -7,3 +23,5 @@ val find_or_add : ('a, 'b) t -> 'a -> f:('a -> 'b) -> 'b
 
 val fold  : ('a, 'b) t -> init:'c -> f:(      'b -> 'c -> 'c) -> 'c
 val foldi : ('a, 'b) t -> init:'c -> f:('a -> 'b -> 'c -> 'c) -> 'c
+
+val mem : ('a, _) t -> 'a -> bool
diff --git a/src/stdune/hashtbl_intf.ml b/src/stdune/hashtbl_intf.ml
new file mode 100644
index 00000000..3d30d0e1
--- /dev/null
+++ b/src/stdune/hashtbl_intf.ml
@@ -0,0 +1,11 @@
+module type S = sig
+  include MoreLabels.Hashtbl.S
+
+  val add : 'a t -> key -> 'a -> unit
+
+  val find : 'a t -> key -> 'a option
+  val find_or_add : 'a t -> key -> f:(key -> 'a) -> 'a
+
+  val fold : 'a t -> init:'b -> f:('a -> 'b -> 'b) -> 'b
+  val foldi : 'a t -> init:'b -> f:(key -> 'a -> 'b -> 'b) -> 'b
+end