Allow to compute the deps of an auxiliary module
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
cc7bd5ebb1
commit
634cd25b1b
126
src/ocamldep.ml
126
src/ocamldep.ml
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue