Generalize named bindings to Jbuild.Named.t

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

src/gen_rules.ml

@@ -187,7 +187,7 @@ module Gen(P : Install_rules.Params) = struct
     in
     SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
       ~locks:(interpret_locks ~dir ~scope rule.locks)
-      (SC.Deps.interpret_bindings sctx ~scope ~dir rule.deps
+      (SC.Deps.interpret_named sctx ~scope ~dir rule.deps
        >>>
        SC.Action.run
          sctx
@@ -929,7 +929,7 @@ module Gen(P : Install_rules.Params) = struct
       let module S = Sexp.To_sexp in
       Sexp.List
         [ Sexp.unsafe_atom_of_string "user-alias"
-        ; Jbuild.Dep_conf.sexp_of_bindings alias_conf.deps
+        ; Jbuild.Named.sexp_of_t Jbuild.Dep_conf.sexp_of_t alias_conf.deps
         ; S.option Action.Unexpanded.sexp_of_t
             (Option.map alias_conf.action ~f:snd)
         ]
@@ -939,7 +939,7 @@ module Gen(P : Install_rules.Params) = struct
       ~name:alias_conf.name
       ~stamp
       ~locks:(interpret_locks ~dir ~scope alias_conf.locks)
-      (SC.Deps.interpret_bindings sctx ~scope ~dir alias_conf.deps
+      (SC.Deps.interpret_named sctx ~scope ~dir alias_conf.deps
        >>>
        match alias_conf.action with
        | None -> Build.progn []

src/jbuild.ml

@@ -232,6 +232,52 @@ module Pps_and_flags = struct
       Dune_syntax.t
 end
 
+module Named = struct
+  type 'a t =
+    { named: (Loc.t * 'a list) String.Map.t
+    ; unnamed : 'a list
+    }
+
+  let empty =
+    { named = String.Map.empty
+    ; unnamed = []
+    }
+
+  let t elem =
+    let binding =
+      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 _ ->
+            elem >>| fun elem ->
+            Left (name, (loc, elem))
+        end
+      | _ ->
+        elem >>| fun elem -> Right elem
+    in
+    list binding >>| (fun bindings ->
+      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)
+      })
+
+  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 ->
+        Sexp.unsafe_atom_of_string (":" ^ n) :: (List.map ~f:sexp_of_a d) @ acc)
+    in
+    Sexp.List (unnamed @ named)
+end
+
 module Dep_conf = struct
   type t =
     | File of String_with_vars.t
@@ -242,16 +288,6 @@ module Dep_conf = struct
     | Package of String_with_vars.t
     | Universe
 
-  type bindings =
-    { named : (Loc.t * t list) String.Map.t
-    ; unnamed : t list
-    }
-
-  let empty_bindings =
-    { named = String.Map.empty
-    ; unnamed = []
-    }
-
   let dep_cons =
     let sw = String_with_vars.t in
     [ "file"       , (sw >>| fun x -> File x)
@@ -285,30 +321,7 @@ module Dep_conf = struct
         :: List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton))
         |> sum)
     in
-    let binding =
-      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 ->
-            Left (name, (loc, deps))
-        end
-      | _ ->
-        dep >>| fun dep -> Right dep
-    in
-    list binding >>| (fun bindings ->
-      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)
-      })
+    Named.t dep
 
   open Sexp
   let sexp_of_t = function
@@ -330,14 +343,6 @@ module Dep_conf = struct
             String_with_vars.sexp_of_t t]
     | Universe ->
       Sexp.unsafe_atom_of_string "universe"
-
-  let sexp_of_bindings { unnamed; named } =
-    let unnamed = List.map ~f:sexp_of_t unnamed in
-    let named =
-      String.Map.foldi ~init:[] named ~f:(fun n (_, d) acc ->
-        Sexp.unsafe_atom_of_string (":" ^ n) :: (List.map ~f:sexp_of_t d) @ acc)
-    in
-    List (unnamed @ named)
 end
 
 module Preprocess = struct
@@ -1123,7 +1128,7 @@ module Rule = struct
 
   type t =
     { targets  : Targets.t
-    ; deps     : Dep_conf.bindings
+    ; deps     : Dep_conf.t Named.t
     ; action   : Loc.t * Action.Unexpanded.t
     ; mode     : Mode.t
     ; locks    : String_with_vars.t list
@@ -1165,7 +1170,7 @@ module Rule = struct
   let short_form =
     located Action.Unexpanded.t >>| fun (loc, action) ->
     { targets  = Infer
-    ; deps     = Dep_conf.empty_bindings
+    ; deps     = Named.empty
     ; action   = (loc, action)
     ; mode     = Standard
     ; locks    = []
@@ -1178,7 +1183,7 @@ module Rule = struct
     >>= fun action ->
     field "targets" (list file_in_current_dir)
     >>= fun targets ->
-    field "deps" (Dep_conf.bindings) ~default:Dep_conf.empty_bindings
+    field "deps" Dep_conf.bindings ~default:Named.empty
     >>= fun deps ->
     field "locks"   (list String_with_vars.t) ~default:[] >>= fun locks ->
     map_validate
@@ -1284,7 +1289,7 @@ module Rule = struct
       let src = name ^ ".mll" in
       let dst = name ^ ".ml"  in
       { targets = Static [dst]
-      ; deps    = { Dep_conf.empty_bindings with
+      ; deps    = { Named.empty with
                     unnamed = [File (S.virt_text __POS__ src)]
                   }
       ; action  =
@@ -1308,7 +1313,7 @@ module Rule = struct
       let src = name ^ ".mly" in
       { targets = Static [name ^ ".ml"; name ^ ".mli"]
       ; deps    =
-          { Dep_conf.empty_bindings with
+          { Named.empty with
             unnamed = [File (S.virt_text __POS__ src)]
           }
       ; action  =
@@ -1378,7 +1383,7 @@ end
 module Alias_conf = struct
   type t =
     { name    : string
-    ; deps    : Dep_conf.bindings
+    ; deps    : Dep_conf.t Named.t
     ; action  : (Loc.t * Action.Unexpanded.t) option
     ; locks   : String_with_vars.t list
     ; package : Package.t option
@@ -1397,7 +1402,7 @@ module Alias_conf = struct
        field_o "package" Pkg.t                          >>= fun package ->
        field_o "action" (located Action.Unexpanded.t)   >>= fun action ->
        field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
-       field "deps" Dep_conf.bindings ~default:Dep_conf.empty_bindings
+       field "deps" Dep_conf.bindings ~default:Named.empty
        >>= fun deps ->
        return
          { name

src/jbuild.mli

@@ -81,6 +81,15 @@ module Lib_deps : sig
   val of_pps : Pp.t list -> t
 end
 
+module Named : sig
+  type 'a t =
+    { named : (Loc.t * 'a list) String.Map.t
+    ; unnamed : 'a list
+    }
+
+  val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t
+end
+
 module Dep_conf : sig
   type t =
     | File of String_with_vars.t
@@ -91,16 +100,8 @@ module Dep_conf : sig
     | Package of String_with_vars.t
     | Universe
 
-  type bindings =
-    { named: (Loc.t * t list) String.Map.t
-    ; unnamed : t list
-    }
-
-  val bindings : bindings Sexp.Of_sexp.t
-
   val t : t Sexp.Of_sexp.t
   val sexp_of_t : t -> Sexp.t
-  val sexp_of_bindings : bindings -> Sexp.t
 end
 
 module Buildable : sig
@@ -292,7 +293,7 @@ module Rule : sig
 
   type t =
     { targets  : Targets.t
-    ; deps     : Dep_conf.bindings
+    ; deps     : Dep_conf.t Named.t
     ; action   : Loc.t * Action.Unexpanded.t
     ; mode     : Mode.t
     ; locks    : String_with_vars.t list
@@ -315,7 +316,7 @@ end
 module Alias_conf : sig
   type t =
     { name    : string
-    ; deps    : Dep_conf.bindings
+    ; deps    : Dep_conf.t Named.t
     ; action  : (Loc.t * Action.Unexpanded.t) option
     ; locks   : String_with_vars.t list
     ; package : Package.t option

src/super_context.ml

@@ -527,7 +527,7 @@ module Deps = struct
     |> Build.all
     >>^ List.concat
 
-  let interpret_bindings t ~scope ~dir { unnamed; named } =
+  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)

src/super_context.mli

@@ -220,11 +220,11 @@ module Deps : sig
     -> Dep_conf.t list
     -> (unit, Path.t list) Build.t
 
-  val interpret_bindings
+  val interpret_named
     :  t
     -> scope:Scope.t
     -> dir:Path.t
-    -> Dep_conf.bindings
+    -> Dep_conf.t Named.t
     -> (unit, Path.t list) Build.t
 end