Move the context out of Action.t
And add it to the rule. It is never dynamic, so it is simpler this way, we just set it in Super_context.add_rule.
This commit is contained in:
parent
7f0a2d7e12
commit
73a4cef9f8
|
@ -585,7 +585,7 @@ let rules =
|
|||
(fun ppf ->
|
||||
Path.Set.iter rule.deps ~f:(fun dep ->
|
||||
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
||||
Sexp.pp_split_strings (Action.Mini_shexp.sexp_of_t rule.action.action))
|
||||
Sexp.pp_split_strings (Action.sexp_of_t rule.action))
|
||||
end else begin
|
||||
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
||||
let sexp =
|
||||
|
@ -594,10 +594,10 @@ let rules =
|
|||
List.concat
|
||||
[ [ "deps" , paths rule.deps
|
||||
; "targets", paths rule.targets ]
|
||||
; (match rule.action.context with
|
||||
; (match rule.context with
|
||||
| None -> []
|
||||
| Some c -> ["context", Atom c.name])
|
||||
; [ "action" , Action.Mini_shexp.sexp_of_t rule.action.action ]
|
||||
; [ "action" , Action.sexp_of_t rule.action ]
|
||||
])
|
||||
in
|
||||
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;; This file is used by `make all-supported-ocaml-versions`
|
||||
(context ((switch 4.02.3)))
|
||||
(context ((switch 4.03.0)))
|
||||
(context ((switch 4.04.0)))
|
||||
(context ((switch 4.04.1)))
|
||||
(context ((switch 4.05.0+trunk)))
|
||||
(context ((switch 4.06.0+trunk)))
|
||||
|
|
|
@ -53,8 +53,7 @@ let expand_prog ctx ~dir ~f template =
|
|||
|> String.concat ~sep:" "
|
||||
|> resolve
|
||||
|
||||
module Mini_shexp = struct
|
||||
module Ast = struct
|
||||
module Ast = struct
|
||||
type outputs =
|
||||
| Stdout
|
||||
| Stderr
|
||||
|
@ -208,14 +207,14 @@ module Mini_shexp = struct
|
|||
| Update_file (x, y) -> Update_file (f2 x, f1 y)
|
||||
| Rename (x, y) -> Rename (f2 x, f2 y)
|
||||
| Remove_tree x -> Remove_tree (f2 x)
|
||||
end
|
||||
open Ast
|
||||
end
|
||||
open Ast
|
||||
|
||||
type t = (string, Path.t) Ast.t
|
||||
let t = Ast.t string Path.t
|
||||
let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_t
|
||||
type t = (string, Path.t) Ast.t
|
||||
let t = Ast.t string Path.t
|
||||
let sexp_of_t = Ast.sexp_of_t Sexp.To_sexp.string Path.sexp_of_t
|
||||
|
||||
let updated_files =
|
||||
let updated_files =
|
||||
let rec loop acc t =
|
||||
let acc =
|
||||
match t with
|
||||
|
@ -226,7 +225,7 @@ module Mini_shexp = struct
|
|||
in
|
||||
fun t -> loop Path.Set.empty t
|
||||
|
||||
let chdirs =
|
||||
let chdirs =
|
||||
let rec loop acc t =
|
||||
let acc =
|
||||
match t with
|
||||
|
@ -237,7 +236,7 @@ module Mini_shexp = struct
|
|||
in
|
||||
fun t -> loop Path.Set.empty t
|
||||
|
||||
module Unexpanded = struct
|
||||
module Unexpanded = struct
|
||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
||||
let sexp_of_t = Ast.sexp_of_t String_with_vars.sexp_of_t String_with_vars.sexp_of_t
|
||||
|
||||
|
@ -284,22 +283,22 @@ module Mini_shexp = struct
|
|||
Rename (expand_path ~dir ~f x, expand_path ~dir ~f y)
|
||||
| Remove_tree x ->
|
||||
Remove_tree (expand_path ~dir ~f x)
|
||||
end
|
||||
end
|
||||
|
||||
open Future
|
||||
open Future
|
||||
|
||||
let get_std_output : _ -> Future.std_output_to = function
|
||||
let get_std_output : _ -> Future.std_output_to = function
|
||||
| None -> Terminal
|
||||
| Some (fn, oc) -> Opened_file { filename = fn; tail = false; desc = Channel oc }
|
||||
|
||||
let run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args =
|
||||
let run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args =
|
||||
let stdout_to = get_std_output stdout_to in
|
||||
let stderr_to = get_std_output stderr_to in
|
||||
let env = Context.extend_env ~vars:env_extra ~env in
|
||||
Future.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to ~stderr_to ~purpose
|
||||
(Path.reach_for_running ~from:dir prog) args
|
||||
|
||||
let rec exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
let rec exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
run ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to prog args
|
||||
|
@ -387,7 +386,7 @@ module Mini_shexp = struct
|
|||
Path.rm_rf path;
|
||||
return ()
|
||||
|
||||
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
let fn = Path.to_string fn in
|
||||
let oc = Io.open_out fn in
|
||||
let out = Some (fn, oc) in
|
||||
|
@ -400,7 +399,7 @@ module Mini_shexp = struct
|
|||
exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to >>| fun () ->
|
||||
close_out oc
|
||||
|
||||
and exec_list l ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
and exec_list l ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to =
|
||||
match l with
|
||||
| [] ->
|
||||
Future.return ()
|
||||
|
@ -409,56 +408,29 @@ module Mini_shexp = struct
|
|||
| t :: rest ->
|
||||
exec t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to >>= fun () ->
|
||||
exec_list rest ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to
|
||||
end
|
||||
|
||||
type t =
|
||||
{ context : Context.t option
|
||||
; action : Mini_shexp.t
|
||||
}
|
||||
|
||||
let sexp_of_t { context; action } =
|
||||
let fields : Sexp.t list =
|
||||
[ List [ Atom "action" ; Mini_shexp.sexp_of_t action ]
|
||||
]
|
||||
in
|
||||
let fields =
|
||||
match context with
|
||||
| None -> fields
|
||||
| Some { name; _ } -> List [ Atom "context"; Atom name ] :: fields
|
||||
in
|
||||
Sexp.List fields
|
||||
|
||||
let exec ~targets { action; context } =
|
||||
let exec ~targets ?context t =
|
||||
let env =
|
||||
match context with
|
||||
match (context : Context.t option) with
|
||||
| None -> Lazy.force Context.initial_env
|
||||
| Some c -> c.env
|
||||
in
|
||||
let targets = Path.Set.elements targets in
|
||||
let purpose = Future.Build_job targets in
|
||||
Mini_shexp.exec action ~purpose ~dir:Path.root ~env ~env_extra:Env_var_map.empty
|
||||
exec t ~purpose ~dir:Path.root ~env ~env_extra:Env_var_map.empty
|
||||
~stdout_to:None ~stderr_to:None
|
||||
|
||||
let sandbox t ~sandboxed ~deps ~targets =
|
||||
let action =
|
||||
let module M = Mini_shexp.Ast in
|
||||
M.Progn
|
||||
[ M.Progn (List.filter_map deps ~f:(fun path ->
|
||||
Ast.Progn
|
||||
[ Ast.Progn (List.filter_map deps ~f:(fun path ->
|
||||
if Path.is_local path then
|
||||
Some (M.Symlink (path, sandboxed path))
|
||||
Some (Ast.Symlink (path, sandboxed path))
|
||||
else
|
||||
None))
|
||||
; M.map t.action ~f1:(fun x -> x) ~f2:sandboxed
|
||||
; M.Progn (List.filter_map targets ~f:(fun path ->
|
||||
; Ast.map t ~f1:(fun x -> x) ~f2:sandboxed
|
||||
; Ast.Progn (List.filter_map targets ~f:(fun path ->
|
||||
if Path.is_local path then
|
||||
Some (M.Rename (sandboxed path, path))
|
||||
Some (Ast.Rename (sandboxed path, path))
|
||||
else
|
||||
None))
|
||||
]
|
||||
in
|
||||
{ t with action }
|
||||
|
||||
type for_hash = string option * Mini_shexp.t
|
||||
|
||||
let for_hash { context; action } =
|
||||
(Option.map context ~f:(fun c -> c.name), action)
|
||||
|
|
|
@ -6,8 +6,7 @@ type var_expansion =
|
|||
| Paths of Path.t list
|
||||
| Str of string
|
||||
|
||||
module Mini_shexp : sig
|
||||
module Ast : sig
|
||||
module Ast : sig
|
||||
type outputs =
|
||||
| Stdout
|
||||
| Stderr
|
||||
|
@ -31,37 +30,31 @@ module Mini_shexp : sig
|
|||
| Update_file of 'path * 'a
|
||||
| Rename of 'path * 'path
|
||||
| Remove_tree of 'path
|
||||
|
||||
val t : 'a Sexp.Of_sexp.t -> 'b Sexp.Of_sexp.t -> ('a, 'b) t Sexp.Of_sexp.t
|
||||
val sexp_of_t : 'a Sexp.To_sexp.t -> 'b Sexp.To_sexp.t -> ('a, 'b) t Sexp.To_sexp.t
|
||||
end
|
||||
end
|
||||
|
||||
type t = (string, Path.t) Ast.t
|
||||
val t : t Sexp.Of_sexp.t
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
type t = (string, Path.t) Ast.t
|
||||
val t : t Sexp.Of_sexp.t
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
|
||||
(** Return the list of files under an [Update_file] *)
|
||||
val updated_files : t -> Path.Set.t
|
||||
(** Return the list of files under an [Update_file] *)
|
||||
val updated_files : t -> Path.Set.t
|
||||
|
||||
(** Return the list of directories the action chdirs to *)
|
||||
val chdirs : t -> Path.Set.t
|
||||
(** Return the list of directories the action chdirs to *)
|
||||
val chdirs : t -> Path.Set.t
|
||||
|
||||
module Unexpanded : sig
|
||||
module Unexpanded : sig
|
||||
type desc = t
|
||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
||||
val t : t Sexp.Of_sexp.t
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
val fold_vars : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
|
||||
val expand : Context.t -> Path.t -> t -> f:(string -> var_expansion) -> desc
|
||||
end with type desc := t
|
||||
end
|
||||
end with type desc := t
|
||||
|
||||
type t =
|
||||
{ context : Context.t option
|
||||
; action : Mini_shexp.t
|
||||
}
|
||||
|
||||
val sexp_of_t : t Sexp.To_sexp.t
|
||||
val exec : targets:Path.Set.t -> t -> unit Future.t
|
||||
val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t
|
||||
|
||||
(* Return a sandboxed version of an action *)
|
||||
val sandbox
|
||||
|
@ -70,6 +63,3 @@ val sandbox
|
|||
-> deps:Path.t list
|
||||
-> targets:Path.t list
|
||||
-> t
|
||||
|
||||
type for_hash
|
||||
val for_hash : t -> for_hash
|
||||
|
|
|
@ -0,0 +1,33 @@
|
|||
module Outputs = struct
|
||||
type t =
|
||||
| Stdout
|
||||
| Stderr
|
||||
| Outputs (** Both Stdout and Stderr *)
|
||||
end
|
||||
|
||||
module type Ast = sig
|
||||
type path
|
||||
type string
|
||||
|
||||
type t =
|
||||
| Run of path * string list
|
||||
| Chdir of path * t
|
||||
| Setenv of string * string * t
|
||||
| Redirect of Outputs.t * path * t
|
||||
| Ignore of Outputs.t * t
|
||||
| Progn of t list
|
||||
| Echo of string
|
||||
| Create_file of path
|
||||
| Cat of path
|
||||
| Copy of path * path
|
||||
| Symlink of path * path
|
||||
| Copy_and_add_line_directive of path * path
|
||||
| System of string
|
||||
| Bash of string
|
||||
| Update_file of path * string
|
||||
| Rename of path * path
|
||||
| Remove_tree of path
|
||||
| Try_run of path * string list * t
|
||||
| Located_error of path * int * int * int * string
|
||||
end
|
||||
|
77
src/build.ml
77
src/build.ml
|
@ -179,7 +179,7 @@ let get_prog (prog : _ Prog_spec.t) =
|
|||
| Dep p -> path p >>> arr (fun _ -> p)
|
||||
| Dyn f -> arr f >>> dyn_paths (arr (fun x -> [x]))
|
||||
|
||||
let prog_and_args ~dir prog args =
|
||||
let prog_and_args ?(dir=Path.root) prog args =
|
||||
Paths (Arg_spec.add_deps args Pset.empty)
|
||||
>>>
|
||||
(get_prog prog &&&
|
||||
|
@ -201,83 +201,50 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[])
|
|||
>>>
|
||||
Targets targets
|
||||
>>^ (fun (prog, args) ->
|
||||
let action : Action.Mini_shexp.t = Run (prog, args) in
|
||||
let action : Action.t = Run (prog, args) in
|
||||
let action =
|
||||
match stdout_to with
|
||||
| None -> action
|
||||
| Some path -> Redirect (Stdout, path, action)
|
||||
in
|
||||
{ Action.
|
||||
context = Some context
|
||||
; action = Chdir (dir, action)
|
||||
})
|
||||
Action.Ast.Chdir (dir, action))
|
||||
|
||||
let action ~context ?(dir=context.Context.build_dir) ~targets action =
|
||||
Targets targets
|
||||
>>^ fun () ->
|
||||
{ Action. context = Some context; action = Chdir (dir, action) }
|
||||
|
||||
let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () =
|
||||
Targets targets
|
||||
>>^ fun action ->
|
||||
{ Action. context = Some context; action = Chdir (dir, action) }
|
||||
|
||||
let action_context_independent ?dir ~targets action =
|
||||
let action : Action.Mini_shexp.t =
|
||||
match dir with
|
||||
| None -> action
|
||||
| Some dir -> Chdir (dir, action)
|
||||
in
|
||||
let action ?dir ~targets action =
|
||||
Targets targets
|
||||
>>^ fun _ ->
|
||||
{ Action. context = None; action }
|
||||
match dir with
|
||||
| None -> action
|
||||
| Some dir -> Action.Ast.Chdir (dir, action)
|
||||
|
||||
let action_dyn ?dir ~targets () =
|
||||
Targets targets
|
||||
>>^ fun action ->
|
||||
match dir with
|
||||
| None -> action
|
||||
| Some dir -> Action.Ast.Chdir (dir, action)
|
||||
|
||||
let update_file fn s =
|
||||
action_context_independent ~targets:[fn] (Update_file (fn, s))
|
||||
action ~targets:[fn] (Update_file (fn, s))
|
||||
|
||||
let update_file_dyn fn =
|
||||
Targets [fn]
|
||||
>>^ fun s ->
|
||||
{ Action.
|
||||
context = None
|
||||
; action = Update_file (fn, s)
|
||||
}
|
||||
Action.Ast.Update_file (fn, s)
|
||||
|
||||
let copy ~src ~dst =
|
||||
path src >>>
|
||||
action_context_independent ~targets:[dst] (Copy (src, dst))
|
||||
action ~targets:[dst] (Copy (src, dst))
|
||||
|
||||
let symlink ~src ~dst =
|
||||
path src >>>
|
||||
action_context_independent ~targets:[dst] (Symlink (src, dst))
|
||||
action ~targets:[dst] (Symlink (src, dst))
|
||||
|
||||
let create_file fn =
|
||||
action_context_independent ~targets:[fn] (Create_file fn)
|
||||
action ~targets:[fn] (Create_file fn)
|
||||
|
||||
let remove_tree dir =
|
||||
arr (fun _ ->
|
||||
{ Action. context = None; action = Remove_tree dir })
|
||||
arr (fun _ -> Action.Ast.Remove_tree dir)
|
||||
|
||||
let progn ts =
|
||||
all ts >>^ fun (actions : Action.t list) ->
|
||||
let rec loop context acc actions =
|
||||
match actions with
|
||||
| [] ->
|
||||
{ Action.
|
||||
context
|
||||
; action = Progn (List.rev acc)
|
||||
}
|
||||
| { Action. context = context'; action } :: rest ->
|
||||
let context =
|
||||
match context, context' with
|
||||
| None, c | c, None -> c
|
||||
| Some c1, Some c2 when c1.name = c2.name -> context
|
||||
| _ -> raise Exit
|
||||
in
|
||||
loop context (action :: acc) rest
|
||||
in
|
||||
try
|
||||
loop None [] actions
|
||||
with Exit ->
|
||||
Sexp.code_error "Build.progn"
|
||||
[ "actions", Sexp.To_sexp.list Action.sexp_of_t actions ]
|
||||
all ts >>^ fun actions ->
|
||||
Action.Ast.Progn actions
|
||||
|
|
|
@ -80,7 +80,7 @@ end
|
|||
|
||||
val run
|
||||
: context:Context.t
|
||||
-> ?dir:Path.t (* default: context.build_dir *)
|
||||
-> ?dir:Path.t (* default: [context.build_dir] *)
|
||||
-> ?stdout_to:Path.t
|
||||
-> ?extra_targets:Path.t list
|
||||
-> 'a Prog_spec.t
|
||||
|
@ -88,24 +88,16 @@ val run
|
|||
-> ('a, Action.t) t
|
||||
|
||||
val action
|
||||
: context:Context.t
|
||||
-> ?dir:Path.t (* default: context.build_dir *)
|
||||
: ?dir:Path.t
|
||||
-> targets:Path.t list
|
||||
-> Action.Mini_shexp.t
|
||||
-> (unit, Action.t) t
|
||||
-> Action.t
|
||||
-> (_, Action.t) t
|
||||
|
||||
val action_dyn
|
||||
: context:Context.t
|
||||
-> ?dir:Path.t (* default: context.build_dir *)
|
||||
: ?dir:Path.t
|
||||
-> targets:Path.t list
|
||||
-> unit
|
||||
-> (Action.Mini_shexp.t, Action.t) t
|
||||
|
||||
val action_context_independent
|
||||
: ?dir:Path.t (* default: Path.root *)
|
||||
-> targets:Path.t list
|
||||
-> Action.Mini_shexp.t
|
||||
-> (unit, Action.t) t
|
||||
-> (Action.t, Action.t) t
|
||||
|
||||
(** Create a file with the given contents. Do not ovewrite the file if
|
||||
it hasn't changed. *)
|
||||
|
|
|
@ -144,13 +144,15 @@ let targets =
|
|||
|
||||
module Rule = struct
|
||||
type t =
|
||||
{ build : (unit, Action.t) Build.t
|
||||
{ context : Context.t option
|
||||
; build : (unit, Action.t) Build.t
|
||||
; targets : Target.t list
|
||||
; sandbox : bool
|
||||
}
|
||||
|
||||
let make ?(sandbox=false) build =
|
||||
{ build
|
||||
let make ?(sandbox=false) ?context build =
|
||||
{ context
|
||||
; build
|
||||
; targets = targets build
|
||||
; sandbox
|
||||
}
|
||||
|
|
|
@ -11,12 +11,13 @@ end
|
|||
|
||||
module Rule : sig
|
||||
type t =
|
||||
{ build : (unit, Action.t) Build.t
|
||||
{ context : Context.t option
|
||||
; build : (unit, Action.t) Build.t
|
||||
; targets : Target.t list
|
||||
; sandbox : bool
|
||||
}
|
||||
|
||||
val make : ?sandbox:bool -> (unit, Action.t) Build.t -> t
|
||||
val make : ?sandbox:bool -> ?context:Context.t -> (unit, Action.t) Build.t -> t
|
||||
end
|
||||
|
||||
module Static_deps : sig
|
||||
|
|
|
@ -63,6 +63,7 @@ module Internal_rule = struct
|
|||
; rule_deps : Pset.t
|
||||
; static_deps : Pset.t
|
||||
; targets : Pset.t
|
||||
; context : Context.t option
|
||||
; build : (unit, Action.t) Build.t
|
||||
; mutable exec : Exec_status.t
|
||||
}
|
||||
|
@ -270,10 +271,7 @@ module Build_exec = struct
|
|||
| Store_vfile (Vspec.T (fn, kind)) ->
|
||||
let file = get_file bs fn (Sexp_file kind) in
|
||||
file.data <- Some x;
|
||||
{ Action.
|
||||
context = None
|
||||
; action = Update_file (fn, vfile_to_string kind fn x)
|
||||
}
|
||||
Update_file (fn, vfile_to_string kind fn x)
|
||||
| Compose (a, b) ->
|
||||
exec dyn_deps a x |> exec dyn_deps b
|
||||
| First t ->
|
||||
|
@ -394,7 +392,7 @@ let make_local_parent_dirs t paths ~map_path =
|
|||
let sandbox_dir = Path.of_string "_build/.sandbox"
|
||||
|
||||
let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||
let { Pre_rule. build; targets = target_specs; sandbox } = pre_rule in
|
||||
let { Pre_rule. context; build; targets = target_specs; sandbox } = pre_rule in
|
||||
let targets = Target.paths target_specs in
|
||||
let { Build_interpret.Static_deps.
|
||||
rule_deps
|
||||
|
@ -420,7 +418,12 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
|||
let all_deps_as_list = Pset.elements all_deps in
|
||||
let targets_as_list = Pset.elements targets in
|
||||
let hash =
|
||||
let trace = (all_deps_as_list, targets_as_list, Action.for_hash action) in
|
||||
let trace =
|
||||
(all_deps_as_list,
|
||||
targets_as_list,
|
||||
Option.map context ~f:(fun c -> c.name),
|
||||
action)
|
||||
in
|
||||
Digest.string (Marshal.to_string trace [])
|
||||
in
|
||||
let sandbox_dir =
|
||||
|
@ -465,7 +468,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
|||
(* Do not remove files that are just updated, otherwise this would break incremental
|
||||
compilation *)
|
||||
let targets_to_remove =
|
||||
Pset.diff targets (Action.Mini_shexp.updated_files action.action)
|
||||
Pset.diff targets (Action.updated_files action)
|
||||
in
|
||||
Pset.iter targets_to_remove ~f:Path.unlink_no_err;
|
||||
pending_targets := Pset.union targets_to_remove !pending_targets;
|
||||
|
@ -488,7 +491,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
|||
| None ->
|
||||
action
|
||||
in
|
||||
make_local_dirs t (Action.Mini_shexp.chdirs action.action);
|
||||
make_local_dirs t (Action.chdirs action);
|
||||
Action.exec ~targets action >>| fun () ->
|
||||
Option.iter sandbox_dir ~f:Path.rm_rf;
|
||||
(* All went well, these targets are no longer pending *)
|
||||
|
@ -504,6 +507,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
|||
; rule_deps
|
||||
; targets
|
||||
; build
|
||||
; context
|
||||
; exec = Not_started { eval_rule; exec_rule }
|
||||
}
|
||||
in
|
||||
|
@ -723,6 +727,7 @@ module Rule = struct
|
|||
{ id : Id.t
|
||||
; deps : Path.Set.t
|
||||
; targets : Path.Set.t
|
||||
; context : Context.t option
|
||||
; action : Action.t
|
||||
}
|
||||
|
||||
|
@ -767,6 +772,7 @@ let build_rules t ?(recursive=false) targets =
|
|||
id = ir.id
|
||||
; deps = Pset.union ir.static_deps dyn_deps
|
||||
; targets = ir.targets
|
||||
; context = ir.context
|
||||
; action = action
|
||||
}
|
||||
in
|
||||
|
|
|
@ -49,6 +49,7 @@ module Rule : sig
|
|||
{ id : Id.t
|
||||
; deps : Path.Set.t
|
||||
; targets : Path.Set.t
|
||||
; context : Context.t option
|
||||
; action : Action.t
|
||||
}
|
||||
end
|
||||
|
|
|
@ -495,7 +495,8 @@ module Gen(P : Params) = struct
|
|||
let action =
|
||||
match alias_conf.action with
|
||||
| None -> Sexp.Atom "none"
|
||||
| Some a -> List [Atom "some" ; Action.Mini_shexp.Unexpanded.sexp_of_t a] in
|
||||
| Some a -> List [Atom "some" ; Action.Unexpanded.sexp_of_t a]
|
||||
in
|
||||
Sexp.List [deps ; action]
|
||||
|> Sexp.to_string
|
||||
|> Digest.string
|
||||
|
|
|
@ -225,13 +225,13 @@ module Preprocess = struct
|
|||
type pps = { pps : Pp.t list; flags : string list }
|
||||
type t =
|
||||
| No_preprocessing
|
||||
| Action of Action.Mini_shexp.Unexpanded.t
|
||||
| Action of Action.Unexpanded.t
|
||||
| Pps of pps
|
||||
|
||||
let t =
|
||||
sum
|
||||
[ cstr "no_preprocessing" nil No_preprocessing
|
||||
; cstr "action" (Action.Mini_shexp.Unexpanded.t @> nil) (fun x -> Action x)
|
||||
; cstr "action" (Action.Unexpanded.t @> nil) (fun x -> Action x)
|
||||
; cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
|
||||
let pps, flags = Pp_or_flags.split l in
|
||||
Pps { pps; flags })
|
||||
|
@ -689,14 +689,14 @@ module Rule = struct
|
|||
type t =
|
||||
{ targets : string list (** List of files in the current directory *)
|
||||
; deps : Dep_conf.t list
|
||||
; action : Action.Mini_shexp.Unexpanded.t
|
||||
; action : Action.Unexpanded.t
|
||||
}
|
||||
|
||||
let v1 =
|
||||
record
|
||||
(field "targets" (list file_in_current_dir) >>= fun targets ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
field "action" Action.Mini_shexp.Unexpanded.t >>= fun action ->
|
||||
field "action" Action.Unexpanded.t >>= fun action ->
|
||||
return { targets; deps; action })
|
||||
|
||||
let ocamllex_v1 names =
|
||||
|
@ -807,7 +807,7 @@ module Alias_conf = struct
|
|||
type t =
|
||||
{ name : string
|
||||
; deps : Dep_conf.t list
|
||||
; action : Action.Mini_shexp.Unexpanded.t option
|
||||
; action : Action.Unexpanded.t option
|
||||
; package : Package.t option
|
||||
}
|
||||
|
||||
|
@ -816,7 +816,7 @@ module Alias_conf = struct
|
|||
(field "name" string >>= fun name ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
field_o "package" (Pkgs.package pkgs) >>= fun package ->
|
||||
field_o "action" Action.Mini_shexp.Unexpanded.t >>= fun action ->
|
||||
field_o "action" Action.Unexpanded.t >>= fun action ->
|
||||
return
|
||||
{ name
|
||||
; deps
|
||||
|
|
|
@ -54,6 +54,7 @@ type t =
|
|||
; ppx_dir : Path.t
|
||||
; ppx_drivers : (string, Path.t) Hashtbl.t
|
||||
; external_dirs : (Path.t, External_dir.t) Hashtbl.t
|
||||
; chdir : (Action.t, Action.t) Build.t
|
||||
}
|
||||
|
||||
let context t = t.context
|
||||
|
@ -199,10 +200,15 @@ let create
|
|||
; ppx_drivers = Hashtbl.create 32
|
||||
; ppx_dir = Path.relative context.build_dir ".ppx"
|
||||
; external_dirs = Hashtbl.create 1024
|
||||
; chdir = Build.arr (fun (action : Action.t) ->
|
||||
match action with
|
||||
| Chdir _ -> action
|
||||
| _ -> Chdir (context.build_dir, action))
|
||||
}
|
||||
|
||||
let add_rule t ?sandbox build =
|
||||
let rule = Build_interpret.Rule.make ?sandbox build in
|
||||
let build = Build.O.(>>>) build t.chdir in
|
||||
let rule = Build_interpret.Rule.make ?sandbox ~context:t.context build in
|
||||
t.rules <- rule :: t.rules;
|
||||
t.known_targets_by_src_dir_so_far <-
|
||||
List.fold_left rule.targets ~init:t.known_targets_by_src_dir_so_far
|
||||
|
@ -303,7 +309,7 @@ module Libs = struct
|
|||
add_rule t
|
||||
(Build.path src
|
||||
>>>
|
||||
Build.action_context_independent ~targets:[dst]
|
||||
Build.action ~targets:[dst]
|
||||
(Copy_and_add_line_directive (src, dst))))
|
||||
|
||||
let real_requires t ~dir ~dep_kind ~item ~libraries ~preprocess ~virtual_deps =
|
||||
|
@ -448,7 +454,7 @@ end
|
|||
|
||||
module Action = struct
|
||||
open Build.O
|
||||
module U = Action.Mini_shexp.Unexpanded
|
||||
module U = Action.Unexpanded
|
||||
|
||||
type resolved_forms =
|
||||
{ (* Mapping from ${...} forms to their resolutions *)
|
||||
|
@ -569,7 +575,7 @@ module Action = struct
|
|||
U.expand sctx.context dir t
|
||||
~f:(expand_var sctx ~artifacts ~targets ~deps))
|
||||
>>>
|
||||
Build.action_dyn () ~context:sctx.context ~dir ~targets
|
||||
Build.action_dyn () ~dir ~targets
|
||||
in
|
||||
match forms.failures with
|
||||
| [] -> build
|
||||
|
|
|
@ -126,7 +126,7 @@ end
|
|||
module Action : sig
|
||||
val run
|
||||
: t
|
||||
-> Action.Mini_shexp.Unexpanded.t
|
||||
-> Action.Unexpanded.t
|
||||
-> dir:Path.t
|
||||
-> dep_kind:Build.lib_dep_kind
|
||||
-> targets:Path.t list
|
||||
|
|
Loading…
Reference in New Issue