Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor Build's related stuff #2066

Merged
1 commit merged into from Apr 18, 2019
Merged

Refactor Build's related stuff #2066

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
299 changes: 240 additions & 59 deletions src/build.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,65 +1,49 @@
open! Stdune
open Import

module Repr = struct
type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('a, 'b) t
| Targets : Path.Set.t -> ('a, 'a) t
| Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
| Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
| Paths_for_rule : Path.Set.t -> ('a, 'a) t
| Paths_glob : File_selector.t -> ('a, Path.Set.t) 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
| Lines_of : Path.t -> ('a, string list) t
| Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t
| Dyn_deps : ('a, Dep.Set.t) t -> ('a, 'a) t
| Record_lib_deps : Lib_deps_info.t -> ('a, 'a) t
| Fail : fail -> (_, _) t
| Memo : 'a memo -> (unit, 'a) t
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
| Deps : Dep.Set.t -> ('a, 'a) t

and 'a memo =
{ name : string
; t : (unit, 'a) t
; mutable state : 'a memo_state
}

and 'a memo_state =
| Unevaluated
| Evaluating
| Evaluated of 'a * Dep.Set.t

and ('a, 'b) if_file_exists_state =
| Undecided of ('a, 'b) t * ('a, 'b) t
| Decided of bool * ('a, 'b) t

and glob_state =
| G_unevaluated of Loc.t * Path.t * Path.t Predicate.t
| G_evaluated of Path.Set.t

let get_if_file_exists_exn state =
match !state with
| Decided (_, t) -> t
| Undecided _ ->
Exn.code_error "Build.get_if_file_exists_exn: got undecided" []

let get_glob_result_exn state =
match !state with
| G_evaluated l -> l
| G_unevaluated (loc, path, _) ->
Exn.code_error "Build.get_glob_result_exn: got unevaluated"
[ "loc", Loc.to_sexp loc
; "path", Path.to_sexp path ]
end
include Repr
let repr t = t
type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('a, 'b) t
| Targets : Path.Set.t -> ('a, 'a) t
| Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
| Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
| Paths_for_rule : Path.Set.t -> ('a, 'a) t
| Paths_glob : File_selector.t -> ('a, Path.Set.t) 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
| Lines_of : Path.t -> ('a, string list) t
| Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t
| Dyn_deps : ('a, Dep.Set.t) t -> ('a, 'a) t
| Record_lib_deps : Lib_deps_info.t -> ('a, 'a) t
| Fail : fail -> (_, _) t
| Memo : 'a memo -> (unit, 'a) t
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
| Deps : Dep.Set.t -> ('a, 'a) t

and 'a memo =
{ name : string
; t : (unit, 'a) t
; mutable state : 'a memo_state
}

and 'a memo_state =
| Unevaluated
| Evaluating
| Evaluated of 'a * Dep.Set.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 _ ->
Exn.code_error "Build.get_if_file_exists_exn: got undecided" []

let arr f = Arr f
let return x = Arr (fun _ -> x)
Expand Down Expand Up @@ -268,3 +252,200 @@ let merge_files_dyn ~target =
>>^ (fun (sources, extras) ->
Action.Merge_files_into (sources, extras, target))
>>> action_dyn ~targets:[target] ()

(* Analysis *)

let no_targets_allowed () =
Exn.code_error "No targets allowed under a [Build.lazy_no_targets] \
or [Build.if_file_exists]" []
[@@inline never]

let static_deps t ~all_targets =
let rec loop : type a b. (a, b) t -> Static_deps.t -> bool -> Static_deps.t
= fun t acc targets_allowed ->
match t with
| Arr _ -> acc
| Targets _ -> if not targets_allowed then no_targets_allowed (); acc
| Compose (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| First t -> loop t acc targets_allowed
| Second t -> loop t acc targets_allowed
| Split (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Fanout (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
| Deps deps ->
Static_deps.add_action_deps acc deps
| Paths_for_rule fns ->
Static_deps.add_rule_paths acc fns
| Paths_glob g ->
Static_deps.add_action_dep acc (Dep.glob g)
| If_file_exists (p, state) -> begin
match !state with
| Decided (_, t) -> loop t acc false
| Undecided (then_, else_) ->
let dir = Path.parent_exn p in
let targets = all_targets ~dir in
if Path.Set.mem targets p then begin
state := Decided (true, then_);
loop then_ acc false
end else begin
state := Decided (false, else_);
loop else_ acc false
end
end
| Dyn_paths t -> loop t acc targets_allowed
| Dyn_deps t -> loop t acc targets_allowed
| Contents p -> Static_deps.add_rule_path acc p
| Lines_of p -> Static_deps.add_rule_path acc p
| Record_lib_deps _ -> acc
| Fail _ -> acc
| Memo m -> loop m.t acc targets_allowed
| Catch (t, _) -> loop t acc targets_allowed
| Lazy_no_targets t -> loop (Lazy.force t) acc false
in
loop t Static_deps.empty true

let lib_deps =
let rec loop : type a b. (a, b) t -> Lib_deps_info.t -> Lib_deps_info.t
= fun t acc ->
match t with
| Arr _ -> acc
| Targets _ -> acc
| Compose (a, b) -> loop a (loop b acc)
| First t -> loop t acc
| Second t -> loop t acc
| Split (a, b) -> loop a (loop b acc)
| Fanout (a, b) -> loop a (loop b acc)
| Paths_for_rule _ -> acc
| Paths_glob _ -> acc
| Deps _ -> acc
| Dyn_paths t -> loop t acc
| Dyn_deps t -> loop t acc
| Contents _ -> acc
| Lines_of _ -> acc
| Record_lib_deps deps -> Lib_deps_info.merge deps acc
| Fail _ -> acc
| If_file_exists (_, state) ->
loop (get_if_file_exists_exn state) acc
| Memo m -> loop m.t acc
| Catch (t, _) -> loop t acc
| Lazy_no_targets t -> loop (Lazy.force t) acc
in
fun t -> loop t Lib_name.Map.empty

let targets =
let rec loop : type a b. (a, b) t -> Path.Set.t -> Path.Set.t = fun t acc ->
match t with
| Arr _ -> acc
| Targets targets -> Path.Set.union targets acc
| Compose (a, b) -> loop a (loop b acc)
| First t -> loop t acc
| Second t -> loop t acc
| Split (a, b) -> loop a (loop b acc)
| Fanout (a, b) -> loop a (loop b acc)
| Paths_for_rule _ -> acc
| Paths_glob _ -> acc
| Deps _ -> acc
| Dyn_paths t -> loop t acc
| Dyn_deps t -> loop t acc
| Contents _ -> acc
| Lines_of _ -> acc
| Record_lib_deps _ -> acc
| Fail _ -> acc
| If_file_exists (_, state) -> begin
match !state with
| Decided (v, _) ->
Exn.code_error "Build_interpret.targets got decided if_file_exists"
["exists", Sexp.Encoder.bool v]
| Undecided (a, b) ->
let a = loop a Path.Set.empty in
let b = loop b Path.Set.empty in
if Path.Set.is_empty a && Path.Set.is_empty b then
acc
else begin
Exn.code_error "Build_interpret.targets: cannot have targets \
under a [if_file_exists]"
[ "targets-a", Path.Set.to_sexp a
; "targets-b", Path.Set.to_sexp b
]
end
end
| Memo m -> loop m.t acc
| Catch (t, _) -> loop t acc
| Lazy_no_targets _ -> acc
in
fun t -> loop t Path.Set.empty

(* Execution *)

let exec ~(eval_pred : Dep.eval_pred) (t : ('a, 'b) t) (x : 'a)
: 'b * Dep.Set.t =
let rec exec
: type a b. Dep.Set.t ref -> (a, b) t -> a -> b = fun dyn_deps t x ->
match t with
| Arr f -> f x
| Targets _ -> x
| Compose (a, b) ->
exec dyn_deps a x |> exec dyn_deps b
| First t ->
let x, y = x in
(exec dyn_deps t x, y)
| Second t ->
let x, y = x in
(x, exec dyn_deps t y)
| Split (a, b) ->
let x, y = x in
let x = exec dyn_deps a x in
let y = exec dyn_deps b y in
(x, y)
| Fanout (a, b) ->
let a = exec dyn_deps a x in
let b = exec dyn_deps b x in
(a, b)
| Deps _ -> x
| Paths_for_rule _ -> x
| Paths_glob g -> eval_pred g
| Contents p -> Io.read_file p
| Lines_of p -> Io.lines_of_file p
| Dyn_paths t ->
let fns = exec dyn_deps t x in
dyn_deps := Dep.Set.add_paths !dyn_deps fns;
x
| Dyn_deps t ->
let fns = exec dyn_deps t x in
dyn_deps := Dep.Set.union !dyn_deps fns;
x
| Record_lib_deps _ -> x
| Fail { fail } -> fail ()
| If_file_exists (_, state) ->
exec dyn_deps (get_if_file_exists_exn state) x
| Catch (t, on_error) -> begin
try
exec dyn_deps t x
with exn ->
on_error exn
end
| Lazy_no_targets t ->
exec dyn_deps (Lazy.force t) x
| Memo m ->
begin match m.state with
| Evaluated (x, deps) ->
dyn_deps := Dep.Set.union !dyn_deps deps;
x
| Evaluating ->
die "Dependency cycle evaluating memoized build arrow %s" m.name
| Unevaluated ->
m.state <- Evaluating;
let dyn_deps' = ref Dep.Set.empty in
match exec dyn_deps' m.t x with
| x ->
m.state <- Evaluated (x, !dyn_deps');
dyn_deps := Dep.Set.union !dyn_deps !dyn_deps';
x
| exception exn ->
m.state <- Unevaluated;
reraise exn
end
in
let dyn_deps = ref Dep.Set.empty in
let result = exec dyn_deps t x in
(result, !dyn_deps)

66 changes: 19 additions & 47 deletions src/build.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -175,56 +175,28 @@ val progn : ('a, Action.t) t list -> ('a, Action.t) t

val record_lib_deps : Lib_deps_info.t -> ('a, 'a) t

(**/**)
(** {1 Analysis} *)

(** Must be called first before [lib_deps] and [targets] as it updates
some of the internal references in the build arrow. *)
val static_deps
: (_, _) t
-> all_targets:(dir:Path.t -> Path.Set.t)
-> Static_deps.t

module Repr : sig
type ('a, 'b) t =
| Arr : ('a -> 'b) -> ('a, 'b) t
| Targets : Path.Set.t -> ('a, 'a) t
| Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
| First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
| Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
| Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
| Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
| Paths_for_rule : Path.Set.t -> ('a, 'a) t
| Paths_glob : File_selector.t -> ('a, Path.Set.t) t
| If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
| Contents : Path.t -> ('a, string) t
| Lines_of : Path.t -> ('a, string list) t
| Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t
| Dyn_deps : ('a, Dep.Set.t) t -> ('a, 'a) t
| Record_lib_deps : Lib_deps_info.t -> ('a, 'a) t
| Fail : fail -> (_, _) t
| Memo : 'a memo -> (unit, 'a) t
| Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
| Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
| Deps : Dep.Set.t -> ('a, 'a) t

and 'a memo =
{ name : string
; t : (unit, 'a) t
; mutable state : 'a memo_state
}

and 'a memo_state =
| Unevaluated
| Evaluating
| Evaluated of 'a * Dep.Set.t (* dynamic dependencies *)

and ('a, 'b) if_file_exists_state =
| Undecided of ('a, 'b) t * ('a, 'b) t
| Decided of bool * ('a, 'b) t

and glob_state =
| G_unevaluated of Loc.t * Path.t * Path.t Predicate.t
| G_evaluated of Path.Set.t

val get_if_file_exists_exn : ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
val get_glob_result_exn : glob_state ref -> Path.Set.t
end
val lib_deps
: (_, _) t
-> Lib_deps_info.t

val targets
: (_, _) t
-> Path.Set.t

(** {1 Execution} *)

val repr : ('a, 'b) t -> ('a, 'b) Repr.t
(** Executes a build arrow. Returns the result and the set of dynamic
dependencies discovered during execution. *)
val exec : eval_pred:Dep.eval_pred -> ('a, 'b) t -> 'a -> 'b * Dep.Set.t

(**/**)
val paths_for_rule : Path.Set.t -> ('a, 'a) t
Expand Down
Loading