From 6c6a5b7866d0bca23bf575c00baa92565100402e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 17:24:48 +0200 Subject: [PATCH 1/7] Move Resolved_forms to own module Signed-off-by: Rudi Grinberg --- src/super_context.ml | 77 +++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 37 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 973c4bfc..ed0e4e22 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -569,27 +569,36 @@ module Action = struct | Infer | Alias - type resolved_forms = - { (* Failed resolutions *) - mutable failures : fail list - ; (* All "name" for %{lib:name:...}/%{lib-available:name} forms *) - mutable lib_deps : Build.lib_deps - ; (* Static deps from %{...} variables. For instance %{exe:...} *) - mutable sdeps : Path.Set.t - ; (* Dynamic deps from %{...} variables. For instance %{read:...} *) - mutable ddeps : (unit, Value.t list) Build.t String.Map.t - } + module Resolved_forms = struct + type t = + { (* Failed resolutions *) + mutable failures : fail list + ; (* All "name" for %{lib:name:...}/%{lib-available:name} forms *) + mutable lib_deps : Build.lib_deps + ; (* Static deps from %{...} variables. For instance %{exe:...} *) + mutable sdeps : Path.Set.t + ; (* Dynamic deps from %{...} variables. For instance %{read:...} *) + mutable ddeps : (unit, Value.t list) Build.t String.Map.t + } - let add_lib_dep acc lib kind = - acc.lib_deps <- String.Map.add acc.lib_deps lib kind + let empty () = + { failures = [] + ; lib_deps = String.Map.empty + ; sdeps = Path.Set.empty + ; ddeps = String.Map.empty + } - let add_fail acc fail = - acc.failures <- fail :: acc.failures; - None + let add_lib_dep acc lib kind = + acc.lib_deps <- String.Map.add acc.lib_deps lib kind - let add_ddep acc ~key dep = - acc.ddeps <- String.Map.add acc.ddeps key dep; - None + let add_fail acc fail = + acc.failures <- fail :: acc.failures; + None + + let add_ddep acc ~key dep = + acc.ddeps <- String.Map.add acc.ddeps key dep; + None + end let path_exp path = [Value.Path path] let str_exp str = [Value.String str] @@ -612,13 +621,7 @@ module Action = struct let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe ~bindings t = - let acc = - { failures = [] - ; lib_deps = String.Map.empty - ; sdeps = Path.Set.empty - ; ddeps = String.Map.empty - } - in + let acc = Resolved_forms.empty () in let expand pform syntax_version = let loc = String_with_vars.Var.loc pform in let key = String_with_vars.Var.full_name pform in @@ -647,26 +650,26 @@ module Action = struct match Artifacts.binary (artifacts sctx) s with | Ok path -> Some (path_exp path) | Error e -> - add_fail acc + Resolved_forms.add_fail acc ({ fail = fun () -> Action.Prog.Not_found.raise e }) end | Macro (Lib, s) -> begin let lib_dep, file = parse_lib_file ~loc s in - add_lib_dep acc lib_dep dep_kind; + Resolved_forms.add_lib_dep acc lib_dep dep_kind; match Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file with | Ok path -> Some (path_exp path) - | Error fail -> add_fail acc fail + | Error fail -> Resolved_forms.add_fail acc fail end | Macro (Libexec, s) -> begin let sctx = host sctx in let lib_dep, file = parse_lib_file ~loc s in - add_lib_dep acc lib_dep dep_kind; + Resolved_forms.add_lib_dep acc lib_dep dep_kind; match Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file with - | Error fail -> add_fail acc fail + | Error fail -> Resolved_forms.add_fail acc fail | Ok path -> if not Sys.win32 || Filename.extension s = ".exe" then begin Some (path_exp path) @@ -679,12 +682,12 @@ module Action = struct ~else_:(Build.path path >>^ fun _ -> path_exp path) in - add_ddep acc ~key dep + Resolved_forms.add_ddep acc ~key dep end end | Macro (Lib_available, s) -> begin let lib = s in - add_lib_dep acc lib Optional; + Resolved_forms.add_lib_dep acc lib Optional; Some (str_exp (string_of_bool ( Lib.DB.available (Scope.libs scope) lib))) end @@ -697,9 +700,9 @@ module Action = struct | None -> [Value.String ""] | Some s -> [String s] in - add_ddep acc ~key x + Resolved_forms.add_ddep acc ~key x | None -> - add_fail acc { fail = fun () -> + Resolved_forms.add_fail acc { fail = fun () -> Loc.fail loc "Package %S doesn't exist in the current project." s } @@ -710,7 +713,7 @@ module Action = struct Build.contents path >>^ fun s -> [Value.String s] in - add_ddep acc ~key data + Resolved_forms.add_ddep acc ~key data end | Macro (Read_lines, s) -> begin let path = Path.relative dir s in @@ -718,7 +721,7 @@ module Action = struct Build.lines_of path >>^ Value.L.strings in - add_ddep acc ~key data + Resolved_forms.add_ddep acc ~key data end | Macro (Read_strings, s) -> begin let path = Path.relative dir s in @@ -726,7 +729,7 @@ module Action = struct Build.strings path >>^ Value.L.strings in - add_ddep acc ~key data + Resolved_forms.add_ddep acc ~key data end | Macro (Path_no_dep, s) -> Some [Value.Dir (Path.relative dir s)]) in From 72bbd06a1dde99dae09b22707d62e4daff747c10 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 11 Jul 2018 20:34:48 +0200 Subject: [PATCH 2/7] Generalize expansion to be in own module The result is Super_context.Expander which can be used for expandding OSL as well Signed-off-by: Rudi Grinberg --- src/super_context.ml | 343 ++++++++++++++++++++++++++----------------- 1 file changed, 206 insertions(+), 137 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index ed0e4e22..f5b57d71 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -560,15 +560,44 @@ module Scope_key = struct sprintf "%s@%s" key (Dune_project.Name.encode scope) end -module Action = struct - open Build.O - module U = Action.Unexpanded +type targets = + | Static of Path.t list + | Infer + | Alias - type targets = - | Static of Path.t list - | Infer - | Alias +module Expander : sig + module Resolved_forms : sig + type t + (* Failed resolutions *) + val failures : t -> fail list + + (* All "name" for %{lib:name:...}/%{lib-available:name} forms *) + val lib_deps : t -> Build.lib_deps + + (* Static deps from %{...} variables. For instance %{exe:...} *) + val sdeps : t -> Path.Set.t + + (* Dynamic deps from %{...} variables. For instance %{read:...} *) + val ddeps : t -> (unit, Value.t list) Build.t String.Map.t + end + + type sctx = t + + type expander + = sctx + -> dir:Path.t + -> dep_kind:Build.lib_dep_kind + -> scope:Scope.t + -> targets_written_by_user:targets + -> map_exe:(Path.t -> Path.t) + -> bindings:Pform.Map.t + -> String_with_vars.Var.t + -> Syntax.Version.t + -> Value.t list option + + val with_expander : (expander -> 'a) -> 'a * Resolved_forms.t +end = struct module Resolved_forms = struct type t = { (* Failed resolutions *) @@ -581,6 +610,11 @@ module Action = struct mutable ddeps : (unit, Value.t list) Build.t String.Map.t } + let failures t = t.failures + let lib_deps t = t.lib_deps + let sdeps t = t.sdeps + let ddeps t = t.ddeps + let empty () = { failures = [] ; lib_deps = String.Map.empty @@ -600,9 +634,166 @@ module Action = struct None end + type sctx = t + + type expander + = sctx + -> dir:Path.t + -> dep_kind:Build.lib_dep_kind + -> scope:Scope.t + -> targets_written_by_user:targets + -> map_exe:(Path.t -> Path.t) + -> bindings:Pform.Map.t + -> String_with_vars.Var.t + -> Syntax.Version.t + -> Value.t list option + let path_exp path = [Value.Path path] let str_exp str = [Value.String str] + let parse_lib_file ~loc s = + match String.lsplit2 s ~on:':' with + | None -> + Loc.fail loc "invalid %%{lib:...} form: %s" s + | Some x -> x + + open Build.O + + let expander ~acc sctx ~dir ~dep_kind ~scope ~targets_written_by_user + ~map_exe ~bindings pform syntax_version = + let loc = String_with_vars.Var.loc pform in + let key = String_with_vars.Var.full_name pform in + let res = + Pform.Map.expand bindings ~syntax_version ~pform + |> Option.bind ~f:(function + | Pform.Expansion.Var (Values l) -> Some l + | Macro (Ocaml_config, s) -> Some (expand_ocaml_config sctx pform s) + | Var Project_root -> Some [Value.Dir (Scope.root scope)] + | Var (First_dep | Deps | Named_local) -> None + | Var Targets -> + begin match targets_written_by_user with + | Infer -> + Loc.fail loc "You cannot use %s with inferred rules." + (String_with_vars.Var.describe pform) + | Alias -> + Loc.fail loc "You cannot use %s in aliases." + (String_with_vars.Var.describe pform) + | Static l -> + Some (Value.L.dirs l) (* XXX hack to signal no dep *) + end + | Macro (Exe, s) -> Some (path_exp (map_exe (Path.relative dir s))) + | Macro (Dep, s) -> Some (path_exp (Path.relative dir s)) + | Macro (Bin, s) -> begin + let sctx = host sctx in + match Artifacts.binary (artifacts sctx) s with + | Ok path -> Some (path_exp path) + | Error e -> + Resolved_forms.add_fail acc + ({ fail = fun () -> Action.Prog.Not_found.raise e }) + end + | Macro (Lib, s) -> begin + let lib_dep, file = parse_lib_file ~loc s in + Resolved_forms.add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Ok path -> Some (path_exp path) + | Error fail -> Resolved_forms.add_fail acc fail + end + | Macro (Libexec, s) -> begin + let sctx = host sctx in + let lib_dep, file = parse_lib_file ~loc s in + Resolved_forms.add_lib_dep acc lib_dep dep_kind; + match + Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file + with + | Error fail -> Resolved_forms.add_fail acc fail + | Ok path -> + if not Sys.win32 || Filename.extension s = ".exe" then begin + Some (path_exp path) + end else begin + let path_exe = Path.extend_basename path ~suffix:".exe" in + let dep = + Build.if_file_exists path_exe + ~then_:(Build.path path_exe >>^ fun _ -> + path_exp path_exe) + ~else_:(Build.path path >>^ fun _ -> + path_exp path) + in + Resolved_forms.add_ddep acc ~key dep + end + end + | Macro (Lib_available, s) -> begin + let lib = s in + Resolved_forms.add_lib_dep acc lib Optional; + Some (str_exp (string_of_bool ( + Lib.DB.available (Scope.libs scope) lib))) + end + | Macro (Version, s) -> begin + match Package.Name.Map.find (Scope.project scope).packages + (Package.Name.of_string s) with + | Some p -> + let x = + Pkg_version.read sctx p >>^ function + | None -> [Value.String ""] + | Some s -> [String s] + in + Resolved_forms.add_ddep acc ~key x + | None -> + Resolved_forms.add_fail acc { fail = fun () -> + Loc.fail loc + "Package %S doesn't exist in the current project." s + } + end + | Macro (Read, s) -> begin + let path = Path.relative dir s in + let data = + Build.contents path + >>^ fun s -> [Value.String s] + in + Resolved_forms.add_ddep acc ~key data + end + | Macro (Read_lines, s) -> begin + let path = Path.relative dir s in + let data = + Build.lines_of path + >>^ Value.L.strings + in + Resolved_forms.add_ddep acc ~key data + end + | Macro (Read_strings, s) -> begin + let path = Path.relative dir s in + let data = + Build.strings path + >>^ Value.L.strings + in + Resolved_forms.add_ddep acc ~key data + end + | Macro (Path_no_dep, s) -> Some [Value.Dir (Path.relative dir s)]) + in + Option.iter res ~f:(fun v -> + acc.sdeps <- Path.Set.union + (Path.Set.of_list (Value.L.deps_only v)) acc.sdeps + ); + res + + let with_expander + : 'a. (expander -> 'a) -> 'a * Resolved_forms.t + = fun f -> + let acc = Resolved_forms.empty () in + (f (expander ~acc), acc) +end + +module Action = struct + open Build.O + module U = Action.Unexpanded + + type nonrec targets = targets = + | Static of Path.t list + | Infer + | Alias + + let map_exe sctx = match sctx.host with | None -> (fun exe -> exe) @@ -613,134 +804,12 @@ module Action = struct Path.append host.context.build_dir exe | _ -> exe - let parse_lib_file ~loc s = - match String.lsplit2 s ~on:':' with - | None -> - Loc.fail loc "invalid %%{lib:...} form: %s" s - | Some x -> x - let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe ~bindings t = - let acc = Resolved_forms.empty () in - let expand pform syntax_version = - let loc = String_with_vars.Var.loc pform in - let key = String_with_vars.Var.full_name pform in - let res = - Pform.Map.expand bindings ~syntax_version ~pform - |> Option.bind ~f:(function - | Pform.Expansion.Var (Values l) -> Some l - | Macro (Ocaml_config, s) -> Some (expand_ocaml_config sctx pform s) - | Var Project_root -> Some [Value.Dir (Scope.root scope)] - | Var (First_dep | Deps | Named_local) -> None - | Var Targets -> - begin match targets_written_by_user with - | Infer -> - Loc.fail loc "You cannot use %s with inferred rules." - (String_with_vars.Var.describe pform) - | Alias -> - Loc.fail loc "You cannot use %s in aliases." - (String_with_vars.Var.describe pform) - | Static l -> - Some (Value.L.dirs l) (* XXX hack to signal no dep *) - end - | Macro (Exe, s) -> Some (path_exp (map_exe (Path.relative dir s))) - | Macro (Dep, s) -> Some (path_exp (Path.relative dir s)) - | Macro (Bin, s) -> begin - let sctx = host sctx in - match Artifacts.binary (artifacts sctx) s with - | Ok path -> Some (path_exp path) - | Error e -> - Resolved_forms.add_fail acc - ({ fail = fun () -> Action.Prog.Not_found.raise e }) - end - | Macro (Lib, s) -> begin - let lib_dep, file = parse_lib_file ~loc s in - Resolved_forms.add_lib_dep acc lib_dep dep_kind; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Ok path -> Some (path_exp path) - | Error fail -> Resolved_forms.add_fail acc fail - end - | Macro (Libexec, s) -> begin - let sctx = host sctx in - let lib_dep, file = parse_lib_file ~loc s in - Resolved_forms.add_lib_dep acc lib_dep dep_kind; - match - Artifacts.file_of_lib (artifacts sctx) ~loc ~lib:lib_dep ~file - with - | Error fail -> Resolved_forms.add_fail acc fail - | Ok path -> - if not Sys.win32 || Filename.extension s = ".exe" then begin - Some (path_exp path) - end else begin - let path_exe = Path.extend_basename path ~suffix:".exe" in - let dep = - Build.if_file_exists path_exe - ~then_:(Build.path path_exe >>^ fun _ -> - path_exp path_exe) - ~else_:(Build.path path >>^ fun _ -> - path_exp path) - in - Resolved_forms.add_ddep acc ~key dep - end - end - | Macro (Lib_available, s) -> begin - let lib = s in - Resolved_forms.add_lib_dep acc lib Optional; - Some (str_exp (string_of_bool ( - Lib.DB.available (Scope.libs scope) lib))) - end - | Macro (Version, s) -> begin - match Package.Name.Map.find (Scope.project scope).packages - (Package.Name.of_string s) with - | Some p -> - let x = - Pkg_version.read sctx p >>^ function - | None -> [Value.String ""] - | Some s -> [String s] - in - Resolved_forms.add_ddep acc ~key x - | None -> - Resolved_forms.add_fail acc { fail = fun () -> - Loc.fail loc - "Package %S doesn't exist in the current project." s - } - end - | Macro (Read, s) -> begin - let path = Path.relative dir s in - let data = - Build.contents path - >>^ fun s -> [Value.String s] - in - Resolved_forms.add_ddep acc ~key data - end - | Macro (Read_lines, s) -> begin - let path = Path.relative dir s in - let data = - Build.lines_of path - >>^ Value.L.strings - in - Resolved_forms.add_ddep acc ~key data - end - | Macro (Read_strings, s) -> begin - let path = Path.relative dir s in - let data = - Build.strings path - >>^ Value.L.strings - in - Resolved_forms.add_ddep acc ~key data - end - | Macro (Path_no_dep, s) -> Some [Value.Dir (Path.relative dir s)]) - in - Option.iter res ~f:(fun v -> - acc.sdeps <- Path.Set.union - (Path.Set.of_list (Value.L.deps_only v)) acc.sdeps - ); - res - in - let t = U.partial_expand t ~dir ~map_exe ~f:expand in - (t, acc) + Expander.with_expander (fun expander -> + let f = expander sctx ~dir ~dep_kind ~scope ~targets_written_by_user + ~map_exe ~bindings in + U.partial_expand t ~dir ~map_exe ~f) let expand_step2 ~dir ~dynamic_expansions ~bindings ~(deps_written_by_user : Path.t Jbuild.Bindings.t) @@ -826,13 +895,13 @@ module Action = struct sprintf "- %s" (Utils.describe_target target)) |> String.concat ~sep:"\n")); let build = - Build.record_lib_deps_simple forms.lib_deps + Build.record_lib_deps_simple (Expander.Resolved_forms.lib_deps forms) >>> - Build.path_set (Path.Set.union deps forms.sdeps) + Build.path_set (Path.Set.union deps (Expander.Resolved_forms.sdeps forms)) >>> Build.arr (fun paths -> ((), paths)) >>> - let ddeps = String.Map.to_list forms.ddeps in + let ddeps = String.Map.to_list (Expander.Resolved_forms.ddeps forms) in Build.first (Build.all (List.map ddeps ~f:snd)) >>^ (fun (vals, deps_written_by_user) -> let dynamic_expansions = @@ -857,7 +926,7 @@ module Action = struct >>> Build.action_dyn () ~dir ~targets in - match forms.failures with + match Expander.Resolved_forms.failures forms with | [] -> build | fail :: _ -> Build.fail fail >>> build end From 39c1cef1283a4f0323baa8d3a5f0632f79bb9fbf Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 12 Jul 2018 13:14:44 +0200 Subject: [PATCH 3/7] Allow to expand multiple values in OSL Variables that expand to multiple values will be interpreted correctly as OSL elements Signed-off-by: Rudi Grinberg --- src/ordered_set_lang.ml | 55 ++++++++++++++++++++++------------- src/ordered_set_lang.mli | 9 +++--- src/super_context.ml | 63 ++++++++++++++++++++-------------------- 3 files changed, 71 insertions(+), 56 deletions(-) diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 6301e562..60ed9755 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -10,6 +10,10 @@ module Ast = struct | Union : ('a, 'b) t list -> ('a, 'b) t | Diff : ('a, 'b) t * ('a, 'b) t -> ('a, 'b) t | Include : String_with_vars.t -> ('a, unexpanded) t + + let of_list = function + | [x] -> Element x + | xs -> Union (List.map ~f:(fun x -> Element x) xs) end type 'ast generic = @@ -32,7 +36,7 @@ module Parse = struct peek_exn >>= function | Atom (loc, A "\\") -> Loc.fail loc "unexpected \\" | (Atom (_, A "") | Quoted_string (_, _)) | Template _ -> - elt >>| fun x -> Element x + elt | Atom (loc, A s) -> begin match s with | ":standard" -> @@ -43,7 +47,7 @@ module Parse = struct | _ when s.[0] = ':' -> Loc.fail loc "undefined symbol %s" s | _ -> - elt >>| fun x -> Element x + elt end | List (_, Atom (loc, A s) :: _) -> begin match s, kind with @@ -88,7 +92,8 @@ end let t = let open Stanza.Of_sexp in get_all >>= fun context -> - located (Parse.without_include ~elt:(plain_string (fun ~loc s -> (loc, s)))) + located (Parse.without_include + ~elt:(plain_string (fun ~loc s -> Ast.Element (loc, s)))) >>| fun (loc, ast) -> { ast; loc = Some loc; context } @@ -210,10 +215,12 @@ let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default module Unexpanded = struct type ast = (String_with_vars.t, Ast.unexpanded) Ast.t type t = ast generic - let t = + let t : t Sexp.Of_sexp.t = let open Stanza.Of_sexp in get_all >>= fun context -> - located (Parse.with_include ~elt:String_with_vars.t) + located ( + Parse.with_include + ~elt:(String_with_vars.t >>| fun s -> Ast.Element s)) >>| fun (loc, ast) -> { ast ; loc = Some loc @@ -239,12 +246,11 @@ module Unexpanded = struct let field ?(default=standard) name = Stanza.Of_sexp.field name t ~default let files t ~f = - let rec loop acc (t : ast) = + let rec loop acc (ast : ast) = let open Ast in - match t with + match ast with | Element _ | Standard -> acc - | Include fn -> - String.Set.add acc (f fn) + | Include fn -> Path.Set.add acc (f fn) | Union l -> List.fold_left l ~init:acc ~f:loop | Diff (l, r) -> @@ -255,7 +261,7 @@ module Unexpanded = struct | Some (0, _)-> File_tree.Dune_file.Kind.Jbuild | None | Some (_, _) -> Dune in - (syntax, loop String.Set.empty t.ast) + (syntax, loop Path.Set.empty t.ast) let has_special_forms t = let rec loop (t : ast) = @@ -291,31 +297,40 @@ module Unexpanded = struct in loop t.ast Pos init - let expand t ~files_contents ~f = + let expand t ~dir ~files_contents ~(f : String_with_vars.t -> Value.t list) = let context = t.context in + let f_elems s = + let loc = String_with_vars.loc s in + List.map ~f:(fun s -> (loc, Value.to_string ~dir s)) (f s) + |> Ast.of_list + in let rec expand (t : ast) : ast_expanded = let open Ast in match t with - | Element s -> Element (String_with_vars.loc s, f s) + | Element s -> f_elems s | Standard -> Standard | Include fn -> let sexp = - let fn = f fn in - match String.Map.find files_contents fn with + let path = + match f fn with + | [x] -> Value.to_path ~dir x + | _ -> + Exn.code_error "Ordered_set_lang.Unexpanded.expand path" + ["fn", String_with_vars.sexp_of_t fn] + in + match Path.Map.find files_contents path with | Some x -> x | None -> Exn.code_error "Ordered_set_lang.Unexpanded.expand" - [ "included-file", Quoted_string fn - ; "files", Sexp.To_sexp.(list string) - (String.Map.keys files_contents) + [ "included-file", Path.sexp_of_t path + ; "files", Sexp.To_sexp.(list Path.sexp_of_t) + (Path.Map.keys files_contents) ] in let open Stanza.Of_sexp in parse - (Parse.without_include - ~elt:(String_with_vars.t >>| fun s -> - (String_with_vars.loc s, f s))) + (Parse.without_include ~elt:(String_with_vars.t >>| f_elems)) context sexp | Union l -> Union (List.map l ~f:expand) diff --git a/src/ordered_set_lang.mli b/src/ordered_set_lang.mli index be36d9cb..6ebaf74f 100644 --- a/src/ordered_set_lang.mli +++ b/src/ordered_set_lang.mli @@ -65,16 +65,17 @@ module Unexpanded : sig (** List of files needed to expand this set *) val files : t - -> f:(String_with_vars.t -> string) - -> Sexp.syntax * String.Set.t + -> f:(String_with_vars.t -> Path.t) + -> Sexp.syntax * Path.Set.t (** Expand [t] using with the given file contents. [file_contents] is a map from filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by [Map.find files_contents fn]. Every element is converted to a string using [f]. *) val expand : t - -> files_contents:Sexp.Ast.t String.Map.t - -> f:(String_with_vars.t -> string) + -> dir:Path.t + -> files_contents:Sexp.Ast.t Path.Map.t + -> f:(String_with_vars.t -> Value.t list) -> expanded type position = Pos | Neg diff --git a/src/super_context.ml b/src/super_context.ml index f5b57d71..c22944e1 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -95,50 +95,49 @@ let expand_ocaml_config t pform name = "Unknown ocaml configuration variable %S" name -let (expand_vars_string, expand_vars_path) = - let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s = - String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version -> - (match Pform.Map.expand bindings ~syntax_version ~pform with - | None -> Pform.Map.expand t.pforms ~syntax_version ~pform - | Some _ as x -> x) - |> Option.map ~f:(function - | Pform.Expansion.Var (Values l) -> l - | Macro (Ocaml_config, s) -> expand_ocaml_config t pform s - | Var Project_root -> [Value.Dir (Scope.root scope)] - | _ -> - Loc.fail (String_with_vars.Var.loc pform) - "%s isn't allowed in this position" - (String_with_vars.Var.describe pform))) - in - 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 ?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_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s = + String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version -> + (match Pform.Map.expand bindings ~syntax_version ~pform with + | None -> Pform.Map.expand t.pforms ~syntax_version ~pform + | Some _ as x -> x) + |> Option.map ~f:(function + | Pform.Expansion.Var (Values l) -> l + | Macro (Ocaml_config, s) -> expand_ocaml_config t pform s + | Var Project_root -> [Value.Dir (Scope.root scope)] + | _ -> + Loc.fail (String_with_vars.Var.loc pform) + "%s isn't allowed in this position" + (String_with_vars.Var.describe pform))) + +let expand_vars_string t ~scope ~dir ?bindings s = + expand_vars t ~mode:Single ~scope ~dir ?bindings s + |> Value.to_string ~dir + +let expand_vars_path t ~scope ~dir ?bindings s = + expand_vars t ~mode:Single ~scope ~dir ?bindings s + |> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir let expand_and_eval_set t ~scope ~dir ?bindings set ~standard = let open Build.O 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 + let (syntax, files) = + let f = expand_vars_path t ~scope ~dir ?bindings in + Ordered_set_lang.Unexpanded.files set ~f in + let f = expand_vars t ~mode:Many ~scope ~dir ?bindings in + match Path.Set.to_list files with | [] -> let set = - Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f + Ordered_set_lang.Unexpanded.expand set ~dir + ~files_contents:Path.Map.empty ~f in standard >>^ fun standard -> Ordered_set_lang.String.eval set ~standard ~parse - | files -> - let paths = List.map files ~f:(Path.relative dir) in + | paths -> Build.fanout standard (Build.all (List.map paths ~f:(fun f -> Build.read_sexp f syntax))) >>^ fun (standard, sexps) -> - let files_contents = List.combine files sexps |> String.Map.of_list_exn in - let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in + let files_contents = List.combine paths sexps |> Path.Map.of_list_exn in + let set = Ordered_set_lang.Unexpanded.expand set ~dir ~files_contents ~f in Ordered_set_lang.String.eval set ~standard ~parse module Env = struct From b0e39d30f0cbd1f774743e3851dd5920c95c369e Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 12 Jul 2018 15:03:31 +0100 Subject: [PATCH 4/7] Deforest a bit Signed-off-by: Jeremie Dimino --- src/ordered_set_lang.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index 60ed9755..a65eeeca 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -11,9 +11,9 @@ module Ast = struct | Diff : ('a, 'b) t * ('a, 'b) t -> ('a, 'b) t | Include : String_with_vars.t -> ('a, unexpanded) t - let of_list = function - | [x] -> Element x - | xs -> Union (List.map ~f:(fun x -> Element x) xs) + let union = function + | [x] -> x + | xs -> Union xs end type 'ast generic = @@ -301,8 +301,8 @@ module Unexpanded = struct let context = t.context in let f_elems s = let loc = String_with_vars.loc s in - List.map ~f:(fun s -> (loc, Value.to_string ~dir s)) (f s) - |> Ast.of_list + Ast.union + (List.map (f s) ~f:(fun s -> Ast.Element (loc, Value.to_string ~dir s))) in let rec expand (t : ast) : ast_expanded = let open Ast in From 0db935669298e60dac1c0a19f22054c39b6b3cf2 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 13 Jul 2018 11:38:32 +0200 Subject: [PATCH 5/7] Fix code error in expansion Signed-off-by: Rudi Grinberg --- src/ordered_set_lang.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/ordered_set_lang.ml b/src/ordered_set_lang.ml index a65eeeca..393f7a76 100644 --- a/src/ordered_set_lang.ml +++ b/src/ordered_set_lang.ml @@ -315,8 +315,9 @@ module Unexpanded = struct match f fn with | [x] -> Value.to_path ~dir x | _ -> - Exn.code_error "Ordered_set_lang.Unexpanded.expand path" - ["fn", String_with_vars.sexp_of_t fn] + Loc.fail (String_with_vars.loc fn) + "An unquoted templated expanded to more than one value. \ + A file path is expected in this position." in match Path.Map.find files_contents path with | Some x -> x From 62e7684f3bc0ac24b49d5fea54e6b3c35dd1d3d6 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 13 Jul 2018 11:51:33 +0200 Subject: [PATCH 6/7] Make the types of expanders uniform everywhere No labels, and consistent parameter order Signed-off-by: Rudi Grinberg --- src/action.mli | 4 ++-- src/pform.ml | 2 +- src/pform.mli | 6 +----- src/string_with_vars.ml | 2 ++ src/string_with_vars.mli | 6 ++++-- src/super_context.ml | 16 ++++++---------- 6 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/action.mli b/src/action.mli index 6c103f51..4a7d32ad 100644 --- a/src/action.mli +++ b/src/action.mli @@ -83,7 +83,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(String_with_vars.Var.t -> Syntax.Version.t -> Value.t list option) + -> f:(Value.t list option String_with_vars.expander) -> Unresolved.t end @@ -91,7 +91,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(String_with_vars.Var.t -> Syntax.Version.t -> Value.t list option) + -> f:(Value.t list option String_with_vars.expander) -> Partial.t end diff --git a/src/pform.ml b/src/pform.ml index 238192d7..17165b58 100644 --- a/src/pform.ml +++ b/src/pform.ml @@ -187,7 +187,7 @@ module Map = struct Syntax.Error.deleted_in (String_with_vars.Var.loc pform) Stanza.syntax syntax_version ~what:(describe pform) ?repl - let expand t ~syntax_version ~pform = + let expand t pform syntax_version = match String_with_vars.Var.payload pform with | None -> Option.map (expand t.vars ~syntax_version ~pform) ~f:(fun x -> diff --git a/src/pform.mli b/src/pform.mli index fcce5f06..4d5bf6a7 100644 --- a/src/pform.mli +++ b/src/pform.mli @@ -48,11 +48,7 @@ module Map : sig val input_file : Path.t -> t - val expand - : t - -> syntax_version:Syntax.Version.t - -> pform:String_with_vars.Var.t - -> Expansion.t option + val expand : t -> Expansion.t option String_with_vars.expander val empty : t end diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 67c8e9ae..4a788f25 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -264,6 +264,8 @@ let partial_expand end | _ -> loop [] [] template.parts +type 'a expander = Var.t -> Syntax.Version.t -> 'a + let expand t ~mode ~dir ~f = match partial_expand t ~mode ~dir ~f:(fun var syntax_version -> diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index 48936764..f81a63b3 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -64,16 +64,18 @@ module Var : sig val describe : t -> string end +type 'a expander = Var.t -> Syntax.Version.t -> 'a + val expand : t -> mode:'a Mode.t -> dir:Path.t - -> f:(Var.t -> Syntax.Version.t -> Value.t list option) + -> f:(Value.t list option expander) -> 'a val partial_expand : t -> mode:'a Mode.t -> dir:Path.t - -> f:(Var.t -> Syntax.Version.t -> Value.t list option) + -> f:(Value.t list option expander) -> 'a Partial.t diff --git a/src/super_context.ml b/src/super_context.ml index c22944e1..fccb2bde 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -97,8 +97,8 @@ let expand_ocaml_config t pform name = let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s = String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version -> - (match Pform.Map.expand bindings ~syntax_version ~pform with - | None -> Pform.Map.expand t.pforms ~syntax_version ~pform + (match Pform.Map.expand bindings pform syntax_version with + | None -> Pform.Map.expand t.pforms pform syntax_version | Some _ as x -> x) |> Option.map ~f:(function | Pform.Expansion.Var (Values l) -> l @@ -591,9 +591,7 @@ module Expander : sig -> targets_written_by_user:targets -> map_exe:(Path.t -> Path.t) -> bindings:Pform.Map.t - -> String_with_vars.Var.t - -> Syntax.Version.t - -> Value.t list option + -> Value.t list option String_with_vars.expander val with_expander : (expander -> 'a) -> 'a * Resolved_forms.t end = struct @@ -643,9 +641,7 @@ end = struct -> targets_written_by_user:targets -> map_exe:(Path.t -> Path.t) -> bindings:Pform.Map.t - -> String_with_vars.Var.t - -> Syntax.Version.t - -> Value.t list option + -> Value.t list option String_with_vars.expander let path_exp path = [Value.Path path] let str_exp str = [Value.String str] @@ -663,7 +659,7 @@ end = struct let loc = String_with_vars.Var.loc pform in let key = String_with_vars.Var.full_name pform in let res = - Pform.Map.expand bindings ~syntax_version ~pform + Pform.Map.expand bindings pform syntax_version |> Option.bind ~f:(function | Pform.Expansion.Var (Values l) -> Some l | Macro (Ocaml_config, s) -> Some (expand_ocaml_config sctx pform s) @@ -819,7 +815,7 @@ module Action = struct match String.Map.find dynamic_expansions key with | Some _ as opt -> opt | None -> - Option.map (Pform.Map.expand bindings ~syntax_version ~pform) ~f:(function + Option.map (Pform.Map.expand bindings pform syntax_version) ~f:(function | Var Named_local -> begin match Jbuild.Bindings.find deps_written_by_user key with | None -> From 2ec21d7b946e7ec1b6b4e48a2917b2cd9c3f58ce Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 13 Jul 2018 12:07:16 +0200 Subject: [PATCH 7/7] Pass extra params to with_expander Signed-off-by: Rudi Grinberg --- src/string_with_vars.ml | 2 +- src/string_with_vars.mli | 2 +- src/super_context.ml | 36 ++++++++++++------------------------ 3 files changed, 14 insertions(+), 26 deletions(-) diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 4a788f25..6237ac5e 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -158,7 +158,7 @@ let concat_rev = function | l -> String.concat (List.rev l) ~sep:"" module Mode = struct - type 'a t = + type _ t = | Single : Value.t t | Many : Value.t list t diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index f81a63b3..4a3736bd 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -35,7 +35,7 @@ val is_var : t -> name:string -> bool val text_only : t -> string option module Mode : sig - type 'a t = + type _ t = | Single : Value.t t | Many : Value.t list t end diff --git a/src/super_context.ml b/src/super_context.ml index fccb2bde..f956c69f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -583,17 +583,16 @@ module Expander : sig type sctx = t - type expander - = sctx + val with_expander + : sctx -> dir:Path.t -> dep_kind:Build.lib_dep_kind -> scope:Scope.t -> targets_written_by_user:targets -> map_exe:(Path.t -> Path.t) -> bindings:Pform.Map.t - -> Value.t list option String_with_vars.expander - - val with_expander : (expander -> 'a) -> 'a * Resolved_forms.t + -> f:(Value.t list option String_with_vars.expander -> 'a) + -> 'a * Resolved_forms.t end = struct module Resolved_forms = struct type t = @@ -633,16 +632,6 @@ end = struct type sctx = t - type expander - = sctx - -> dir:Path.t - -> dep_kind:Build.lib_dep_kind - -> scope:Scope.t - -> targets_written_by_user:targets - -> map_exe:(Path.t -> Path.t) - -> bindings:Pform.Map.t - -> Value.t list option String_with_vars.expander - let path_exp path = [Value.Path path] let str_exp str = [Value.String str] @@ -772,11 +761,12 @@ end = struct ); res - let with_expander - : 'a. (expander -> 'a) -> 'a * Resolved_forms.t - = fun f -> - let acc = Resolved_forms.empty () in - (f (expander ~acc), acc) + let with_expander sctx ~dir ~dep_kind ~scope ~targets_written_by_user + ~map_exe ~bindings ~f = + let acc = Resolved_forms.empty () in + ( f (expander ~acc sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe ~bindings) + , acc + ) end module Action = struct @@ -801,10 +791,8 @@ module Action = struct let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe ~bindings t = - Expander.with_expander (fun expander -> - let f = expander sctx ~dir ~dep_kind ~scope ~targets_written_by_user - ~map_exe ~bindings in - U.partial_expand t ~dir ~map_exe ~f) + Expander.with_expander sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe ~bindings + ~f:(fun f -> U.partial_expand t ~dir ~map_exe ~f) let expand_step2 ~dir ~dynamic_expansions ~bindings ~(deps_written_by_user : Path.t Jbuild.Bindings.t)