Add Build.if_file_exists
This commit is contained in:
parent
c880cd3e2d
commit
87c958f2e0
|
@ -342,11 +342,7 @@ module Mini_shexp = struct
|
||||||
| Copy_and_add_line_directive (src, dst) ->
|
| Copy_and_add_line_directive (src, dst) ->
|
||||||
with_file_in (Path.to_string src) ~f:(fun ic ->
|
with_file_in (Path.to_string src) ~f:(fun ic ->
|
||||||
with_file_out (Path.to_string dst) ~f:(fun oc ->
|
with_file_out (Path.to_string dst) ~f:(fun oc ->
|
||||||
let fn =
|
let fn = Path.drop_build_context src in
|
||||||
match Path.extract_build_context src with
|
|
||||||
| None -> src
|
|
||||||
| Some (_, rem) -> rem
|
|
||||||
in
|
|
||||||
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
Printf.fprintf oc "# 1 %S\n" (Path.to_string fn);
|
||||||
copy_channels ic oc));
|
copy_channels ic oc));
|
||||||
return ()
|
return ()
|
||||||
|
|
24
src/build.ml
24
src/build.ml
|
@ -34,12 +34,23 @@ module Repr = struct
|
||||||
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
||||||
| Paths : Pset.t -> ('a, 'a) t
|
| Paths : Pset.t -> ('a, 'a) t
|
||||||
| Paths_glob : Path.t * Re.re -> ('a, 'a) t
|
| Paths_glob : Path.t * Re.re -> ('a, 'a) t
|
||||||
|
(* The reference gets decided in Build_interpret.deps *)
|
||||||
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
| Contents : Path.t -> ('a, string) t
|
| Contents : Path.t -> ('a, string) t
|
||||||
| Lines_of : Path.t -> ('a, string list) t
|
| Lines_of : Path.t -> ('a, string list) t
|
||||||
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> (_, _) t
|
| Fail : fail -> (_, _) t
|
||||||
|
|
||||||
|
and ('a, 'b) if_file_exists_state =
|
||||||
|
| Undecided of ('a, 'b) t * ('a, 'b) t
|
||||||
|
| Decided of bool * ('a, 'b) t
|
||||||
|
|
||||||
|
let get_if_file_exists_exn state =
|
||||||
|
match !state with
|
||||||
|
| Decided (_, t) -> t
|
||||||
|
| Undecided _ -> code_errorf "Build.get_if_file_exists_exn: got undecided"
|
||||||
end
|
end
|
||||||
include Repr
|
include Repr
|
||||||
let repr t = t
|
let repr t = t
|
||||||
|
@ -108,6 +119,19 @@ let dyn_paths t = Dyn_paths t
|
||||||
let contents p = Contents p
|
let contents p = Contents p
|
||||||
let lines_of p = Lines_of p
|
let lines_of p = Lines_of p
|
||||||
|
|
||||||
|
let if_file_exists p ~then_ ~else_ =
|
||||||
|
If_file_exists (p, ref (Undecided (then_, else_)))
|
||||||
|
|
||||||
|
let file_exists p =
|
||||||
|
if_file_exists p
|
||||||
|
~then_:(arr (fun _ -> true))
|
||||||
|
~else_:(arr (fun _ -> false))
|
||||||
|
|
||||||
|
let file_exists_opt p t =
|
||||||
|
if_file_exists p
|
||||||
|
~then_:(t >>^ fun x -> Some x)
|
||||||
|
~else_:(arr (fun _ -> None))
|
||||||
|
|
||||||
let fail ?targets x =
|
let fail ?targets x =
|
||||||
match targets with
|
match targets with
|
||||||
| None -> Fail x
|
| None -> Fail x
|
||||||
|
|
|
@ -45,6 +45,22 @@ val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
val contents : Path.t -> ('a, string) t
|
val contents : Path.t -> ('a, string) t
|
||||||
val lines_of : Path.t -> ('a, string list) t
|
val lines_of : Path.t -> ('a, string list) t
|
||||||
|
|
||||||
|
(** Evaluates to [true] if the file is present on the file system or is the target of a
|
||||||
|
rule. *)
|
||||||
|
val file_exists : Path.t -> ('a, bool) t
|
||||||
|
|
||||||
|
(** [if_file_exists p ~then ~else] is an arrow that behaves like [then_] if [file_exists
|
||||||
|
p] evaluates to [true], and [else_] otherwise. *)
|
||||||
|
val if_file_exists : Path.t -> then_:('a, 'b) t -> else_:('a, 'b) t -> ('a, 'b) t
|
||||||
|
|
||||||
|
(** [file_exists_opt p t] is:
|
||||||
|
|
||||||
|
{[
|
||||||
|
if_file_exists p ~then_:(t >>^ fun x -> Some x) ~else_:(arr (fun _ -> None))
|
||||||
|
]}
|
||||||
|
*)
|
||||||
|
val file_exists_opt : Path.t -> ('a, 'b) t -> ('a, 'b option) t
|
||||||
|
|
||||||
(** Always fail when executed. We pass a function rather than an exception to get a proper
|
(** Always fail when executed. We pass a function rather than an exception to get a proper
|
||||||
backtrace *)
|
backtrace *)
|
||||||
val fail : ?targets:Path.t list -> fail -> (_, _) t
|
val fail : ?targets:Path.t list -> fail -> (_, _) t
|
||||||
|
@ -126,12 +142,19 @@ module Repr : sig
|
||||||
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
|
||||||
| Paths : Path.Set.t -> ('a, 'a) t
|
| Paths : Path.Set.t -> ('a, 'a) t
|
||||||
| Paths_glob : Path.t * Re.re -> ('a, 'a) t
|
| Paths_glob : Path.t * Re.re -> ('a, 'a) t
|
||||||
|
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
| Contents : Path.t -> ('a, string) t
|
| Contents : Path.t -> ('a, string) t
|
||||||
| Lines_of : Path.t -> ('a, string list) t
|
| Lines_of : Path.t -> ('a, string list) t
|
||||||
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
| Vpath : 'a Vspec.t -> (unit, 'a) t
|
||||||
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
| Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
|
||||||
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
| Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t
|
||||||
| Fail : fail -> (_, _) t
|
| Fail : fail -> (_, _) t
|
||||||
|
|
||||||
|
and ('a, 'b) if_file_exists_state =
|
||||||
|
| Undecided of ('a, 'b) t * ('a, 'b) t
|
||||||
|
| Decided of bool * ('a, 'b) t
|
||||||
|
|
||||||
|
val get_if_file_exists_exn : ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
|
||||||
end
|
end
|
||||||
|
|
||||||
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
val repr : ('a, 'b) t -> ('a, 'b) Repr.t
|
||||||
|
|
|
@ -40,6 +40,23 @@ let deps t ~all_targets_by_dir =
|
||||||
Re.execp re (Path.basename path))
|
Re.execp re (Path.basename path))
|
||||||
|> Pset.union acc
|
|> Pset.union acc
|
||||||
end
|
end
|
||||||
|
| If_file_exists (p, state) -> begin
|
||||||
|
match !state with
|
||||||
|
| Decided (exists, t) -> loop t (if exists then Pset.add p acc else acc)
|
||||||
|
| Undecided (then_, else_) ->
|
||||||
|
let dir = Path.parent p in
|
||||||
|
let targets =
|
||||||
|
Option.value (Pmap.find dir (Lazy.force all_targets_by_dir))
|
||||||
|
~default:Pset.empty
|
||||||
|
in
|
||||||
|
if Pset.mem p targets then begin
|
||||||
|
state := Decided (true, then_);
|
||||||
|
loop then_ (Pset.add p acc)
|
||||||
|
end else begin
|
||||||
|
state := Decided (false, else_);
|
||||||
|
loop else_ acc
|
||||||
|
end
|
||||||
|
end
|
||||||
| Dyn_paths t -> loop t acc
|
| Dyn_paths t -> loop t acc
|
||||||
| Contents p -> Pset.add p acc
|
| Contents p -> Pset.add p acc
|
||||||
| Lines_of p -> Pset.add p acc
|
| Lines_of p -> Pset.add p acc
|
||||||
|
@ -74,6 +91,8 @@ let lib_deps =
|
||||||
in
|
in
|
||||||
Pmap.add acc ~key:dir ~data
|
Pmap.add acc ~key:dir ~data
|
||||||
| Fail _ -> acc
|
| Fail _ -> acc
|
||||||
|
| If_file_exists (_, state) ->
|
||||||
|
loop (get_if_file_exists_exn state) acc
|
||||||
in
|
in
|
||||||
fun t -> loop (Build.repr t) Pmap.empty
|
fun t -> loop (Build.repr t) Pmap.empty
|
||||||
|
|
||||||
|
@ -97,6 +116,16 @@ let targets =
|
||||||
| Lines_of _ -> acc
|
| Lines_of _ -> acc
|
||||||
| Record_lib_deps _ -> acc
|
| Record_lib_deps _ -> acc
|
||||||
| Fail _ -> acc
|
| Fail _ -> acc
|
||||||
|
| If_file_exists (_, state) -> begin
|
||||||
|
match !state with
|
||||||
|
| Decided _ -> code_errorf "Build_interpret.targets got decided if_file_exists"
|
||||||
|
| Undecided (a, b) ->
|
||||||
|
match loop a [], loop b [] with
|
||||||
|
| [], [] -> acc
|
||||||
|
| _ ->
|
||||||
|
code_errorf "Build_interpret.targets: cannot have targets \
|
||||||
|
under a [if_file_exists]"
|
||||||
|
end
|
||||||
in
|
in
|
||||||
fun t -> loop (Build.repr t) []
|
fun t -> loop (Build.repr t) []
|
||||||
|
|
||||||
|
|
|
@ -248,6 +248,8 @@ module Build_exec = struct
|
||||||
x
|
x
|
||||||
| Record_lib_deps _ -> x
|
| Record_lib_deps _ -> x
|
||||||
| Fail { fail } -> fail ()
|
| Fail { fail } -> fail ()
|
||||||
|
| If_file_exists (_, state) ->
|
||||||
|
exec (get_if_file_exists_exn state) x
|
||||||
in
|
in
|
||||||
let action = exec (Build.repr t) x in
|
let action = exec (Build.repr t) x in
|
||||||
(action, !dyn_deps)
|
(action, !dyn_deps)
|
||||||
|
|
|
@ -639,7 +639,9 @@ module Gen(P : Params) = struct
|
||||||
let meta_fn = "META." ^ pkg.name in
|
let meta_fn = "META." ^ pkg.name in
|
||||||
let meta_templ_fn = meta_fn ^ ".template" in
|
let meta_templ_fn = meta_fn ^ ".template" in
|
||||||
|
|
||||||
let files = SC.sources_and_targets_known_so_far sctx ~src_path:pkg.path in
|
let files =
|
||||||
|
SC.sources_and_targets_known_so_far sctx ~src_path:pkg.path
|
||||||
|
in
|
||||||
let has_meta, has_meta_tmpl =
|
let has_meta, has_meta_tmpl =
|
||||||
(String_set.mem meta_fn files,
|
(String_set.mem meta_fn files,
|
||||||
String_set.mem meta_templ_fn files)
|
String_set.mem meta_templ_fn files)
|
||||||
|
|
Loading…
Reference in New Issue