Better behavior when aliases have targets (#426)

Ignore the targets and report a warning.

src/action.ml

@@ -876,112 +876,143 @@ module Infer = struct
   end
   open Outcome
 
-  let ( +@ ) acc fn = { acc with targets = S.add fn acc.targets }
+  module type Pset = sig
-  let ( +< ) acc fn = { acc with deps    = S.add fn acc.deps    }
+    type t
+    val empty : t
+    val diff : t -> t -> t
+  end
 
-  let rec infer acc t =
+  module type Outcome = sig
-    match t with
+    type path_set
-    | Run (Ok prog, _)        -> acc +< prog
+    type t =
-    | Run (Error _, _) -> acc
+      { deps    : path_set
-    | Redirect (_, fn, t)  -> infer (acc +@ fn) t
+      ; targets : path_set
-    | Cat fn               -> acc +< fn
+      }
-    | Write_file (fn, _)  -> acc +@ fn
+  end
-    | 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) -> infer acc t
-    | Progn l -> List.fold_left l ~init:acc ~f:infer
-    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<)
-    | Diff { optional; file1; file2 } ->
-      if optional then acc else acc +< file1 +< file2
-    | Echo _
-    | System _
-    | Bash _
-    | Remove_tree _
-    | Mkdir _ -> acc
 
-  let infer t =
+  module type Primitives = sig
-    let { deps; targets } = infer { deps = S.empty; targets = S.empty } t in
+    type path
-    (* A file can be inferred as both a dependency and a target, for instance:
+    type program
+    type outcome
+    val ( +@ ) : outcome -> path -> outcome
+    val ( +< ) : outcome -> path -> outcome
+    val ( +<! ) : outcome -> program -> outcome
+  end
 
-       {[
+  module Make
-         (progn (copy a b) (copy b c))
+      (Ast : Action_intf.Ast)
-       ]}
+      (Pset : Pset)
-    *)
+      (Out : Outcome with type path_set := Pset.t)
-    { deps = S.diff deps targets; targets }
+      (Prim : Primitives
+       with type path := Ast.path
+       with type program := Ast.program
+       with type outcome := Out.t) =
+  struct
+    open Ast
+    open Out
+    open Prim
+    let rec infer acc t =
+      match t with
+      | Run (prog, _) -> acc +<! prog
+      | Redirect (_, fn, t)  -> infer (acc +@ fn) t
+      | Cat fn               -> acc +< fn
+      | Write_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) -> infer acc t
+      | Progn l -> List.fold_left l ~init:acc ~f:infer
+      | Digest_files l -> List.fold_left l ~init:acc ~f:(+<)
+      | Diff { optional; file1; file2 } ->
+        if optional then acc else acc +< file1 +< file2
+      | Echo _
+      | System _
+      | Bash _
+      | Remove_tree _
+      | Mkdir _ -> acc
 
-  let ( +@? ) acc fn =
+    let infer t =
-    match fn with
+      let { deps; targets } =
-    | Inl fn -> { acc with targets = S.add fn acc.targets }
+        infer { deps = Pset.empty; targets = Pset.empty } t
-    | Inr _  -> acc
+      in
-  let ( +<? ) acc fn =
+      (* A file can be inferred as both a dependency and a target,
-    match fn with
+         for instance:
-    | Inl fn -> { acc with deps    = S.add fn acc.deps    }
-    | Inr _  -> acc
 
-  let rec partial acc (t : Unexpanded.Partial.t) =
+         {[
-    match t with
+           (progn (copy a b) (copy b c))
-    | Run (Inl (This prog), _)   -> acc +< prog
+         ]}
-    | Run (_, _) -> acc
+      *)
-    | Redirect (_, fn, t)  -> partial (acc +@? fn) t
+      { deps = Pset.diff deps targets; targets }
-    | Cat fn               -> acc +<? fn
+  end [@@inline always]
-    | Write_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
-    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<?)
-    | Diff { optional; file1; file2 } ->
-      if optional then acc else acc +<? file1 +<? file2
-    | Echo _
-    | System _
-    | Bash _
-    | Remove_tree _
-    | Mkdir _ -> acc
 
-  let ( +@? ) acc fn =
+  include Make(Ast)(S)(Outcome)(struct
-    match fn with
+      let ( +@ ) acc fn = { acc with targets = S.add fn acc.targets }
-    | Inl fn -> { acc with targets = S.add fn acc.targets }
+      let ( +< ) acc fn = { acc with deps    = S.add fn acc.deps    }
-    | Inr sw -> Loc.fail (SW.loc sw) "Cannot determine this target statically."
+      let ( +<! ) acc prog =
+        match prog with
+        | Ok p -> acc +< p
+        | Error _ -> acc
+    end)
 
-  let rec partial_with_all_targets acc (t : Unexpanded.Partial.t) =
+  module Partial = Make(Unexpanded.Partial.Past)(S)(Outcome)(struct
-    match t with
+      let ( +@ ) acc fn =
-    | Run (Inl (This prog), _)   -> acc +< prog
+        match fn with
-    | Run (_, _) -> acc
+        | Inl fn -> { acc with targets = S.add fn acc.targets }
-    | Redirect (_, fn, t)  -> partial_with_all_targets (acc +@? fn) t
+        | Inr _  -> acc
-    | Cat fn               -> acc +<? fn
+      let ( +< ) acc fn =
-    | Write_file (fn, _)  -> acc +@? fn
+        match fn with
-    | Rename (src, dst)    -> acc +<? src +@? dst
+        | Inl fn -> { acc with deps    = S.add fn acc.deps    }
-    | Copy (src, dst)
+        | Inr _  -> acc
-    | Copy_and_add_line_directive (src, dst)
+      let ( +<! ) acc fn =
-    | Symlink (src, dst) -> acc +<? src +@? dst
+        match (fn : Unexpanded.Partial.program) with
-    | Chdir (_, t)
+        | Inl (This fn) -> { acc with deps = S.add fn acc.deps }
-    | Setenv (_, _, t)
+        | Inl (Search _) | Inr _ -> acc
-    | Ignore (_, t) -> partial_with_all_targets acc t
+    end)
-    | Progn l -> List.fold_left l ~init:acc ~f:partial_with_all_targets
+
-    | Digest_files l -> List.fold_left l ~init:acc ~f:(+<?)
+  module Partial_with_all_targets = Make(Unexpanded.Partial.Past)(S)(Outcome)(struct
-    | Diff { optional; file1; file2 } ->
+      let ( +@ ) acc fn =
-      if optional then acc else acc +<? file1 +<? file2
+        match fn with
-    | Echo _
+        | Inl fn -> { acc with targets = S.add fn acc.targets }
-    | System _
+        | Inr sw -> Loc.fail (SW.loc sw) "Cannot determine this target statically."
-    | Bash _
+      let ( +< ) acc fn =
-    | Remove_tree _
+        match fn with
-    | Mkdir _ -> acc
+        | Inl fn -> { acc with deps    = S.add fn acc.deps    }
+        | Inr _  -> acc
+      let ( +<! ) acc fn =
+        match (fn : Unexpanded.Partial.program) with
+        | Inl (This fn) -> { acc with deps = S.add fn acc.deps }
+        | Inl (Search _) | Inr _ -> acc
+    end)
 
   let partial ~all_targets t =
-    let acc = { deps = S.empty; targets = S.empty } in
+    if all_targets then
-    let { deps; targets } =
+      Partial_with_all_targets.infer t
-      if all_targets then
+    else
-        partial_with_all_targets acc t
+      Partial.infer t
-      else
+
-        partial acc t
+  module S_unexp = struct
-    in
+    type t = String_with_vars.t list
-    { deps = S.diff deps targets; targets }
+    let empty = []
+    let diff a _ = a
+  end
+
+  module Outcome_unexp = struct
+    type t =
+      { deps    : S_unexp.t
+      ; targets : S_unexp.t
+      }
+  end
+
+  module Unexp = Make(Unexpanded.Uast)(S_unexp)(Outcome_unexp)(struct
+      open Outcome_unexp
+      let ( +@ ) acc fn = { acc with targets = fn :: acc.targets }
+      let ( +< ) acc _ = acc
+      let ( +<! )= ( +< )
+    end)
+
+  let unexpanded_targets t =
+    (Unexp.infer t).targets
 end

src/action.mli

@@ -126,6 +126,9 @@ module Infer : sig
 
   (** If [all_targets] is [true] and a target cannot be determined statically, fail *)
   val partial : all_targets:bool -> Unexpanded.Partial.t -> Outcome.t
+
+  (** Return the list of targets of an unexpanded action. *)
+  val unexpanded_targets : Unexpanded.t -> String_with_vars.t list
 end
 
 module Promotion : sig

src/build_interpret.ml

@@ -177,11 +177,19 @@ module Rule = struct
         List.iter l ~f:(fun target ->
           let path = Target.path target in
           if Path.parent path <> dir then
-            Sexp.code_error "rule has targets in different directories"
+            match loc with
-              [ "dir", Path.sexp_of_t dir
+            | None ->
-              ; "targets", Sexp.To_sexp.list Path.sexp_of_t
+              Sexp.code_error "rule has targets in different directories"
-                             (List.map (x :: l) ~f:Target.path)
+                [ "targets", Sexp.To_sexp.list Path.sexp_of_t
-              ]);
+                               (List.map targets ~f:Target.path)
+                ]
+            | Some loc ->
+              Loc.fail loc
+                "Rule has targets in different directories.\nTargets:\n%s"
+                (String.concat ~sep:"\n"
+                   (List.map targets ~f:(fun t ->
+                      sprintf "- %s"
+                        (Target.path t |> Path.to_string_maybe_quoted)))));
         dir
     in
     { context

src/gen_rules.ml

@@ -796,7 +796,7 @@ Add it to your jbuild file to remove this warning.
            action
            ~dir
            ~dep_kind:Required
-           ~targets:(Static [])
+           ~targets:Alias
            ~scope)
 
   (* +-----------------------------------------------------------------+

src/super_context.ml

@@ -442,6 +442,7 @@ module Action = struct
   type targets =
     | Static of Path.t list
     | Infer
+    | Alias
 
   type resolved_forms =
     { (* Failed resolutions *)
@@ -598,6 +599,7 @@ module Action = struct
           | "@" -> begin
               match targets_written_by_user with
               | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules."
+              | Alias -> Loc.fail loc "You cannot use ${@} in aliases."
               | Static l -> Some (Paths (l, Split))
             end
           | _ -> expand_var_no_root sctx var)
@@ -627,6 +629,14 @@ module Action = struct
   let run sctx t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
     : (Path.t list, Action.t) Build.t =
     let map_exe = map_exe sctx in
+    if targets_written_by_user = Alias then begin
+      match Action.Infer.unexpanded_targets t with
+      | [] -> ()
+      | x :: _ ->
+        let loc = String_with_vars.loc x in
+        Loc.warn loc "Aliases must not have targets, this target will be ignored.\n\
+                      This will become an error in the future.";
+    end;
     let t, forms =
       expand_step1 sctx t ~dir ~dep_kind ~scope
         ~targets_written_by_user ~map_exe
@@ -656,6 +666,11 @@ module Action = struct
            ]}
         *)
         { deps; targets = Pset.union targets targets_written_by_user }
+      | Alias ->
+        let { Action.Infer.Outcome. deps; targets = _ } =
+          Action.Infer.partial t ~all_targets:false
+        in
+        { deps; targets = Pset.empty }
     in
     let targets = Pset.elements targets in
     List.iter targets ~f:(fun target ->

src/super_context.mli

@@ -169,6 +169,7 @@ module Action : sig
   type targets =
     | Static of Path.t list
     | Infer
+    | Alias (** This action is for an alias *)
 
   (** The arrow takes as input the list of actual dependencies *)
   val run