Added deps/targets inference

This commit is contained in:
Jérémie Dimino 2017-05-28 02:46:07 +01:00
parent b9c9b19f0a
commit 7c9dcbf284
6 changed files with 118 additions and 0 deletions

View File

@ -444,3 +444,48 @@ let sandbox t ~sandboxed ~deps ~targets =
else
None))
]
module Infer = struct
module S = Path.Set
module Outcome = struct
type t =
{ deps : S.t
; targets : S.t
}
end
open Outcome
let ( +@ ) acc fn = { acc with targets = S.add fn acc.targets }
let ( +< ) acc fn =
if S.mem fn acc.targets then
acc
else
{ acc with deps = S.add fn acc.deps }
let ( -@ ) acc fn = { acc with targets = S.remove fn acc.targets }
let rec infer acc t =
match t with
| Run (prog, _) -> acc +< prog
| Redirect (_, fn, t) -> infer (acc +@ fn) t
| Cat fn -> acc +< fn
| Create_file fn -> acc +@ fn
| Update_file (fn, _) -> acc +@ fn
| Rename (src, dst) -> acc +< src +@ dst -@ src
| Copy (src, dst)
| Copy_and_add_line_directive (src, dst)
| Symlink (src, dst) -> acc +< src +@ dst
| Chdir (_, t)
| Setenv (_, _, t)
| Ignore (_, t) -> infer acc t
| Progn l -> List.fold_left l ~init:acc ~f:infer
| Echo _
| System _
| Bash _ -> acc
| Remove_tree dir ->
{ acc with targets = S.filter acc.targets ~f:(fun fn ->
not (Path.is_descendant fn ~of_:dir))
}
let infer t =
infer { deps = S.empty; targets = S.empty } t
end

View File

@ -21,6 +21,18 @@ val updated_files : t -> Path.Set.t
(** Return the list of directories the action chdirs to *)
val chdirs : t -> Path.Set.t
(** Infer dependencies and targets *)
module Infer : sig
module Outcome : sig
type t =
{ deps : Path.Set.t
; targets : Path.Set.t
}
end
val infer : t -> Outcome.t
end
module Unexpanded : sig
type action = t

View File

@ -192,6 +192,15 @@ module Local = struct
else
None
let is_descendant t ~of_ =
match of_ with
| "" -> true
| _ ->
let of_len = String.length of_ in
let t_len = String.length t in
(t_len = of_len && t = of_) ||
(t_len >= of_len && t.[of_len] = '/' && String.is_prefix t ~prefix:of_)
let reach t ~from =
let rec loop t from =
match t, from with
@ -290,6 +299,12 @@ let descendant t ~of_ =
else
None
let is_descendant t ~of_ =
if is_local t && is_local of_ then
Local.is_descendant t ~of_
else
false
let append a b =
if not (is_local b) then
Sexp.code_error "Path.append called with non-local second path"

View File

@ -59,6 +59,7 @@ val reach : t -> from:t -> string
val reach_for_running : t -> from:t -> string
val descendant : t -> of_:t -> t option
val is_descendant : t -> of_:t -> bool
val append : t -> t -> t

View File

@ -0,0 +1,38 @@
(* -*- tuareg -*- *)
#warnings "-40";;
open Jbuilder;;
open Import;;
open Action.Infer.Outcome;;
let p = Path.of_string;;
let infer a =
let x = Action.Infer.infer a in
(List.map (Path.Set.elements x.deps) ~f:Path.to_string,
List.map (Path.Set.elements x.targets) ~f:Path.to_string)
[%%expect{|
val p : string -> Jbuilder.Path.t = <fun>
val infer : Jbuilder__Action.t -> string list * string list = <fun>
|}]
infer (Copy (p "a", p "b"));;
[%%expect{|
- : string list * string list = (["a"], ["b"])
|}]
infer (Progn
[ Copy (p "a", p "b")
; Copy (p "b", p "c")
]);;
[%%expect{|
- : string list * string list = (["a"], ["b"; "c"])
|}]
infer (Progn
[ Copy (p "a", p "b")
; Rename (p "b", p "c")
]);;
[%%expect{|
- : string list * string list = (["a"], ["c"])
|}]

View File

@ -29,3 +29,10 @@
(glob_files ${ROOT}/src/*.cmi)
(glob_files ${ROOT}/vendor/re/*.cmi)))
(action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))
(alias
((name runtest)
(deps (action.mlt
(glob_files ${ROOT}/src/*.cmi)
(glob_files ${ROOT}/vendor/re/*.cmi)))
(action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))