Deprecate polymorphic hashtbl

Author: hhugo

compiler/bin-js_of_ocaml/compile.ml

@@ -183,15 +183,15 @@ let run
         if not (Sys.file_exists file)
         then failwith (Printf.sprintf "export file %S does not exist" file);
         let ic = open_in_text file in
-        let t = Hashtbl.create 17 in
+        let t = String.Hashtbl.create 17 in
         (try
            while true do
-             Hashtbl.add t (String.trim (In_channel.input_line_exn ic)) ()
+             String.Hashtbl.add t (String.trim (In_channel.input_line_exn ic)) ()
            done;
            assert false
          with End_of_file -> ());
         close_in ic;
-        Some (Hashtbl.fold (fun cmi () acc -> cmi :: acc) t [])
+        Some (String.Hashtbl.fold (fun cmi () acc -> cmi :: acc) t [])
   in
   let runtime_files =
     if (not no_runtime) && (toplevel || dynlink)

compiler/lib-wasm/code_generation.ml

@@ -37,13 +37,13 @@ type constant_global =
   }
 
 type context =
-  { constants : (Var.t, W.expression) Hashtbl.t
+  { constants : W.expression Var.Hashtbl.t
   ; mutable data_segments : string Var.Map.t
   ; mutable constant_globals : constant_global Var.Map.t
   ; mutable other_fields : W.module_field list
   ; mutable imports : (Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t
-  ; type_names : (string, Var.t) Hashtbl.t
-  ; types : (Var.t, Wasm_ast.type_field) Hashtbl.t
+  ; type_names : Var.t String.Hashtbl.t
+  ; types : Wasm_ast.type_field Var.Hashtbl.t
   ; mutable closure_envs : Var.t Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Var.t IntMap.t
@@ -63,13 +63,13 @@ type context =
   }
 
 let make_context ~value_type =
-  { constants = Hashtbl.create 128
+  { constants = Var.Hashtbl.create 128
   ; data_segments = Var.Map.empty
   ; constant_globals = Var.Map.empty
   ; other_fields = []
   ; imports = StringMap.empty
-  ; type_names = Hashtbl.create 128
-  ; types = Hashtbl.create 128
+  ; type_names = String.Hashtbl.create 128
+  ; types = Var.Hashtbl.create 128
   ; closure_envs = Var.Map.empty
   ; apply_funs = IntMap.empty
   ; cps_apply_funs = IntMap.empty
@@ -126,7 +126,7 @@ let register_data_segment x v st =
 let get_context st = st.context, st
 
 let register_constant x e st =
-  Hashtbl.add st.context.constants x e;
+  Var.Hashtbl.add st.context.constants x e;
   (), st
 
 type type_def =
@@ -138,21 +138,21 @@ type type_def =
 let register_type nm gen_typ st =
   let context = st.context in
   let { supertype; final; typ }, st = gen_typ () st in
-  ( (try Hashtbl.find context.type_names nm
+  ( (try String.Hashtbl.find context.type_names nm
      with Not_found ->
        let name = Var.fresh_n nm in
        let type_field = { Wasm_ast.name; typ; supertype; final } in
        context.other_fields <- Type [ type_field ] :: context.other_fields;
-       Hashtbl.add context.type_names nm name;
-       Hashtbl.add context.types name type_field;
+       String.Hashtbl.add context.type_names nm name;
+       Var.Hashtbl.add context.types name type_field;
        name)
   , st )
 
 let rec type_index_sub ty ty' st =
   if Var.equal ty ty'
   then true, st
   else
-    let type_field = Hashtbl.find st.context.types ty in
+    let type_field = Var.Hashtbl.find st.context.types ty in
     match type_field.supertype with
     | None -> false, st
     | Some ty -> type_index_sub ty ty' st
@@ -168,20 +168,20 @@ let heap_type_sub (ty : W.heap_type) (ty' : W.heap_type) st =
   | (None_ | I31), I31 -> true, st
   | None_, None_ -> true, st
   | Type t, Struct ->
-      ( (let type_field = Hashtbl.find st.context.types t in
+      ( (let type_field = Var.Hashtbl.find st.context.types t in
          match type_field.typ with
          | Struct _ -> true
          | Array _ | Func _ -> false)
       , st )
   | Type t, Array ->
-      ( (let type_field = Hashtbl.find st.context.types t in
+      ( (let type_field = Var.Hashtbl.find st.context.types t in
          match type_field.typ with
          | Array _ -> true
          | Struct _ | Func _ -> false)
       , st )
   | Type t, Type t' -> type_index_sub t t' st
   | None_, Type t ->
-      ( (let type_field = Hashtbl.find st.context.types t in
+      ( (let type_field = Var.Hashtbl.find st.context.types t in
          match type_field.typ with
          | Struct _ | Array _ -> true
          | Func _ -> false)
@@ -282,7 +282,7 @@ let unit_name st = st.context.unit_name, st
 
 let var x st =
   try Var.Map.find x st.vars, st
-  with Not_found -> Expr (return (Hashtbl.find st.context.constants x)), st
+  with Not_found -> Expr (return (Var.Hashtbl.find st.context.constants x)), st
 
 let add_var ?typ x ({ var_count; vars; _ } as st) =
   match Var.Map.find_opt x vars with

compiler/lib-wasm/code_generation.mli

@@ -21,13 +21,13 @@ open Stdlib
 type constant_global
 
 type context =
-  { constants : (Code.Var.t, Wasm_ast.expression) Hashtbl.t
+  { constants : Wasm_ast.expression Code.Var.Hashtbl.t
   ; mutable data_segments : string Code.Var.Map.t
   ; mutable constant_globals : constant_global Code.Var.Map.t
   ; mutable other_fields : Wasm_ast.module_field list
   ; mutable imports : (Code.Var.t * Wasm_ast.import_desc) StringMap.t StringMap.t
-  ; type_names : (string, Code.Var.t) Hashtbl.t
-  ; types : (Code.Var.t, Wasm_ast.type_field) Hashtbl.t
+  ; type_names : Code.Var.t String.Hashtbl.t
+  ; types : Wasm_ast.type_field Code.Var.Hashtbl.t
   ; mutable closure_envs : Code.Var.t Code.Var.Map.t
         (** GC: mapping of recursive functions to their shared environment *)
   ; mutable apply_funs : Code.Var.t Stdlib.IntMap.t

compiler/lib-wasm/gc_target.ml

@@ -1068,7 +1068,7 @@ end
 module Closure = struct
   let get_free_variables ~context info =
     List.filter
-      ~f:(fun x -> not (Hashtbl.mem context.constants x))
+      ~f:(fun x -> not (Code.Var.Hashtbl.mem context.constants x))
       info.Closure_conversion.free_variables
 
   let rec is_last_fun l f =

compiler/lib-wasm/generate.ml

@@ -98,9 +98,9 @@ module Generate (Target : Target_sig.S) = struct
     | Int64 -> Memory.unbox_int64 e
 
   let specialized_primitives =
-    let h = Hashtbl.create 18 in
+    let h = String.Hashtbl.create 18 in
     List.iter
-      ~f:(fun (nm, typ) -> Hashtbl.add h nm typ)
+      ~f:(fun (nm, typ) -> String.Hashtbl.add h nm typ)
       [ "caml_int32_bswap", (`Pure, [ Int32 ], Int32)
       ; "caml_nativeint_bswap", (`Pure, [ Nativeint ], Nativeint)
       ; "caml_int64_bswap", (`Pure, [ Int64 ], Int64)
@@ -182,14 +182,14 @@ module Generate (Target : Target_sig.S) = struct
     | Pc c -> Constant.translate c
 
   let internal_primitives =
-    let h = Hashtbl.create 128 in
+    let h = String.Hashtbl.create 128 in
     List.iter
       ~f:(fun (nm, k, f) ->
-        Hashtbl.add h nm (k, fun _ _ transl_prim_arg l -> f transl_prim_arg l))
+        String.Hashtbl.add h nm (k, fun _ _ transl_prim_arg l -> f transl_prim_arg l))
       internal_primitives;
     h
 
-  let register_prim name k f = Hashtbl.add internal_primitives name (k, f)
+  let register_prim name k f = String.Hashtbl.add internal_primitives name (k, f)
 
   let invalid_arity name l ~expected =
     failwith
@@ -698,15 +698,20 @@ module Generate (Target : Target_sig.S) = struct
           Value.unit
     | Prim (p, l) -> (
         match p with
-        | Extern name when Hashtbl.mem internal_primitives name ->
-            snd (Hashtbl.find internal_primitives name) ctx context transl_prim_arg l
+        | Extern name when String.Hashtbl.mem internal_primitives name ->
+            snd
+              (String.Hashtbl.find internal_primitives name)
+              ctx
+              context
+              transl_prim_arg
+              l
         | _ -> (
             let l = List.map ~f:transl_prim_arg l in
             match p, l with
             | Extern name, l -> (
                 try
                   let ((_, arg_typ, res_typ) as typ) =
-                    Hashtbl.find specialized_primitives name
+                    String.Hashtbl.find specialized_primitives name
                   in
                   let* f = register_import ~name (Fun (specialized_primitive_type typ)) in
                   let rec loop acc arg_typ l =
@@ -1243,10 +1248,10 @@ module Generate (Target : Target_sig.S) = struct
   let init () =
     Primitive.register "caml_make_array" `Mutable None None;
     Primitive.register "caml_array_of_uniform_array" `Mutable None None;
-    Hashtbl.iter
+    String.Hashtbl.iter
       (fun name (k, _) -> Primitive.register name k None None)
       internal_primitives;
-    Hashtbl.iter
+    String.Hashtbl.iter
       (fun name (k, _, _) -> Primitive.register name k None None)
       specialized_primitives
 end

compiler/lib-wasm/link.ml

@@ -617,7 +617,7 @@ let link_to_directory ~files_to_link ~files ~enable_source_maps ~dir =
   runtime :: prelude :: List.map ~f:fst lst, (runtime_intf, List.map ~f:snd lst)
 
 let compute_dependencies ~files_to_link ~files =
-  let h = Hashtbl.create 128 in
+  let h = String.Hashtbl.create 128 in
   let i = ref 2 in
   List.filter_map
     ~f:(fun (file, (_, units)) ->
@@ -628,13 +628,13 @@ let compute_dependencies ~files_to_link ~files =
             ~f:(fun s { unit_info; _ } ->
               StringSet.fold
                 (fun unit_name s ->
-                  try IntSet.add (Hashtbl.find h unit_name) s with Not_found -> s)
+                  try IntSet.add (String.Hashtbl.find h unit_name) s with Not_found -> s)
                 unit_info.requires
                 s)
             ~init:IntSet.empty
             units
         in
-        List.iter ~f:(fun { unit_name; _ } -> Hashtbl.add h unit_name !i) units;
+        List.iter ~f:(fun { unit_name; _ } -> String.Hashtbl.add h unit_name !i) units;
         incr i;
         Some (Some (IntSet.elements s)))
       else None)

compiler/lib-wasm/wasm_link.ml

@@ -439,8 +439,8 @@ module Read = struct
     }
 
   type index =
-    { sections : (int, section) Hashtbl.t
-    ; custom_sections : (string, section) Hashtbl.t
+    { sections : section Int.Hashtbl.t
+    ; custom_sections : section String.Hashtbl.t
     }
 
   let next_section ch =
@@ -454,14 +454,16 @@ module Read = struct
   let skip_section ch { pos; size; _ } = seek_in ch (pos + size)
 
   let index ch =
-    let index = { sections = Hashtbl.create 16; custom_sections = Hashtbl.create 16 } in
+    let index =
+      { sections = Int.Hashtbl.create 16; custom_sections = String.Hashtbl.create 16 }
+    in
     let rec loop () =
       match next_section ch with
       | None -> index
       | Some sect ->
           if sect.id = 0
-          then Hashtbl.add index.custom_sections (name ch) sect
-          else Hashtbl.add index.sections sect.id sect;
+          then String.Hashtbl.add index.custom_sections (name ch) sect
+          else Int.Hashtbl.add index.sections sect.id sect;
           skip_section ch sect;
           loop ()
     in
@@ -480,14 +482,14 @@ module Read = struct
     { ch; type_mapping = [||]; type_index_count = 0; index = index ch }
 
   let find_section contents n =
-    match Hashtbl.find contents.index.sections n with
+    match Int.Hashtbl.find contents.index.sections n with
     | { pos; _ } ->
         seek_in contents.ch pos;
         true
     | exception Not_found -> false
 
   let get_custom_section contents name =
-    Hashtbl.find_opt contents.index.custom_sections name
+    String.Hashtbl.find_opt contents.index.custom_sections name
 
   let focus_on_custom_section contents section =
     let pos, limit =
@@ -1866,7 +1868,7 @@ let rec resolve
     ~kind
     i
     ({ module_; name; _ } as import) =
-  let i', index = Hashtbl.find exports (module_, name) in
+  let i', index = Poly.Hashtbl.find exports (module_, name) in
   let imports = get_exportable_info intfs.(i').Read.imports kind in
   if index < Array.length imports
   then (
@@ -1911,22 +1913,22 @@ let f files ~output_file =
   add_section out_ch ~id:1 buf;
 
   (* 2: import *)
-  let exports = init_exportable_info (fun _ -> Hashtbl.create 128) in
+  let exports = init_exportable_info (fun _ -> Poly.Hashtbl.create 128) in
   Array.iteri
     ~f:(fun i intf ->
       iter_exportable_info
         (fun kind lst ->
           let h = get_exportable_info exports kind in
           List.iter
             ~f:(fun (name, index) ->
-              Hashtbl.add h (files.(i).module_name, name) (i, index))
+              Poly.Hashtbl.add h (files.(i).module_name, name) (i, index))
             lst)
         intf.Read.exports)
     intfs;
   let import_list = ref [] in
   let unresolved_imports = make_exportable_info 0 in
   let resolved_imports =
-    let tbl = Hashtbl.create 128 in
+    let tbl = Poly.Hashtbl.create 128 in
     Array.mapi
       ~f:(fun i intf ->
         map_exportable_info
@@ -1937,12 +1939,12 @@ let f files ~output_file =
                 match resolve 0 ~files ~intfs ~subtyping_info ~exports ~kind i import with
                 | i', idx -> Resolved (i', idx)
                 | exception Not_found -> (
-                    match Hashtbl.find tbl import with
+                    match Poly.Hashtbl.find tbl import with
                     | status -> status
                     | exception Not_found ->
                         let idx = get_exportable_info unresolved_imports kind in
                         let status = Unresolved idx in
-                        Hashtbl.replace tbl import status;
+                        Poly.Hashtbl.replace tbl import status;
                         set_exportable_info unresolved_imports kind (1 + idx);
                         import_list := import :: !import_list;
                         status))
@@ -2149,7 +2151,7 @@ let f files ~output_file =
       intfs
   in
   Write.uint buf export_count;
-  let exports = Hashtbl.create 128 in
+  let exports = String.Hashtbl.create 128 in
   Array.iteri
     ~f:(fun i intf ->
       iter_exportable_info
@@ -2164,7 +2166,7 @@ let f files ~output_file =
           in
           List.iter
             ~f:(fun (name, idx) ->
-              match Hashtbl.find exports name with
+              match String.Hashtbl.find exports name with
               | i' ->
                   failwith
                     (Printf.sprintf
@@ -2173,7 +2175,7 @@ let f files ~output_file =
                        files.(i').file
                        files.(i).file)
               | exception Not_found ->
-                  Hashtbl.add exports name i;
+                  String.Hashtbl.add exports name i;
                   Write.export buf kind name map.(idx))
             lst)
         intf.Read.exports)