matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implemenet variable shadowing 

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-07-09 23:39:57 +07:00
parent abab989e20
commit 4f7e7188d7
7 changed files with 52 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/inline_tests.ml
View File

@ -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

6
src/pform.ml
View File

@ -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

4
src/pform.mli
View File

@ -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

14
src/preprocessing.ml
View File

@ -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 ->

39
src/super_context.ml
View File

@ -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

7
src/super_context.mli
View File

@ -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

2
test/blackbox-tests/test-cases/shadow-bindings/run.t
View File

@ -1,4 +1,4 @@
Bindings introduced by user dependencies should shadow existing bindings
$ dune runtest
.
foo