Fix DCE false positives for functors constrained by a named module type

Changes.md

@@ -1,3 +1,7 @@
+# Unreleased
+
+- Fix false positives for values in functor bodies (and modules) constrained by a module type defined in another file, e.g. `module Make (K) : Gen.S with type key = K.t`. On OCaml 5.3+ declaration dependencies pointing at other compilation units are now resolved, and references to `val` items of a named module type are forwarded to the implementations satisfying it.
+
 # 2.26.0
 
 - Support OCaml 5.3, 5.4, and 5.5.

examples/deadcode/src/FunctorSigGen.ml

@@ -0,0 +1,14 @@
+(* Named module types used as functor result signatures from other files. *)
+module type S = sig
+  val find_opt : int -> int option
+
+  val unused_in_sig : int -> int
+
+  val with_opt : ?x:int -> unit -> int
+end
+
+module type T = sig
+  val lookup : int -> int option
+
+  val unused_in_inline_sig : int -> int
+end

examples/deadcode/src/FunctorSigInline.ml

@@ -0,0 +1,9 @@
+module Make (K : sig
+  type t
+end) : FunctorSigGen.T = struct
+  let lookup k = Some k
+
+  let unused_in_inline_sig k = k
+
+  let truly_dead_inline k = k
+end

examples/deadcode/src/FunctorSigMli.ml

@@ -0,0 +1,12 @@
+module Make (K : sig
+  type t
+end) =
+struct
+  let find_opt k = Some k
+
+  let unused_in_sig k = k
+
+  let truly_dead k = k
+
+  let with_opt ?(x = 0) () = x
+end

examples/deadcode/src/FunctorSigMli.mli

@@ -0,0 +1,3 @@
+module Make (K : sig
+  type t
+end) : FunctorSigGen.S

examples/deadcode/src/FunctorSigUse.ml

@@ -0,0 +1,13 @@
+module H = FunctorSigMli.Make (struct
+  type t = int
+end)
+
+module I = FunctorSigInline.Make (struct
+  type t = int
+end)
+
+let run () =
+  ignore (H.with_opt ~x:1 ());
+  match (H.find_opt 1, I.lookup 2) with
+  | Some _, Some _ -> print_endline "x"
+  | _ -> ()

examples/deadcode/src/Main.ml

@@ -7,6 +7,7 @@ let () =
   ignore (Types.make_live 1);
   ignore TransitiveTypes.live_value;
   FirstClassModules.run ();
+  FunctorSigUse.run ();
   OptionalArgs.live_optional ~used:1 ();
   ignore (Externals.live_external "abc");
   Annotations.live_value ();

examples/deadcode/src/deadcode.txt

@@ -7,6 +7,10 @@
   File "OptionalArgs.ml", line 1, characters 0-86
   optional argument used of function +live_optional is always supplied (1 calls)
 
+  Warning Redundant Optional Argument
+  File "FunctorSigMli.ml", line 11, characters 2-30
+  optional argument x of function Make.+with_opt is always supplied (1 calls)
+
   Warning Dead Value
   File "Annotations.ml", line 5, characters 0-33
   +stale_dead_annotation is never used
@@ -41,6 +45,30 @@
   <-- line 10
     let run () = () [@@dead "DeadRunner.+run"] 
 
+  Warning Dead Value
+  File "FunctorSigInline.ml", line 6, characters 2-32
+  Make.+unused_in_inline_sig is never used
+  <-- line 6
+    let unused_in_inline_sig k = k [@@dead "Make.+unused_in_inline_sig"] 
+
+  Warning Dead Value
+  File "FunctorSigInline.ml", line 8, characters 2-29
+  Make.+truly_dead_inline is never used
+  <-- line 8
+    let truly_dead_inline k = k [@@dead "Make.+truly_dead_inline"] 
+
+  Warning Dead Value
+  File "FunctorSigMli.ml", line 7, characters 2-25
+  Make.+unused_in_sig is never used
+  <-- line 7
+    let unused_in_sig k = k [@@dead "Make.+unused_in_sig"] 
+
+  Warning Dead Value
+  File "FunctorSigMli.ml", line 9, characters 2-22
+  Make.+truly_dead is never used
+  <-- line 9
+    let truly_dead k = k [@@dead "Make.+truly_dead"] 
+
   Warning Dead Value
   File "Includes.ml", line 4, characters 2-29
   +included_unused is never used
@@ -123,4 +151,4 @@
   <-- line 4
     | LiveA [@dead "live_variant.LiveA"] 
 
-  Analysis reported 22 issues (Warning Dead Module:2, Warning Dead Type:5, Warning Dead Value:13, Warning Redundant Optional Argument:1, Warning Unused Argument:1)
+  Analysis reported 27 issues (Warning Dead Module:2, Warning Dead Type:5, Warning Dead Value:17, Warning Redundant Optional Argument:2, Warning Unused Argument:1)

examples/deadcode/src/dune

@@ -6,6 +6,10 @@
   Exceptions
   Externals
   FirstClassModules
+  FunctorSigGen
+  FunctorSigInline
+  FunctorSigMli
+  FunctorSigUse
   Includes
   Main
   ModuleAliases

examples/regression/dup_a/Dup_a_impl.ml

@@ -0,0 +1,9 @@
+module Make (K : sig
+  type t
+end) : Dup_sig.S with type t = K.t = struct
+  type t = K.t
+
+  let f x = x
+
+  let g x = x
+end

examples/regression/dup_a/Dup_a_use.ml

@@ -0,0 +1,6 @@
+module M = Dup_a_impl.Make (struct
+  type t = int
+end)
+
+let run () = M.f 1
+let () = ignore (run ())

examples/regression/dup_a/Dup_sig.ml

@@ -0,0 +1,8 @@
+(* Same compilation unit name as dup_b/Dup_sig.ml, different content. *)
+module type S = sig
+  type t
+
+  val f : t -> t
+
+  val g : t -> t
+end

examples/regression/dup_a/dune

@@ -0,0 +1,6 @@
+(library
+ (name dup_a)
+ (wrapped false)
+ (modes byte)
+ (modules Dup_sig Dup_a_impl Dup_a_use)
+ (flags :standard -w -27-32-34-37-39 -bin-annot))

examples/regression/dup_b/Dup_b_impl.ml

@@ -0,0 +1,11 @@
+module Make (K : sig
+  type t
+end) : Dup_sig.S with type t = K.t = struct
+  type t = K.t
+
+  let f x = x
+
+  let g x = x
+
+  let h x = x
+end

examples/regression/dup_b/Dup_b_use.ml

@@ -0,0 +1,6 @@
+module M = Dup_b_impl.Make (struct
+  type t = int
+end)
+
+let run () = M.g 1
+let () = ignore (run ())

examples/regression/dup_b/Dup_sig.ml

@@ -0,0 +1,10 @@
+(* Same compilation unit name as dup_a/Dup_sig.ml, different content. *)
+module type S = sig
+  type t
+
+  val f : t -> t
+
+  val g : t -> t
+
+  val h : t -> t
+end

examples/regression/dup_b/dune

@@ -0,0 +1,6 @@
+(library
+ (name dup_b)
+ (wrapped false)
+ (modes byte)
+ (modules Dup_sig Dup_b_impl Dup_b_use)
+ (flags :standard -w -27-32-34-37-39 -bin-annot))

scripts/run_integration_tests.js

@@ -112,6 +112,28 @@ function runRegressionTests() {
   assertNotIncludes(output, "Dead Value +Local_side_effects.+_info");
   assertNotIncludes(output, "Dead Value +Local_side_effects.+process");
   assertNotIncludes(output, "Dead Value +Local_side_effects.+register");
+
+  // Two unwrapped libraries each define a `Dup_sig` compilation unit. The
+  // functor result constraints in dup_a and dup_b must resolve to their own
+  // Dup_sig, not to whichever one happens to be indexed first.
+  console.log(`${cwd}: reanalyze duplicate compilation unit assertions`);
+  const dupOutput = child_process.execFileSync(
+    reanalyzeFile,
+    ["-ci", "-debug", "-native-build-target", ".", "-dce-cmt", "_build/default"],
+    {
+      cwd,
+      encoding: "utf8",
+    }
+  );
+
+  assertIncludes(dupOutput, "Live Value +Dup_a_impl.Make.+f");
+  assertIncludes(dupOutput, "Dead Value +Dup_a_impl.Make.+g");
+  assertIncludes(dupOutput, "Dead Value +Dup_b_impl.Make.+f");
+  assertIncludes(dupOutput, "Live Value +Dup_b_impl.Make.+g");
+  assertIncludes(dupOutput, "Dead Value +Dup_b_impl.Make.+h");
+
+  assertNotIncludes(dupOutput, "Dead Value +Dup_a_impl.Make.+f");
+  assertNotIncludes(dupOutput, "Dead Value +Dup_b_impl.Make.+g");
 }
 
 function checkSetup() {