Re-work the code to handle (include ...)

Signed-off-by: Jeremie Dimino <jdimino@janestreet.com>
This commit is contained in:
Jeremie Dimino 2018-05-24 18:11:09 +01:00 committed by Jérémie Dimino
parent d211272d24
commit 5c4027aff8
1 changed files with 46 additions and 40 deletions

View File

@ -1241,9 +1241,9 @@ module Stanzas = struct
| None -> [Executables exe] | None -> [Executables exe]
| Some i -> [Executables exe; Install i] | Some i -> [Executables exe; Install i]
exception Include_loop of Path.t * (Loc.t * Path.t) list type Stanza.t += Include of Loc.t * string
let rec t project ~file ~include_stack : Stanza.t list Sexp.Of_sexp.t = let t project : Stanza.t list Sexp.Of_sexp.t =
sum sum
[ cstr "library" (Library.v1 project @> nil) (fun x -> [Library x]) [ cstr "library" (Library.v1 project @> nil) (fun x -> [Library x])
; cstr "executable" (Executables.v1_single project @> nil) execs ; cstr "executable" (Executables.v1_single project @> nil) execs
@ -1266,32 +1266,33 @@ module Stanzas = struct
(* Just for validation and error messages *) (* Just for validation and error messages *)
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> []) ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn -> ; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn ->
let include_stack = (loc, file) :: include_stack in [Include (loc, fn)])
let dir = Path.parent_exn file in
let file = Path.relative dir fn in
if not (Path.exists file) then
Loc.fail loc "File %s doesn't exist."
(Path.to_string_maybe_quoted file);
if List.exists include_stack ~f:(fun (_, f) -> f = file) then
raise (Include_loop (file, include_stack));
let sexps = Io.Sexp.load file ~mode:Many in
parse project sexps ~file ~include_stack)
; cstr "documentation" (Documentation.v1 project @> nil) ; cstr "documentation" (Documentation.v1 project @> nil)
(fun d -> [Documentation d]) (fun d -> [Documentation d])
] ]
and parse ~file ~include_stack project sexps = exception Include_loop of Path.t * (Loc.t * Path.t) list
let l =
List.concat_map sexps ~f:(t project ~file ~include_stack) let rec parse t ~current_file ~include_stack sexps =
in List.concat_map sexps ~f:t
match List.filter_map l ~f:(function Env e -> Some e | _ -> None) with |> List.concat_map ~f:(function
| _ :: e :: _ -> | Include (loc, fn) ->
Loc.fail e.loc "The 'env' stanza cannot appear more than once" let include_stack = (loc, current_file) :: include_stack in
| _ -> l let dir = Path.parent_exn current_file in
let current_file = Path.relative dir fn in
if not (Path.exists current_file) then
Loc.fail loc "File %s doesn't exist."
(Path.to_string_maybe_quoted current_file);
if List.exists include_stack ~f:(fun (_, f) -> f = current_file) then
raise (Include_loop (current_file, include_stack));
let sexps = Io.Sexp.load current_file ~mode:Many in
parse t sexps ~current_file ~include_stack
| stanza -> [stanza])
let parse ~file project sexps = let parse ~file project sexps =
let stanzas =
try try
parse project sexps ~include_stack:[] ~file parse (t project) sexps ~include_stack:[] ~current_file:file
with with
| Include_loop (_, []) -> assert false | Include_loop (_, []) -> assert false
| Include_loop (file, last :: rest) -> | Include_loop (file, last :: rest) ->
@ -1311,4 +1312,9 @@ module Stanzas = struct
sprintf sprintf
"\n--> included from %s" "\n--> included from %s"
(line_loc x)))) (line_loc x))))
in
match List.filter_map stanzas ~f:(function Env e -> Some e | _ -> None) with
| _ :: e :: _ ->
Loc.fail e.loc "The 'env' stanza cannot appear more than once"
| _ -> stanzas
end end