Build.t doesn't need Future to be interpreted
This commit is contained in:
parent
ca4b6fbf41
commit
292f423cda
|
@ -174,56 +174,55 @@ let vfile_to_string (type a) (module K : Vfile_kind.S with type t = a) fn x =
|
||||||
module Build_exec = struct
|
module Build_exec = struct
|
||||||
open Build.Repr
|
open Build.Repr
|
||||||
|
|
||||||
let exec bs t x ~static_deps ~targeting =
|
let exec bs t x =
|
||||||
let all_deps = ref static_deps in
|
let dyn_deps = ref Pset.empty in
|
||||||
let rec exec
|
let rec exec
|
||||||
: type a b. (a, b) t -> a -> b Future.t = fun t x ->
|
: type a b. (a, b) t -> a -> b = fun t x ->
|
||||||
let return = Future.return in
|
|
||||||
match t with
|
match t with
|
||||||
| Arr f -> return (f x)
|
| Arr f -> f x
|
||||||
| Targets _ -> return x
|
| Targets _ -> x
|
||||||
| Store_vfile (Vspec.T (fn, kind)) ->
|
| Store_vfile (Vspec.T (fn, kind)) ->
|
||||||
let file = get_file bs fn (Sexp_file kind) in
|
let file = get_file bs fn (Sexp_file kind) in
|
||||||
assert (file.data = None);
|
assert (file.data = None);
|
||||||
file.data <- Some x;
|
file.data <- Some x;
|
||||||
Future.return
|
|
||||||
{ Action.
|
{ Action.
|
||||||
context = None
|
context = None
|
||||||
; dir = Path.root
|
; dir = Path.root
|
||||||
; action = Write_file (fn, vfile_to_string kind fn x)
|
; action = Write_file (fn, vfile_to_string kind fn x)
|
||||||
}
|
}
|
||||||
| Compose (a, b) ->
|
| Compose (a, b) ->
|
||||||
exec a x >>= exec b
|
exec a x |> exec b
|
||||||
| First t ->
|
| First t ->
|
||||||
let x, y = x in
|
let x, y = x in
|
||||||
exec t x >>= fun x ->
|
(exec t x, y)
|
||||||
return (x, y)
|
|
||||||
| Second t ->
|
| Second t ->
|
||||||
let x, y = x in
|
let x, y = x in
|
||||||
exec t y >>= fun y ->
|
(x, exec t y)
|
||||||
return (x, y)
|
|
||||||
| Split (a, b) ->
|
| Split (a, b) ->
|
||||||
let x, y = x in
|
let x, y = x in
|
||||||
both (exec a x) (exec b y)
|
let x = exec a x in
|
||||||
|
let y = exec b y in
|
||||||
|
(x, y)
|
||||||
| Fanout (a, b) ->
|
| Fanout (a, b) ->
|
||||||
both (exec a x) (exec b x)
|
let a = exec a x in
|
||||||
| Paths _ -> return x
|
let b = exec b x in
|
||||||
| Paths_glob _ -> return x
|
(a, b)
|
||||||
| Contents p -> return (read_file (Path.to_string p))
|
| Paths _ -> x
|
||||||
| Lines_of p -> return (lines_of_file (Path.to_string p))
|
| Paths_glob _ -> x
|
||||||
|
| Contents p -> read_file (Path.to_string p)
|
||||||
|
| Lines_of p -> lines_of_file (Path.to_string p)
|
||||||
| Vpath (Vspec.T (fn, kind)) ->
|
| Vpath (Vspec.T (fn, kind)) ->
|
||||||
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
let file : b File_spec.t = get_file bs fn (Sexp_file kind) in
|
||||||
return (Option.value_exn file.data)
|
Option.value_exn file.data
|
||||||
| Dyn_paths t ->
|
| Dyn_paths t ->
|
||||||
exec t x >>= fun fns ->
|
let fns = exec t x in
|
||||||
all_deps := Pset.union !all_deps (Pset.of_list fns);
|
dyn_deps := Pset.union !dyn_deps (Pset.of_list fns);
|
||||||
all_unit (List.rev_map fns ~f:(wait_for_file bs ~targeting)) >>= fun () ->
|
x
|
||||||
return x
|
| Record_lib_deps _ -> x
|
||||||
| Record_lib_deps _ -> return x
|
|
||||||
| Fail { fail } -> fail ()
|
| Fail { fail } -> fail ()
|
||||||
in
|
in
|
||||||
exec (Build.repr t) x >>| fun action ->
|
let action = exec (Build.repr t) x in
|
||||||
(action, !all_deps)
|
(action, !dyn_deps)
|
||||||
end
|
end
|
||||||
|
|
||||||
let add_spec t fn spec ~allow_override =
|
let add_spec t fn spec ~allow_override =
|
||||||
|
@ -256,6 +255,10 @@ let refresh_targets_timestamps_after_rule_execution t targets =
|
||||||
|> List.map ~f:(fun fn -> sprintf "- %s" (Path.to_string fn))
|
|> List.map ~f:(fun fn -> sprintf "- %s" (Path.to_string fn))
|
||||||
|> String.concat ~sep:"\n")
|
|> String.concat ~sep:"\n")
|
||||||
|
|
||||||
|
let wait_for_deps t deps ~targeting =
|
||||||
|
all_unit
|
||||||
|
(Pset.fold deps ~init:[] ~f:(fun fn acc -> wait_for_file t fn ~targeting :: acc))
|
||||||
|
|
||||||
let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
let { Pre_rule. build; targets = target_specs } = pre_rule in
|
let { Pre_rule. build; targets = target_specs } = pre_rule in
|
||||||
let deps = Build_interpret.deps build ~all_targets_by_dir in
|
let deps = Build_interpret.deps build ~all_targets_by_dir in
|
||||||
|
@ -289,11 +292,12 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
match Path.kind fn with
|
match Path.kind fn with
|
||||||
| Local local -> Path.Local.ensure_parent_directory_exists local
|
| Local local -> Path.Local.ensure_parent_directory_exists local
|
||||||
| External _ -> ());
|
| External _ -> ());
|
||||||
all_unit
|
wait_for_deps t deps ~targeting
|
||||||
(Pset.fold deps ~init:[] ~f:(fun fn acc -> wait_for_file t fn ~targeting :: acc))
|
|
||||||
>>= fun () ->
|
>>= fun () ->
|
||||||
Build_exec.exec t build () ~targeting ~static_deps:deps
|
let action, dyn_deps = Build_exec.exec t build () in
|
||||||
>>= fun (action, all_deps) ->
|
wait_for_deps t ~targeting (Pset.diff dyn_deps deps)
|
||||||
|
>>= fun () ->
|
||||||
|
let all_deps = Pset.union deps dyn_deps in
|
||||||
if !Clflags.debug_actions then
|
if !Clflags.debug_actions then
|
||||||
Format.eprintf "@{<debug>Action@}: %s@."
|
Format.eprintf "@{<debug>Action@}: %s@."
|
||||||
(Sexp.to_string (Action.sexp_of_t action));
|
(Sexp.to_string (Action.sexp_of_t action));
|
||||||
|
|
Loading…
Reference in New Issue