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 <rudi.grinberg@gmail.com>
This commit is contained in:
parent
72bbd06a1d
commit
39c1cef128
|
@ -10,6 +10,10 @@ module Ast = struct
|
||||||
| Union : ('a, 'b) t list -> ('a, 'b) t
|
| Union : ('a, 'b) t list -> ('a, 'b) t
|
||||||
| Diff : ('a, 'b) t * ('a, 'b) t -> ('a, 'b) t
|
| Diff : ('a, 'b) t * ('a, 'b) t -> ('a, 'b) t
|
||||||
| Include : String_with_vars.t -> ('a, unexpanded) 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
|
end
|
||||||
|
|
||||||
type 'ast generic =
|
type 'ast generic =
|
||||||
|
@ -32,7 +36,7 @@ module Parse = struct
|
||||||
peek_exn >>= function
|
peek_exn >>= function
|
||||||
| Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
|
| Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
|
||||||
| (Atom (_, A "") | Quoted_string (_, _)) | Template _ ->
|
| (Atom (_, A "") | Quoted_string (_, _)) | Template _ ->
|
||||||
elt >>| fun x -> Element x
|
elt
|
||||||
| Atom (loc, A s) -> begin
|
| Atom (loc, A s) -> begin
|
||||||
match s with
|
match s with
|
||||||
| ":standard" ->
|
| ":standard" ->
|
||||||
|
@ -43,7 +47,7 @@ module Parse = struct
|
||||||
| _ when s.[0] = ':' ->
|
| _ when s.[0] = ':' ->
|
||||||
Loc.fail loc "undefined symbol %s" s
|
Loc.fail loc "undefined symbol %s" s
|
||||||
| _ ->
|
| _ ->
|
||||||
elt >>| fun x -> Element x
|
elt
|
||||||
end
|
end
|
||||||
| List (_, Atom (loc, A s) :: _) -> begin
|
| List (_, Atom (loc, A s) :: _) -> begin
|
||||||
match s, kind with
|
match s, kind with
|
||||||
|
@ -88,7 +92,8 @@ end
|
||||||
let t =
|
let t =
|
||||||
let open Stanza.Of_sexp in
|
let open Stanza.Of_sexp in
|
||||||
get_all >>= fun context ->
|
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) ->
|
>>| fun (loc, ast) ->
|
||||||
{ ast; loc = Some loc; context }
|
{ ast; loc = Some loc; context }
|
||||||
|
|
||||||
|
@ -210,10 +215,12 @@ let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default
|
||||||
module Unexpanded = struct
|
module Unexpanded = struct
|
||||||
type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
|
type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
|
||||||
type t = ast generic
|
type t = ast generic
|
||||||
let t =
|
let t : t Sexp.Of_sexp.t =
|
||||||
let open Stanza.Of_sexp in
|
let open Stanza.Of_sexp in
|
||||||
get_all >>= fun context ->
|
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) ->
|
>>| fun (loc, ast) ->
|
||||||
{ ast
|
{ ast
|
||||||
; loc = Some loc
|
; loc = Some loc
|
||||||
|
@ -239,12 +246,11 @@ module Unexpanded = struct
|
||||||
let field ?(default=standard) name = Stanza.Of_sexp.field name t ~default
|
let field ?(default=standard) name = Stanza.Of_sexp.field name t ~default
|
||||||
|
|
||||||
let files t ~f =
|
let files t ~f =
|
||||||
let rec loop acc (t : ast) =
|
let rec loop acc (ast : ast) =
|
||||||
let open Ast in
|
let open Ast in
|
||||||
match t with
|
match ast with
|
||||||
| Element _ | Standard -> acc
|
| Element _ | Standard -> acc
|
||||||
| Include fn ->
|
| Include fn -> Path.Set.add acc (f fn)
|
||||||
String.Set.add acc (f fn)
|
|
||||||
| Union l ->
|
| Union l ->
|
||||||
List.fold_left l ~init:acc ~f:loop
|
List.fold_left l ~init:acc ~f:loop
|
||||||
| Diff (l, r) ->
|
| Diff (l, r) ->
|
||||||
|
@ -255,7 +261,7 @@ module Unexpanded = struct
|
||||||
| Some (0, _)-> File_tree.Dune_file.Kind.Jbuild
|
| Some (0, _)-> File_tree.Dune_file.Kind.Jbuild
|
||||||
| None | Some (_, _) -> Dune
|
| None | Some (_, _) -> Dune
|
||||||
in
|
in
|
||||||
(syntax, loop String.Set.empty t.ast)
|
(syntax, loop Path.Set.empty t.ast)
|
||||||
|
|
||||||
let has_special_forms t =
|
let has_special_forms t =
|
||||||
let rec loop (t : ast) =
|
let rec loop (t : ast) =
|
||||||
|
@ -291,31 +297,40 @@ module Unexpanded = struct
|
||||||
in
|
in
|
||||||
loop t.ast Pos init
|
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 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 rec expand (t : ast) : ast_expanded =
|
||||||
let open Ast in
|
let open Ast in
|
||||||
match t with
|
match t with
|
||||||
| Element s -> Element (String_with_vars.loc s, f s)
|
| Element s -> f_elems s
|
||||||
| Standard -> Standard
|
| Standard -> Standard
|
||||||
| Include fn ->
|
| Include fn ->
|
||||||
let sexp =
|
let sexp =
|
||||||
let fn = f fn in
|
let path =
|
||||||
match String.Map.find files_contents fn with
|
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
|
| Some x -> x
|
||||||
| None ->
|
| None ->
|
||||||
Exn.code_error
|
Exn.code_error
|
||||||
"Ordered_set_lang.Unexpanded.expand"
|
"Ordered_set_lang.Unexpanded.expand"
|
||||||
[ "included-file", Quoted_string fn
|
[ "included-file", Path.sexp_of_t path
|
||||||
; "files", Sexp.To_sexp.(list string)
|
; "files", Sexp.To_sexp.(list Path.sexp_of_t)
|
||||||
(String.Map.keys files_contents)
|
(Path.Map.keys files_contents)
|
||||||
]
|
]
|
||||||
in
|
in
|
||||||
let open Stanza.Of_sexp in
|
let open Stanza.Of_sexp in
|
||||||
parse
|
parse
|
||||||
(Parse.without_include
|
(Parse.without_include ~elt:(String_with_vars.t >>| f_elems))
|
||||||
~elt:(String_with_vars.t >>| fun s ->
|
|
||||||
(String_with_vars.loc s, f s)))
|
|
||||||
context
|
context
|
||||||
sexp
|
sexp
|
||||||
| Union l -> Union (List.map l ~f:expand)
|
| Union l -> Union (List.map l ~f:expand)
|
||||||
|
|
|
@ -65,16 +65,17 @@ module Unexpanded : sig
|
||||||
(** List of files needed to expand this set *)
|
(** List of files needed to expand this set *)
|
||||||
val files
|
val files
|
||||||
: t
|
: t
|
||||||
-> f:(String_with_vars.t -> string)
|
-> f:(String_with_vars.t -> Path.t)
|
||||||
-> Sexp.syntax * String.Set.t
|
-> Sexp.syntax * Path.Set.t
|
||||||
|
|
||||||
(** Expand [t] using with the given file contents. [file_contents] is a map from
|
(** 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
|
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]. *)
|
[Map.find files_contents fn]. Every element is converted to a string using [f]. *)
|
||||||
val expand
|
val expand
|
||||||
: t
|
: t
|
||||||
-> files_contents:Sexp.Ast.t String.Map.t
|
-> dir:Path.t
|
||||||
-> f:(String_with_vars.t -> string)
|
-> files_contents:Sexp.Ast.t Path.Map.t
|
||||||
|
-> f:(String_with_vars.t -> Value.t list)
|
||||||
-> expanded
|
-> expanded
|
||||||
|
|
||||||
type position = Pos | Neg
|
type position = Pos | Neg
|
||||||
|
|
|
@ -95,50 +95,49 @@ let expand_ocaml_config t pform name =
|
||||||
"Unknown ocaml configuration variable %S"
|
"Unknown ocaml configuration variable %S"
|
||||||
name
|
name
|
||||||
|
|
||||||
let (expand_vars_string, expand_vars_path) =
|
let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s =
|
||||||
let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s =
|
String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version ->
|
||||||
String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version ->
|
(match Pform.Map.expand bindings ~syntax_version ~pform with
|
||||||
(match Pform.Map.expand bindings ~syntax_version ~pform with
|
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
|
||||||
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
|
| Some _ as x -> x)
|
||||||
| Some _ as x -> x)
|
|> Option.map ~f:(function
|
||||||
|> Option.map ~f:(function
|
| Pform.Expansion.Var (Values l) -> l
|
||||||
| Pform.Expansion.Var (Values l) -> l
|
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
|
||||||
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
|
| Var Project_root -> [Value.Dir (Scope.root scope)]
|
||||||
| Var Project_root -> [Value.Dir (Scope.root scope)]
|
| _ ->
|
||||||
| _ ->
|
Loc.fail (String_with_vars.Var.loc pform)
|
||||||
Loc.fail (String_with_vars.Var.loc pform)
|
"%s isn't allowed in this position"
|
||||||
"%s isn't allowed in this position"
|
(String_with_vars.Var.describe pform)))
|
||||||
(String_with_vars.Var.describe pform)))
|
|
||||||
in
|
let expand_vars_string t ~scope ~dir ?bindings s =
|
||||||
let expand_vars t ~scope ~dir ?bindings s =
|
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
||||||
expand t ~scope ~dir ?bindings s
|
|> Value.to_string ~dir
|
||||||
|> Value.to_string ~dir
|
|
||||||
in
|
let expand_vars_path t ~scope ~dir ?bindings s =
|
||||||
let expand_vars_path t ~scope ~dir ?bindings s =
|
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|
||||||
expand t ~scope ~dir ?bindings s
|
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
|
||||||
|> 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 ?bindings set ~standard =
|
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
|
||||||
let open Build.O in
|
let open Build.O in
|
||||||
let f = expand_vars_string t ~scope ~dir ?bindings in
|
|
||||||
let parse ~loc:_ s = s in
|
let parse ~loc:_ s = s in
|
||||||
let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
|
let (syntax, files) =
|
||||||
match String.Set.to_list files with
|
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 =
|
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
|
in
|
||||||
standard >>^ fun standard ->
|
standard >>^ fun standard ->
|
||||||
Ordered_set_lang.String.eval set ~standard ~parse
|
Ordered_set_lang.String.eval set ~standard ~parse
|
||||||
| files ->
|
| paths ->
|
||||||
let paths = List.map files ~f:(Path.relative dir) in
|
|
||||||
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
|
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
|
||||||
Build.read_sexp f syntax)))
|
Build.read_sexp f syntax)))
|
||||||
>>^ fun (standard, sexps) ->
|
>>^ fun (standard, sexps) ->
|
||||||
let files_contents = List.combine files sexps |> String.Map.of_list_exn in
|
let files_contents = List.combine paths sexps |> Path.Map.of_list_exn in
|
||||||
let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in
|
let set = Ordered_set_lang.Unexpanded.expand set ~dir ~files_contents ~f in
|
||||||
Ordered_set_lang.String.eval set ~standard ~parse
|
Ordered_set_lang.String.eval set ~standard ~parse
|
||||||
|
|
||||||
module Env = struct
|
module Env = struct
|
||||||
|
|
Loading…
Reference in New Issue