Add error checking for duplicate bindings
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
93b0c618d1
commit
aab701d4a1
|
@ -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 sctx ~scope ~dir rule.deps
|
||||
(SC.Deps.interpret_bindings 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"
|
||||
; S.list Jbuild.Dep_conf.sexp_of_t alias_conf.deps
|
||||
; Jbuild.Dep_conf.sexp_of_bindings 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 sctx ~scope ~dir alias_conf.deps
|
||||
(SC.Deps.interpret_bindings sctx ~scope ~dir alias_conf.deps
|
||||
>>>
|
||||
match alias_conf.action with
|
||||
| None -> Build.progn []
|
||||
|
|
|
@ -233,7 +233,7 @@ module Pps_and_flags = struct
|
|||
end
|
||||
|
||||
module Dep_conf = struct
|
||||
type dep =
|
||||
type t =
|
||||
| File of String_with_vars.t
|
||||
| Alias of String_with_vars.t
|
||||
| Alias_rec of String_with_vars.t
|
||||
|
@ -242,9 +242,15 @@ module Dep_conf = struct
|
|||
| Package of String_with_vars.t
|
||||
| Universe
|
||||
|
||||
type t =
|
||||
| Unnamed of dep list
|
||||
| Named of string * dep list
|
||||
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
|
||||
|
@ -269,16 +275,17 @@ module Dep_conf = struct
|
|||
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 =
|
||||
make_dep_parser ~single:(fun x -> x) ~many:(sum dep_cons)
|
||||
|
||||
let bindings =
|
||||
let dep =
|
||||
make_dep_parser ~single:List.singleton ~many:(
|
||||
("list", repeat t)
|
||||
:: 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
|
||||
|
@ -287,13 +294,24 @@ module Dep_conf = struct
|
|||
| None -> of_sexp_errorf loc "Naked binding %s" s
|
||||
| Some _ -> dep
|
||||
>>| fun deps ->
|
||||
Named (name, deps)
|
||||
Left (name, (loc, deps))
|
||||
end
|
||||
| _ ->
|
||||
dep >>| fun dep -> Unnamed dep
|
||||
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
|
||||
let sexp_of_dep = function
|
||||
let sexp_of_t = function
|
||||
| File t ->
|
||||
List [Sexp.unsafe_atom_of_string "file" ; String_with_vars.sexp_of_t t]
|
||||
| Alias t ->
|
||||
|
@ -313,11 +331,13 @@ module Dep_conf = struct
|
|||
| Universe ->
|
||||
Sexp.unsafe_atom_of_string "universe"
|
||||
|
||||
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]
|
||||
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
|
||||
|
@ -1103,7 +1123,7 @@ module Rule = struct
|
|||
|
||||
type t =
|
||||
{ targets : Targets.t
|
||||
; deps : Dep_conf.t list
|
||||
; deps : Dep_conf.bindings
|
||||
; action : Loc.t * Action.Unexpanded.t
|
||||
; mode : Mode.t
|
||||
; locks : String_with_vars.t list
|
||||
|
@ -1145,7 +1165,7 @@ module Rule = struct
|
|||
let short_form =
|
||||
located Action.Unexpanded.t >>| fun (loc, action) ->
|
||||
{ targets = Infer
|
||||
; deps = []
|
||||
; deps = Dep_conf.empty_bindings
|
||||
; action = (loc, action)
|
||||
; mode = Standard
|
||||
; locks = []
|
||||
|
@ -1158,7 +1178,8 @@ module Rule = struct
|
|||
>>= fun action ->
|
||||
field "targets" (list file_in_current_dir)
|
||||
>>= fun targets ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
field "deps" (Dep_conf.bindings) ~default:Dep_conf.empty_bindings
|
||||
>>= fun deps ->
|
||||
field "locks" (list String_with_vars.t) ~default:[] >>= fun locks ->
|
||||
map_validate
|
||||
(field_b
|
||||
|
@ -1263,7 +1284,9 @@ module Rule = struct
|
|||
let src = name ^ ".mll" in
|
||||
let dst = name ^ ".ml" in
|
||||
{ targets = Static [dst]
|
||||
; deps = [Unnamed [File (S.virt_text __POS__ src)]]
|
||||
; deps = { Dep_conf.empty_bindings with
|
||||
unnamed = [File (S.virt_text __POS__ src)]
|
||||
}
|
||||
; action =
|
||||
(loc,
|
||||
Chdir
|
||||
|
@ -1284,7 +1307,10 @@ module Rule = struct
|
|||
List.map modules ~f:(fun name ->
|
||||
let src = name ^ ".mly" in
|
||||
{ targets = Static [name ^ ".ml"; name ^ ".mli"]
|
||||
; deps = [Unnamed [File (S.virt_text __POS__ src)]]
|
||||
; deps =
|
||||
{ Dep_conf.empty_bindings with
|
||||
unnamed = [File (S.virt_text __POS__ src)]
|
||||
}
|
||||
; action =
|
||||
(loc,
|
||||
Chdir
|
||||
|
@ -1352,7 +1378,7 @@ end
|
|||
module Alias_conf = struct
|
||||
type t =
|
||||
{ name : string
|
||||
; deps : Dep_conf.t list
|
||||
; deps : Dep_conf.bindings
|
||||
; action : (Loc.t * Action.Unexpanded.t) option
|
||||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
|
@ -1368,10 +1394,11 @@ module Alias_conf = struct
|
|||
let t =
|
||||
record
|
||||
(field "name" alias_name >>= fun name ->
|
||||
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
|
||||
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
|
||||
>>= fun deps ->
|
||||
return
|
||||
{ name
|
||||
; deps
|
||||
|
|
|
@ -82,7 +82,7 @@ module Lib_deps : sig
|
|||
end
|
||||
|
||||
module Dep_conf : sig
|
||||
type dep =
|
||||
type t =
|
||||
| File of String_with_vars.t
|
||||
| Alias of String_with_vars.t
|
||||
| Alias_rec of String_with_vars.t
|
||||
|
@ -91,12 +91,16 @@ module Dep_conf : sig
|
|||
| Package of String_with_vars.t
|
||||
| Universe
|
||||
|
||||
type t =
|
||||
| Unnamed of dep list
|
||||
| Named of string * dep list
|
||||
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
|
||||
|
@ -288,7 +292,7 @@ module Rule : sig
|
|||
|
||||
type t =
|
||||
{ targets : Targets.t
|
||||
; deps : Dep_conf.t list
|
||||
; deps : Dep_conf.bindings
|
||||
; action : Loc.t * Action.Unexpanded.t
|
||||
; mode : Mode.t
|
||||
; locks : String_with_vars.t list
|
||||
|
@ -311,7 +315,7 @@ end
|
|||
module Alias_conf : sig
|
||||
type t =
|
||||
{ name : string
|
||||
; deps : Dep_conf.t list
|
||||
; deps : Dep_conf.bindings
|
||||
; action : (Loc.t * Action.Unexpanded.t) option
|
||||
; locks : String_with_vars.t list
|
||||
; package : Package.t option
|
||||
|
|
|
@ -523,9 +523,14 @@ module Deps = struct
|
|||
>>^ fun () -> []
|
||||
|
||||
let interpret t ~scope ~dir l =
|
||||
List.concat_map l ~f:(function
|
||||
| Unnamed d
|
||||
| Named (_, d) -> List.map ~f:(dep t ~scope ~dir) d)
|
||||
List.map l ~f:(dep t ~scope ~dir)
|
||||
|> Build.all
|
||||
>>^ List.concat
|
||||
|
||||
let interpret_bindings t ~scope ~dir { 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
|
||||
end
|
||||
|
|
|
@ -219,6 +219,13 @@ module Deps : sig
|
|||
-> dir:Path.t
|
||||
-> Dep_conf.t list
|
||||
-> (unit, Path.t list) Build.t
|
||||
|
||||
val interpret_bindings
|
||||
: t
|
||||
-> scope:Scope.t
|
||||
-> dir:Path.t
|
||||
-> Dep_conf.bindings
|
||||
-> (unit, Path.t list) Build.t
|
||||
end
|
||||
|
||||
(** Interpret action written in jbuild files *)
|
||||
|
|
Loading…
Reference in New Issue