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
|
~init:extra_vars
|
||||||
~f:(fun acc (k, v) -> String.Map.add acc k v)
|
~f:(fun acc (k, v) -> String.Map.add acc k v)
|
||||||
in
|
in
|
||||||
Build.return []
|
Build.return Named.empty
|
||||||
>>>
|
>>>
|
||||||
Build.all
|
Build.all
|
||||||
(List.filter_map backends ~f:(fun (backend : Backend.t) ->
|
(List.filter_map backends ~f:(fun (backend : Backend.t) ->
|
||||||
|
|
|
@ -234,15 +234,31 @@ end
|
||||||
|
|
||||||
module Named = struct
|
module Named = struct
|
||||||
type 'a t =
|
type 'a t =
|
||||||
{ named: (Loc.t * 'a list) String.Map.t
|
{ named: 'a list String.Map.t
|
||||||
; unnamed : 'a list
|
; 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 =
|
let empty =
|
||||||
{ named = String.Map.empty
|
{ named = String.Map.empty
|
||||||
; unnamed = []
|
; unnamed = []
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let singleton x = { empty with unnamed = [x] }
|
||||||
|
|
||||||
let t elem =
|
let t elem =
|
||||||
let binding =
|
let binding =
|
||||||
peek_exn >>= function
|
peek_exn >>= function
|
||||||
|
@ -262,17 +278,18 @@ module Named = struct
|
||||||
let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in
|
let (named, unnamed) = List.partition_map bindings ~f:(fun x -> x) in
|
||||||
{ unnamed = List.flatten unnamed
|
{ unnamed = List.flatten unnamed
|
||||||
; named =
|
; named =
|
||||||
match String.Map.of_list named with
|
(match String.Map.of_list named with
|
||||||
| Ok x -> x
|
| Ok x -> x
|
||||||
| Error (name, (l1, _), (l2, _)) ->
|
| Error (name, (l1, _), (l2, _)) ->
|
||||||
of_sexp_errorf l1 "Variable %s is already defined in %s"
|
of_sexp_errorf l1 "Variable %s is already defined in %s"
|
||||||
name (Loc.to_file_colon_line l2)
|
name (Loc.to_file_colon_line l2))
|
||||||
|
|> String.Map.map ~f:snd
|
||||||
})
|
})
|
||||||
|
|
||||||
let sexp_of_t sexp_of_a { unnamed; named } =
|
let sexp_of_t sexp_of_a { unnamed; named } =
|
||||||
let unnamed = List.map ~f:sexp_of_a unnamed in
|
let unnamed = List.map ~f:sexp_of_a unnamed in
|
||||||
let named =
|
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)
|
Sexp.unsafe_atom_of_string (":" ^ n) :: (List.map ~f:sexp_of_a d) @ acc)
|
||||||
in
|
in
|
||||||
Sexp.List (unnamed @ named)
|
Sexp.List (unnamed @ named)
|
||||||
|
|
|
@ -83,12 +83,18 @@ end
|
||||||
|
|
||||||
module Named : sig
|
module Named : sig
|
||||||
type 'a t =
|
type 'a t =
|
||||||
{ named : (Loc.t * 'a list) String.Map.t
|
{ named : 'a list String.Map.t
|
||||||
; unnamed : 'a list
|
; unnamed : 'a list
|
||||||
}
|
}
|
||||||
|
|
||||||
val empty : 'a t
|
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
|
val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t
|
||||||
end
|
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
|
let src_path = Path.relative dir src.name in
|
||||||
add_alias src.name
|
add_alias src.name
|
||||||
(Build.path src_path
|
(Build.path src_path
|
||||||
>>^ (fun _ -> [src_path])
|
>>^ (fun _ -> Jbuild.Named.singleton src_path)
|
||||||
>>> SC.Action.run sctx
|
>>> SC.Action.run sctx
|
||||||
action
|
action
|
||||||
~loc
|
~loc
|
||||||
|
@ -531,7 +531,7 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
|
||||||
(preprocessor_deps
|
(preprocessor_deps
|
||||||
>>>
|
>>>
|
||||||
Build.path src
|
Build.path src
|
||||||
>>^ (fun _ -> [src])
|
>>^ (fun _ -> Jbuild.Named.singleton src)
|
||||||
>>>
|
>>>
|
||||||
SC.Action.run sctx
|
SC.Action.run sctx
|
||||||
(Redirect
|
(Redirect
|
||||||
|
|
|
@ -528,11 +528,20 @@ module Deps = struct
|
||||||
>>^ List.concat
|
>>^ List.concat
|
||||||
|
|
||||||
let interpret_named t ~scope ~dir { Named.unnamed; named } =
|
let interpret_named t ~scope ~dir { Named.unnamed; named } =
|
||||||
String.Map.fold ~init:unnamed named ~f:(fun (_, ds) acc ->
|
let deps l =
|
||||||
List.rev_append ds acc)
|
List.map ~f:(dep t ~scope ~dir) l
|
||||||
|> List.map ~f:(dep t ~scope ~dir)
|
|> Build.all
|
||||||
|> Build.all
|
>>^ List.concat
|
||||||
>>^ 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
|
end
|
||||||
|
|
||||||
module Pkg_version = struct
|
module Pkg_version = struct
|
||||||
|
@ -762,31 +771,47 @@ module Action = struct
|
||||||
let t = U.partial_expand t ~dir ~map_exe ~f:expand in
|
let t = U.partial_expand t ~dir ~map_exe ~f:expand in
|
||||||
(t, acc)
|
(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 ->
|
U.Partial.expand t ~dir ~map_exe ~f:(fun var syntax_version ->
|
||||||
let key = String_with_vars.Var.full_name var in
|
let key = String_with_vars.Var.full_name var in
|
||||||
let loc = String_with_vars.Var.loc var in
|
let loc = String_with_vars.Var.loc var in
|
||||||
match String.Map.find dynamic_expansions key with
|
match String.Map.find dynamic_expansions key with
|
||||||
| Some _ as opt -> opt
|
| Some _ as opt -> opt
|
||||||
| None ->
|
| None ->
|
||||||
Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var
|
begin match
|
||||||
|> Option.map ~f:(function
|
Pform.Map.expand Pform.Map.static_vars ~syntax_version ~var
|
||||||
| Pform.Var.Deps -> (Value.L.paths deps_written_by_user)
|
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 ->
|
| 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 \
|
Loc.warn loc "Variable '%s' used with no explicit \
|
||||||
dependencies@." key;
|
dependencies@." key;
|
||||||
[Value.String ""]
|
Some [Value.String ""]
|
||||||
| v :: _ -> [Path v]
|
| Ok v -> Some [Path v]
|
||||||
end
|
end
|
||||||
| _ ->
|
| _ ->
|
||||||
Exn.code_error "Unexpected variable in step2"
|
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)
|
let run sctx ~loc ?(extra_vars=String.Map.empty)
|
||||||
t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
|
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
|
let map_exe = map_exe sctx in
|
||||||
if targets_written_by_user = Alias then begin
|
if targets_written_by_user = Alias then begin
|
||||||
match Action.Infer.unexpanded_targets t with
|
match Action.Infer.unexpanded_targets t with
|
||||||
|
|
|
@ -225,7 +225,7 @@ module Deps : sig
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> dir:Path.t
|
-> dir:Path.t
|
||||||
-> Dep_conf.t Named.t
|
-> Dep_conf.t Named.t
|
||||||
-> (unit, Path.t list) Build.t
|
-> (unit, Path.t Named.t) Build.t
|
||||||
end
|
end
|
||||||
|
|
||||||
(** Interpret action written in jbuild files *)
|
(** Interpret action written in jbuild files *)
|
||||||
|
@ -245,7 +245,7 @@ module Action : sig
|
||||||
-> dep_kind:Build.lib_dep_kind
|
-> dep_kind:Build.lib_dep_kind
|
||||||
-> targets:targets
|
-> targets:targets
|
||||||
-> scope:Scope.t
|
-> scope:Scope.t
|
||||||
-> (Path.t list, Action.t) Build.t
|
-> (Path.t Named.t, Action.t) Build.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Pkg_version : sig
|
module Pkg_version : sig
|
||||||
|
|
Loading…
Reference in New Issue