Extract a Static_deps module

Signed-off-by: Etienne Millon <me@emillon.org>

src/build_interpret.ml

@@ -18,13 +18,6 @@ module Target = struct
       Path.Set.add acc (path t))
 end
 
-module Static_deps = struct
-  type t =
-    { rule_deps   : Deps.t
-    ; action_deps : Deps.t
-    }
-end
-
 type file_kind = Reg | Dir
 
 let inspect_path file_tree path =
@@ -67,13 +60,14 @@ let static_deps t ~all_targets ~file_tree =
     | 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
-    | Paths fns -> { acc with action_deps = Deps.add_paths acc.action_deps fns }
+    | Paths fns ->
+      Static_deps.add_action_paths acc fns
     | Paths_for_rule fns ->
-      { acc with rule_deps = Deps.add_paths acc.rule_deps fns }
+      Static_deps.add_rule_paths acc fns
     | Paths_glob state -> begin
         match !state with
         | G_evaluated l ->
-          { acc with action_deps = Deps.add_paths acc.action_deps l }
+          Static_deps.add_action_paths acc l
         | G_unevaluated (loc, dir, re) ->
           let targets = all_targets ~dir in
           let result =
@@ -95,8 +89,7 @@ let static_deps t ~all_targets ~file_tree =
               ()
           end;
           state := G_evaluated result;
-          let action_deps = Deps.add_paths acc.action_deps result in
-          { acc with action_deps }
+          Static_deps.add_action_paths acc result
       end
     | If_file_exists (p, state) -> begin
         match !state with
@@ -114,21 +107,18 @@ let static_deps t ~all_targets ~file_tree =
       end
     | Dyn_paths t -> loop t acc targets_allowed
     | Vpath (Vspec.T (p, _)) ->
-      { acc with rule_deps = Deps.add_path acc.rule_deps p }
-    | Contents p -> { acc with rule_deps = Deps.add_path acc.rule_deps p }
-    | Lines_of p -> { acc with rule_deps = Deps.add_path acc.rule_deps p }
+      Static_deps.add_rule_path acc p
+    | 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
-    | Env_var var -> { acc with action_deps = Deps.add_env_var acc.action_deps var }
+    | Env_var var ->
+      Static_deps.add_action_env_var acc var
   in
-  loop (Build.repr t)
-    { rule_deps = Deps.empty
-    ; action_deps = Deps.empty
-    }
-    true
+  loop (Build.repr 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

src/build_interpret.mli

@@ -33,13 +33,6 @@ module Rule : sig
     -> t
 end
 
-module Static_deps : sig
-  type t =
-    { rule_deps   : Deps.t
-    ; action_deps : Deps.t
-    }
-end
-
 (* must be called first *)
 val static_deps
   :  (_, _) Build.t

src/build_system.ml

@@ -109,7 +109,7 @@ module Internal_rule = struct
 
   type t =
     { id               : Id.t
-    ; static_deps      : Build_interpret.Static_deps.t Lazy.t
+    ; static_deps      : Static_deps.t Lazy.t
     ; targets          : Path.Set.t
     ; context          : Context.t option
     ; build            : (unit, Action.t) Build.t
@@ -131,17 +131,15 @@ module Internal_rule = struct
   let lib_deps t =
     (* Forcing this lazy ensures that the various globs and
        [if_file_exists] are resolved inside the [Build.t] value. *)
-    ignore (Lazy.force t.static_deps : Build_interpret.Static_deps.t);
+    ignore (Lazy.force t.static_deps : Static_deps.t);
     Build_interpret.lib_deps t.build
 
   (* Represent the build goal given by the user. This rule is never
      actually executed and is only used starting point of all
      dependency paths. *)
   let root =
     { id          = Id.gen ()
-    ; static_deps = lazy { rule_deps   = Deps.empty
-                         ; action_deps = Deps.empty
-                         }
+    ; static_deps = lazy Static_deps.empty
     ; targets     = Path.Set.empty
     ; context     = None
     ; build       = Build.return (Action.Progn [])
@@ -739,12 +737,14 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
 
   let eval_rule () =
     t.hook Rule_started;
-    wait_for_deps t (Lazy.force static_deps).rule_deps ~loc
+    let static_deps = Lazy.force static_deps in
+    wait_for_deps t (Static_deps.rule_deps static_deps) ~loc
     >>| fun () ->
     Build_exec.exec t build ()
   in
   let exec_rule (rule_evaluation : Exec_status.rule_evaluation) =
-    let static_deps = (Lazy.force static_deps).action_deps in
+    let static_deps = Lazy.force static_deps in
+    let static_deps = Static_deps.action_deps static_deps in
     Fiber.fork_and_join_unit
       (fun () ->
          wait_for_deps ~loc t static_deps)
@@ -1261,12 +1261,14 @@ let create ~contexts ~file_tree ~hook =
   t
 
 let eval_request t ~request ~process_target =
-  let { Build_interpret.Static_deps.
-        rule_deps
-      ; action_deps = static_deps
-      } = Build_interpret.static_deps request ~all_targets:(targets_of t)
-            ~file_tree:t.file_tree
+  let static_deps =
+    Build_interpret.static_deps
+      request
+      ~all_targets:(targets_of t)
+      ~file_tree:t.file_tree
   in
+  let rule_deps = Static_deps.rule_deps static_deps in
+  let static_deps = Static_deps.action_deps static_deps in
 
   Fiber.fork_and_join_unit
     (fun () -> parallel_iter_deps ~f:process_target static_deps)
@@ -1317,7 +1319,7 @@ let rules_for_targets t targets =
       ~key:(fun (r : Internal_rule.t) -> r.id)
       ~deps:(fun (r : Internal_rule.t) ->
         let x = Lazy.force r.static_deps in
-        rules_for_files t (Deps.path_union x.action_deps x.rule_deps))
+        rules_for_files t (Static_deps.paths x))
   with
   | Ok l -> l
   | Error cycle ->
@@ -1328,13 +1330,11 @@ let rules_for_targets t targets =
        |> String.concat ~sep:"\n-> ")
 
 let static_deps_of_request t request =
-  let { Build_interpret.Static_deps.
-        rule_deps
-      ; action_deps
-      } = Build_interpret.static_deps request ~all_targets:(targets_of t)
-            ~file_tree:t.file_tree
-  in
-  Deps.path_union rule_deps action_deps
+  Static_deps.paths @@
+  Build_interpret.static_deps
+    request
+    ~all_targets:(targets_of t)
+    ~file_tree:t.file_tree
 
 let all_lib_deps t ~request =
   let targets = static_deps_of_request t request in
@@ -1424,10 +1424,13 @@ let build_rules_internal ?(recursive=false) t ~request =
       Fiber.fork (fun () ->
         Fiber.Future.wait rule_evaluation
         >>| fun (action, dyn_deps) ->
-        let static_deps = (Lazy.force ir.static_deps).action_deps in
+        let action_deps =
+          Static_deps.action_deps
+            (Lazy.force ir.static_deps)
+        in
         { Rule.
           id      = ir.id
-        ; deps    = Deps.union static_deps dyn_deps
+        ; deps    = Deps.union action_deps dyn_deps
         ; targets = ir.targets
         ; context = ir.context
         ; action  = action
@@ -1505,8 +1508,12 @@ let package_deps t pkg files =
             Option.value_exn (Fiber.Future.peek rule_evaluation)
           | Not_started _ -> assert false
         in
+        let action_deps =
+          Static_deps.action_deps
+            (Lazy.force ir.static_deps)
+        in
         Path.Set.fold
-          (Deps.path_union (Lazy.force ir.static_deps).action_deps dyn_deps)
+          (Deps.path_union action_deps dyn_deps)
           ~init:acc ~f:loop
       end
   in

src/static_deps.ml

@@ -0,0 +1,38 @@
+open! Import
+
+type t =
+  { rule_deps   : Deps.t
+  ; action_deps : Deps.t
+  }
+
+let action_deps t = t.action_deps
+
+let rule_deps t = t.rule_deps
+
+let empty =
+  { rule_deps = Deps.empty
+  ; action_deps = Deps.empty
+  }
+
+let add_rule_paths t fns =
+  { t with
+    rule_deps = Deps.add_paths t.rule_deps fns
+  }
+
+let add_rule_path t fn =
+  { t with
+    rule_deps = Deps.add_path t.rule_deps fn
+  }
+
+let add_action_paths t fns =
+  { t with
+    action_deps = Deps.add_paths t.action_deps fns
+  }
+
+let add_action_env_var t var =
+  { t with
+    action_deps = Deps.add_env_var t.action_deps var
+  }
+
+let paths {action_deps; rule_deps} =
+  Deps.path_union action_deps rule_deps

src/static_deps.mli

@@ -0,0 +1,33 @@
+open! Import
+
+(** A simple wrapper around [Deps.t], where some dependencies are recorded as
+    "rule deps" and other as "action deps". *)
+type t
+
+(** {1} Constructors *)
+
+(** No dependencies. *)
+val empty : t
+
+(** Add a path as a rule dep. *)
+val add_rule_path : t -> Path.t -> t
+
+(** Add a set of paths as rule deps. *)
+val add_rule_paths : t -> Path.Set.t -> t
+
+(** Add a set of paths as action deps. *)
+val add_action_paths : t -> Path.Set.t -> t
+
+(** Add an environment variable as an action dep. *)
+val add_action_env_var : t -> string -> t
+
+(** {1} Deconstructors *)
+
+(** Return the rule deps. *)
+val rule_deps : t -> Deps.t
+
+(** Return the action deps. *)
+val action_deps : t -> Deps.t
+
+(** Return the paths deps, both for the rule deps and the action deps . *)
+val paths : t -> Path.Set.t