Deprecate List.mem/assoc

hhugo · hhugo · commit 13948f4e1241 · 2025-05-14T13:20:46.000+02:00
diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml
@@ -45,7 +45,7 @@ let normalize_effects (effects : [ `Cps | `Double_translation ] option) common :
   | None ->
       (* For backward compatibility, consider that [--enable effects] alone means
          [--effects cps] *)
-      if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable
+      if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable
       then `Cps
       else `Disabled
   | Some ((`Cps | `Double_translation) as e) -> (e :> Config.effects_backend)
diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml
@@ -196,7 +196,7 @@ let run
   let runtime_files =
     if (not no_runtime) && (toplevel || dynlink)
     then
-      let add_if_absent x l = if List.mem x ~set:l then l else x :: l in
+      let add_if_absent x l = if List.mem ~eq:String.equal x l then l else x :: l in
       runtime_files_from_cmdline
       |> add_if_absent "+toplevel.js"
       |> add_if_absent "+dynlink.js"
diff --git a/compiler/bin-wasm_of_ocaml/cmd_arg.ml b/compiler/bin-wasm_of_ocaml/cmd_arg.ml
@@ -44,7 +44,9 @@ let normalize_effects (effects : [ `Cps | `Jspi ] option) common : Config.effect
   | None ->
       (* For backward compatibility, consider that [--enable effects] alone means
         [--effects cps] *)
-      if List.mem "effects" ~set:common.Jsoo_cmdline.Arg.optim.enable then `Cps else `Jspi
+      if List.mem ~eq:String.equal "effects" common.Jsoo_cmdline.Arg.optim.enable
+      then `Cps
+      else `Jspi
   | Some ((`Cps | `Jspi) as e) -> e
 
 type t =
diff --git a/compiler/bin-wasm_of_ocaml/compile.ml b/compiler/bin-wasm_of_ocaml/compile.ml
@@ -58,7 +58,11 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
       ; sourceroot =
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
       ; ignore_list =
-          (if List.mem Wasm_source_map.blackbox_filename ~set:source_map.sources
+          (if
+             List.mem
+               ~eq:String.equal
+               Wasm_source_map.blackbox_filename
+               source_map.sources
            then [ Wasm_source_map.blackbox_filename ]
            else [])
       }
diff --git a/compiler/lib-cmdline/arg.ml b/compiler/lib-cmdline/arg.ml
@@ -96,7 +96,9 @@ let t =
           let enable = if debuginfo then "debuginfo" :: enable else enable in
           let disable = if noinline then "inline" :: disable else disable in
           let disable_if_pretty name disable =
-            if pretty && not (List.mem name ~set:enable) then name :: disable else disable
+            if pretty && not (List.mem ~eq:String.equal name enable)
+            then name :: disable
+            else disable
           in
           let disable = disable_if_pretty "shortvar" disable in
           let disable = disable_if_pretty "share" disable in
diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml
@@ -1085,7 +1085,7 @@ module Closure = struct
         (List.exists
            ~f:(fun x -> Code.Var.Set.mem x context.globalized_variables)
            free_variables));
-    let arity = List.assoc f info.functions in
+    let _, arity = List.find ~f:(fun (f', _) -> Code.Var.equal f f') info.functions in
     let arity = if cps then arity - 1 else arity in
     let* curry_fun = if arity > 1 then need_curry_fun ~cps ~arity else return f in
     if List.is_empty free_variables
@@ -1200,7 +1200,7 @@ module Closure = struct
       let* _ = add_var (Code.Var.fresh ()) in
       return ()
     else
-      let arity = List.assoc f info.functions in
+      let _, arity = List.find ~f:(fun (f', _) -> Code.Var.equal f f') info.functions in
       let arity = if cps then arity - 1 else arity in
       let offset = Memory.env_start arity in
       match info.Closure_conversion.functions with
diff --git a/compiler/lib-wasm/generate.ml b/compiler/lib-wasm/generate.ml
@@ -1262,20 +1262,26 @@ let fix_switch_branches p =
         then
           l.(i) <-
             ( (let l = try Addr.Map.find pc !updates with Not_found -> [] in
-               try List.assoc args l
-               with Not_found ->
-                 let pc' = !p'.free_pc in
-                 p' :=
-                   { !p' with
-                     blocks =
-                       Addr.Map.add
-                         pc'
-                         { params = []; body = []; branch = Branch cont }
-                         !p'.blocks
-                   ; free_pc = pc' + 1
-                   };
-                 updates := Addr.Map.add pc ((args, pc') :: l) !updates;
-                 pc')
+               match
+                 List.find_map
+                   ~f:(fun (args', pc') ->
+                     if List.equal ~eq:Var.equal args' args then Some pc' else None)
+                   l
+               with
+               | Some x -> x
+               | None ->
+                   let pc' = !p'.free_pc in
+                   p' :=
+                     { !p' with
+                       blocks =
+                         Addr.Map.add
+                           pc'
+                           { params = []; body = []; branch = Branch cont }
+                           !p'.blocks
+                     ; free_pc = pc' + 1
+                     };
+                   updates := Addr.Map.add pc ((args, pc') :: l) !updates;
+                   pc')
             , [] ))
       l
   in
diff --git a/compiler/lib-wasm/runtime.ml b/compiler/lib-wasm/runtime.ml
@@ -24,7 +24,7 @@ let build ~allowed_imports ~link_options ~opt_options ~variables ~inputs ~output
       let missing_imports =
         List.filter
           ~f:(fun { Link.Wasm_binary.module_; _ } ->
-            not (List.mem module_ ~set:allowed_imports))
+            not (List.mem ~eq:String.equal module_ allowed_imports))
           imports
       in
       if not (List.is_empty missing_imports)
diff --git a/compiler/lib-wasm/wasm_source_map.ml b/compiler/lib-wasm/wasm_source_map.ml
@@ -153,7 +153,7 @@ let insert_source_contents' (sm : Source_map.Standard.t) i f =
   in
   let sm = { sm with sources_content = Some contents } in
   let sm =
-    if List.mem blackbox_filename ~set:sm.sources
+    if List.mem ~eq:String.equal blackbox_filename sm.sources
     then { sm with ignore_list = [ blackbox_filename ] }
     else sm
   in
diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml
@@ -26,29 +26,34 @@ module Flag = struct
 
   let o ~name ~default =
     let state =
-      try List.assoc name !optims
-      with Not_found ->
-        let state = ref default in
-        optims := (name, state) :: !optims;
-        state
+      match List.string_assoc name !optims with
+      | Some x -> x
+      | None ->
+          let state = ref default in
+          optims := (name, state) :: !optims;
+          state
     in
     fun () -> !state
 
   let find s =
-    try !(List.assoc s !optims)
-    with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
+    match List.string_assoc s !optims with
+    | Some x -> !x
+    | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
 
   let set s b =
-    try List.assoc s !optims := b
-    with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
+    match List.string_assoc s !optims with
+    | Some s -> s := b
+    | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
 
   let disable s =
-    try List.assoc s !optims := false
-    with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
+    match List.string_assoc s !optims with
+    | Some s -> s := false
+    | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
 
   let enable s =
-    try List.assoc s !optims := true
-    with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
+    match List.string_assoc s !optims with
+    | Some s -> s := true
+    | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
 
   let pretty = o ~name:"pretty" ~default:false
 
@@ -107,13 +112,18 @@ module Param = struct
   let int default = default, int_of_string
 
   let enum : (string * 'a) list -> _ = function
-    | (_, v) :: _ as l -> v, fun x -> List.assoc x l
+    | (_, v) :: _ as l -> (
+        ( v
+        , fun x ->
+            match List.string_assoc x l with
+            | Some x -> x
+            | None -> assert false ))
     | _ -> assert false
 
   let params : (string * _) list ref = ref []
 
   let p ~name ~desc (default, convert) =
-    assert (not (List.mem_assoc name ~map:!params));
+    assert (Option.is_none (List.string_assoc name !params));
     let state = ref default in
     let set : string -> unit =
      fun v ->
@@ -124,8 +134,9 @@ module Param = struct
     fun () -> !state
 
   let set s v =
-    try fst (List.assoc s !params) v
-    with Not_found -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
+    match List.string_assoc s !params with
+    | Some (f, _) -> f v
+    | None -> failwith (Printf.sprintf "The option named %S doesn't exist" s)
 
   let all () = List.map !params ~f:(fun (n, (_, d)) -> n, d)
 
diff --git a/compiler/lib/debug.ml b/compiler/lib/debug.ml
@@ -48,20 +48,23 @@ let available () = List.map !debugs ~f:fst
 
 let find ?(even_if_quiet = false) s =
   let state =
-    try List.assoc s !debugs
-    with Not_found ->
-      let state = ref false in
-      debugs := (s, state) :: !debugs;
-      state
+    match List.string_assoc s !debugs with
+    | Some s -> s
+    | None ->
+        let state = ref false in
+        debugs := (s, state) :: !debugs;
+        state
   in
   fun () ->
     if String.equal s "times" then take_snapshot ();
     (even_if_quiet || not !quiet) && !state
 
 let enable s =
-  try List.assoc s !debugs := true
-  with Not_found -> failwith (Printf.sprintf "The debug named %S doesn't exist" s)
+  match List.string_assoc s !debugs with
+  | Some s -> s := true
+  | None -> failwith (Printf.sprintf "The debug named %S doesn't exist" s)
 
 let disable s =
-  try List.assoc s !debugs := false
-  with Not_found -> failwith (Printf.sprintf "The debug named %S doesn't exist" s)
+  match List.string_assoc s !debugs with
+  | Some s -> s := false
+  | None -> failwith (Printf.sprintf "The debug named %S doesn't exist" s)
diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml
@@ -736,4 +736,4 @@ let from_string ~prims ~debug s formatter =
 
 let profiles = [ 1, O1; 2, O2; 3, O3 ]
 
-let profile i = try Some (List.assoc i profiles) with Not_found -> None
+let profile i = List.find_map ~f:(fun (i', p) -> if i = i' then Some p else None) profiles
diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml
@@ -2055,7 +2055,7 @@ and compile_conditional st queue ~fall_through loc last scope_stack : _ * _ =
                   J.N
               in
               let instrs, queue =
-                if List.mem x ~set:(snd e1)
+                if List.mem ~eq:Var.equal x (snd e1)
                 then (
                   assert (n = 1);
                   enqueue [] const_p x wrapped_exn J.U None [])
@@ -2128,7 +2128,9 @@ and compile_argument_passing ctx loc queue (pc, args) back_edge continuation =
     parallel_renaming ctx loc back_edge block.params args continuation queue
 
 and compile_branch st loc queue ((pc, _) as cont) scope_stack ~fall_through : bool * _ =
-  let scope = List.assoc_opt pc scope_stack in
+  let scope =
+    List.find_map ~f:(fun (pc', x) -> if pc = pc' then Some x else None) scope_stack
+  in
   let back_edge =
     List.exists
       ~f:(function
diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
@@ -441,7 +441,7 @@ let propagate st ~update approx x =
                     when n < Array.length a
                          &&
                          match tags with
-                         | Some tags -> List.memq t ~set:tags
+                         | Some tags -> List.mem ~eq:Int.equal t tags
                          | None -> true ->
                       let t = a.(n) in
                       let m = Var.ISet.mem st.possibly_mutable z in
diff --git a/compiler/lib/inline.ml b/compiler/lib/inline.ml
@@ -70,7 +70,7 @@ let simple_function blocks size name params pc =
             | None -> ()
             | Some (Let (y, Apply { f; _ })) ->
                 (* track if some params are called in tail position *)
-                if Code.Var.equal x y && List.mem f ~set:params
+                if Code.Var.equal x y && List.mem ~eq:Var.equal f params
                 then tc := Var.Set.add f !tc
             | Some _ -> ())
         | Branch _ | Cond _ | Switch _ -> ());
diff --git a/compiler/lib/linker.ml b/compiler/lib/linker.ml
@@ -449,7 +449,7 @@ let list_all ?from () =
   let include_ =
     match from with
     | None -> fun _ _ -> true
-    | Some l -> fun fn _nm -> List.mem fn ~set:l
+    | Some l -> fun fn _nm -> List.mem ~eq:String.equal fn l
   in
   Hashtbl.fold
     (fun nm p set -> if include_ p.filename nm then StringSet.add nm set else set)
@@ -460,7 +460,7 @@ let list_all_with_aliases ?from () =
   let include_ =
     match from with
     | None -> fun _ _ -> true
-    | Some l -> fun fn _nm -> List.mem fn ~set:l
+    | Some l -> fun fn _nm -> List.mem ~eq:String.equal fn l
   in
   Hashtbl.fold
     (fun nm p map ->
@@ -638,7 +638,7 @@ let rec resolve_dep_name_rev state path nm =
 and resolve_dep_id_rev state path id =
   if IntSet.mem id state.ids
   then (
-    if List.memq id ~set:path
+    if List.mem ~eq:Int.equal id path
     then
       error
         "circular dependency: %s"
@@ -669,7 +669,7 @@ let init ?from () =
   let include_ =
     match from with
     | None -> fun _ -> true
-    | Some l -> fun fn -> List.mem fn ~set:l
+    | Some l -> fun fn -> List.mem ~eq:String.equal fn l
   in
   { ids = IntSet.empty
   ; always_required_codes =
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
@@ -2644,7 +2644,7 @@ let from_exe
       true
     with Not_found -> (
       match exported_unit with
-      | Some l -> List.mem s ~set:l
+      | Some l -> List.mem ~eq:String.equal s l
       | None -> true)
   in
   let crcs = List.filter ~f:(fun (unit, _crc) -> keep unit) orig_crcs in
diff --git a/compiler/lib/pseudo_fs.ml b/compiler/lib/pseudo_fs.ml
@@ -33,8 +33,8 @@ let expand_path exts real virt =
             let b = Filename.basename realfile in
             let i = String.rindex b '.' in
             let e = String.sub b ~pos:(i + 1) ~len:(String.length b - i - 1) in
-            List.mem e ~set:exts
-          with Not_found -> List.mem "" ~set:exts
+            List.mem ~eq:String.equal e exts
+          with Not_found -> List.mem ~eq:String.equal "" exts
         in
         if List.is_empty exts || exmatch then (virtfile, realfile) :: acc else acc
       with exc ->
diff --git a/compiler/lib/source_map.ml b/compiler/lib/source_map.ml
diff --git a/compiler/lib/specialize.ml b/compiler/lib/specialize.ml
diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml
diff --git a/compiler/lib/stdlib.ml b/compiler/lib/stdlib.ml
diff --git a/compiler/lib/strongly_connected_components.ml b/compiler/lib/strongly_connected_components.ml
