Allow to use ${^} in actions in conjunction with (glob_files ...) and (file_recursively_in ...)

src/build.ml

@@ -33,7 +33,7 @@ module Repr = struct
     | Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
     | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
     | Paths : Pset.t -> ('a, 'a) t
-    | Paths_glob : Path.t * Re.re -> ('a, 'a) t
+    | Paths_glob : glob_state ref -> ('a, Path.t list) t
     (* The reference gets decided in Build_interpret.deps *)
     | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
@@ -59,10 +59,19 @@ module Repr = struct
     | Undecided of ('a, 'b) t * ('a, 'b) t
     | Decided   of bool * ('a, 'b) t
 
+  and glob_state =
+    | G_unevaluated of Path.t * Re.re
+    | G_evaluated   of Path.t list
+
   let get_if_file_exists_exn state =
     match !state with
     | Decided (_, t) -> t
     | Undecided _ -> code_errorf "Build.get_if_file_exists_exn: got undecided"
+
+  let get_glob_result_exn state =
+    match !state with
+    | G_evaluated l -> l
+    | G_unevaluated _ -> code_errorf "Build.get_glob_result_exn: got unevaluated"
 end
 include Repr
 let repr t = t
@@ -124,7 +133,7 @@ let rec all = function
 let path p = Paths (Pset.singleton p)
 let paths ps = Paths (Pset.of_list ps)
 let path_set ps = Paths ps
-let paths_glob ~dir re = Paths_glob (dir, re)
+let paths_glob ~dir re = Paths_glob (ref (G_unevaluated (dir, re)))
 let vpath vp = Vpath vp
 let dyn_paths t = Dyn_paths t
 
@@ -170,7 +179,8 @@ let files_recursively_in ~dir ~file_tree =
     | None -> (Path.root, dir)
     | Some (ctx_dir, src_dir) -> (ctx_dir, src_dir)
   in
-  path_set (File_tree.files_recursively_in file_tree dir ~prefix_with)
+  let paths = File_tree.files_recursively_in file_tree dir ~prefix_with in
+  path_set paths >>^ fun _ -> paths
 
 let store_vfile spec = Store_vfile spec
 

src/build.mli

@@ -36,8 +36,8 @@ val all : ('a, 'b) t list -> ('a, 'b list) t
 val path  : Path.t      -> ('a, 'a) t
 val paths : Path.t list -> ('a, 'a) t
 val path_set : Path.Set.t -> ('a, 'a) t
-val paths_glob : dir:Path.t -> Re.re -> ('a, 'a) t
-val files_recursively_in : dir:Path.t -> file_tree:File_tree.t -> ('a, 'a) t
+val paths_glob : dir:Path.t -> Re.re -> ('a, Path.t list) t
+val files_recursively_in : dir:Path.t -> file_tree:File_tree.t -> ('a, Path.Set.t) t
 val vpath : 'a Vspec.t  -> (unit, 'a) t
 
 val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
@@ -143,7 +143,7 @@ module Repr : sig
     | Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
     | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
     | Paths : Path.Set.t -> ('a, 'a) t
-    | Paths_glob : Path.t * Re.re -> ('a, 'a) t
+    | Paths_glob : glob_state ref -> ('a, Path.t list) t
     | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
     | Lines_of : Path.t -> ('a, string list) t
@@ -168,7 +168,12 @@ module Repr : sig
     | Undecided of ('a, 'b) t * ('a, 'b) t
     | Decided   of bool * ('a, 'b) t
 
+  and glob_state =
+    | G_unevaluated of Path.t * Re.re
+    | G_evaluated   of Path.t list
+
   val get_if_file_exists_exn : ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
+  val get_glob_result_exn : glob_state ref -> Path.t list
 end
 
 val repr : ('a, 'b) t -> ('a, 'b) Repr.t

src/build_interpret.ml

@@ -38,16 +38,21 @@ let static_deps t ~all_targets_by_dir =
     | Split (a, b) -> loop a (loop b acc)
     | Fanout (a, b) -> loop a (loop b acc)
     | Paths fns -> { acc with action_deps = Pset.union fns acc.action_deps }
-    | Paths_glob (dir, re) -> begin
-        match Pmap.find dir (Lazy.force all_targets_by_dir) with
-        | None -> acc
-        | Some targets ->
-          let action_deps =
-            Pset.filter targets ~f:(fun path ->
-              Re.execp re (Path.basename path))
-            |> Pset.union acc.action_deps
-          in
-          { acc with action_deps }
+    | Paths_glob state -> begin
+        match !state with
+        | G_evaluated l ->
+          { acc with action_deps = Pset.union acc.action_deps (Pset.of_list l) }
+        | G_unevaluated (dir, re) ->
+          match Pmap.find dir (Lazy.force all_targets_by_dir) with
+          | None -> acc
+          | Some targets ->
+            let result =
+              Pset.filter targets ~f:(fun path ->
+                Re.execp re (Path.basename path))
+            in
+            state := G_evaluated (Pset.elements result);
+            let action_deps = Pset.union result acc.action_deps in
+            { acc with action_deps }
       end
     | If_file_exists (p, state) -> begin
         match !state with

src/build_system.ml

@@ -290,7 +290,7 @@ module Build_exec = struct
         let b = exec dyn_deps b x in
         (a, b)
       | Paths _ -> x
-      | Paths_glob _ -> x
+      | Paths_glob state -> get_glob_result_exn state
       | Contents p -> Io.read_file (Path.to_string p)
       | Lines_of p -> Io.lines_of_file (Path.to_string p)
       | Vpath (Vspec.T (fn, kind)) ->

src/gen_rules.ml

@@ -491,7 +491,6 @@ module Gen(P : Params) = struct
          ~dir
          ~dep_kind:Required
          ~targets
-         ~deps:(SC.Deps.only_plain_files sctx ~dir rule.deps)
          ~package_context)
 
   let alias_rules (alias_conf : Alias_conf.t) ~dir ~package_context =
@@ -527,7 +526,6 @@ module Gen(P : Params) = struct
                ~dir
                ~dep_kind:Required
                ~targets:[]
-               ~deps:(SC.Deps.only_plain_files sctx ~dir alias_conf.deps)
                ~package_context
            ; Build.create_file digest_path
            ])

src/super_context.ml

@@ -396,8 +396,14 @@ module Deps = struct
   open Dep_conf
 
   let dep t ~dir = function
-    | File  s -> Build.path (Path.relative dir (expand_vars t ~dir s))
-    | Alias s -> Build.path (Alias.file (Alias.make ~dir (expand_vars t ~dir s)))
+    | File  s ->
+      let path = Path.relative dir (expand_vars t ~dir s) in
+      Build.path path
+      >>^ fun _ -> [path]
+    | Alias s ->
+      let path = Alias.file (Alias.make ~dir (expand_vars t ~dir s)) in
+      Build.path path
+      >>^ fun _ -> []
     | Glob_files s -> begin
         let path = Path.relative dir (expand_vars t ~dir s) in
         let dir = Path.parent path in
@@ -411,22 +417,11 @@ 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
 
   let interpret t ~dir l =
-    let rec loop acc = function
-      | [] -> acc
-      | d :: l ->
-        loop (acc >>> dep t ~dir d) l
-    in
-    loop (Build.return ()) l
-
-  let only_plain_file t ~dir = function
-    | File s -> Some (Path.relative dir (expand_vars t ~dir s))
-    | Alias _ -> None
-    | Glob_files _ -> None
-    | Files_recursively_in _ -> None
-
-  let only_plain_files t ~dir l = List.map l ~f:(only_plain_file t ~dir)
+    Build.all (List.map l ~f:(dep t ~dir))
+    >>^ List.concat
 end
 
 module Pkg_version = struct
@@ -550,28 +545,26 @@ module Action = struct
       | _ -> acc)
 
   let expand_var =
-    let dep_exn name = function
-      | Some dep -> dep
-      | None -> die "cannot use ${%s} with files_recursively_in" name
-    in
     fun sctx ~artifacts ~targets ~deps var_name ->
       match String_map.find var_name artifacts with
       | Some exp -> exp
       | None ->
         match var_name with
         | "@" -> Action.Paths targets
-        | "<" -> (match deps with
-          | []        -> Str ""
-          | dep1 :: _ -> Path (dep_exn var_name dep1))
+        | "<" ->
+          (match deps with
+           | []       -> Str "" (* CR-someday jdimino: this should be an error *)
+           | dep :: _ -> Path dep)
         | "^" ->
-          Paths (List.map deps ~f:(dep_exn var_name))
+          Paths deps
         | "ROOT" -> Path sctx.context.build_dir
         | var ->
           match expand_var_no_root sctx var with
           | Some s -> Str s
           | None -> Not_found
 
-  let run sctx t ~dir ~dep_kind ~targets ~deps ~package_context =
+  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 build =
       Build.record_lib_deps_simple ~dir forms.lib_deps
@@ -584,9 +577,11 @@ module Action = struct
              | Paths ps -> Path.Set.union acc (Path.Set.of_list ps)
              | Not_found | Str _ -> acc))
       >>>
+      Build.arr (fun paths -> ((), paths))
+      >>>
       let vdeps = String_map.bindings forms.vdeps in
-      Build.all (List.map vdeps ~f:snd)
-      >>^ (fun vals ->
+      Build.first (Build.all (List.map vdeps ~f:snd))
+      >>^ (fun (vals, deps) ->
         let artifacts =
           List.fold_left2 vdeps vals ~init:forms.artifacts ~f:(fun acc (var, _) value ->
             String_map.add acc ~key:var ~data:value)
@@ -753,7 +748,10 @@ module PP = struct
      point to the .pp files *)
   let pped_modules sctx ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name
         ~package_context =
-    let preprocessor_deps = Deps.interpret sctx ~dir preprocessor_deps in
+    let preprocessor_deps =
+      Build.memoize "preprocessor deps"
+        (Deps.interpret sctx ~dir preprocessor_deps)
+    in
     String_map.map modules ~f:(fun (m : Module.t) ->
       let m = setup_reason_rules sctx ~dir m in
       match Preprocess_map.find m.name preprocess with
@@ -774,7 +772,6 @@ module PP = struct
                ~dir
                ~dep_kind
                ~targets:[dst]
-               ~deps:[Some src]
                ~package_context))
       | Pps { pps; flags } ->
         let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in

src/super_context.mli

@@ -115,11 +115,8 @@ end
 
 (** Interpret dependencies written in jbuild files *)
 module Deps : sig
-  val interpret : t -> dir:Path.t -> Dep_conf.t list -> (unit, unit) Build.t
-
-  (** Interpret plain dependencies, replacing other (glob_files, files_recursively_in,
-      ...) by None *)
-  val only_plain_files : t -> dir:Path.t -> Dep_conf.t list -> Path.t option list
+  (** Evaluates to the actual list of dependencies, ignoring aliases *)
+  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 *)
@@ -133,15 +130,15 @@ end
 
 (** Interpret action written in jbuild files *)
 module Action : sig
+  (** 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
-    -> deps:Path.t option list
     -> package_context:Pkgs.t
-    -> (unit, Action.t) Build.t
+    -> (Path.t list, Action.t) Build.t
 end
 
 (** Preprocessing stuff *)

test/jbuild

@@ -11,6 +11,13 @@
    (chdir workspaces/redirections
     (run ${exe:run.exe} -- ${bin:jbuilder} runtest -j1 --root .)))))
 
+(alias
+ ((name runtest)
+  (deps ((files_recursively_in workspaces/globs)))
+  (action
+   (chdir workspaces/globs
+    (run ${exe:run.exe} -- ${bin:jbuilder} runtest -j1 --root .)))))
+
 (alias
  ((name runtest)
   (deps ((files_recursively_in workspaces/github20)))

test/workspaces/globs/jbuild

@@ -0,0 +1,24 @@
+;; Test for ${^} with globs in rules
+(rule
+ ((targets (result expected))
+  (deps    (jbuild (glob_files *.txt)))
+  (action  (progn
+            (with-stdout-to result   (echo ${^}))
+            (with-stdout-to expected (echo "jbuild a.txt b.txt c.txt"))))))
+
+(rule
+ ((targets (result2 expected2))
+  (deps    ((files_recursively_in sub-tree)))
+  (action  (progn
+            (with-stdout-to result2   (echo ${^}))
+            (with-stdout-to expected2 (echo "sub-tree/a sub-tree/dir/b"))))))
+
+(alias
+ ((name   runtest)
+  (deps   (result expected))
+  (action (run diff -u result expected))))
+
+(alias
+ ((name   runtest)
+  (deps   (result2 expected2))
+  (action (run diff -u result2 expected2))))