let call builder r =
let dyndeps = ref Resources.empty in
let builder rs =
let results = builder rs in
List.map begin fun res ->
match res with
| Good res' ->
let () = dprintf 10 "new dyndep for %S(%a): %S" r.name print_resource_list r.prods res' in
dyndeps := Resources.add res' !dyndeps;
List.iter (fun x -> Resource.Cache.add_dependency x res') r.prods;
res
| Bad _ -> res
end results in
let () = dprintf 5 "start rule %a" print r in
let action = r.code (fun x -> x) builder in
build_deps_of_tags_on_cmd builder action.command;
let dyndeps = !dyndeps in
let () = dprintf 10 "dyndeps: %a" Resources.print dyndeps in
let (reason, cached) =
match exists2 List.find (fun r -> not (Resource.exists_in_build_dir r)) r.prods with
| Some r -> (`cache_miss_missing_prod r, false)
| _ ->
begin match exists2 List.find Resource.Cache.resource_has_changed r.deps with
| Some r -> (`cache_miss_changed_dep r, false)
| _ ->
begin match exists2 Resources.find Resource.Cache.resource_has_changed dyndeps with
| Some r -> (`cache_miss_changed_dyn_dep r, false)
| _ ->
begin match cached_digest r with
| None -> (`cache_miss_no_digest, false)
| Some d ->
let rule_digest = digest_rule r dyndeps action in
if d = rule_digest then (`cache_hit, true)
else (`cache_miss_digest_changed(d, rule_digest), false)
end
end
end
in
let explain_reason l =
raw_dprintf (l+1) "mid rule %a: " print r;
match reason with
| `cache_miss_missing_prod r ->
dprintf l "cache miss: a product is not in build dir (%a)" Resource.print r
| `cache_miss_changed_dep r ->
dprintf l "cache miss: a dependency has changed (%a)" Resource.print r
| `cache_miss_changed_dyn_dep r ->
dprintf l "cache miss: a dynamic dependency has changed (%a)" Resource.print r
| `cache_miss_no_digest ->
dprintf l "cache miss: no digest found for %S (the command, a dependency, or a product)"
r.name
| `cache_hit -> dprintf (l+1) "cache hit"
| `cache_miss_digest_changed(old_d, new_d) ->
dprintf l "cache miss: the digest has changed for %S (the command, a dependency, or a product: %a <> %a)"
r.name print_digest old_d print_digest new_d
in
let prod_digests = digest_prods r in
(if not cached then List.iter Resource.clean r.prods);
(if !Options.nothing_should_be_rebuilt && not cached then
(explain_reason (-1);
let msg = sbprintf "Need to rebuild %a through the rule `%a'" print_resource_list r.prods print r in
raise (Exit_rule_error msg)));
explain_reason 3;
let thunk () =
try
if cached then Command.execute ~pretend:true action.command
else
begin match r.stamp with
| Some stamp ->
reset_filesys_cache ();
let digest_deps = digest_deps r dyndeps in
with_output_file stamp (fun oc -> output_string oc digest_deps)
| None -> ()
end;
List.iter (fun r -> Resource.Cache.resource_built r) r.prods;
(if not cached then
let new_rule_digest = digest_rule r dyndeps action in
let new_prod_digests = digest_prods r in
let () = store_digest r new_rule_digest in
List.iter begin fun p ->
let f = Pathname.to_string (Resource.in_build_dir p) in
(try let digest = List.assoc f prod_digests in
let new_digest = List.assoc f new_prod_digests in
if digest <> new_digest then raise Not_found
with Not_found -> Resource.Cache.resource_changed p)
end r.prods);
dprintf 5 "end rule %a" print r
with exn -> (List.iter Resource.clean r.prods; raise exn)
in
if cached
then thunk ()
else List.iter (fun x -> Resource.Cache.suspend_resource x action.command thunk r.prods) r.prods