diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 4e7522a1..b918eb19 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -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 diff --git a/src/pform.ml b/src/pform.ml index f2f96eec..cf87d265 100644 --- a/src/pform.ml +++ b/src/pform.ml @@ -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 diff --git a/src/pform.mli b/src/pform.mli index 9e1149a8..f33818ef 100644 --- a/src/pform.mli +++ b/src/pform.mli @@ -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 diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 1a280a37..e635d893 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -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 -> diff --git a/src/super_context.ml b/src/super_context.ml index 133e44e6..fa72e423 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -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 diff --git a/src/super_context.mli b/src/super_context.mli index f203db79..913ab515 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -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 diff --git a/test/blackbox-tests/test-cases/shadow-bindings/run.t b/test/blackbox-tests/test-cases/shadow-bindings/run.t index 565385e9..015e5376 100644 --- a/test/blackbox-tests/test-cases/shadow-bindings/run.t +++ b/test/blackbox-tests/test-cases/shadow-bindings/run.t @@ -1,4 +1,4 @@ Bindings introduced by user dependencies should shadow existing bindings $ dune runtest - . + foo