Implemenet variable shadowing
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
abab989e20
commit
4f7e7188d7
|
@ -179,8 +179,9 @@ include Sub_system.Register_end_point(
|
|||
~obj_name:name)
|
||||
in
|
||||
|
||||
let extra_vars =
|
||||
String.Map.singleton "library-name" ([Value.String lib.name])
|
||||
let bindings =
|
||||
Pform.Map.singleton "library-name"
|
||||
(Pform.Var.Values [Value.String lib.name])
|
||||
in
|
||||
|
||||
let runner_libs =
|
||||
|
@ -202,17 +203,15 @@ include Sub_system.Register_end_point(
|
|||
let target = Path.relative inline_test_dir main_module_filename in
|
||||
let source_modules = Module.Name.Map.values source_modules in
|
||||
let files ml_kind =
|
||||
Value.L.paths (
|
||||
Pform.Var.Values (Value.L.paths (
|
||||
List.filter_map source_modules ~f:(fun m ->
|
||||
Module.file m ~dir ml_kind))
|
||||
Module.file m ~dir ml_kind)))
|
||||
in
|
||||
let extra_vars =
|
||||
List.fold_left
|
||||
let bindings =
|
||||
Pform.Map.of_list_exn
|
||||
[ "impl-files", files Impl
|
||||
; "intf-files", files Intf
|
||||
]
|
||||
~init:extra_vars
|
||||
~f:(fun acc (k, v) -> String.Map.add acc k v)
|
||||
in
|
||||
Build.return Bindings.empty
|
||||
>>>
|
||||
|
@ -220,8 +219,8 @@ include Sub_system.Register_end_point(
|
|||
(List.filter_map backends ~f:(fun (backend : Backend.t) ->
|
||||
Option.map backend.info.generate_runner ~f:(fun (loc, action) ->
|
||||
SC.Action.run sctx action ~loc
|
||||
~bindings:Pform.Map.empty
|
||||
~extra_vars ~dir ~dep_kind:Required ~targets:Alias ~scope)))
|
||||
~bindings
|
||||
~dir ~dep_kind:Required ~targets:Alias ~scope)))
|
||||
>>^ (fun actions ->
|
||||
Action.with_stdout_to target
|
||||
(Action.progn actions))
|
||||
|
@ -252,7 +251,7 @@ include Sub_system.Register_end_point(
|
|||
Super_context.expand_and_eval_set sctx flags
|
||||
~scope
|
||||
~dir
|
||||
~extra_vars
|
||||
~bindings
|
||||
~standard:(Build.return [])))
|
||||
>>^ List.concat
|
||||
in
|
||||
|
|
|
@ -183,6 +183,12 @@ module Map = struct
|
|||
|
||||
let empty = String.Map.empty
|
||||
|
||||
let singleton k v = String.Map.singleton k (No_info v)
|
||||
|
||||
let of_list_exn vars =
|
||||
List.map ~f:(fun (k, x) -> (k, No_info x)) vars
|
||||
|> String.Map.of_list_exn
|
||||
|
||||
let of_bindings =
|
||||
Jbuild.Bindings.fold ~f:(fun x acc ->
|
||||
match x with
|
||||
|
|
|
@ -46,6 +46,10 @@ module Map : sig
|
|||
|
||||
val of_bindings : 'a Jbuild.Bindings.t -> Var.t t
|
||||
|
||||
val singleton : string -> 'a -> 'a t
|
||||
|
||||
val of_list_exn : (string * 'a) list -> 'a t
|
||||
|
||||
val expand
|
||||
: 'a t
|
||||
-> syntax_version:Syntax.Version.t
|
||||
|
|
|
@ -478,14 +478,15 @@ let lint_module sctx ~dir ~dep_kind ~lint ~lib_name ~scope ~dir_kind =
|
|||
get_ppx_driver sctx ~loc ~scope ~dir_kind pps
|
||||
>>| fun (exe, driver) ->
|
||||
(exe,
|
||||
let extra_vars =
|
||||
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
|
||||
let bindings =
|
||||
Pform.Map.singleton "corrected-suffix"
|
||||
(Pform.Var.Values [Value.String corrected_suffix])
|
||||
in
|
||||
Build.memoize "ppx flags"
|
||||
(SC.expand_and_eval_set sctx driver.info.lint_flags
|
||||
~scope
|
||||
~dir
|
||||
~extra_vars
|
||||
~bindings
|
||||
~standard:(Build.return [])))
|
||||
in
|
||||
(fun ~source ~ast ->
|
||||
|
@ -561,14 +562,15 @@ let make sctx ~dir ~dep_kind ~lint ~preprocess
|
|||
let open Result.O in
|
||||
get_ppx_driver sctx ~loc ~scope ~dir_kind pps >>| fun (exe, driver) ->
|
||||
(exe,
|
||||
let extra_vars =
|
||||
String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
|
||||
let bindings =
|
||||
Pform.Map.singleton "corrected-suffix"
|
||||
(Pform.Var.Values [Value.String corrected_suffix])
|
||||
in
|
||||
Build.memoize "ppx flags"
|
||||
(SC.expand_and_eval_set sctx driver.info.flags
|
||||
~scope
|
||||
~dir
|
||||
~extra_vars
|
||||
~bindings
|
||||
~standard:(Build.return [])))
|
||||
in
|
||||
(fun m ~lint ->
|
||||
|
|
|
@ -112,11 +112,13 @@ let expand t ~syntax_version ~var =
|
|||
| Left (Some x) -> Some (Left x)
|
||||
|
||||
let (expand_vars_string, expand_vars_path) =
|
||||
let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s =
|
||||
let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s =
|
||||
String_with_vars.expand ~mode:Single ~dir s ~f:(fun var syntax_version ->
|
||||
match expand t ~syntax_version ~var with
|
||||
| None ->
|
||||
String.Map.find extra_vars (String_with_vars.Var.full_name var)
|
||||
let open Option.O in
|
||||
Pform.Map.expand bindings ~syntax_version ~var >>=
|
||||
Pform.Var.to_value_no_deps_or_targets ~scope
|
||||
| Some (Left v) ->
|
||||
begin match Pform.Var.to_value_no_deps_or_targets ~scope v with
|
||||
| Some _ as v -> v
|
||||
|
@ -131,19 +133,19 @@ let (expand_vars_string, expand_vars_path) =
|
|||
Loc.fail (String_with_vars.Var.loc var)
|
||||
"This percent form isn't allowed in this position")
|
||||
in
|
||||
let expand_vars t ~scope ~dir ?extra_vars s =
|
||||
expand t ~scope ~dir ?extra_vars s
|
||||
let expand_vars t ~scope ~dir ?bindings s =
|
||||
expand t ~scope ~dir ?bindings s
|
||||
|> Value.to_string ~dir
|
||||
in
|
||||
let expand_vars_path t ~scope ~dir ?extra_vars s =
|
||||
expand t ~scope ~dir ?extra_vars s
|
||||
let expand_vars_path t ~scope ~dir ?bindings s =
|
||||
expand t ~scope ~dir ?bindings s
|
||||
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
|
||||
in
|
||||
(expand_vars, expand_vars_path)
|
||||
|
||||
let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
|
||||
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
|
||||
let open Build.O in
|
||||
let f = expand_vars_string t ~scope ~dir ?extra_vars in
|
||||
let f = expand_vars_string t ~scope ~dir ?bindings in
|
||||
let parse ~loc:_ s = s in
|
||||
let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
|
||||
match String.Set.to_list files with
|
||||
|
@ -208,7 +210,7 @@ module Env = struct
|
|||
~ocamlopt_flags:cfg.ocamlopt_flags
|
||||
~default
|
||||
~eval:(expand_and_eval_set t ~scope:node.scope ~dir:node.dir
|
||||
?extra_vars:None)
|
||||
?bindings:None)
|
||||
in
|
||||
node.ocaml_flags <- Some flags;
|
||||
flags
|
||||
|
@ -223,7 +225,7 @@ let ocaml_flags t ~dir ~scope (x : Buildable.t) =
|
|||
~ocamlc_flags:x.ocamlc_flags
|
||||
~ocamlopt_flags:x.ocamlopt_flags
|
||||
~default:(Env.ocaml_flags t ~dir)
|
||||
~eval:(expand_and_eval_set t ~scope ~dir ?extra_vars:None)
|
||||
~eval:(expand_and_eval_set t ~scope ~dir ?bindings:None)
|
||||
|
||||
let dump_env t ~dir =
|
||||
Ocaml_flags.dump (Env.ocaml_flags t ~dir)
|
||||
|
@ -630,7 +632,7 @@ module Action = struct
|
|||
| Some x -> x
|
||||
|
||||
let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user
|
||||
~map_exe ~extra_vars t =
|
||||
~map_exe ~bindings t =
|
||||
let acc =
|
||||
{ failures = []
|
||||
; lib_deps = String.Map.empty
|
||||
|
@ -735,14 +737,13 @@ module Action = struct
|
|||
in
|
||||
let expand var syntax_version =
|
||||
let loc = String_with_vars.Var.loc var in
|
||||
let key = String_with_vars.Var.full_name var in
|
||||
let res =
|
||||
match String_with_vars.Var.destruct var with
|
||||
| Macro (_, s) -> expand_form s var syntax_version
|
||||
| Var var_name ->
|
||||
begin match expand_vars sctx ~syntax_version ~var with
|
||||
| None -> String.Map.find extra_vars key
|
||||
| Some Targets ->
|
||||
begin match Pform.Map.expand bindings ~syntax_version ~var with
|
||||
| None -> None
|
||||
| Some Pform.Var.Targets ->
|
||||
let var () =
|
||||
match var_name with
|
||||
| "@" -> sprintf "${%s}" var_name
|
||||
|
@ -808,10 +809,9 @@ module Action = struct
|
|||
Exn.code_error "Unexpected variable in step2"
|
||||
["var", String_with_vars.Var.sexp_of_t var])
|
||||
|
||||
let run sctx ~loc ?(extra_vars=String.Map.empty) ~bindings
|
||||
t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
|
||||
let run sctx ~loc ~bindings t ~dir ~dep_kind
|
||||
~targets:targets_written_by_user ~scope
|
||||
: (Path.t Bindings.t, Action.t) Build.t =
|
||||
ignore bindings;
|
||||
let map_exe = map_exe sctx in
|
||||
if targets_written_by_user = Alias then begin
|
||||
match Action.Infer.unexpanded_targets t with
|
||||
|
@ -823,8 +823,9 @@ module Action = struct
|
|||
This will become an error in the future.";
|
||||
end;
|
||||
let t, forms =
|
||||
let bindings = Pform.Map.superpose sctx.vars bindings in
|
||||
expand_step1 sctx t ~dir ~dep_kind ~scope
|
||||
~targets_written_by_user ~map_exe ~extra_vars
|
||||
~targets_written_by_user ~map_exe ~bindings
|
||||
in
|
||||
let { Action.Infer.Outcome. deps; targets } =
|
||||
match targets_written_by_user with
|
||||
|
|
|
@ -82,7 +82,7 @@ val expand_vars_string
|
|||
: t
|
||||
-> scope:Scope.t
|
||||
-> dir:Path.t
|
||||
-> ?extra_vars:Value.t list String.Map.t
|
||||
-> ?bindings:Pform.Var.t Pform.Map.t
|
||||
-> String_with_vars.t
|
||||
-> string
|
||||
|
||||
|
@ -90,7 +90,7 @@ val expand_vars_path
|
|||
: t
|
||||
-> scope:Scope.t
|
||||
-> dir:Path.t
|
||||
-> ?extra_vars:Value.t list String.Map.t
|
||||
-> ?bindings:Pform.Var.t Pform.Map.t
|
||||
-> String_with_vars.t
|
||||
-> Path.t
|
||||
|
||||
|
@ -98,7 +98,7 @@ val expand_and_eval_set
|
|||
: t
|
||||
-> scope:Scope.t
|
||||
-> dir:Path.t
|
||||
-> ?extra_vars:Value.t list String.Map.t
|
||||
-> ?bindings:Pform.Var.t Pform.Map.t
|
||||
-> Ordered_set_lang.Unexpanded.t
|
||||
-> standard:(unit, string list) Build.t
|
||||
-> (unit, string list) Build.t
|
||||
|
@ -239,7 +239,6 @@ module Action : sig
|
|||
val run
|
||||
: t
|
||||
-> loc:Loc.t
|
||||
-> ?extra_vars:Value.t list String.Map.t
|
||||
-> bindings:Pform.Var.t Pform.Map.t
|
||||
-> Action.Unexpanded.t
|
||||
-> dir:Path.t
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
Bindings introduced by user dependencies should shadow existing bindings
|
||||
|
||||
$ dune runtest
|
||||
.
|
||||
foo
|
||||
|
|
Loading…
Reference in New Issue