From 589943df60b9a076bb365ec0041510314a0e063c Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 5 Jun 2018 23:42:32 +0700 Subject: [PATCH] Simplify String_with_vars Make it expand only to Value.t since the string only version wasn't really used. Variable expansions are now Value.t list. Which also gives the flexibility for a value to expand to a collection of more than 1 value. Signed-off-by: Rudi Grinberg --- src/action.ml | 107 ++++++++------------ src/action.mli | 4 +- src/inline_tests.ml | 4 +- src/stdune/either.ml | 5 + src/stdune/either.mli | 2 + src/string_with_vars.ml | 206 ++++++++++++++++----------------------- src/string_with_vars.mli | 85 +++------------- src/super_context.ml | 72 +++++++------- src/super_context.mli | 8 +- src/value.ml | 27 +++++ src/value.mli | 17 ++++ src/var_expansion.ml | 61 ------------ src/var_expansion.mli | 34 ------- 13 files changed, 237 insertions(+), 395 deletions(-) create mode 100644 src/value.ml create mode 100644 src/value.mli delete mode 100644 src/var_expansion.ml delete mode 100644 src/var_expansion.mli diff --git a/src/action.ml b/src/action.ml index 3c9e9ec4..c2ef1c7f 100644 --- a/src/action.ml +++ b/src/action.ml @@ -270,13 +270,12 @@ module Unresolved = struct | Search s -> Ok (f s)) 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 "", []) +let prog_and_args_of_values p ~dir = + match p with + | [] -> (Unresolved.Program.Search "", []) + | Value.Path p :: xs -> (This p, Value.to_strings ~dir xs) + | String s :: xs -> + (Unresolved.Program.of_string ~dir s, Value.to_strings ~dir xs) module SW = String_with_vars @@ -315,43 +314,33 @@ module Unexpanded = struct include Past module E = struct - let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function - | Left x -> map x - | Right template -> - match - Var_expansion.Expand.expand dir template ~f ~allow_multivalue - with - | Expansion e -> special dir e - | String s -> generic dir s - [@@inlined always] + let expand ~dir ~mode ~f ~l ~r = + Either.map ~l + ~r:(fun s -> r (String_with_vars.expand s ~dir ~f ~mode) ~dir) - let string ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:(fun _dir x -> x) - ~special:Var_expansion.to_string - ~map:(fun x -> x) + let string = + expand ~mode:Single + ~l:(fun x -> x) + ~r:Value.to_string - let strings ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir x -> [x]) - ~special:Var_expansion.to_strings - ~map:(fun x -> [x]) + let strings = + expand ~mode:Many + ~l:(fun x -> [x]) + ~r:Value.to_strings - let path ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:Var_expansion.path_of_string - ~special:Var_expansion.to_path - ~map:(fun x -> x) + let path e = + let error_loc = + match e with + | Left _ -> None + | Right r -> Some (String_with_vars.loc r) in + expand ~mode:Single + ~l:(fun x -> x) + ~r:Value.(to_path ?error_loc) e - let prog_and_args ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir s -> (Program.of_string ~dir s, [])) - ~special:var_expansion_to_prog_and_args - ~map:(fun x -> (x, [])) + let prog_and_args = + expand ~mode:Many + ~l:(fun x -> (x, [])) + ~r:prog_and_args_of_values end let rec expand t ~dir ~map_exe ~f : Unresolved.t = @@ -414,37 +403,17 @@ module Unexpanded = struct end module E = struct - let expand ~generic ~special ~dir ~allow_multivalue ~f template = - match - Var_expansion.Expand.partial_expand dir template ~allow_multivalue ~f - with - | Expansion e -> Left (special dir e) - | String s -> Left (generic dir s) + let expand ~dir ~mode ~f ~map x = + match String_with_vars.partial_expand ~mode ~dir ~f x with + | Expanded e -> Left (map e ~dir) | Unexpanded x -> Right x - let string ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~generic:(fun _dir x -> x) - ~special:Var_expansion.to_string - - let strings ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:true - ~generic:(fun _dir x -> [x]) - ~special:Var_expansion.to_strings - - let path ~dir ~f x = - expand ~dir ~f x - ~allow_multivalue:false - ~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:var_expansion_to_prog_and_args + let string = expand ~mode:Single ~map:(Value.to_string) + let strings = expand ~mode:Many ~map:(Value.to_strings) + let path x = + let error_loc = String_with_vars.loc x in + expand ~mode:Single ~map:(Value.to_path ~error_loc) x + let prog_and_args = expand ~mode:Many ~map:(prog_and_args_of_values) end let rec partial_expand t ~dir ~map_exe ~f : Partial.t = diff --git a/src/action.mli b/src/action.mli index 310dcd89..e3972fdd 100644 --- a/src/action.mli +++ b/src/action.mli @@ -82,7 +82,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> String.t -> Var_expansion.t option) + -> f:(Loc.t -> String.t -> Value.t list option) -> Unresolved.t end @@ -90,7 +90,7 @@ module Unexpanded : sig : t -> dir:Path.t -> map_exe:(Path.t -> Path.t) - -> f:(Loc.t -> string -> Var_expansion.t option) + -> f:(Loc.t -> string -> Value.t list option) -> Partial.t end diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 27ff3d43..3c202834 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -187,7 +187,7 @@ include Sub_system.Register_end_point( in let extra_vars = - String.Map.singleton "library-name" (Var_expansion.Strings [lib.name]) + String.Map.singleton "library-name" ([Value.String lib.name]) in let runner_libs = @@ -209,7 +209,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 = - Var_expansion.Paths ( + Value.paths ( List.filter_map source_modules ~f:(fun m -> Module.file m ~dir ml_kind)) in diff --git a/src/stdune/either.ml b/src/stdune/either.ml index 082092aa..f76d48f3 100644 --- a/src/stdune/either.ml +++ b/src/stdune/either.ml @@ -1,3 +1,8 @@ type ('a, 'b) t = | Left of 'a | Right of 'b + +let map t ~l ~r = + match t with + | Left x -> l x + | Right x -> r x diff --git a/src/stdune/either.mli b/src/stdune/either.mli index 621339d8..21bd9125 100644 --- a/src/stdune/either.mli +++ b/src/stdune/either.mli @@ -3,3 +3,5 @@ type ('a, 'b) t = | Left of 'a | Right of 'b + +val map : ('a, 'b) t -> l:('a -> 'c) -> r:('b -> 'c) -> 'c diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index 3860423c..733d51b5 100644 --- a/src/string_with_vars.ml +++ b/src/string_with_vars.ml @@ -104,137 +104,103 @@ let string_of_var syntax v = | Parens -> sprintf "$(%s)" v | Braces -> sprintf "${%s}" v -module type EXPANSION = sig - type t - val length : t -> int - val is_multivalued : t -> bool - type context - val to_string : context -> t -> string -end - let concat_rev = function | [] -> "" | [s] -> s | l -> String.concat (List.rev l) ~sep:"" -module Expand = struct - module Full = struct - type nonrec 'a t = - | Expansion of 'a - | String of string - end - module Partial = struct - type nonrec 'a t = - | Expansion of 'a - | String of string - | Unexpanded of t - end +module Mode = struct + type 'a t = + | Single : Value.t t + | Many : Value.t list t + + let string + : type a. a t -> string -> a + = fun t s -> + match t with + | Single -> Value.String s + | Many -> [Value.String s] + + let value + : type a. a t -> Value.t list -> a option + = fun t s -> + match t, s with + | Many, s -> Some s + | Single, [s] -> Some s + | Single, _ -> None end -module type Expand_intf = sig - type context - type expansion - - val expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Full.t - - val partial_expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Partial.t +module Partial = struct + type nonrec 'a t = + | Expanded of 'a + | Unexpanded of t end -module Expand_to(V: EXPANSION) = struct - type expansion = V.t - type context = V.context +let invalid_multivalue syntax ~var t x = + Loc.fail t.loc "Variable %s expands to %d values, \ + however a single value is expected here. \ + Please quote this atom." + (string_of_var syntax var) (List.length x) - let check_valid_multivalue syntax ~var t x = - if not t.quoted && V.is_multivalued x then - Loc.fail t.loc "Variable %s expands to %d values, \ - however a single value is expected here. \ - Please quote this atom." - (string_of_var syntax var) (V.length x) +let expand t ~mode ~dir ~f = + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + begin match f t.loc v with + | Some e -> + begin match Mode.value mode e with + | None -> invalid_multivalue syntax ~var:v t e + | Some s -> s + end + | None -> Mode.string mode (string_of_var syntax v) + end + | _ -> + Mode.string mode ( + List.concat_map t.items ~f:(function + | Text s -> [s] + | Var (syntax, v) -> + begin match f t.loc v, t.quoted with + | Some ([] | _::_::_ as e) , false -> + invalid_multivalue syntax ~var:v t e + | Some ([_] as t), false + | Some t, true -> Value.to_strings ~dir t + | None, _ -> [string_of_var syntax v] + end) + |> String.concat ~sep:"") - let expand ctx t ~allow_multivalue ~f = - match t.items with - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - (match f t.loc v with - | Some e -> - if not allow_multivalue then - check_valid_multivalue syntax ~var:v t e; - Expand.Full.Expansion e - | None -> Expand.Full.String (string_of_var syntax v)) - | _ -> - Expand.Full.String ( - List.map t.items ~f:(function - | Text s -> s - | Var (syntax, v) -> - match f t.loc v with - | Some x -> - check_valid_multivalue syntax ~var:v t x; - V.to_string ctx x - | None -> string_of_var syntax v) - |> String.concat ~sep:"") - - let partial_expand ctx t ~allow_multivalue ~f = - let commit_text acc_text acc = - let s = concat_rev acc_text in - if s = "" then acc else Text s :: acc - in - let rec loop acc_text acc items = - match items with - | [] -> begin - match acc with - | [] -> Expand.Partial.String (concat_rev acc_text) - | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } - end - | Text s :: items -> loop (s :: acc_text) acc items - | Var (syntax, v) as it :: items -> - match f t.loc v with - | None -> loop [] (it :: commit_text acc_text acc) items - | Some x -> - check_valid_multivalue syntax ~var:v t x; - loop (V.to_string ctx x :: acc_text) acc items - in - match t.items with - | [Var (syntax, v)] when not t.quoted -> - (* Unquoted single var *) - (match f t.loc v with - | Some e -> - if not allow_multivalue then - check_valid_multivalue syntax ~var:v t e; - Expand.Partial.Expansion e - | None -> Expand.Partial.Unexpanded t) - | _ -> loop [] [] t.items -end - -module String_expansion = struct - type t = string - let length _ = 1 - let is_multivalued _ = false - type context = unit - let to_string () (s: string) = s -end - -module S = Expand_to(String_expansion) - -let expand t ~f = - match S.expand () t ~allow_multivalue:true ~f with - | Expand.Full.String s - | Expansion s -> s - -let partial_expand t ~f = - match S.partial_expand () t ~allow_multivalue:true ~f with - | Expand.Partial.Expansion s -> Left s - | String s -> Left s - | Unexpanded s -> Right s +let partial_expand t ~mode ~dir ~f = + let commit_text acc_text acc = + let s = concat_rev acc_text in + if s = "" then acc else Text s :: acc + in + let rec loop acc_text acc items = + match items with + | [] -> + begin match acc with + | [] -> Partial.Expanded (Mode.string mode (concat_rev acc_text)) + | _ -> Unexpanded { t with items = List.rev (commit_text acc_text acc) } + end + | Text s :: items -> loop (s :: acc_text) acc items + | Var (syntax, v) as it :: items -> + begin match f t.loc v with + | Some (([] | _::_) as e) when not t.quoted -> + invalid_multivalue syntax ~var:v t e + | Some t -> + loop (List.rev_append (Value.to_strings ~dir t) acc_text) acc items + | None -> loop [] (it :: commit_text acc_text acc) items + end + in + match t.items with + | [Var (syntax, v)] when not t.quoted -> + (* Unquoted single var *) + begin match f t.loc v with + | Some e -> Partial.Expanded ( + match Mode.value mode e with + | None -> invalid_multivalue syntax ~var:v t e + | Some s -> s) + | None -> Unexpanded t + end + | _ -> loop [] [] t.items let to_string t = match t.items with diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index fa9d5d5f..f29de007 100644 --- a/src/string_with_vars.mli +++ b/src/string_with_vars.mli @@ -45,81 +45,28 @@ val iter : t -> f:(Loc.t -> string -> unit) -> unit val is_var : t -> name:string -> bool -module type EXPANSION = sig - type t - (** The value to which variables are expanded. *) - - val length : t -> int - - val is_multivalued : t -> bool - (** Report whether the value is a multivalued one (such as for - example ${@}) which much be in quoted strings to be concatenated - to text or other variables. *) - - type context - (** Context needed to expand values of type [t] to strings. *) - - val to_string : context -> t -> string - (** When needing to expand with text portions or if the - string-with-vars is quoted, the value is converted to a string - using [to_string]. *) +module Mode : sig + type 'a t = + | Single : Value.t t + | Many : Value.t list t end -module Expand : sig - module Full : sig - type nonrec 'a t = - | Expansion of 'a - | String of string - end - module Partial : sig - type nonrec 'a t = - | Expansion of 'a - | String of string - | Unexpanded of t - end +module Partial : sig + type nonrec 'a t = + | Expanded of 'a + | Unexpanded of t end -module type Expand_intf = sig - type context - type expansion - - val expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Full.t - (** [expand t ~f] return [t] where all variables have been expanded - using [f]. If [f loc var] return [Some x], the variable [var] is - replaced by [x]; otherwise, the variable is inserted using the syntax - it was originally defined with: ${..} or $(..) *) - - val partial_expand - : context - -> t - -> allow_multivalue:bool - -> f:(Loc.t -> string -> expansion option) - -> expansion Expand.Partial.t - (** [partial_expand t ~f] is like [expand_generic] where all - variables that could be expanded (i.e., those for which [f] - returns [Some _]) are. If all the variables of [t] were - expanded, a string is returned. If [f] returns [None] on at - least a variable of [t], it returns a string-with-vars. *) -end - -module Expand_to(V : EXPANSION) : Expand_intf - with type expansion = V.t and type context = V.context - val expand : t - -> f:(Loc.t -> string -> string option) - -> string -(** Specialized version [Expand_to.expand] that returns a string (so - variables are assumed to expand to a single value). *) + -> mode:'a Mode.t + -> dir:Path.t + -> f:(Loc.t -> string -> Value.t list option) + -> 'a val partial_expand : t - -> f:(Loc.t -> string -> string option) - -> (string, t) Either.t -(** [partial_expand] is a specialized version of - [Expand_to.partial_expand] that returns a string. *) + -> mode:'a Mode.t + -> dir:Path.t + -> f:(Loc.t -> string -> Value.t list option) + -> 'a Partial.t diff --git a/src/super_context.ml b/src/super_context.ml index 35b46404..1cc820a0 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -45,7 +45,7 @@ type t = ; artifacts : Artifacts.t ; stanzas_to_consider_for_install : Installable.t list ; cxx_flags : string list - ; vars : Var_expansion.t String.Map.t + ; vars : Value.t list 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 @@ -87,17 +87,24 @@ let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_var_no_root t var = String.Map.find t.vars var let (expand_vars, expand_vars_path) = - let make expander t ~scope ~dir ?(extra_vars=String.Map.empty) s = - expander ~dir s ~f:(fun _loc -> function - | "ROOT" -> Some (Var_expansion.Paths [t.context.build_dir]) - | "SCOPE_ROOT" -> Some (Paths [Scope.root scope]) + let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s = + String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function + | "ROOT" -> Some [Value.Path t.context.build_dir] + | "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)] | var -> (match expand_var_no_root t var with | Some _ as x -> x - | None -> String.Map.find extra_vars var)) in - ( make Var_expansion.Single.string - , make Var_expansion.Single.path - ) + | None -> String.Map.find extra_vars var)) + in + let expand_vars t ~scope ~dir ?extra_vars s = + expand t ~scope ~dir ?extra_vars s + |> Value.to_string ~dir + in + let expand_vars_path t ~scope ~dir ?extra_vars s = + expand t ~scope ~dir ?extra_vars 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 open Build.O in @@ -272,18 +279,17 @@ let create | None -> Path.relative context.ocaml_bin "ocamlopt" | Some p -> p in - let open Var_expansion in + let string s = [Value.String s] in + let path p = [Value.Path p] in let make = match Bin.make with - | None -> Strings ["make"] - | Some p -> Paths [p] + | None -> string "make" + | Some p -> path p in let cflags = context.ocamlc_cflags in - let strings l = Strings l in - let string s = Strings [s] in - let path p = Paths [p] in + let strings = Value.strings in let vars = - [ "-verbose" , Strings ([] (*"-verbose";*)) + [ "-verbose" , [] ; "CPP" , strings (context.c_compiler :: cflags @ ["-E"]) ; "PA_CPP" , strings (context.c_compiler :: cflags @ ["-undef"; "-traditional"; @@ -586,7 +592,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, Var_expansion.t) Build.t String.Map.t + mutable ddeps : (unit, Value.t list) Build.t String.Map.t } let add_lib_dep acc lib kind = @@ -600,8 +606,8 @@ module Action = struct acc.ddeps <- String.Map.add acc.ddeps key dep; None - let path_exp path = Var_expansion.Paths [path] - let str_exp path = Var_expansion.Strings [path] + let path_exp path = [Value.Path path] + let str_exp str = [Value.String str] let map_exe sctx = match sctx.host with @@ -628,7 +634,6 @@ module Action = struct ; ddeps = String.Map.empty } 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) ) @@ -681,8 +686,8 @@ module Action = struct | Some p -> let x = Pkg_version.read sctx p >>^ function - | None -> Strings [""] - | Some s -> Strings [s] + | None -> [Value.String ""] + | Some s -> [String s] in add_ddep acc ~key x | None -> @@ -694,7 +699,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.contents path - >>^ fun s -> Strings [s] + >>^ fun s -> [Value.String s] in add_ddep acc ~key data end @@ -702,7 +707,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.lines_of path - >>^ fun l -> Strings l + >>^ Value.strings in add_ddep acc ~key data end @@ -710,7 +715,7 @@ module Action = struct let path = Path.relative dir s in let data = Build.strings path - >>^ fun l -> Strings l + >>^ Value.strings in add_ddep acc ~key data end @@ -732,7 +737,7 @@ module Action = struct match targets_written_by_user with | Infer -> Loc.fail loc "You cannot use ${@} with inferred rules." | Alias -> Loc.fail loc "You cannot use ${@} in aliases." - | Static l -> Some (Paths l) + | Static l -> Some (Value.paths l) end | _ -> match String.lsplit2 var ~on:':' with @@ -740,16 +745,15 @@ module Action = struct Some (path_exp (Path.relative dir s)) | x -> let exp = expand loc key var x in - (match exp with - | Some (Paths ps) -> - acc.sdeps <- Path.Set.union (Path.Set.of_list ps) acc.sdeps - | _ -> ()); + Option.iter exp ~f:(fun vs -> + acc.sdeps <- + Path.Set.union (Path.Set.of_list (Value.paths_only vs)) acc.sdeps; + ); exp) in (t, acc) let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t = - 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 @@ -762,10 +766,10 @@ module Action = struct | [] -> Loc.warn loc "Variable '<' used with no explicit \ dependencies@."; - Strings [""] + [Value.String ""] | dep :: _ -> - Paths [dep]) - | "^" -> Some (Paths deps_written_by_user) + [Path dep]) + | "^" -> Some (Value.paths deps_written_by_user) | _ -> None) let run sctx ~loc ?(extra_vars=String.Map.empty) diff --git a/src/super_context.mli b/src/super_context.mli index 2f06dfba..ae4bc5c3 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -82,7 +82,7 @@ val expand_vars : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> String_with_vars.t -> string @@ -90,7 +90,7 @@ val expand_vars_path : t -> scope:Scope.t -> dir:Path.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.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:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> Ordered_set_lang.Unexpanded.t -> standard:(unit, string list) Build.t -> (unit, string list) Build.t @@ -232,7 +232,7 @@ module Action : sig val run : t -> loc:Loc.t - -> ?extra_vars:Var_expansion.t String.Map.t + -> ?extra_vars:Value.t list String.Map.t -> Action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind diff --git a/src/value.ml b/src/value.ml new file mode 100644 index 00000000..f8cf5828 --- /dev/null +++ b/src/value.ml @@ -0,0 +1,27 @@ +open Stdune + +type t = + | String of string + | Path of Path.t + +let string_of_path ~dir p = Path.reach ~from:dir p + +let to_string t ~dir = + match t with + | String s -> s + | Path p -> string_of_path ~dir p + +let to_strings t ~dir = List.map t ~f:(to_string ~dir) + +let to_path ?error_loc t ~dir = + match t with + | String s -> Path.relative ?error_loc dir s + | Path p -> p + +let strings = List.map ~f:(fun x -> String x) +let paths = List.map ~f:(fun x -> Path x) + +let paths_only = + List.filter_map ~f:(function + | String _ -> None + | Path p -> Some p) diff --git a/src/value.mli b/src/value.mli new file mode 100644 index 00000000..72226e21 --- /dev/null +++ b/src/value.mli @@ -0,0 +1,17 @@ +open Stdune + +type t = + | String of string + | Path of Path.t + +val to_string : t -> dir:Path.t -> string + +val to_strings : t list -> dir:Path.t -> string list + +val to_path : ?error_loc:Loc.t -> t -> dir:Path.t -> Path.t + +val strings : string list -> t list + +val paths : Path.t list -> t list + +val paths_only : t list -> Path.t list diff --git a/src/var_expansion.ml b/src/var_expansion.ml deleted file mode 100644 index 080b18ae..00000000 --- a/src/var_expansion.ml +++ /dev/null @@ -1,61 +0,0 @@ -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))) - -module Single = struct - let path ~dir sw ~f = - let relative = Path.relative ~error_loc:(String_with_vars.loc sw) in - match Expand.expand dir sw ~allow_multivalue:false ~f with - | String s - | Expansion (Strings [s]) -> relative dir s - | Expansion (Paths [s]) -> Path.append dir s - | _ -> assert false (* multivalues aren't allowed *) - - let string ~dir sw ~f = - match Expand.expand dir sw ~allow_multivalue:false ~f with - | String s - | Expansion (Strings [s]) -> s - | Expansion (Paths [s]) -> string_of_path ~dir s - | _ -> assert false (* multivalues aren't allowed *) -end diff --git a/src/var_expansion.mli b/src/var_expansion.mli deleted file mode 100644 index 048a2488..00000000 --- a/src/var_expansion.mli +++ /dev/null @@ -1,34 +0,0 @@ -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 - -(** Specialized expansion that produce only a single value *) -module Single : sig - val path - : dir:Path.t - -> String_with_vars.t - -> f:(Loc.t -> string -> t option) - -> Path.t - - val string - : dir:Path.t - -> String_with_vars.t - -> f:(Loc.t -> string -> t option) - -> string -end