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
|
include Past
|
||||||
|
|
||||||
module E = struct
|
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
|
| Left x -> map x
|
||||||
| Right template ->
|
| 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
|
| Expansion e -> special dir e
|
||||||
| String s -> generic dir s
|
| String s -> generic dir s
|
||||||
[@@inlined always]
|
[@@inlined always]
|
||||||
|
|
||||||
let string ~dir ~f x =
|
let string ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:false
|
||||||
~generic:(fun _dir x -> x)
|
~generic:(fun _dir x -> x)
|
||||||
~special:VE.to_string
|
~special:VE.to_string
|
||||||
~map:(fun x -> x)
|
~map:(fun x -> x)
|
||||||
|
|
||||||
let strings ~dir ~f x =
|
let strings ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:true
|
||||||
~generic:(fun _dir x -> [x])
|
~generic:(fun _dir x -> [x])
|
||||||
~special:VE.to_strings
|
~special:VE.to_strings
|
||||||
~map:(fun x -> [x])
|
~map:(fun x -> [x])
|
||||||
|
|
||||||
let path ~dir ~f x =
|
let path ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:false
|
||||||
~generic:VE.path_of_string
|
~generic:VE.path_of_string
|
||||||
~special:VE.to_path
|
~special:VE.to_path
|
||||||
~map:(fun x -> x)
|
~map:(fun x -> x)
|
||||||
|
|
||||||
let prog_and_args ~dir ~f x =
|
let prog_and_args ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:true
|
||||||
~generic:(fun _dir s -> (Program.of_string ~dir s, []))
|
~generic:(fun _dir s -> (Program.of_string ~dir s, []))
|
||||||
~special:VE.to_prog_and_args
|
~special:VE.to_prog_and_args
|
||||||
~map:(fun x -> (x, []))
|
~map:(fun x -> (x, []))
|
||||||
|
@ -447,29 +451,33 @@ module Unexpanded = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module E = struct
|
module E = struct
|
||||||
let expand ~generic ~special ~dir ~f template =
|
let expand ~generic ~special ~dir ~allow_multivalue ~f template =
|
||||||
match To_VE.partial_expand dir template ~f with
|
match To_VE.partial_expand dir template ~allow_multivalue ~f with
|
||||||
| Expansion e -> Left (special dir e)
|
| Expansion e -> Left (special dir e)
|
||||||
| String s -> Left (generic dir s)
|
| String s -> Left (generic dir s)
|
||||||
| Unexpanded x -> Right x
|
| Unexpanded x -> Right x
|
||||||
|
|
||||||
let string ~dir ~f x =
|
let string ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:false
|
||||||
~generic:(fun _dir x -> x)
|
~generic:(fun _dir x -> x)
|
||||||
~special:VE.to_string
|
~special:VE.to_string
|
||||||
|
|
||||||
let strings ~dir ~f x =
|
let strings ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:true
|
||||||
~generic:(fun _dir x -> [x])
|
~generic:(fun _dir x -> [x])
|
||||||
~special:VE.to_strings
|
~special:VE.to_strings
|
||||||
|
|
||||||
let path ~dir ~f x =
|
let path ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:false
|
||||||
~generic:VE.path_of_string
|
~generic:VE.path_of_string
|
||||||
~special:VE.to_path
|
~special:VE.to_path
|
||||||
|
|
||||||
let prog_and_args ~dir ~f x =
|
let prog_and_args ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
|
~allow_multivalue:true
|
||||||
~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, []))
|
~generic:(fun dir s -> (Unresolved.Program.of_string ~dir s, []))
|
||||||
~special:VE.to_prog_and_args
|
~special:VE.to_prog_and_args
|
||||||
end
|
end
|
||||||
|
|
|
@ -137,15 +137,18 @@ module Expand_to(V: EXPANSION) = struct
|
||||||
if not t.quoted && V.is_multivalued x then
|
if not t.quoted && V.is_multivalued x then
|
||||||
Loc.fail t.loc "Variable %s expands to %d values, \
|
Loc.fail t.loc "Variable %s expands to %d values, \
|
||||||
however a single value is expected here. \
|
however a single value is expected here. \
|
||||||
Please quote this atom. "
|
Please quote this atom."
|
||||||
(string_of_var syntax var) (V.length x)
|
(string_of_var syntax var) (V.length x)
|
||||||
|
|
||||||
let expand ctx t ~f =
|
let expand ctx t ~allow_multivalue ~f =
|
||||||
match t.items with
|
match t.items with
|
||||||
| [Var (syntax, v)] when not t.quoted ->
|
| [Var (syntax, v)] when not t.quoted ->
|
||||||
(* Unquoted single var *)
|
(* Unquoted single var *)
|
||||||
(match f t.loc v with
|
(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))
|
| None -> Expand.Full.String (string_of_var syntax v))
|
||||||
| _ ->
|
| _ ->
|
||||||
Expand.Full.String (
|
Expand.Full.String (
|
||||||
|
@ -159,7 +162,7 @@ module Expand_to(V: EXPANSION) = struct
|
||||||
| None -> string_of_var syntax v)
|
| None -> string_of_var syntax v)
|
||||||
|> String.concat ~sep:"")
|
|> String.concat ~sep:"")
|
||||||
|
|
||||||
let partial_expand ctx t ~f =
|
let partial_expand ctx t ~allow_multivalue ~f =
|
||||||
let commit_text acc_text acc =
|
let commit_text acc_text acc =
|
||||||
let s = concat_rev acc_text in
|
let s = concat_rev acc_text in
|
||||||
if s = "" then acc else Text s :: acc
|
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
|
loop (V.to_string ctx x :: acc_text) acc items
|
||||||
in
|
in
|
||||||
match t.items with
|
match t.items with
|
||||||
| [Var (_, v)] when not t.quoted ->
|
| [Var (syntax, v)] when not t.quoted ->
|
||||||
(* Unquoted single var *)
|
(* Unquoted single var *)
|
||||||
(match f t.loc v with
|
(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)
|
| None -> Expand.Partial.Unexpanded t)
|
||||||
| _ -> loop [] [] t.items
|
| _ -> loop [] [] t.items
|
||||||
end
|
end
|
||||||
|
@ -199,12 +205,12 @@ end
|
||||||
module S = Expand_to(String_expansion)
|
module S = Expand_to(String_expansion)
|
||||||
|
|
||||||
let expand t ~f =
|
let expand t ~f =
|
||||||
match S.expand () t ~f with
|
match S.expand () t ~allow_multivalue:true ~f with
|
||||||
| Expand.Full.String s
|
| Expand.Full.String s
|
||||||
| Expansion s -> s
|
| Expansion s -> s
|
||||||
|
|
||||||
let partial_expand t ~f =
|
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
|
| Expand.Partial.Expansion s -> Left s
|
||||||
| String s -> Left s
|
| String s -> Left s
|
||||||
| Unexpanded s -> Right s
|
| Unexpanded s -> Right s
|
||||||
|
|
|
@ -83,6 +83,7 @@ module Expand_to(V : EXPANSION) : sig
|
||||||
val expand
|
val expand
|
||||||
: V.context
|
: V.context
|
||||||
-> t
|
-> t
|
||||||
|
-> allow_multivalue:bool
|
||||||
-> f:(Loc.t -> string -> V.t option)
|
-> f:(Loc.t -> string -> V.t option)
|
||||||
-> V.t Expand.Full.t
|
-> V.t Expand.Full.t
|
||||||
(** [expand t ~f] return [t] where all variables have been expanded
|
(** [expand t ~f] return [t] where all variables have been expanded
|
||||||
|
@ -93,6 +94,7 @@ module Expand_to(V : EXPANSION) : sig
|
||||||
val partial_expand
|
val partial_expand
|
||||||
: V.context
|
: V.context
|
||||||
-> t
|
-> t
|
||||||
|
-> allow_multivalue:bool
|
||||||
-> f:(Loc.t -> string -> V.t option)
|
-> f:(Loc.t -> string -> V.t option)
|
||||||
-> V.t Expand.Partial.t
|
-> V.t Expand.Partial.t
|
||||||
(** [partial_expand t ~f] is like [expand_generic] where all
|
(** [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. *)
|
least a variable of [t], it returns a string-with-vars. *)
|
||||||
end
|
end
|
||||||
|
|
||||||
val expand :
|
val expand
|
||||||
t -> f:(Loc.t -> string -> string option) -> string
|
: t
|
||||||
|
-> f:(Loc.t -> string -> string option)
|
||||||
|
-> string
|
||||||
(** Specialized version [Expand_to.expand] that returns a string (so
|
(** Specialized version [Expand_to.expand] that returns a string (so
|
||||||
variables are assumed to expand to a single value). *)
|
variables are assumed to expand to a single value). *)
|
||||||
|
|
||||||
val partial_expand :
|
val partial_expand
|
||||||
t -> f:(Loc.t -> string -> string option) -> (string, t) Either.t
|
: t
|
||||||
|
-> f:(Loc.t -> string -> string option)
|
||||||
|
-> (string, t) Either.t
|
||||||
(** [partial_expand] is a specialized version of
|
(** [partial_expand] is a specialized version of
|
||||||
[Expand_to.partial_expand] that returns a string. *)
|
[Expand_to.partial_expand] that returns a string. *)
|
||||||
|
|
|
@ -2,6 +2,9 @@
|
||||||
File "dune", line 65, characters 21-44:
|
File "dune", line 65, characters 21-44:
|
||||||
Warning: Directory dir-that-doesnt-exist doesn't exist.
|
Warning: Directory dir-that-doesnt-exist doesn't exist.
|
||||||
No rule found for jbuild
|
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
|
diff alias runtest
|
||||||
[1]
|
[1]
|
||||||
|
|
|
@ -8,6 +8,9 @@ that ${@} is not quoted and doesn't contain exactly 1 element
|
||||||
- y
|
- y
|
||||||
[1]
|
[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
|
The targets should only be interpreted as a single path when quoted
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue