Use module information for native_archives

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

src/dune_rules/compilation_context.ml

@@ -3,8 +3,6 @@ open! Stdune
 open Import
 module SC = Super_context
 
-let modules_of_lib = Fdecl.create Dyn.Encoder.opaque
-
 module Includes = struct
   type t = Command.Args.dynamic Command.Args.t Cm_kind.Dict.t
 
@@ -234,5 +232,5 @@ let without_bin_annot t = { t with bin_annot = false }
 let root_module_entries t : Module_name.t list Or_exn.t =
   let open Result.O in
   let* requires = t.requires_compile in
-  let local_lib = Fdecl.get modules_of_lib t.super_context in
+  let local_lib = Fdecl.get Super_context.modules_of_lib t.super_context in
   Result.List.concat_map requires ~f:(Lib.entry_module_names ~local_lib)

src/dune_rules/compilation_context.mli

@@ -21,10 +21,6 @@ type opaque =
   | Inherit_from_settings
       (** Determined from the version of OCaml and the profile *)
 
-val modules_of_lib :
-  (* to avoid a cycle with [Dir_contents] *)
-  (Super_context.t -> dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t
-
 (** Create a compilation context. *)
 val create :
      super_context:Super_context.t

src/dune_rules/dir_contents.ml

@@ -341,7 +341,7 @@ end = struct
       let ml_sources = ocaml t in
       Ml_sources.modules ml_sources ~for_:(Library name)
     in
-    Fdecl.set Compilation_context.modules_of_lib f
+    Fdecl.set Super_context.modules_of_lib f
 
   let gen_rules sctx ~dir =
     match Memo.exec memo0 (sctx, dir) with

src/dune_rules/dune_file.ml

@@ -771,8 +771,9 @@ module Library = struct
     List.map (foreign_archives t) ~f:(fun archive ->
         Foreign.Archive.dll_file ~archive ~dir ~ext_dll)
 
-  let archive t ~dir ~ext =
-    Path.Build.relative dir (Lib_name.Local.to_string (snd t.name) ^ ext)
+  let archive_basename t ~ext = Lib_name.Local.to_string (snd t.name) ^ ext
+
+  let archive t ~dir ~ext = Path.Build.relative dir (archive_basename t ~ext)
 
   let best_name t =
     match t.visibility with
@@ -834,10 +835,27 @@ module Library = struct
     let virtual_library = is_virtual conf in
     let foreign_archives = foreign_lib_files conf ~dir ~ext_lib in
     let native_archives =
-      if modes.native then
-        [ archive ext_lib ]
+      let archive = archive ext_lib in
+      if virtual_library || not modes.native then
+        Lib_info.Files []
+      else if Option.is_some conf.implements then
+        Lib_info.Files [ archive ]
+      else if
+        Lib_config.linker_can_create_empty_archives lib_config
+        && Ocaml_version.ocamlopt_always_calls_library_linker
+             lib_config.ocaml_version
+      then
+        Lib_info.Files [ archive ]
+      else if
+        match conf.wrapped with
+        | This (Simple false)
+        | From _ ->
+          true
+        | _ -> false
+      then
+        Lib_info.Needs_module_info archive
       else
-        []
+        Lib_info.Files [ archive ]
     in
     let foreign_dll_files = foreign_dll_files conf ~dir ~ext_dll in
     let exit_module = Option.bind conf.stdlib ~f:(fun x -> x.exit_module) in
@@ -916,12 +934,12 @@ module Library = struct
     let special_builtin_support = conf.special_builtin_support in
     let instrumentation_backend = conf.instrumentation_backend in
     let entry_modules = Lib_info.Source.Local in
-    Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir
-      ~version ~synopsis ~main_module_name ~sub_systems ~requires
-      ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives
-      ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive
-      ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules
-      ~implements ~default_implementation ~modes ~wrapped
+    Lib_info.create ~loc ~path_kind:Local ~name ~kind ~status ~src_dir
+      ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems
+      ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps
+      ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime
+      ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_
+      ~entry_modules ~implements ~default_implementation ~modes ~wrapped
       ~special_builtin_support ~exit_module ~instrumentation_backend
 end
 

src/dune_rules/dune_package.ml

@@ -66,6 +66,12 @@ module Lib = struct
     let jsoo_runtime = Lib_info.jsoo_runtime info in
     let virtual_ = Option.is_some (Lib_info.virtual_ info) in
     let instrumentation_backend = Lib_info.instrumentation_backend info in
+    let native_archives =
+      match Lib_info.native_archives info with
+      | Lib_info.Files f -> f
+      | Needs_module_info _ ->
+        Code_error.raise "caller must set native archives to known value" []
+    in
     record_fields
     @@ [ field "name" Lib_name.encode name
        ; field "kind" Lib_kind.encode kind
@@ -76,7 +82,7 @@ module Lib = struct
        ; mode_paths "plugins" plugins
        ; paths "foreign_objects" foreign_objects
        ; paths "foreign_archives" (Lib_info.foreign_archives info)
-       ; paths "native_archives" (Lib_info.native_archives info)
+       ; paths "native_archives" native_archives
        ; paths "jsoo_runtime" jsoo_runtime
        ; Lib_dep.L.field_encode requires ~name:"requires"
        ; libs "ppx_runtime_deps" ppx_runtime_deps
@@ -186,10 +192,11 @@ module Lib = struct
            Some (Lib_info.Inherited.This (Modules.wrapped modules))
          in
          let entry_modules = Lib_info.Source.External (Ok entry_modules) in
-         Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir
-           ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires
-           ~foreign_objects ~plugins ~archives ~ppx_runtime_deps
-           ~foreign_archives ~native_archives ~foreign_dll_files:[]
+         Lib_info.create ~path_kind:External ~loc ~name ~kind ~status ~src_dir
+           ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name
+           ~sub_systems ~requires ~foreign_objects ~plugins ~archives
+           ~ppx_runtime_deps ~foreign_archives
+           ~native_archives:(Files native_archives) ~foreign_dll_files:[]
            ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps
            ~dune_version ~virtual_ ~entry_modules ~implements
            ~default_implementation ~modes ~wrapped ~special_builtin_support

src/dune_rules/dune_package.mli

@@ -78,8 +78,6 @@ module Or_meta : sig
     | Use_meta
     | Dune_package of t
 
-  val encode : dune_version:Dune_lang.Syntax.Version.t -> t -> Dune_lang.t list
-
   val pp :
     dune_version:Dune_lang.Syntax.Version.t -> Format.formatter -> t -> unit
 

src/dune_rules/findlib/findlib.ml

@@ -410,13 +410,14 @@ end = struct
                         | Ok s -> Ok (Some s)
                         | Error e -> Error (User_error.E e) )) ) )
         in
-        Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir
-          ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires
-          ~foreign_objects ~plugins ~archives ~ppx_runtime_deps
-          ~foreign_archives ~native_archives ~foreign_dll_files:[] ~jsoo_runtime
-          ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version
-          ~virtual_ ~implements ~default_implementation ~modes ~wrapped
-          ~special_builtin_support ~exit_module:None
+        Lib_info.create ~path_kind:External ~loc ~name:t.name ~kind ~status
+          ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name
+          ~sub_systems ~requires ~foreign_objects ~plugins ~archives
+          ~ppx_runtime_deps ~foreign_archives
+          ~native_archives:(Files native_archives) ~foreign_dll_files:[]
+          ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps
+          ~dune_version ~virtual_ ~implements ~default_implementation ~modes
+          ~wrapped ~special_builtin_support ~exit_module:None
           ~instrumentation_backend:None ~entry_modules
       in
       Dune_package.Lib.of_findlib info

src/dune_rules/install_rules.ml

@@ -53,11 +53,10 @@ end = struct
     else
       []
 
-  let lib_files ~modes ~dir_contents ~dir ~lib_config lib =
+  let lib_files ~dir_contents ~dir ~lib_config lib =
     let virtual_library = Option.is_some (Lib_info.virtual_ lib) in
     let { Lib_config.ext_obj; _ } = lib_config in
     let archives = Lib_info.archives lib in
-    let { Mode.Dict.byte = _; native } = modes in
     List.concat
       [ archives.byte
       ; archives.native
@@ -68,18 +67,12 @@ end = struct
           Foreign.Sources.object_files files ~dir ~ext_obj
         else
           Lib_info.foreign_archives lib )
-      ; if_
-          (native && not virtual_library)
-          ((* TODO remove the if check once Lib_info.native_archives always
-              returns the correct value for libs without modules *)
-           let modules =
-             Dir_contents.ocaml dir_contents
-             |> Ml_sources.modules ~for_:(Library (Lib_info.name lib))
-           in
-           if Lib_info.has_native_archive lib_config modules then
-             Lib_info.native_archives lib
-           else
-             [])
+      ; (let modules =
+           Dir_contents.ocaml dir_contents
+           |> Ml_sources.modules ~for_:(Library (Lib_info.name lib))
+           |> Option.some
+         in
+         Lib_info.eval_native_archives_exn lib ~modules)
       ; Lib_info.jsoo_runtime lib
       ; (Lib_info.plugins lib).native
       ]
@@ -183,7 +176,7 @@ end = struct
           other_cm_files)
     in
     let lib_files, dll_files =
-      let lib_files = lib_files ~modes ~dir ~dir_contents ~lib_config info in
+      let lib_files = lib_files ~dir ~dir_contents ~lib_config info in
       let dll_files = dll_files ~modes ~dynlink:lib.dynlink ~ctx info in
       (lib_files, dll_files)
     in

src/dune_rules/lib.ml

@@ -256,6 +256,7 @@ module T = struct
          {[ This kind of expression is not allowed as right-hand side of `let
          rec' }] *)
       mutable sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t
+    ; modules : Modules.t Lazy.t option
     }
 
   let compare (x : t) (y : t) = Id.compare x.unique_id y.unique_id
@@ -323,6 +324,7 @@ type db =
   ; all : Lib_name.t list Lazy.t
   ; lib_config : Lib_config.t
   ; instrument_with : Lib_name.t list
+  ; modules_of_lib : (dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t
   ; projects_by_package : Dune_project.t Package.Name.Map.t
   }
 
@@ -407,7 +409,7 @@ module Link_params = struct
              not appear on the command line *)
     }
 
-  let get t (mode : Link_mode.t) =
+  let get (t : lib) (mode : Link_mode.t) =
     let lib_files = Lib_info.foreign_archives t.info
     and dll_files = Lib_info.foreign_dll_files t.info in
     (* OCaml library archives [*.cma] and [*.cmxa] are directly listed in the
@@ -420,7 +422,12 @@ module Link_params = struct
       match mode with
       | Byte -> dll_files
       | Byte_with_stubs_statically_linked_in -> lib_files
-      | Native -> List.rev_append (Lib_info.native_archives t.info) lib_files
+      | Native ->
+        let native_archives =
+          let modules = Option.map t.modules ~f:Lazy.force in
+          Lib_info.eval_native_archives_exn t.info ~modules
+        in
+        List.rev_append native_archives lib_files
     in
     let include_dirs =
       let files =
@@ -1143,6 +1150,11 @@ end = struct
         let* package = Lib_info.package info in
         Package.Name.Map.find db.projects_by_package package
     in
+    let modules =
+      match Path.as_in_build_dir (Lib_info.src_dir info) with
+      | None -> None
+      | Some dir -> Some (lazy (Fdecl.get db.modules_of_lib ~dir ~name))
+    in
     let t =
       { info
       ; name
@@ -1158,6 +1170,7 @@ end = struct
       ; lib_config = db.lib_config
       ; re_exports
       ; project
+      ; modules
       }
     in
     t.sub_systems <-
@@ -1727,18 +1740,28 @@ module DB = struct
 
   (* CR-soon amokhov: this whole module should be rewritten using the
      memoization framework instead of using mutable state. *)
-  let create ~parent ~resolve ~projects_by_package ~all ~lib_config () =
+  let create ~parent ~resolve ~projects_by_package ~all ~modules_of_lib
+      ~lib_config () =
     { parent
     ; resolve
     ; table = Table.create (module Lib_name) 1024
     ; all = Lazy.from_fun all
     ; lib_config
     ; instrument_with = lib_config.Lib_config.instrument_with
     ; projects_by_package
+    ; modules_of_lib
     }
 
   let create_from_findlib ~lib_config ~projects_by_package findlib =
     create () ~parent:None ~lib_config ~projects_by_package
+      ~modules_of_lib:
+        (let t = Fdecl.create Dyn.Encoder.opaque in
+         Fdecl.set t (fun ~dir ~name ->
+             Code_error.raise "external libraries need no modules"
+               [ ("dir", Path.Build.to_dyn dir)
+               ; ("name", Lib_name.to_dyn name)
+               ]);
+         t)
       ~resolve:(fun name ->
         match Findlib.find findlib name with
         | Ok (Library pkg) -> Found (Dune_package.Lib.info pkg)
@@ -1950,6 +1973,7 @@ let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects ~dir =
   let info =
     Lib_info.for_dune_package info ~name ~ppx_runtime_deps ~requires
       ~foreign_objects ~obj_dir ~implements ~default_implementation ~sub_systems
+      ~modules
   in
   Dune_package.Lib.of_dune_lib ~info ~modules ~main_module_name
 

src/dune_rules/lib.mli

@@ -186,6 +186,7 @@ module DB : sig
     -> resolve:(Lib_name.t -> Resolve_result.t)
     -> projects_by_package:Dune_project.t Package.Name.Map.t
     -> all:(unit -> Lib_name.t list)
+    -> modules_of_lib:(dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t
     -> lib_config:Lib_config.t
     -> unit
     -> t