Simplify and strenghten the representation of file infos

src/deadCode.ml

@@ -327,7 +327,7 @@ let regabs state =
     hashtbl_add_unique_to_list main_files (Utils.Filepath.unit fn) ()
 
 
-let read_interface fn (sign : State.File_infos.signature) state =
+let read_interface fn export_collector state =
   regabs state;
   if Config.must_report_main state.config then
     let comp_unit =
@@ -341,12 +341,7 @@ let read_interface fn (sign : State.File_infos.signature) state =
       |> Ident.create_persistent
     in
     let path = [module_id] in
-    begin match sign with
-    | Structure structure ->
-        DeadSign.collect_export_from_structure ~path ~comp_unit structure
-    | Signature signature ->
-        DeadSign.collect_export_from_signature ~path ~comp_unit signature
-    end;
+    export_collector ~path ~comp_unit;
     last_loc := Lexing.dummy_pos
 
 
@@ -429,30 +424,34 @@ let load_file fn state =
   in
   let process_interface fn =
     last_loc := Lexing.dummy_pos;
-      if state.State.config.verbose then
-        Printf.eprintf "Scanning interface from %s\n%!" fn;
+    if state.State.config.verbose then
+      Printf.eprintf "Scanning interface from %s\n%!" fn;
     init_and_continue state fn (fun state ->
-    match state.file_infos.signature with
-    | None -> report_error (fn ^ ": missing signature")
-    | Some sign ->
-        read_interface fn sign state
+    match state.file_infos.cm_infos with
+    | Neither -> report_error (fn ^ ": missing signature")
+    | Cmti {sign; _} | Cmt {sign = Some sign; _} ->
+        let export_collector = DeadSign.collect_export_from_signature sign in
+        read_interface fn export_collector state
+    | Cmt {strc; _} ->
+        let export_collector = DeadSign.collect_export_from_structure strc in
+        read_interface fn export_collector state
     )
   in
   let process_implementation fn =
     last_loc := Lexing.dummy_pos;
     if state.State.config.verbose then
       Printf.eprintf "Scanning implementation from %s\n%!" fn;
     init_and_continue state fn (fun state ->
-    match state.file_infos.cmt_struct with
-    | None -> report_error (fn ^ ": missing cmt_struct")
-    | Some structure ->
+    match state.file_infos.cm_infos with
+    | Neither | Cmti _ -> report_error (fn ^ ": missing structure")
+    | Cmt {strc; location_dependencies; _} ->
         regabs state;
         let prepare (loc1, loc2) =
           DeadObj.add_equal loc1 loc2;
           VdNode.merge_locs ~force:true loc2 loc1
         in
-        List.iter prepare state.file_infos.location_dependencies;
-        collect_references.Tast_mapper.structure collect_references structure
+        List.iter prepare location_dependencies;
+        collect_references.Tast_mapper.structure collect_references strc
         |> ignore;
         let loc_dep =
           if Config.must_report_section state.config.sections.exported_values then
@@ -468,7 +467,7 @@ let load_file fn state =
                    Some (loc1, loc2)
                  else None
               )
-              state.file_infos.location_dependencies
+              location_dependencies
           else []
         in
         eof loc_dep

src/deadSign.ml

@@ -258,8 +258,8 @@ let rec collect_export_from_include ~path sig_item =
 
 let correct_export sig_item =
   let state = State.get_current () in
-  match state.file_infos.signature with
-  | Some (Signature _) ->
+  match state.file_infos.cm_infos with
+  | Cmt {sign = None; _} -> correct_export sig_item
+  | _ ->
       (* Typedtree signatures found in .cmti files do not need correction *)
       ()
-  | _ -> correct_export sig_item

src/state/cmt.ml

@@ -34,9 +34,8 @@ module Cache = struct
 
 end
 
-type cmi_cmt_infos = Cmi_format.cmi_infos option * Cmt_format.cmt_infos
-
-let cache_cmt : ((string * string), (string * cmi_cmt_infos)) Cache.t = Cache.create 64
+let cache_cmt : ((string * string), (string * Cmt_format.cmt_infos)) Cache.t =
+  Cache.create 64
 
 let set_cache_size capacity = Cache.update_capacity cache_cmt capacity
 
@@ -51,17 +50,21 @@ let read_no_cache filepath =
       Option.map (( ^ ) " Tip: ") tip
       |> Option.value ~default:""
     in
-    Printf.sprintf "%s: %s.%s" filepath msg tip
+    Printf.sprintf "%s: %s. %s" filepath msg tip
     |> Result.error
   in
-  match Cmt_format.read filepath with
+  match Cmt_format.read_cmt filepath with
   | exception Cmi_format.(Error (Not_an_interface _)) ->
       let tip =
-        "the file must be compiled with the same OCaml version as the dead_code_analyzer."
+        "The file must be compiled with the same OCaml version as the dead_code_analyzer."
       in
       error ~tip "invalid magic number"
-  | _, None -> error "missing cmt_infos"
-  | cmi_infos, Some cmt_infos -> Result.ok (cmi_infos, cmt_infos)
+  | exception Cmt_format.(Error (Not_a_typedtree _)) ->
+      let tip =
+        "The file must be a .cmt or .cmti file compiled with the same OCaml version as the dead_code_analyzer."
+      in
+      error ~tip "does not contain a typedtree"
+  | cmt_infos -> Result.ok cmt_infos
 
 let read filepath =
   let comp_unit = Utils.Filepath.unit filepath in
@@ -70,9 +73,9 @@ let read filepath =
   | Some (fp, res) when String.equal fp filepath -> Result.ok res
   | _ ->
       read_no_cache filepath
-      |> Result.map (fun cmi_cmt_infos ->
-        Cache.add cache_cmt (ext, comp_unit) (filepath, cmi_cmt_infos);
-        cmi_cmt_infos)
+      |> Result.map (fun cmt_infos ->
+        Cache.add cache_cmt (ext, comp_unit) (filepath, cmt_infos);
+        cmt_infos)
 
 let find_cached_from_comp_unit comp_unit ext =
   Cache.find_opt cache_cmt (ext, comp_unit)

src/state/cmt.mli

@@ -1,10 +1,8 @@
-type cmi_cmt_infos = Cmi_format.cmi_infos option * Cmt_format.cmt_infos
+val read : string -> (Cmt_format.cmt_infos, string) Result.t
 
-val read : string -> (cmi_cmt_infos, string) Result.t
+val cached_cmti : string -> Cmt_format.cmt_infos option
 
-val cached_cmti : string -> cmi_cmt_infos option
-
-val cached_cmt : string -> cmi_cmt_infos option
+val cached_cmt : string -> Cmt_format.cmt_infos option
 
 val set_cache_size : int -> unit
 

src/state/file_infos.ml

@@ -1,33 +1,38 @@
-type signature =
-  | Structure of Typedtree.structure
-  | Signature of Typedtree.signature
+module Locdep = Location_dependencies
+
+type cm_infos =
+  | Cmti of {
+        sign : Typedtree.signature;
+        cmti_uid_to_decl : Location_dependencies.uid_to_decl;
+      }
+  | Cmt of {
+        strc : Typedtree.structure;
+        sign : Typedtree.signature option;
+        location_dependencies : Location_dependencies.t;
+      }
+  | Neither
 
 type t = {
   builddir : string;
   cm_file : string;
-  signature : signature option;
-  cmt_struct : Typedtree.structure option;
-  cmti_uid_to_decl : Location_dependencies.uid_to_decl option;
-  location_dependencies : Location_dependencies.t;
+  cm_infos : cm_infos;
   modname : string;
   sourcepath : string option;
 }
 
 let empty = {
   builddir = "!!UNKNOWN_BUILDDIR!!";
   cm_file = "";
-  signature = None;
-  cmt_struct = None;
-  cmti_uid_to_decl = None;
-  location_dependencies = Location_dependencies.empty;
+  cm_infos = Neither;
   modname = "!!UNKNOWN_MODNAME!!";
   sourcepath = None;
 }
 
 (** [init_from_all_cm_infos ~cm_file cmt_infos] creates a [t] with:
     - information from [cmt_infos] : [builddir], [modname], [sourcepath];
     - [cm_file];
-    - [signature] is extracted from [cmt_infos.cmt_annots]
+    - [cm_infos] is built with [cmt_infos.cmt_annots] and
+      [cmt_infos.cmt_uid_to_decl]
 *)
 let init_from_all_cm_infos ~cm_file cmt_infos =
   let builddir = cmt_infos.Cmt_format.cmt_builddir in
@@ -36,17 +41,17 @@ let init_from_all_cm_infos ~cm_file cmt_infos =
     |> Option.map (Filename.concat builddir)
   in
   let modname = cmt_infos.cmt_modname in
-  let signature =
+  let cm_infos =
     match cmt_infos.cmt_annots with
-    | Interface sign -> Some (Signature sign)
-    | Implementation str -> Some (Structure str)
-    | _ -> None
+    | Interface sign ->
+        let cmti_uid_to_decl = cmt_infos.cmt_uid_to_decl in
+        Cmti {sign; cmti_uid_to_decl}
+    | Implementation strc ->
+        let location_dependencies = Location_dependencies.empty in
+        Cmt {strc; sign = None; location_dependencies}
+    | _ -> Neither
   in
-  {empty with builddir;
-              cm_file;
-              signature;
-              modname;
-              sourcepath}
+  {builddir; cm_file; cm_infos; modname; sourcepath}
 
 (** [init_from_cm_file cm_file] returns an [Ok t] with [t] filled with general
     info expected for both cmt and cmti files, using the [cm_file] (see
@@ -59,7 +64,7 @@ let init_from_cm_file cm_file =
   else
     match Cmt.read cm_file with
     | Error _ as err -> err
-    | Ok (_, cmt_infos) ->
+    | Ok cmt_infos ->
         let file_infos =
           init_from_all_cm_infos ~cm_file cmt_infos
         in
@@ -69,78 +74,49 @@ let ( let* ) x f = Result.bind x f
 let ( let+ ) x f = Result.map f x
 
 let init_from_cmti_file cmti_file =
-  let+ file_infos, cmt_infos = init_from_cm_file cmti_file in
-  let cmti_uid_to_decl = Some cmt_infos.cmt_uid_to_decl in
-  {file_infos with cmti_uid_to_decl}
+  let* file_infos, _ = init_from_cm_file cmti_file in
+  match file_infos.cm_infos with
+  | Cmti _ -> Result.ok file_infos
+  | _ -> Result.error (cmti_file ^ ": does not contain an interface")
 
-let init_from_cmt_file ~comp_unit_to_path cmt_file =
+let init_from_cmt_file ~comp_unit_to_path ?(cmi_infos = Neither) cmt_file =
   let* file_infos, cmt_infos = init_from_cm_file cmt_file in
-  let* cmt_struct =
-    match cmt_infos.cmt_annots with
-    | Implementation structure -> Result.ok structure
-    | _ -> Result.error (cmt_file ^ ": does not contain an implementation")
-  in
-  let cmt_struct = Some cmt_struct in
-  (* Read the cmti if it exists. We always want to do it in case a user
-     specified the cmt before the cmti to ensure the location_dependencies
-     are idempotent. *)
-  let cmti_uid_to_decl =
-    let cmti_file = Filename.remove_extension cmt_file ^ ".cmti" in
-    match init_from_cmti_file cmti_file with
-    | Error _ -> None
-    | Ok file_infos -> file_infos.cmti_uid_to_decl
-  in
-  let+ location_dependencies =
-    Location_dependencies.init ~comp_unit_to_path cmt_infos cmti_uid_to_decl
-  in
-  let file_infos =
-    {file_infos with cmt_struct; cmti_uid_to_decl; location_dependencies}
-  in
-  file_infos, cmt_infos
+  match file_infos.cm_infos with
+  | Cmt cmt ->
+      let sign, cmti_uid_to_decl =
+        match cmi_infos with
+        | Cmti {sign; cmti_uid_to_decl} -> Some sign, Some cmti_uid_to_decl
+        | _ -> None, None
+      in
+      let+ location_dependencies =
+        Locdep.init ~comp_unit_to_path cmt_infos cmti_uid_to_decl
+      in
+      let cm_infos = Cmt {cmt with sign; location_dependencies} in
+      {file_infos with cm_infos}
+  | _ -> Result.error (cmt_file ^ ": does not contain an implementation")
 
 let init ~comp_unit_to_path cm_file =
   match Filename.extension cm_file with
-  | ".cmt" ->
-      let+ file_infos, _ = init_from_cmt_file ~comp_unit_to_path cm_file in
-      file_infos
-  | ".cmti" -> (
-      (* Using cmt_infos is not critical. The intent is to mirror the behavior
-         on cmt files, where both cmt and cmti are read. *)
-      let filled_with_cmt_infos =
-        let cmt_file = Filename.remove_extension cm_file ^ ".cmt" in
-        let* file_infos, cmt_infos = init_from_cmt_file ~comp_unit_to_path cmt_file in
-        let+ location_dependencies =
-          Location_dependencies.init ~comp_unit_to_path cmt_infos file_infos.cmti_uid_to_decl
-        in
-        {file_infos with location_dependencies}
-      in
-      match filled_with_cmt_infos with
-      | Ok {cmt_struct; cmti_uid_to_decl; location_dependencies; _} ->
-          let+ res, _ = init_from_cm_file cm_file in
-          {res with cmt_struct; cmti_uid_to_decl; location_dependencies}
-      | Error _ -> init_from_cmti_file cm_file
-  )
+  | ".cmt" -> init_from_cmt_file ~comp_unit_to_path cm_file
+  | ".cmti" -> init_from_cmti_file cm_file
   | _ -> Result.error (cm_file ^ ": not a .cmti or .cmt file")
 
 let change_file ~comp_unit_to_path file_infos cm_file =
   let no_ext = Filename.remove_extension cm_file in
   assert(no_ext = Filename.remove_extension file_infos.cm_file);
   match Filename.extension cm_file, file_infos with
-  | ".cmt", {cmt_struct = (Some _ as cs); signature; cmti_uid_to_decl; _} ->
-      let* res, cmt_infos = init_from_cm_file cm_file in
-      let+ location_dependencies =
-        match file_infos.location_dependencies with
-        | [] -> Location_dependencies.init ~comp_unit_to_path cmt_infos cmti_uid_to_decl
-        | loc_dep -> (* They have already been computed *)
-            Result.ok loc_dep
-      in
-      {res with cmt_struct = cs; signature; cmti_uid_to_decl; location_dependencies}
-  | ".cmti", {cmti_uid_to_decl = (Some _ as cutd); cmt_struct; location_dependencies; _} ->
-      let+ res, _ = init_from_cm_file cm_file in
-      {res with cmti_uid_to_decl = cutd; cmt_struct; location_dependencies}
+  | ".cmt", {cm_infos = Cmti _ as cmi_infos; _} ->
+        init_from_cmt_file ~comp_unit_to_path ~cmi_infos cm_file
+  | ".cmt",  _ ->
+      (* The only other possible file read before a .cmt is the
+         corresponding .cmti *)
+      Result.error (cm_file ^ ": must be read after its corresponding .cmti")
+  | ".cmti", _ ->
+      (* .cmti files are always read before the corresponding .cmt *)
+      Result.error (cm_file ^ ": must be read before its corresponding .cmt")
   | _ ->
-      (* invalid extension or the corresponding info is None *)
-      init ~comp_unit_to_path cm_file
+      (* invalid extension *)
+      Result.error (cm_file ^ ": not a .cmti or .cmt file")
 
 let has_sourcepath file_infos = Option.is_some file_infos.sourcepath
 

src/state/file_infos.mli

@@ -1,20 +1,27 @@
-(** Information about a analyzable file ([.cmti] or [.cmt] file) *)
+(** Information about an analyzable file ([.cmti] or [.cmt] file) *)
 
-type signature =
-  | Structure of Typedtree.structure
-  | Signature of Typedtree.signature
+(** Data specific to the file type (.cmt or .cmti) *)
+type cm_infos =
+  | Cmti of {
+        sign : Typedtree.signature;
+        cmti_uid_to_decl : Location_dependencies.uid_to_decl;
+          (** Extracted from [cmt_infos.cmt_uid_to_decl] *)
+      } (* only a .cmti was read *)
+  | Cmt of {
+        strc : Typedtree.structure;
+        sign : Typedtree.signature option;
+          (** signature read in the corresponding .cmti (if available) *)
+        location_dependencies : Location_dependencies.t;
+          (** Dependencies similar to [cmt_infos.cmt_value_dependencies]
+              in OCaml 5.2. *)
+      } (* infos coming from a .cmt *)
+  | Neither (* no file read or the content was discarded *)
 
 type t = {
   builddir : string; (** The [cmt_builddir] *)
   cm_file : string; (** The filepath currently analyzed *)
-  signature : signature option;
-    (** Extracted from [cmt_infos] in cmti files and [cmi_infos] in cmt files *)
-  cmt_struct : Typedtree.structure option;
-    (** Extracted from a cmt's [cmt_infos.cmt_annots] *)
-  cmti_uid_to_decl : Location_dependencies.uid_to_decl option;
-    (** Extracted from a cmti's [cmt_infos] *)
-  location_dependencies : Location_dependencies.t;
-    (** Dependencies similar to [cmt_infos.cmt_value_dependencies] in OCaml 5.2 *)
+  cm_infos : cm_infos;
+    (** Data specific to the file type (.cmt or .cmti) *)
   modname : string; (** Either [cmti_name] or [cmt_modname] *)
   sourcepath : string option; (** The path to the associated source file *)
 }