Generalize named bindings to Jbuild.Named.t
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
b9be63f4b7
commit
f121a1546e
|
@ -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 []
|
||||
|
|
103
src/jbuild.ml
103
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in New Issue