Commit 69bd2a49 authored by POTTIER Francois's avatar POTTIER Francois

Updated [FancyDriver] to produce a fancy message. This seems to be working.

parent 13bd0b0f
......@@ -7,49 +7,67 @@
(* TEMPORARY a lot of code is copied from [Engine]. Can we avoid it? *)
(* A short name for the incremental parser API. *)
module I =
open MenhirLib.General (* streams: Nil, Cons *)
open Parser.MenhirInterpreter (* incremental API to our parser *)
(* The loop which drives the parser. At each iteration, we analyze a
result produced by the parser, and act in an appropriate manner. *)
(* [lexbuf] is the lexing buffer. [result] is the last result produced
by the parser. *)
result produced by the parser, and act in an appropriate manner.
We have to do this in order to get ahold of the current state when
a syntax error is encountered. *)
let rec loop lexer lexbuf (result : 'a I.result) : 'a =
let rec loop lexer lexbuf (result : 'a result) : 'a =
let open Lexing in
match result with
| I.InputNeeded _ ->
| InputNeeded _ ->
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
result. Then, repeat. *)
let token = lexer lexbuf in
let result = I.offer result (token, lexbuf.lex_start_p, lexbuf.lex_curr_p) in
let result = offer result (token, lexbuf.lex_start_p, lexbuf.lex_curr_p) in
loop lexer lexbuf result
| I.Shifting _
| I.AboutToReduce _ ->
let result = I.resume result in
| Shifting _
| AboutToReduce _ ->
let result = resume result in
loop lexer lexbuf result
| I.HandlingError _env ->
(* The parser has suspended itself because of a syntax error. Stop. *)
Printf.fprintf stderr
"At offset %d: syntax error.\n%!"
(lexeme_start lexbuf);
exit 1
| I.Accepted v ->
| HandlingError env ->
(* The parser has suspended itself because of a syntax error. Stop.
Find out which state the parser is currently in. *)
let stack = stack env in
let s : int =
match Lazy.force stack with
| Nil ->
(* Hmm... The parser is in its initial state. Its number is
usually 0. This is a BIG HACK. TEMPORARY *)
| Cons (Element (s, _, _, _), _) ->
(* We are missing a conversion [lr1state -> int]. TEMPORARY *)
Obj.magic (s : _ lr1state)
(* Display a nice error message. In principle, the table found in
[FancyParserMessages] should be complete, so we should obtain
a nice message. If [Not_found] is raised, we produce a generic
message, which is better than nothing. Note that the OCaml code
in [FancyParserMessages] is auto-generated based on the table in
[fancy-parser.messages]. *)
let message =
FancyParserMessages.message s
with Not_found ->
Printf.sprintf "Unknown syntax error (in state %d).\n" s
(* Hack: remove the final newline, because [Error.error] adds one. *)
let message = String.sub message 0 (String.length message - 1) in
(* Display our message and die. *)
Error.error (Positions.lexbuf lexbuf) message
| Accepted v ->
| I.Rejected ->
| Rejected ->
(* The parser rejects this input. This cannot happen because
we stop as soon as the parser reports [HandlingError]. *)
assert false
(* The entry point. *)
module F = FancyParserMessages (* TEMPORARY *)
let grammar lexer lexbuf =
loop lexer lexbuf (Parser.Incremental.grammar())
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment