[src][state] expose location_dependencies through state.file_infos

Rather than  adding a `signature` field to the state to hold a
`uid_to_loc` table to then use in `DeadCode.load_file` to convert uids
into locations, to then convert `cmt_declaration_dependencies` into
a list of pairs of locations, directly construct that list and store
along with the `file_infos`. This move  is more consistent with the
nature, usage and provenance of the information : it is created using
info in `cmt_infos` and `cmti_infos` to replace the
`cmt_value_dependencies` field that existed prior to OCaml 5.3, and
should only live as long the corresponding `cmt_infos` live.

Author: fantazio

src/deadCode.ml

@@ -460,30 +460,17 @@ let rec load_file state fn =
     init_and_continue state fn (fun state ->
     match state.file_infos.cmt_infos with
     | None -> bad_files := fn :: !bad_files
-    | Some ({cmt_annots = Implementation x; _} as cmt_infos) ->
+    | Some {cmt_annots = Implementation x; _} ->
         regabs state;
-        let uid_decl_dep_to_loc_pair (_dep_kind, uid_def, uid_decl) =
-          let ( let* ) x f = Option.bind x f in
-          let loc_opt_of_uid uid =
-            Uid.Tbl.find_opt state.signature.uid_to_loc uid
-          in
-          let* def_loc = loc_opt_of_uid uid_def in
-          let* decl_loc = loc_opt_of_uid uid_decl in
-          Some (def_loc, decl_loc)
-        in
-        let value_dep =
-          cmt_infos.cmt_declaration_dependencies
-          |> List.filter_map uid_decl_dep_to_loc_pair
-        in
         let prepare (loc1, loc2) =
           DeadObj.add_equal loc1 loc2;
           VdNode.merge_locs ~force:true loc2 loc1
         in
-        List.iter prepare value_dep;
+        List.iter prepare state.file_infos.location_dependencies;
         ignore (collect_references.Tast_mapper.structure collect_references x);
         let loc_dep =
           if !DeadFlag.exported.DeadFlag.print then
-              value_dep
+              state.file_infos.location_dependencies
           else []
         in
         eof loc_dep

src/state/file_infos.ml

@@ -1,21 +1,23 @@
 type t = {
-  cm_file : string;
-  sourcepath : string option;
   builddir : string;
-  modname : string;
+  cm_file : string;
   cmi_infos : Cmi_format.cmi_infos option;
   cmt_infos : Cmt_format.cmt_infos option;
   cmti_infos : Cmt_format.cmt_infos option;
+  location_dependencies : Location_dependencies.t;
+  modname : string;
+  sourcepath : string option;
 }
 
 let empty = {
-  cm_file = "";
-  sourcepath = None;
   builddir = "!!UNKNOWN_BUILDDIR!!";
-  modname = "!!UNKNOWN_MODNAME!!";
+  cm_file = "";
   cmi_infos = None;
   cmt_infos = None;
   cmti_infos = None;
+  location_dependencies = Location_dependencies.empty;
+  modname = "!!UNKNOWN_MODNAME!!";
+  sourcepath = None;
 }
 
 (** [init_from_all_cm_infos ~orig ~cm_file cmi_infos cmt_infos] creates a [t] with:
@@ -35,7 +37,13 @@ let empty = {
     | `Cmt -> Some cmt_infos, None
     | `Cmti -> None, Some cmt_infos
   in
-  {cm_file; sourcepath; builddir; modname; cmi_infos; cmt_infos; cmti_infos}
+  {empty with builddir;
+              cm_file;
+              cmi_infos;
+              cmt_infos;
+              cmti_infos;
+              modname;
+              sourcepath}
 
 (** [init_from_cm_file ~orig cm_file] returns an [Ok t] with [t] filled using
     the [cm_file] (see [init_from_cmt_infos]).
@@ -80,7 +88,15 @@ let init cm_file =
         in
         file_infos.cmi_infos, cmt_infos, file_infos.cmti_infos
   in
-  Result.ok {file_infos with cmi_infos; cmt_infos; cmti_infos}
+  let* location_dependencies =
+    match orig with
+    | `Cmt -> Location_dependencies.init cmt_infos cmti_infos
+    | `Cmti -> Result.ok Location_dependencies.empty
+  in
+  Result.ok {file_infos with cmi_infos;
+                             cmt_infos;
+                             cmti_infos;
+                             location_dependencies}
 
 let change_file file_infos cm_file =
   let no_ext = Filename.remove_extension cm_file in
@@ -90,7 +106,11 @@ let change_file file_infos cm_file =
       let res =
         init_from_all_cm_infos ~orig:`Cmt ~cm_file cmi_infos cmt_infos
       in
-      Result.ok {res with cmi_infos; cmti_infos}
+      let res = {res with cmi_infos; cmti_infos} in
+      let* location_dependencies =
+        Location_dependencies.init res.cmt_infos res.cmti_infos
+      in
+      Result.ok {res with location_dependencies}
   | ".cmti", {cmti_infos=Some cmti_infos; cmi_infos; cmt_infos; _} ->
       let res =
         init_from_all_cm_infos ~orig:`Cmti ~cm_file cmi_infos cmti_infos

src/state/file_infos.mli

@@ -1,13 +1,15 @@
 (** Information about a analyzable file ([.cmti] or [.cmt] file) *)
 
 type t = {
-  cm_file : string; (** The filepath currently analyzed *)
-  sourcepath : string option; (** The path to the associated source file *)
   builddir : string; (** The [cmt_builddir] *)
-  modname : string; (** Either [cmti_name] or [cmt_modname] *)
+  cm_file : string; (** The filepath currently analyzed *)
   cmi_infos : Cmi_format.cmi_infos option;
   cmt_infos : Cmt_format.cmt_infos option;
   cmti_infos : Cmt_format.cmt_infos option;
+  location_dependencies : Location_dependencies.t;
+    (** Dependencies similar to [cmt_infos.cmt_value_dependencies] in OCaml 5.2 *)
+  modname : string; (** Either [cmti_name] or [cmt_modname] *)
+  sourcepath : string option; (** The path to the associated source file *)
 }
 
 val empty : t (** No file info *)

src/state/location_dependencies.ml

@@ -0,0 +1,79 @@
+type t = (Lexing.position * Lexing.position) list
+
+let empty = []
+
+module UidTbl = Shape.Uid.Tbl
+
+let fill_from_structure (structure : Typedtree.structure) res_uid_to_loc =
+  let open Types in
+  let rec fill_from_signature_item = function
+    | Sig_value (_, {val_loc; val_uid; _}, _) ->
+        UidTbl.replace res_uid_to_loc val_uid val_loc.loc_start
+    | Sig_module (_, _, {md_type = modtype; _}, _, _)
+    | Sig_modtype (_, {mtd_type = Some modtype; _}, _) ->
+        Utils.signature_of_modtype modtype
+        |> fill_from_signature
+    | _ -> ()
+  and fill_from_signature s =
+    List.iter fill_from_signature_item s
+  in
+  let iterator =
+    let super = Tast_iterator.default_iterator in
+    let structure_item self struct_item =
+      let open Typedtree in
+      begin match struct_item.str_desc with
+      | Tstr_include {incl_type; _} -> fill_from_signature incl_type
+      | _ -> ()
+      end;
+      super.Tast_iterator.structure_item self struct_item
+    in
+    {super with structure_item}
+  in
+  iterator.structure iterator structure;
+  res_uid_to_loc
+
+let fill_from_cmt_infos cmt_infos res_uid_to_loc =
+  let open Typedtree in
+  let loc_of_item_decl = function
+    | Value {val_loc = loc; _}
+    | Value_binding {vb_pat = {pat_loc = loc; _}; _} ->
+        Some loc.loc_start
+    | _ -> None
+  in
+  let add_uid_loc uid item_decl =
+    let loc = loc_of_item_decl item_decl in
+    Option.iter (UidTbl.replace res_uid_to_loc uid) loc
+  in
+  UidTbl.iter add_uid_loc cmt_infos.Cmt_format.cmt_uid_to_decl;
+  res_uid_to_loc
+
+let cmt_decl_dep_to_loc_dep cmt_decl_dep uid_to_loc =
+  let convert_pair (_dep_kind, uid_def, uid_decl) =
+    let ( let* ) x f = Option.bind x f in
+    let loc_opt_of_uid uid =
+      UidTbl.find_opt uid_to_loc uid
+    in
+    let* def_loc = loc_opt_of_uid uid_def in
+    let* decl_loc = loc_opt_of_uid uid_decl in
+    Some (def_loc, decl_loc)
+  in
+  List.filter_map convert_pair cmt_decl_dep
+
+let init cmt_infos cmti_infos =
+  match cmt_infos with
+  | None -> Result.error "No cmt_infos available"
+  | Some (Cmt_format.{cmt_annots = Implementation structure; _} as cmt_infos) -> (
+      let fill_from_cmti_infos tbl =
+        match cmti_infos with
+        | None -> tbl
+        | Some cmti_infos -> fill_from_cmt_infos cmti_infos tbl
+      in
+      (* TODO: Evaluate a generally good size for the tbl ? *)
+      UidTbl.create 512
+      |> fill_from_structure structure
+      |> fill_from_cmt_infos cmt_infos
+      |> fill_from_cmti_infos
+      |> cmt_decl_dep_to_loc_dep cmt_infos.cmt_declaration_dependencies
+      |> Result.ok
+  )
+  | Some _ -> Result.error "No implementation found in cmt_infos"

src/state/location_dependencies.mli

@@ -0,0 +1,12 @@
+type t = (Lexing.position * Lexing.position) list
+    (** Dependencies similar to [cmt_infos.cmt_value_dependencies] in OCaml 5.2 *)
+
+val empty : t (** No signature read *)
+
+val init : Cmt_format.cmt_infos option -> Cmt_format.cmt_infos option -> (t, string) result
+(** [init cmt_infos cmti_infos] expects [cmt_infos = Some _].
+    It reads the [cmt_infos] and the |cmti_infos] to retrieve their
+    [cmt_declaration_dependencies] and convert them into a single [t].
+    It returns an [Ok t] with [t] on success.
+    In case the [cmt_infos] is missing or does not contain an implementation,
+    it returns an [Err msg] with msg a string describing the issue. *)

src/state/signature.ml

@@ -2,19 +2,16 @@ module File_infos = File_infos
 
 type t = {
   file_infos : File_infos.t;
-  signature : Signature.t
 }
 
 let empty = {
   file_infos = File_infos.empty;
-  signature = Signature.empty ();
 }
 
 let init cm_file =
   let ( let* ) x f = Result.bind x f in
   let* file_infos = File_infos.init cm_file in
-  let* signature = Signature.init file_infos in
-  Result.ok {file_infos; signature}
+  Result.ok {file_infos}
 
 let change_file state cm_file =
   let file_infos = state.file_infos in
@@ -27,7 +24,7 @@ let change_file state cm_file =
     Result.ok state
   else if equal_no_ext file_infos.cm_file cm_file then
     let file_infos = File_infos.change_file file_infos cm_file in
-    Result.map (fun file_infos -> {state with file_infos}) file_infos
+    Result.map (fun file_infos -> {file_infos}) file_infos
   else
     init cm_file
 

src/state/signature.mli

@@ -4,15 +4,13 @@ module File_infos = File_infos
 
 type t = {
   file_infos : File_infos.t; (** Info about the file being analyzed *)
-  signature : Signature.t; (** Data extracted or built using the current
-                               compiltion unit's signature *)
 }
 
 val empty : t (** The empty state *)
 
 val init : string -> (t, string) result
 (** [init cmti_file] initialize a state to analyze [cmti_file].
-    See [File_infos.init] for error cases. *)
+    See the fields respective [init]s for error cases. *)
 
 val change_file : t -> string -> (t, string) result
 (** [cahnge_file t cmti_file] prepare the analysis to move on to [cmti_file].