Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
113 lines (101 sloc) 3.42 KB
(** Parsing functions *)
type parse_error =
| Lexing of string * Lexing.position
| Parsing of message option * Lexing.position * Lexing.position
and message = string
exception Error of parse_error
let program_symbol = Parser.Incremental.program
let value_symbol = Parser.Incremental.value
let parse symbol lexbuf =
(* see the Menhir manual for the description of
error messages support *)
let open MenhirLib.General in
let module Interp = Parser.MenhirInterpreter in
let input = Interp.lexer_lexbuf_to_supplier Lexer.token lexbuf in
let success prog = prog in
let failure error_state =
let env = match[@warning "-4"] error_state with
| Interp.HandlingError env -> env
| _ -> assert false in
match Interp.stack env with
| lazy Nil -> assert false
| lazy (Cons (Interp.Element (state, _, start_pos, end_pos), _)) ->
let message =
try Some (Parser_messages.message (Interp.number state)) with
| Not_found -> None in
raise (Error (Parsing (message, start_pos, end_pos)))
in
try
Interp.loop_handle success failure input
(symbol lexbuf.Lexing.lex_curr_p)
with Lexer.Error (input, pos) -> raise (Error (Lexing (input, pos)))
let parse_string symbol str =
let lexbuf = Lexing.from_string str in
parse symbol lexbuf
let parse_file symbol path =
let chan = open_in path in
let lexbuf =
let open Lexing in
let lexbuf = from_channel chan in
lexbuf.lex_start_p <- {
pos_fname = path;
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
};
lexbuf.lex_curr_p <- lexbuf.lex_start_p;
lexbuf
in
parse symbol lexbuf
let program_of_string = parse_string program_symbol
let program_of_file = parse_file program_symbol
let value_of_string = parse_string value_symbol
let value_of_file = parse_file value_symbol
(** Parsing error reporting *)
let position {Lexing.pos_fname; pos_lnum; pos_cnum; pos_bol} =
let file = pos_fname in
let line = pos_lnum in
let character = pos_cnum - pos_bol in
(file, line, character)
let nth_line file line =
try
let input = open_in file in
for i = 1 to line - 1 do
ignore (input_line input)
done;
let result = input_line input in
close_in input;
Some result
with _ -> None
let report_error = function
| Parsing (message, start_pos, end_pos) ->
let file, start_line, start_character = position start_pos in
let _, curr_line, curr_character = position end_pos in
let open Printf in
let lines =
if curr_line = start_line
then sprintf "line %d" curr_line
else sprintf "lines %d-%d" start_line curr_line in
let characters =
if curr_line = start_line
then sprintf "characters %d-%d" start_character curr_character
else sprintf "character %d" start_character in
Printf.eprintf "File %S, %s, %s, parsing error:\n%!"
file lines characters;
begin match nth_line file curr_line with
| None -> ()
| Some line -> Printf.eprintf "> %s\n" line;
end;
begin match message with
| None -> ()
| Some error_message -> prerr_endline error_message
end
| Lexing (invalid_input, err_pos) ->
let file, line, character = position err_pos in
Printf.eprintf
"File %S, line %d, character %d, lexing error:\n" file line character;
begin match nth_line file line with
| None -> ()
| Some line -> Printf.eprintf "> %s\n" line;
end;
Printf.eprintf "Invalid input %S\n%!" invalid_input
You can’t perform that action at this time.