diff --git a/src/action.ml b/src/action.ml index e5cf7a8efd02..3c9e9ec43cbf 100644 --- a/src/action.ml +++ b/src/action.ml @@ -270,53 +270,14 @@ module Unresolved = struct | Search s -> Ok (f s)) end -module Var_expansion = struct - type t = - | Paths of Path.t list - | Strings of string list - - let length = function - | Paths x -> List.length x - | Strings x -> List.length x - - let is_multivalued = function - | Paths [_] -> false - | Strings [_] -> false - | _ -> true - - type context = Path.t (* For String_with_vars.Expand_to *) - - let concat = function - | [s] -> s - | l -> String.concat ~sep:" " l - - let string_of_path ~dir p = Path.reach ~from:dir p - let path_of_string dir s = Path.relative dir s - - let to_strings dir = function - | Strings l -> l - | Paths l -> List.map l ~f:(string_of_path ~dir) - - let to_string (dir: context) = function - | Strings l -> concat l - | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) - - let to_path dir = function - | Strings l -> path_of_string dir (concat l) - | Paths [p] -> p - | Paths l -> - path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) - - let to_prog_and_args dir exp : Unresolved.Program.t * string list = - let module P = Unresolved.Program in - match exp with - | Paths (x::xs) -> (This x, to_strings dir (Paths xs)) - | Strings (s::xs) -> (P.of_string ~dir s, to_strings dir (Strings xs)) - | Paths [] | Strings [] -> (Search "", []) -end +let var_expansion_to_prog_and_args dir exp : Unresolved.Program.t * string list = + let module P = Unresolved.Program in + match (exp : Var_expansion.t) with + | Paths (x::xs) -> (This x, Var_expansion.to_strings dir (Paths xs)) + | Strings (s::xs) -> ( P.of_string ~dir s + , Var_expansion.to_strings dir (Strings xs)) + | Paths [] | Strings [] -> (Search "", []) -module VE = Var_expansion -module To_VE = String_with_vars.Expand_to(VE) module SW = String_with_vars module Unexpanded = struct @@ -357,37 +318,39 @@ module Unexpanded = struct let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function | Left x -> map x | Right template -> - match To_VE.expand dir template ~f ~allow_multivalue with - | Expansion e -> special dir e - | String s -> generic dir s + match + Var_expansion.Expand.expand dir template ~f ~allow_multivalue + with + | Expansion e -> special dir e + | String s -> generic dir s [@@inlined always] let string ~dir ~f x = expand ~dir ~f x ~allow_multivalue:false ~generic:(fun _dir x -> x) - ~special:VE.to_string + ~special:Var_expansion.to_string ~map:(fun x -> x) let strings ~dir ~f x = expand ~dir ~f x ~allow_multivalue:true ~generic:(fun _dir x -> [x]) - ~special:VE.to_strings + ~special:Var_expansion.to_strings ~map:(fun x -> [x]) let path ~dir ~f x = expand ~dir ~f x ~allow_multivalue:false - ~generic:VE.path_of_string - ~special:VE.to_path + ~generic:Var_expansion.path_of_string + ~special:Var_expansion.to_path ~map:(fun x -> x) let prog_and_args ~dir ~f x = expand ~dir ~f x ~allow_multivalue:true ~generic:(fun _dir s -> (Program.of_string ~dir s, [])) - ~special:VE.to_prog_and_args + ~special:var_expansion_to_prog_and_args ~map:(fun x -> (x, [])) end @@ -452,7 +415,9 @@ module Unexpanded = struct module E = struct let expand ~generic ~special ~dir ~allow_multivalue ~f template = - match To_VE.partial_expand dir template ~allow_multivalue ~f with + match + Var_expansion.Expand.partial_expand dir template ~allow_multivalue ~f + with | Expansion e -> Left (special dir e) | String s -> Left (generic dir s) | Unexpanded x -> Right x @@ -461,25 +426,25 @@ module Unexpanded = struct expand ~dir ~f x ~allow_multivalue:false ~generic:(fun _dir x -> x) - ~special:VE.to_string + ~special:Var_expansion.to_string let strings ~dir ~f x = expand ~dir ~f x ~allow_multivalue:true ~generic:(fun _dir x -> [x]) - ~special:VE.to_strings + ~special:Var_expansion.to_strings let path ~dir ~f x = expand ~dir ~f x ~allow_multivalue:false - ~generic:VE.path_of_string - ~special:VE.to_path + ~generic:Var_expansion.path_of_string + ~special:Var_expansion.to_path let prog_and_args ~dir ~f x = expand ~dir ~f x ~allow_multivalue:true ~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, [])) - ~special:VE.to_prog_and_args + ~special:var_expansion_to_prog_and_args end let rec partial_expand t ~dir ~map_exe ~f : Partial.t = diff --git a/src/action.mli b/src/action.mli index 89e0a91faef9..310dcd891546 100644 --- a/src/action.mli +++ b/src/action.mli @@ -1,16 +1,5 @@ open! Import -module Var_expansion : sig - type t = - | Paths of Path.t list - | Strings of string list - - val to_string : Path.t -> t -> string - (** [to_string dir v] convert the variable expansion to a string. - If it is a path, the corresponding string will be relative to - [dir]. *) -end - module Outputs : module type of struct include Action_intf.Outputs end (** result of the lookup of a program, the path to it or information about the diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 80f9de61a516..23ebe737284a 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -190,8 +190,7 @@ include Sub_system.Register_end_point( in let extra_vars = - String.Map.singleton "library-name" - (Action.Var_expansion.Strings [lib.name]) + String.Map.singleton "library-name" (Var_expansion.Strings [lib.name]) in let runner_libs = @@ -213,7 +212,7 @@ 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 = - Action.Var_expansion.Paths ( + Var_expansion.Paths ( List.filter_map source_modules ~f:(fun m -> Module.file m ~dir ml_kind)) in diff --git a/src/super_context.ml b/src/super_context.ml index 63a354975df9..1c64c9f0da96 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -35,7 +35,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : (Path.t * Scope.t * Stanza.t) list ; cxx_flags : string list - ; vars : Action.Var_expansion.t String.Map.t + ; vars : Var_expansion.t String.Map.t ; chdir : (Action.t, Action.t) Build.t ; host : t option ; libs_by_package : (Package.t * Lib.Set.t) Package.Name.Map.t @@ -82,7 +82,7 @@ let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = | "SCOPE_ROOT" -> Some (Path.reach ~from:dir (Scope.root scope)) | var -> - Option.map ~f:(fun e -> Action.Var_expansion.to_string dir e) + Option.map ~f:(fun e -> Var_expansion.to_string dir e) (match expand_var_no_root t var with | Some _ as x -> x | None -> String.Map.find extra_vars var)) @@ -248,7 +248,7 @@ let create | None -> Path.relative context.ocaml_bin "ocamlopt" | Some p -> p in - let open Action.Var_expansion in + let open Var_expansion in let make = match Bin.make with | None -> Strings ["make"] @@ -566,7 +566,7 @@ module Action = struct ; (* Static deps from ${...} variables. For instance ${exe:...} *) mutable sdeps : Path.Set.t ; (* Dynamic deps from ${...} variables. For instance ${read:...} *) - mutable ddeps : (unit, Action.Var_expansion.t) Build.t String.Map.t + mutable ddeps : (unit, Var_expansion.t) Build.t String.Map.t } let add_lib_dep acc lib kind = @@ -580,8 +580,8 @@ module Action = struct acc.ddeps <- String.Map.add acc.ddeps key dep; None - let path_exp path = Action.Var_expansion.Paths [path] - let str_exp path = Action.Var_expansion.Strings [path] + let path_exp path = Var_expansion.Paths [path] + let str_exp path = Var_expansion.Strings [path] let map_exe sctx = match sctx.host with @@ -608,7 +608,7 @@ module Action = struct ; ddeps = String.Map.empty } in - let open Action.Var_expansion in + let open Var_expansion in let expand loc key var = function | Some ("exe" , s) -> Some (path_exp (map_exe (Path.relative dir s))) | Some ("path" , s) -> Some (path_exp (Path.relative dir s) ) @@ -729,7 +729,7 @@ module Action = struct (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = - let open Action.Var_expansion in + let open Var_expansion in U.Partial.expand t ~dir ~map_exe ~f:(fun loc key -> match String.Map.find dynamic_expansions key with | Some _ as opt -> opt @@ -740,9 +740,9 @@ module Action = struct Some (match deps_written_by_user with | [] -> - Loc.warn loc "Variable '<' used with no explicit \ - dependencies@."; - Strings [""] + Loc.warn loc "Variable '<' used with no explicit \ + dependencies@."; + Strings [""] | dep :: _ -> Paths [dep]) | "^" -> Some (Paths deps_written_by_user) diff --git a/src/super_context.mli b/src/super_context.mli index a762c9609cca..1daed6992acd 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -72,7 +72,7 @@ val expand_vars : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> String_with_vars.t -> string @@ -80,7 +80,7 @@ val expand_and_eval_set : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> Ordered_set_lang.Unexpanded.t -> standard:(unit, string list) Build.t -> (unit, string list) Build.t @@ -208,7 +208,7 @@ module Action : sig val run : t -> loc:Loc.t - -> ?extra_vars:Action.Var_expansion.t String.Map.t + -> ?extra_vars:Var_expansion.t String.Map.t -> Action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind diff --git a/src/var_expansion.ml b/src/var_expansion.ml new file mode 100644 index 000000000000..8dc6d996d755 --- /dev/null +++ b/src/var_expansion.ml @@ -0,0 +1,44 @@ +open Stdune + +module T = struct + type t = + | Paths of Path.t list + | Strings of string list + + let length = function + | Paths x -> List.length x + | Strings x -> List.length x + + let is_multivalued = function + | Paths [_] -> false + | Strings [_] -> false + | _ -> true + + type context = Path.t (* For String_with_vars.Expand_to *) + + let concat = function + | [s] -> s + | l -> String.concat ~sep:" " l + + let string_of_path ~dir p = Path.reach ~from:dir p + + let to_string (dir: context) = function + | Strings l -> concat l + | Paths l -> concat (List.map l ~f:(string_of_path ~dir)) +end + +include T + +module Expand = String_with_vars.Expand_to(T) + +let path_of_string dir s = Path.relative dir s + +let to_strings dir = function + | Strings l -> l + | Paths l -> List.map l ~f:(string_of_path ~dir) + +let to_path dir = function + | Strings l -> path_of_string dir (concat l) + | Paths [p] -> p + | Paths l -> + path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) diff --git a/src/var_expansion.mli b/src/var_expansion.mli new file mode 100644 index 000000000000..09819fcf8f34 --- /dev/null +++ b/src/var_expansion.mli @@ -0,0 +1,19 @@ +open Stdune + +type t = + | Paths of Path.t list + | Strings of string list + +val to_string : Path.t -> t -> string +(** [to_string dir v] convert the variable expansion to a string. + If it is a path, the corresponding string will be relative to + [dir]. *) + +val path_of_string : Path.t -> string -> Path.t + +val to_strings : Path.t -> t -> string list + +val to_path : Path.t -> t -> Path.t + +module Expand : String_with_vars.Expand_intf + with type expansion = t and type context = Path.t