From fcc249dc42c4ae92acc2ae038881cbc1ace44f7f Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Sat, 1 Aug 2026 15:54:18 +0200 Subject: [PATCH 01/10] [src][deadSign] extract `collect_export` The new module documents the function's parameters. This is preliminary work to implement 2 collectors: - one for cmti files (relying on `Typedtree.signature`) - one for cmt files (relying on a mix of cmi and cmt info) --- src/deadCode.ml | 85 ++++++------------------------------------------ src/deadSign.ml | 76 +++++++++++++++++++++++++++++++++++++++++++ src/deadSign.mli | 23 +++++++++++++ 3 files changed, 109 insertions(+), 75 deletions(-) create mode 100644 src/deadSign.ml create mode 100644 src/deadSign.mli diff --git a/src/deadCode.ml b/src/deadCode.ml index bdcd53a..3f50e9c 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -31,78 +31,6 @@ let main_files = Hashtbl.create 256 (* names -> paths *) (******** PROCESSING ********) -type context = - | Toplevel - | In_module of (Ident.t * Location.t) - | In_modtyp of (Ident.t * Location.t) - | Include - -let should_export_value ~context stock loc = - let state = State.get_current () in - let belongs_to_context loc = - match context with - | Toplevel | Include -> true - | In_module (_, md_loc) - | In_modtyp (_, md_loc) -> - (* When a value is part of a module sig because of: - - an include, then its location precedes that of the current module; - - a module type with substitution, then its location ends - with the current module's sig. - Checking that the value's location is striclty within the - module's rules out these 2 cases. - *) - let get_pos_info loc = - let fname, start_l, start_c = - Location.get_pos_info loc.Location.loc_start - in - let _, end_l, end_c = Location.get_pos_info loc.loc_end in - fname, (start_l, start_c), (end_l, end_c) - in - let v_fname, v_start, v_end = get_pos_info loc in - let md_fname, md_start, md_end = get_pos_info md_loc in - let ( > ) (l1, c1) (l2, c2) = - l1 > l2 || (l1 = l2 && c1 > c2) - in - String.equal v_fname md_fname - && v_start > md_start - && md_end > v_end - in - Config.must_report_section state.config.sections.exported_values - && (* do not add the loc in decs if it belongs to a module type - or if it is not actually declared in the current context *) - ( stock != decs - || (not (Hashtbl.mem in_modtype loc.Location.loc_start) - && belongs_to_context loc) - ) - -let rec collect_export ~context path u stock = function - - | Sig_value (id, ({Types.val_loc; val_type; _} as value), _) - when not val_loc.Location.loc_ghost -> - if should_export_value ~context stock val_loc then export path u stock id val_loc; - let path = Ident.create_persistent (Ident.name id ^ "*") :: path in - DeadObj.collect_export path u stock ~obj:val_type val_loc; - !DeadLexiFi.sig_value value - - | Sig_type (id, t, _, _) when stock == decs -> - DeadType.collect_export (id :: path) u stock t - - | Sig_class (id, {Types.cty_type = t; cty_loc = loc; _}, _, _) -> - DeadObj.collect_export (id :: path) u stock ~cltyp:t loc - - | (Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) - | Sig_modtype (id, {Types.mtd_type = Some t; mtd_loc = loc; _}, _)) as s -> - let stock, context = - match s, context with - | _, Include -> stock, Include - | Sig_modtype _, _ -> in_modtype, In_modtyp (id, loc) - | _, _ -> stock, In_module (id, loc) - in - Utils.signature_of_modtype t - |> List.iter (collect_export ~context (id :: path) u stock) - - | _ -> () - let rec treat_exp exp args = match exp.exp_desc with @@ -188,8 +116,12 @@ let structure_item super self i = State.File_infos.get_modname state.file_infos |> Ident.create_persistent in + let context = DeadSign.Include in + let path = [module_id] in + let comp_unit = _include in + let stock = incl in List.iter - (collect_export ~context:Include [module_id] _include incl) + (DeadSign.collect_export ~context ~path ~comp_unit ~stock) signature; last_loc := prev_last_loc; in @@ -394,7 +326,7 @@ let regabs state = let read_interface fn signature state = regabs state; if Config.must_report_main state.config then - let u = + let comp_unit = if State.File_infos.has_sourcepath state.file_infos then State.File_infos.get_sourceunit state.file_infos else @@ -405,7 +337,10 @@ let read_interface fn signature state = |> Ident.create_persistent in let f = - collect_export ~context:Toplevel [module_id] u decs + let context = DeadSign.Toplevel in + let path = [module_id] in + let stock = decs in + DeadSign.collect_export ~context ~path ~comp_unit ~stock in List.iter f signature; last_loc := Lexing.dummy_pos diff --git a/src/deadSign.ml b/src/deadSign.ml new file mode 100644 index 0000000..40e48ca --- /dev/null +++ b/src/deadSign.ml @@ -0,0 +1,76 @@ +type context = + | Toplevel + | In_module of (Ident.t * Location.t) + | In_modtyp of (Ident.t * Location.t) + | Include + +let should_export_value ~context ~stock loc = + let state = State.get_current () in + let belongs_to_context loc = + match context with + | Toplevel | Include -> true + | In_module (_, md_loc) + | In_modtyp (_, md_loc) -> + (* When a value is part of a module sig because of: + - an include, then its location precedes that of the current module; + - a module type with substitution, then its location ends + with the current module's sig. + Checking that the value's location is striclty within the + module's rules out these 2 cases. + *) + let get_pos_info loc = + let fname, start_l, start_c = + Location.get_pos_info loc.Location.loc_start + in + let _, end_l, end_c = Location.get_pos_info loc.loc_end in + fname, (start_l, start_c), (end_l, end_c) + in + let v_fname, v_start, v_end = get_pos_info loc in + let md_fname, md_start, md_end = get_pos_info md_loc in + let ( > ) (l1, c1) (l2, c2) = + l1 > l2 || (l1 = l2 && c1 > c2) + in + String.equal v_fname md_fname + && v_start > md_start + && md_end > v_end + in + Config.must_report_section state.config.sections.exported_values + && (* do not add the loc in decs if it belongs to a module type + or if it is not actually declared in the current context *) + ( stock != DeadCommon.decs + || (not (Hashtbl.mem DeadCommon.in_modtype loc.Location.loc_start) + && belongs_to_context loc) + ) + +let collect_export ~context ~path ~comp_unit ~stock sig_item = + let rec collect_export context path stock : Types.signature_item -> unit = + function + + | Sig_value (id, ({Types.val_loc; val_type; _} as value), _) + when not val_loc.Location.loc_ghost -> + if should_export_value ~context ~stock val_loc then + DeadCommon.export path comp_unit stock id val_loc; + let path = Ident.create_persistent (Ident.name id ^ "*") :: path in + DeadObj.collect_export path comp_unit stock ~obj:val_type val_loc; + !DeadLexiFi.sig_value value + + | Sig_type (id, t, _, _) when stock == DeadCommon.decs -> + DeadType.collect_export (id :: path) comp_unit stock t + + | Sig_class (id, {Types.cty_type = t; cty_loc = loc; _}, _, _) -> + DeadObj.collect_export (id :: path) comp_unit stock ~cltyp:t loc + + | (Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) + | Sig_modtype (id, {Types.mtd_type = Some t; mtd_loc = loc; _}, _)) as s -> + let stock, context = + match s, context with + | _, Include -> stock, Include + | Sig_modtype _, _ -> DeadCommon.in_modtype, In_modtyp (id, loc) + | _, _ -> stock, In_module (id, loc) + in + Utils.signature_of_modtype t + |> List.iter (collect_export context (id::path) stock) + + | _ -> () + in + collect_export context path stock sig_item diff --git a/src/deadSign.mli b/src/deadSign.mli new file mode 100644 index 0000000..7ca5f96 --- /dev/null +++ b/src/deadSign.mli @@ -0,0 +1,23 @@ +type context = + | Toplevel + | In_module of (Ident.t * Location.t) + | In_modtyp of (Ident.t * Location.t) + | Include + +val collect_export : + context:context -> + path:Ident.t list -> + comp_unit:string -> + stock:(Lexing.position, string * string) Hashtbl.t -> + Types.signature_item + -> unit +(** [collect_export ~context ~path ~comp_unit ~stock sig_item] + recursively traverse the [sig_item] and store exported elements + (values, constructors, ...) in [stock]. + - [path] is the current module path. E.g. for a value in a submodule, + the path is [Module.Submodule]. + - [comp_unit] is the compilation unit of the [sig_item]. + - [context] specifies if the current signature item is found at the + [Toplevel] of the current compilation unit, in a module, a modtype, + or an [Include] +*) From 175d0edd8e064c477ff5f6e96566db98e03a4e39 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Sat, 1 Aug 2026 16:59:54 +0200 Subject: [PATCH 02/10] [src][deadSign] add `collect_export_from_typedtree` This is a naive translation of the existing `collect_export`, that works on `Typedtree.signature` instead of `Types.sig_item`. The intent is to use this new function on cmti files' signatures instead of the other on their cmi infos. A new function `Utils.typedtree_signature_of_modtype` is added, and is also a naive translation of `Utils.signature_of_modtype` to work on `Typedtree` types instead of `Types`'s. --- src/deadSign.ml | 46 ++++++++++++++++++++++++++++++++++++++++++++++ src/deadSign.mli | 13 +++++++++++++ src/utils.ml | 8 ++++++++ src/utils.mli | 7 +++++++ 4 files changed, 74 insertions(+) diff --git a/src/deadSign.ml b/src/deadSign.ml index 40e48ca..29be9d7 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -74,3 +74,49 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = | _ -> () in collect_export context path stock sig_item + +let collect_export_from_typedtree ~context ~path ~comp_unit ~stock signature = + let rec collect_signature context path stock Typedtree.{sig_items; _} = + List.iter (collect_item context path stock) sig_items + and collect_item context path stock sig_item = + match sig_item.Typedtree.sig_desc with + + | Tsig_value {val_id; val_loc; val_val; _} + when not val_loc.Location.loc_ghost -> + if should_export_value ~context ~stock val_loc then + DeadCommon.export path comp_unit stock val_id val_loc; + let path = Ident.create_persistent (Ident.name val_id ^ "*") :: path in + let obj = val_val.val_type in + DeadObj.collect_export path comp_unit stock ~obj val_loc; + !DeadLexiFi.sig_value val_val + + | Tsig_type (_, type_decls) when stock == DeadCommon.decs-> + let export_type (td : Typedtree.type_declaration) = + let path = td.typ_id :: path in + DeadType.collect_export path comp_unit stock td.typ_type + in + List.iter export_type type_decls + + | Tsig_class class_descs -> + let export_class (cd : Typedtree.class_description) = + let path = cd.ci_id_class :: path in + let cltyp = cd.ci_expr.cltyp_type in + DeadObj.collect_export path comp_unit stock ~cltyp cd.ci_loc + in + List.iter export_class class_descs + + | (Tsig_module {md_id = Some id; md_loc = loc; md_type = t; _} + | Tsig_modtype {mtd_id = id; mtd_loc = loc; mtd_type = Some t; _}) as s -> + let stock, context = + match s, context with + | _, Include -> stock, Include + | Tsig_modtype _, _ -> DeadCommon.in_modtype, In_modtyp (id, loc) + | _, _ -> stock, In_module (id, loc) + in + let path = id :: path in + Utils.typedtree_signature_of_modtype t + |> Option.iter (collect_signature context path stock) + + | _ -> () + in + collect_signature context path stock signature diff --git a/src/deadSign.mli b/src/deadSign.mli index 7ca5f96..53d09af 100644 --- a/src/deadSign.mli +++ b/src/deadSign.mli @@ -21,3 +21,16 @@ val collect_export : [Toplevel] of the current compilation unit, in a module, a modtype, or an [Include] *) + +val collect_export_from_typedtree : + context:context -> + path:Ident.t list -> + comp_unit:string -> + stock:(Lexing.position, string * string) Hashtbl.t -> + Typedtree.signature + -> unit +(** [collect_export_from_typedtree ~context ~path ~comp_unit ~stock sigature] + recursively traverse the [signature] items and store exported elements + (values, constructors, ...) in [stock]. + See {!collect_export} above for more information. +*) diff --git a/src/utils.ml b/src/utils.ml index df300c1..c52d78e 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -43,4 +43,12 @@ let rec signature_of_modtype ?(select_param = false) modtype = | Mty_functor (Named (_, t), _) -> signature_of_modtype t | _ -> [] +let rec typedtree_signature_of_modtype ?(select_param = false) modtype = + let open Typedtree in + match modtype.mty_desc with + | Tmty_signature sg -> Some sg + | Tmty_functor (_, t) when not select_param -> typedtree_signature_of_modtype t + | Tmty_functor (Named (_, _, t), _) -> typedtree_signature_of_modtype t + | _ -> None + module StringSet = Set.Make(String) diff --git a/src/utils.mli b/src/utils.mli index 1d506e9..2900bd8 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -32,4 +32,11 @@ val signature_of_modtype : [false] after looking for the parameter of the first functor. There is currently no way to select the parameter of a parameter. *) +val typedtree_signature_of_modtype : + ?select_param:bool -> Typedtree.module_type -> Typedtree.signature option +(** [signature_of_modtype ?select_param modtype] returns the selected + Typedtree.signature of [modtype] when possible. + See {!signature_of_modtype} above for more information +*) + module StringSet : Set.S with type elt = String.t From 17f7c21dcdd5bb18b78f307ba4d120f15cf9b724 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Sat, 1 Aug 2026 18:14:17 +0200 Subject: [PATCH 03/10] [src] use cmti signature In `State.File_infos.t`, update `smi_sign` to `cm_sign` and its type to the new `signature option`. It now stores either the cmti signature when available (found `cmt_infos.cmt_annots`), or the `cmi_infos.cmi_sign` as fallaback (old behavior). When collecting exports, use the collector corresponding to the cm_sign, using `collect_export_from_typedtree` for cmti signature. This fixes the modtype limitation when a .mli is provided for all constructs but optional arguments. This also fixes the FP of `exported_valuies/incl_same_name` when the new module has a .mli. --- check/classic/classic.ref | 30 ++-------------- check/internal/internal.ref | 30 ++-------------- check/threshold-1/threshold-1.ref | 33 ++--------------- check/threshold-3-0.5/threshold-3-0.5.ref | 43 ++--------------------- src/deadCode.ml | 29 +++++++++------ src/state/file_infos.ml | 26 ++++++++++---- src/state/file_infos.mli | 7 +++- 7 files changed, 55 insertions(+), 143 deletions(-) diff --git a/check/classic/classic.ref b/check/classic/classic.ref index 5ec0a5d..3bf35ec 100644 --- a/check/classic/classic.ref +++ b/check/classic/classic.ref @@ -33,9 +33,7 @@ ./examples/docs/exported_values/hello_world/hello_world_with_intf.mli:3: goodbye ./examples/docs/exported_values/hello_world/hello_world_with_intf.mli:4: world -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:4: redefined_unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:4: redefined_unused @@ -183,20 +181,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected @@ -304,14 +288,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Ftor_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: With.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Ftor_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: With.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -781,7 +757,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 653 +Total: 629 Success: 595 -Failed: 58 -Ratio: 91.1179173047% +Failed: 34 +Ratio: 94.5945945946% diff --git a/check/internal/internal.ref b/check/internal/internal.ref index dad1e95..dfca2d8 100644 --- a/check/internal/internal.ref +++ b/check/internal/internal.ref @@ -23,9 +23,7 @@ ./examples/docs/exported_values/code_constructs/module/module_lib.mli:6: M.unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:4: redefined_unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:4: redefined_unused @@ -135,20 +133,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected @@ -256,14 +240,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Ftor_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: With.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Ftor_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: With.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -733,7 +709,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 609 +Total: 585 Success: 551 -Failed: 58 -Ratio: 90.4761904762% +Failed: 34 +Ratio: 94.188034188% diff --git a/check/threshold-1/threshold-1.ref b/check/threshold-1/threshold-1.ref index 65aaef2..c1dc3ba 100644 --- a/check/threshold-1/threshold-1.ref +++ b/check/threshold-1/threshold-1.ref @@ -23,9 +23,7 @@ ./examples/docs/exported_values/code_constructs/module/module_lib.mli:6: M.unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:4: redefined_unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:4: redefined_unused @@ -169,9 +167,7 @@ ./examples/docs/exported_values/hello_world/hello_world_without_intf.ml:2: hello ./examples/docs/exported_values/hello_world/hello_world_without_intf.ml:3: goodbye -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:3: used: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:5: redefined_used -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:3: used: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:5: redefined_used ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:5: redefined_used @@ -430,20 +426,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected @@ -603,7 +585,6 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/obj/without_class.mli:28: _self_used_factory#used_fun ./examples/using_dune/wrapped_lib/obj/without_class.mli:28: _self_used_factory#used_int -./examples/using_make/advanced/func.mli:3: M.c#f: Should not be detected ./examples/using_make/advanced/mod.mli:4: p#f ./examples/using_make/obj/class.mli:1: c#f @@ -644,14 +625,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Ftor_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: With.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Ftor_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: With.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -1202,7 +1175,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 999 +Total: 972 Success: 935 -Failed: 64 -Ratio: 93.5935935936% +Failed: 37 +Ratio: 96.1934156379% diff --git a/check/threshold-3-0.5/threshold-3-0.5.ref b/check/threshold-3-0.5/threshold-3-0.5.ref index 08716e2..dad4cec 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.ref +++ b/check/threshold-3-0.5/threshold-3-0.5.ref @@ -23,9 +23,7 @@ ./examples/docs/exported_values/code_constructs/module/module_lib.mli:6: M.unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:4: redefined_unused -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:2: unused: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:4: redefined_unused @@ -169,9 +167,7 @@ ./examples/docs/exported_values/hello_world/hello_world_without_intf.ml:2: hello ./examples/docs/exported_values/hello_world/hello_world_without_intf.ml:3: goodbye -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:3: used: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/with_intf.mli:5: redefined_used -./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.ml:3: used: Should not be detected ./examples/docs/exported_values/limitations/incl_same_name/incl_with_intf/without_intf.mli:5: redefined_used ./examples/docs/exported_values/limitations/incl_same_name/incl_without_intf/with_intf.ml:5: redefined_used @@ -432,10 +428,6 @@ ./examples/docs/exported_values/hello_world/hello_world_with_intf.mli:4: world ./examples/docs/exported_values/hello_world/hello_world_without_intf.ml:4: world -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.f: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.x: Should not be detected ./examples/docs/methods/limitations/alias/alias_lib.mli:2: original ./examples/docs/optional_arguments/code_constructs/intext_app/intext_app_lib.mli:2: max @@ -577,20 +569,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected ./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected @@ -750,7 +728,6 @@ Nothing else to report in this section ./examples/using_dune/wrapped_lib/obj/without_class.mli:28: _self_used_factory#used_fun ./examples/using_dune/wrapped_lib/obj/without_class.mli:28: _self_used_factory#used_int -./examples/using_make/advanced/func.mli:3: M.c#f: Should not be detected ./examples/using_make/advanced/mod.mli:4: p#f ./examples/using_make/obj/class.mli:1: c#f @@ -830,14 +807,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Ftor_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: Incl_with.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:4: With.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Ftor_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: Incl_with.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:5: With.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -991,12 +960,6 @@ Nothing else to report in this section .>-> ALMOST UNUSED CONSTRUCTORS/RECORD FIELDS: Called 2 time(s): ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.field.field: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:15: constructors.Used ./examples/using_dune/preprocessed_lib/preprocessed.mli:24: record.used ./examples/using_dune/preprocessed_lib/preprocessed_no_intf.ml:26: constructors.Used @@ -1616,7 +1579,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1331 +Total: 1294 Success: 1257 -Failed: 74 -Ratio: 94.4402704733% +Failed: 37 +Ratio: 97.1406491499% diff --git a/src/deadCode.ml b/src/deadCode.ml index 3f50e9c..d4879cb 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -323,7 +323,7 @@ let regabs state = hashtbl_add_unique_to_list main_files (Utils.Filepath.unit fn) () -let read_interface fn signature state = +let read_interface fn (cm_sign : State.File_infos.signature) state = regabs state; if Config.must_report_main state.config then let comp_unit = @@ -336,13 +336,20 @@ let read_interface fn signature state = State.File_infos.get_modname state.file_infos |> Ident.create_persistent in - let f = - let context = DeadSign.Toplevel in - let path = [module_id] in - let stock = decs in - DeadSign.collect_export ~context ~path ~comp_unit ~stock - in - List.iter f signature; + let context = DeadSign.Toplevel in + let path = [module_id] in + let stock = decs in + begin match cm_sign with + | Cmi_sign signature -> + let f = + DeadSign.collect_export ~context ~path ~comp_unit ~stock + in + List.iter f signature + | Cmti_sign signature -> + DeadSign.collect_export_from_typedtree + ~context ~path ~comp_unit ~stock + signature + end; last_loc := Lexing.dummy_pos @@ -428,10 +435,10 @@ let load_file fn state = 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.cmi_sign with + match state.file_infos.cm_sign with | None -> report_error (fn ^ ": missing cmi_sign") - | Some cmi_sign -> - read_interface fn cmi_sign state + | Some cm_sign -> + read_interface fn cm_sign state ) in let process_implementation fn = diff --git a/src/state/file_infos.ml b/src/state/file_infos.ml index 89b676e..a9f8eeb 100644 --- a/src/state/file_infos.ml +++ b/src/state/file_infos.ml @@ -1,7 +1,11 @@ +type signature = + | Cmi_sign of Types.signature + | Cmti_sign of Typedtree.signature + type t = { builddir : string; cm_file : string; - cmi_sign : Types.signature option; + cm_sign : signature option; cmt_struct : Typedtree.structure option; cmti_uid_to_decl : Location_dependencies.uid_to_decl option; location_dependencies : Location_dependencies.t; @@ -12,7 +16,7 @@ type t = { let empty = { builddir = "!!UNKNOWN_BUILDDIR!!"; cm_file = ""; - cmi_sign = None; + cm_sign = None; cmt_struct = None; cmti_uid_to_decl = None; location_dependencies = Location_dependencies.empty; @@ -23,7 +27,10 @@ let empty = { (** [init_from_all_cm_infos ~cm_file ~cmi_infos cmt_infos] creates a [t] with: - information from [cmt_infos] : [builddir], [modname], [sourcepath]; - [cm_file]; - - [cmi_sign = Some cm_infos.cmi_sign] if [cmi_infos = Some _]; *) + - [sign] is extracted from either: + - [cmt_infos.cmt_annots] is it is an [Interface] + - [cmi_infos.cmi_sign] if [cmi_infos = Some _] +*) let init_from_all_cm_infos ~cm_file ~cmi_infos cmt_infos = let builddir = cmt_infos.Cmt_format.cmt_builddir in let sourcepath = @@ -31,10 +38,15 @@ let empty = { |> Option.map (Filename.concat builddir) in let modname = cmt_infos.cmt_modname in - let cmi_sign = Option.map (fun Cmi_format.{cmi_sign; _} -> cmi_sign) cmi_infos in + let cm_sign = + match cmt_infos.cmt_annots with + | Interface sign -> Some (Cmti_sign sign) + | _ -> + Option.map (fun Cmi_format.{cmi_sign; _} -> Cmi_sign cmi_sign) cmi_infos + in {empty with builddir; cm_file; - cmi_sign; + cm_sign; modname; sourcepath} @@ -116,7 +128,7 @@ 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); cmi_sign; cmti_uid_to_decl; _} -> + | ".cmt", {cmt_struct = (Some _ as cs); cm_sign; cmti_uid_to_decl; _} -> let* res, cmt_infos = init_from_cm_file cm_file in let+ location_dependencies = match file_infos.location_dependencies with @@ -124,7 +136,7 @@ let change_file ~comp_unit_to_path file_infos cm_file = | loc_dep -> (* They have already been computed *) Result.ok loc_dep in - {res with cmt_struct = cs; cmi_sign; cmti_uid_to_decl; location_dependencies} + {res with cmt_struct = cs; cm_sign; 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} diff --git a/src/state/file_infos.mli b/src/state/file_infos.mli index a4cc8fe..69e25d1 100644 --- a/src/state/file_infos.mli +++ b/src/state/file_infos.mli @@ -1,9 +1,14 @@ (** Information about a analyzable file ([.cmti] or [.cmt] file) *) +type signature = + | Cmi_sign of Types.signature + | Cmti_sign of Typedtree.signature + type t = { builddir : string; (** The [cmt_builddir] *) cm_file : string; (** The filepath currently analyzed *) - cmi_sign : Types.signature option; (** Extracted from [cmi_infos] *) + cm_sign : 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; From 824514516d22f617b42f1eefaede00834049facf Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Mon, 3 Aug 2026 15:39:42 +0200 Subject: [PATCH 04/10] [src][deadSign] simplify collect_export_from_typedtree Unlike manipulating Types.signature, manipulating Typedtree.signature does not require the identification of content within module types. This is because module types attached to modules are more precise in the Typedtree and, in particular, disintiguishes explicit signatures from module types with constraints. In Types, those module types with constraints are represented uniformly with, thus undistinguishable from, explicit signatures. --- src/deadCode.ml | 4 +--- src/deadSign.ml | 39 ++++++++++++++++++--------------------- src/deadSign.mli | 6 ++---- 3 files changed, 21 insertions(+), 28 deletions(-) diff --git a/src/deadCode.ml b/src/deadCode.ml index d4879cb..8ff150d 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -346,9 +346,7 @@ let read_interface fn (cm_sign : State.File_infos.signature) state = in List.iter f signature | Cmti_sign signature -> - DeadSign.collect_export_from_typedtree - ~context ~path ~comp_unit ~stock - signature + DeadSign.collect_export_from_typedtree ~path ~comp_unit signature end; last_loc := Lexing.dummy_pos diff --git a/src/deadSign.ml b/src/deadSign.ml index 29be9d7..805d677 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -75,25 +75,29 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = in collect_export context path stock sig_item -let collect_export_from_typedtree ~context ~path ~comp_unit ~stock signature = - let rec collect_signature context path stock Typedtree.{sig_items; _} = - List.iter (collect_item context path stock) sig_items - and collect_item context path stock sig_item = +let collect_export_from_typedtree ~path ~comp_unit signature = + let should_export_value = + let state = State.get_current () in + Config.must_report_section state.config.sections.exported_values + in + let rec collect_signature path Typedtree.{sig_items; _} = + List.iter (collect_item path) sig_items + and collect_item path sig_item = match sig_item.Typedtree.sig_desc with | Tsig_value {val_id; val_loc; val_val; _} when not val_loc.Location.loc_ghost -> - if should_export_value ~context ~stock val_loc then - DeadCommon.export path comp_unit stock val_id val_loc; + if should_export_value then + DeadCommon.export path comp_unit DeadCommon.decs val_id val_loc; let path = Ident.create_persistent (Ident.name val_id ^ "*") :: path in let obj = val_val.val_type in - DeadObj.collect_export path comp_unit stock ~obj val_loc; + DeadObj.collect_export path comp_unit DeadCommon.decs ~obj val_loc; !DeadLexiFi.sig_value val_val - | Tsig_type (_, type_decls) when stock == DeadCommon.decs-> + | Tsig_type (_, type_decls)-> let export_type (td : Typedtree.type_declaration) = let path = td.typ_id :: path in - DeadType.collect_export path comp_unit stock td.typ_type + DeadType.collect_export path comp_unit DeadCommon.decs td.typ_type in List.iter export_type type_decls @@ -101,22 +105,15 @@ let collect_export_from_typedtree ~context ~path ~comp_unit ~stock signature = let export_class (cd : Typedtree.class_description) = let path = cd.ci_id_class :: path in let cltyp = cd.ci_expr.cltyp_type in - DeadObj.collect_export path comp_unit stock ~cltyp cd.ci_loc + DeadObj.collect_export path comp_unit DeadCommon.decs ~cltyp cd.ci_loc in List.iter export_class class_descs - | (Tsig_module {md_id = Some id; md_loc = loc; md_type = t; _} - | Tsig_modtype {mtd_id = id; mtd_loc = loc; mtd_type = Some t; _}) as s -> - let stock, context = - match s, context with - | _, Include -> stock, Include - | Tsig_modtype _, _ -> DeadCommon.in_modtype, In_modtyp (id, loc) - | _, _ -> stock, In_module (id, loc) - in + | Tsig_module {md_id = Some id; md_type; _} -> let path = id :: path in - Utils.typedtree_signature_of_modtype t - |> Option.iter (collect_signature context path stock) + Utils.typedtree_signature_of_modtype md_type + |> Option.iter (collect_signature path) | _ -> () in - collect_signature context path stock signature + collect_signature path signature diff --git a/src/deadSign.mli b/src/deadSign.mli index 53d09af..b7028cc 100644 --- a/src/deadSign.mli +++ b/src/deadSign.mli @@ -23,14 +23,12 @@ val collect_export : *) val collect_export_from_typedtree : - context:context -> path:Ident.t list -> comp_unit:string -> - stock:(Lexing.position, string * string) Hashtbl.t -> Typedtree.signature -> unit -(** [collect_export_from_typedtree ~context ~path ~comp_unit ~stock sigature] +(** [collect_export_from_typedtree ~path ~comp_unit sigature] recursively traverse the [signature] items and store exported elements - (values, constructors, ...) in [stock]. + (values, constructors, ...) in {!DeadCommon.desc}. See {!collect_export} above for more information. *) From f71a6cde1f040bf2532f8cbb7fc61f5e5f283833 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Mon, 3 Aug 2026 16:51:34 +0200 Subject: [PATCH 05/10] [src] identify and correct wrong exports This fixes the false positives related to the `modtype` limitation. The process is simple : - When processing signatures (either `Types` or `Typedtree`), mark content coming from Types' module types as such. This is necessary for optional arguments. In the case of a Typedtree.signature, elements to be marked are detected via a mismatch between the Typedtree and the Types module type signatures (the first is implicit while the second is explicit). - When processing a .cmt file without corresponding .cmti file, if a module type signature mismatches between the Typedtree and Types representation (same as above), then its elements are unexported, and the marked as belonging to a module type. Thus, this is a correction a posteriori. --- check/classic/classic.ref | 36 +----------- check/internal/internal.ref | 36 +----------- check/threshold-1/threshold-1.ref | 36 +----------- check/threshold-3-0.5/threshold-3-0.5.ref | 36 +----------- src/deadCode.ml | 19 +++++-- src/deadCommon.ml | 12 ++++ src/deadMod.ml | 7 +++ src/deadObj.ml | 2 + src/deadObj.mli | 3 + src/deadSign.ml | 67 ++++++++++++++++++++++- src/deadSign.mli | 14 +++++ src/deadType.ml | 13 +++++ src/deadType.mli | 3 + 13 files changed, 145 insertions(+), 139 deletions(-) diff --git a/check/classic/classic.ref b/check/classic/classic.ref index 3bf35ec..9bbe7ac 100644 --- a/check/classic/classic.ref +++ b/check/classic/classic.ref @@ -181,20 +181,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -364,14 +350,6 @@ Nothing else to report in this section ============================= ./examples/docs/coding_style/opt/opt.ml:15: ?index -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?always: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:3: ?max ./examples/docs/optional_arguments/code_constructs/hof/hof_bin.ml:2: ?index @@ -533,14 +511,6 @@ Nothing else to report in this section .> OPTIONAL ARGUMENTS: NEVER: ============================ -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?never: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:2: ?min ./examples/docs/optional_arguments/code_constructs/internal_app/internal_app_lib.ml:2: ?min @@ -757,7 +727,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 629 +Total: 599 Success: 595 -Failed: 34 -Ratio: 94.5945945946% +Failed: 4 +Ratio: 99.3322203673% diff --git a/check/internal/internal.ref b/check/internal/internal.ref index dfca2d8..0459212 100644 --- a/check/internal/internal.ref +++ b/check/internal/internal.ref @@ -133,20 +133,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -316,14 +302,6 @@ Nothing else to report in this section ============================= ./examples/docs/coding_style/opt/opt.ml:15: ?index -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?always: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:3: ?max ./examples/docs/optional_arguments/code_constructs/hof/hof_bin.ml:2: ?index @@ -485,14 +463,6 @@ Nothing else to report in this section .> OPTIONAL ARGUMENTS: NEVER: ============================ -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?never: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:2: ?min ./examples/docs/optional_arguments/code_constructs/internal_app/internal_app_lib.ml:2: ?min @@ -709,7 +679,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 585 +Total: 555 Success: 551 -Failed: 34 -Ratio: 94.188034188% +Failed: 4 +Ratio: 99.2792792793% diff --git a/check/threshold-1/threshold-1.ref b/check/threshold-1/threshold-1.ref index c1dc3ba..0538fc9 100644 --- a/check/threshold-1/threshold-1.ref +++ b/check/threshold-1/threshold-1.ref @@ -426,20 +426,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -782,14 +768,6 @@ Nothing else to report in this section ============================= ./examples/docs/coding_style/opt/opt.ml:15: ?index -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?always: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:3: ?max ./examples/docs/optional_arguments/code_constructs/hof/hof_bin.ml:2: ?index @@ -951,14 +929,6 @@ Nothing else to report in this section .> OPTIONAL ARGUMENTS: NEVER: ============================ -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?never: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:2: ?min ./examples/docs/optional_arguments/code_constructs/internal_app/internal_app_lib.ml:2: ?min @@ -1175,7 +1145,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 972 +Total: 942 Success: 935 -Failed: 37 -Ratio: 96.1934156379% +Failed: 7 +Ratio: 99.2569002123% diff --git a/check/threshold-3-0.5/threshold-3-0.5.ref b/check/threshold-3-0.5/threshold-3-0.5.ref index dad4cec..e345004 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.ref +++ b/check/threshold-3-0.5/threshold-3-0.5.ref @@ -569,20 +569,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:7: With.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Ftor_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: Incl_with.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:8: With.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.c#m: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -1007,14 +993,6 @@ Nothing else to report in this section ============================= ./examples/docs/coding_style/opt/opt.ml:15: ?index -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?always: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?always: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:3: ?max ./examples/docs/optional_arguments/code_constructs/hof/hof_bin.ml:2: ?index @@ -1273,14 +1251,6 @@ Nothing else to report in this section .> OPTIONAL ARGUMENTS: NEVER: ============================ -./examples/docs/limitations/modtype/modtype_with_intf.mli:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:18: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:29: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_with_intf.mli:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:9: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:36: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:74: ?never: Should not be detected -./examples/docs/limitations/modtype/modtype_without_intf.ml:108: ?never: Should not be detected ./examples/docs/optional_arguments/code_constructs/external_app/external_app_lib.mli:2: ?min ./examples/docs/optional_arguments/code_constructs/internal_app/internal_app_lib.ml:2: ?min @@ -1579,7 +1549,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1294 +Total: 1264 Success: 1257 -Failed: 37 -Ratio: 97.1406491499% +Failed: 7 +Ratio: 99.4462025316% diff --git a/src/deadCode.ml b/src/deadCode.ml index 8ff150d..eb2b792 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -291,6 +291,11 @@ let collect_references = (* Tast_mapper *) (fun self x -> DeadMod.expr x; super.Tast_mapper.module_expr self x) (fun x -> x.mod_loc) in + let module_type = + wrap + (fun self x -> DeadMod.type_ x; super.Tast_mapper.module_type self x) + (fun x -> x.mty_loc) + in let class_structure = (fun self x -> DeadObj.class_structure x; super.Tast_mapper.class_structure self x) @@ -310,9 +315,11 @@ let collect_references = (* Tast_mapper *) super.Tast_mapper.type_declaration self x in Tast_mapper.{ super with - structure_item; expr; pat; value_binding; - module_expr; class_structure; class_field; typ; - type_declaration + structure_item; + expr; pat; value_binding; + module_expr; module_type; + class_structure; class_field; + typ; type_declaration } @@ -494,7 +501,11 @@ let load_file fn state = (* Prepare the list of opt_args for report *) let analyze_opt_args () = DeadArg.eocb (); - let dec_loc loc = Hashtbl.mem main_files (Utils.Filepath.unit loc.Lexing.pos_fname) in + let dec_loc loc = + (* Is the location among the analyzed code and not part of a module type *) + Hashtbl.mem main_files (Utils.Filepath.unit loc.Lexing.pos_fname) + && not (Hashtbl.mem DeadCommon.in_modtype loc) + in let all = ref [] in let opt_args_tbl = Hashtbl.create 256 in diff --git a/src/deadCommon.ml b/src/deadCommon.ml index 93f915a..d1fc532 100644 --- a/src/deadCommon.ml +++ b/src/deadCommon.ml @@ -400,6 +400,18 @@ let export ?(sep = ".") path u stock id loc = let builddir = State.File_infos.get_builddir state.file_infos in hashtbl_add_to_list stock loc.Location.loc_start (builddir, value) +let unexport stock loc = + let state = State.get_current () in + (* The builddir works as a second key to ensure we are not removing + the location of another compilation unit. + *) + let builddir = State.File_infos.get_builddir state.file_infos in + let different_builddir (b, _v) = + not (String.equal b builddir) + in + hashtbl_find_list stock loc.Location.loc_start + |> List.filter different_builddir + |> hashtbl_replace_list stock loc.Location.loc_start (**** REPORTING ****) diff --git a/src/deadMod.ml b/src/deadMod.ml index 6d0fd9a..d5d4fd0 100644 --- a/src/deadMod.ml +++ b/src/deadMod.ml @@ -76,6 +76,13 @@ let expr m = match m.mod_desc with | _ -> () +let type_ mt = + let on_mismatch signature = + List.iter DeadSign.correct_export signature + in + DeadSign.modtype ~on_mismatch mt + + (******** WRAPPING ********) let expr m = diff --git a/src/deadObj.ml b/src/deadObj.ml index cc131d0..3bdb0be 100644 --- a/src/deadObj.ml +++ b/src/deadObj.ml @@ -215,6 +215,8 @@ let collect_export path u stock ~obj ~cltyp loc = treat_fields save typ | None -> () +let correct_export loc = DeadCommon.unexport decs loc + let collect_references ~meth ~call_site expr = let loc = locate expr in diff --git a/src/deadObj.mli b/src/deadObj.mli index 1602d8c..b5ce97a 100644 --- a/src/deadObj.mli +++ b/src/deadObj.mli @@ -24,6 +24,9 @@ val collect_export : -> Location.t -> unit +val correct_export : Location.t -> unit +(** Undo export collection for the specified location *) + val collect_references : meth: string diff --git a/src/deadSign.ml b/src/deadSign.ml index 805d677..d0fa6d3 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -75,11 +75,68 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = in collect_export context path stock sig_item +let correct_export sig_item = + let state = State.get_current () in + let rec correct_export : Types.signature_item -> unit = function + | Sig_value (id, {Types.val_loc; _}, _) -> + DeadCommon.unexport DeadCommon.decs val_loc; + DeadObj.correct_export val_loc; + (* For optional arguments, every use is stored during the analysis. + The uses are then filtered before reporting. Thus, we need to + remember "wrong" exports until then. + *) + if Config.must_report_opt_args state.config then + let comp_unit = + Utils.Filepath.unit val_loc.Location.loc_start.Lexing.pos_fname + in + let path = Ident.create_persistent "DUMMY_PATH":: [] in + DeadCommon.export path comp_unit DeadCommon.in_modtype id val_loc + | Sig_type (_, t, _, _) -> DeadType.correct_export t + | Sig_class (_, {cty_loc; _}, _, _) -> DeadObj.correct_export cty_loc + | Sig_module (_, _, {Types.md_type = t; _}, _, _) + | Sig_modtype (_, {Types.mtd_type = Some t; _}, _) -> + Utils.signature_of_modtype t + |> List.iter correct_export + | _ -> () + in + match state.file_infos.cm_sign with + | Some (Cmti_sign _) -> + (* Typedtree signatures found in .cmti files do not need correction *) + () + | _ -> correct_export sig_item + +let modtype ~on_mismatch (mt : Typedtree.module_type) = + let types_sig = Utils.signature_of_modtype mt.mty_type in + let typedtree_sig = Utils.typedtree_signature_of_modtype mt in + match types_sig, typedtree_sig with + | _::_, None -> on_mismatch types_sig + | _ -> () + let collect_export_from_typedtree ~path ~comp_unit signature = + let state = State.get_current () in let should_export_value = - let state = State.get_current () in Config.must_report_section state.config.sections.exported_values in + let mark_modtype_elements ~path ~loc mt = + (* For optional arguments, every use is stored during the analysis. + The uses are then filtered before reporting. Thus, we need to + remember "wrong" exports until then. + *) + let on_mismatch signature = + let id = + match path with + | [] -> Ident.create_persistent "DUMMY_ID" + | id :: _ -> id + in + let context = In_modtyp (id, loc) in + let stock = DeadCommon.in_modtype in + List.iter + (collect_export ~context ~path ~comp_unit ~stock) + signature + in + if Config.must_report_opt_args state.config then + modtype ~on_mismatch mt + in let rec collect_signature path Typedtree.{sig_items; _} = List.iter (collect_item path) sig_items and collect_item path sig_item = @@ -109,10 +166,14 @@ let collect_export_from_typedtree ~path ~comp_unit signature = in List.iter export_class class_descs - | Tsig_module {md_id = Some id; md_type; _} -> + | Tsig_module {md_id = Some id; md_type; md_loc; _} -> let path = id :: path in Utils.typedtree_signature_of_modtype md_type - |> Option.iter (collect_signature path) + |> Option.iter (collect_signature path); + mark_modtype_elements ~path ~loc:md_loc md_type + + | Tsig_include {incl_mod; incl_loc; _} -> + mark_modtype_elements ~path ~loc:incl_loc incl_mod | _ -> () in diff --git a/src/deadSign.mli b/src/deadSign.mli index b7028cc..804f767 100644 --- a/src/deadSign.mli +++ b/src/deadSign.mli @@ -22,6 +22,11 @@ val collect_export : or an [Include] *) +val correct_export : Types.signature_item -> unit +(** Unexport the signature_item. This is used to correct wrongful exports from + {!collect_export} above +*) + val collect_export_from_typedtree : path:Ident.t list -> comp_unit:string -> @@ -32,3 +37,12 @@ val collect_export_from_typedtree : (values, constructors, ...) in {!DeadCommon.desc}. See {!collect_export} above for more information. *) + +val modtype : + on_mismatch: (Types.signature -> unit) -> + Typedtree.module_type + -> unit +(** [modtype ~on_mismatch mt] checks that the Typedtree and Types signatures + for [mt] agree. I.e. if the first one is explicit when the second one is. + If not, then the first one is implicit and [on_mismatch] is called on the + second. *) diff --git a/src/deadType.ml b/src/deadType.ml index 1a3b99b..668324a 100644 --- a/src/deadType.ml +++ b/src/deadType.ml @@ -94,6 +94,19 @@ let collect_export path u stock t = List.iter (fun {Types.cd_id; cd_loc; _} -> save cd_id cd_loc) l | _ -> () +let correct_export t = + let unexport loc = DeadCommon.unexport decs loc in + match t.type_kind with + | Type_record (l, _) -> + List.iter + (fun {Types.ld_loc; _} -> + unexport ld_loc; + ) + l + | Type_variant (l, _) -> + List.iter (fun {Types.cd_loc; _} -> unexport cd_loc) l + | _ -> () + let collect_references loc exp_loc = LocHash.add_set references loc exp_loc diff --git a/src/deadType.mli b/src/deadType.mli index 28eed7b..a7280fe 100644 --- a/src/deadType.mli +++ b/src/deadType.mli @@ -32,6 +32,9 @@ val collect_export : -> Types.type_declaration -> unit +val correct_export : Types.type_declaration -> unit +(** Undo export collection for the specified type_decl *) + val collect_references : Lexing.position -> Lexing.position -> unit From 934145c98c9cf37595d6b73017e851a9c7a2648a Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Tue, 4 Aug 2026 16:44:57 +0200 Subject: [PATCH 06/10] [docs][limitations] merge modtype The modtype limitation was used as an exemple for false positives that did not follow the semantics on module types. Now that these false positives are fixed, the exemples are used to describe the module type semantics (still considered a limitation) as a whole. --- docs/LIMITATIONS.md | 277 +------------------------------------------- 1 file changed, 1 insertion(+), 276 deletions(-) diff --git a/docs/LIMITATIONS.md b/docs/LIMITATIONS.md index 30c78de..776c1b4 100644 --- a/docs/LIMITATIONS.md +++ b/docs/LIMITATIONS.md @@ -1,7 +1,6 @@ # Table of contents + [Module type](#module-type) -+ [Module type with and inclusion](#module-type-with-and-inclusion) The limitations listed below apply to all the reportable elements of code. Coding style issues are not concerned unless specified otherwise. @@ -22,279 +21,5 @@ A future improvement would be to report unused elements declared in module types by considering all the elemnts defined in modules of such types as instances of the elements in the module types. -# Module type with and inclusion - -Related issue : -[issue #64](https://github.com/LexiFi/dead_code_analyzer/issues/64). - -According to the above limitation on elements in module types, elements included -from a module type (`include T`) should not be reported. Even more so according -to the semantics described in the -[exported values' Include](./exported_values/code_constructs/INCLUDE.md) -example. -Similarly, elements defined in a module type with constraints (`T with ...`) -should not be reported. - -This is mostly the case for unused exported values, unless there is a substition -(`T with ... := ...`) and not .mli is provided, or a .mli is provided and the 2 -contructs are mixed into an included module type with substitution -(`include T with ... := ...`). -This is however, not the case at all for constructors, fields, and methods. -Optional arguments always/never used are only affected by substitutions. - -## Example - -The reference files for this example are in the +Examples of this limitation are avaialble in the [modtype](../../examples/docs/limitations/modtype) directory. - -The reference takes place in `/tmp/docs/limitations`, which -is a copy of the [limitations](../../examples/docs/limitations) directory. -Reported locations may differ depending on the location of the source files. - -The compilation command is : -``` -make -C modtype build -``` - -The analysis command is : -``` -make -C modtype analyze -``` - -The compile + analyze command is : -``` -make -C modtype -``` - -Code: -```OCaml -(* modtype_with_intf.mli *) -module type T = sig - type t - type ctor = Ctor - type field = {field : unit} - val x : t - val o : < m : t > - class c : object method m : t end - val f : ?always:t -> ?never:t -> unit -> t - (* to use as [always] in call to [f] *) - val always : t -end - -module Regular : T - -module With : T with type t = int - -module Subst : T with type t := int - -module Incl : sig - include T -end - -module Incl_with : sig - include T with type t = int -end - -module Incl_subst : sig - include T with type t := int -end - -module Ftor () : T - -module Ftor_with () : T with type t = int - -module Ftor_subst () : T with type t := int -``` -The other files are not displayed here. -`modtype_without_intf` is equivalent to `modtype_with_intf`'s interface and -implementation merged together. `modtype_bin` uses the function's `f` to track -its optional parameters. -The modules are all defined as: -```OCaml -struct - type t = int - type ctor = Ctor - type field = {field : unit} - let x = 0 - let o = object method m = 0 end - class c = object method m = 0 end - let f ?always:_ ?never:_ () = 0 - let always = 0 -end -``` - -Compile and analyze: -``` -$ make -C modtype -make: Entering directory '/tmp/docs/limitations/modtype' -ocamlopt -bin-annot modtype_with_intf.mli modtype_with_intf.ml modtype_without_intf.ml modtype_bin.ml -dead_code_analyzer --all -E threshold:4 -M threshold:4 -T threshold:4 . -Scanning files... - [DONE] - -.> UNUSED EXPORTED VALUES: -========================= - - -.>-> ALMOST UNUSED EXPORTED VALUES: Called 2 time(s): -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.always -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.f -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.x --------- - - -.>-> ALMOST UNUSED EXPORTED VALUES: Called 4 time(s): -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.f -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.x -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.f -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.x -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.f -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.x - -Nothing else to report in this section --------------------------------------------------------------------------------- - - -.> UNUSED METHODS: -================= -/tmp/docs/limitations/modtype/modtype_with_intf.mli:7: Ftor_with.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:7: Incl.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:7: Incl_with.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:7: With.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:8: Ftor_with.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:8: Incl.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:8: Incl_with.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:8: With.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.o#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.c#m -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:7: Ftor_with.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:7: Incl.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:7: Incl_with.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:7: With.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:8: Ftor_with.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:8: Incl.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:8: Incl_with.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:8: With.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.o#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.c#m -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.o#m --------- - - - -Nothing else to report in this section --------------------------------------------------------------------------------- - - -.> UNUSED CONSTRUCTORS/RECORD FIELDS: -==================================== -/tmp/docs/limitations/modtype/modtype_with_intf.mli:4: Ftor_with.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:4: Incl.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:4: Incl_with.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:4: With.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:5: Ftor_with.field.field -/tmp/docs/limitations/modtype/modtype_with_intf.mli:5: Incl.field.field -/tmp/docs/limitations/modtype/modtype_with_intf.mli:5: Incl_with.field.field -/tmp/docs/limitations/modtype/modtype_with_intf.mli:5: With.field.field --------- - - -.>-> ALMOST UNUSED CONSTRUCTORS/RECORD FIELDS: Called 2 time(s): -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: Subst.field.field -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: Incl_subst.field.field -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: Ftor_subst.field.field --------- - - -.>-> ALMOST UNUSED CONSTRUCTORS/RECORD FIELDS: Called 4 time(s): -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -/tmp/docs/limitations/modtype/modtype_without_intf.ml:4: Ftor_with.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:4: Incl.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:4: Incl_with.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:4: With.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:5: Ftor_with.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:5: Incl.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:5: Incl_with.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:5: With.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: Subst.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: Incl_subst.field.field -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.ctor.Ctor -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: Ftor_subst.field.field - -Nothing else to report in this section --------------------------------------------------------------------------------- --------------------------------------------------------------------------------- - - -.> OPTIONAL ARGUMENTS: ALWAYS: -============================= -/tmp/docs/limitations/modtype/modtype_with_intf.mli:9: ?always -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: ?always -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: ?always -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: ?always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:9: ?always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: ?always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: ?always -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: ?always - -Nothing else to report in this section --------------------------------------------------------------------------------- - - -.> OPTIONAL ARGUMENTS: NEVER: -============================ -/tmp/docs/limitations/modtype/modtype_with_intf.mli:9: ?never -/tmp/docs/limitations/modtype/modtype_with_intf.mli:18: ?never -/tmp/docs/limitations/modtype/modtype_with_intf.mli:29: ?never -/tmp/docs/limitations/modtype/modtype_with_intf.mli:36: ?never -/tmp/docs/limitations/modtype/modtype_without_intf.ml:9: ?never -/tmp/docs/limitations/modtype/modtype_without_intf.ml:36: ?never -/tmp/docs/limitations/modtype/modtype_without_intf.ml:74: ?never -/tmp/docs/limitations/modtype/modtype_without_intf.ml:108: ?never - -Nothing else to report in this section --------------------------------------------------------------------------------- - - -.> CODING STYLE: -=============== - -Nothing else to report in this section --------------------------------------------------------------------------------- - - -make: Leaving directory '/tmp/docs/limitations/modtype' -``` -> [!NOTE] -> The analyzer is run with thresholds. Because elements of `T` share the same -> location at the point of use of `T`, the analyzer gets confused and considers -> some unused elements as used. Using thresholds enables reporting elements used -> up to a fixed amount. -> For more details about the command line arguments see [the more general Usage -documentation](../USAGE.md). - -The analyzer reports elements although they are all defined within module type -`T`. -Following its semantics on module types, the report should be empty. From bff68c60232c37f2fe858d18c6670a02948edaa9 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Tue, 4 Aug 2026 18:03:32 +0200 Subject: [PATCH 07/10] [src] change `in_modtype` to `implicit_decs` This value only stores "implicit re-declarations" which appear as regular new declarations in `Types.signature`. In addition, this stock is only useful to filter out opt args related to such implicit re-declarations so it is only filled out if opt args are enabled. Finally, because it is only related to opt args, it is not used anymore to avoid "wronfully" exporting values that were implicit re-declarations. These values are identified and corrected by `DeadSign.correct_export`. --- src/deadCode.ml | 2 +- src/deadCommon.ml | 5 +++-- src/deadSign.ml | 45 ++++++++++++++++++++------------------------- 3 files changed, 24 insertions(+), 28 deletions(-) diff --git a/src/deadCode.ml b/src/deadCode.ml index eb2b792..3306fd1 100644 --- a/src/deadCode.ml +++ b/src/deadCode.ml @@ -504,7 +504,7 @@ let analyze_opt_args () = let dec_loc loc = (* Is the location among the analyzed code and not part of a module type *) Hashtbl.mem main_files (Utils.Filepath.unit loc.Lexing.pos_fname) - && not (Hashtbl.mem DeadCommon.in_modtype loc) + && not (Hashtbl.mem DeadCommon.implicit_decs loc) in let all = ref [] in let opt_args_tbl = Hashtbl.create 256 in diff --git a/src/deadCommon.ml b/src/deadCommon.ml index d1fc532..f3f162a 100644 --- a/src/deadCommon.ml +++ b/src/deadCommon.ml @@ -39,8 +39,9 @@ let abspath : (string, string) Hashtbl.t = Hashtbl.create 256 (* all exported value declarations *) let decs : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 -(* all exported value declarations found in module types *) -let in_modtype : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 +(* all value declarations re-exported by module types uses. + The [(string * string)] is only to match the type of other stocks *) +let implicit_decs : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 (* all exported value declarations *) let incl : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 diff --git a/src/deadSign.ml b/src/deadSign.ml index d0fa6d3..2d0b85a 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -35,12 +35,18 @@ let should_export_value ~context ~stock loc = && md_end > v_end in Config.must_report_section state.config.sections.exported_values - && (* do not add the loc in decs if it belongs to a module type - or if it is not actually declared in the current context *) - ( stock != DeadCommon.decs - || (not (Hashtbl.mem DeadCommon.in_modtype loc.Location.loc_start) - && belongs_to_context loc) - ) + && (* do not add the loc in decs if it is not actually declared in + the current context *) + (stock != DeadCommon.decs || belongs_to_context loc) + +let wrongful_export loc = + (* For optional arguments, every use is stored during the analysis. + The uses are then filtered before reporting. Thus, we need to + remember "wrong" exports until then. + *) + let state = State.get_current () in + if Config.must_report_opt_args state.config then + Hashtbl.add DeadCommon.implicit_decs loc.Location.loc_start ("", "") let collect_export ~context ~path ~comp_unit ~stock sig_item = let rec collect_export context path stock : Types.signature_item -> unit = @@ -60,13 +66,11 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = | Sig_class (id, {Types.cty_type = t; cty_loc = loc; _}, _, _) -> DeadObj.collect_export (id :: path) comp_unit stock ~cltyp:t loc - | (Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) - | Sig_modtype (id, {Types.mtd_type = Some t; mtd_loc = loc; _}, _)) as s -> - let stock, context = - match s, context with - | _, Include -> stock, Include - | Sig_modtype _, _ -> DeadCommon.in_modtype, In_modtyp (id, loc) - | _, _ -> stock, In_module (id, loc) + | Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) -> + let context = + match context with + | Include -> context + | _ -> In_module (id, loc) in Utils.signature_of_modtype t |> List.iter (collect_export context (id::path) stock) @@ -78,19 +82,10 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = let correct_export sig_item = let state = State.get_current () in let rec correct_export : Types.signature_item -> unit = function - | Sig_value (id, {Types.val_loc; _}, _) -> + | Sig_value (_, {Types.val_loc; _}, _) -> DeadCommon.unexport DeadCommon.decs val_loc; DeadObj.correct_export val_loc; - (* For optional arguments, every use is stored during the analysis. - The uses are then filtered before reporting. Thus, we need to - remember "wrong" exports until then. - *) - if Config.must_report_opt_args state.config then - let comp_unit = - Utils.Filepath.unit val_loc.Location.loc_start.Lexing.pos_fname - in - let path = Ident.create_persistent "DUMMY_PATH":: [] in - DeadCommon.export path comp_unit DeadCommon.in_modtype id val_loc + wrongful_export val_loc | Sig_type (_, t, _, _) -> DeadType.correct_export t | Sig_class (_, {cty_loc; _}, _, _) -> DeadObj.correct_export cty_loc | Sig_module (_, _, {Types.md_type = t; _}, _, _) @@ -129,7 +124,7 @@ let collect_export_from_typedtree ~path ~comp_unit signature = | id :: _ -> id in let context = In_modtyp (id, loc) in - let stock = DeadCommon.in_modtype in + let stock = DeadCommon.implicit_decs in List.iter (collect_export ~context ~path ~comp_unit ~stock) signature From 4fc44a78144bd1bdf6410787b7a362e4d8dd1900 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Wed, 5 Aug 2026 12:07:05 +0200 Subject: [PATCH 08/10] [docs][limitations] add module type of The new limitation is a corollary of the one on module types. Corresponding examples (derived from `modtype`'s) are added in `examples/docs/limitations/modtype_of`. --- check/classic/classic.ref | 12 +- check/internal/internal.ref | 12 +- check/threshold-1/threshold-1.ref | 12 +- check/threshold-3-0.5/threshold-3-0.5.ref | 12 +- docs/LIMITATIONS.md | 11 ++ examples/docs/limitations/Makefile | 2 + .../docs/limitations/modtype/modtype_bin.ml | 1 + .../limitations/modtype/modtype_with_intf.ml | 2 +- examples/docs/limitations/modtype_of/Makefile | 12 ++ .../limitations/modtype_of/modtype_of_bin.ml | 30 +++++ .../modtype_of/modtype_of_with_intf.ml | 111 +++++++++++++++++ .../modtype_of/modtype_of_with_intf.mli | 36 ++++++ .../modtype_of/modtype_of_without_intf.ml | 117 ++++++++++++++++++ 13 files changed, 357 insertions(+), 13 deletions(-) create mode 100644 examples/docs/limitations/modtype_of/Makefile create mode 100644 examples/docs/limitations/modtype_of/modtype_of_bin.ml create mode 100644 examples/docs/limitations/modtype_of/modtype_of_with_intf.ml create mode 100644 examples/docs/limitations/modtype_of/modtype_of_with_intf.mli create mode 100644 examples/docs/limitations/modtype_of/modtype_of_without_intf.ml diff --git a/check/classic/classic.ref b/check/classic/classic.ref index 9bbe7ac..866d034 100644 --- a/check/classic/classic.ref +++ b/check/classic/classic.ref @@ -48,6 +48,8 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -181,6 +183,8 @@ Nothing else to report in this section .> UNUSED METHODS: ================= +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -274,6 +278,8 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -727,7 +733,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 599 +Total: 605 Success: 595 -Failed: 4 -Ratio: 99.3322203673% +Failed: 10 +Ratio: 98.347107438% diff --git a/check/internal/internal.ref b/check/internal/internal.ref index 0459212..be2c597 100644 --- a/check/internal/internal.ref +++ b/check/internal/internal.ref @@ -38,6 +38,8 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -133,6 +135,8 @@ Nothing else to report in this section .> UNUSED METHODS: ================= +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -226,6 +230,8 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -679,7 +685,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 555 +Total: 561 Success: 551 -Failed: 4 -Ratio: 99.2792792793% +Failed: 10 +Ratio: 98.2174688057% diff --git a/check/threshold-1/threshold-1.ref b/check/threshold-1/threshold-1.ref index 0538fc9..053279d 100644 --- a/check/threshold-1/threshold-1.ref +++ b/check/threshold-1/threshold-1.ref @@ -38,6 +38,8 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -426,6 +428,8 @@ Nothing else to report in this section .> UNUSED METHODS: ================= +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -611,6 +615,8 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -1145,7 +1151,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 942 +Total: 948 Success: 935 -Failed: 7 -Ratio: 99.2569002123% +Failed: 13 +Ratio: 98.6286919831% diff --git a/check/threshold-3-0.5/threshold-3-0.5.ref b/check/threshold-3-0.5/threshold-3-0.5.ref index e345004..bb2a845 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.ref +++ b/check/threshold-3-0.5/threshold-3-0.5.ref @@ -38,6 +38,8 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -569,6 +571,8 @@ Nothing else to report in this section .> UNUSED METHODS: ================= +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -793,6 +797,8 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected +./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -1549,7 +1555,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1264 +Total: 1270 Success: 1257 -Failed: 7 -Ratio: 99.4462025316% +Failed: 13 +Ratio: 98.9763779528% diff --git a/docs/LIMITATIONS.md b/docs/LIMITATIONS.md index 776c1b4..f23703d 100644 --- a/docs/LIMITATIONS.md +++ b/docs/LIMITATIONS.md @@ -1,6 +1,7 @@ # Table of contents + [Module type](#module-type) ++ [Module type of](#module-type-of) The limitations listed below apply to all the reportable elements of code. Coding style issues are not concerned unless specified otherwise. @@ -23,3 +24,13 @@ of the elements in the module types. Examples of this limitation are avaialble in the [modtype](../../examples/docs/limitations/modtype) directory. + +# Module type of + +The same restricition as for the [Module type](#module-type) limitation above +is applied to modules whose module types are recovered via `module type of`. +Using this construction makes the module behave similarly to a module type, so +the module type semantics apply to it. + +Examples of this limitation are avaialble in the +[modtype_of](../../examples/docs/limitations/modtype_of) directory. diff --git a/examples/docs/limitations/Makefile b/examples/docs/limitations/Makefile index b14152c..ebf9a1a 100644 --- a/examples/docs/limitations/Makefile +++ b/examples/docs/limitations/Makefile @@ -4,7 +4,9 @@ all: build build: make -C modtype build + make -C modtype_of build clean: rm -f *~ *.cm* *.o *.obj make -C modtype clean + make -C modtype_of clean diff --git a/examples/docs/limitations/modtype/modtype_bin.ml b/examples/docs/limitations/modtype/modtype_bin.ml index 9759f41..efd5019 100644 --- a/examples/docs/limitations/modtype/modtype_bin.ml +++ b/examples/docs/limitations/modtype/modtype_bin.ml @@ -1,3 +1,4 @@ +(* modtype_bin.ml *) module M_intf = Modtype_with_intf.Ftor () module M_intf_with = Modtype_with_intf.Ftor_with () module M_intf_subst = Modtype_with_intf.Ftor_subst () diff --git a/examples/docs/limitations/modtype/modtype_with_intf.ml b/examples/docs/limitations/modtype/modtype_with_intf.ml index 364caf7..30bc351 100644 --- a/examples/docs/limitations/modtype/modtype_with_intf.ml +++ b/examples/docs/limitations/modtype/modtype_with_intf.ml @@ -1,4 +1,4 @@ -(* modtype_with_intf.mli *) +(* modtype_with_intf.ml *) module type T = sig type t type ctor = Ctor diff --git a/examples/docs/limitations/modtype_of/Makefile b/examples/docs/limitations/modtype_of/Makefile new file mode 100644 index 0000000..ebadc2e --- /dev/null +++ b/examples/docs/limitations/modtype_of/Makefile @@ -0,0 +1,12 @@ +SRC:=modtype_of_with_intf.mli modtype_of_with_intf.ml modtype_of_without_intf.ml modtype_of_bin.ml + +all: build analyze + +build: + ocamlopt -bin-annot ${SRC} + +analyze: + dead_code_analyzer --all -E threshold:4 -M threshold:4 -T threshold:4 . + +clean: + rm -f *.cm* *.o a.out diff --git a/examples/docs/limitations/modtype_of/modtype_of_bin.ml b/examples/docs/limitations/modtype_of/modtype_of_bin.ml new file mode 100644 index 0000000..e983843 --- /dev/null +++ b/examples/docs/limitations/modtype_of/modtype_of_bin.ml @@ -0,0 +1,30 @@ +(* modtype_of_bin.ml *) +module M_intf = Modtype_of_with_intf.Ftor () +module M_intf_with = Modtype_of_with_intf.Ftor_with () +module M_intf_subst = Modtype_of_with_intf.Ftor_subst () + +let () = + let open Modtype_of_with_intf in + With.(f ~always ()) |> ignore; + Subst.(f ~always ()) |> ignore; + Incl.(f ~always ()) |> ignore; + Incl_with.(f ~always ()) |> ignore; + Incl_subst.f ~always:Incl_subst.always () |> ignore; + M_intf.(f ~always ()) |> ignore; + M_intf_with.(f ~always ()) |> ignore; + M_intf_subst.(f ~always ()) |> ignore + +module M_no_intf = Modtype_of_without_intf.Ftor () +module M_no_intf_with = Modtype_of_without_intf.Ftor_with () +module M_no_intf_subst = Modtype_of_without_intf.Ftor_subst () + +let () = + let open Modtype_of_without_intf in + With.(f ~always ()) |> ignore; + Subst.(f ~always ()) |> ignore; + Incl.(f ~always ()) |> ignore; + Incl_with.(f ~always ()) |> ignore; + Incl_subst.f ~always:Incl_subst.always () |> ignore; + M_no_intf.(f ~always ()) |> ignore; + M_no_intf_with.(f ~always ()) |> ignore; + M_no_intf_subst.(f ~always ()) |> ignore diff --git a/examples/docs/limitations/modtype_of/modtype_of_with_intf.ml b/examples/docs/limitations/modtype_of/modtype_of_with_intf.ml new file mode 100644 index 0000000..3531c4e --- /dev/null +++ b/examples/docs/limitations/modtype_of/modtype_of_with_intf.ml @@ -0,0 +1,111 @@ +(* modtype_of_with_intf.ml *) +module M = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + (* to use as [always] in call to [f] *) + let always = 0 +end + +module Regular = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module With = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Subst = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl_with = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl_subst = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor() = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor_with() = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor_subst() = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end diff --git a/examples/docs/limitations/modtype_of/modtype_of_with_intf.mli b/examples/docs/limitations/modtype_of/modtype_of_with_intf.mli new file mode 100644 index 0000000..abc9e00 --- /dev/null +++ b/examples/docs/limitations/modtype_of/modtype_of_with_intf.mli @@ -0,0 +1,36 @@ +(* modtype_of_with_intf.mli *) +module M : sig + type t + type ctor = Ctor + type field = {field : unit} + val x : t + val o : < m : t > + class c : object method m : t end + val f : ?always:t -> ?never:t -> unit -> t + (* to use as [always] in call to [f] *) + val always : t +end + +module Regular : module type of M + +module With : module type of M with type t = int + +module Subst : module type of M with type t := int + +module Incl : sig + include module type of M +end + +module Incl_with : sig + include module type of M with type t = int +end + +module Incl_subst : sig + include module type of M with type t := int +end + +module Ftor () : module type of M + +module Ftor_with () : module type of M with type t = int + +module Ftor_subst () : module type of M with type t := int diff --git a/examples/docs/limitations/modtype_of/modtype_of_without_intf.ml b/examples/docs/limitations/modtype_of/modtype_of_without_intf.ml new file mode 100644 index 0000000..be80fc9 --- /dev/null +++ b/examples/docs/limitations/modtype_of/modtype_of_without_intf.ml @@ -0,0 +1,117 @@ +(* modtype_of_without_intf.ml *) +module M = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + (* to use as [always] in call to [f] *) + let always = 0 +end + +module Regular : module type of M = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module With : module type of M with type t = int = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Subst : module type of M with type t := int = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl : sig + include module type of M +end = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl_with : sig + include module type of M with type t = int +end = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Incl_subst : sig + include module type of M with type t := int +end = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor() : module type of M = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor_with() : module type of M with type t = int = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end + +module Ftor_subst() : module type of M with type t := int = struct + type t = int + type ctor = Ctor + type field = {field : unit} + let x = 0 + let o = object method m = 0 end + class c = object method m = 0 end + let f ?always:_ ?never:_ () = 0 + let always = 0 +end From 517055d144cb603feac4fa742c4e88127cffb496 Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Wed, 5 Aug 2026 13:16:01 +0200 Subject: [PATCH 09/10] [src][deadSign] fix modtype_of FP `correct_export` is first defined without guard in order to be used during `collect_export_from_typedtree` traversal. Then redefined with guard to avoid correcting Typedtree signatures during the structure analysis. This function is used instead of `collect_export`. This avoids the risk of not storing the desired locs in `implicit_decs`. As a result, `implicit_decs` does not need to be a "stock" anymore and is only used to store locations (the table's values are units). --- check/classic/classic.ref | 12 ++--- check/internal/internal.ref | 12 ++--- check/threshold-1/threshold-1.ref | 12 ++--- check/threshold-3-0.5/threshold-3-0.5.ref | 12 ++--- src/deadCommon.ml | 5 +- src/deadSign.ml | 65 ++++++++++------------- 6 files changed, 41 insertions(+), 77 deletions(-) diff --git a/check/classic/classic.ref b/check/classic/classic.ref index 866d034..9bbe7ac 100644 --- a/check/classic/classic.ref +++ b/check/classic/classic.ref @@ -48,8 +48,6 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -183,8 +181,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -278,8 +274,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -733,7 +727,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 605 +Total: 599 Success: 595 -Failed: 10 -Ratio: 98.347107438% +Failed: 4 +Ratio: 99.3322203673% diff --git a/check/internal/internal.ref b/check/internal/internal.ref index be2c597..0459212 100644 --- a/check/internal/internal.ref +++ b/check/internal/internal.ref @@ -38,8 +38,6 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -135,8 +133,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -230,8 +226,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -685,7 +679,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 561 +Total: 555 Success: 551 -Failed: 10 -Ratio: 98.2174688057% +Failed: 4 +Ratio: 99.2792792793% diff --git a/check/threshold-1/threshold-1.ref b/check/threshold-1/threshold-1.ref index 053279d..0538fc9 100644 --- a/check/threshold-1/threshold-1.ref +++ b/check/threshold-1/threshold-1.ref @@ -38,8 +38,6 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -428,8 +426,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -615,8 +611,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -1151,7 +1145,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 948 +Total: 942 Success: 935 -Failed: 13 -Ratio: 98.6286919831% +Failed: 7 +Ratio: 99.2569002123% diff --git a/check/threshold-3-0.5/threshold-3-0.5.ref b/check/threshold-3-0.5/threshold-3-0.5.ref index bb2a845..e345004 100644 --- a/check/threshold-3-0.5/threshold-3-0.5.ref +++ b/check/threshold-3-0.5/threshold-3-0.5.ref @@ -38,8 +38,6 @@ ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:4: redefined_unused ./examples/docs/exported_values/limitations/incl_same_name/to_incl/without_intf.ml:5: redefined_used -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:6: M.x: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o: Should not be detected ./examples/docs/methods/code_constructs/factory_fun/factory_fun_bin.ml:2: unused_factory ./examples/docs/methods/code_constructs/immediate_object/immediate_object_bin.ml:2: unused_obj @@ -571,8 +569,6 @@ Nothing else to report in this section .> UNUSED METHODS: ================= -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:7: M.o#m: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:8: M.c#m: Should not be detected ./examples/docs/methods/code_constructs/class/class_bin.ml:2: unused_class#unused_method ./examples/docs/methods/code_constructs/class/class_lib.mli:2: int_stack#reset @@ -797,8 +793,6 @@ Nothing else to report in this section ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:2: either.Right ./examples/docs/fields_and_constructors/code_constructs/polymorphic_type/polymorphic_type_lib.mli:3: both.left -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:4: M.ctor.Ctor: Should not be detected -./examples/docs/limitations/modtype_of/modtype_of_with_intf.mli:5: M.field.field: Should not be detected ./examples/using_dune/preprocessed_lib/preprocessed.mli:14: constructors.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:19: constr_with_eq.Unused ./examples/using_dune/preprocessed_lib/preprocessed.mli:23: record.unused @@ -1555,7 +1549,7 @@ Nothing else to report in this section -------------------------------------------------------------------------------- -Total: 1270 +Total: 1264 Success: 1257 -Failed: 13 -Ratio: 98.9763779528% +Failed: 7 +Ratio: 99.4462025316% diff --git a/src/deadCommon.ml b/src/deadCommon.ml index f3f162a..7a34189 100644 --- a/src/deadCommon.ml +++ b/src/deadCommon.ml @@ -39,9 +39,8 @@ let abspath : (string, string) Hashtbl.t = Hashtbl.create 256 (* all exported value declarations *) let decs : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 -(* all value declarations re-exported by module types uses. - The [(string * string)] is only to match the type of other stocks *) -let implicit_decs : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 +(* all value declarations re-exported by module types uses *) +let implicit_decs : (Lexing.position, unit) Hashtbl.t = Hashtbl.create 256 (* all exported value declarations *) let incl : (Lexing.position, string * string) Hashtbl.t = Hashtbl.create 256 diff --git a/src/deadSign.ml b/src/deadSign.ml index 2d0b85a..9a750e6 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -46,7 +46,7 @@ let wrongful_export loc = *) let state = State.get_current () in if Config.must_report_opt_args state.config then - Hashtbl.add DeadCommon.implicit_decs loc.Location.loc_start ("", "") + Hashtbl.replace DeadCommon.implicit_decs loc.Location.loc_start () let collect_export ~context ~path ~comp_unit ~stock sig_item = let rec collect_export context path stock : Types.signature_item -> unit = @@ -79,26 +79,18 @@ let collect_export ~context ~path ~comp_unit ~stock sig_item = in collect_export context path stock sig_item -let correct_export sig_item = - let state = State.get_current () in - let rec correct_export : Types.signature_item -> unit = function - | Sig_value (_, {Types.val_loc; _}, _) -> - DeadCommon.unexport DeadCommon.decs val_loc; - DeadObj.correct_export val_loc; - wrongful_export val_loc - | Sig_type (_, t, _, _) -> DeadType.correct_export t - | Sig_class (_, {cty_loc; _}, _, _) -> DeadObj.correct_export cty_loc - | Sig_module (_, _, {Types.md_type = t; _}, _, _) - | Sig_modtype (_, {Types.mtd_type = Some t; _}, _) -> - Utils.signature_of_modtype t - |> List.iter correct_export - | _ -> () - in - match state.file_infos.cm_sign with - | Some (Cmti_sign _) -> - (* Typedtree signatures found in .cmti files do not need correction *) - () - | _ -> correct_export sig_item +let rec correct_export : Types.signature_item -> unit = function + | Sig_value (_, {Types.val_loc; _}, _) -> + DeadCommon.unexport DeadCommon.decs val_loc; + DeadObj.correct_export val_loc; + wrongful_export val_loc + | Sig_type (_, t, _, _) -> DeadType.correct_export t + | Sig_class (_, {cty_loc; _}, _, _) -> DeadObj.correct_export cty_loc + | Sig_module (_, _, {Types.md_type = t; _}, _, _) + | Sig_modtype (_, {Types.mtd_type = Some t; _}, _) -> + Utils.signature_of_modtype t + |> List.iter correct_export + | _ -> () let modtype ~on_mismatch (mt : Typedtree.module_type) = let types_sig = Utils.signature_of_modtype mt.mty_type in @@ -112,23 +104,12 @@ let collect_export_from_typedtree ~path ~comp_unit signature = let should_export_value = Config.must_report_section state.config.sections.exported_values in - let mark_modtype_elements ~path ~loc mt = + let mark_modtype_elements mt = (* For optional arguments, every use is stored during the analysis. The uses are then filtered before reporting. Thus, we need to remember "wrong" exports until then. *) - let on_mismatch signature = - let id = - match path with - | [] -> Ident.create_persistent "DUMMY_ID" - | id :: _ -> id - in - let context = In_modtyp (id, loc) in - let stock = DeadCommon.implicit_decs in - List.iter - (collect_export ~context ~path ~comp_unit ~stock) - signature - in + let on_mismatch signature = List.iter correct_export signature in if Config.must_report_opt_args state.config then modtype ~on_mismatch mt in @@ -161,15 +142,23 @@ let collect_export_from_typedtree ~path ~comp_unit signature = in List.iter export_class class_descs - | Tsig_module {md_id = Some id; md_type; md_loc; _} -> + | Tsig_module {md_id = Some id; md_type; _} -> let path = id :: path in Utils.typedtree_signature_of_modtype md_type |> Option.iter (collect_signature path); - mark_modtype_elements ~path ~loc:md_loc md_type + mark_modtype_elements md_type - | Tsig_include {incl_mod; incl_loc; _} -> - mark_modtype_elements ~path ~loc:incl_loc incl_mod + | Tsig_include {incl_mod; _} -> + mark_modtype_elements incl_mod | _ -> () in collect_signature path signature + +let correct_export sig_item = + let state = State.get_current () in + match state.file_infos.cm_sign with + | Some (Cmti_sign _) -> + (* Typedtree signatures found in .cmti files do not need correction *) + () + | _ -> correct_export sig_item From 62b3666ac85fdd80a2d3f1a2e95fba18d369a10a Mon Sep 17 00:00:00 2001 From: Corentin De Souza <9597216+fantazio@users.noreply.github.com> Date: Wed, 5 Aug 2026 10:00:36 +0200 Subject: [PATCH 10/10] [src][deadSign] refactor 3 functions `export_value, `export_type`, and `export_class` are defined to share logic between `collect_export` and `collect_export_from_typedtree`. `collect_export` is flattened. The `should_export` logic is simplified to ignore the substitution case because it is now handled by `correct_export`. As a result, `context` does not include `In_modtyp` anymore, and `DeadCommon.implicit_decs` does not need to resemble a stock (now use `unit` as value). --- src/deadSign.ml | 155 ++++++++++++++++++++++++----------------------- src/deadSign.mli | 1 - 2 files changed, 79 insertions(+), 77 deletions(-) diff --git a/src/deadSign.ml b/src/deadSign.ml index 9a750e6..e0701f9 100644 --- a/src/deadSign.ml +++ b/src/deadSign.ml @@ -1,97 +1,101 @@ type context = | Toplevel | In_module of (Ident.t * Location.t) - | In_modtyp of (Ident.t * Location.t) | Include + +let export_value should_export ~path ~comp_unit ~stock id value = + let loc = value.Types.val_loc in + if should_export then + DeadCommon.export path comp_unit stock id loc; + let path = Ident.create_persistent (Ident.name id ^ "*") :: path in + let obj = value.Types.val_type in + DeadObj.collect_export path comp_unit stock ~obj loc; + !DeadLexiFi.sig_value value + +let export_type ~path ~comp_unit ~stock id t = + let path = id :: path in + DeadType.collect_export path comp_unit stock t + +let export_class ~path ~comp_unit ~stock id cd = + let path = id :: path in + let cltyp = cd.Types.cty_type in + let loc = cd.Types.cty_loc in + DeadObj.collect_export path comp_unit stock ~cltyp loc + let should_export_value ~context ~stock loc = let state = State.get_current () in let belongs_to_context loc = match context with | Toplevel | Include -> true - | In_module (_, md_loc) - | In_modtyp (_, md_loc) -> - (* When a value is part of a module sig because of: - - an include, then its location precedes that of the current module; - - a module type with substitution, then its location ends - with the current module's sig. - Checking that the value's location is striclty within the - module's rules out these 2 cases. - *) + | In_module (_, md_loc) -> + (* When a value is part of a module sig because of an include, + then its location precedes that of the current module. + *) let get_pos_info loc = - let fname, start_l, start_c = Location.get_pos_info loc.Location.loc_start - in - let _, end_l, end_c = Location.get_pos_info loc.loc_end in - fname, (start_l, start_c), (end_l, end_c) - in - let v_fname, v_start, v_end = get_pos_info loc in - let md_fname, md_start, md_end = get_pos_info md_loc in - let ( > ) (l1, c1) (l2, c2) = - l1 > l2 || (l1 = l2 && c1 > c2) in + let v_fname, v_line, v_col = get_pos_info loc in + let md_fname, md_line, md_col = get_pos_info md_loc in String.equal v_fname md_fname - && v_start > md_start - && md_end > v_end + && (v_line, v_col) > (md_line, md_col) in Config.must_report_section state.config.sections.exported_values && (* do not add the loc in decs if it is not actually declared in the current context *) (stock != DeadCommon.decs || belongs_to_context loc) -let wrongful_export loc = - (* For optional arguments, every use is stored during the analysis. - The uses are then filtered before reporting. Thus, we need to - remember "wrong" exports until then. - *) - let state = State.get_current () in - if Config.must_report_opt_args state.config then - Hashtbl.replace DeadCommon.implicit_decs loc.Location.loc_start () +let rec collect_export ~context ~path ~comp_unit ~stock sig_item = + match (sig_item : Types.signature_item) with -let collect_export ~context ~path ~comp_unit ~stock sig_item = - let rec collect_export context path stock : Types.signature_item -> unit = - function + | Sig_value (id, ({val_loc; _} as value), _) + when not val_loc.Location.loc_ghost -> + let should_export = should_export_value ~context ~stock val_loc in + export_value should_export ~path ~comp_unit ~stock id value - | Sig_value (id, ({Types.val_loc; val_type; _} as value), _) - when not val_loc.Location.loc_ghost -> - if should_export_value ~context ~stock val_loc then - DeadCommon.export path comp_unit stock id val_loc; - let path = Ident.create_persistent (Ident.name id ^ "*") :: path in - DeadObj.collect_export path comp_unit stock ~obj:val_type val_loc; - !DeadLexiFi.sig_value value - - | Sig_type (id, t, _, _) when stock == DeadCommon.decs -> - DeadType.collect_export (id :: path) comp_unit stock t - - | Sig_class (id, {Types.cty_type = t; cty_loc = loc; _}, _, _) -> - DeadObj.collect_export (id :: path) comp_unit stock ~cltyp:t loc - - | Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) -> - let context = - match context with - | Include -> context - | _ -> In_module (id, loc) - in - Utils.signature_of_modtype t - |> List.iter (collect_export context (id::path) stock) + | Sig_type (id, t, _, _) when stock == DeadCommon.decs -> + export_type ~path ~comp_unit ~stock id t + + | Sig_class (id, cd, _, _) -> + export_class ~path ~comp_unit ~stock id cd + + | Sig_module (id, _, {Types.md_type = t; md_loc = loc; _}, _, _) -> + let context = + match context with + | Include -> context + | _ -> In_module (id, loc) + in + let path = id :: path in + Utils.signature_of_modtype t + |> List.iter (collect_export ~context ~path ~comp_unit ~stock) + + | _ -> () - | _ -> () - in - collect_export context path stock sig_item let rec correct_export : Types.signature_item -> unit = function - | Sig_value (_, {Types.val_loc; _}, _) -> + | Sig_value (_, {Types.val_loc; _}, _) + when not val_loc.Location.loc_ghost -> DeadCommon.unexport DeadCommon.decs val_loc; DeadObj.correct_export val_loc; - wrongful_export val_loc + (* For optional arguments, every use is stored during the analysis. + The uses are then filtered before reporting. Thus, we need to + remember "wrong" exports until then. + *) + let state = State.get_current () in + if Config.must_report_opt_args state.config then + Hashtbl.replace DeadCommon.implicit_decs val_loc.Location.loc_start () + | Sig_type (_, t, _, _) -> DeadType.correct_export t + | Sig_class (_, {cty_loc; _}, _, _) -> DeadObj.correct_export cty_loc + | Sig_module (_, _, {Types.md_type = t; _}, _, _) | Sig_modtype (_, {Types.mtd_type = Some t; _}, _) -> Utils.signature_of_modtype t |> List.iter correct_export | _ -> () + let modtype ~on_mismatch (mt : Typedtree.module_type) = let types_sig = Utils.signature_of_modtype mt.mty_type in let typedtree_sig = Utils.typedtree_signature_of_modtype mt in @@ -99,6 +103,7 @@ let modtype ~on_mismatch (mt : Typedtree.module_type) = | _::_, None -> on_mismatch types_sig | _ -> () + let collect_export_from_typedtree ~path ~comp_unit signature = let state = State.get_current () in let should_export_value = @@ -120,27 +125,24 @@ let collect_export_from_typedtree ~path ~comp_unit signature = | Tsig_value {val_id; val_loc; val_val; _} when not val_loc.Location.loc_ghost -> - if should_export_value then - DeadCommon.export path comp_unit DeadCommon.decs val_id val_loc; - let path = Ident.create_persistent (Ident.name val_id ^ "*") :: path in - let obj = val_val.val_type in - DeadObj.collect_export path comp_unit DeadCommon.decs ~obj val_loc; - !DeadLexiFi.sig_value val_val + let stock = DeadCommon.decs in + export_value should_export_value ~path ~comp_unit ~stock val_id val_val | Tsig_type (_, type_decls)-> - let export_type (td : Typedtree.type_declaration) = - let path = td.typ_id :: path in - DeadType.collect_export path comp_unit DeadCommon.decs td.typ_type - in - List.iter export_type type_decls + let stock = DeadCommon.decs in + List.iter + (fun Typedtree.{typ_id; typ_type; _} -> + export_type ~path ~comp_unit ~stock typ_id typ_type + ) + type_decls | Tsig_class class_descs -> - let export_class (cd : Typedtree.class_description) = - let path = cd.ci_id_class :: path in - let cltyp = cd.ci_expr.cltyp_type in - DeadObj.collect_export path comp_unit DeadCommon.decs ~cltyp cd.ci_loc - in - List.iter export_class class_descs + let stock = DeadCommon.decs in + List.iter + (fun {Typedtree.ci_id_class; ci_decl; _} -> + export_class ~path ~comp_unit ~stock ci_id_class ci_decl + ) + class_descs | Tsig_module {md_id = Some id; md_type; _} -> let path = id :: path in @@ -155,6 +157,7 @@ let collect_export_from_typedtree ~path ~comp_unit signature = in collect_signature path signature + let correct_export sig_item = let state = State.get_current () in match state.file_infos.cm_sign with diff --git a/src/deadSign.mli b/src/deadSign.mli index 804f767..cd3be03 100644 --- a/src/deadSign.mli +++ b/src/deadSign.mli @@ -1,7 +1,6 @@ type context = | Toplevel | In_module of (Ident.t * Location.t) - | In_modtyp of (Ident.t * Location.t) | Include val collect_export :