Added deps/targets inference
This commit is contained in:
parent
b9c9b19f0a
commit
7c9dcbf284
|
@ -444,3 +444,48 @@ let sandbox t ~sandboxed ~deps ~targets =
|
||||||
else
|
else
|
||||||
None))
|
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
|
||||||
|
|
|
@ -21,6 +21,18 @@ val updated_files : t -> Path.Set.t
|
||||||
(** Return the list of directories the action chdirs to *)
|
(** Return the list of directories the action chdirs to *)
|
||||||
val chdirs : t -> Path.Set.t
|
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
|
module Unexpanded : sig
|
||||||
type action = t
|
type action = t
|
||||||
|
|
||||||
|
|
15
src/path.ml
15
src/path.ml
|
@ -192,6 +192,15 @@ module Local = struct
|
||||||
else
|
else
|
||||||
None
|
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 reach t ~from =
|
||||||
let rec loop t from =
|
let rec loop t from =
|
||||||
match t, from with
|
match t, from with
|
||||||
|
@ -290,6 +299,12 @@ let descendant t ~of_ =
|
||||||
else
|
else
|
||||||
None
|
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 =
|
let append a b =
|
||||||
if not (is_local b) then
|
if not (is_local b) then
|
||||||
Sexp.code_error "Path.append called with non-local second path"
|
Sexp.code_error "Path.append called with non-local second path"
|
||||||
|
|
|
@ -59,6 +59,7 @@ val reach : t -> from:t -> string
|
||||||
val reach_for_running : t -> from:t -> string
|
val reach_for_running : t -> from:t -> string
|
||||||
|
|
||||||
val descendant : t -> of_:t -> t option
|
val descendant : t -> of_:t -> t option
|
||||||
|
val is_descendant : t -> of_:t -> bool
|
||||||
|
|
||||||
val append : t -> t -> t
|
val append : t -> t -> t
|
||||||
|
|
||||||
|
|
|
@ -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"])
|
||||||
|
|}]
|
|
@ -29,3 +29,10 @@
|
||||||
(glob_files ${ROOT}/src/*.cmi)
|
(glob_files ${ROOT}/src/*.cmi)
|
||||||
(glob_files ${ROOT}/vendor/re/*.cmi)))
|
(glob_files ${ROOT}/vendor/re/*.cmi)))
|
||||||
(action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))
|
(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} ${<})))))
|
||||||
|
|
Loading…
Reference in New Issue