Allow to compute the deps of an auxiliary module

Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
Jeremie Dimino 2018-05-25 16:57:02 +01:00 committed by Jérémie Dimino
parent cc7bd5ebb1
commit 634cd25b1b
2 changed files with 79 additions and 57 deletions

View File

@ -66,6 +66,11 @@ let parse_module_names ~(unit : Module.t) ~modules words =
else else
Module.Name.Map.find modules m) Module.Name.Map.find modules m)
let is_alias_module ~(alias_module : Module.t option) (m : Module.t) =
match alias_module with
| None -> false
| Some alias -> alias.name = m.name
let parse_deps ~dir ~file ~unit let parse_deps ~dir ~file ~unit
~modules ~alias_module ~lib_interface_module lines = ~modules ~alias_module ~lib_interface_module lines =
let invalid () = let invalid () =
@ -94,12 +99,7 @@ let parse_deps ~dir ~file ~unit
(match lib_interface_module with (match lib_interface_module with
| None -> () | None -> ()
| Some (m : Module.t) -> | Some (m : Module.t) ->
let is_alias_module = if unit.name <> m.name && not (is_alias_module unit ~alias_module) &&
match alias_module with
| None -> false
| Some (m : Module.t) -> unit.name = m.name
in
if unit.name <> m.name && not is_alias_module &&
List.exists deps ~f:(fun x -> Module.name x = m.name) then List.exists deps ~f:(fun x -> Module.name x = m.name) then
die "Module %a in directory %s depends on %a.\n\ die "Module %a in directory %s depends on %a.\n\
This doesn't make sense to me.\n\ This doesn't make sense to me.\n\
@ -116,60 +116,64 @@ let parse_deps ~dir ~file ~unit
| None -> deps | None -> deps
| Some m -> m :: deps | Some m -> m :: deps
let rules ~(ml_kind:Ml_kind.t) ~dir ~modules let deps_of ~ml_kind ~dir ~modules ~already_used
?(already_used=Module.Name.Set.empty) ~alias_module ~lib_interface_module sctx unit =
~alias_module ~lib_interface_module sctx = if is_alias_module unit ~alias_module then
let is_alias_module (m : Module.t) = Build.return []
match alias_module with else
| None -> false match Module.file ~dir unit ml_kind with
| Some (alias : Module.t) -> alias.name = m.name | None -> Build.return []
in | Some file ->
let per_module = let all_deps_path file =
Module.Name.Map.map modules ~f:(fun unit -> Path.extend_basename file ~suffix:".all-deps"
match Module.file ~dir unit ml_kind with in
| _ when is_alias_module unit -> Build.return [] let context = SC.context sctx in
| None -> Build.return [] let all_deps_file = all_deps_path file in
| Some file -> let ocamldep_output = Path.extend_basename file ~suffix:".d" in
let all_deps_path file = if not (Module.Name.Set.mem already_used unit.name) then
Path.extend_basename file ~suffix:".all-deps" begin
in SC.add_rule sctx
let context = SC.context sctx in ( Build.run ~context (Ok context.ocamldep)
let all_deps_file = all_deps_path file in [A "-modules"; Ml_kind.flag ml_kind; Dep file]
let ocamldep_output = Path.extend_basename file ~suffix:".d" in ~stdout_to:ocamldep_output
if not (Module.Name.Set.mem already_used unit.name) then );
begin let build_paths dependencies =
SC.add_rule sctx let dependency_file_path m =
( Build.run ~context (Ok context.ocamldep) let path =
[A "-modules"; Ml_kind.flag ml_kind; Dep file] if is_alias_module m ~alias_module then
~stdout_to:ocamldep_output None
); else
let build_paths dependencies =
let dependency_file_path m =
let path =
match Module.file ~dir m Ml_kind.Intf with match Module.file ~dir m Ml_kind.Intf with
| _ when is_alias_module m -> None
| Some _ as x -> x | Some _ as x -> x
| None -> Module.file ~dir m Ml_kind.Impl | None -> Module.file ~dir m Ml_kind.Impl
in
Option.map path ~f:all_deps_path
in in
List.filter_map dependencies ~f:dependency_file_path Option.map path ~f:all_deps_path
in in
SC.add_rule sctx List.filter_map dependencies ~f:dependency_file_path
( Build.lines_of ocamldep_output in
>>^ parse_deps SC.add_rule sctx
~dir ~file ~unit ~modules ~alias_module ( Build.lines_of ocamldep_output
~lib_interface_module >>^ parse_deps
>>^ (fun modules -> ~dir ~file ~unit ~modules ~alias_module
(build_paths modules, ~lib_interface_module
List.map modules ~f:(fun m -> >>^ (fun modules ->
Module.Name.to_string (Module.name m)) (build_paths modules,
)) List.map modules ~f:(fun m ->
>>> Build.merge_files_dyn ~target:all_deps_file) Module.Name.to_string (Module.name m))
end; ))
Build.memoize (Path.to_string all_deps_file) >>> Build.merge_files_dyn ~target:all_deps_file)
( Build.lines_of all_deps_file end;
>>^ parse_module_names ~unit ~modules)) Build.memoize (Path.to_string all_deps_file)
( Build.lines_of all_deps_file
>>^ parse_module_names ~unit ~modules)
let rules_generic ~(ml_kind:Ml_kind.t) ~dir ~modules ~for_modules
?(already_used=Module.Name.Set.empty)
~alias_module ~lib_interface_module sctx =
let per_module =
Module.Name.Map.map for_modules
~f:(deps_of ~ml_kind ~dir ~modules ~already_used
~alias_module ~lib_interface_module sctx)
in in
{ Dep_graph. { Dep_graph.
dir dir
@ -177,5 +181,13 @@ let rules ~(ml_kind:Ml_kind.t) ~dir ~modules
} }
let rules ~dir ~modules ?already_used ~alias_module ~lib_interface_module sctx = let rules ~dir ~modules ?already_used ~alias_module ~lib_interface_module sctx =
Ml_kind.Dict.of_func (rules sctx ~dir ~modules ?already_used ~alias_module Ml_kind.Dict.of_func
~lib_interface_module) (rules_generic sctx ~dir ~modules ~for_modules:modules
?already_used ~alias_module ~lib_interface_module)
let rules_for_auxiliary_module ~dir ~modules ~alias_module
~lib_interface_module sctx (m : Module.t) =
let for_modules = Module.Name.Map.singleton m.name m in
Ml_kind.Dict.of_func
(rules_generic sctx ~dir ~modules ~for_modules
?already_used:None ~alias_module ~lib_interface_module)

View File

@ -42,3 +42,13 @@ val rules
-> lib_interface_module:Module.t option -> lib_interface_module:Module.t option
-> Super_context.t -> Super_context.t
-> Dep_graphs.t -> Dep_graphs.t
(** Compute the dependencies of an auxiliary module. *)
val rules_for_auxiliary_module
: dir:Path.t
-> modules:Module.t Module.Name.Map.t
-> alias_module:Module.t option
-> lib_interface_module:Module.t option
-> Super_context.t
-> Module.t
-> Dep_graphs.t