fancyDriver.ml 2.9 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15 16 17 18 19 20
(* The module [Driver] serves to offer a unified API to the parser,
   which could be produced by either ocamlyacc or Menhir. *)

(* This is the Menhir-specific driver. We wish to handle syntax errors
   in a more ambitious manner, so as to help our end users understand
   their mistakes. *)

21
open Parser.MenhirInterpreter (* incremental API to our parser *)
22

POTTIER Francois's avatar
POTTIER Francois committed
23 24
(* [fail buffer lexbuf s] is invoked if a syntax error is encountered
   in state [s]. *)
25

POTTIER Francois's avatar
POTTIER Francois committed
26
let fail buffer lexbuf (s : int) =
27 28 29 30 31 32 33 34 35 36 37 38
  (* Display a nice error message. In principle, the table found in
     [ParserMessages] 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 [ParserMessages] is auto-generated based on the table in
     [ParserMessages.messages]. *)
  let message =
    try
      ParserMessages.message s
    with Not_found ->
      Printf.sprintf "Unknown syntax error (in state %d).\n" s
  in
39 40
  (* Show the two tokens between which the error took place. *)
  let where = MenhirLib.ErrorReports.show InputFile.chunk buffer in
41 42 43
  (* 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. *)
44
  Error.error (Positions.lexbuf lexbuf) "syntax error %s.\n%s" where message
45

POTTIER Francois's avatar
POTTIER Francois committed
46 47
(* Same as above, except we expect a checkpoint instead of a state [s]. *)

48
let fail buffer lexbuf checkpoint =
49 50
  match checkpoint with
  | HandlingError env ->
POTTIER Francois's avatar
POTTIER Francois committed
51 52
      let s = current_state_number env in
      fail buffer lexbuf s
53 54 55
  | _ ->
      assert false (* this cannot happen *)

56 57
(* The entry point. *)

58
let grammar lexer lexbuf =
59 60 61 62

  (* Keep track of the last two tokens in a buffer. *)
  let buffer, lexer = MenhirLib.ErrorReports.wrap lexer in

63 64
  loop_handle
    (fun v -> v)
65
    (fail buffer lexbuf)
66
    (lexer_lexbuf_to_supplier lexer lexbuf)
POTTIER Francois's avatar
POTTIER Francois committed
67
    (Parser.Incremental.grammar lexbuf.Lexing.lex_curr_p)