feature: unused-libs alias

Introduce an alias to detect unused libraries in libraries and
executable stanzas.

This stanza relies on information extracted using ocamlobjinfo to detect
which modules are actually used

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

doc/changes/added/12623.md

@@ -0,0 +1,2 @@
+- Introduce an `unused-libs` stanza to detect unused libraries (#12623, fixes
+  #650, @rgrinberg)

doc/reference/aliases/unused-libs.rst

@@ -0,0 +1,5 @@
+@unused-libs
+============
+
+This alias is used to detect unused entries in the libraries field of
+executables and stanzas.

src/dune_rules/alias0.ml

@@ -26,6 +26,7 @@ let install = standard "install"
 let pkg_install = Alias.Name.of_string "pkg-install"
 let ocaml_index = standard "ocaml-index"
 let runtest = standard "runtest"
+let unused_libs = standard "unused-libs"
 let all = standard "all"
 let default = standard "default"
 let empty = standard "empty"

src/dune_rules/alias0.mli

@@ -15,6 +15,7 @@ val ocaml_index : Name.t
 val install : Name.t
 val pkg_install : Name.t
 val runtest : Name.t
+val unused_libs : Name.t
 val empty : Name.t
 val all : Name.t
 val default : Name.t

src/dune_rules/dep_rules.ml

@@ -36,7 +36,10 @@ let ooi_deps
       let ctx = Super_context.context sctx in
       Context.ocaml ctx
     in
-    Ocamlobjinfo.rules ocaml ~sandbox ~dir ~unit
+    Ocamlobjinfo.rules ocaml ~sandbox ~dir ~units:[ unit ]
+    |> Action_builder.map ~f:(function
+      | [ x ] -> x
+      | [] | _ :: _ -> assert false)
   in
   let add_rule = Super_context.add_rule sctx ~dir in
   let read =

src/dune_rules/exe_rules.ml

@@ -208,6 +208,18 @@ let executables_rules
   in
   let lib_config = ocaml.lib_config in
   let* requires_compile = Compilation_context.requires_compile cctx in
+  let* () =
+    let toolchain = Compilation_context.ocaml cctx in
+    let direct_requires = Lib.Compile.direct_requires compile_info in
+    Unused_libs_rules.gen_rules
+      sctx
+      toolchain
+      exes.buildable.loc
+      ~obj_dir
+      ~modules
+      ~dir
+      ~direct_requires
+  in
   let* () =
     let* dep_graphs =
       (* Building an archive for foreign stubs, we link the corresponding object

src/dune_rules/lib_rules.ml

@@ -621,6 +621,17 @@ let library_rules
     in
     Sub_system.gen_rules
       { super_context = sctx; dir; stanza = lib; scope; source_modules; compile_info }
+  and+ () =
+    let toolchain = Compilation_context.ocaml cctx in
+    let direct_requires = Lib.Compile.direct_requires compile_info in
+    Unused_libs_rules.gen_rules
+      sctx
+      toolchain
+      lib.buildable.loc
+      ~obj_dir
+      ~modules
+      ~dir
+      ~direct_requires
   and+ merlin =
     let+ requires_hidden = Compilation_context.requires_hidden cctx
     and+ parameters = Compilation_context.parameters cctx in

src/dune_rules/ocamlobjinfo.mli

@@ -10,8 +10,19 @@ val rules
   :  Ocaml_toolchain.t
   -> dir:Path.Build.t
   -> sandbox:Sandbox_config.t option
-  -> unit:Path.t
-  -> t Action_builder.t
+  -> units:Path.t list
+  -> t list Action_builder.t
+
+(** Run ocamlobjinfo on an archive to extract module names defined in it *)
+val archive_rules
+  :  Ocaml_toolchain.t
+  -> dir:Path.Build.t
+  -> sandbox:Sandbox_config.t option
+  -> archive:Path.t
+  -> Module_name.Unique.Set.t Action_builder.t
 
 (** For testing only *)
-val parse : string -> t
+val parse : string -> t list
+
+(** Parse archive output to extract module names defined in the archive *)
+val parse_archive : string -> Module_name.Unique.Set.t

src/dune_rules/ocamlobjinfo.mll

@@ -22,23 +22,34 @@ let ws = [' ' '\t']+
 let hash = ['0'-'9' 'a'-'z' '-']+
 let name = ['A'-'Z'] ['A'-'Z' 'a'-'z' '0'-'9' '_']*
 
-rule ocamlobjinfo acc = parse
-  | "Interfaces imported:" newline { intfs acc lexbuf }
-  | "Implementations imported:" newline { impls acc lexbuf }
-  | _ { ocamlobjinfo acc lexbuf }
+rule ocamlobjinfo acc_units acc = parse
+  | "Interfaces imported:" newline { intfs acc_units acc lexbuf }
+  | "Implementations imported:" newline { impls acc_units acc lexbuf }
+  | _ { ocamlobjinfo acc_units acc lexbuf }
+  | eof { acc :: acc_units }
+and intfs acc_units acc = parse
+  | ws hash ws (name as name) newline { intfs acc_units (add_intf acc name) lexbuf }
+  | "Implementations imported:" newline { impls acc_units acc lexbuf }
+  | "File " [^ '\n']+ newline { ocamlobjinfo (acc :: acc_units) empty lexbuf }
+  | _ | eof { acc :: acc_units }
+and impls acc_units acc = parse
+  | ws hash ws (name as name) newline { impls acc_units (add_impl acc name) lexbuf }
+  | "File " [^ '\n']+ newline { ocamlobjinfo (acc :: acc_units) empty lexbuf }
+  | _ | eof { acc :: acc_units }
+
+and archive acc = parse
+  | "Unit name:" ws (name as name) { archive (Module_name.Unique.Set.add acc (Module_name.Unique.of_string name)) lexbuf }
+  | _ { archive acc lexbuf }
   | eof { acc }
-and intfs acc = parse
-  | ws hash ws (name as name) newline { intfs (add_intf acc name) lexbuf }
-  | "Implementations imported:" newline { impls acc lexbuf }
-  | _ | eof { acc }
-and impls acc = parse
-  | ws hash ws (name as name) newline { impls (add_impl acc name) lexbuf }
-  | _ | eof { acc }
 
 {
-let parse s = ocamlobjinfo empty (Lexing.from_string s)
+let parse s = Lexing.from_string s |> ocamlobjinfo [] empty  |> List.rev
+
+let parse_archive s =
+  Lexing.from_string s
+  |> archive Module_name.Unique.Set.empty
 
-let rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~unit =
+let rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~units =
   let no_approx =
     if Ocaml.Version.ooi_supports_no_approx ocaml.version then
       [Command.Args.A "-no-approx"]
@@ -52,7 +63,9 @@ let rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~unit =
       []
   in
   let observing_facts =
-    Dep.Facts.singleton (Dep.file unit) (Dep.Fact.nothing)
+    List.map units ~f:(fun unit ->
+      Dep.Facts.singleton (Dep.file unit) (Dep.Fact.nothing))
+    |> Dep.Facts.union_all
   in
   let open Action_builder.O in
   let* action =
@@ -61,7 +74,7 @@ let rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~unit =
       (List.concat
          [ no_approx
          ; no_code
-         ; [ Dep unit ]
+         ; [ Deps units ]
          ])
   in
   (Dune_engine.Build_system.execute_action_stdout
@@ -73,4 +86,24 @@ let rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~unit =
     }
   |> Action_builder.of_memo)
   >>| parse
+
+let archive_rules (ocaml : Ocaml_toolchain.t) ~dir ~sandbox ~archive =
+  let observing_facts =
+    Dep.Facts.singleton (Dep.file archive) (Dep.Fact.nothing)
+  in
+  let open Action_builder.O in
+  let* action =
+    Command.run' ?sandbox
+      ~dir:(Path.build dir) ocaml.ocamlobjinfo
+      [ Dep archive ]
+  in
+  (Dune_engine.Build_system.execute_action_stdout
+    ~observing_facts
+    { Rule.Anonymous_action.action
+    ; loc = Loc.none
+    ; dir
+    ; alias = None
+    }
+  |> Action_builder.of_memo)
+  >>| parse_archive
 }

src/dune_rules/unused_libs_rules.ml

@@ -0,0 +1,107 @@
+open Import
+open Memo.O
+
+let classify_libs sctx libs =
+  Memo.parallel_map libs ~f:(fun lib ->
+    let+ modules = Dir_contents.modules_of_lib sctx lib in
+    lib, modules)
+  >>| List.partition_map ~f:(fun (lib, modules) ->
+    match modules with
+    | Some modules ->
+      let module_set =
+        Modules.With_vlib.obj_map modules
+        |> Module_name.Unique.Map.keys
+        |> Module_name.Unique.Set.of_list
+      in
+      Left (lib, module_set)
+    | None ->
+      (match
+         let archives = Lib.info lib |> Lib_info.archives in
+         Mode.Dict.get archives Byte
+       with
+       | [] -> Left (lib, Module_name.Unique.Set.empty)
+       | archive :: _ -> Right (lib, archive)))
+;;
+
+let gen_rules sctx toolchain loc ~obj_dir ~modules ~dir ~direct_requires =
+  match
+    let modules =
+      Modules.With_vlib.drop_vlib modules
+      |> Modules.fold ~init:[] ~f:(fun m acc -> m :: acc)
+    in
+    let cmis = Obj_dir.Module.L.cm_files obj_dir modules ~kind:(Ocaml Cmi) in
+    let cmos = Obj_dir.Module.L.cm_files obj_dir modules ~kind:(Ocaml Cmo) in
+    cmis @ cmos
+  with
+  | [] -> Memo.return ()
+  | units ->
+    let action =
+      let open Action_builder.O in
+      let build_dir = Obj_dir.dir obj_dir in
+      let* local_modules, external_lib_archives =
+        let* direct_requires = Resolve.Memo.read direct_requires in
+        classify_libs sctx direct_requires |> Action_builder.of_memo
+      in
+      let* results =
+        Ocamlobjinfo.rules
+          toolchain
+          ~dir:build_dir
+          ~sandbox:(Some Sandbox_config.needs_sandboxing)
+          ~units
+      and* external_modules =
+        List.map external_lib_archives ~f:(fun (lib, archive) ->
+          let+ modules =
+            Ocamlobjinfo.archive_rules
+              toolchain
+              ~dir:build_dir
+              ~sandbox:(Some Sandbox_config.needs_sandboxing)
+              ~archive
+          in
+          lib, modules)
+        |> Action_builder.all
+      in
+      let unused_libs =
+        let all_imported =
+          List.fold_left results ~init:Module_name.Unique.Set.empty ~f:(fun acc result ->
+            let intf_deps = Ml_kind.Dict.get result Intf in
+            let impl_deps = Ml_kind.Dict.get result Impl in
+            Module_name.Unique.Set.union
+              acc
+              (Module_name.Unique.Set.union intf_deps impl_deps))
+        in
+        external_modules @ local_modules
+        |> Lib.Map.of_list_exn
+        |> Lib.Map.foldi ~init:[] ~f:(fun lib lib_modules acc ->
+          (* Skip libraries with no modules *)
+          if Module_name.Unique.Set.is_empty lib_modules
+          then acc
+          else (
+            (* Check if any module from this library is imported *)
+            let is_used =
+              Module_name.Unique.Set.exists lib_modules ~f:(fun mod_name ->
+                Module_name.Unique.Set.mem all_imported mod_name)
+            in
+            if is_used then acc else lib :: acc))
+      in
+      match unused_libs with
+      | [] -> Action_builder.return (Action.progn [])
+      | libs ->
+        Action_builder.fail
+          { fail =
+              (fun () ->
+                (* CR-someday rgrinberg: ideally, we'd use the locations of the
+                   unused libraries, but they've already been discarded. *)
+                User_error.raise
+                  ~loc
+                  [ Pp.text "Unused libraries:"
+                  ; Pp.enumerate libs ~f:(fun lib ->
+                      Lib.name lib |> Lib_name.to_string |> Pp.verbatim)
+                  ])
+          }
+    in
+    let unused_libs_alias = Alias.make Alias0.unused_libs ~dir in
+    Rules.Produce.Alias.add_action
+      unused_libs_alias
+      ~loc
+      (action |> Action_builder.map ~f:Action.Full.make)
+;;