Remove the dir field in Action.t

Simplify things for Build.progn

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)

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)

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
   }
 

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

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 *)