Implemenet variable shadowing

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/inline_tests.ml

@@ -179,8 +179,9 @@ include Sub_system.Register_end_point(
              ~obj_name:name)
       in
 
-      let extra_vars =
+      let bindings =
-        String.Map.singleton "library-name" ([Value.String lib.name])
+        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 =
+        let bindings =
-          List.fold_left
+          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
+                 ~bindings
-                 ~extra_vars ~dir ~dep_kind:Required ~targets:Alias ~scope)))
+                 ~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

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

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

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 =
+             let bindings =
-               String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
+               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 =
+         let bindings =
-           String_map.singleton "corrected-suffix" [Value.String corrected_suffix]
+           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 ->

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 =
+  let expand_vars t ~scope ~dir ?bindings s =
-    expand t ~scope ~dir ?extra_vars s
+    expand t ~scope ~dir ?bindings s
     |> Value.to_string ~dir
   in
-  let expand_vars_path t ~scope ~dir ?extra_vars s =
+  let expand_vars_path t ~scope ~dir ?bindings s =
-    expand t ~scope ~dir ?extra_vars 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
+          begin match Pform.Map.expand bindings ~syntax_version ~var with
-          | None -> String.Map.find extra_vars key
+          | None -> None
-          | Some Targets ->
+          | 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
+  let run sctx ~loc ~bindings t ~dir ~dep_kind
-        t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
+        ~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

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

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