From 35ba1bc0f1b50a0afea96748d02ab343bfa1c553 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 25 May 2017 16:20:10 +0100 Subject: [PATCH] Remove the dir field in Action.t Simplify things for Build.progn --- bin/main.ml | 10 ++-------- src/action.ml | 37 ++++++++++++++++++++----------------- src/action.mli | 4 +++- src/build.ml | 28 ++++++++++++---------------- src/build_system.ml | 20 ++++++++++---------- 5 files changed, 47 insertions(+), 52 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 182136e4..f343fca6 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -574,12 +574,6 @@ let rules = Build_system.build_rules setup.build_system targets ~recursive >>= fun rules -> let print oc = 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; Format.pp_open_vbox ppf 0; if makefile_syntax then begin @@ -591,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 (get_action rule))) + Sexp.pp_split_strings (Action.Mini_shexp.sexp_of_t rule.action.action)) end else begin List.iter rules ~f:(fun (rule : Build_system.Rule.t) -> let sexp = @@ -603,7 +597,7 @@ let rules = ; (match rule.action.context with | None -> [] | 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 Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp) diff --git a/src/action.ml b/src/action.ml index 132316a0..0712d136 100644 --- a/src/action.ml +++ b/src/action.ml @@ -221,6 +221,17 @@ module Mini_shexp = struct in 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 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 @@ -392,7 +403,6 @@ end type t = { context : Context.t option - ; dir : Path.t ; action : Mini_shexp.t } @@ -406,15 +416,13 @@ let t contexts sexp = in record (field_o "context" context >>= fun context -> - field "dir" Path.t >>= fun dir -> field "action" Mini_shexp.t >>= fun action -> - return { context; dir; action }) + return { context; action }) sexp -let sexp_of_t { context; dir; action } = +let sexp_of_t { context; action } = 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 let fields = @@ -424,7 +432,7 @@ let sexp_of_t { context; dir; action } = in Sexp.List fields -let exec ~targets { action; dir; context } = +let exec ~targets { action; context } = let env = match context with | None -> Lazy.force Context.initial_env @@ -432,7 +440,7 @@ let exec ~targets { action; dir; context } = in let targets = Path.Set.elements 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 let sandbox t ~sandboxed ~deps ~targets = @@ -452,14 +460,9 @@ let sandbox t ~sandboxed ~deps ~targets = None)) ] in - { t with - action - ; dir = sandboxed t.dir - } + { t with action } -type for_hash = string option * Path.t * Mini_shexp.t +type for_hash = string option * Mini_shexp.t -let for_hash { context; dir; action; _ } = - (Option.map context ~f:(fun c -> c.name), - dir, - action) +let for_hash { context; action } = + (Option.map context ~f:(fun c -> c.name), action) diff --git a/src/action.mli b/src/action.mli index d54bd566..fc730fa4 100644 --- a/src/action.mli +++ b/src/action.mli @@ -41,6 +41,9 @@ module Mini_shexp : sig (** 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 + module Unexpanded : sig type desc = t type t = (String_with_vars.t, String_with_vars.t) Ast.t @@ -53,7 +56,6 @@ end type t = { context : Context.t option - ; dir : Path.t ; action : Mini_shexp.t } diff --git a/src/build.ml b/src/build.ml index 23ffc46a..c75b5f15 100644 --- a/src/build.ml +++ b/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) in { Action. - dir - ; context = Some context - ; action + context = Some context + ; action = Chdir (dir, action) }) let action ~context ?(dir=context.Context.build_dir) ~targets action = Targets targets >>^ 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 () = Targets targets >>^ 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 >>^ fun () -> - { Action. context = None; dir; action } + { Action. context = None; action } let update_file fn s = action_context_independent ~targets:[fn] (Update_file (fn, s)) @@ -236,7 +240,6 @@ let update_file_dyn fn = >>^ fun s -> { Action. context = None - ; dir = Path.root ; action = Update_file (fn, s) } @@ -258,22 +261,15 @@ let progn ts = | [] -> { Action. context - ; dir = Path.root ; action = Progn (List.rev acc) } - | { Action. context = context'; dir; action } :: rest -> + | { 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 - let action = - if dir = Path.root then - action - else - Chdir (dir, action) - in loop context (action :: acc) rest in try diff --git a/src/build_system.ml b/src/build_system.ml index 143aafda..31ab4546 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -272,7 +272,6 @@ module Build_exec = struct file.data <- Some x; { Action. context = None - ; dir = Path.root ; action = Update_file (fn, vfile_to_string kind fn x) } | Compose (a, b) -> @@ -371,14 +370,15 @@ let () = pending_targets := Pset.empty; Pset.iter fns ~f:Path.unlink_no_err) -let make_local_dir t path = - match Path.kind path with - | Local path -> - if not (Path.Local.Set.mem path t.local_mkdirs) then begin - Path.Local.mkdir_p path; - t.local_mkdirs <- Path.Local.Set.add path t.local_mkdirs - end - | _ -> () +let make_local_dirs t paths = + Pset.iter paths ~f:(fun path -> + match Path.kind path with + | Local path -> + if not (Path.Local.Set.mem path t.local_mkdirs) then begin + Path.Local.mkdir_p path; + t.local_mkdirs <- Path.Local.Set.add path t.local_mkdirs + end + | _ -> ()) let make_local_parent_dirs t paths ~map_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 -> action in - make_local_dir t action.dir; + make_local_dirs t (Action.Mini_shexp.chdirs action.action); Action.exec ~targets action >>| fun () -> Option.iter sandbox_dir ~f:Path.rm_rf; (* All went well, these targets are no longer pending *)