parser_utils.ml

   1 (* $Id$ *)
   2
   3 module type Parser_type =
   4 sig
   5   type token
   6   type result
   7   val input : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> result
   8   val rule : Lexing.lexbuf -> token
   9 end
  10
  11 module Make(T : Parser_type) =
  12 struct
  13   let parse_buf_exn lexbuf =
  14     try
  15       T.input T.rule lexbuf
  16     with exn ->
  17       begin
  18         let curr = lexbuf.Lexing.lex_curr_p in
  19         let line = curr.Lexing.pos_lnum in
  20         let cnum = curr.Lexing.pos_cnum - curr.Lexing.pos_bol in
  21         let tok = Lexing.lexeme lexbuf in
  22         let extra = begin match exn with
  23         | Parsing.Parse_error -> "[parsing error]"
  24         | _ -> "[unknown]"
  25         end in
  26         Error.report "Exception %s in %u:%u at lexeme \"%s\"" extra line cnum tok;
  27         raise exn
  28       end
  29
  30   let parse_buf lexbuf = try Some (parse_buf_exn lexbuf) with exn -> None
  31
  32   let parse_stdin () = parse_buf (Lexing.from_channel stdin)
  33   let parse_string str = (*Error.log "Parsing : %s" str; *)
  34                          parse_buf (Lexing.from_string str)
  35
  36   let parse_file filename =
  37     let contents = try Std.input_file filename with exn -> "" in
  38     parse_string contents
  39
  40 end