Simplification of [FancyDriver] using [loop_handle].

src/fancyDriver.ml

@@ -5,30 +5,13 @@
    in a more ambitious manner, so as to help our end users understand
    their mistakes. *)
 
-(* TEMPORARY a lot of code is copied from [Engine]. Can we avoid it? *)
-
 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
-   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. *)
+(* [fail] is invoked if a syntax error is encountered. *)
 
-let rec loop lexer lexbuf (checkpoint : 'a checkpoint) : 'a =
-  let open Lexing in
+let fail lexbuf checkpoint =
   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 ->
       (* The parser has suspended itself because of a syntax error. Stop.
          Find out which state the parser is currently in. *)
@@ -59,15 +42,16 @@ let rec loop lexer lexbuf (checkpoint : 'a checkpoint) : 'a =
       let message = String.sub message 0 (String.length message - 1) in
       (* Display our message and die. *)
       Error.error (Positions.lexbuf lexbuf) message
-  | Accepted v ->
-      v
-  | Rejected ->
-      (* The parser rejects this input. This cannot happen because
-         we stop as soon as the parser reports [HandlingError]. *)
+  | _ ->
+      (* This cannot happen. *)
       assert false
 
 (* The entry point. *)
 
 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())