diff --git a/src/deadCode.ml b/src/deadCode.ml index c4a8dd4..6181baf 100644 --- a/src/deadCode.ml +++ b/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,13 +424,17 @@ 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 = @@ -443,16 +442,16 @@ let load_file fn state = 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 diff --git a/src/deadSign.ml b/src/deadSign.ml index 36fa4ec..0f5a5d4 100644 --- a/src/deadSign.ml +++ b/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 diff --git a/src/state/cmt.ml b/src/state/cmt.ml index ce9c002..256f8ee 100644 --- a/src/state/cmt.ml +++ b/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) diff --git a/src/state/cmt.mli b/src/state/cmt.mli index 49432e9..dcc06ae 100644 --- a/src/state/cmt.mli +++ b/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 diff --git a/src/state/file_infos.ml b/src/state/file_infos.ml index 4ac88b6..76e0386 100644 --- a/src/state/file_infos.ml +++ b/src/state/file_infos.ml @@ -1,14 +1,21 @@ -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; } @@ -16,10 +23,7 @@ type t = { 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; } @@ -27,7 +31,8 @@ let empty = { (** [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 diff --git a/src/state/file_infos.mli b/src/state/file_infos.mli index 8c50705..8b17458 100644 --- a/src/state/file_infos.mli +++ b/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 *) } diff --git a/src/state/location_dependencies.ml b/src/state/location_dependencies.ml index e31078c..d951af2 100644 --- a/src/state/location_dependencies.ml +++ b/src/state/location_dependencies.ml @@ -42,12 +42,11 @@ let find_opt_external_uid_loc ~comp_unit_to_path = function in Cmt.read cm_path |> Result.to_option in - let* cmi_cmt_infos = + let* cmt_infos = match cached with | Some _ as some -> some | None -> read_from_path () in - let cmt_infos = snd cmi_cmt_infos in let cmt_uid_to_decl = cmt_infos.cmt_uid_to_decl in let* item_decl = UidTbl.find_opt cmt_uid_to_decl uid in loc_opt_of_item_decl item_decl