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:
Rudi Grinberg 2018-07-12 13:14:44 +02:00
parent 72bbd06a1d
commit 39c1cef128
3 changed files with 71 additions and 56 deletions

View File

@ -10,6 +10,10 @@ module Ast = struct
| Union : ('a, 'b) t list -> ('a, 'b) t
| Diff : ('a, 'b) t * ('a, 'b) t -> ('a, 'b) 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
type 'ast generic =
@ -32,7 +36,7 @@ module Parse = struct
peek_exn >>= function
| Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
| (Atom (_, A "") | Quoted_string (_, _)) | Template _ ->
elt >>| fun x -> Element x
elt
| Atom (loc, A s) -> begin
match s with
| ":standard" ->
@ -43,7 +47,7 @@ module Parse = struct
| _ when s.[0] = ':' ->
Loc.fail loc "undefined symbol %s" s
| _ ->
elt >>| fun x -> Element x
elt
end
| List (_, Atom (loc, A s) :: _) -> begin
match s, kind with
@ -88,7 +92,8 @@ end
let t =
let open Stanza.Of_sexp in
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) ->
{ ast; loc = Some loc; context }
@ -210,10 +215,12 @@ let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default
module Unexpanded = struct
type ast = (String_with_vars.t, Ast.unexpanded) Ast.t
type t = ast generic
let t =
let t : t Sexp.Of_sexp.t =
let open Stanza.Of_sexp in
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) ->
{ ast
; loc = Some loc
@ -239,12 +246,11 @@ module Unexpanded = struct
let field ?(default=standard) name = Stanza.Of_sexp.field name t ~default
let files t ~f =
let rec loop acc (t : ast) =
let rec loop acc (ast : ast) =
let open Ast in
match t with
match ast with
| Element _ | Standard -> acc
| Include fn ->
String.Set.add acc (f fn)
| Include fn -> Path.Set.add acc (f fn)
| Union l ->
List.fold_left l ~init:acc ~f:loop
| Diff (l, r) ->
@ -255,7 +261,7 @@ module Unexpanded = struct
| Some (0, _)-> File_tree.Dune_file.Kind.Jbuild
| None | Some (_, _) -> Dune
in
(syntax, loop String.Set.empty t.ast)
(syntax, loop Path.Set.empty t.ast)
let has_special_forms t =
let rec loop (t : ast) =
@ -291,31 +297,40 @@ module Unexpanded = struct
in
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 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 open Ast in
match t with
| Element s -> Element (String_with_vars.loc s, f s)
| Element s -> f_elems s
| Standard -> Standard
| Include fn ->
let sexp =
let fn = f fn in
match String.Map.find files_contents fn with
let path =
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
| None ->
Exn.code_error
"Ordered_set_lang.Unexpanded.expand"
[ "included-file", Quoted_string fn
; "files", Sexp.To_sexp.(list string)
(String.Map.keys files_contents)
[ "included-file", Path.sexp_of_t path
; "files", Sexp.To_sexp.(list Path.sexp_of_t)
(Path.Map.keys files_contents)
]
in
let open Stanza.Of_sexp in
parse
(Parse.without_include
~elt:(String_with_vars.t >>| fun s ->
(String_with_vars.loc s, f s)))
(Parse.without_include ~elt:(String_with_vars.t >>| f_elems))
context
sexp
| Union l -> Union (List.map l ~f:expand)

View File

@ -65,16 +65,17 @@ module Unexpanded : sig
(** List of files needed to expand this set *)
val files
: t
-> f:(String_with_vars.t -> string)
-> Sexp.syntax * String.Set.t
-> f:(String_with_vars.t -> Path.t)
-> Sexp.syntax * Path.Set.t
(** 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
[Map.find files_contents fn]. Every element is converted to a string using [f]. *)
val expand
: t
-> files_contents:Sexp.Ast.t String.Map.t
-> f:(String_with_vars.t -> string)
-> dir:Path.t
-> files_contents:Sexp.Ast.t Path.Map.t
-> f:(String_with_vars.t -> Value.t list)
-> expanded
type position = Pos | Neg

View File

@ -95,50 +95,49 @@ let expand_ocaml_config t pform name =
"Unknown ocaml configuration variable %S"
name
let (expand_vars_string, expand_vars_path) =
let expand t ~scope ~dir ?(bindings=Pform.Map.empty) s =
String_with_vars.expand ~mode:Single ~dir s ~f:(fun pform syntax_version ->
(match Pform.Map.expand bindings ~syntax_version ~pform with
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
| Some _ as x -> x)
|> Option.map ~f:(function
| Pform.Expansion.Var (Values l) -> l
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
| Var Project_root -> [Value.Dir (Scope.root scope)]
| _ ->
Loc.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position"
(String_with_vars.Var.describe pform)))
in
let expand_vars t ~scope ~dir ?bindings s =
expand t ~scope ~dir ?bindings s
|> Value.to_string ~dir
in
let expand_vars_path t ~scope ~dir ?bindings s =
expand t ~scope ~dir ?bindings s
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
in
(expand_vars, expand_vars_path)
let expand_vars t ~mode ~scope ~dir ?(bindings=Pform.Map.empty) s =
String_with_vars.expand ~mode ~dir s ~f:(fun pform syntax_version ->
(match Pform.Map.expand bindings ~syntax_version ~pform with
| None -> Pform.Map.expand t.pforms ~syntax_version ~pform
| Some _ as x -> x)
|> Option.map ~f:(function
| Pform.Expansion.Var (Values l) -> l
| Macro (Ocaml_config, s) -> expand_ocaml_config t pform s
| Var Project_root -> [Value.Dir (Scope.root scope)]
| _ ->
Loc.fail (String_with_vars.Var.loc pform)
"%s isn't allowed in this position"
(String_with_vars.Var.describe pform)))
let expand_vars_string t ~scope ~dir ?bindings s =
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|> Value.to_string ~dir
let expand_vars_path t ~scope ~dir ?bindings s =
expand_vars t ~mode:Single ~scope ~dir ?bindings s
|> Value.to_path ~error_loc:(String_with_vars.loc s) ~dir
let expand_and_eval_set t ~scope ~dir ?bindings set ~standard =
let open Build.O in
let f = expand_vars_string t ~scope ~dir ?bindings in
let parse ~loc:_ s = s in
let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
match String.Set.to_list files with
let (syntax, files) =
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 =
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
standard >>^ fun standard ->
Ordered_set_lang.String.eval set ~standard ~parse
| files ->
let paths = List.map files ~f:(Path.relative dir) in
| paths ->
Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
Build.read_sexp f syntax)))
>>^ fun (standard, sexps) ->
let files_contents = List.combine files sexps |> String.Map.of_list_exn in
let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in
let files_contents = List.combine paths sexps |> Path.Map.of_list_exn in
let set = Ordered_set_lang.Unexpanded.expand set ~dir ~files_contents ~f in
Ordered_set_lang.String.eval set ~standard ~parse
module Env = struct