Expand named variables in actions

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

src/inline_tests.ml

@@ -214,7 +214,7 @@ include Sub_system.Register_end_point(
             ~init:extra_vars
             ~f:(fun acc (k, v) -> String.Map.add acc k v)
         in
-        Build.return []
+        Build.return Named.empty
         >>>
         Build.all
           (List.filter_map backends ~f:(fun (backend : Backend.t) ->

src/jbuild.ml

@@ -234,15 +234,31 @@ end
 
 module Named = struct
   type 'a t =
-    { named: (Loc.t * 'a list) String.Map.t
+    { named: 'a list String.Map.t
     ; unnamed : 'a list
     }
 
+  let fold { named; unnamed } ~f ~init =
+    let flipped x acc = f acc x in
+    String.Map.fold named
+      ~f:(fun x init -> List.fold_left ~f:flipped ~init x)
+      ~init:(List.fold_left ~f:flipped ~init unnamed)
+
+  let first { named; unnamed } =
+    if String.Map.is_empty named then
+      match unnamed with
+      | [] -> Result.Error `Empty
+      | x :: _ -> Ok x
+    else
+      Result.Error `Named_exists
+
   let empty =
     { named = String.Map.empty
     ; unnamed = []
     }
 
+  let singleton x = { empty with unnamed = [x] }
+
   let t elem =
     let binding =
       peek_exn >>= function
@@ -262,17 +278,18 @@ module Named = struct
       let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in
       { unnamed = List.flatten unnamed
       ; named =
-          match String.Map.of_list named with
-          | Ok x -> x
-          | Error (name, (l1, _), (l2, _)) ->
-            of_sexp_errorf l1 "Variable %s is already defined in %s"
-              name (Loc.to_file_colon_line l2)
+          (match String.Map.of_list named with
+           | Ok x -> x
+           | Error (name, (l1, _), (l2, _)) ->
+             of_sexp_errorf l1 "Variable %s is already defined in %s"
+               name (Loc.to_file_colon_line l2))
+          |> String.Map.map ~f:snd
       })
 
   let sexp_of_t sexp_of_a { unnamed; named } =
     let unnamed = List.map ~f:sexp_of_a unnamed in
     let named =
-      String.Map.foldi ~init:[] named ~f:(fun n (_, d) acc ->
+      String.Map.foldi ~init:[] named ~f:(fun n d acc ->
         Sexp.unsafe_atom_of_string (":" ^ n) :: (List.map ~f:sexp_of_a d) @ acc)
     in
     Sexp.List (unnamed @ named)

src/jbuild.mli

@@ -83,12 +83,18 @@ end
 
 module Named : sig
   type 'a t =
-    { named : (Loc.t * 'a list) String.Map.t
+    { named : 'a list String.Map.t
     ; unnamed : 'a list
     }
 
   val empty : 'a t
 
+  val singleton : 'a -> 'a t
+
+  val first : 'a t -> ('a, [`Empty | `Named_exists]) Result.t
+
+  val fold : 'a t -> f:('a -> 'init -> 'init) -> init:'init -> 'init
+
   val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t
 end
 

src/preprocessing.ml

@@ -456,7 +456,7 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
                let src_path = Path.relative dir src.name in
                add_alias src.name
                  (Build.path src_path
-                  >>^ (fun _ -> [src_path])
+                  >>^ (fun _ -> Jbuild.Named.singleton src_path)
                   >>> SC.Action.run sctx
                         action
                         ~loc
@@ -531,7 +531,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
                (preprocessor_deps
                 >>>
                 Build.path src
-                >>^ (fun _ -> [src])
+                >>^ (fun _ -> Jbuild.Named.singleton src)
                 >>>
                 SC.Action.run sctx
                   (Redirect

src/super_context.ml

@@ -528,11 +528,20 @@ module Deps = struct
     >>^ List.concat
 
   let interpret_named t ~scope ~dir { Named.unnamed; named } =
-    String.Map.fold ~init:unnamed named ~f:(fun (_, ds) acc ->
-      List.rev_append ds acc)
-    |> List.map ~f:(dep t ~scope ~dir)
-    |> Build.all
-    >>^ List.concat
+    let deps l =
+      List.map ~f:(dep t ~scope ~dir) l
+      |> Build.all
+      >>^ List.concat
+    in
+    let unnamed = deps unnamed in
+    let named =
+      String.Map.to_list named
+      |> List.map ~f:(fun (k, d) -> deps d >>^ fun d -> (k, d))
+      |> Build.all
+      >>^ String.Map.of_list_exn
+    in
+    unnamed &&& named >>^ fun (unnamed, named) ->
+    { Named.unnamed; named }
 end
 
 module Pkg_version = struct
@@ -762,31 +771,47 @@ module Action = struct
     let t = U.partial_expand t ~dir ~map_exe ~f:expand in
     (t, acc)
 
-  let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
+  let expand_step2 ~dir ~dynamic_expansions
+        ~(deps_written_by_user : Path.t Jbuild.Named.t)
+        ~map_exe t =
     U.Partial.expand t ~dir ~map_exe ~f:(fun var syntax_version ->
       let key = String_with_vars.Var.full_name var in
       let loc = String_with_vars.Var.loc var in
       match String.Map.find dynamic_expansions key with
       | Some _ as opt -> opt
       | None ->
-        Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var
-        |> Option.map ~f:(function
-          | Pform.Var.Deps -> (Value.L.paths deps_written_by_user)
+        begin match
+          Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var
+        with
+        | None ->
+          String.Map.find deps_written_by_user.named key
+          |> Option.map ~f:Value.L.paths
+        | Some x ->
+          begin match x with
+            Pform.Var.Deps ->
+            deps_written_by_user
+            |> Jbuild.Named.fold ~init:[] ~f:List.cons
+            |> Value.L.paths
+            |> Option.some
           | First_dep ->
-            begin match deps_written_by_user with
-            | [] ->
+            begin match Jbuild.Named.first deps_written_by_user with
+            | Error `Named_exists ->
+              Loc.fail loc "%%{first-dep} is not allowed with named dependencies"
+            | Error `Empty ->
               Loc.warn loc "Variable '%s' used with no explicit \
                             dependencies@." key;
-              [Value.String ""]
-            | v :: _  -> [Path v]
+              Some [Value.String ""]
+            | Ok v  -> Some [Path v]
             end
           | _ ->
             Exn.code_error "Unexpected variable in step2"
-              ["var", String_with_vars.Var.sexp_of_t var]))
+              ["var", String_with_vars.Var.sexp_of_t var]
+          end
+        end)
 
   let run sctx ~loc ?(extra_vars=String.Map.empty)
         t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
-    : (Path.t list, Action.t) Build.t =
+    : (Path.t Named.t, 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

src/super_context.mli

@@ -225,7 +225,7 @@ module Deps : sig
     -> scope:Scope.t
     -> dir:Path.t
     -> Dep_conf.t Named.t
-    -> (unit, Path.t list) Build.t
+    -> (unit, Path.t Named.t) Build.t
 end
 
 (** Interpret action written in jbuild files *)
@@ -245,7 +245,7 @@ module Action : sig
     -> dep_kind:Build.lib_dep_kind
     -> targets:targets
     -> scope:Scope.t
-    -> (Path.t list, Action.t) Build.t
+    -> (Path.t Named.t, Action.t) Build.t
 end
 
 module Pkg_version : sig