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"
|
Path.relative (Path.of_string Xdg.config_dir) "dune/config"
|
||||||
|
|
||||||
let load_config_file p =
|
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 () =
|
let load_user_config_file () =
|
||||||
if Path.exists user_config_file then
|
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
|
rule is_script = parse
|
||||||
| "(* -*- tuareg -*- *)" { true }
|
| "(* -*- tuareg -*- *)" { true }
|
||||||
| "" { false }
|
| "" { 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"
|
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 =
|
let default_name ~dir ~packages =
|
||||||
match Package.Name.Map.choose packages with
|
match Package.Name.Map.choose packages with
|
||||||
| None -> Option.value_exn (Name.anonymous dir)
|
| None -> Option.value_exn (Name.anonymous dir)
|
||||||
|
@ -173,8 +157,7 @@ let name ~dir ~packages =
|
||||||
|
|
||||||
let parse ~dir packages =
|
let parse ~dir packages =
|
||||||
record
|
record
|
||||||
(lang >>= fun Dune_0_1 ->
|
(name ~dir ~packages >>= fun name ->
|
||||||
name ~dir ~packages >>= fun name ->
|
|
||||||
field_o "version" string >>= fun version ->
|
field_o "version" string >>= fun version ->
|
||||||
return { lang = Dune (0, 1)
|
return { lang = Dune (0, 1)
|
||||||
; name
|
; name
|
||||||
|
@ -185,8 +168,20 @@ let parse ~dir packages =
|
||||||
|
|
||||||
let load_dune_project ~dir packages =
|
let load_dune_project ~dir packages =
|
||||||
let fname = Path.relative dir filename in
|
let fname = Path.relative dir filename in
|
||||||
let sexp = Io.Sexp.load_many_as_one fname in
|
Io.with_lexbuf_from_file fname ~f:(fun lb ->
|
||||||
parse ~dir packages sexp
|
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 =
|
let make_jbuilder_project ~dir packages =
|
||||||
{ lang = Jbuilder
|
{ lang = Jbuilder
|
||||||
|
|
|
@ -82,16 +82,6 @@ let compare_files fn1 fn2 = String.compare (read_file fn1) (read_file fn2)
|
||||||
let buf_len = 65_536
|
let buf_len = 65_536
|
||||||
|
|
||||||
module Sexp = struct
|
module Sexp = struct
|
||||||
open Sexp
|
|
||||||
|
|
||||||
let load ?lexer path ~mode =
|
let load ?lexer path ~mode =
|
||||||
with_lexbuf_from_file path ~f:(Usexp.Parser.parse ~mode ?lexer)
|
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
|
end
|
||||||
|
|
|
@ -28,7 +28,6 @@ val read_all : in_channel -> string
|
||||||
|
|
||||||
module Sexp : sig
|
module Sexp : sig
|
||||||
val load : ?lexer:Usexp.Lexer.t -> Path.t -> mode:'a Sexp.Parser.Mode.t -> 'a
|
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
|
end
|
||||||
|
|
||||||
(**/**)
|
(**/**)
|
||||||
|
|
|
@ -267,7 +267,7 @@ module Ast = struct
|
||||||
if should_be_atom s then Atom (loc, A s)
|
if should_be_atom s then Atom (loc, A s)
|
||||||
else Quoted_string (loc, 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
|
let rec remove_locs : t -> sexp = function
|
||||||
| Atom (_, s) -> Atom s
|
| Atom (_, s) -> Atom s
|
||||||
|
@ -306,19 +306,28 @@ module Parser = struct
|
||||||
|
|
||||||
module Mode = struct
|
module Mode = struct
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Single : Ast.t t
|
| Single : Ast.t t
|
||||||
| Many : Ast.t list 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
|
let make_result : type a. a t -> Lexing.lexbuf -> Ast.t list -> a
|
||||||
= fun t lexbuf sexps ->
|
= fun t lexbuf sexps ->
|
||||||
match t with
|
match t with
|
||||||
| Many -> sexps
|
| Single -> begin
|
||||||
| Single ->
|
|
||||||
match sexps with
|
match sexps with
|
||||||
| [sexp] -> sexp
|
| [sexp] -> sexp
|
||||||
| [] -> error (make_loc lexbuf) "no s-expression found in input"
|
| [] -> error (make_loc lexbuf) "no s-expression found in input"
|
||||||
| _ :: sexp :: _ ->
|
| _ :: sexp :: _ ->
|
||||||
error (Ast.loc sexp) "too many s-expressions found in input"
|
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
|
end
|
||||||
|
|
||||||
let rec loop depth lexer lexbuf acc =
|
let rec loop depth lexer lexbuf acc =
|
||||||
|
|
|
@ -107,8 +107,9 @@ end
|
||||||
module Parser : sig
|
module Parser : sig
|
||||||
module Mode : sig
|
module Mode : sig
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Single : Ast.t t
|
| Single : Ast.t t
|
||||||
| Many : Ast.t list t
|
| Many : Ast.t list t
|
||||||
|
| Many_as_one : Ast.t t
|
||||||
end
|
end
|
||||||
|
|
||||||
val parse
|
val parse
|
||||||
|
|
Loading…
Reference in New Issue