Strengthen the parsing of the (lang ...) line
It now has to be the first line of the dune-project file and the lexical conventions are stricter than the rest of the syntax. This will allow making changes to the lexical conventions of the language in the future. Signed-off-by: Jeremie Dimino <jdimino@janestreet.com>
This commit is contained in:
parent
39e74826f4
commit
f0e448dc36
|
@ -111,7 +111,7 @@ let user_config_file =
|
|||
Path.relative (Path.of_string Xdg.config_dir) "dune/config"
|
||||
|
||||
let load_config_file p =
|
||||
t (Io.Sexp.load_many_as_one p)
|
||||
t (Io.Sexp.load p ~mode:Many_as_one)
|
||||
|
||||
let load_user_config_file () =
|
||||
if Path.exists user_config_file then
|
||||
|
|
|
@ -0,0 +1,10 @@
|
|||
(** Returns [true] if the input starts with "(* -*- tuareg -*- *)" *)
|
||||
val is_script : Lexing.lexbuf -> bool
|
||||
|
||||
type first_line =
|
||||
{ lang : Loc.t * string
|
||||
; version : Loc.t * string
|
||||
}
|
||||
|
||||
(** Parse the first line of a dune-project file. *)
|
||||
val first_line : Lexing.lexbuf -> first_line
|
|
@ -1,3 +1,64 @@
|
|||
{
|
||||
type first_line =
|
||||
{ lang : Loc.t * string
|
||||
; version : Loc.t * string
|
||||
}
|
||||
|
||||
let make_loc lexbuf : Loc.t =
|
||||
{ start = Lexing.lexeme_start_p lexbuf
|
||||
; stop = Lexing.lexeme_end_p lexbuf
|
||||
}
|
||||
|
||||
let invalid_lang_line start lexbuf =
|
||||
lexbuf.Lexing.lex_start_p <- start;
|
||||
Loc.fail_lex lexbuf
|
||||
"Invalid first line, expected: (lang <lang> <version>)"
|
||||
}
|
||||
|
||||
let newline = '\r'? '\n'
|
||||
let blank = [' ' '\t']
|
||||
let atom_char = [^';' '(' ')' '"' '#' '|' '\000'-'\032']
|
||||
|
||||
rule is_script = parse
|
||||
| "(* -*- tuareg -*- *)" { true }
|
||||
| "" { false }
|
||||
|
||||
and first_line = parse
|
||||
| '(' blank* "lang"
|
||||
{ let start = Lexing.lexeme_start_p lexbuf in
|
||||
let lang = atom start lexbuf in
|
||||
let version = atom start lexbuf in
|
||||
first_line_end start lexbuf;
|
||||
{ lang; version }
|
||||
}
|
||||
| ""
|
||||
{ let start = Lexing.lexeme_start_p lexbuf in
|
||||
to_eol lexbuf;
|
||||
invalid_lang_line start lexbuf
|
||||
}
|
||||
|
||||
and atom start = parse
|
||||
| blank+
|
||||
{ atom start lexbuf
|
||||
}
|
||||
| atom_char+ as s
|
||||
{ (make_loc lexbuf, s)
|
||||
}
|
||||
| _ | eof
|
||||
{ to_eol lexbuf;
|
||||
invalid_lang_line start lexbuf
|
||||
}
|
||||
|
||||
and first_line_end start = parse
|
||||
| blank* ')' blank* (newline | eof)
|
||||
{ ()
|
||||
}
|
||||
| ""
|
||||
{ to_eol lexbuf;
|
||||
invalid_lang_line start lexbuf
|
||||
}
|
||||
|
||||
and to_eol = parse
|
||||
| [^'\r' '\n']*
|
||||
{ ()
|
||||
}
|
||||
|
|
|
@ -131,22 +131,6 @@ let anonymous =
|
|||
|
||||
let filename = "dune-project"
|
||||
|
||||
type lang =
|
||||
| Dune_0_1
|
||||
|
||||
let lang =
|
||||
let name =
|
||||
enum
|
||||
[ ("dune", ()) ]
|
||||
in
|
||||
let version ver =
|
||||
match string ver with
|
||||
| "0.1" -> Dune_0_1
|
||||
| _ ->
|
||||
of_sexp_error ver "unsupported version of the dune language"
|
||||
in
|
||||
field_multi "lang" (name @> version @> nil) (fun () v -> v)
|
||||
|
||||
let default_name ~dir ~packages =
|
||||
match Package.Name.Map.choose packages with
|
||||
| None -> Option.value_exn (Name.anonymous dir)
|
||||
|
@ -173,8 +157,7 @@ let name ~dir ~packages =
|
|||
|
||||
let parse ~dir packages =
|
||||
record
|
||||
(lang >>= fun Dune_0_1 ->
|
||||
name ~dir ~packages >>= fun name ->
|
||||
(name ~dir ~packages >>= fun name ->
|
||||
field_o "version" string >>= fun version ->
|
||||
return { lang = Dune (0, 1)
|
||||
; name
|
||||
|
@ -185,8 +168,20 @@ let parse ~dir packages =
|
|||
|
||||
let load_dune_project ~dir packages =
|
||||
let fname = Path.relative dir filename in
|
||||
let sexp = Io.Sexp.load_many_as_one fname in
|
||||
parse ~dir packages sexp
|
||||
Io.with_lexbuf_from_file fname ~f:(fun lb ->
|
||||
let { Dune_lexer. lang; version } = Dune_lexer.first_line lb in
|
||||
(match lang with
|
||||
| _, "dune" -> ()
|
||||
| loc, s ->
|
||||
Loc.fail loc "%s is not a supported langauge. \
|
||||
Only the dune language is supported." s);
|
||||
(match version with
|
||||
| _, "0.1" -> ()
|
||||
| loc, s ->
|
||||
Loc.fail loc "Unsupported version of the dune language. \
|
||||
The only supported version is 0.1." s);
|
||||
let sexp = Sexp.Parser.parse lb ~mode:Many_as_one in
|
||||
parse ~dir packages sexp)
|
||||
|
||||
let make_jbuilder_project ~dir packages =
|
||||
{ lang = Jbuilder
|
||||
|
|
|
@ -82,16 +82,6 @@ let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)
|
|||
let buf_len = 65_536
|
||||
|
||||
module Sexp = struct
|
||||
open Sexp
|
||||
|
||||
let load ?lexer path ~mode =
|
||||
with_lexbuf_from_file path ~f:(Usexp.Parser.parse ~mode ?lexer)
|
||||
|
||||
let load_many_as_one ?lexer path =
|
||||
match load ?lexer path ~mode:Many with
|
||||
| [] -> Ast.List (Loc.in_file (Path.to_string path), [])
|
||||
| x :: l ->
|
||||
let last = Option.value (List.last l) ~default:x in
|
||||
let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in
|
||||
Ast.List (loc, x :: l)
|
||||
end
|
||||
|
|
|
@ -28,7 +28,6 @@ val read_all : in_channel -> string
|
|||
|
||||
module Sexp : sig
|
||||
val load : ?lexer:Usexp.Lexer.t -> Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a
|
||||
val load_many_as_one : ?lexer:Usexp.Lexer.t -> Path.t -> Sexp.Ast.t
|
||||
end
|
||||
|
||||
(**/**)
|
||||
|
|
|
@ -267,7 +267,7 @@ module Ast = struct
|
|||
if should_be_atom s then Atom (loc, A s)
|
||||
else Quoted_string (loc, s)
|
||||
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||
let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
|
||||
|
||||
let rec remove_locs : t -> sexp = function
|
||||
| Atom (_, s) -> Atom s
|
||||
|
@ -308,18 +308,27 @@ module Parser = struct
|
|||
type 'a t =
|
||||
| Single : Ast.t t
|
||||
| Many : Ast.t list t
|
||||
| Many_as_one : Ast.t t
|
||||
|
||||
let make_result : type a. a t -> Lexing.lexbuf -> Ast.t list -> a
|
||||
= fun t lexbuf sexps ->
|
||||
match t with
|
||||
| Many -> sexps
|
||||
| Single ->
|
||||
| Single -> begin
|
||||
match sexps with
|
||||
| [sexp] -> sexp
|
||||
| [] -> error (make_loc lexbuf) "no s-expression found in input"
|
||||
| _ :: sexp :: _ ->
|
||||
error (Ast.loc sexp) "too many s-expressions found in input"
|
||||
end
|
||||
| Many -> sexps
|
||||
| Many_as_one ->
|
||||
match sexps with
|
||||
| [] -> List (Loc.in_file lexbuf.lex_curr_p.pos_fname, [])
|
||||
| x :: l ->
|
||||
let last = List.fold_left l ~init:x ~f:(fun _ x -> x) in
|
||||
let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in
|
||||
List (loc, x :: l)
|
||||
end
|
||||
|
||||
let rec loop depth lexer lexbuf acc =
|
||||
match (lexer lexbuf : Lexer.Token.t) with
|
||||
|
|
|
@ -109,6 +109,7 @@ module Parser : sig
|
|||
type 'a t =
|
||||
| Single : Ast.t t
|
||||
| Many : Ast.t list t
|
||||
| Many_as_one : Ast.t t
|
||||
end
|
||||
|
||||
val parse
|
||||
|
|
Loading…
Reference in New Issue