diff --git a/src/config.ml b/src/config.ml index 6423b504..2dbaad76 100644 --- a/src/config.ml +++ b/src/config.ml @@ -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 diff --git a/src/dune_lexer.mli b/src/dune_lexer.mli new file mode 100644 index 00000000..eac90852 --- /dev/null +++ b/src/dune_lexer.mli @@ -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 diff --git a/src/dune_lexer.mll b/src/dune_lexer.mll index bace62a3..3f26c611 100644 --- a/src/dune_lexer.mll +++ b/src/dune_lexer.mll @@ -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 )" +} + +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']* + { () + } diff --git a/src/dune_project.ml b/src/dune_project.ml index 8e228dda..dc6114eb 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -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 diff --git a/src/stdune/io.ml b/src/stdune/io.ml index 4ac4d870..69bd48cd 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -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 diff --git a/src/stdune/io.mli b/src/stdune/io.mli index 7dc87a0c..ab78efb8 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -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 (**/**) diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index e45fa393..960b8986 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -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 @@ -306,19 +306,28 @@ module Parser = struct module Mode = struct type 'a t = - | Single : Ast.t t - | Many : Ast.t list 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 = diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index 7a451b0b..9ab798a1 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -107,8 +107,9 @@ end module Parser : sig module Mode : sig type 'a t = - | Single : Ast.t t - | Many : Ast.t list t + | Single : Ast.t t + | Many : Ast.t list t + | Many_as_one : Ast.t t end val parse