From a1ee3d074df313627b2ff0bf8a9f76e6650110db Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 3 May 2026 21:33:25 +0100 Subject: [PATCH] refactor: Remove explicit OCaml transitive dependency files Compute transitive module dependency closures directly from anonymous ocamldep and ocamlobjinfo actions instead of materializing .all-deps files. This removes the merge-file rule path for internal dependency setup while preserving module-level cycle diagnostics. As a side-effect, this fixes an ugly "Rule not found" error. Signed-off-by: Rudi Grinberg --- otherlibs/stdune/src/filename.ml | 1 - otherlibs/stdune/src/filename.mli | 1 - src/dune_graph/graph.ml | 12 +- src/dune_rules/dep_rules.ml | 452 ++++++++++++++---- src/dune_rules/dep_rules.mli | 8 +- src/dune_rules/melange/melange_rules.ml | 19 +- src/dune_rules/obj_dir.ml | 32 -- src/dune_rules/obj_dir.mli | 8 +- src/dune_rules/ocamldep.ml | 110 ----- src/dune_rules/ocamldep.mli | 19 - .../test-cases/cyclic-dep-executable.t | 9 +- .../include-qualified/build-with-sandbox.t | 31 +- .../invalid-deps/group-interface-sub-module.t | 2 +- .../invalid-deps/group-interface.t | 2 +- .../include-qualified/ocamldep-regression.t | 4 +- .../test-cases/inline-tests/alias-cycle.t | 4 +- .../test-cases/melange/module-cycle.t | 6 +- .../test-cases/menhir/inferred-missing-dep.t | 2 +- .../ocamldep/ocamldep-alias-module.t | 1 - .../ocamldep/ocamldep-error-check.t | 2 +- .../test-cases/reporting-of-cycles.t/run.t | 12 +- ...irtual-modules-excluded-by-modules-field.t | 5 - 22 files changed, 435 insertions(+), 307 deletions(-) diff --git a/otherlibs/stdune/src/filename.ml b/otherlibs/stdune/src/filename.ml index b480dde0d97..fdd9ff9f2ec 100644 --- a/otherlibs/stdune/src/filename.ml +++ b/otherlibs/stdune/src/filename.ml @@ -37,7 +37,6 @@ module Extension = struct let cmsi = ".cmsi" let odoc = ".odoc" let d = ".d" - let all_deps = ".all-deps" let js = ".js" let h = ".h" let mlg = ".mlg" diff --git a/otherlibs/stdune/src/filename.mli b/otherlibs/stdune/src/filename.mli index 89ff98bc381..4a4f1c590b3 100644 --- a/otherlibs/stdune/src/filename.mli +++ b/otherlibs/stdune/src/filename.mli @@ -53,7 +53,6 @@ module Extension : sig val odoc : t val h : t val d : t - val all_deps : t val js : t val mlg : t val json : t diff --git a/src/dune_graph/graph.ml b/src/dune_graph/graph.ml index 71ac66d7905..b9de0d60c5b 100644 --- a/src/dune_graph/graph.ml +++ b/src/dune_graph/graph.ml @@ -220,17 +220,9 @@ module String_opt_map = Map.Make (struct let serialize_summary t oc = let open Aggregated in - (* CR-someday cmoseley: A memo node is created for each *.all-deps target - which fills up the summary with noise. This is a hacky fix for it right - now, it would be better to find something else to aggregate on or to move - these nodes to a single table since they only have a single entry each *) - let rename_all_deps label = - Option.map label ~f:(fun label -> - if String.ends_with ~suffix:".all-deps" label then "*.all-deps" else label) - in let by_label = Int.Map.fold t.nodes ~init:String_opt_map.empty ~f:(fun node acc -> - let label = rename_all_deps node.label in + let label = node.label in let attributes = Option.value ~default:Int.Map.empty @@ -253,7 +245,7 @@ let serialize_summary t oc = let by_label = Edge.Set.fold t.edges ~init:by_label ~f:(fun edge acc -> let get_label id = - Option.bind (Int.Map.find t.nodes id) ~f:(fun node -> rename_all_deps node.label) + Option.bind (Int.Map.find t.nodes id) ~f:(fun node -> node.label) in let src_label = get_label edge.src_id in let dst_label = get_label edge.dst_id in diff --git a/src/dune_rules/dep_rules.ml b/src/dune_rules/dep_rules.ml index 91428008c9d..b9e70e4768d 100644 --- a/src/dune_rules/dep_rules.ml +++ b/src/dune_rules/dep_rules.ml @@ -2,10 +2,124 @@ open Import open Memo.O module Parallel_map = Memo.Make_parallel_map (Module_name.Unique.Map) -let transitive_deps_contents modules = - List.map modules ~f:(fun m -> - (* TODO use object names *) - Modules.Sourced_module.to_module m |> Module.name |> Module_name.to_string) +module Merge_dep_output = struct + module Spec = struct + type ('src, 'dst) t = + { transitive : string list + ; immediate : Module_name.Unique.t list + } + + let name = "merge_dep_output" + let version = 3 + let is_useful_to ~memoize:_ = true + + let bimap + (type src dst src' dst') + ({ transitive; immediate } : (src, dst) t) + (_path : src -> src') + (_target : dst -> dst') + : (src', dst') t + = + { transitive; immediate } + ;; + + let encode + (type src dst) + ({ transitive; immediate } : (src, dst) t) + (_input : src -> Sexp.t) + (_output : dst -> Sexp.t) + : Sexp.t + = + List + [ List (List.map transitive ~f:(fun s -> Sexp.Atom s)) + ; List + (List.map ~f:(fun s -> Sexp.Atom (Module_name.Unique.to_string s)) immediate) + ] + ;; + + let action { transitive; immediate } ~ectx:_ ~(eenv : Action.env) = + Async.async (fun () -> + let deps = + List.fold_left + transitive + ~init:(Module_name.Unique.Set.of_list immediate) + ~f:(fun set deps -> + String.split_lines deps + |> Module_name.Unique.Set.of_list_map ~f:Module_name.Unique.of_string + |> Module_name.Unique.Set.union set) + |> Module_name.Unique.Set.to_list_map ~f:Module_name.Unique.to_string + in + let stdout = Process.Io.out_channel eenv.stdout_to in + List.iter deps ~f:(fun dep -> + output_string stdout dep; + output_char stdout '\n')) + ;; + end + + module Action = Action_ext.Make (Spec) + + let action ~transitive ~immediate = Action.action { transitive; immediate } +end + +module Dep_key = struct + type t = Module_name.Unique.t * Ml_kind.t + + let ml_kind_equal (x : Ml_kind.t) (y : Ml_kind.t) = + match x, y with + | Ml_kind.Impl, Impl | Intf, Intf -> true + | Impl, Intf | Intf, Impl -> false + ;; + + let ml_kind_hash (ml_kind : Ml_kind.t) = + match ml_kind with + | Ml_kind.Impl -> 0 + | Intf -> 1 + ;; + + let equal = Tuple.T2.equal Module_name.Unique.equal ml_kind_equal + + let hash = + Tuple.T2.hash + (fun obj_name -> Module_name.Unique.to_string obj_name |> String.hash) + ml_kind_hash + ;; + + let to_dyn = Tuple.T2.to_dyn Module_name.Unique.to_dyn Ml_kind.to_dyn +end + +let merge_deps ~dir ~transitive ~immediate = + let open Action_builder.O in + let action = + let+ transitive = Action_builder.all transitive in + { Rule.Anonymous_action.action = + Merge_dep_output.action ~transitive ~immediate + |> Action.Full.make ~sandbox:Sandbox_config.no_sandboxing + ; loc = Loc.none + ; dir + ; alias = None + } + in + Build_system.execute_action_stdout action |> Action_builder.of_memo +;; + +let transitive_dep m = + match Module.kind m with + | Root | Alias _ -> None + | _ -> + Some (Module.obj_name m, if Module.has m ~ml_kind:Intf then Ml_kind.Intf else Impl) +;; + +let parse_compilation_units ~modules output = + let obj_map = Modules.With_vlib.obj_map modules in + String.split_lines output + |> List.filter_map ~f:(fun m -> + let obj_name = Module_name.Unique.of_string m in + Module_name.Unique.Map.find obj_map obj_name + |> Option.map ~f:Modules.Sourced_module.to_module) +;; + +let transitive_deps_output modules = + List.map modules ~f:(fun m -> Module.obj_name m |> Module_name.Unique.to_string) |> String.concat ~sep:"\n" ;; @@ -17,11 +131,10 @@ let ooi_deps ~dune_version ~vlib_obj_map ~(ml_kind : Ml_kind.t) - ~for_ (sourced_module : Modules.Sourced_module.t) = let m = Modules.Sourced_module.to_module sourced_module in - let* read = + let+ read = let unit = let cm_kind = match ml_kind with @@ -42,7 +155,6 @@ let ooi_deps | [ x ] -> x | [] | _ :: _ -> assert false) in - let add_rule = Super_context.add_rule sctx ~dir in let read = Action_builder.memoize "ocamlobjinfo" @@ -54,14 +166,6 @@ let ooi_deps then None else Module_name.Unique.Map.find vlib_obj_map dep)) in - let+ () = - add_rule - (let target = - Obj_dir.Module.dep obj_dir ~for_ (Transitive (m, ml_kind)) |> Option.value_exn - in - Action_builder.map read ~f:transitive_deps_contents - |> Action_builder.write_file_dyn target) - in read ;; @@ -72,77 +176,224 @@ let wrapped_compat_deps modules m = | None -> [ inner ] ;; -let deps_of_module ~modules ~sandbox ~sctx ~dir ~obj_dir ~ml_kind ~for_ m = - match Module.kind m with - | Wrapped_compat -> - wrapped_compat_deps modules m |> Action_builder.return |> Memo.return - | _ -> - let+ deps = Ocamldep.deps_of ~sandbox ~modules ~sctx ~dir ~obj_dir ~ml_kind ~for_ m in - (match Modules.With_vlib.alias_for modules m with - | [] -> deps - | aliases -> - let open Action_builder.O in - let+ deps = deps in - aliases @ deps) -;; - -let deps_of_vlib_module ~obj_dir ~vimpl ~dir ~sctx ~ml_kind ~for_ sourced_module = - match - let vlib = Vimpl.vlib vimpl in - Lib.Local.of_lib vlib - with +let preprocessed_modules_of_local_lib ~sctx lib ~for_ = + let info = Lib.Local.info lib in + let dir = Lib_info.src_dir info in + let* modules = Dir_contents.modules_of_local_lib sctx lib ~for_ + and* version = + let+ ocaml = Context.ocaml (Super_context.context sctx) in + ocaml.version + and* preprocess = + let* scope = Scope.DB.find_by_dir dir in + Instrumentation.with_instrumentation + (Lib_info.preprocess info ~for_) + ~instrumentation_backend:(Lib.DB.instrumentation_backend (Scope.libs scope)) + |> Resolve.Memo.read_memo + in + let pped_map = Staged.unstage (Pp_spec.pped_modules_map preprocess version) in + Modules.map_user_written modules ~f:(fun m -> Memo.return (pped_map m)) +;; + +type imported_vlib_deps = + Modules.Sourced_module.t -> ml_kind:Ml_kind.t -> Module.t list Action_builder.t Memo.t + +type transitive_deps = + { sandbox : Sandbox_config.t + ; modules : Modules.With_vlib.t + ; sctx : Super_context.t + ; dir : Path.Build.t + ; obj_dir : Path.Build.t Obj_dir.t + ; obj_map : Modules.Sourced_module.t Module_name.Unique.Map.t + ; imported_vlib_deps : imported_vlib_deps option + ; memo : (Dep_key.t, string) Action_builder.memo Lazy.t + } + +let rec create_transitive_deps ~sandbox ~modules ~sctx ~dir ~obj_dir ~imported_vlib_deps = + let obj_map = Modules.With_vlib.obj_map modules in + let rec t = + { sandbox + ; modules + ; sctx + ; dir + ; obj_dir + ; obj_map + ; imported_vlib_deps + ; memo = + lazy + (Action_builder.create_memo + "ocamldep transitive deps" + ~input:(module Dep_key) + ~cutoff:String.equal + ~human_readable_description:(fun (obj_name, ml_kind) -> + Pp.textf + "transitive deps of %s.%s in %s" + (Module_name.Unique.to_string obj_name) + (Ml_kind.to_string ml_kind) + (Path.Build.to_string dir)) + (fun (obj_name, ml_kind) -> + match Module_name.Unique.Map.find obj_map obj_name with + | None -> Action_builder.return "" + | Some m -> transitive_deps_output_of_sourced_module t m ~ml_kind)) + } + in + t + +and transitive_deps_output_uncached t unit ~ml_kind = + let open Action_builder.O in + let* immediate_deps = + Ocamldep.read_immediate_deps_of + ~sandbox:t.sandbox + ~sctx:t.sctx + ~obj_dir:t.obj_dir + ~modules:t.modules + ~ml_kind + unit + in + let transitive = + List.filter_map immediate_deps ~f:transitive_dep + |> List.map ~f:(Action_builder.exec_memo (Lazy.force t.memo)) + in + let immediate = List.map immediate_deps ~f:Module.obj_name in + merge_deps ~dir:t.dir ~transitive ~immediate + +and transitive_deps_output_of_sourced_module + t + (sourced_module : Modules.Sourced_module.t) + ~ml_kind + = + match sourced_module with + | Normal m -> transitive_deps_output_uncached t m ~ml_kind + | Imported_from_vlib m -> transitive_deps_output_of_imported_vlib t m ~ml_kind + | Impl_of_virtual_module impl_or_vlib -> + let m = Ml_kind.Dict.get impl_or_vlib ml_kind in + (match ml_kind with + | Impl -> transitive_deps_output_uncached t m ~ml_kind + | Intf -> transitive_deps_output_of_imported_vlib t m ~ml_kind) + +and transitive_deps_output_of_imported_vlib t m ~ml_kind = + match t.imported_vlib_deps with | None -> - let+ deps = - let vlib_obj_map = Vimpl.vlib_obj_map vimpl in - let dune_version = - let impl = Vimpl.impl vimpl in - Dune_project.dune_version impl.project + Code_error.raise + "imported vlib module without vlib deps" + [ "module", Module.to_dyn m + ; "ml_kind", Ml_kind.to_dyn ml_kind + ; "dir", Path.Build.to_dyn t.dir + ] + | Some imported_vlib_deps -> + let open Action_builder.O in + let* deps = + Action_builder.of_memo + (imported_vlib_deps (Modules.Sourced_module.Imported_from_vlib m) ~ml_kind) + in + let+ deps = deps in + transitive_deps_output deps +;; + +let transitive_deps_of t ~ml_kind unit = + (let obj_name = Module.obj_name unit in + match Module_name.Unique.Map.find t.obj_map obj_name with + | None -> transitive_deps_output_uncached t unit ~ml_kind + | Some _ -> Action_builder.exec_memo (Lazy.force t.memo) (obj_name, ml_kind)) + |> Action_builder.map ~f:(parse_compilation_units ~modules:t.modules) + |> Action_builder.memoize + (sprintf + "%s.%s.transitive-deps" + (Module_name.Unique.to_string (Module.obj_name unit)) + (Ml_kind.to_string ml_kind)) +;; + +let make_imported_vlib_deps ~obj_dir ~vimpl ~dir ~sctx ~sandbox ~for_ : imported_vlib_deps + = + let vlib = Vimpl.vlib vimpl in + match Lib.Local.of_lib vlib with + | None -> + let vlib_obj_map = Vimpl.vlib_obj_map vimpl in + let dune_version = + let impl = Vimpl.impl vimpl in + Dune_project.dune_version impl.project + in + let deps_of sourced_module ~ml_kind = + let+ deps = + ooi_deps + ~vimpl + ~sctx + ~dir + ~obj_dir + ~dune_version + ~vlib_obj_map + ~ml_kind + sourced_module in - ooi_deps - ~vimpl - ~sctx - ~dir - ~obj_dir - ~dune_version - ~vlib_obj_map - ~ml_kind - ~for_ - sourced_module + Action_builder.map deps ~f:(fun deps -> + List.map deps ~f:Modules.Sourced_module.to_module) in - Action_builder.map deps ~f:(List.map ~f:Modules.Sourced_module.to_module) + deps_of | Some lib -> let vlib_obj_dir = let info = Lib.Local.info lib in Lib_info.obj_dir info in - let m = Modules.Sourced_module.to_module sourced_module in - let+ () = - let src = - Obj_dir.Module.dep vlib_obj_dir ~for_ (Transitive (m, ml_kind)) - |> Option.value_exn - |> Path.build - in - let dst = - Obj_dir.Module.dep obj_dir ~for_ (Transitive (m, ml_kind)) |> Option.value_exn - in - Super_context.add_rule sctx ~dir (Action_builder.symlink ~src ~dst) + let transitive_deps = + Memo.lazy_ (fun () -> + let+ modules = preprocessed_modules_of_local_lib ~sctx lib ~for_ in + let modules = Modules.With_vlib.modules modules in + create_transitive_deps + ~sandbox + ~modules + ~sctx + ~dir:(Obj_dir.dir vlib_obj_dir) + ~obj_dir:vlib_obj_dir + ~imported_vlib_deps:None) in - let modules = Vimpl.vlib_modules vimpl |> Modules.With_vlib.modules in - Ocamldep.read_deps_of ~obj_dir:vlib_obj_dir ~modules ~ml_kind ~for_ m + let deps_of sourced_module ~ml_kind = + let* transitive_deps = Memo.Lazy.force transitive_deps in + let m = Modules.Sourced_module.to_module sourced_module in + transitive_deps_of transitive_deps ~ml_kind m |> Memo.return + in + deps_of +;; + +let make_transitive_deps ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ = + let imported_vlib_deps = + match (Modules.With_vlib.split_by_lib modules).vlib with + | [] -> None + | _ :: _ -> + Some + (make_imported_vlib_deps + ~obj_dir + ~vimpl:(Virtual_rules.vimpl_exn impl) + ~dir + ~sctx + ~sandbox + ~for_) + in + ( create_transitive_deps ~sandbox ~modules ~sctx ~dir ~obj_dir ~imported_vlib_deps + , imported_vlib_deps ) +;; + +let deps_of_module ~modules ~transitive_deps ~ml_kind m = + match Module.kind m with + | Wrapped_compat -> + wrapped_compat_deps modules m |> Action_builder.return |> Memo.return + | _ -> + let deps = transitive_deps_of transitive_deps ~ml_kind m in + Memo.return + (match Modules.With_vlib.alias_for modules m with + | [] -> deps + | aliases -> + let open Action_builder.O in + let+ deps = deps in + aliases @ deps) ;; (** Tests whether a set of modules is a singleton *) let has_single_file modules = Option.is_some @@ Modules.With_vlib.as_singleton modules let rec deps_of - ~obj_dir ~modules - ~sandbox - ~impl - ~dir - ~sctx + ~transitive_deps + ~imported_vlib_deps ~ml_kind - ~for_ (m : Modules.Sourced_module.t) = let is_alias_or_root = @@ -157,23 +408,27 @@ let rec deps_of then Memo.return (Action_builder.return []) else ( let skip_if_source_absent f sourced_module = - let m = Modules.Sourced_module.to_module m in - if Module.has m ~ml_kind + let module_ = Modules.Sourced_module.to_module sourced_module in + if Module.has module_ ~ml_kind then f sourced_module else Memo.return (Action_builder.return []) in match m with | Imported_from_vlib _ -> - let vimpl = Virtual_rules.vimpl_exn impl in - skip_if_source_absent - (deps_of_vlib_module ~obj_dir ~vimpl ~dir ~sctx ~ml_kind ~for_) - m - | Normal m -> + (match imported_vlib_deps with + | None -> Code_error.raise "imported vlib module without vlib deps" [] + | Some imported_vlib_deps -> + skip_if_source_absent + (fun sourced_module -> imported_vlib_deps sourced_module ~ml_kind) + m) + | Normal _ -> skip_if_source_absent - (deps_of_module ~modules ~sandbox ~sctx ~dir ~obj_dir ~ml_kind ~for_) + (fun sourced_module -> + Modules.Sourced_module.to_module sourced_module + |> deps_of_module ~modules ~transitive_deps ~ml_kind) m | Impl_of_virtual_module impl_or_vlib -> - deps_of ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~ml_kind ~for_ + deps_of ~modules ~transitive_deps ~imported_vlib_deps ~ml_kind @@ let m = Ml_kind.Dict.get impl_or_vlib ml_kind in (match ml_kind with @@ -181,7 +436,17 @@ let rec deps_of | Impl -> Normal m)) ;; -let read_transitive_deps_of_module ~modules ~obj_dir ~ml_kind ~for_ unit = +let read_transitive_deps_of_module + ~sandbox + ~sctx + ~modules + ~obj_dir + ~impl + ~dir + ~for_ + ~ml_kind + unit + = match Module.kind unit with | Root | Alias _ -> Action_builder.return [] | Wrapped_compat -> wrapped_compat_deps modules unit |> Action_builder.return @@ -190,7 +455,10 @@ let read_transitive_deps_of_module ~modules ~obj_dir ~ml_kind ~for_ unit = then Action_builder.return [] else let open Action_builder.O in - let+ deps = Ocamldep.read_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit in + let transitive_deps, _imported_vlib_deps = + make_transitive_deps ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ + in + let+ deps = transitive_deps_of transitive_deps ~ml_kind unit in (match Modules.With_vlib.alias_for modules unit with | [] -> deps | aliases -> aliases @ deps) @@ -206,9 +474,19 @@ let read_immediate_deps_of ~sandbox ~sctx ~obj_dir ~modules ~ml_kind m = else Ocamldep.read_immediate_deps_of ~sandbox ~sctx ~obj_dir ~modules ~ml_kind m ;; -let read_deps_of ~obj_dir ~modules ~ml_kind ~for_ m = +let read_deps_of ~sandbox ~sctx ~obj_dir ~modules ~impl ~dir ~for_ ~ml_kind m = if Module.has m ~ml_kind - then read_transitive_deps_of_module ~modules ~obj_dir ~ml_kind ~for_ m + then + read_transitive_deps_of_module + ~sandbox + ~sctx + ~modules + ~obj_dir + ~impl + ~dir + ~for_ + ~ml_kind + m else Action_builder.return [] ;; @@ -219,19 +497,25 @@ let dict_of_func_concurrently f = ;; let for_module ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ module_ = + let transitive_deps, imported_vlib_deps = + make_transitive_deps ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ + in dict_of_func_concurrently - (deps_of ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ (Normal module_)) + (deps_of ~modules ~transitive_deps ~imported_vlib_deps (Normal module_)) ;; let rules ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~for_ = match Modules.With_vlib.as_singleton modules with | Some m -> Memo.return (Dep_graph.Ml_kind.dummy m) | None -> + let transitive_deps, imported_vlib_deps = + make_transitive_deps ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~for_ + in dict_of_func_concurrently (fun ~ml_kind -> let+ per_module = Modules.With_vlib.obj_map modules |> Parallel_map.parallel_map ~f:(fun _obj_name m -> - deps_of ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~ml_kind ~for_ m) + deps_of ~modules ~transitive_deps ~imported_vlib_deps ~ml_kind m) in Dep_graph.make ~dir ~per_module) |> Memo.map ~f:(Dep_graph.Ml_kind.for_module_compilation ~modules) diff --git a/src/dune_rules/dep_rules.mli b/src/dune_rules/dep_rules.mli index bfefc1e75d9..8e1324d6050 100644 --- a/src/dune_rules/dep_rules.mli +++ b/src/dune_rules/dep_rules.mli @@ -33,9 +33,13 @@ val read_immediate_deps_of -> Module.t list Action_builder.t val read_deps_of - : obj_dir:Path.Build.t Obj_dir.t + : sandbox:Sandbox_config.t + -> sctx:Super_context.t + -> obj_dir:Path.Build.t Obj_dir.t -> modules:Modules.With_vlib.t - -> ml_kind:Ml_kind.t + -> impl:Virtual_rules.t + -> dir:Path.Build.t -> for_:Compilation_mode.t + -> ml_kind:Ml_kind.t -> Module.t -> Module.t list Action_builder.t diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index ef7cb851a2c..521f206411c 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -246,7 +246,16 @@ let make_same_lib_emission_deps = >>= function | true -> let* intf_deps = - Dep_rules.read_deps_of ~obj_dir ~modules ~ml_kind:Intf module_ ~for_ + Dep_rules.read_deps_of + ~sandbox + ~sctx + ~obj_dir + ~modules + ~impl:Virtual_rules.no_implements + ~dir:(Obj_dir.dir obj_dir) + ~for_ + ~ml_kind:Intf + module_ in (* Cross-module optimization follows implementation artifacts, but the initial reachability also comes from the emitted module's interface @@ -256,10 +265,10 @@ let make_same_lib_emission_deps = |> Action_builder.map ~f:(deps_of_xopt_closure ~obj_dir) | false -> (* Emission reads same-library implementation artifacts recursively. - The generic [.impl.all-deps] files collapse transitive edges through - interfaces when a dependency has an [.mli], which is fine for - compilation but insufficient for JS emission. Follow the - implementation dependency graph directly instead. *) + Compilation dependencies collapse transitive edges through interfaces + when a dependency has an [.mli], which is insufficient for JS + emission. Follow the implementation dependency graph directly + instead. *) Dep_graph.top_closed_implementations dep_graph [ module_ ] |> Action_builder.map ~f:(deps_of_impl_closure ~obj_dir) ;; diff --git a/src/dune_rules/obj_dir.ml b/src/dune_rules/obj_dir.ml index ca4fc861ccb..31c77c5c860 100644 --- a/src/dune_rules/obj_dir.ml +++ b/src/dune_rules/obj_dir.ml @@ -617,38 +617,6 @@ module Module = struct relative t (odoc_dir t) basename ;; - module Dep = struct - type t = Transitive of Module.t * Ml_kind.t - - let make_name m kind ext = - let ext = - sprintf ".%s%s" (Ml_kind.to_string kind) (Filename.Extension.to_string ext) - |> Filename.Extension.of_string_exn - in - let obj = Module.obj_name m in - Module_name.Unique.artifact_filename obj ~ext - ;; - - let basename = function - | Transitive (m, kind) -> make_name m kind Filename.Extension.all_deps - ;; - end - - let dep t dep ~for_ = - match (dep : Dep.t) with - | Transitive (m, _) -> - (match Module.kind m with - | Module.Kind.Alias _ | Root -> None - | _ -> - let dir = - match for_ with - | Compilation_mode.Ocaml -> obj_dir t - | Melange -> melange_dir t - in - let name = Dep.basename dep in - Some (Path.Build.relative dir name)) - ;; - module L = struct let o_files t modules ~ext_obj = List.filter_map modules ~f:(fun m -> diff --git a/src/dune_rules/obj_dir.mli b/src/dune_rules/obj_dir.mli index f61582d14b0..8e2190de14c 100644 --- a/src/dune_rules/obj_dir.mli +++ b/src/dune_rules/obj_dir.mli @@ -35,7 +35,7 @@ val equal : 'a t -> 'a t -> bool (** The source_root directory *) val dir : 'path t -> 'path -(** The directory for ocamldep files *) +(** The private object directory *) val obj_dir : 'path t -> 'path (** The private compiled native file directory *) @@ -150,10 +150,4 @@ module Module : sig val o_files : 'path t -> Module.t list -> ext_obj:Filename.Extension.t -> Path.t list val cm_files : 'path t -> Module.t list -> kind:Lib_mode.Cm_kind.t -> Path.t list end - - module Dep : sig - type t = Transitive of Module.t * Ml_kind.t - end - - val dep : Path.Build.t t -> Dep.t -> for_:Compilation_mode.t -> Path.Build.t option end diff --git a/src/dune_rules/ocamldep.ml b/src/dune_rules/ocamldep.ml index a19d71fb7b3..a8aeb6c8252 100644 --- a/src/dune_rules/ocamldep.ml +++ b/src/dune_rules/ocamldep.ml @@ -1,57 +1,4 @@ open Import -open Memo.O - -module Merge_files_into = struct - module Spec = struct - type ('src, 'dst) t = - { transitive : 'src list - ; immediate : Module_name.Unique.t list - ; target : 'dst - } - - let name = "merge_files_into" - let version = 2 - let is_useful_to ~memoize:_ = true - - let bimap t path target = - { t with transitive = List.map t.transitive ~f:path; target = target t.target } - ;; - - let encode - (type src dst) - ({ transitive; immediate; target } : (src, dst) t) - (input : src -> Sexp.t) - (output : dst -> Sexp.t) - : Sexp.t - = - List - [ List (List.map transitive ~f:input) - ; List - (List.map ~f:(fun s -> Sexp.Atom (Module_name.Unique.to_string s)) immediate) - ; output target - ] - ;; - - let action { transitive; immediate; target } ~ectx:_ ~eenv:_ = - Async.async (fun () -> - List.fold_left - transitive - ~init:(Module_name.Unique.Set.of_list immediate) - ~f:(fun set source_path -> - Io.lines_of_file source_path - |> Module_name.Unique.Set.of_list_map ~f:Module_name.Unique.of_string - |> Module_name.Unique.Set.union set) - |> Module_name.Unique.Set.to_list_map ~f:Module_name.Unique.to_string - |> Io.write_lines (Path.build target)) - ;; - end - - module Action = Action_ext.Make (Spec) - - let action ~transitive ~immediate ~target = - Action.action { transitive; immediate; target } - ;; -end let parse_module_names ~dir ~(unit : Module.t) ~modules words = List.concat_map words ~f:(fun m -> @@ -75,14 +22,6 @@ let parse_module_names ~dir ~(unit : Module.t) ~modules words = ]) ;; -let parse_compilation_units ~modules = - let obj_map = Modules.With_vlib.obj_map modules in - List.filter_map ~f:(fun m -> - let obj_name = Module_name.Unique.of_string m in - Module_name.Unique.Map.find obj_map obj_name - |> Option.map ~f:Modules.Sourced_module.to_module) -;; - let parse_deps_exn = let invalid file lines = User_error.raise @@ -106,19 +45,6 @@ let parse_deps_exn = String.extract_blank_separated_words deps) ;; -let transitive_deps = - let transive_dep obj_dir m ~for_ = - (match Module.kind m with - | Root | Alias _ -> None - | _ -> if Module.has m ~ml_kind:Intf then Some Ml_kind.Intf else Some Impl) - |> Option.map ~f:(fun ml_kind -> - Obj_dir.Module.dep obj_dir ~for_ (Transitive (m, ml_kind)) - |> Option.value_exn (* we already checked if it's an alias module *) - |> Path.build) - in - fun obj_dir modules ~for_ -> List.filter_map modules ~f:(transive_dep obj_dir ~for_) -;; - let ocamldep_action ~sandbox ~sctx ~dir ~ml_kind unit = let context = Super_context.context sctx in let flags, sandbox = @@ -174,39 +100,3 @@ let read_immediate_deps_of ~sandbox ~sctx ~obj_dir ~modules ~ml_kind unit = |> Action_builder.of_memo |> Action_builder.memoize memo_name ;; - -let deps_of ~sandbox ~modules ~sctx ~dir ~obj_dir ~ml_kind ~for_ unit = - let dep = Obj_dir.Module.dep obj_dir ~for_ in - let all_deps_file = dep (Transitive (unit, ml_kind)) |> Option.value_exn in - let+ () = - let produce_all_deps = - let open Action_builder.O in - (let+ transitive, immediate = - (let+ immediate_deps = - read_immediate_deps_of ~sandbox ~sctx ~obj_dir ~modules ~ml_kind unit - in - let transitive_deps = transitive_deps obj_dir immediate_deps ~for_ in - let immediate_deps = List.map immediate_deps ~f:Module.obj_name in - (transitive_deps, immediate_deps), transitive_deps) - |> Action_builder.dyn_paths - in - Merge_files_into.action ~transitive ~immediate ~target:all_deps_file) - |> Action_builder.with_file_targets ~file_targets:[ all_deps_file ] - in - Action_builder.With_targets.map ~f:Action.Full.make produce_all_deps - |> Super_context.add_rule sctx ~dir - in - let all_deps_file = Path.build all_deps_file in - Action_builder.lines_of all_deps_file - |> Action_builder.map ~f:(parse_compilation_units ~modules) - |> Action_builder.memoize (Path.to_string all_deps_file) -;; - -let read_deps_of ~obj_dir ~modules ~ml_kind ~for_ unit = - let all_deps_file = - Obj_dir.Module.dep obj_dir ~for_ (Transitive (unit, ml_kind)) |> Option.value_exn - in - Action_builder.lines_of (Path.build all_deps_file) - |> Action_builder.map ~f:(parse_compilation_units ~modules) - |> Action_builder.memoize (Path.Build.to_string all_deps_file) -;; diff --git a/src/dune_rules/ocamldep.mli b/src/dune_rules/ocamldep.mli index 156f96f5477..bf01cca1992 100644 --- a/src/dune_rules/ocamldep.mli +++ b/src/dune_rules/ocamldep.mli @@ -2,25 +2,6 @@ open Import -val deps_of - : sandbox:Sandbox_config.t - -> modules:Modules.With_vlib.t - -> sctx:Super_context.t - -> dir:Path.Build.t - -> obj_dir:Path.Build.t Obj_dir.t - -> ml_kind:Ml_kind.t - -> for_:Compilation_mode.t - -> Module.t - -> Module.t list Action_builder.t Memo.t - -val read_deps_of - : obj_dir:Path.Build.t Obj_dir.t - -> modules:Modules.With_vlib.t - -> ml_kind:Ml_kind.t - -> for_:Compilation_mode.t - -> Module.t - -> Module.t list Action_builder.t - (** [read_immediate_deps_of ~obj_dir ~modules ~ml_kind unit] returns the immediate dependencies found in the modules of [modules] for the file with kind [ml_kind] of the module [unit]. If there is no such file with kind diff --git a/test/blackbox-tests/test-cases/cyclic-dep-executable.t b/test/blackbox-tests/test-cases/cyclic-dep-executable.t index 01c71e7c66a..140e871c465 100644 --- a/test/blackbox-tests/test-cases/cyclic-dep-executable.t +++ b/test/blackbox-tests/test-cases/cyclic-dep-executable.t @@ -23,12 +23,11 @@ Reports module dependency cycles inside executables. $ dune build Error: Dependency cycle between: - _build/default/.foo.eobjs/dune__exe__Baz.impl.all-deps - -> _build/default/.foo.eobjs/dune__exe__Bar.impl.all-deps - -> _build/default/.foo.eobjs/dune__exe__Baz.impl.all-deps - -> required by _build/default/.foo.eobjs/dune__exe__Foo.impl.all-deps + transitive deps of dune__exe__Baz.impl in _build/default + -> transitive deps of dune__exe__Bar.impl in _build/default + -> transitive deps of dune__exe__Baz.impl in _build/default + -> required by transitive deps of dune__exe__Foo.impl in _build/default -> required by _build/default/foo.exe -> required by alias all -> required by alias default [1] - diff --git a/test/blackbox-tests/test-cases/include-qualified/build-with-sandbox.t b/test/blackbox-tests/test-cases/include-qualified/build-with-sandbox.t index 957b1dc7d03..82a76075b29 100644 --- a/test/blackbox-tests/test-cases/include-qualified/build-with-sandbox.t +++ b/test/blackbox-tests/test-cases/include-qualified/build-with-sandbox.t @@ -19,11 +19,28 @@ Test `(include_subdirs qualified)` with sandboxing $ DUNE_SANDBOX=symlink dune build -Transitive deps file includes the alias module +No transitive deps file is materialized. - $ cat _build/default/lib/.foo.objs/foo__Bar.impl.all-deps - foo__Sub - foo__Sub__Hello + $ find _build -name "*.all-deps" | sort + +Transitive alias dependencies are still available under sandboxing when a +compiled interface exposes a qualified submodule path. + + $ cat > lib/a.ml < let x = B.x + > EOF + $ cat > lib/b.mli < val x : Sub.T.t + > EOF + $ cat > lib/b.ml < let x = Sub.T.x + > EOF + $ cat > lib/sub/t.ml < type t = int + > let x = 0 + > EOF + + $ DUNE_SANDBOX=symlink dune build $ cat > lib/dune < (include_subdirs qualified) @@ -34,6 +51,7 @@ Transitive deps file includes the alias module > EOF $ cat > lib/sub/sub.ml < module Hello = Hello + > module T = T > let world = "world" > EOF $ cat > lib/sub/hello.ml < required by _build/default/.foo.objs/foo__X__Y__Z.impl.all-deps + -> required by transitive deps of foo__X__Y__Z.impl in _build/default -> required by _build/default/.foo.objs/byte/foo__X__Y__Z.cmo -> required by _build/default/foo.cma -> required by alias all diff --git a/test/blackbox-tests/test-cases/include-qualified/invalid-deps/group-interface.t b/test/blackbox-tests/test-cases/include-qualified/invalid-deps/group-interface.t index 8682855cf4c..dce4aa17d76 100644 --- a/test/blackbox-tests/test-cases/include-qualified/invalid-deps/group-interface.t +++ b/test/blackbox-tests/test-cases/include-qualified/invalid-deps/group-interface.t @@ -23,7 +23,7 @@ We shouldn't allow foo/$x.ml to depend on foo/foo.ml Baz is the main module of the library and is the only module exposed outside of the library. Consequently, it should be the one depending on all the other modules in the library. - -> required by _build/default/.foo.objs/foo__Baz__Bar.impl.all-deps + -> required by transitive deps of foo__Baz__Bar.impl in _build/default -> required by _build/default/.foo.objs/byte/foo__Baz__Bar.cmo -> required by _build/default/foo.cma -> required by alias all diff --git a/test/blackbox-tests/test-cases/include-qualified/ocamldep-regression.t b/test/blackbox-tests/test-cases/include-qualified/ocamldep-regression.t index 502d4b9b04f..58a6d9830dd 100644 --- a/test/blackbox-tests/test-cases/include-qualified/ocamldep-regression.t +++ b/test/blackbox-tests/test-cases/include-qualified/ocamldep-regression.t @@ -39,7 +39,7 @@ We also forbid submodules from depending on their interface modules: Baz is the main module of the library and is the only module exposed outside of the library. Consequently, it should be the one depending on all the other modules in the library. - -> required by _build/default/.foo.objs/foo__Baz__Bar.impl.all-deps + -> required by transitive deps of foo__Baz__Bar.impl in _build/default -> required by _build/default/.foo.objs/byte/foo__Baz__Bar.cmo -> required by _build/default/foo.cma -> required by alias all @@ -60,7 +60,7 @@ Or their parent interface modules: Baz is the main module of the library and is the only module exposed outside of the library. Consequently, it should be the one depending on all the other modules in the library. - -> required by _build/default/.foo.objs/foo__Baz__Foo__Z.impl.all-deps + -> required by transitive deps of foo__Baz__Foo__Z.impl in _build/default -> required by _build/default/.foo.objs/byte/foo__Baz__Foo__Z.cmo -> required by _build/default/foo.cma -> required by alias all diff --git a/test/blackbox-tests/test-cases/inline-tests/alias-cycle.t b/test/blackbox-tests/test-cases/inline-tests/alias-cycle.t index ee3e794e9fd..685c8966e67 100644 --- a/test/blackbox-tests/test-cases/inline-tests/alias-cycle.t +++ b/test/blackbox-tests/test-cases/inline-tests/alias-cycle.t @@ -29,13 +29,13 @@ turn depends on the inline-test-name alias of the inline tests of the library. This kind of cycle has a difficult to understand error message. $ dune build 2>&1 | grep -vwE "sed" Error: Dependency cycle between: - _build/default/.foo_simple.objs/foo_simple__Bar.impl.all-deps + transitive deps of foo_simple__Bar.impl in _build/default -> _build/default/.foo_simple.objs/byte/foo_simple__Bar.cmi -> _build/default/.foo_simple.inline-tests/.t.eobjs/native/dune__exe__Main.cmx -> _build/default/.foo_simple.inline-tests/inline-test-runner.exe -> alias runtest-foo_simple in dune:9 -> _build/default/bar.ml - -> _build/default/.foo_simple.objs/foo_simple__Bar.impl.all-deps + -> transitive deps of foo_simple__Bar.impl in _build/default -> required by _build/default/.foo_simple.objs/byte/foo_simple__Bar.cmo -> required by _build/default/foo_simple.cma -> required by alias all diff --git a/test/blackbox-tests/test-cases/melange/module-cycle.t b/test/blackbox-tests/test-cases/melange/module-cycle.t index 9947d21ce58..bc39de5c341 100644 --- a/test/blackbox-tests/test-cases/melange/module-cycle.t +++ b/test/blackbox-tests/test-cases/melange/module-cycle.t @@ -20,9 +20,9 @@ $ dune build @check Error: Dependency cycle between: - _build/default/.output.mobjs/melange/melange__Main.impl.all-deps - -> _build/default/.output.mobjs/melange/melange__Hello.impl.all-deps - -> _build/default/.output.mobjs/melange/melange__Main.impl.all-deps + transitive deps of melange__Main.impl in _build/default + -> transitive deps of melange__Hello.impl in _build/default + -> transitive deps of melange__Main.impl in _build/default -> required by _build/default/.output.mobjs/melange/melange__Main.cmi -> required by alias check [1] diff --git a/test/blackbox-tests/test-cases/menhir/inferred-missing-dep.t b/test/blackbox-tests/test-cases/menhir/inferred-missing-dep.t index 9b16df4d34a..7b02e9fb95a 100644 --- a/test/blackbox-tests/test-cases/menhir/inferred-missing-dep.t +++ b/test/blackbox-tests/test-cases/menhir/inferred-missing-dep.t @@ -60,7 +60,7 @@ The first issue #2450 is that `ocamlc -i` may generate a reference to Mylib is the main module of the library and is the only module exposed outside of the library. Consequently, it should be the one depending on all the other modules in the library. - -> required by _build/default/.mylib.objs/mylib__Parser.impl.all-deps + -> required by transitive deps of mylib__Parser.impl in _build/default -> required by _build/default/.mylib.objs/native/mylib__Parser.cmx -> required by _build/default/mylib.a -> required by alias all diff --git a/test/blackbox-tests/test-cases/ocamldep/ocamldep-alias-module.t b/test/blackbox-tests/test-cases/ocamldep/ocamldep-alias-module.t index 6e76c87f8ab..7aa9ab36d66 100644 --- a/test/blackbox-tests/test-cases/ocamldep/ocamldep-alias-module.t +++ b/test/blackbox-tests/test-cases/ocamldep/ocamldep-alias-module.t @@ -12,4 +12,3 @@ We don't need to run ocamldep on ther alias module $ dune build foo.cma $ find _build -iname "*.d" -o -iname "*.all-deps" | sort - _build/default/.foo.objs/foo__Bar.impl.all-deps diff --git a/test/blackbox-tests/test-cases/ocamldep/ocamldep-error-check.t b/test/blackbox-tests/test-cases/ocamldep/ocamldep-error-check.t index ecd63a4ef68..def11700ee7 100644 --- a/test/blackbox-tests/test-cases/ocamldep/ocamldep-error-check.t +++ b/test/blackbox-tests/test-cases/ocamldep/ocamldep-error-check.t @@ -20,7 +20,7 @@ Dune uses ocamldep to prevent a module from depending on itself. Foo is the main module of the library and is the only module exposed outside of the library. Consequently, it should be the one depending on all the other modules in the library. - -> required by _build/default/lib/.foo.objs/foo__Bar.impl.all-deps + -> required by transitive deps of foo__Bar.impl in _build/default/lib -> required by _build/default/lib/.foo.objs/byte/foo__Bar.cmo -> required by _build/default/lib/foo.cma -> required by alias lib/all diff --git a/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t b/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t index e630fee88ae..5832a629f9c 100644 --- a/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t +++ b/test/blackbox-tests/test-cases/reporting-of-cycles.t/run.t @@ -54,16 +54,16 @@ error message. -> required by alias indirect/indirect-deps in indirect/dune:6 [1] -But when the cycle is due to the cmi files themselves, the message becomes -cryptic and can involve unrelated files: +When the cycle is due to the cmi files, it is reported through the transitive +dependency actions: $ echo 'val xx : B.t' >> indirect/c.mli $ dune build @indirect-deps Error: Dependency cycle between: - _build/default/indirect/.a.eobjs/a.impl.all-deps - -> _build/default/indirect/.a.eobjs/b.impl.all-deps - -> _build/default/indirect/.a.eobjs/c.intf.all-deps - -> _build/default/indirect/.a.eobjs/a.impl.all-deps + transitive deps of a.impl in _build/default/indirect + -> transitive deps of b.impl in _build/default/indirect + -> transitive deps of c.intf in _build/default/indirect + -> transitive deps of a.impl in _build/default/indirect -> required by _build/default/indirect/a.exe -> required by alias indirect/indirect-deps in indirect/dune:6 [1] diff --git a/test/blackbox-tests/test-cases/virtual-libraries/virtual-modules-excluded-by-modules-field.t b/test/blackbox-tests/test-cases/virtual-libraries/virtual-modules-excluded-by-modules-field.t index 9ef27f9a09f..b64a3465483 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/virtual-modules-excluded-by-modules-field.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/virtual-modules-excluded-by-modules-field.t @@ -40,11 +40,6 @@ X is warned about: 1 | module type F = X ^ Error: Unbound module type X - File "src/impl/dune", lines 1-3, characters 0-40: - 1 | (library - 2 | (name impl) - 3 | (implements foo)) - Error: No rule found for src/.foo.objs/y.impl.all-deps [1] In 3.11 onwards this warning becomes an error