Replace poly tables (#2462)

Replace poly tables

src/alias.ml

@@ -45,7 +45,7 @@ let compare x y =
 let equal x y = compare x y = Eq
 
 let hash { dir ; name } =
-  Hashtbl.hash (Path.Build.hash dir, String.hash name)
+  Tuple.T2.hash Path.Build.hash String.hash (dir, name)
 
 let pp fmt t = Path.Build.pp fmt (Path.Build.relative t.dir t.name)
 
@@ -82,12 +82,12 @@ let find_dir_specified_on_command_line ~dir ~file_tree =
       ]
   | Some dir -> dir
 
-let standard_aliases = Hashtbl.create 7
+let standard_aliases = Table.create (module String) 7
 
-let is_standard name = Hashtbl.mem standard_aliases name
+let is_standard name = Table.mem standard_aliases name
 
 let make_standard name =
-  Hashtbl.add_exn standard_aliases name ();
+  Table.add_exn standard_aliases name ();
   make name
 
 let default     = make_standard "default"

src/build_system.ml

@@ -555,14 +555,15 @@ let compute_targets_digest_after_rule_execution ~info targets =
 
 let sandbox_dir = Path.Build.relative Path.Build.root ".sandbox"
 
-let locks : (Path.t, Fiber.Mutex.t) Hashtbl.t = Hashtbl.create 32
+let locks : (Path.t, Fiber.Mutex.t) Table.t =
+  Table.create (module Path) 32
 
 let rec with_locks mutexes ~f =
   match mutexes with
   | [] -> f ()
   | m :: mutexes ->
     Fiber.Mutex.with_lock
-      (Hashtbl.find_or_add locks m ~f:(fun _ -> Fiber.Mutex.create ()))
+      (Table.find_or_add locks m ~f:(fun _ -> Fiber.Mutex.create ()))
       (fun () -> with_locks mutexes ~f)
 
 let remove_old_artifacts t ~dir ~(subdirs_to_keep : Subdir_set.t) =

src/context.ml

@@ -64,7 +64,7 @@ type t =
   ; findlib                 : Findlib.t
   ; findlib_toolchain       : string option
   ; arch_sixtyfour          : bool
-  ; opam_var_cache          : (string, string) Hashtbl.t
+  ; opam_var_cache          : (string, string) Table.t
   ; ocaml_config            : Ocaml_config.t
   ; version_string          : string
   ; version                 : Ocaml_version.t
@@ -97,7 +97,7 @@ type t =
   ; cmxs_magic_number       : string
   ; cmt_magic_number        : string
   ; supports_shared_libraries : Dynlink_supported.By_the_os.t
-  ; which_cache             : (string, Path.t option) Hashtbl.t
+  ; which_cache             : (string, Path.t option) Table.t
   ; lib_config : Lib_config.t
   }
 
@@ -129,9 +129,9 @@ let to_dyn t : Dyn.t =
       Bool (Dynlink_supported.By_the_os.get t.lib_config.natdynlink_supported)
     ; "supports_shared_libraries",
       Bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries)
-    ; "opam_vars", Hashtbl.to_dyn string string t.opam_var_cache
+    ; "opam_vars", Table.to_dyn string t.opam_var_cache
     ; "ocaml_config", Ocaml_config.to_dyn t.ocaml_config
-    ; "which", Hashtbl.to_dyn string (option path) t.which_cache
+    ; "which", Table.to_dyn (option path) t.which_cache
     ]
 
 let to_dyn_concise t : Dyn.t = String t.name
@@ -141,7 +141,7 @@ let compare a b = compare a.name b.name
 let opam = lazy (Bin.which ~path:(Env.path Env.initial) "opam")
 
 let opam_config_var ~env ~cache var =
-  match Hashtbl.find cache var with
+  match Table.find cache var with
   | Some _ as x -> Fiber.return x
   | None ->
     match Lazy.force opam with
@@ -152,12 +152,12 @@ let opam_config_var ~env ~cache var =
       >>| function
       | Ok s ->
         let s = String.trim s in
-        Hashtbl.set cache var s;
+        Table.set cache var s;
         Some s
       | Error _ -> None
 
 let which ~cache ~path x =
-  Hashtbl.find_or_add cache x ~f:(Bin.which ~path)
+  Table.find_or_add cache x ~f:(Bin.which ~path)
 
 let ocamlpath_sep =
   if Sys.cygwin then
@@ -208,15 +208,15 @@ let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain =
 
 let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
       ~host_context ~host_toolchain ~profile =
-  let opam_var_cache = Hashtbl.create 128 in
+  let opam_var_cache = Table.create (module String) 128 in
   (match kind with
    | Opam { root = Some root; _ } ->
-     Hashtbl.set opam_var_cache "root" root
+     Table.set opam_var_cache "root" root
    | _ -> ());
   let prog_not_found_in_path prog =
     Utils.program_not_found prog ~context:name ~loc:None
   in
-  let which_cache = Hashtbl.create 128 in
+  let which_cache = Table.create (module String) 128 in
   let which x = which ~cache:which_cache ~path x in
   let which_exn x =
     match which x with

src/context.mli

@@ -85,7 +85,7 @@ type t =
   ; (** Misc *)
     arch_sixtyfour : bool
 
-  ; opam_var_cache : (string, string) Hashtbl.t
+  ; opam_var_cache : (string, string) Table.t
 
   ; ocaml_config            : Ocaml_config.t
   ; version_string          : string
@@ -121,7 +121,7 @@ type t =
 
   ; supports_shared_libraries : Dynlink_supported.By_the_os.t
 
-  ; which_cache             : (string, Path.t option) Hashtbl.t
+  ; which_cache             : (string, Path.t option) Table.t
   ; lib_config : Lib_config.t
   }
 

src/dune_project.ml

@@ -376,16 +376,16 @@ module Extension = struct
         Univ_map.t * Stanza.Parser.t list
     }
 
-  let extensions = Hashtbl.create 32
+  let extensions = Table.create (module String) 32
 
   let register ?(experimental=false) syntax stanzas arg_to_dyn =
     let name = Syntax.name syntax in
-    if Hashtbl.mem extensions name then
+    if Table.mem extensions name then
       Code_error.raise "Dune_project.Extension.register: already registered"
         [ "name", Dyn.Encoder.string name ];
     let key = Univ_map.Key.create ~name arg_to_dyn in
     let ext = { syntax; stanzas; experimental; key } in
-    Hashtbl.add_exn extensions name (Extension ext);
+    Table.add_exn extensions name (Extension ext);
     key
 
   let register_simple ?experimental syntax stanzas =
@@ -399,12 +399,12 @@ module Extension = struct
     ()
 
   let instantiate ~loc ~parse_args (name_loc, name) (ver_loc, ver) =
-    match Hashtbl.find extensions name with
+    match Table.find extensions name with
     | None ->
       User_error.raise ~loc:name_loc
         [ Pp.textf "Unknown extension %S." name ]
         ~hints:(User_message.did_you_mean name
-                  ~candidates:(Hashtbl.keys extensions))
+                  ~candidates:(Table.keys extensions))
     | Some t ->
       Syntax.check_supported (syntax t) (ver_loc, ver);
       { extension = t
@@ -417,7 +417,7 @@ module Extension = struct
      automatically available at their latest version.  When used, dune
      will automatically edit the dune-project file. *)
   let automatic ~project_file ~f =
-    Hashtbl.foldi extensions ~init:[] ~f:(fun name extension acc ->
+    Table.foldi extensions ~init:[] ~f:(fun name extension acc ->
       if f name then
         let version =
           if is_experimental extension then

src/findlib.ml

@@ -165,7 +165,7 @@ type t =
   ; packages   : ( Lib_name.t
                  , ( Sub_system_info.t Dune_package.Lib.t
                    , Unavailable_reason.t) result
-                 ) Hashtbl.t
+                 ) Table.t
   }
 
 module Package = struct
@@ -381,7 +381,7 @@ end = struct
       let dir, res =
         parse_package db ~meta_file ~name:full_name ~parent_dir:dir ~vars
       in
-      Hashtbl.set db.packages full_name res;
+      Table.set db.packages full_name res;
       List.iter meta.subs ~f:(fun (meta : Meta.Simplified.t) ->
         let full_name =
           match meta.name with
@@ -426,23 +426,23 @@ let find_and_acknowledge_package t ~fq_name =
   in
   match loop t.paths with
   | None ->
-    Hashtbl.set t.packages root_name (Error Not_found)
+    Table.set t.packages root_name (Error Not_found)
   | Some (Findlib findlib_package) ->
     Meta_source.parse_and_acknowledge findlib_package t
   | Some (Dune pkg) ->
     List.iter pkg.libs ~f:(fun lib ->
-      Hashtbl.set t.packages (Dune_package.Lib.name lib) (Ok lib))
+      Table.set t.packages (Dune_package.Lib.name lib) (Ok lib))
 
 let find t name =
-  match Hashtbl.find t.packages name with
+  match Table.find t.packages name with
   | Some x -> x
   | None ->
     find_and_acknowledge_package t ~fq_name:name;
-    match Hashtbl.find t.packages name with
+    match Table.find t.packages name with
     | Some x -> x
     | None ->
       let res = Error Unavailable_reason.Not_found in
-      Hashtbl.set t.packages name res;
+      Table.set t.packages name res;
       res
 
 let available t name = Result.is_ok (find t name)
@@ -476,7 +476,7 @@ let load_all_packages t =
 
 let all_packages t =
   load_all_packages t;
-  Hashtbl.fold t.packages ~init:[] ~f:(fun x acc ->
+  Table.fold t.packages ~init:[] ~f:(fun x acc ->
     match x with
     | Ok p    -> p :: acc
     | Error _ -> acc)
@@ -486,12 +486,12 @@ let create ~stdlib_dir ~paths ~version =
   { stdlib_dir
   ; paths
   ; builtins = Meta.builtins ~stdlib_dir ~version
-  ; packages = Hashtbl.create 1024
+  ; packages = Table.create (module Lib_name) 1024
   }
 
 let all_unavailable_packages t =
   load_all_packages t;
-  Hashtbl.foldi t.packages ~init:[] ~f:(fun name x acc ->
+  Table.foldi t.packages ~init:[] ~f:(fun name x acc ->
     match x with
     | Ok    _ -> acc
     | Error e -> ((name, e) :: acc))

src/gen_rules.ml

@@ -367,15 +367,15 @@ let gen ~contexts
       Package.Name.Map.filter packages ~f:(fun { Package.name; _ } ->
         Package.Name.Set.mem pkgs name)
   in
-  let sctxs = Hashtbl.create 4 in
+  let sctxs = Table.create (module String) 4 in
   List.iter contexts ~f:(fun c ->
-    Hashtbl.add_exn sctxs c.Context.name (Fiber.Ivar.create ()));
+    Table.add_exn sctxs c.Context.name (Fiber.Ivar.create ()));
   let make_sctx (context : Context.t) : _ Fiber.t =
     let host () =
       match context.for_host with
       | None -> Fiber.return None
       | Some h ->
-        Fiber.Ivar.read (Hashtbl.find_exn sctxs h.name)
+        Fiber.Ivar.read (Table.find_exn sctxs h.name)
         >>| Option.some
     in
 
@@ -403,8 +403,7 @@ let gen ~contexts
     in
     let module P = struct let sctx = sctx end in
     let module M = Gen(P) in
-    let+ () =
-      Fiber.Ivar.fill (Hashtbl.find_exn sctxs context.name) sctx in
+    let+ () = Fiber.Ivar.fill (Table.find_exn sctxs context.name) sctx in
     (context.name, (module M : Gen))
   in
   let+ contexts = Fiber.parallel_map contexts ~f:make_sctx in

src/lib.ml

@@ -338,7 +338,7 @@ type status =
 type db =
   { parent               : db option
   ; resolve              : Lib_name.t -> resolve_result
-  ; table                : (Lib_name.t, status) Hashtbl.t
+  ; table                : (Lib_name.t, status) Table.t
   ; all                  : Lib_name.t list Lazy.t
   ; stdlib_dir           : Path.t
   }
@@ -929,10 +929,10 @@ end = struct
       let src_dir = Lib_info.src_dir info in
       Dep_stack.create_and_push stack name src_dir
     in
-    Option.iter (Hashtbl.find db.table name) ~f:(fun x ->
+    Option.iter (Table.find db.table name) ~f:(fun x ->
       already_in_table info name x);
     (* Add [id] to the table, to detect loops *)
-    Hashtbl.add_exn db.table name (St_initializing unique_id);
+    Table.add_exn db.table name (St_initializing unique_id);
 
     let status = Lib_info.status info in
     let allow_private_deps = Lib_info.Status.is_private status in
@@ -1063,11 +1063,11 @@ end = struct
       | Some reason ->
         St_hidden (t, src_dir, reason)
     in
-    Hashtbl.replace db.table ~key:name ~data:res;
+    Table.set db.table name res;
     res
 
   let find_internal db (name : Lib_name.t) ~stack : status =
-    match Hashtbl.find db.table name with
+    match Table.find db.table name with
     | Some x -> x
     | None   -> resolve_name db name ~stack
 
@@ -1088,7 +1088,7 @@ end = struct
         match find_internal db' name' ~stack with
         | St_initializing _ as x -> x
         | x ->
-          Hashtbl.add_exn db.table name x;
+          Table.add_exn db.table name x;
           x
       end
     | Found info ->
@@ -1099,7 +1099,7 @@ end = struct
         | None    -> St_not_found
         | Some db -> find_internal db name ~stack
       in
-      Hashtbl.add_exn db.table name res;
+      Table.add_exn db.table name res;
       res
     | Hidden (info, hidden) ->
       match
@@ -1108,7 +1108,7 @@ end = struct
         | Some db -> find_internal db name ~stack
       with
       | St_found _ as x ->
-        Hashtbl.add_exn db.table name x;
+        Table.add_exn db.table name x;
         x
       | _ ->
         instantiate db name info ~stack ~hidden:(Some hidden)
@@ -1464,7 +1464,7 @@ module DB = struct
   let create ?parent ~stdlib_dir ~resolve ~all () =
     { parent
     ; resolve
-    ; table  = Hashtbl.create 1024
+    ; table  = Table.create (module Lib_name) 1024
     ; all    = Lazy.from_fun all
     ; stdlib_dir
     }

src/lib_name.ml

@@ -85,6 +85,7 @@ let of_local (_loc, t) = t
 
 type t = string
 
+let hash = String.hash
 let compare = String.compare
 
 include (

src/lib_name.mli

@@ -2,6 +2,8 @@ open Stdune
 
 type t
 
+val hash : t -> int
+
 val of_string_exn : loc:Loc.t option -> string -> t
 val to_string : t -> string
 

src/opam_file.ml

@@ -129,11 +129,11 @@ module Create = struct
         ; "extra-files"
         |] in
       let table = lazy (
-        let table = Hashtbl.create (Array.length fields) in
-        Array.iteri fields ~f:(fun i field -> Hashtbl.add_exn table field i);
+        let table = Table.create (module String) (Array.length fields) in
+        Array.iteri fields ~f:(fun i field -> Table.add_exn table field i);
         table
       ) in
-      fun key -> Hashtbl.find (Lazy.force table) key
+      fun key -> Table.find (Lazy.force table) key
     in
     fun vars ->
       List.stable_sort vars ~compare:(fun (x, _) (y, _) ->