Extract a Static_deps module

Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
Etienne Millon 2018-09-04 17:00:58 +02:00
parent 74db582b04
commit f2035892aa
5 changed files with 112 additions and 51 deletions

View File

@ -18,13 +18,6 @@ module Target = struct
Path.Set.add acc (path t)) Path.Set.add acc (path t))
end end
module Static_deps = struct
type t =
{ rule_deps : Deps.t
; action_deps : Deps.t
}
end
type file_kind = Reg | Dir type file_kind = Reg | Dir
let inspect_path file_tree path = let inspect_path file_tree path =
@ -67,13 +60,14 @@ let static_deps t ~all_targets ~file_tree =
| Second t -> loop t acc targets_allowed | Second t -> loop t acc targets_allowed
| Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed | Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed | Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Paths fns -> { acc with action_deps = Deps.add_paths acc.action_deps fns } | Paths fns ->
Static_deps.add_action_paths acc fns
| Paths_for_rule fns -> | Paths_for_rule fns ->
{ acc with rule_deps = Deps.add_paths acc.rule_deps fns } Static_deps.add_rule_paths acc fns
| Paths_glob state -> begin | Paths_glob state -> begin
match !state with match !state with
| G_evaluated l -> | G_evaluated l ->
{ acc with action_deps = Deps.add_paths acc.action_deps l } Static_deps.add_action_paths acc l
| G_unevaluated (loc, dir, re) -> | G_unevaluated (loc, dir, re) ->
let targets = all_targets ~dir in let targets = all_targets ~dir in
let result = let result =
@ -95,8 +89,7 @@ let static_deps t ~all_targets ~file_tree =
() ()
end; end;
state := G_evaluated result; state := G_evaluated result;
let action_deps = Deps.add_paths acc.action_deps result in Static_deps.add_action_paths acc result
{ acc with action_deps }
end end
| If_file_exists (p, state) -> begin | If_file_exists (p, state) -> begin
match !state with match !state with
@ -114,21 +107,18 @@ let static_deps t ~all_targets ~file_tree =
end end
| Dyn_paths t -> loop t acc targets_allowed | Dyn_paths t -> loop t acc targets_allowed
| Vpath (Vspec.T (p, _)) -> | Vpath (Vspec.T (p, _)) ->
{ acc with rule_deps = Deps.add_path acc.rule_deps p } Static_deps.add_rule_path acc p
| Contents p -> { acc with rule_deps = Deps.add_path acc.rule_deps p } | Contents p -> Static_deps.add_rule_path acc p
| Lines_of p -> { acc with rule_deps = Deps.add_path acc.rule_deps p } | Lines_of p -> Static_deps.add_rule_path acc p
| Record_lib_deps _ -> acc | Record_lib_deps _ -> acc
| Fail _ -> acc | Fail _ -> acc
| Memo m -> loop m.t acc targets_allowed | Memo m -> loop m.t acc targets_allowed
| Catch (t, _) -> loop t acc targets_allowed | Catch (t, _) -> loop t acc targets_allowed
| Lazy_no_targets t -> loop (Lazy.force t) acc false | Lazy_no_targets t -> loop (Lazy.force t) acc false
| Env_var var -> { acc with action_deps = Deps.add_env_var acc.action_deps var } | Env_var var ->
Static_deps.add_action_env_var acc var
in in
loop (Build.repr t) loop (Build.repr t) Static_deps.empty true
{ rule_deps = Deps.empty
; action_deps = Deps.empty
}
true
let lib_deps = let lib_deps =
let rec loop : type a b. (a, b) t -> Lib_deps_info.t -> Lib_deps_info.t let rec loop : type a b. (a, b) t -> Lib_deps_info.t -> Lib_deps_info.t

View File

@ -33,13 +33,6 @@ module Rule : sig
-> t -> t
end end
module Static_deps : sig
type t =
{ rule_deps : Deps.t
; action_deps : Deps.t
}
end
(* must be called first *) (* must be called first *)
val static_deps val static_deps
: (_, _) Build.t : (_, _) Build.t

View File

@ -109,7 +109,7 @@ module Internal_rule = struct
type t = type t =
{ id : Id.t { id : Id.t
; static_deps : Build_interpret.Static_deps.t Lazy.t ; static_deps : Static_deps.t Lazy.t
; targets : Path.Set.t ; targets : Path.Set.t
; context : Context.t option ; context : Context.t option
; build : (unit, Action.t) Build.t ; build : (unit, Action.t) Build.t
@ -131,7 +131,7 @@ module Internal_rule = struct
let lib_deps t = let lib_deps t =
(* Forcing this lazy ensures that the various globs and (* Forcing this lazy ensures that the various globs and
[if_file_exists] are resolved inside the [Build.t] value. *) [if_file_exists] are resolved inside the [Build.t] value. *)
ignore (Lazy.force t.static_deps : Build_interpret.Static_deps.t); ignore (Lazy.force t.static_deps : Static_deps.t);
Build_interpret.lib_deps t.build Build_interpret.lib_deps t.build
(* Represent the build goal given by the user. This rule is never (* Represent the build goal given by the user. This rule is never
@ -139,9 +139,7 @@ module Internal_rule = struct
dependency paths. *) dependency paths. *)
let root = let root =
{ id = Id.gen () { id = Id.gen ()
; static_deps = lazy { rule_deps = Deps.empty ; static_deps = lazy Static_deps.empty
; action_deps = Deps.empty
}
; targets = Path.Set.empty ; targets = Path.Set.empty
; context = None ; context = None
; build = Build.return (Action.Progn []) ; build = Build.return (Action.Progn [])
@ -739,12 +737,14 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
let eval_rule () = let eval_rule () =
t.hook Rule_started; t.hook Rule_started;
wait_for_deps t (Lazy.force static_deps).rule_deps ~loc let static_deps = Lazy.force static_deps in
wait_for_deps t (Static_deps.rule_deps static_deps) ~loc
>>| fun () -> >>| fun () ->
Build_exec.exec t build () Build_exec.exec t build ()
in in
let exec_rule (rule_evaluation : Exec_status.rule_evaluation) = let exec_rule (rule_evaluation : Exec_status.rule_evaluation) =
let static_deps = (Lazy.force static_deps).action_deps in let static_deps = Lazy.force static_deps in
let static_deps = Static_deps.action_deps static_deps in
Fiber.fork_and_join_unit Fiber.fork_and_join_unit
(fun () -> (fun () ->
wait_for_deps ~loc t static_deps) wait_for_deps ~loc t static_deps)
@ -1261,12 +1261,14 @@ let create ~contexts ~file_tree ~hook =
t t
let eval_request t ~request ~process_target = let eval_request t ~request ~process_target =
let { Build_interpret.Static_deps. let static_deps =
rule_deps Build_interpret.static_deps
; action_deps = static_deps request
} = Build_interpret.static_deps request ~all_targets:(targets_of t) ~all_targets:(targets_of t)
~file_tree:t.file_tree ~file_tree:t.file_tree
in in
let rule_deps = Static_deps.rule_deps static_deps in
let static_deps = Static_deps.action_deps static_deps in
Fiber.fork_and_join_unit Fiber.fork_and_join_unit
(fun () -> parallel_iter_deps ~f:process_target static_deps) (fun () -> parallel_iter_deps ~f:process_target static_deps)
@ -1317,7 +1319,7 @@ let rules_for_targets t targets =
~key:(fun (r : Internal_rule.t) -> r.id) ~key:(fun (r : Internal_rule.t) -> r.id)
~deps:(fun (r : Internal_rule.t) -> ~deps:(fun (r : Internal_rule.t) ->
let x = Lazy.force r.static_deps in let x = Lazy.force r.static_deps in
rules_for_files t (Deps.path_union x.action_deps x.rule_deps)) rules_for_files t (Static_deps.paths x))
with with
| Ok l -> l | Ok l -> l
| Error cycle -> | Error cycle ->
@ -1328,13 +1330,11 @@ let rules_for_targets t targets =
|> String.concat ~sep:"\n-> ") |> String.concat ~sep:"\n-> ")
let static_deps_of_request t request = let static_deps_of_request t request =
let { Build_interpret.Static_deps. Static_deps.paths @@
rule_deps Build_interpret.static_deps
; action_deps request
} = Build_interpret.static_deps request ~all_targets:(targets_of t) ~all_targets:(targets_of t)
~file_tree:t.file_tree ~file_tree:t.file_tree
in
Deps.path_union rule_deps action_deps
let all_lib_deps t ~request = let all_lib_deps t ~request =
let targets = static_deps_of_request t request in let targets = static_deps_of_request t request in
@ -1424,10 +1424,13 @@ let build_rules_internal ?(recursive=false) t ~request =
Fiber.fork (fun () -> Fiber.fork (fun () ->
Fiber.Future.wait rule_evaluation Fiber.Future.wait rule_evaluation
>>| fun (action, dyn_deps) -> >>| fun (action, dyn_deps) ->
let static_deps = (Lazy.force ir.static_deps).action_deps in let action_deps =
Static_deps.action_deps
(Lazy.force ir.static_deps)
in
{ Rule. { Rule.
id = ir.id id = ir.id
; deps = Deps.union static_deps dyn_deps ; deps = Deps.union action_deps dyn_deps
; targets = ir.targets ; targets = ir.targets
; context = ir.context ; context = ir.context
; action = action ; action = action
@ -1505,8 +1508,12 @@ let package_deps t pkg files =
Option.value_exn (Fiber.Future.peek rule_evaluation) Option.value_exn (Fiber.Future.peek rule_evaluation)
| Not_started _ -> assert false | Not_started _ -> assert false
in in
let action_deps =
Static_deps.action_deps
(Lazy.force ir.static_deps)
in
Path.Set.fold Path.Set.fold
(Deps.path_union (Lazy.force ir.static_deps).action_deps dyn_deps) (Deps.path_union action_deps dyn_deps)
~init:acc ~f:loop ~init:acc ~f:loop
end end
in in

38
src/static_deps.ml Normal file
View File

@ -0,0 +1,38 @@
open! Import
type t =
{ rule_deps : Deps.t
; action_deps : Deps.t
}
let action_deps t = t.action_deps
let rule_deps t = t.rule_deps
let empty =
{ rule_deps = Deps.empty
; action_deps = Deps.empty
}
let add_rule_paths t fns =
{ t with
rule_deps = Deps.add_paths t.rule_deps fns
}
let add_rule_path t fn =
{ t with
rule_deps = Deps.add_path t.rule_deps fn
}
let add_action_paths t fns =
{ t with
action_deps = Deps.add_paths t.action_deps fns
}
let add_action_env_var t var =
{ t with
action_deps = Deps.add_env_var t.action_deps var
}
let paths {action_deps; rule_deps} =
Deps.path_union action_deps rule_deps

33
src/static_deps.mli Normal file
View File

@ -0,0 +1,33 @@
open! Import
(** A simple wrapper around [Deps.t], where some dependencies are recorded as
"rule deps" and other as "action deps". *)
type t
(** {1} Constructors *)
(** No dependencies. *)
val empty : t
(** Add a path as a rule dep. *)
val add_rule_path : t -> Path.t -> t
(** Add a set of paths as rule deps. *)
val add_rule_paths : t -> Path.Set.t -> t
(** Add a set of paths as action deps. *)
val add_action_paths : t -> Path.Set.t -> t
(** Add an environment variable as an action dep. *)
val add_action_env_var : t -> string -> t
(** {1} Deconstructors *)
(** Return the rule deps. *)
val rule_deps : t -> Deps.t
(** Return the action deps. *)
val action_deps : t -> Deps.t
(** Return the paths deps, both for the rule deps and the action deps . *)
val paths : t -> Path.Set.t