44 lines
1.4 KiB
OCaml
44 lines
1.4 KiB
OCaml
|
open Util
|
||
|
|
|
||
|
|
module I = Parser.MenhirInterpreter
|
||
|
|
|
||
|
|
let get_parse_error env =
|
||
|
|
match I.stack env with
|
||
|
|
| lazy Nil -> "Invalid syntax"
|
||
|
|
| lazy (Cons (I.Element (state, _, _, _), _)) ->
|
||
|
|
try (Parser_messages.message (I.number state)) with
|
||
|
|
| Not_found -> "invalid syntax (no specific message for this eror)"
|
||
|
|
|
||
|
|
let rec parse lexbuf (checkpoint : Ast.program I.checkpoint) =
|
||
|
|
match checkpoint with
|
||
|
|
| I.InputNeeded _env ->
|
||
|
|
let token = Lexer.f lexbuf in
|
||
|
|
let startp = lexbuf.lex_start_p
|
||
|
|
and endp = lexbuf.lex_curr_p in
|
||
|
|
let checkpoint = I.offer checkpoint (token, startp, endp) in
|
||
|
|
parse lexbuf checkpoint
|
||
|
|
| I.Shifting _
|
||
|
|
| I.AboutToReduce _ ->
|
||
|
|
let checkpoint = I.resume checkpoint in
|
||
|
|
parse lexbuf checkpoint
|
||
|
|
| I.HandlingError _env ->
|
||
|
|
let line, pos = Util.get_lexing_position lexbuf in
|
||
|
|
let err = get_parse_error _env in
|
||
|
|
raise (Syntax_error (Some (line, pos), err))
|
||
|
|
| I.Accepted v -> v
|
||
|
|
| I.Rejected ->
|
||
|
|
raise (Syntax_error (None, "invalid syntax (parser rejected the input)"))
|
||
|
|
|
||
|
|
let try_parse lexbuf =
|
||
|
|
try
|
||
|
|
let program = parse lexbuf (Parser.Incremental.program lexbuf.lex_curr_p) in
|
||
|
|
Ok program
|
||
|
|
with
|
||
|
|
| Util.Syntax_error (pos, err) ->
|
||
|
|
begin
|
||
|
|
match pos with
|
||
|
|
| Some (line, pos) ->
|
||
|
|
Error (Printf.sprintf "Syntax error on line %d, character %d: %s" line pos err)
|
||
|
|
| None -> Error (Printf.sprintf "Syntax error: %s" err)
|
||
|
|
end
|