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
|
||||
| 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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue