Remove the dir field in Action.t
Simplify things for Build.progn
This commit is contained in:
parent
0a1f4f5658
commit
35ba1bc0f1
10
bin/main.ml
10
bin/main.ml
|
@ -574,12 +574,6 @@ let rules =
|
||||||
Build_system.build_rules setup.build_system targets ~recursive >>= fun rules ->
|
Build_system.build_rules setup.build_system targets ~recursive >>= fun rules ->
|
||||||
let print oc =
|
let print oc =
|
||||||
let ppf = Format.formatter_of_out_channel oc in
|
let ppf = Format.formatter_of_out_channel oc in
|
||||||
let get_action (rule : Build_system.Rule.t) =
|
|
||||||
if Path.is_root rule.action.dir then
|
|
||||||
rule.action.action
|
|
||||||
else
|
|
||||||
Chdir (rule.action.dir, rule.action.action)
|
|
||||||
in
|
|
||||||
Sexp.prepare_formatter ppf;
|
Sexp.prepare_formatter ppf;
|
||||||
Format.pp_open_vbox ppf 0;
|
Format.pp_open_vbox ppf 0;
|
||||||
if makefile_syntax then begin
|
if makefile_syntax then begin
|
||||||
|
@ -591,7 +585,7 @@ let rules =
|
||||||
(fun ppf ->
|
(fun ppf ->
|
||||||
Path.Set.iter rule.deps ~f:(fun dep ->
|
Path.Set.iter rule.deps ~f:(fun dep ->
|
||||||
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
Format.fprintf ppf "@ %s" (Path.to_string dep)))
|
||||||
Sexp.pp_split_strings (Action.Mini_shexp.sexp_of_t (get_action rule)))
|
Sexp.pp_split_strings (Action.Mini_shexp.sexp_of_t rule.action.action))
|
||||||
end else begin
|
end else begin
|
||||||
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
|
||||||
let sexp =
|
let sexp =
|
||||||
|
@ -603,7 +597,7 @@ let rules =
|
||||||
; (match rule.action.context with
|
; (match rule.action.context with
|
||||||
| None -> []
|
| None -> []
|
||||||
| Some c -> ["context", Atom c.name])
|
| Some c -> ["context", Atom c.name])
|
||||||
; [ "action" , Action.Mini_shexp.sexp_of_t (get_action rule) ]
|
; [ "action" , Action.Mini_shexp.sexp_of_t rule.action.action ]
|
||||||
])
|
])
|
||||||
in
|
in
|
||||||
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
|
||||||
|
|
|
@ -221,6 +221,17 @@ module Mini_shexp = struct
|
||||||
in
|
in
|
||||||
fun t -> loop Path.Set.empty t
|
fun t -> loop Path.Set.empty t
|
||||||
|
|
||||||
|
let chdirs =
|
||||||
|
let rec loop acc t =
|
||||||
|
let acc =
|
||||||
|
match t with
|
||||||
|
| Chdir (dir, _) -> Path.Set.add dir acc
|
||||||
|
| _ -> acc
|
||||||
|
in
|
||||||
|
Ast.fold_one_step t ~init:acc ~f:loop
|
||||||
|
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
|
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
|
let sexp_of_t = Ast.sexp_of_t String_with_vars.sexp_of_t String_with_vars.sexp_of_t
|
||||||
|
@ -392,7 +403,6 @@ end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ context : Context.t option
|
{ context : Context.t option
|
||||||
; dir : Path.t
|
|
||||||
; action : Mini_shexp.t
|
; action : Mini_shexp.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -406,15 +416,13 @@ let t contexts sexp =
|
||||||
in
|
in
|
||||||
record
|
record
|
||||||
(field_o "context" context >>= fun context ->
|
(field_o "context" context >>= fun context ->
|
||||||
field "dir" Path.t >>= fun dir ->
|
|
||||||
field "action" Mini_shexp.t >>= fun action ->
|
field "action" Mini_shexp.t >>= fun action ->
|
||||||
return { context; dir; action })
|
return { context; action })
|
||||||
sexp
|
sexp
|
||||||
|
|
||||||
let sexp_of_t { context; dir; action } =
|
let sexp_of_t { context; action } =
|
||||||
let fields : Sexp.t list =
|
let fields : Sexp.t list =
|
||||||
[ List [ Atom "dir" ; Path.sexp_of_t dir ]
|
[ List [ Atom "action" ; Mini_shexp.sexp_of_t action ]
|
||||||
; List [ Atom "action" ; Mini_shexp.sexp_of_t action ]
|
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
let fields =
|
let fields =
|
||||||
|
@ -424,7 +432,7 @@ let sexp_of_t { context; dir; action } =
|
||||||
in
|
in
|
||||||
Sexp.List fields
|
Sexp.List fields
|
||||||
|
|
||||||
let exec ~targets { action; dir; context } =
|
let exec ~targets { action; context } =
|
||||||
let env =
|
let env =
|
||||||
match context with
|
match context with
|
||||||
| None -> Lazy.force Context.initial_env
|
| None -> Lazy.force Context.initial_env
|
||||||
|
@ -432,7 +440,7 @@ let exec ~targets { action; dir; context } =
|
||||||
in
|
in
|
||||||
let targets = Path.Set.elements targets in
|
let targets = Path.Set.elements targets in
|
||||||
let purpose = Future.Build_job targets in
|
let purpose = Future.Build_job targets in
|
||||||
Mini_shexp.exec action ~purpose ~dir ~env ~env_extra:Env_var_map.empty
|
Mini_shexp.exec action ~purpose ~dir:Path.root ~env ~env_extra:Env_var_map.empty
|
||||||
~stdout_to:None ~stderr_to:None
|
~stdout_to:None ~stderr_to:None
|
||||||
|
|
||||||
let sandbox t ~sandboxed ~deps ~targets =
|
let sandbox t ~sandboxed ~deps ~targets =
|
||||||
|
@ -452,14 +460,9 @@ let sandbox t ~sandboxed ~deps ~targets =
|
||||||
None))
|
None))
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
{ t with
|
{ t with action }
|
||||||
action
|
|
||||||
; dir = sandboxed t.dir
|
|
||||||
}
|
|
||||||
|
|
||||||
type for_hash = string option * Path.t * Mini_shexp.t
|
type for_hash = string option * Mini_shexp.t
|
||||||
|
|
||||||
let for_hash { context; dir; action; _ } =
|
let for_hash { context; action } =
|
||||||
(Option.map context ~f:(fun c -> c.name),
|
(Option.map context ~f:(fun c -> c.name), action)
|
||||||
dir,
|
|
||||||
action)
|
|
||||||
|
|
|
@ -41,6 +41,9 @@ module Mini_shexp : sig
|
||||||
(** Return the list of files under an [Update_file] *)
|
(** Return the list of files under an [Update_file] *)
|
||||||
val updated_files : t -> Path.Set.t
|
val updated_files : 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 desc = t
|
||||||
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
type t = (String_with_vars.t, String_with_vars.t) Ast.t
|
||||||
|
@ -53,7 +56,6 @@ end
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ context : Context.t option
|
{ context : Context.t option
|
||||||
; dir : Path.t
|
|
||||||
; action : Mini_shexp.t
|
; action : Mini_shexp.t
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
28
src/build.ml
28
src/build.ml
|
@ -208,25 +208,29 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[])
|
||||||
| Some path -> Redirect (Stdout, path, action)
|
| Some path -> Redirect (Stdout, path, action)
|
||||||
in
|
in
|
||||||
{ Action.
|
{ Action.
|
||||||
dir
|
context = Some context
|
||||||
; context = Some context
|
; action = Chdir (dir, action)
|
||||||
; action
|
|
||||||
})
|
})
|
||||||
|
|
||||||
let action ~context ?(dir=context.Context.build_dir) ~targets action =
|
let action ~context ?(dir=context.Context.build_dir) ~targets action =
|
||||||
Targets targets
|
Targets targets
|
||||||
>>^ fun () ->
|
>>^ fun () ->
|
||||||
{ Action. context = Some context; dir; action }
|
{ Action. context = Some context; action = Chdir (dir, action) }
|
||||||
|
|
||||||
let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () =
|
let action_dyn ~context ?(dir=context.Context.build_dir) ~targets () =
|
||||||
Targets targets
|
Targets targets
|
||||||
>>^ fun action ->
|
>>^ fun action ->
|
||||||
{ Action. context = Some context; dir; action }
|
{ Action. context = Some context; action = Chdir (dir, action) }
|
||||||
|
|
||||||
let action_context_independent ?(dir=Path.root) ~targets 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
|
||||||
Targets targets
|
Targets targets
|
||||||
>>^ fun () ->
|
>>^ fun () ->
|
||||||
{ Action. context = None; dir; action }
|
{ Action. context = None; action }
|
||||||
|
|
||||||
let update_file fn s =
|
let update_file fn s =
|
||||||
action_context_independent ~targets:[fn] (Update_file (fn, s))
|
action_context_independent ~targets:[fn] (Update_file (fn, s))
|
||||||
|
@ -236,7 +240,6 @@ let update_file_dyn fn =
|
||||||
>>^ fun s ->
|
>>^ fun s ->
|
||||||
{ Action.
|
{ Action.
|
||||||
context = None
|
context = None
|
||||||
; dir = Path.root
|
|
||||||
; action = Update_file (fn, s)
|
; action = Update_file (fn, s)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -258,22 +261,15 @@ let progn ts =
|
||||||
| [] ->
|
| [] ->
|
||||||
{ Action.
|
{ Action.
|
||||||
context
|
context
|
||||||
; dir = Path.root
|
|
||||||
; action = Progn (List.rev acc)
|
; action = Progn (List.rev acc)
|
||||||
}
|
}
|
||||||
| { Action. context = context'; dir; action } :: rest ->
|
| { Action. context = context'; action } :: rest ->
|
||||||
let context =
|
let context =
|
||||||
match context, context' with
|
match context, context' with
|
||||||
| None, c | c, None -> c
|
| None, c | c, None -> c
|
||||||
| Some c1, Some c2 when c1.name = c2.name -> context
|
| Some c1, Some c2 when c1.name = c2.name -> context
|
||||||
| _ -> raise Exit
|
| _ -> raise Exit
|
||||||
in
|
in
|
||||||
let action =
|
|
||||||
if dir = Path.root then
|
|
||||||
action
|
|
||||||
else
|
|
||||||
Chdir (dir, action)
|
|
||||||
in
|
|
||||||
loop context (action :: acc) rest
|
loop context (action :: acc) rest
|
||||||
in
|
in
|
||||||
try
|
try
|
||||||
|
|
|
@ -272,7 +272,6 @@ module Build_exec = struct
|
||||||
file.data <- Some x;
|
file.data <- Some x;
|
||||||
{ Action.
|
{ Action.
|
||||||
context = None
|
context = None
|
||||||
; dir = Path.root
|
|
||||||
; action = Update_file (fn, vfile_to_string kind fn x)
|
; action = Update_file (fn, vfile_to_string kind fn x)
|
||||||
}
|
}
|
||||||
| Compose (a, b) ->
|
| Compose (a, b) ->
|
||||||
|
@ -371,14 +370,15 @@ let () =
|
||||||
pending_targets := Pset.empty;
|
pending_targets := Pset.empty;
|
||||||
Pset.iter fns ~f:Path.unlink_no_err)
|
Pset.iter fns ~f:Path.unlink_no_err)
|
||||||
|
|
||||||
let make_local_dir t path =
|
let make_local_dirs t paths =
|
||||||
match Path.kind path with
|
Pset.iter paths ~f:(fun path ->
|
||||||
| Local path ->
|
match Path.kind path with
|
||||||
if not (Path.Local.Set.mem path t.local_mkdirs) then begin
|
| Local path ->
|
||||||
Path.Local.mkdir_p path;
|
if not (Path.Local.Set.mem path t.local_mkdirs) then begin
|
||||||
t.local_mkdirs <- Path.Local.Set.add path t.local_mkdirs
|
Path.Local.mkdir_p path;
|
||||||
end
|
t.local_mkdirs <- Path.Local.Set.add path t.local_mkdirs
|
||||||
| _ -> ()
|
end
|
||||||
|
| _ -> ())
|
||||||
|
|
||||||
let make_local_parent_dirs t paths ~map_path =
|
let make_local_parent_dirs t paths ~map_path =
|
||||||
Pset.iter paths ~f:(fun path ->
|
Pset.iter paths ~f:(fun path ->
|
||||||
|
@ -488,7 +488,7 @@ let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule =
|
||||||
| None ->
|
| None ->
|
||||||
action
|
action
|
||||||
in
|
in
|
||||||
make_local_dir t action.dir;
|
make_local_dirs t (Action.Mini_shexp.chdirs action.action);
|
||||||
Action.exec ~targets action >>| fun () ->
|
Action.exec ~targets action >>| fun () ->
|
||||||
Option.iter sandbox_dir ~f:Path.rm_rf;
|
Option.iter sandbox_dir ~f:Path.rm_rf;
|
||||||
(* All went well, these targets are no longer pending *)
|
(* All went well, these targets are no longer pending *)
|
||||||
|
|
Loading…
Reference in New Issue