Add syntax for binding dependencies to names

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/jbuild.ml

@@ -233,7 +233,7 @@ module Pps_and_flags = struct
 end
 
 module Dep_conf = struct
-  type t =
+  type dep =
     | File of String_with_vars.t
     | Alias of String_with_vars.t
     | Alias_rec of String_with_vars.t
@@ -241,38 +241,59 @@ module Dep_conf = struct
     | Source_tree of String_with_vars.t
     | Package of String_with_vars.t
     | Universe
-    | List of t list
 
-  let t =
-    let t =
-      let sw = String_with_vars.t in
-      fix (fun t ->
-        sum
-          [ "file"       , (sw >>| fun x -> File x)
-          ; "alias"      , (sw >>| fun x -> Alias x)
-          ; "alias_rec"  , (sw >>| fun x -> Alias_rec x)
-          ; "glob_files" , (sw >>| fun x -> Glob_files x)
-          ; "package"    , (sw >>| fun x -> Package x)
-          ; "universe"   , return Universe
-          ; "files_recursively_in",
-            (Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree"
-             >>= fun () ->
-             sw >>| fun x -> Source_tree x)
-          ; "source_tree",
-            (Syntax.since Stanza.syntax (1, 0) >>= fun () ->
-             sw >>| fun x -> Source_tree x)
-          ; "list",
-            (Syntax.since Stanza.syntax (1, 0) >>= fun () ->
-             (repeat t) >>| fun x -> List x)
-          ])
-    in
+  type t =
+    | Unnamed of dep list
+    | Named of string * dep list
+
+  let dep_cons =
+    let sw = String_with_vars.t in
+    [ "file"       , (sw >>| fun x -> File x)
+    ; "alias"      , (sw >>| fun x -> Alias x)
+    ; "alias_rec"  , (sw >>| fun x -> Alias_rec x)
+    ; "glob_files" , (sw >>| fun x -> Glob_files x)
+    ; "package"    , (sw >>| fun x -> Package x)
+    ; "universe"   , return Universe
+    ; "files_recursively_in",
+      (Syntax.renamed_in Stanza.syntax (1, 0) ~to_:"source_tree"
+       >>= fun () ->
+       sw >>| fun x -> Source_tree x)
+    ; "source_tree",
+      (Syntax.since Stanza.syntax (1, 0) >>= fun () ->
+       sw >>| fun x -> Source_tree x)
+    ]
+
+  let make_dep_parser ~single ~many =
     peek_exn >>= function
     | Template _ | Atom _ | Quoted_string _ ->
-      String_with_vars.t >>| fun x -> File x
-    | List _ -> t
+      String_with_vars.t >>| fun x -> single (File x)
+    | List _ -> many
+
+  let dep =
+    let dep =
+      let dep_no_list =
+        make_dep_parser ~single:(fun x -> x) ~many:(sum dep_cons) in
+      sum (("list", repeat dep_no_list)
+           :: (List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton))))
+    in
+    make_dep_parser ~single:List.singleton ~many:dep
+
+  let t =
+    peek_exn >>= function
+    | Atom (loc, A s) when String.length s > 1 && s.[0] = ':' ->
+      begin
+        string >>= fun name ->
+        peek >>= function
+        | None -> of_sexp_errorf loc "Naked binding %s" s
+        | Some _ -> dep
+          >>| fun deps ->
+          Named (name, deps)
+      end
+    | _ ->
+      dep >>| fun dep -> Unnamed dep
 
   open Sexp
-  let rec sexp_of_t = function
+  let sexp_of_dep = function
     | File t ->
        List [Sexp.unsafe_atom_of_string "file" ; String_with_vars.sexp_of_t t]
     | Alias t ->
@@ -291,9 +312,12 @@ module Dep_conf = struct
             String_with_vars.sexp_of_t t]
     | Universe ->
       Sexp.unsafe_atom_of_string "universe"
-    | List ts ->
-      List (Sexp.unsafe_atom_of_string "list"
-            :: (List.map ~f:sexp_of_t ts))
+
+  let sexp_of_t =
+    let open Sexp.To_sexp in
+    function
+    | Unnamed dep -> (list sexp_of_dep) dep
+    | Named (name, dep) -> List [Sexp.atom name; (list sexp_of_dep) dep]
 end
 
 module Preprocess = struct
@@ -1239,7 +1263,7 @@ module Rule = struct
       let src = name ^ ".mll" in
       let dst = name ^ ".ml"  in
       { targets = Static [dst]
-      ; deps    = [File (S.virt_text __POS__ src)]
+      ; deps    = [Unnamed [File (S.virt_text __POS__ src)]]
       ; action  =
           (loc,
            Chdir
@@ -1260,7 +1284,7 @@ module Rule = struct
     List.map modules ~f:(fun name ->
       let src = name ^ ".mly" in
       { targets = Static [name ^ ".ml"; name ^ ".mli"]
-      ; deps    = [File (S.virt_text __POS__ src)]
+      ; deps    = [Unnamed [File (S.virt_text __POS__ src)]]
       ; action  =
           (loc,
            Chdir

src/jbuild.mli

@@ -82,7 +82,7 @@ module Lib_deps : sig
 end
 
 module Dep_conf : sig
-  type t =
+  type dep =
     | File of String_with_vars.t
     | Alias of String_with_vars.t
     | Alias_rec of String_with_vars.t
@@ -90,7 +90,10 @@ module Dep_conf : sig
     | Source_tree of String_with_vars.t
     | Package of String_with_vars.t
     | Universe
-    | List of t list
+
+  type t =
+    | Unnamed of dep list
+    | Named of string * dep list
 
   val t : t Sexp.Of_sexp.t
   val sexp_of_t : t -> Sexp.t

src/super_context.ml

@@ -487,7 +487,7 @@ module Deps = struct
     let loc = String_with_vars.loc s in
     Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s))
 
-  let rec dep t ~scope ~dir = function
+  let dep t ~scope ~dir = function
     | File  s ->
       let path = expand_vars_path t ~scope ~dir s in
       Build.path path
@@ -521,12 +521,12 @@ module Deps = struct
     | Universe ->
       Build.path Build_system.universe_file
       >>^ fun () -> []
-    | List ts ->
-      Build.all (List.map ~f:(dep t ~scope ~dir) ts)
-      >>^ List.concat
 
   let interpret t ~scope ~dir l =
-    Build.all (List.map l ~f:(dep t ~scope ~dir))
+    List.concat_map l ~f:(function
+      | Unnamed d
+      | Named (_, d) -> List.map ~f:(dep t ~scope ~dir) d)
+    |> Build.all
     >>^ List.concat
 end
 

test/blackbox-tests/dune.inc

@@ -80,6 +80,14 @@
    test-cases/custom-build-dir
    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
+(alias
+ (name dep-vars)
+ (deps (package dune) (source_tree test-cases/dep-vars))
+ (action
+  (chdir
+   test-cases/dep-vars
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+
 (alias
  (name depend-on-the-universe)
  (deps (package dune) (source_tree test-cases/depend-on-the-universe))
@@ -680,6 +688,7 @@
   (alias copy_files)
   (alias cross-compilation)
   (alias custom-build-dir)
+  (alias dep-vars)
   (alias depend-on-the-universe)
   (alias dune-jbuild-var-case)
   (alias dune-ppx-driver-system)
@@ -762,6 +771,7 @@
   (alias copy_files)
   (alias cross-compilation)
   (alias custom-build-dir)
+  (alias dep-vars)
   (alias depend-on-the-universe)
   (alias dune-jbuild-var-case)
   (alias dune-ppx-driver-system)

test/blackbox-tests/test-cases/dep-vars/dune

@@ -0,0 +1,5 @@
+
+(rule
+ (deps :foo (list a b) :baz foo (list (alias test)) (list a b c))
+ (targets bar)
+ (action (with-stdout-to bar (echo "foo"))))

test/blackbox-tests/test-cases/dep-vars/dune-project

@@ -0,0 +1 @@
+(lang dune 1.0)

test/blackbox-tests/test-cases/dep-vars/run.t

@@ -0,0 +1,3 @@
+Dependencies are allowed :patterns
+
+  $ dune build