Added deps/targets inference
This commit is contained in:
parent
b9c9b19f0a
commit
7c9dcbf284
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
15
src/path.ml
15
src/path.ml
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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}/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} ${<})))))
|
||||
|
|
Loading…
Reference in New Issue