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
|
in
|
||||||
SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
|
SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc
|
||||||
~locks:(interpret_locks ~dir ~scope rule.locks)
|
~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
|
SC.Action.run
|
||||||
sctx
|
sctx
|
||||||
|
@ -929,7 +929,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
let module S = Sexp.To_sexp in
|
let module S = Sexp.To_sexp in
|
||||||
Sexp.List
|
Sexp.List
|
||||||
[ Sexp.unsafe_atom_of_string "user-alias"
|
[ 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
|
; S.option Action.Unexpanded.sexp_of_t
|
||||||
(Option.map alias_conf.action ~f:snd)
|
(Option.map alias_conf.action ~f:snd)
|
||||||
]
|
]
|
||||||
|
@ -939,7 +939,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
~name:alias_conf.name
|
~name:alias_conf.name
|
||||||
~stamp
|
~stamp
|
||||||
~locks:(interpret_locks ~dir ~scope alias_conf.locks)
|
~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
|
match alias_conf.action with
|
||||||
| None -> Build.progn []
|
| None -> Build.progn []
|
||||||
|
|
103
src/jbuild.ml
103
src/jbuild.ml
|
@ -232,6 +232,52 @@ module Pps_and_flags = struct
|
||||||
Dune_syntax.t
|
Dune_syntax.t
|
||||||
end
|
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
|
module Dep_conf = struct
|
||||||
type t =
|
type t =
|
||||||
| File of String_with_vars.t
|
| File of String_with_vars.t
|
||||||
|
@ -242,16 +288,6 @@ module Dep_conf = struct
|
||||||
| Package of String_with_vars.t
|
| Package of String_with_vars.t
|
||||||
| Universe
|
| 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 dep_cons =
|
||||||
let sw = String_with_vars.t in
|
let sw = String_with_vars.t in
|
||||||
[ "file" , (sw >>| fun x -> File x)
|
[ "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))
|
:: List.map dep_cons ~f:(fun (n, d) -> (n, d >>| List.singleton))
|
||||||
|> sum)
|
|> sum)
|
||||||
in
|
in
|
||||||
let binding =
|
Named.t dep
|
||||||
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)
|
|
||||||
})
|
|
||||||
|
|
||||||
open Sexp
|
open Sexp
|
||||||
let sexp_of_t = function
|
let sexp_of_t = function
|
||||||
|
@ -330,14 +343,6 @@ module Dep_conf = struct
|
||||||
String_with_vars.sexp_of_t t]
|
String_with_vars.sexp_of_t t]
|
||||||
| Universe ->
|
| Universe ->
|
||||||
Sexp.unsafe_atom_of_string "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
|
end
|
||||||
|
|
||||||
module Preprocess = struct
|
module Preprocess = struct
|
||||||
|
@ -1123,7 +1128,7 @@ module Rule = struct
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ targets : Targets.t
|
{ targets : Targets.t
|
||||||
; deps : Dep_conf.bindings
|
; deps : Dep_conf.t Named.t
|
||||||
; action : Loc.t * Action.Unexpanded.t
|
; action : Loc.t * Action.Unexpanded.t
|
||||||
; mode : Mode.t
|
; mode : Mode.t
|
||||||
; locks : String_with_vars.t list
|
; locks : String_with_vars.t list
|
||||||
|
@ -1165,7 +1170,7 @@ module Rule = struct
|
||||||
let short_form =
|
let short_form =
|
||||||
located Action.Unexpanded.t >>| fun (loc, action) ->
|
located Action.Unexpanded.t >>| fun (loc, action) ->
|
||||||
{ targets = Infer
|
{ targets = Infer
|
||||||
; deps = Dep_conf.empty_bindings
|
; deps = Named.empty
|
||||||
; action = (loc, action)
|
; action = (loc, action)
|
||||||
; mode = Standard
|
; mode = Standard
|
||||||
; locks = []
|
; locks = []
|
||||||
|
@ -1178,7 +1183,7 @@ module Rule = struct
|
||||||
>>= fun action ->
|
>>= fun action ->
|
||||||
field "targets" (list file_in_current_dir)
|
field "targets" (list file_in_current_dir)
|
||||||
>>= fun targets ->
|
>>= fun targets ->
|
||||||
field "deps" (Dep_conf.bindings) ~default:Dep_conf.empty_bindings
|
field "deps" Dep_conf.bindings ~default:Named.empty
|
||||||
>>= fun deps ->
|
>>= fun deps ->
|
||||||
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
||||||
map_validate
|
map_validate
|
||||||
|
@ -1284,7 +1289,7 @@ module Rule = struct
|
||||||
let src = name ^ ".mll" in
|
let src = name ^ ".mll" in
|
||||||
let dst = name ^ ".ml" in
|
let dst = name ^ ".ml" in
|
||||||
{ targets = Static [dst]
|
{ targets = Static [dst]
|
||||||
; deps = { Dep_conf.empty_bindings with
|
; deps = { Named.empty with
|
||||||
unnamed = [File (S.virt_text __POS__ src)]
|
unnamed = [File (S.virt_text __POS__ src)]
|
||||||
}
|
}
|
||||||
; action =
|
; action =
|
||||||
|
@ -1308,7 +1313,7 @@ module Rule = struct
|
||||||
let src = name ^ ".mly" in
|
let src = name ^ ".mly" in
|
||||||
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
|
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
|
||||||
; deps =
|
; deps =
|
||||||
{ Dep_conf.empty_bindings with
|
{ Named.empty with
|
||||||
unnamed = [File (S.virt_text __POS__ src)]
|
unnamed = [File (S.virt_text __POS__ src)]
|
||||||
}
|
}
|
||||||
; action =
|
; action =
|
||||||
|
@ -1378,7 +1383,7 @@ end
|
||||||
module Alias_conf = struct
|
module Alias_conf = struct
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ name : string
|
||||||
; deps : Dep_conf.bindings
|
; deps : Dep_conf.t Named.t
|
||||||
; action : (Loc.t * Action.Unexpanded.t) option
|
; action : (Loc.t * Action.Unexpanded.t) option
|
||||||
; locks : String_with_vars.t list
|
; locks : String_with_vars.t list
|
||||||
; package : Package.t option
|
; package : Package.t option
|
||||||
|
@ -1397,7 +1402,7 @@ module Alias_conf = struct
|
||||||
field_o "package" Pkg.t >>= fun package ->
|
field_o "package" Pkg.t >>= fun package ->
|
||||||
field_o "action" (located Action.Unexpanded.t) >>= fun action ->
|
field_o "action" (located Action.Unexpanded.t) >>= fun action ->
|
||||||
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
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 ->
|
>>= fun deps ->
|
||||||
return
|
return
|
||||||
{ name
|
{ name
|
||||||
|
|
|
@ -81,6 +81,15 @@ module Lib_deps : sig
|
||||||
val of_pps : Pp.t list -> t
|
val of_pps : Pp.t list -> t
|
||||||
end
|
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
|
module Dep_conf : sig
|
||||||
type t =
|
type t =
|
||||||
| File of String_with_vars.t
|
| File of String_with_vars.t
|
||||||
|
@ -91,16 +100,8 @@ module Dep_conf : sig
|
||||||
| Package of String_with_vars.t
|
| Package of String_with_vars.t
|
||||||
| Universe
|
| 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 t : t Sexp.Of_sexp.t
|
||||||
val sexp_of_t : t -> Sexp.t
|
val sexp_of_t : t -> Sexp.t
|
||||||
val sexp_of_bindings : bindings -> Sexp.t
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Buildable : sig
|
module Buildable : sig
|
||||||
|
@ -292,7 +293,7 @@ module Rule : sig
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ targets : Targets.t
|
{ targets : Targets.t
|
||||||
; deps : Dep_conf.bindings
|
; deps : Dep_conf.t Named.t
|
||||||
; action : Loc.t * Action.Unexpanded.t
|
; action : Loc.t * Action.Unexpanded.t
|
||||||
; mode : Mode.t
|
; mode : Mode.t
|
||||||
; locks : String_with_vars.t list
|
; locks : String_with_vars.t list
|
||||||
|
@ -315,7 +316,7 @@ end
|
||||||
module Alias_conf : sig
|
module Alias_conf : sig
|
||||||
type t =
|
type t =
|
||||||
{ name : string
|
{ name : string
|
||||||
; deps : Dep_conf.bindings
|
; deps : Dep_conf.t Named.t
|
||||||
; action : (Loc.t * Action.Unexpanded.t) option
|
; action : (Loc.t * Action.Unexpanded.t) option
|
||||||
; locks : String_with_vars.t list
|
; locks : String_with_vars.t list
|
||||||
; package : Package.t option
|
; package : Package.t option
|
||||||
|
|
|
@ -527,7 +527,7 @@ module Deps = struct
|
||||||
|> Build.all
|
|> Build.all
|
||||||
>>^ List.concat
|
>>^ 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 ->
|
String.Map.fold ~init:unnamed named ~f:(fun (_, ds) acc ->
|
||||||
List.rev_append ds acc)
|
List.rev_append ds acc)
|
||||||
|> List.map ~f:(dep t ~scope ~dir)
|
|> List.map ~f:(dep t ~scope ~dir)
|
||||||
|
|
|
@ -220,11 +220,11 @@ module Deps : sig
|
||||||
-> Dep_conf.t list
|
-> Dep_conf.t list
|
||||||
-> (unit, Path.t list) Build.t
|
-> (unit, Path.t list) Build.t
|
||||||
|
|
||||||
val interpret_bindings
|
val interpret_named
|
||||||
: t
|
: t
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> Dep_conf.bindings
|
-> Dep_conf.t Named.t
|
||||||
-> (unit, Path.t list) Build.t
|
-> (unit, Path.t list) Build.t
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue