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/src/Main.ml

@@ -5,4 +5,10 @@ let () =
   Functor_argument.use_set ();
   Functor_argument.use_anonymous_set ();
   Local_side_effects.start ();
-  Ocaml_compiler_compat.run ()
+  Ocaml_compiler_compat.run ();
+  Shared_signature_use.run ();
+  Shared_signature_arg.run ();
+  Shared_signature_arg.run_more ();
+  Shared_signature_arg.run_even_more ();
+  Shared_signature_arg.run_sig ();
+  Shared_signature_arg.run_partial ()

examples/regression/src/Shared_signature.ml

@@ -0,0 +1,10 @@
+(* A named module type shared by two functors. Only [Used] is instantiated, so
+   [Unused.Make.f] must be reported dead: a call through [Used]'s instance must
+   not keep [Unused]'s implementation alive. *)
+module type S = sig
+  val f : unit -> int
+end
+
+module type O = sig
+  val g : ?x:int -> unit -> int
+end

examples/regression/src/Shared_signature_arg.ml

@@ -0,0 +1,133 @@
+(* Two modules implement the shared named signature; only [Chosen] is passed
+   to a functor. [Ignored.f] must be reported dead. *)
+module Chosen : Shared_signature.S = struct
+  let f () = 3
+end
+
+module Ignored : Shared_signature.S = struct
+  let f () = 4
+end
+
+module Apply (M : Shared_signature.S) = struct
+  let run () = M.f ()
+end
+
+module Applied = Apply (Chosen)
+
+(* Same, but the module is used directly from the same file. *)
+module Local_used : Shared_signature.S = struct
+  let f () = 5
+end
+
+module Local_unused : Shared_signature.S = struct
+  let f () = 6
+end
+
+let run () = ignore (Applied.run () + Local_used.f ())
+
+(* A binding calling both through the parameter and a resolved module: the
+   parameter call must still not be forwarded to [Ignored]. *)
+module Apply_mixed (M : Shared_signature.S) = struct
+  let run () = M.f () + Chosen.f ()
+end
+
+module Applied_mixed = Apply_mixed (Chosen)
+
+(* Optional argument supplied only through a functor parameter call: must be
+   credited to [Opt_chosen] only, so [Opt_direct]'s [x] stays never used. *)
+module Opt_chosen : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Opt_direct : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Apply_opt (M : Shared_signature.O) = struct
+  let run () = M.g ~x:1 ()
+end
+
+module Applied_opt = Apply_opt (Opt_chosen)
+
+let run_more () =
+  ignore (Applied_mixed.run () + Applied_opt.run () + Opt_direct.g ())
+
+(* Argument wrapped in a constraint: [(Opt_constrained : O)]. *)
+module Opt_constrained : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Applied_constrained = Apply_opt ((Opt_constrained : Shared_signature.O))
+
+(* Inline functor applied directly. *)
+module Opt_inline : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Applied_inline =
+  (functor (M : Shared_signature.O) -> struct
+    let run () = M.g ~x:1 ()
+  end)
+    (Opt_inline)
+
+(* Constrained argument for liveness: [Ignored2] must stay dead. *)
+module Chosen2 : Shared_signature.S = struct
+  let f () = 7
+end
+
+module Ignored2 : Shared_signature.S = struct
+  let f () = 8
+end
+
+module Applied_constrained_value = Apply ((Chosen2 : Shared_signature.S))
+
+let run_even_more () =
+  ignore
+    (Applied_constrained.run () + Applied_inline.run ()
+   + Applied_constrained_value.run ())
+
+(* Named functor with a whole-functor signature: the binding expression is a
+   constraint around the functor. *)
+module Opt_sigfun : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Apply_sig : functor (M : Shared_signature.O) -> sig
+  val run : unit -> int
+end =
+functor
+  (M : Shared_signature.O)
+  ->
+  struct
+    let run () = M.g ~x:1 ()
+  end
+
+module Applied_sig = Apply_sig (Opt_sigfun)
+
+let run_sig () = ignore (Applied_sig.run ())
+
+(* Curried functor, partially applied and named before the second argument. *)
+module Opt_partial : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+module Apply2 (A : Shared_signature.S) (B : Shared_signature.O) = struct
+  let run () = A.f () + B.g ~x:1 ()
+end
+
+module Apply2_partial = Apply2 (Chosen)
+module Applied_partial = Apply2_partial (Opt_partial)
+
+(* Functor bound with [let module]. *)
+module Opt_letmodule : Shared_signature.O = struct
+  let g ?(x = 0) () = x
+end
+
+let run_local () =
+  let module Apply_local (M : Shared_signature.O) = struct
+    let run () = M.g ~x:1 ()
+  end in
+  let module Applied_local = Apply_local (Opt_letmodule) in
+  Applied_local.run ()
+
+let run_partial () = ignore (Applied_partial.run () + run_local ())

examples/regression/src/Shared_signature_unused.ml

@@ -0,0 +1,5 @@
+module Make (K : sig
+  type t
+end) : Shared_signature.S = struct
+  let f () = 2
+end

examples/regression/src/Shared_signature_use.ml

@@ -0,0 +1,5 @@
+module H = Shared_signature_used.Make (struct
+  type t = int
+end)
+
+let run () = ignore (H.f ())

examples/regression/src/Shared_signature_used.ml

@@ -0,0 +1,5 @@
+module Make (K : sig
+  type t
+end) : Shared_signature.S = struct
+  let f () = 1
+end

examples/regression/src/dune

@@ -6,5 +6,10 @@
   Live_ancestors
   Local_side_effects
   Main
-  Ocaml_compiler_compat)
+  Ocaml_compiler_compat
+  Shared_signature
+  Shared_signature_arg
+  Shared_signature_unused
+  Shared_signature_use
+  Shared_signature_used)
  (flags :standard -w -27-32-34-37-39 -bin-annot))