[RFC] Add support for order-only and post-use dependencies to Dune engine

bin/print_rules.ml

@@ -99,6 +99,7 @@ let rec encode : Action.For_shell.t -> Dune_lang.t =
   | Mkdir x -> List [ atom "mkdir"; target x ]
   | Pipe (outputs, l) ->
     List (atom (sprintf "pipe-%s" (Outputs.to_string outputs)) :: List.map l ~f:encode)
+  | Needed_deps xs -> List (atom "needed_deps" :: List.map xs ~f:path)
   | Extension ext -> List [ atom "ext"; Dune_sexp.Quoted_string (Sexp.to_string ext) ]
 ;;
 

doc/concepts/dependency-spec.rst

@@ -46,6 +46,9 @@ Dependencies in ``dune`` files can be specified using one of the following:
 - ``(include <file>)`` read the s-expression in ``<file>`` and interpret it as
   additional dependencies. The s-expression is expected to be a list of the
   same constructs enumerated here.
+- ``(order_only <deps>)`` declares ``<deps>`` as "order only" dependencies.
+  This means that these dependencies will be guaranteed to be up-to-date before
+  building the target, but changes in them will not cause the target to be rebuilt.
 
 In all these cases, the argument supports :doc:`variables`.
 

doc/reference/actions/needed_deps.rst

@@ -0,0 +1,38 @@
+needed_deps
+----
+
+.. highlight:: dune
+
+.. describe:: (needed_deps <file> ...)
+
+   Declare the contents of ``<file>`` assumed to as dependencies of the rule.
+   Each ``<file>`` is assumed to contain a valid dependency specification (see
+   below).
+
+   This is used to declare that certain "order only" dependencies (see
+   :docs:`concepts/dependency-spec`) are actual dependencies of the rule.
+
+   The file passed as an argument is assumed to contain zero or more
+   S-expressions using the following constructors which cover a subset of the
+   usual dependency sepecification:
+
+   - ``(file <filename>)``
+   - ``(alias <alias_name>)``
+   - ``(file_selector <glob>)``
+   - ``(universe)``
+
+   (see :docs:`concepts/dependency-spec` for the details of each constructor).
+
+   In the following example, both ``a`` and ``b`` are declared as "order only"
+   dependencies. The file ``b`` is in addition declared as a needed dependency
+   for the rule. The rule will only be reran if ``b`` changes, but not if ``a``
+   changes.
+
+   Example::
+
+   (rule
+    (deps (order_only (file a) (file b)))
+    (action
+     (progn
+     (with-stdout-to deps (echo "(file b)"))
+     (needed_deps deps))))

src/dune_engine/action.ml

@@ -54,6 +54,7 @@ struct
   let rename a b = Rename (a, b)
   let remove_tree path = Remove_tree path
   let mkdir path = Mkdir path
+  let needed_deps xs = Needed_deps xs
 end
 
 module Prog = struct
@@ -193,7 +194,8 @@ let fold_one_step t ~init:acc ~f =
   | Rename _
   | Remove_tree _
   | Mkdir _
-  | Extension _ -> acc
+  | Extension _
+  | Needed_deps _ -> acc
 ;;
 
 include Action_mapper.Make (Ast) (Ast)
@@ -238,7 +240,8 @@ let rec is_dynamic = function
   | Rename _
   | Remove_tree _
   | Mkdir _
-  | Extension _ -> false
+  | Extension _
+  | Needed_deps _ -> false
 ;;
 
 let maybe_sandbox_path sandbox p =
@@ -291,6 +294,7 @@ let is_useful_to memoize =
     | Dynamic_run _ -> true
     | Bash _ -> true
     | Extension (module A) -> A.Spec.is_useful_to ~memoize
+    | Needed_deps _ -> false
   in
   fun t ->
     match loop t with

src/dune_engine/action_exec.ml

@@ -125,6 +125,7 @@ module Exec_result = struct
   type ok =
     { dynamic_deps_stages : (Dep.Set.t * Dep.Facts.t) list
     ; duration : float option
+    ; needed_deps : Dep.Set.t * Dep.Facts.t
     }
 
   type t = (ok, Error.t list) Result.t
@@ -178,12 +179,12 @@ let bash_exn =
 let zero = Predicate_lang.element 0
 let maybe_async f = Produce.of_fiber (maybe_async f)
 
-let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
+let rec exec t ~display ~ectx ~eenv : Action_res.t Produce.t =
   match (t : Action.t) with
   | Run (Error e, _) -> Action.Prog.Not_found.raise e
   | Run (Ok prog, args) ->
     let+ () = exec_run ~display ~ectx ~eenv prog (Array.Immutable.to_list args) in
-    Done
+    Action_res.done_
   | With_accepted_exit_codes (exit_codes, t) ->
     let eenv =
       let exit_codes =
@@ -204,7 +205,7 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
       maybe_async (fun () ->
         Io.write_file (Path.build fn) (String.concat s ~sep:" ") ~perm)
     in
-    Done
+    Action_res.done_
   | Redirect_out (outputs, fn, perm, t) ->
     let fn = Path.build fn in
     redirect_out t ~display ~ectx ~eenv outputs ~perm fn
@@ -214,28 +215,28 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
   | Progn ts -> exec_list ts ~display ~ectx ~eenv
   | Concurrent ts ->
     Produce.parallel_map ts ~f:(exec ~display ~ectx ~eenv)
-    >>| List.fold_left ~f:done_or_more_deps_union ~init:Done
+    >>| List.fold_left ~f:Action_res.union ~init:Action_res.done_
   | Echo strs ->
     let+ () = exec_echo eenv.stdout_to (String.concat strs ~sep:" ") in
-    Done
+    Action_res.done_
   | Cat xs ->
     let+ () =
       maybe_async (fun () ->
         List.iter xs ~f:(fun fn ->
           Io.with_file_in fn ~f:(fun ic ->
             Io.copy_channels ic (Process.Io.out_channel eenv.stdout_to))))
     in
-    Done
+    Action_res.done_
   | Copy (src, dst) ->
     let dst = Path.build dst in
     let+ () = maybe_async (fun () -> Io.copy_file ~src ~dst ()) in
-    Done
+    Action_res.done_
   | Symlink (src, dst) ->
     let+ () = maybe_async (fun () -> Io.portable_symlink ~src ~dst:(Path.build dst)) in
-    Done
+    Action_res.done_
   | Hardlink (src, dst) ->
     let+ () = maybe_async (fun () -> Io.portable_hardlink ~src ~dst:(Path.build dst)) in
-    Done
+    Action_res.done_
   | Bash cmd ->
     let+ () =
       exec_run
@@ -245,26 +246,34 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
         (bash_exn ~loc:ectx.rule_loc ~needed_to:"interpret (bash ...) actions")
         [ "-e"; "-u"; "-o"; "pipefail"; "-c"; cmd ]
     in
-    Done
+    Action_res.done_
   | Write_file (fn, perm, s) ->
     let perm = Action.File_perm.to_unix_perm perm in
     let+ () = maybe_async (fun () -> Io.write_file (Path.build fn) s ~perm) in
-    Done
+    Action_res.done_
   | Rename (src, dst) ->
     let src = Path.Build.to_string src in
     let dst = Path.Build.to_string dst in
     let+ () = maybe_async (fun () -> Unix.rename src dst) in
-    Done
+    Action_res.done_
   | Remove_tree path ->
     let+ () = maybe_async (fun () -> Path.rm_rf (Path.build path)) in
-    Done
+    Action_res.done_
   | Mkdir path ->
     let+ () = maybe_async (fun () -> Path.mkdir_p (Path.build path)) in
-    Done
+    Action_res.done_
   | Pipe (outputs, l) -> exec_pipe ~display ~ectx ~eenv outputs l
   | Extension (module A) ->
     let+ () = Produce.of_fiber @@ A.Spec.action A.v ~ectx ~eenv in
-    Done
+    Action_res.done_
+  | Needed_deps paths ->
+    let needed_deps =
+      Dep.Set.union_map paths ~f:(fun path ->
+        Dep.Set.of_list_map
+          ~f:(Dune_sexp.Decoder.parse (Dep.decode eenv.working_dir) Univ_map.empty)
+          (Dune_sexp.Parser.load ~mode:Many path))
+    in
+    Produce.return (Action_res.needed_deps needed_deps)
 
 and redirect_out t ~display ~ectx ~eenv ~perm outputs fn =
   redirect t ~display ~ectx ~eenv ~out:(outputs, fn, perm) ()
@@ -302,22 +311,25 @@ and redirect t ~display ~ectx ~eenv ?in_ ?out () =
   release_out ();
   result
 
-and exec_list ts ~display ~ectx ~eenv : done_or_more_deps Produce.t =
+and exec_list ts ~display ~ectx ~eenv : Action_res.t Produce.t =
   match ts with
-  | [] -> Produce.return Done
+  | [] -> Produce.return Action_res.done_
   | [ t ] -> exec t ~display ~ectx ~eenv
   | t :: rest ->
-    let* done_or_deps =
+    let* action_res =
       let stdout_to = Process.Io.multi_use eenv.stdout_to in
       let stderr_to = Process.Io.multi_use eenv.stderr_to in
       let stdin_from = Process.Io.multi_use eenv.stdin_from in
       exec t ~display ~ectx ~eenv:{ eenv with stdout_to; stderr_to; stdin_from }
     in
-    (match done_or_deps with
-     | Need_more_deps _ as need -> Produce.return need
-     | Done -> exec_list rest ~display ~ectx ~eenv)
-
-and exec_pipe outputs ts ~display ~ectx ~eenv : done_or_more_deps Produce.t =
+    (match action_res with
+     | { done_or_more_deps = Need_more_deps _; _ } -> Produce.return action_res
+     | { done_or_more_deps = Done; needed_deps } ->
+       let* x = exec_list rest ~display ~ectx ~eenv in
+       let needed_deps = Dep.Set.union x.needed_deps needed_deps in
+       Produce.return (Action_res.needed_deps needed_deps))
+
+and exec_pipe outputs ts ~display ~ectx ~eenv : Action_res.t Produce.t =
   let tmp_file () =
     Dtemp.file ~prefix:"dune-pipe-action-" ~suffix:("." ^ Action.Outputs.to_string outputs)
   in
@@ -335,14 +347,17 @@ and exec_pipe outputs ts ~display ~ectx ~eenv : done_or_more_deps Produce.t =
       result
     | t :: ts ->
       let out = tmp_file () in
-      let* done_or_deps =
+      let* action_res =
         let eenv = { eenv with stderr_to = Process.Io.multi_use eenv.stderr_to } in
         redirect t ~display ~ectx ~eenv ~in_:(Stdin, in_) ~out:(Stdout, out, Normal) ()
       in
       Dtemp.destroy File in_;
-      (match done_or_deps with
-       | Need_more_deps _ as need -> Produce.return need
-       | Done -> loop ~in_:out ts)
+      (match action_res with
+       | { done_or_more_deps = Need_more_deps _; _ } -> Produce.return action_res
+       | { done_or_more_deps = Done; needed_deps } ->
+         let* res = loop ~in_:out ts in
+         let needed_deps = Dep.Set.union res.needed_deps needed_deps in
+         Produce.return (Action_res.needed_deps needed_deps))
   in
   match ts with
   | [] -> assert false
@@ -356,16 +371,23 @@ and exec_pipe outputs ts ~display ~ectx ~eenv : done_or_more_deps Produce.t =
     in
     let* done_or_deps = redirect_out t1 ~display ~ectx ~eenv ~perm:Normal outputs out in
     (match done_or_deps with
-     | Need_more_deps _ as need -> Produce.return need
-     | Done -> loop ~in_:out ts)
+     | { done_or_more_deps = Need_more_deps _; _ } -> Produce.return done_or_deps
+     | { done_or_more_deps = Done; needed_deps } ->
+       let* res = loop ~in_:out ts in
+       let needed_deps = Dep.Set.union res.needed_deps needed_deps in
+       Produce.return (Action_res.needed_deps needed_deps))
 ;;
 
 let exec_until_all_deps_ready ~display ~ectx ~eenv t =
   let rec loop ~eenv stages =
     let* result = exec ~display ~ectx ~eenv t in
     match result with
-    | Done -> Produce.return stages
-    | Need_more_deps (relative_deps, deps_to_build) ->
+    | { done_or_more_deps = Done; needed_deps = deps } ->
+      let* fact_map = Produce.of_fiber @@ ectx.build_deps deps in
+      Produce.return (stages, (deps, fact_map))
+    | { done_or_more_deps = Need_more_deps (relative_deps, deps_to_build)
+      ; needed_deps = _
+      } ->
       let* fact_map = Produce.of_fiber @@ ectx.build_deps deps_to_build in
       let stages = (deps_to_build, fact_map) :: stages in
       let eenv =
@@ -377,8 +399,11 @@ let exec_until_all_deps_ready ~display ~ectx ~eenv t =
       loop ~eenv stages
   in
   let open Fiber.O in
-  let+ stages, state = Produce.run Produce.State.empty (loop ~eenv []) in
-  { Exec_result.dynamic_deps_stages = List.rev stages; duration = state.duration }
+  let+ (stages, needed_deps), state = Produce.run Produce.State.empty (loop ~eenv []) in
+  { Exec_result.dynamic_deps_stages = List.rev stages
+  ; duration = state.duration
+  ; needed_deps
+  }
 ;;
 
 type input =

src/dune_engine/action_exec.mli

@@ -19,6 +19,7 @@ module Exec_result : sig
            facts map. We don't do it because conversion isn't free *)
         (Dep.Set.t * Dep.Facts.t) list
     ; duration : float option
+    ; needed_deps : Dep.Set.t * Dep.Facts.t
     }
 
   type t = (ok, Error.t list) Result.t

src/dune_engine/action_intf.ml

@@ -51,6 +51,7 @@ module type Ast = sig
     | Mkdir of target
     | Pipe of Outputs.t * t list
     | Extension of ext
+    | Needed_deps of path list
 end
 
 module type Helpers = sig
@@ -82,6 +83,7 @@ module type Helpers = sig
   val rename : target -> target -> t
   val remove_tree : target -> t
   val mkdir : target -> t
+  val needed_deps : path list -> t
 end
 
 module Exec = struct

src/dune_engine/action_mapper.ml

@@ -41,6 +41,7 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct
     | Mkdir x -> Mkdir (f_target ~dir x)
     | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(fun t -> f t ~dir))
     | Extension ext -> Extension (f_ext ~dir ext)
+    | Needed_deps xs -> Needed_deps (List.map xs ~f:(f_path ~dir))
   ;;
 
   let rec map t ~dir ~f_program ~f_string ~f_path ~f_target ~f_ext =

src/dune_engine/action_plugin.ml

@@ -37,6 +37,27 @@ let done_or_more_deps_union x y =
     Need_more_deps (Dependency.Set.union deps1 deps2, Dep.Set.union dyn_deps1 dyn_deps2)
 ;;
 
+module Action_res = struct
+  type t =
+    { done_or_more_deps : done_or_more_deps
+    ; needed_deps : Dep.Set.t
+    }
+
+  let union x y =
+    match x, y with
+    | ( { done_or_more_deps = x; needed_deps = a }
+      , { done_or_more_deps = y; needed_deps = b } ) ->
+      { done_or_more_deps = done_or_more_deps_union x y; needed_deps = Dep.Set.union a b }
+  ;;
+
+  let needed_deps needed_deps = { done_or_more_deps = Done; needed_deps }
+  let done_ = { done_or_more_deps = Done; needed_deps = Dep.Set.empty }
+
+  let need_more_deps deps dyn_deps =
+    { done_or_more_deps = Need_more_deps (deps, dyn_deps); needed_deps = Dep.Set.empty }
+  ;;
+end
+
 open Action_intf.Exec
 
 let exec ~display ~(ectx : context) ~(eenv : env) prog args =
@@ -126,8 +147,9 @@ let exec ~display ~(ectx : context) ~(eenv : env) prog args =
            that is incompatible with this version of dune."
           prog_name
       ]
-  | Ok Done -> Done
+  | Ok Done -> Action_res.done_
   | Ok (Need_more_deps deps) ->
-    Need_more_deps
-      (deps, to_dune_dep_set deps ~loc:ectx.rule_loc ~working_dir:eenv.working_dir)
+    Action_res.need_more_deps
+      deps
+      (to_dune_dep_set deps ~loc:ectx.rule_loc ~working_dir:eenv.working_dir)
 ;;

src/dune_engine/action_plugin.mli

@@ -11,10 +11,22 @@ type done_or_more_deps =
 
 val done_or_more_deps_union : done_or_more_deps -> done_or_more_deps -> done_or_more_deps
 
+module Action_res : sig
+  type t =
+    { done_or_more_deps : done_or_more_deps
+    ; needed_deps : Dep.Set.t
+    }
+
+  val union : t -> t -> t
+  val done_ : t
+  val needed_deps : Dep.Set.t -> t
+  val need_more_deps : Dependency.Set.t -> Dep.Set.t -> t
+end
+
 val exec
   :  display:Display.t
   -> ectx:Action_intf.Exec.context
   -> eenv:Action_intf.Exec.env
   -> Path.t
   -> string list
-  -> done_or_more_deps Fiber.t
+  -> Action_res.t Fiber.t