Allow ${...:...} for in (do ...) and add more checks

Check that targets written by the user are a superset of inferred
targets.

src/action.ml

@@ -9,7 +9,7 @@ module Program = struct
     | Not_found of string
 
   let sexp_of_t = function
-    | This      p -> Path.sexp_of_t p
+    | This p -> Path.sexp_of_t p
     | Not_found s -> List [Atom "not_found"; Atom s]
 
   let t sexp =
@@ -19,6 +19,16 @@ module Program = struct
     | _ ->
       Loc.fail (Sexp.Ast.loc sexp)
         "S-expression of the form <atom> or (not_found <atom>) expected"
+
+  let resolve ctx ~dir s =
+    if s = "" then
+      Not_found ""
+    else if String.contains s '/' then
+      This (Path.relative dir s)
+    else
+      match Context.which ctx s with
+      | Some p -> This p
+      | None -> Not_found s
 end
 
 module Var_expansion = struct
@@ -58,63 +68,28 @@ module Var_expansion = struct
     | Paths ([p], Concat) -> p
     | Paths (l,   Concat) ->
       path_of_string ~dir (concat (List.map l ~f:(string_of_path ~dir)))
+
+  let to_prog_and_args ctx ~dir exp : Program.t * string list =
+    let resolve = Program.resolve in
+    match exp with
+    | Paths   ([p], _) -> (This p, [])
+    | Strings ([s], _) -> (resolve ctx ~dir s, [])
+    | Paths ([], _) | Strings ([], _) -> (Not_found "", [])
+    | Paths (l, Concat) ->
+      (This
+         (path_of_string ~dir
+            (concat (List.map l ~f:(string_of_path ~dir)))),
+       [])
+    | Strings (l, Concat) ->
+      (resolve ~dir ctx (concat l), l)
+    | Paths (p :: l, Split) ->
+      (This p, List.map l ~f:(string_of_path ~dir))
+    | Strings (s :: l, Split) ->
+      (resolve ~dir ctx s, l)
 end
 
-module Expand = struct
+module VE = Var_expansion
-  module V = Var_expansion
+module SW = String_with_vars
-  module SW = String_with_vars
-
-  let string ~dir ~f template =
-    SW.expand template ~f:(fun var ->
-      match f var with
-      | None   -> None
-      | Some e -> Some (V.to_string ~dir e))
-
-  let expand ~generic ~special ~dir ~f template =
-    match SW.just_a_var template with
-    | None -> generic ~dir (string ~dir ~f template)
-    | Some var ->
-      match f var with
-      | None   -> generic ~dir (SW.to_string template)
-      | Some e -> special ~dir e
-
-  let strings ~dir ~f template =
-    expand ~dir ~f template
-      ~generic:(fun ~dir:_ x -> [x])
-      ~special:V.to_strings
-
-  let path ~dir ~f template =
-    expand ~dir ~f template
-      ~generic:V.path_of_string
-      ~special:V.to_path
-
-  let prog_and_args ctx ~dir ~f template =
-    let resolve s =
-      if String.contains s '/' then
-        Program.This (Path.relative dir s)
-      else
-        match Context.which ctx s with
-        | Some p -> Program.This p
-        | None -> Not_found s
-    in
-    expand ~dir ~f template
-      ~generic:(fun ~dir:_ s -> (resolve s, []))
-      ~special:(fun ~dir exp ->
-        match exp with
-        | Paths   ([p], _) -> (This p   , [])
-        | Strings ([s], _) -> (resolve s, [])
-        | Paths ([], _) | Strings ([], _) -> (resolve "", [])
-        | Paths (l, Concat) ->
-          (Program.This
-             (V.path_of_string ~dir (V.concat (List.map l ~f:(V.string_of_path ~dir)))),
-           [])
-        | Strings (l, Concat) ->
-          (resolve (V.concat l), l)
-        | Paths (p :: l, Split) ->
-          (This p, List.map l ~f:(V.string_of_path ~dir))
-        | Strings (s :: l, Split) ->
-          (resolve s, l))
-end
 
 module Outputs = struct
   include Action_intf.Outputs
@@ -204,9 +179,9 @@ struct
 end
 
 module type Ast = Action_intf.Ast
-  with type program := Program.t
+  with type program = Program.t
-  with type path    := Path.t
+  with type path    = Path.t
-  with type string  := String.t
+  with type string  = String.t
 module rec Ast : Ast = Ast
 
 include Make_ast
@@ -219,16 +194,14 @@ include Make_ast
     end)
     (Ast)
 
-type action = t
-
 module Unexpanded = struct
-  module type Ast = Action_intf.Ast
+  module type Uast = Action_intf.Ast
-    with type program := String_with_vars.t
+    with type program = String_with_vars.t
-    with type path    := String_with_vars.t
+    with type path    = String_with_vars.t
-    with type string  := String_with_vars.t
+    with type string  = String_with_vars.t
-  module rec Ast : Ast = Ast
+  module rec Uast : Uast = Uast
 
-  include Make_ast(String_with_vars)(String_with_vars)(String_with_vars)(Ast)
+  include Make_ast(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
 
   let t sexp =
     match sexp with
@@ -237,66 +210,232 @@ module Unexpanded = struct
         "if you meant for this to be executed with bash, write (bash \"...\") instead"
     | List _ -> t sexp
 
-  let rec fold t ~init:acc ~f =
+  module Partial = struct
-    match t with
+    module type Past = Action_intf.Ast
-    | Run (prog, args) -> List.fold_left args ~init:(f acc prog) ~f
+      with type program = (Program.t, String_with_vars.t) either
-    | Chdir (fn, t) -> fold t ~init:(f acc fn) ~f
+      with type path    = (Path.t   , String_with_vars.t) either
-    | Setenv (var, value, t) -> fold t ~init:(f (f acc var) value) ~f
+      with type string  = (string   , String_with_vars.t) either
-    | Redirect (_, fn, t) -> fold t ~init:(f acc fn) ~f
+    module rec Past : Past = Past
-    | Ignore (_, t) -> fold t ~init:acc ~f
-    | Progn l -> List.fold_left l ~init:acc ~f:(fun init t -> fold t ~init ~f)
-    | Echo x -> f acc x
-    | Cat x -> f acc x
-    | Create_file x -> f acc x
-    | Copy (x, y) -> f (f acc x) y
-    | Symlink (x, y) -> f (f acc x) y
-    | Copy_and_add_line_directive (x, y) -> f (f acc x) y
-    | System x -> f acc x
-    | Bash x -> f acc x
-    | Update_file (x, y) -> f (f acc x) y
-    | Rename (x, y) -> f (f acc x) y
-    | Remove_tree x
-    | Mkdir x -> f acc x
 
-  let fold_vars t ~init ~f =
+    include Past
-    fold t ~init ~f:(fun acc pat ->
-      String_with_vars.fold ~init:acc pat ~f)
 
-  let rec expand ctx dir t ~f : action =
+    module E = struct
+      let string ~dir ~f = function
+        | Inl x -> x
+        | Inr template ->
+          SW.expand template ~f:(fun loc var ->
+            match f loc var with
+            | None   -> None
+            | Some e -> Some (VE.to_string ~dir e))
+
+      let expand ~generic ~special ~map ~dir ~f = function
+        | Inl x -> map x
+        | Inr template as x ->
+          match SW.just_a_var template with
+          | None -> generic ~dir (string ~dir ~f x)
+          | Some var ->
+            match f (SW.loc template) var with
+            | None   -> generic ~dir (SW.to_string template)
+            | Some e -> special ~dir e
+      [@@inlined always]
+
+      let strings ~dir ~f x =
+        expand ~dir ~f x
+          ~generic:(fun ~dir:_ x -> [x])
+          ~special:VE.to_strings
+          ~map:(fun x -> [x])
+
+      let path ~dir ~f x =
+        expand ~dir ~f x
+          ~generic:VE.path_of_string
+          ~special:VE.to_path
+          ~map:(fun x -> x)
+
+      let prog_and_args ctx ~dir ~f x =
+        expand ~dir ~f x
+          ~generic:(fun ~dir:_ s -> (Program.resolve ctx ~dir s, []))
+          ~special:(VE.to_prog_and_args ctx)
+          ~map:(fun x -> (x, []))
+    end
+
+    let rec expand ctx dir t ~f : Ast.t =
+      match t with
+      | Run (prog, args) ->
+        let args = List.concat_map args ~f:(E.strings ~dir ~f) in
+        let prog, more_args = E.prog_and_args ctx ~dir ~f prog in
+        Run (prog, more_args @ args)
+      | Chdir (fn, t) ->
+        let fn = E.path ~dir ~f fn in
+        Chdir (fn, expand ctx fn t ~f)
+      | Setenv (var, value, t) ->
+        Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
+                expand ctx dir t ~f)
+      | Redirect (outputs, fn, t) ->
+        Redirect (outputs, E.path ~dir ~f fn, expand ctx dir t ~f)
+      | Ignore (outputs, t) ->
+        Ignore (outputs, expand ctx dir t ~f)
+      | Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
+      | Echo x -> Echo (E.string ~dir ~f x)
+      | Cat x -> Cat (E.path ~dir ~f x)
+      | Create_file x -> Create_file (E.path ~dir ~f x)
+      | Copy (x, y) ->
+        Copy (E.path ~dir ~f x, E.path ~dir ~f y)
+      | Symlink (x, y) ->
+        Symlink (E.path ~dir ~f x, E.path ~dir ~f y)
+      | Copy_and_add_line_directive (x, y) ->
+        Copy_and_add_line_directive (E.path ~dir ~f x, E.path ~dir ~f y)
+      | System x -> System (E.string ~dir ~f x)
+      | Bash x -> Bash (E.string ~dir ~f x)
+      | Update_file (x, y) -> Update_file (E.path ~dir ~f x, E.string ~dir ~f y)
+      | Rename (x, y) ->
+        Rename (E.path ~dir ~f x, E.path ~dir ~f y)
+      | Remove_tree x ->
+        Remove_tree (E.path ~dir ~f x)
+      | Mkdir x ->
+        Mkdir (E.path ~dir ~f x)
+  end
+
+  module E = struct
+    let string ~dir ~f template =
+      SW.partial_expand template ~f:(fun loc var ->
+        match f loc var with
+        | None   -> None
+        | Some e -> Some (VE.to_string ~dir e))
+
+    let expand ~generic ~special ~dir ~f template =
+      match SW.just_a_var template with
+      | None -> begin
+          match string ~dir ~f template with
+          | Inl x -> Inl (generic ~dir x)
+          | Inr _ as x -> x
+        end
+      | Some var ->
+        match f (SW.loc template) var with
+        | None   -> Inr template
+        | Some e -> Inl (special ~dir e)
+
+    let strings ~dir ~f x =
+      expand ~dir ~f x
+        ~generic:(fun ~dir:_ x -> [x])
+        ~special:VE.to_strings
+
+    let path ~dir ~f x =
+      expand ~dir ~f x
+        ~generic:VE.path_of_string
+        ~special:VE.to_path
+
+    let prog_and_args ctx ~dir ~f x =
+      expand ~dir ~f x
+        ~generic:(fun ~dir s -> (Program.resolve ctx ~dir s, []))
+        ~special:(VE.to_prog_and_args ctx)
+
+    let simple x =
+      match SW.just_text x with
+      | Some s -> Inl s
+      | None   -> Inr x
+  end
+
+  (* Like [partial_expand] except we keep everything as a template. This is for when we
+     can't determine a chdir statically *)
+  let rec simple_expand t ~f : Partial.t =
     match t with
     | Run (prog, args) ->
-      let prog, more_args = Expand.prog_and_args ctx ~dir ~f prog in
+      SW.iter prog ~f;
-      Run (prog,
+      List.iter args ~f:(SW.iter ~f);
-           more_args @ List.concat_map args ~f:(Expand.strings ~dir ~f))
+      Run (Inr prog, List.map args ~f:E.simple)
     | Chdir (fn, t) ->
-      let fn = Expand.path ~dir ~f fn in
+      SW.iter fn ~f;
-      Chdir (fn, expand ctx fn t ~f)
+      Chdir (Inr fn, simple_expand t ~f)
     | Setenv (var, value, t) ->
-      Setenv (Expand.string ~dir ~f var, Expand.string ~dir ~f value,
+      SW.iter var ~f;
-              expand ctx dir t ~f)
+      SW.iter value ~f;
+      Setenv (E.simple var, E.simple value, simple_expand t  ~f)
     | Redirect (outputs, fn, t) ->
-      Redirect (outputs, Expand.path ~dir ~f fn, expand ctx dir t ~f)
+      SW.iter fn ~f;
+      Redirect (outputs, Inr fn, simple_expand t ~f)
     | Ignore (outputs, t) ->
-      Ignore (outputs, expand ctx dir t ~f)
+      Ignore (outputs, simple_expand t ~f)
-    | Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
+    | Progn l -> Progn (List.map l ~f:(simple_expand ~f))
-    | Echo x -> Echo (Expand.string ~dir ~f x)
+    | Echo x -> SW.iter x ~f; Echo (E.simple x)
-    | Cat x -> Cat (Expand.path ~dir ~f x)
+    | Cat x -> SW.iter x ~f; Cat (Inr x)
-    | Create_file x -> Create_file (Expand.path ~dir ~f x)
+    | Create_file x -> SW.iter x ~f; Create_file (Inr x)
     | Copy (x, y) ->
-      Copy (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
+      SW.iter x ~f;
-    | Symlink (x, y) ->
+      SW.iter y ~f;
-      Symlink (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
+      Copy (Inr x, Inr y)
     | Copy_and_add_line_directive (x, y) ->
-      Copy_and_add_line_directive (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
+      SW.iter x ~f;
-    | System x -> System (Expand.string ~dir ~f x)
+      SW.iter y ~f;
-    | Bash x -> Bash (Expand.string ~dir ~f x)
+      Copy_and_add_line_directive (Inr x, Inr y)
-    | Update_file (x, y) -> Update_file (Expand.path ~dir ~f x, Expand.string ~dir ~f y)
+    | Symlink (x, y) ->
+      SW.iter x ~f;
+      SW.iter y ~f;
+      Symlink (Inr x, Inr y)
     | Rename (x, y) ->
-      Rename (Expand.path ~dir ~f x, Expand.path ~dir ~f y)
+      SW.iter x ~f;
+      SW.iter y ~f;
+      Rename (Inr x, Inr y)
+    | System x -> SW.iter x ~f; System (E.simple x)
+    | Bash x -> SW.iter x ~f; Bash (E.simple x)
+    | Update_file (x, y) ->
+      SW.iter x ~f;
+      SW.iter y ~f;
+      Update_file (Inr x, E.simple y)
+    | Remove_tree x -> SW.iter x ~f; Remove_tree (Inr x)
+    | Mkdir x -> SW.iter x ~f; Mkdir (Inr x)
+
+  let rec partial_expand ctx dir t ~f : Partial.t =
+    match t with
+    | Run (prog, args) ->
+      let args =
+        List.concat_map args ~f:(fun arg ->
+          match E.strings ~dir ~f arg with
+          | Inl args -> List.map args ~f:(fun x -> Inl x)
+          | Inr _ as x -> [x])
+      in
+      begin
+        match E.prog_and_args ctx ~dir ~f prog with
+        | Inl (prog, more_args) ->
+          let more_args = List.map more_args ~f:(fun x -> Inl x) in
+          Run (Inl prog, more_args @ args)
+        | Inr _ as prog ->
+          Run (prog, args)
+      end
+    | Chdir (fn, t) -> begin
+        let res = E.path ~dir ~f fn in
+        match res with
+        | Inl dir ->
+          Chdir (res, partial_expand ctx dir t ~f)
+        | Inr _ ->
+          let f loc x = ignore (f loc x : _ option) in
+          Chdir (res, simple_expand t ~f)
+      end
+    | Setenv (var, value, t) ->
+      Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
+              partial_expand ctx dir t ~f)
+    | Redirect (outputs, fn, t) ->
+      Redirect (outputs, E.path ~dir ~f fn, partial_expand ctx dir t ~f)
+    | Ignore (outputs, t) ->
+      Ignore (outputs, partial_expand ctx dir t ~f)
+    | Progn l -> Progn (List.map l ~f:(fun t -> partial_expand ctx dir t ~f))
+    | Echo x -> Echo (E.string ~dir ~f x)
+    | Cat x -> Cat (E.path ~dir ~f x)
+    | Create_file x -> Create_file (E.path ~dir ~f x)
+    | Copy (x, y) ->
+      Copy (E.path ~dir ~f x, E.path ~dir ~f y)
+    | Symlink (x, y) ->
+      Symlink (E.path ~dir ~f x, E.path ~dir ~f y)
+    | Copy_and_add_line_directive (x, y) ->
+      Copy_and_add_line_directive (E.path ~dir ~f x, E.path ~dir ~f y)
+    | System x -> System (E.string ~dir ~f x)
+    | Bash x -> Bash (E.string ~dir ~f x)
+    | Update_file (x, y) -> Update_file (E.path ~dir ~f x, E.string ~dir ~f y)
+    | Rename (x, y) ->
+      Rename (E.path ~dir ~f x, E.path ~dir ~f y)
     | Remove_tree x ->
-      Remove_tree (Expand.path ~dir ~f x)
+      Remove_tree (E.path ~dir ~f x)
     | Mkdir x ->
-      Mkdir (Expand.path ~dir ~f x)
+      Mkdir (E.path ~dir ~f x)
 end
 
 let fold_one_step t ~init:acc ~f =
@@ -586,4 +725,72 @@ module Infer = struct
        ]}
     *)
     { deps = S.diff deps targets; targets }
+
+  let ( +@? ) acc fn =
+    match fn with
+    | Inl fn -> { acc with targets = S.add fn acc.targets }
+    | Inr _  -> acc
+  let ( +<? ) acc fn =
+    match fn with
+    | Inl fn -> { acc with deps    = S.add fn acc.deps    }
+    | Inr _  -> acc
+
+  let rec partial acc (t : Unexpanded.Partial.t) =
+    match t with
+    | Run (Inl (This prog), _)   -> acc +< prog
+    | Run (_, _) -> acc
+    | Redirect (_, fn, t)  -> partial (acc +@? fn) t
+    | Cat fn               -> acc +<? fn
+    | Create_file fn       -> acc +@? fn
+    | Update_file (fn, _)  -> acc +@? fn
+    | Rename (src, dst)    -> acc +<? src +@? dst
+    | Copy (src, dst)
+    | Copy_and_add_line_directive (src, dst)
+    | Symlink (src, dst) -> acc +<? src +@? dst
+    | Chdir (_, t)
+    | Setenv (_, _, t)
+    | Ignore (_, t) -> partial acc t
+    | Progn l -> List.fold_left l ~init:acc ~f:partial
+    | Echo _
+    | System _
+    | Bash _
+    | Remove_tree _
+    | Mkdir _ -> acc
+
+  let ( +@? ) acc fn =
+    match fn with
+    | Inl fn -> { acc with targets = S.add fn acc.targets }
+    | Inr _  -> die "cannot determine target"
+
+  let rec partial_with_all_targets acc (t : Unexpanded.Partial.t) =
+    match t with
+    | Run (Inl (This prog), _)   -> acc +< prog
+    | Run (_, _) -> acc
+    | Redirect (_, fn, t)  -> partial_with_all_targets (acc +@? fn) t
+    | Cat fn               -> acc +<? fn
+    | Create_file fn       -> acc +@? fn
+    | Update_file (fn, _)  -> acc +@? fn
+    | Rename (src, dst)    -> acc +<? src +@? dst
+    | Copy (src, dst)
+    | Copy_and_add_line_directive (src, dst)
+    | Symlink (src, dst) -> acc +<? src +@? dst
+    | Chdir (_, t)
+    | Setenv (_, _, t)
+    | Ignore (_, t) -> partial_with_all_targets acc t
+    | Progn l -> List.fold_left l ~init:acc ~f:partial_with_all_targets
+    | Echo _
+    | System _
+    | Bash _
+    | Remove_tree _
+    | Mkdir _ -> acc
+
+  let partial ~all_targets t =
+    let acc = { deps = S.empty; targets = S.empty } in
+    let { deps; targets } =
+      if all_targets then
+        partial_with_all_targets acc t
+      else
+        partial acc t
+    in
+    { deps = S.diff deps targets; targets }
 end

src/action.mli

@@ -34,6 +34,49 @@ 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 action = t
+
+  include Action_intf.Ast
+    with type program := String_with_vars.t
+    with type path    := String_with_vars.t
+    with type string  := String_with_vars.t
+
+  val t : t Sexp.Of_sexp.t
+  val sexp_of_t : t Sexp.To_sexp.t
+
+  module Partial : sig
+    include Action_intf.Ast
+      with type program = (Program.t, String_with_vars.t) either
+      with type path    = (Path.t   , String_with_vars.t) either
+      with type string  = (string   , String_with_vars.t) either
+
+    val expand
+      :  Context.t
+      -> Path.t
+      -> t
+      -> f:(Loc.t -> String.t -> Var_expansion.t option)
+      -> action
+  end
+
+  val partial_expand
+    :  Context.t
+    -> Path.t
+    -> t
+    -> f:(Loc.t -> string -> Var_expansion.t option)
+    -> Partial.t
+end with type action := t
+
+val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t
+
+(* Return a sandboxed version of an action *)
+val sandbox
+  :  t
+  -> sandboxed:(Path.t -> Path.t)
+  -> deps:Path.t list
+  -> targets:Path.t list
+  -> t
+
 (** Infer dependencies and targets.
 
     This currently doesn't support well (rename ...) and (remove-tree ...). However these
@@ -48,28 +91,7 @@ module Infer : sig
   end
 
   val infer : t -> Outcome.t
+
+  (** If [all_targets] is [true] and a target cannot be determined statically, fail *)
+  val partial : all_targets:bool -> Unexpanded.Partial.t -> Outcome.t
 end
-
-module Unexpanded : sig
-  type action = t
-
-  include Action_intf.Ast
-    with type program := String_with_vars.t
-    with type path    := String_with_vars.t
-    with type string  := String_with_vars.t
-
-  val t : t Sexp.Of_sexp.t
-  val sexp_of_t : t Sexp.To_sexp.t
-  val fold_vars : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
-  val expand : Context.t -> Path.t -> t -> f:(string -> Var_expansion.t option) -> action
-end with type action := t
-
-val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t
-
-(* Return a sandboxed version of an action *)
-val sandbox
-  :  t
-  -> sandboxed:(Path.t -> Path.t)
-  -> deps:Path.t list
-  -> targets:Path.t list
-  -> t

src/gen_rules.ml

@@ -476,9 +476,17 @@ module Gen(P : Params) = struct
      | User rules                                                      |
      +-----------------------------------------------------------------+ *)
 
-  let do_rule (conf : Do.t) ~dir =
+  let do_rule (conf : Do.t) ~dir ~package_context =
     SC.add_rule sctx
-      (SC.Do_action.run sctx conf.action ~dir)
+      (Build.return []
+       >>>
+       SC.Action.run
+         sctx
+         conf.action
+         ~dir
+         ~dep_kind:Required
+         ~targets:Infer
+         ~package_context)
 
   let user_rule (rule : Rule.t) ~dir ~package_context =
     let targets = List.map rule.targets ~f:(Path.relative dir) in
@@ -490,7 +498,7 @@ module Gen(P : Params) = struct
          rule.action
          ~dir
          ~dep_kind:Required
-         ~targets
+         ~targets:(Static targets)
          ~package_context)
 
   let alias_rules (alias_conf : Alias_conf.t) ~dir ~package_context =
@@ -525,7 +533,7 @@ module Gen(P : Params) = struct
                action
                ~dir
                ~dep_kind:Required
-               ~targets:[]
+               ~targets:(Static [])
                ~package_context
            ; Build.create_file digest_path
            ])
@@ -604,7 +612,7 @@ module Gen(P : Params) = struct
       let dir = ctx_dir in
       match (stanza : Stanza.t) with
       | Rule         rule  -> user_rule   rule  ~dir ~package_context
-      | Do           conf  -> do_rule     conf  ~dir
+      | Do           conf  -> do_rule     conf  ~dir ~package_context
       | Alias        alias -> alias_rules alias ~dir ~package_context
       | Library _ | Executables _ | Provides _ | Install _ -> ());
     let files = lazy (

src/jbuild_types.ml

@@ -909,7 +909,7 @@ module Foreach = struct
         | Error (dup, _, _) ->
           Loc.fail loc "variable %s appears twice in this pattern" dup
       in
-      expand_sexps (fun v -> String_map.find v env) sexps)
+      expand_sexps (fun _loc v -> String_map.find v env) sexps)
 end
 
 module Stanza = struct

src/string_with_vars.ml

@@ -72,6 +72,11 @@ let just_a_var t =
   | [Var (_, s)] -> Some s
   | _ -> None
 
+let just_text t =
+  match t.items with
+  | [Text s] -> Some s
+  | _ -> None
+
 let sexp_of_var_syntax = function
   | Parens -> Sexp.Atom "parens"
   | Braces -> Sexp.Atom "braces"
@@ -90,6 +95,11 @@ let fold t ~init ~f =
     | Text _ -> acc
     | Var (_, v) -> f acc t.loc v)
 
+let iter t ~f =
+  List.iter t.items ~f:(function
+    | Text _ -> ()
+    | Var (_, v) -> f t.loc v)
+
 let vars t = fold t ~init:String_set.empty ~f:(fun acc _ x -> String_set.add x acc)
 
 let string_of_var syntax v =
@@ -101,11 +111,36 @@ let expand t ~f =
   List.map t.items ~f:(function
     | Text s -> s
     | Var (syntax, v) ->
-      match f v with
+      match f t.loc v with
       | Some x -> x
       | None -> string_of_var syntax v)
   |> String.concat ~sep:""
 
+let concat_rev = function
+  | [] -> ""
+  | [s] -> s
+  | l -> String.concat (List.rev l) ~sep:" "
+
+let partial_expand t ~f =
+  let commit_text acc_text acc =
+    let s = concat_rev acc_text in
+    if s = "" then acc else Text s :: acc
+  in
+  let rec loop acc_text acc items =
+    match items with
+    | [] -> begin
+        match acc with
+        | [] -> Inl (concat_rev acc_text)
+        | _  -> Inr { t with items = List.rev (commit_text acc_text acc) }
+      end
+    | Text s :: items -> loop (s :: acc_text) acc items
+    | Var (_, v) as it :: items ->
+      match f t.loc v with
+      | None -> loop [] (it :: commit_text acc_text acc) items
+      | Some s -> loop (s :: acc_text) acc items
+  in
+  loop [] [] t.items
+
 let to_string t =
   match t.items with
   (* [to_string is only called from action.ml, always on [t]s of this form *)

src/string_with_vars.mli

@@ -16,9 +16,12 @@ val to_string : t -> string
 val raw : loc:Loc.t -> string -> t
 
 val just_a_var : t -> string option
+val just_text : t -> string option
 
 val vars : t -> String_set.t
 
 val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
+val iter : t -> f:(Loc.t -> string -> unit) -> unit
 
-val expand : t -> f:(string -> string option) -> string
+val expand : t -> f:(Loc.t -> string -> string option) -> string
+val partial_expand : t -> f:(Loc.t -> string -> string option) -> (string, t) either

src/super_context.ml

@@ -1,6 +1,8 @@
 open Import
 open Jbuild_types
 
+module Pset = Path.Set
+
 module Dir_with_jbuild = struct
   type t =
     { src_dir : Path.t
@@ -74,7 +76,7 @@ let get_external_dir t ~dir =
     External_dir.create ~dir)
 
 let expand_vars t ~dir s =
-  String_with_vars.expand s ~f:(function
+  String_with_vars.expand s ~f:(fun _loc -> function
   | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
   | var -> String_map.find var t.vars)
 
@@ -110,9 +112,9 @@ let create
         | _ -> None))
   in
   let dirs_with_dot_opam_files =
-    Path.Set.elements dirs_with_dot_opam_files
+    Pset.elements dirs_with_dot_opam_files
     |> List.map ~f:(Path.append context.build_dir)
-    |> Path.Set.of_list
+    |> Pset.of_list
   in
   let libs =
     Lib_db.create context.findlib internal_libraries
@@ -417,7 +419,7 @@ module Deps = struct
     | Files_recursively_in s ->
       let path = Path.relative dir (expand_vars t ~dir s) in
       Build.files_recursively_in ~dir:path ~file_tree:t.file_tree
-      >>^ Path.Set.elements
+      >>^ Pset.elements
 
   let interpret t ~dir l =
     Build.all (List.map l ~f:(dep t ~dir))
@@ -454,58 +456,36 @@ let parse_bang var : Action.Var_expansion.Concat_or_split.t * string =
   else
     (Concat, var)
 
-module Do_action = struct
-  open Build.O
-  module U = Action.Unexpanded
-
-  let run t action ~dir =
-    let action =
-      Action.Unexpanded.expand t.context dir action ~f:(fun var ->
-        let cos, var = parse_bang var in
-        match var with
-        | "ROOT" -> Some (Paths ([t.context.build_dir], cos))
-        | var ->
-          match expand_var_no_root t var with
-          | Some s -> Some (Strings ([s], cos))
-          | None -> None)
-    in
-    let { Action.Infer.Outcome.deps; targets } = Action.Infer.infer action in
-    Build.path_set deps
-    >>>
-    Build.action ~dir ~targets:(Path.Set.elements targets) action
-end
-
 module Action = struct
   open Build.O
   module U = Action.Unexpanded
 
+  type targets =
+    | Static of Path.t list
+    | Infer
+
   type resolved_forms =
     { (* Mapping from ${...} forms to their resolutions *)
-      artifacts : Action.Var_expansion.t String_map.t
+      mutable artifacts : Action.Var_expansion.t String_map.t
     ; (* Failed resolutions *)
-      failures  : fail list
+      mutable failures  : fail list
     ; (* All "name" for ${lib:name:...}/${lib-available:name} forms *)
-      lib_deps  : Build.lib_deps
+      mutable lib_deps  : Build.lib_deps
-    ; vdeps     : (unit, Action.Var_expansion.t) Build.t String_map.t
+    ; mutable vdeps     : (unit, Action.Var_expansion.t) Build.t String_map.t
     }
 
   let add_artifact ?lib_dep acc ~key result =
-    let lib_deps =
+    (match lib_dep with
-      match lib_dep with
+     | None -> ()
-      | None -> acc.lib_deps
+     | Some (lib, kind) ->
-      | Some (lib, kind) -> String_map.add acc.lib_deps ~key:lib ~data:kind
+       acc.lib_deps <- String_map.add acc.lib_deps ~key:lib ~data:kind);
-    in
     match result with
-    | Ok path ->
+    | Ok exp ->
-      { acc with
+      acc.artifacts <- String_map.add acc.artifacts ~key ~data:exp;
-        artifacts = String_map.add acc.artifacts ~key ~data:path
+      Some exp
-      ; lib_deps
-      }
     | Error fail ->
-      { acc with
+      acc.failures <- fail :: acc.failures;
-        failures = fail :: acc.failures
+      None
-      ; lib_deps
-      }
 
   let ok_path   x = Ok (Action.Var_expansion.Paths   ([x], Concat))
   let ok_string x = Ok (Action.Var_expansion.Strings ([x], Concat))
@@ -514,82 +494,88 @@ module Action = struct
     | Ok x -> ok_path x
     | Error _ as e -> e
 
-  let extract_artifacts sctx ~dir ~dep_kind ~package_context t =
+  let expand_step1 sctx ~dir ~dep_kind ~package_context t =
-    let init =
+    let acc =
       { artifacts = String_map.empty
       ; failures  = []
       ; lib_deps  = String_map.empty
       ; vdeps     = String_map.empty
       }
     in
-    U.fold_vars t ~init ~f:(fun acc loc key ->
+    let t =
-      let module A = Artifacts in
+      U.partial_expand sctx.context dir t ~f:(fun loc key ->
-      let open Action.Var_expansion in
+        let module A = Artifacts in
-      let cos, var = parse_bang key in
+        let open Action.Var_expansion in
-      match String.lsplit2 var ~on:':' with
+        let cos, var = parse_bang key in
-      | Some ("exe"     , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
+        match String.lsplit2 var ~on:':' with
-      | Some ("path"    , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
+        | Some ("exe"     , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
-      | Some ("bin"     , s) ->
+        | Some ("path"    , s) -> add_artifact acc ~key (ok_path (Path.relative dir s))
-        add_artifact acc ~key (A.binary (artifacts sctx) s |> map_result)
+        | Some ("bin"     , s) ->
-      | Some ("lib"     , s)
+          add_artifact acc ~key (A.binary (artifacts sctx) s |> map_result)
-      | Some ("libexec" , s) ->
+        | Some ("lib"     , s)
-        let lib_dep, res = A.file_of_lib (artifacts sctx) ~from:dir s in
+        | Some ("libexec" , s) ->
-        add_artifact acc ~key ~lib_dep:(lib_dep, dep_kind) (map_result res)
+          let lib_dep, res = A.file_of_lib (artifacts sctx) ~from:dir s in
-      | Some ("lib-available", lib) ->
+          add_artifact acc ~key ~lib_dep:(lib_dep, dep_kind) (map_result res)
-        add_artifact acc ~key ~lib_dep:(lib, Optional)
+        | Some ("lib-available", lib) ->
-          (ok_string (string_of_bool (Libs.lib_is_available sctx ~from:dir lib)))
+          add_artifact acc ~key ~lib_dep:(lib, Optional)
-      (* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
+            (ok_string (string_of_bool (Libs.lib_is_available sctx ~from:dir lib)))
-      | Some ("findlib" , s) ->
+        (* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
-        let lib_dep, res =
+        | Some ("findlib" , s) ->
-          A.file_of_lib (artifacts sctx) ~from:dir s ~use_provides:true
+          let lib_dep, res =
-        in
+            A.file_of_lib (artifacts sctx) ~from:dir s ~use_provides:true
-        add_artifact acc ~key ~lib_dep:(lib_dep, Required) (map_result res)
+          in
-      | Some ("version", s) -> begin
+          add_artifact acc ~key ~lib_dep:(lib_dep, Required) (map_result res)
-          match Pkgs.resolve package_context s with
+        | Some ("version", s) -> begin
-          | Ok p ->
+            match Pkgs.resolve package_context s with
-            let x =
+            | Ok p ->
-              Pkg_version.read sctx p >>^ function
+              let x =
-              | None   -> Strings ([""], Concat)
+                Pkg_version.read sctx p >>^ function
-              | Some s -> Strings ([s],  Concat)
+                | None   -> Strings ([""], Concat)
+                | Some s -> Strings ([s],  Concat)
+              in
+              acc.vdeps <- String_map.add acc.vdeps ~key ~data:x;
+            | Error s ->
+              acc.failures <- { fail = fun () -> Loc.fail loc "%s" s } :: acc.failures
+          end; None
+        | Some ("read", s) -> begin
+            let path = Path.relative dir s in
+            let data =
+              Build.contents path
+              >>^ fun s -> Strings ([s], cos)
             in
-            { acc with vdeps = String_map.add acc.vdeps ~key ~data:x }
+            acc.vdeps <- String_map.add acc.vdeps ~key ~data
-          | Error s ->
+          end; None
-            { acc with failures = { fail = fun () -> Loc.fail loc "%s" s } :: acc.failures }
+        | Some ("read-lines", s) -> begin
-        end
+            let path = Path.relative dir s in
-      | Some ("read", s) -> begin
+            let data =
-          let path = Path.relative dir s in
+              Build.lines_of path
-          let data =
+              >>^ fun l -> Strings (l, cos)
-            Build.contents path
+            in
-            >>^ fun s -> Strings ([s], cos)
+            acc.vdeps <- String_map.add acc.vdeps ~key ~data
-          in
+          end; None
-          {acc with vdeps = String_map.add acc.vdeps ~key ~data }
+        | Some ("read-strings", s) -> begin
-        end
+            let path = Path.relative dir s in
-      | Some ("read-lines", s) -> begin
+            let data =
-          let path = Path.relative dir s in
+              Build.strings path
-          let data =
+              >>^ fun l -> Strings (l, cos)
-            Build.lines_of path
+            in
-            >>^ fun l -> Strings (l, cos)
+            acc.vdeps <- String_map.add acc.vdeps ~key ~data
-          in
+          end; None
-          {acc with vdeps = String_map.add acc.vdeps ~key ~data }
+        | _ ->
-        end
+          match expand_var_no_root sctx var with
-      | Some ("read-strings", s) -> begin
+          | Some s -> Some (Strings ([s], cos))
-          let path = Path.relative dir s in
+          | None -> None)
-          let data =
+    in
-            Build.strings path
+    (t, acc)
-            >>^ fun l -> Strings (l, cos)
-          in
-          {acc with vdeps = String_map.add acc.vdeps ~key ~data }
-        end
-      | _ -> acc)
 
-  let expand_var =
+  let expand_step2 sctx ~dir ~artifacts ~targets ~deps t =
-    fun sctx ~artifacts ~targets ~deps var_name ->
+    let open Action.Var_expansion in
-      let open Action.Var_expansion in
+    U.Partial.expand sctx.context dir t ~f:(fun _loc key ->
-      let cos, var_name = parse_bang var_name in
+      match String_map.find key artifacts with
-      match String_map.find var_name artifacts with
       | Some _ as opt -> opt
       | None ->
-        match var_name with
+        let cos, var = parse_bang key in
+        match var with
         | "@"  -> Some (Paths (targets, cos))
         | "<" ->
           Some
@@ -604,20 +590,40 @@ module Action = struct
         | var ->
           match expand_var_no_root sctx var with
           | Some s -> Some (Strings ([s], cos))
-          | None -> None
+          | None -> None)
 
   let run sctx t ~dir ~dep_kind ~targets ~package_context
     : (Path.t list, Action.t) Build.t =
-    let forms = extract_artifacts sctx ~dir ~dep_kind ~package_context t in
+    let t, forms = expand_step1 sctx ~dir ~dep_kind ~package_context t in
+    let { Action.Infer.Outcome. deps; targets } =
+      match targets with
+      | Infer -> Action.Infer.partial t ~all_targets:true
+      | Static targets_written_by_user ->
+        let targets_written_by_user = Pset.of_list targets_written_by_user in
+        let { Action.Infer.Outcome. deps; targets } =
+          Action.Infer.partial t ~all_targets:false
+        in
+        let missing = Pset.diff targets targets_written_by_user in
+        if not (Pset.is_empty missing) then
+          Loc.warn (Loc.in_file (Utils.jbuild_name_in ~dir))
+            "Missing targets in user action:\n%s"
+            (List.map (Pset.elements missing) ~f:(fun target ->
+               sprintf "- %s" (Utils.describe_target target))
+             |> String.concat ~sep:"\n");
+        { deps; targets = Pset.union targets targets_written_by_user }
+    in
+    let targets = Pset.elements targets in
     let build =
       Build.record_lib_deps_simple ~dir forms.lib_deps
       >>>
+      Build.path_set deps
+      >>>
       Build.path_set
-        (String_map.fold forms.artifacts ~init:Path.Set.empty
+        (String_map.fold forms.artifacts ~init:Pset.empty
            ~f:(fun ~key:_ ~data:exp acc ->
              match exp with
              | Action.Var_expansion.Paths (ps, _) ->
-               Path.Set.union acc (Path.Set.of_list ps)
+               Pset.union acc (Pset.of_list ps)
              | Strings _ -> acc))
       >>>
       Build.arr (fun paths -> ((), paths))
@@ -629,8 +635,9 @@ module Action = struct
           List.fold_left2 vdeps vals ~init:forms.artifacts ~f:(fun acc (var, _) value ->
             String_map.add acc ~key:var ~data:value)
         in
-        U.expand sctx.context dir t
+        expand_step2 sctx ~dir ~artifacts ~targets ~deps t
-          ~f:(expand_var sctx ~artifacts ~targets ~deps))
+        (* CR-someday jdimino: we could infer again to find more dependencies/check
+           targets again *))
       >>>
       Build.action_dyn () ~dir ~targets
     in
@@ -814,7 +821,7 @@ module PP = struct
                           action)))
                ~dir
                ~dep_kind
-               ~targets:[dst]
+               ~targets:(Static [dst])
                ~package_context))
       | Pps { pps; flags } ->
         let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in

src/super_context.mli

@@ -119,24 +119,19 @@ module Deps : sig
   val interpret : t -> dir:Path.t -> Dep_conf.t list -> (unit, Path.t list) Build.t
 end
 
-(** Interpret "do" actions, for which targes are inferred *)
-module Do_action : sig
-  val run
-    :  t
-    -> Action.Unexpanded.t
-    -> dir:Path.t
-    -> (unit, Action.t) Build.t
-end
-
 (** Interpret action written in jbuild files *)
 module Action : sig
+  type targets =
+    | Static of Path.t list
+    | Infer
+
   (** The arrow takes as input the list of actual dependencies *)
   val run
     :  t
     -> Action.Unexpanded.t
     -> dir:Path.t
     -> dep_kind:Build.lib_dep_kind
-    -> targets:Path.t list
+    -> targets:targets
     -> package_context:Pkgs.t
     -> (Path.t list, Action.t) Build.t
 end