Rewrite lexing of installed dune files
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
04ee6b0b2d
commit
6589464f21
|
@ -38,52 +38,50 @@ let of_sexp =
|
||||||
let open Sexp.Of_sexp in
|
let open Sexp.Of_sexp in
|
||||||
let version =
|
let version =
|
||||||
plain_string (fun ~loc -> function
|
plain_string (fun ~loc -> function
|
||||||
| "1" | "2" -> ()
|
| "1" -> (0, 0)
|
||||||
|
| "2" -> (1, 0)
|
||||||
| v ->
|
| v ->
|
||||||
of_sexp_errorf loc
|
of_sexp_errorf loc
|
||||||
"Unsupported version %S, only version 1 is supported" v)
|
"Unsupported version %S, only version 1 is supported" v)
|
||||||
in
|
in
|
||||||
sum
|
sum
|
||||||
[ "dune",
|
[ "dune",
|
||||||
(version >>= fun () ->
|
(version >>= fun version ->
|
||||||
get_all >>= fun parsing_context ->
|
set (Syntax.key Stanza.syntax) version
|
||||||
list raw >>|
|
(get_all >>= fun parsing_context ->
|
||||||
parse_sub_systems ~parsing_context)
|
list raw >>|
|
||||||
|
parse_sub_systems ~parsing_context))
|
||||||
]
|
]
|
||||||
|
|
||||||
let load fname =
|
let load fname =
|
||||||
Io.with_lexbuf_from_file fname ~f:(fun lexbuf ->
|
Io.with_lexbuf_from_file fname ~f:(fun lexbuf ->
|
||||||
let (tokens, version_loc, version) =
|
(* Installed dune files are versioned but they don't use the
|
||||||
let rec loop = function
|
[(lang ...)] line which was introduced after. Installed dune
|
||||||
| [_; _; _] as a -> List.rev a
|
files in version 1 are using the jbuild syntax and version 2
|
||||||
| acc ->
|
are using the dune syntax, so we start by lexing the first
|
||||||
begin match (Sexp.Lexer.token lexbuf : Sexp.Lexer.Token.t) with
|
tokens with the dune lexer until we reach the file version, at
|
||||||
| Eof -> List.rev acc
|
which point we can decide what lexer to use for the reset of
|
||||||
| t -> loop (t :: acc)
|
the file. *)
|
||||||
end
|
let state = ref 0 in
|
||||||
in
|
let lexer = ref Sexp.Lexer.token in
|
||||||
let loc = Sexp.Loc.of_lexbuf lexbuf in
|
let lexer lb =
|
||||||
match loop [] with
|
let token : Sexp.Lexer.Token.t = !lexer lb in
|
||||||
| [Lparen; Atom (A "dune"); Atom s] as tokens ->
|
(match !state, token with
|
||||||
(tokens, loc, Sexp.Atom.to_string s)
|
| 0, Lparen -> state := 1
|
||||||
| _ -> Loc.fail loc "Unable to read (dune x.y ..) line file"
|
| 1, Atom (A "dune") -> state := 2
|
||||||
|
| 2, Atom (A "1") -> state := 3; lexer := Sexp.Lexer.jbuild_token
|
||||||
|
| 2, Atom (A "2") -> state := 3; lexer := Sexp.Lexer.token
|
||||||
|
| 2, Atom (A version) ->
|
||||||
|
Loc.fail (Sexp.Loc.of_lexbuf lexbuf) "Unsupported version %S" version
|
||||||
|
| 3, _ -> ()
|
||||||
|
| _ ->
|
||||||
|
Loc.fail (Sexp.Loc.of_lexbuf lexbuf)
|
||||||
|
"This <lib>.dune file looks invalid, it should \
|
||||||
|
contain a S-expression of the form (dune x.y ..)"
|
||||||
|
);
|
||||||
|
token
|
||||||
in
|
in
|
||||||
let (lexer, syntax) =
|
Sexp.Of_sexp.parse of_sexp Univ_map.empty
|
||||||
match version with
|
|
||||||
| "1" -> (Sexp.Lexer.jbuild_token, (0, 0))
|
|
||||||
| "2" -> (Sexp.Lexer.token, (1, 0))
|
|
||||||
| _ -> Loc.fail version_loc "unknown version %S" version
|
|
||||||
in
|
|
||||||
(* push back the tokens that we already read *)
|
|
||||||
let lexer =
|
|
||||||
let pending_tokens = ref tokens in
|
|
||||||
fun lb ->
|
|
||||||
match !pending_tokens with
|
|
||||||
| [] -> lexer lb
|
|
||||||
| x :: xs -> pending_tokens := xs; x
|
|
||||||
in
|
|
||||||
Sexp.Of_sexp.parse of_sexp
|
|
||||||
(Univ_map.singleton (Syntax.key Stanza.syntax) syntax)
|
|
||||||
(Sexp.Parser.parse ~lexer ~mode:Single lexbuf))
|
(Sexp.Parser.parse ~lexer ~mode:Single lexbuf))
|
||||||
|
|
||||||
let gen ~(dune_version : Syntax.Version.t) confs =
|
let gen ~(dune_version : Syntax.Version.t) confs =
|
||||||
|
|
Loading…
Reference in New Issue