Commit a991d7cb authored by POTTIER Francois's avatar POTTIER Francois

Simplification of [FancyDriver] using [loop_handle].

parent 535cee59
...@@ -5,30 +5,13 @@ ...@@ -5,30 +5,13 @@
in a more ambitious manner, so as to help our end users understand in a more ambitious manner, so as to help our end users understand
their mistakes. *) their mistakes. *)
(* TEMPORARY a lot of code is copied from [Engine]. Can we avoid it? *)
open MenhirLib.General (* streams: Nil, Cons *) open MenhirLib.General (* streams: Nil, Cons *)
open Parser.MenhirInterpreter (* incremental API to our parser *) open Parser.MenhirInterpreter (* incremental API to our parser *)
(* The loop which drives the parser. At each iteration, we analyze a (* [fail] is invoked if a syntax error is encountered. *)
checkpoint 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 (checkpoint : 'a checkpoint) : 'a = let fail lexbuf checkpoint =
let open Lexing in
match checkpoint with match checkpoint with
| InputNeeded _ ->
(* The parser needs a token. Request one from the lexer,
and offer it to the parser, which will produce a new
checkpoint. Then, repeat. *)
let token = lexer lexbuf in
let checkpoint = offer checkpoint (token, lexbuf.lex_start_p, lexbuf.lex_curr_p) in
loop lexer lexbuf checkpoint
| Shifting _
| AboutToReduce _ ->
let checkpoint = resume checkpoint in
loop lexer lexbuf checkpoint
| HandlingError env -> | HandlingError env ->
(* The parser has suspended itself because of a syntax error. Stop. (* The parser has suspended itself because of a syntax error. Stop.
Find out which state the parser is currently in. *) Find out which state the parser is currently in. *)
...@@ -59,15 +42,16 @@ let rec loop lexer lexbuf (checkpoint : 'a checkpoint) : 'a = ...@@ -59,15 +42,16 @@ let rec loop lexer lexbuf (checkpoint : 'a checkpoint) : 'a =
let message = String.sub message 0 (String.length message - 1) in let message = String.sub message 0 (String.length message - 1) in
(* Display our message and die. *) (* Display our message and die. *)
Error.error (Positions.lexbuf lexbuf) message Error.error (Positions.lexbuf lexbuf) message
| Accepted v -> | _ ->
v (* This cannot happen. *)
| Rejected ->
(* The parser rejects this input. This cannot happen because
we stop as soon as the parser reports [HandlingError]. *)
assert false assert false
(* The entry point. *) (* The entry point. *)
let grammar lexer lexbuf = let grammar lexer lexbuf =
loop lexer lexbuf (Parser.Incremental.grammar()) loop_handle
(fun v -> v)
(fail lexbuf)
(lexer_lexbuf_to_supplier 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