Fix a bug in incremental compilation
If a rule had no dependencies and targets where missing, it wasn't re-run. Refactor the code and fix this bug.
This commit is contained in:
parent
ec6b89ea11
commit
6cf93d69b5
|
@ -63,24 +63,48 @@ type t =
|
||||||
; timestamps : (Path.t, float) Hashtbl.t
|
; timestamps : (Path.t, float) Hashtbl.t
|
||||||
}
|
}
|
||||||
|
|
||||||
let timestamp t fn ~default =
|
let timestamp t fn =
|
||||||
match Hashtbl.find t.timestamps fn with
|
match Hashtbl.find t.timestamps fn with
|
||||||
| Some ts -> ts
|
| Some _ as x -> x
|
||||||
| None ->
|
| None ->
|
||||||
match Unix.lstat (Path.to_string fn) with
|
match Unix.lstat (Path.to_string fn) with
|
||||||
| exception _ -> default
|
| exception _ -> None
|
||||||
| stat ->
|
| stat ->
|
||||||
let ts = stat.st_mtime in
|
let ts = stat.st_mtime in
|
||||||
Hashtbl.add t.timestamps ~key:fn ~data:ts;
|
Hashtbl.add t.timestamps ~key:fn ~data:ts;
|
||||||
ts
|
Some ts
|
||||||
|
|
||||||
let min_timestamp t fns =
|
type limit_timestamp =
|
||||||
List.fold_left fns ~init:max_float
|
{ missing_files : bool
|
||||||
~f:(fun acc fn -> min acc (timestamp t fn ~default:0.))
|
; limit : float option
|
||||||
|
}
|
||||||
|
|
||||||
let max_timestamp t fns =
|
let sexp_of_limit_timestamp lt =
|
||||||
List.fold_left fns ~init:0.
|
Sexp.To_sexp.(record
|
||||||
~f:(fun acc fn -> max acc (timestamp t fn ~default:max_float))
|
[ "missing_files" , bool lt.missing_files
|
||||||
|
; "limit" , option float lt.limit
|
||||||
|
])
|
||||||
|
|
||||||
|
let merge_timestamp t fns ~merge =
|
||||||
|
let init =
|
||||||
|
{ missing_files = false
|
||||||
|
; limit = None
|
||||||
|
}
|
||||||
|
in
|
||||||
|
List.fold_left fns ~init
|
||||||
|
~f:(fun acc fn ->
|
||||||
|
match timestamp t fn with
|
||||||
|
| None -> { acc with missing_files = true }
|
||||||
|
| Some ts ->
|
||||||
|
{ acc with
|
||||||
|
limit =
|
||||||
|
match acc.limit with
|
||||||
|
| None -> Some ts
|
||||||
|
| Some ts' -> Some (merge ts ts')
|
||||||
|
})
|
||||||
|
|
||||||
|
let min_timestamp t fns = merge_timestamp t fns ~merge:min
|
||||||
|
let max_timestamp t fns = merge_timestamp t fns ~merge:max
|
||||||
|
|
||||||
let find_file_exn t file =
|
let find_file_exn t file =
|
||||||
Hashtbl.find_exn t.files file ~string_of_key:(fun fn -> sprintf "%S" (Path.to_string fn))
|
Hashtbl.find_exn t.files file ~string_of_key:(fun fn -> sprintf "%S" (Path.to_string fn))
|
||||||
|
@ -334,8 +358,31 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
Hashtbl.replace t.trace ~key:fn ~data:hash;
|
Hashtbl.replace t.trace ~key:fn ~data:hash;
|
||||||
acc || prev_hash <> hash)
|
acc || prev_hash <> hash)
|
||||||
in
|
in
|
||||||
|
let targets_min_ts = min_timestamp t targets_as_list in
|
||||||
|
let deps_max_ts = max_timestamp t all_deps_as_list in
|
||||||
if rule_changed ||
|
if rule_changed ||
|
||||||
min_timestamp t targets_as_list < max_timestamp t all_deps_as_list then (
|
match deps_max_ts, targets_min_ts with
|
||||||
|
| _, { missing_files = true; _ } ->
|
||||||
|
(* Missing targets -> rebuild *)
|
||||||
|
true
|
||||||
|
| _, { missing_files = false; limit = None } ->
|
||||||
|
(* CR-someday jdimino: no target, this should be a user error *)
|
||||||
|
true
|
||||||
|
| { missing_files = true; _ }, _ ->
|
||||||
|
Sexp.code_error
|
||||||
|
"Dependencies missing after waiting for them"
|
||||||
|
[ "all_deps", Sexp.To_sexp.list Path.sexp_of_t all_deps_as_list ]
|
||||||
|
| { limit = None; missing_files = false },
|
||||||
|
{ missing_files = false; _ } ->
|
||||||
|
(* No dependencies, no need to do anything if the rule hasn't changed and targets
|
||||||
|
are here. *)
|
||||||
|
false
|
||||||
|
| { limit = Some deps_max; missing_files = false },
|
||||||
|
{ limit = Some targets_min; missing_files = false } ->
|
||||||
|
targets_min < deps_max
|
||||||
|
then (
|
||||||
|
if !Clflags.debug_actions then
|
||||||
|
Format.eprintf "@{<debug>Action@}: -> running action@.";
|
||||||
(* Do not remove files that are just updated, otherwise this would break incremental
|
(* Do not remove files that are just updated, otherwise this would break incremental
|
||||||
compilation *)
|
compilation *)
|
||||||
let targets_to_remove =
|
let targets_to_remove =
|
||||||
|
@ -347,8 +394,19 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
(* All went well, these targets are no longer pending *)
|
(* All went well, these targets are no longer pending *)
|
||||||
pending_targets := Pset.diff !pending_targets targets_to_remove;
|
pending_targets := Pset.diff !pending_targets targets_to_remove;
|
||||||
refresh_targets_timestamps_after_rule_execution t targets_as_list
|
refresh_targets_timestamps_after_rule_execution t targets_as_list
|
||||||
) else
|
) else (
|
||||||
|
if !Clflags.debug_actions then
|
||||||
|
Format.eprintf
|
||||||
|
"@{<debug>Action@}: -> not running action as targets are up-to-date@\n\
|
||||||
|
@{<debug>Action@}: -> @[%a@]@."
|
||||||
|
Sexp.pp
|
||||||
|
(Sexp.To_sexp.(record
|
||||||
|
[ "rule_changed" , bool rule_changed
|
||||||
|
; "targets_min_ts" , sexp_of_limit_timestamp targets_min_ts
|
||||||
|
; "deps_max_ts" , sexp_of_limit_timestamp deps_max_ts
|
||||||
|
]));
|
||||||
return ()
|
return ()
|
||||||
|
)
|
||||||
) in
|
) in
|
||||||
let rule =
|
let rule =
|
||||||
{ Rule.
|
{ Rule.
|
||||||
|
|
|
@ -77,6 +77,7 @@ module type Combinators = sig
|
||||||
val unit : unit t
|
val unit : unit t
|
||||||
val string : string t
|
val string : string t
|
||||||
val int : int t
|
val int : int t
|
||||||
|
val float : float t
|
||||||
val bool : bool t
|
val bool : bool t
|
||||||
val pair : 'a t -> 'b t -> ('a * 'b) t
|
val pair : 'a t -> 'b t -> ('a * 'b) t
|
||||||
val list : 'a t -> 'a list t
|
val list : 'a t -> 'a list t
|
||||||
|
@ -92,6 +93,7 @@ module To_sexp = struct
|
||||||
let unit () = List []
|
let unit () = List []
|
||||||
let string s = Atom s
|
let string s = Atom s
|
||||||
let int n = Atom (string_of_int n)
|
let int n = Atom (string_of_int n)
|
||||||
|
let float f = Atom (string_of_float f)
|
||||||
let bool b = Atom (string_of_bool b)
|
let bool b = Atom (string_of_bool b)
|
||||||
let pair fa fb (a, b) = List [fa a; fb b]
|
let pair fa fb (a, b) = List [fa a; fb b]
|
||||||
let list f l = List (List.map l ~f)
|
let list f l = List (List.map l ~f)
|
||||||
|
@ -134,6 +136,13 @@ module Of_sexp = struct
|
||||||
with _ ->
|
with _ ->
|
||||||
of_sexp_error sexp "Integer expected"
|
of_sexp_error sexp "Integer expected"
|
||||||
|
|
||||||
|
let float sexp =
|
||||||
|
let s = string sexp in
|
||||||
|
try
|
||||||
|
float_of_string s
|
||||||
|
with _ ->
|
||||||
|
of_sexp_error sexp "Float expected"
|
||||||
|
|
||||||
let bool sexp =
|
let bool sexp =
|
||||||
match string sexp with
|
match string sexp with
|
||||||
| "true" -> true
|
| "true" -> true
|
||||||
|
|
|
@ -29,6 +29,7 @@ module type Combinators = sig
|
||||||
val unit : unit t
|
val unit : unit t
|
||||||
val string : string t
|
val string : string t
|
||||||
val int : int t
|
val int : int t
|
||||||
|
val float : float t
|
||||||
val bool : bool t
|
val bool : bool t
|
||||||
val pair : 'a t -> 'b t -> ('a * 'b) t
|
val pair : 'a t -> 'b t -> ('a * 'b) t
|
||||||
val list : 'a t -> 'a list t
|
val list : 'a t -> 'a list t
|
||||||
|
|
Loading…
Reference in New Issue