Expand named variables in actions
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
1cc0198d9c
commit
2b7a7fcdff
|
@ -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) ->
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue