298 lines
10 KiB
OCaml
298 lines
10 KiB
OCaml
|
/**************************************************************************/
|
||
|
|
/* */
|
||
|
|
/* Copyright 2012-2017 OCamlPro */
|
||
|
|
/* Copyright 2012 INRIA */
|
||
|
|
/* */
|
||
|
|
/* All rights reserved. This file is distributed under the terms of the */
|
||
|
|
/* GNU Lesser General Public License version 2.1, with the special */
|
||
|
|
/* exception on linking described in the file LICENSE. */
|
||
|
|
/* */
|
||
|
|
/**************************************************************************/
|
||
|
|
|
||
|
|
%{
|
||
|
|
|
||
|
|
open OpamParserTypes.FullPos
|
||
|
|
|
||
|
|
(** Opam config file generic type parser *)
|
||
|
|
|
||
|
|
let pos_of_lexing_pos spos epos =
|
||
|
|
Lexing.({
|
||
|
|
filename = spos.pos_fname;
|
||
|
|
start = spos.pos_lnum, spos.pos_cnum - spos.pos_bol;
|
||
|
|
stop = epos.pos_lnum, epos.pos_cnum - epos.pos_bol;
|
||
|
|
})
|
||
|
|
|
||
|
|
let get_pos_full ?(s=1) n =
|
||
|
|
pos_of_lexing_pos (Parsing.rhs_start_pos s) (Parsing.rhs_end_pos n)
|
||
|
|
|
||
|
|
let get_pos n = get_pos_full ~s:n n
|
||
|
|
|
||
|
|
(* This must match up with the package's version; checked by the build system *)
|
||
|
|
let version = (2, 1)
|
||
|
|
|
||
|
|
%}
|
||
|
|
|
||
|
|
%token <string> STRING IDENT
|
||
|
|
%token <bool> BOOL
|
||
|
|
%token EOF
|
||
|
|
%token LBRACKET RBRACKET
|
||
|
|
%token LPAR RPAR
|
||
|
|
%token LBRACE RBRACE
|
||
|
|
%token COLON
|
||
|
|
%token <int> INT
|
||
|
|
%token <OpamParserTypes.FullPos.relop_kind> RELOP
|
||
|
|
%token AND
|
||
|
|
%token OR
|
||
|
|
%token <OpamParserTypes.FullPos.pfxop_kind> PFXOP
|
||
|
|
%token <OpamParserTypes.FullPos.env_update_op_kind> ENVOP
|
||
|
|
|
||
|
|
%left COLON
|
||
|
|
%left ATOM
|
||
|
|
%left OR
|
||
|
|
%left AND
|
||
|
|
%nonassoc ENVOP
|
||
|
|
%nonassoc PFXOP
|
||
|
|
%left LBRACE RBRACE
|
||
|
|
%nonassoc RELOP
|
||
|
|
%nonassoc URELOP
|
||
|
|
|
||
|
|
%start main value
|
||
|
|
%type <string -> OpamParserTypes.FullPos.opamfile> main
|
||
|
|
%type <OpamParserTypes.FullPos.value> value
|
||
|
|
%type <OpamParserTypes.FullPos.value list> values
|
||
|
|
%type <OpamParserTypes.FullPos.opamfile_item> item
|
||
|
|
|
||
|
|
%%
|
||
|
|
|
||
|
|
main:
|
||
|
|
| items EOF { fun file_name ->
|
||
|
|
{ file_contents = $1; file_name } }
|
||
|
|
;
|
||
|
|
|
||
|
|
items:
|
||
|
|
| item items { $1 :: $2 }
|
||
|
|
| { [] }
|
||
|
|
;
|
||
|
|
|
||
|
|
item:
|
||
|
|
| IDENT COLON value {
|
||
|
|
{ pos = get_pos_full 3;
|
||
|
|
pelem =
|
||
|
|
Variable ({ pos = get_pos 1; pelem = $1 }, $3);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
| IDENT LBRACE items RBRACE {
|
||
|
|
{ pos = get_pos_full 4;
|
||
|
|
pelem =
|
||
|
|
Section ({section_kind = { pos = get_pos 1; pelem = $1 };
|
||
|
|
section_name = None;
|
||
|
|
section_items =
|
||
|
|
{ pos = get_pos_full ~s:2 4; pelem = $3 };
|
||
|
|
})
|
||
|
|
}
|
||
|
|
}
|
||
|
|
| IDENT STRING LBRACE items RBRACE {
|
||
|
|
{ pos = get_pos_full 5;
|
||
|
|
pelem =
|
||
|
|
Section ({section_kind = { pos = get_pos 1; pelem = $1 };
|
||
|
|
section_name = Some { pos = get_pos 2; pelem = $2 };
|
||
|
|
section_items =
|
||
|
|
{ pos = get_pos_full ~s:3 5; pelem = $4 };
|
||
|
|
})
|
||
|
|
}
|
||
|
|
}
|
||
|
|
;
|
||
|
|
|
||
|
|
value:
|
||
|
|
| atom %prec ATOM { $1 }
|
||
|
|
| LPAR values RPAR {{ pos = get_pos_full 3 ; pelem = Group { pos = get_pos_full ~s:1 3; pelem = $2 } }}
|
||
|
|
| LBRACKET values RBRACKET {{ pos = get_pos_full 3 ; pelem = List { pos = get_pos_full ~s:1 3; pelem = $2 } }}
|
||
|
|
| value LBRACE values RBRACE {{ pos = get_pos_full 4 ;
|
||
|
|
pelem = Option ($1, { pos = get_pos_full ~s:2 4; pelem = $3 }) }}
|
||
|
|
| value AND value {{ pos = get_pos_full 3 ; pelem = Logop ({ pos = get_pos 2 ; pelem = `And },$1,$3) }}
|
||
|
|
| value OR value {{ pos = get_pos_full 3 ; pelem = Logop ({ pos = get_pos 2 ; pelem = `Or },$1,$3) }}
|
||
|
|
| atom RELOP atom {{ pos = get_pos_full 3 ; pelem = Relop ({ pos = get_pos 2 ; pelem = $2 },$1,$3) }}
|
||
|
|
| atom ENVOP atom {{ pos = get_pos_full 3 ; pelem = Env_binding ($1,{ pos = get_pos 2 ; pelem = $2 },$3) }}
|
||
|
|
| PFXOP value {{ pos = get_pos_full 2 ; pelem = Pfxop ({ pos = get_pos 1 ; pelem = $1 },$2) }}
|
||
|
|
| RELOP atom {{ pos = get_pos_full 2 ; pelem = Prefix_relop ({ pos = get_pos 1 ; pelem = $1 },$2) }}
|
||
|
|
;
|
||
|
|
|
||
|
|
values:
|
||
|
|
| { [] }
|
||
|
|
| value values { $1 :: $2 }
|
||
|
|
;
|
||
|
|
|
||
|
|
atom:
|
||
|
|
| IDENT {{ pos = get_pos 1 ; pelem = Ident $1 }}
|
||
|
|
| BOOL {{ pos = get_pos 1 ; pelem = Bool $1 }}
|
||
|
|
| INT {{ pos = get_pos 1 ; pelem = Int $1 }}
|
||
|
|
| STRING {{ pos = get_pos 1 ; pelem = String $1 }}
|
||
|
|
;
|
||
|
|
|
||
|
|
%%
|
||
|
|
|
||
|
|
let nopatch v =
|
||
|
|
let s =
|
||
|
|
try
|
||
|
|
let i = String.index v '.' in
|
||
|
|
let i = String.index_from v (i+1) '.' in
|
||
|
|
(String.sub v 0 i)
|
||
|
|
with Not_found ->
|
||
|
|
let rec f i =
|
||
|
|
if i >= String.length v then v
|
||
|
|
else match String.get v i with
|
||
|
|
| '0'..'9' | '.' -> f (i+1)
|
||
|
|
| _ -> String.sub v 0 i
|
||
|
|
in
|
||
|
|
f 0
|
||
|
|
in
|
||
|
|
try Scanf.sscanf s "%u.%u%!" (fun maj min -> (maj, min))
|
||
|
|
with Scanf.Scan_failure _
|
||
|
|
| Failure _
|
||
|
|
| End_of_file ->
|
||
|
|
try Scanf.sscanf s "%u%!" (fun maj -> (maj, 0))
|
||
|
|
with Scanf.Scan_failure _
|
||
|
|
| Failure _
|
||
|
|
| End_of_file -> (0, 0)
|
||
|
|
|
||
|
|
let with_clear_parser f x =
|
||
|
|
try
|
||
|
|
let r = f x in
|
||
|
|
Parsing.clear_parser ();
|
||
|
|
r
|
||
|
|
with e ->
|
||
|
|
Parsing.clear_parser ();
|
||
|
|
raise e
|
||
|
|
|
||
|
|
(* Update a lexbuf with position information prior to raising an exception *)
|
||
|
|
let reset_lexbuf_and_abort l file_name (start_line, start_col) (end_line, end_col) exn =
|
||
|
|
let open Lexing in
|
||
|
|
l.lex_start_p <- {pos_fname = file_name; pos_lnum = start_line; pos_bol = 0; pos_cnum = start_col};
|
||
|
|
l.lex_curr_p <- {pos_fname = file_name; pos_lnum = end_line; pos_bol = 0; pos_cnum = end_col};
|
||
|
|
exn ()
|
||
|
|
|
||
|
|
(* cf. OpamStd.fatal - always allow standard exceptions to propagate. *)
|
||
|
|
let not_fatal = function
|
||
|
|
| Sys.Break
|
||
|
|
| Assert_failure _
|
||
|
|
| Match_failure _ -> false
|
||
|
|
| _ -> true
|
||
|
|
|
||
|
|
let get_three_tokens lexer lexbuf =
|
||
|
|
let open Lexing in
|
||
|
|
try
|
||
|
|
let p0 = lexbuf.lex_start_p, lexbuf.lex_curr_p in
|
||
|
|
let t1 = lexer lexbuf in
|
||
|
|
let p1 = lexbuf.lex_start_p, lexbuf.lex_curr_p in
|
||
|
|
let t2 = lexer lexbuf in
|
||
|
|
let p2 = lexbuf.lex_start_p, lexbuf.lex_curr_p in
|
||
|
|
let t3 = lexer lexbuf in
|
||
|
|
let p3 = lexbuf.lex_start_p, lexbuf.lex_curr_p in
|
||
|
|
((p0, p1, p2, p3), (t1, t2, t3))
|
||
|
|
with
|
||
|
|
| e when not_fatal e -> raise Parsing.Parse_error
|
||
|
|
|
||
|
|
(* Wrap the ocamlyacc parser *)
|
||
|
|
let main lexer lexbuf file_name =
|
||
|
|
(* Extract the exceptions for opam-version not at the top of the file and
|
||
|
|
opam-version duplicated. OpamLexer has special cases for these two
|
||
|
|
constants. If OpamLexer.token isn't used, raise Parse_error instead. *)
|
||
|
|
let exn_not_first () =
|
||
|
|
let _ = lexer (Lexing.from_string "version: \"42\"\nopam-version: \"2.1\"") in
|
||
|
|
raise Parsing.Parse_error
|
||
|
|
and exn_duplicate () =
|
||
|
|
let _ = lexer (Lexing.from_string "opam-version: \"2.1\"\nopam-version: \"z\"") in
|
||
|
|
raise Parsing.Parse_error
|
||
|
|
and restore_pos (start, curr) =
|
||
|
|
let open Lexing in
|
||
|
|
lexbuf.lex_start_p <- start;
|
||
|
|
lexbuf.lex_curr_p <- curr
|
||
|
|
in
|
||
|
|
(* Raises the exn_not_first or exn_duplicate exceptions if an invalid
|
||
|
|
opam-version variable is found in the result. *)
|
||
|
|
let scan_opam_version_variable format_2_1_or_greater = function
|
||
|
|
| {pelem = Variable({pelem = "opam-version"; _}, {pelem = String ver; _}); pos = {start; stop; _}} ->
|
||
|
|
if format_2_1_or_greater then
|
||
|
|
(* [opam-version] can only appear once for 2.1+ *)
|
||
|
|
reset_lexbuf_and_abort lexbuf file_name start stop exn_duplicate
|
||
|
|
else if nopatch ver > (2, 0) then
|
||
|
|
(* Only [opam-version: "2.0"] can appear after the first non-comment/whitespace line of the file *)
|
||
|
|
reset_lexbuf_and_abort lexbuf file_name start stop exn_not_first
|
||
|
|
else
|
||
|
|
()
|
||
|
|
| _ -> ()
|
||
|
|
in
|
||
|
|
(* Now parse the header of the file manually. The smallest valid opam file
|
||
|
|
is `ident: atom`, so if we can't read three tokens we have a parse error *)
|
||
|
|
let ((((_, p0) as initial_pos), ((_, p1) as pos1), ((_, p2) as pos2), ((_, p3) as pos3)), (t1, t2, t3)) =
|
||
|
|
get_three_tokens lexer lexbuf
|
||
|
|
in
|
||
|
|
(* Parse those three tokens if they are [opam-version: ver] *)
|
||
|
|
let (header, format_2_1_or_greater, trap_exceptions) =
|
||
|
|
match (t1, t2, t3) with
|
||
|
|
| (IDENT "opam-version", COLON, STRING ver) ->
|
||
|
|
let header =
|
||
|
|
(* Parsing or lexing errors immediate following opam-version may cause
|
||
|
|
an exception to be raised before the element has been fully parsed.
|
||
|
|
In this case, we generate a single opam-version Variable to return.
|
||
|
|
*)
|
||
|
|
{pelem = Variable({pelem = "opam-version"; pos = pos_of_lexing_pos p0 p1},
|
||
|
|
{pelem = String ver; pos = pos_of_lexing_pos p2 p3});
|
||
|
|
pos = pos_of_lexing_pos p0 p3}
|
||
|
|
in
|
||
|
|
(header, (nopatch ver >= (2, 1)), (nopatch ver > version))
|
||
|
|
| _ ->
|
||
|
|
(* Default is [opam-version: "2.0"] *)
|
||
|
|
let pos = {filename = ""; start = (0, 0); stop = (0, 0)} in
|
||
|
|
({pelem = Variable ({pelem = ""; pos}, {pelem = Int 42; pos}); pos}, false, false)
|
||
|
|
in
|
||
|
|
(* The parser will use position information from the lexbuf, so replay the
|
||
|
|
positions, even if we're not actually reading anything. *)
|
||
|
|
restore_pos initial_pos;
|
||
|
|
(* Wrap the lexer to simulate reading those three tokens a second time *)
|
||
|
|
let lexer =
|
||
|
|
let tokens = ref [t1, pos1; t2, pos2; t3, pos3] in
|
||
|
|
fun lexbuf ->
|
||
|
|
match tokens with
|
||
|
|
| {contents = (t, p)::rest} ->
|
||
|
|
tokens := rest;
|
||
|
|
restore_pos p;
|
||
|
|
t
|
||
|
|
| {contents = []} ->
|
||
|
|
lexer lexbuf
|
||
|
|
in
|
||
|
|
let result =
|
||
|
|
try with_clear_parser (main lexer lexbuf) file_name
|
||
|
|
with e when trap_exceptions && not_fatal e ->
|
||
|
|
(* Append a syntactically invalid sentinel section "#" to the version
|
||
|
|
header which was manually parsed. That is then sufficient
|
||
|
|
information for a client to determine that the file was invalid.
|
||
|
|
If OpamBaseParser.version = (2, 1), this would allow
|
||
|
|
`opam-version: "2.2"`, containing no lexer or parser changes, still to
|
||
|
|
report syntax errors in opam 2.2, by using this sentinel group to
|
||
|
|
detect the parsing error. *)
|
||
|
|
let sentinel =
|
||
|
|
let pos =
|
||
|
|
Lexing.(pos_of_lexing_pos lexbuf.lex_start_p lexbuf.lex_curr_p)
|
||
|
|
in
|
||
|
|
let section =
|
||
|
|
{section_kind = {pelem = "#"; pos};
|
||
|
|
section_name = None;
|
||
|
|
section_items = {pelem = []; pos}}
|
||
|
|
in
|
||
|
|
{pelem = Section section; pos}
|
||
|
|
in
|
||
|
|
{file_contents = [header; sentinel]; file_name}
|
||
|
|
in
|
||
|
|
begin
|
||
|
|
match result with
|
||
|
|
| {file_contents = _::items; _} ->
|
||
|
|
(* Ensure that there are no `opam-version` fields with a value >= "2.1"
|
||
|
|
further down the file. *)
|
||
|
|
List.iter (scan_opam_version_variable format_2_1_or_greater) items
|
||
|
|
| _ -> ()
|
||
|
|
end;
|
||
|
|
result
|
||
|
|
|
||
|
|
let value t l = with_clear_parser (value t) l
|