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,49 +1266,55 @@ 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 =
try let stanzas =
parse project sexps ~include_stack:[] ~file try
with parse (t project) sexps ~include_stack:[] ~current_file:file
| Include_loop (_, []) -> assert false with
| Include_loop (file, last :: rest) -> | Include_loop (_, []) -> assert false
let loc = fst (Option.value (List.last rest) ~default:last) in | Include_loop (file, last :: rest) ->
let line_loc (loc, file) = let loc = fst (Option.value (List.last rest) ~default:last) in
sprintf "%s:%d" let line_loc (loc, file) =
sprintf "%s:%d"
(Path.to_string_maybe_quoted file)
loc.Loc.start.pos_lnum
in
Loc.fail loc
"Recursive inclusion of jbuild files detected:\n\
File %s is included from %s%s"
(Path.to_string_maybe_quoted file) (Path.to_string_maybe_quoted file)
loc.Loc.start.pos_lnum (line_loc last)
in (String.concat ~sep:""
Loc.fail loc (List.map rest ~f:(fun x ->
"Recursive inclusion of jbuild files detected:\n\ sprintf
File %s is included from %s%s" "\n--> included from %s"
(Path.to_string_maybe_quoted file) (line_loc x))))
(line_loc last) in
(String.concat ~sep:"" match List.filter_map stanzas ~f:(function Env e -> Some e | _ -> None) with
(List.map rest ~f:(fun x -> | _ :: e :: _ ->
sprintf Loc.fail e.loc "The 'env' stanza cannot appear more than once"
"\n--> included from %s" | _ -> stanzas
(line_loc x))))
end end