Add flag to allow/disallow multivalue expansions
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
9545d9a854
commit
eab7c46bdb
|
@ -354,34 +354,38 @@ module Unexpanded = struct
|
|||
include Past
|
||||
|
||||
module E = struct
|
||||
let expand ~generic ~special ~map ~dir ~f = function
|
||||
let expand ~generic ~special ~map ~dir ~allow_multivalue ~f = function
|
||||
| Left x -> map x
|
||||
| Right template ->
|
||||
match To_VE.expand dir template ~f with
|
||||
match To_VE.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
|
||||
~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
|
||||
~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
|
||||
~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
|
||||
~map:(fun x -> (x, []))
|
||||
|
@ -447,29 +451,33 @@ module Unexpanded = struct
|
|||
end
|
||||
|
||||
module E = struct
|
||||
let expand ~generic ~special ~dir ~f template =
|
||||
match To_VE.partial_expand dir template ~f with
|
||||
let expand ~generic ~special ~dir ~allow_multivalue ~f template =
|
||||
match To_VE.partial_expand dir template ~allow_multivalue ~f with
|
||||
| Expansion e -> Left (special dir e)
|
||||
| String s -> Left (generic dir s)
|
||||
| Unexpanded x -> Right x
|
||||
|
||||
let string ~dir ~f x =
|
||||
expand ~dir ~f x
|
||||
~allow_multivalue:false
|
||||
~generic:(fun _dir x -> x)
|
||||
~special:VE.to_string
|
||||
|
||||
let strings ~dir ~f x =
|
||||
expand ~dir ~f x
|
||||
~allow_multivalue:true
|
||||
~generic:(fun _dir x -> [x])
|
||||
~special:VE.to_strings
|
||||
|
||||
let path ~dir ~f x =
|
||||
expand ~dir ~f x
|
||||
~allow_multivalue:false
|
||||
~generic:VE.path_of_string
|
||||
~special:VE.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
|
||||
end
|
||||
|
|
|
@ -137,15 +137,18 @@ module Expand_to(V: EXPANSION) = struct
|
|||
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. "
|
||||
Please quote this atom."
|
||||
(string_of_var syntax var) (V.length x)
|
||||
|
||||
let expand ctx t ~f =
|
||||
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 -> Expand.Full.Expansion e
|
||||
| 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 (
|
||||
|
@ -159,7 +162,7 @@ module Expand_to(V: EXPANSION) = struct
|
|||
| None -> string_of_var syntax v)
|
||||
|> String.concat ~sep:"")
|
||||
|
||||
let partial_expand ctx t ~f =
|
||||
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
|
||||
|
@ -180,10 +183,13 @@ module Expand_to(V: EXPANSION) = struct
|
|||
loop (V.to_string ctx x :: acc_text) acc items
|
||||
in
|
||||
match t.items with
|
||||
| [Var (_, v)] when not t.quoted ->
|
||||
| [Var (syntax, v)] when not t.quoted ->
|
||||
(* Unquoted single var *)
|
||||
(match f t.loc v with
|
||||
| Some e -> Expand.Partial.Expansion e
|
||||
| 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
|
||||
|
@ -199,12 +205,12 @@ end
|
|||
module S = Expand_to(String_expansion)
|
||||
|
||||
let expand t ~f =
|
||||
match S.expand () t ~f with
|
||||
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 ~f with
|
||||
match S.partial_expand () t ~allow_multivalue:true ~f with
|
||||
| Expand.Partial.Expansion s -> Left s
|
||||
| String s -> Left s
|
||||
| Unexpanded s -> Right s
|
||||
|
|
|
@ -83,6 +83,7 @@ module Expand_to(V : EXPANSION) : sig
|
|||
val expand
|
||||
: V.context
|
||||
-> t
|
||||
-> allow_multivalue:bool
|
||||
-> f:(Loc.t -> string -> V.t option)
|
||||
-> V.t Expand.Full.t
|
||||
(** [expand t ~f] return [t] where all variables have been expanded
|
||||
|
@ -93,6 +94,7 @@ module Expand_to(V : EXPANSION) : sig
|
|||
val partial_expand
|
||||
: V.context
|
||||
-> t
|
||||
-> allow_multivalue:bool
|
||||
-> f:(Loc.t -> string -> V.t option)
|
||||
-> V.t Expand.Partial.t
|
||||
(** [partial_expand t ~f] is like [expand_generic] where all
|
||||
|
@ -102,12 +104,16 @@ module Expand_to(V : EXPANSION) : sig
|
|||
least a variable of [t], it returns a string-with-vars. *)
|
||||
end
|
||||
|
||||
val expand :
|
||||
t -> f:(Loc.t -> string -> string option) -> string
|
||||
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). *)
|
||||
|
||||
val partial_expand :
|
||||
t -> f:(Loc.t -> string -> string option) -> (string, t) Either.t
|
||||
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. *)
|
||||
|
|
|
@ -2,6 +2,9 @@
|
|||
File "dune", line 65, characters 21-44:
|
||||
Warning: Directory dir-that-doesnt-exist doesn't exist.
|
||||
No rule found for jbuild
|
||||
diff alias runtest
|
||||
File "dune", line 9, characters 43-47:
|
||||
Error: Variable ${^} expands to 4 values, however a single value is expected here. Please quote this atom.
|
||||
File "dune", line 16, characters 44-48:
|
||||
Error: Variable ${^} expands to 2 values, however a single value is expected here. Please quote this atom.
|
||||
diff alias runtest
|
||||
[1]
|
||||
|
|
|
@ -8,6 +8,9 @@ that ${@} is not quoted and doesn't contain exactly 1 element
|
|||
- y
|
||||
[1]
|
||||
|
||||
$ dune build --root bad x
|
||||
File "dune", line 3, characters 26-30:
|
||||
Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom.
|
||||
|
||||
The targets should only be interpreted as a single path when quoted
|
||||
|
||||
|
|
Loading…
Reference in New Issue