Same error formatting for the incremental and monolithic API of Menhir.
This commit is contained in:
Christian Rinderknecht
parent
379311a748
commit
6814e7786a
@ -1,10 +1,4 @@
|
||||
(** Generic parser for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode Region.{region; value} ~file =
|
||||
let reg = region#to_string ~file ~offsets mode in
|
||||
Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value
|
||||
(* Generic parser for LIGO *)
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
@ -12,12 +6,6 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message : int -> string end) =
|
||||
struct
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
|
||||
module I = Parser.MenhirInterpreter
|
||||
module S = MenhirLib.General (* Streams *)
|
||||
|
||||
@ -42,6 +30,13 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
|
||||
(* The parser has suspended itself because of a syntax error. Stop. *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
let failure get_win checkpoint =
|
||||
let message = ParErr.message (state checkpoint) in
|
||||
match get_win () with
|
||||
@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
| Lexer.Two (invalid, valid) ->
|
||||
raise (Point (message, Some valid, invalid))
|
||||
|
||||
(* The generic parsing function *)
|
||||
(* The two Menhir APIs are called from the following two functions. *)
|
||||
|
||||
let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
|
||||
let supplier = I.lexer_lexbuf_to_supplier read buffer
|
||||
@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
in close (); ast
|
||||
|
||||
let mono_contract = Parser.contract
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
|
||||
let invalid_lexeme = LexToken.to_lexeme invalid in
|
||||
let invalid_region = LexToken.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = LexToken.to_lexeme valid
|
||||
in Printf.sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
header ^ (if message = "" then ".\n" else ":\n" ^ message)
|
||||
|
||||
end
|
||||
|
||||
@ -1,23 +1,22 @@
|
||||
(** Generic parser API for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
val format_error :
|
||||
?offsets:bool -> [`Byte | `Point] ->
|
||||
string Region.reg -> file:bool -> string
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message: int -> string end) :
|
||||
sig
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
(* Monolithic and incremental APIs of Menhir for parsing *)
|
||||
|
||||
val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
|
||||
val incr_contract : Lexer.instance -> AST.t
|
||||
|
||||
(* Error handling *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
|
||||
end
|
||||
|
||||
@ -119,43 +119,27 @@ let () =
|
||||
in prerr_string msg
|
||||
|
||||
(* Incremental API of Menhir *)
|
||||
| ParserFront.Point (message, valid_opt, invalid) ->
|
||||
let () = close_all () in
|
||||
let invalid_lexeme = Lexer.Token.to_lexeme invalid in
|
||||
let invalid_region = Lexer.Token.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets:options#offsets
|
||||
options#mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = Lexer.Token.to_lexeme valid
|
||||
in sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
eprintf "\027[31m%s:\n%s\027[0m%!" header message
|
||||
| ParserFront.Point point ->
|
||||
let () = close_all () in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* Monolithic API of Menhir *)
|
||||
| Parser.Error ->
|
||||
let () = close_all () in
|
||||
let token =
|
||||
let invalid, valid_opt =
|
||||
match get_win () with
|
||||
Lexer.Nil ->
|
||||
assert false (* Safe: There is always at least EOF. *)
|
||||
| Lexer.One token
|
||||
| Lexer.Two (token, _) -> token in
|
||||
let lexeme = Lexer.Token.to_lexeme token
|
||||
and region = Lexer.Token.to_region token in
|
||||
let msg = sprintf "Syntax error on \"%s\".\n" lexeme in
|
||||
let error = Region.{region; value=msg} in
|
||||
let () = close_all () in
|
||||
let msg =
|
||||
ParserAPI.format_error ~offsets:options#offsets
|
||||
options#mode error ~file
|
||||
in prerr_string msg
|
||||
| Lexer.One invalid -> invalid, None
|
||||
| Lexer.Two (invalid, valid) -> invalid, Some valid in
|
||||
let point = "", valid_opt, invalid in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* I/O errors *)
|
||||
| Sys_error msg -> Utils.highlight msg
|
||||
|
||||
@ -1,10 +1,4 @@
|
||||
(** Generic parser for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode Region.{region; value} ~file =
|
||||
let reg = region#to_string ~file ~offsets mode in
|
||||
Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value
|
||||
(* Generic parser for LIGO *)
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
@ -12,12 +6,6 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message : int -> string end) =
|
||||
struct
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
|
||||
module I = Parser.MenhirInterpreter
|
||||
module S = MenhirLib.General (* Streams *)
|
||||
|
||||
@ -42,6 +30,13 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
|
||||
(* The parser has suspended itself because of a syntax error. Stop. *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
let failure get_win checkpoint =
|
||||
let message = ParErr.message (state checkpoint) in
|
||||
match get_win () with
|
||||
@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
| Lexer.Two (invalid, valid) ->
|
||||
raise (Point (message, Some valid, invalid))
|
||||
|
||||
(* The generic parsing function *)
|
||||
(* The two Menhir APIs are called from the following two functions. *)
|
||||
|
||||
let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
|
||||
let supplier = I.lexer_lexbuf_to_supplier read buffer
|
||||
@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
in close (); ast
|
||||
|
||||
let mono_contract = Parser.contract
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
|
||||
let invalid_lexeme = LexToken.to_lexeme invalid in
|
||||
let invalid_region = LexToken.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = LexToken.to_lexeme valid
|
||||
in Printf.sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
header ^ (if message = "" then ".\n" else ":\n" ^ message)
|
||||
|
||||
end
|
||||
|
||||
@ -1,23 +1,22 @@
|
||||
(** Generic parser API for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
val format_error :
|
||||
?offsets:bool -> [`Byte | `Point] ->
|
||||
string Region.reg -> file:bool -> string
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message: int -> string end) :
|
||||
sig
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
(* Monolithic and incremental APIs of Menhir for parsing *)
|
||||
|
||||
val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
|
||||
val incr_contract : Lexer.instance -> AST.t
|
||||
|
||||
(* Error handling *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
|
||||
end
|
||||
|
||||
@ -119,43 +119,27 @@ let () =
|
||||
in prerr_string msg
|
||||
|
||||
(* Incremental API of Menhir *)
|
||||
| ParserFront.Point (message, valid_opt, invalid) ->
|
||||
let () = close_all () in
|
||||
let invalid_lexeme = Lexer.Token.to_lexeme invalid in
|
||||
let invalid_region = Lexer.Token.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets:options#offsets
|
||||
options#mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = Lexer.Token.to_lexeme valid
|
||||
in sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
eprintf "\027[31m%s:\n%s\027[0m%!" header message
|
||||
| ParserFront.Point point ->
|
||||
let () = close_all () in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* Monolithic API of Menhir *)
|
||||
| Parser.Error ->
|
||||
let () = close_all () in
|
||||
let token =
|
||||
let invalid, valid_opt =
|
||||
match get_win () with
|
||||
Lexer.Nil ->
|
||||
assert false (* Safe: There is always at least EOF. *)
|
||||
| Lexer.One token
|
||||
| Lexer.Two (token, _) -> token in
|
||||
let lexeme = Lexer.Token.to_lexeme token
|
||||
and region = Lexer.Token.to_region token in
|
||||
let msg = sprintf "Syntax error on \"%s\".\n" lexeme in
|
||||
let error = Region.{region; value=msg} in
|
||||
let () = close_all () in
|
||||
let msg =
|
||||
ParserAPI.format_error ~offsets:options#offsets
|
||||
options#mode error ~file
|
||||
in prerr_string msg
|
||||
| Lexer.One invalid -> invalid, None
|
||||
| Lexer.Two (invalid, valid) -> invalid, Some valid in
|
||||
let point = "", valid_opt, invalid in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* I/O errors *)
|
||||
| Sys_error msg -> Utils.highlight msg
|
||||
|
||||
@ -1,10 +1,4 @@
|
||||
(** Generic parser for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode Region.{region; value} ~file =
|
||||
let reg = region#to_string ~file ~offsets mode in
|
||||
Printf.sprintf "\027[31mParse error %s:\n%s\027[0m%!" reg value
|
||||
(* Generic parser for LIGO *)
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
@ -12,12 +6,6 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message : int -> string end) =
|
||||
struct
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
|
||||
module I = Parser.MenhirInterpreter
|
||||
module S = MenhirLib.General (* Streams *)
|
||||
|
||||
@ -42,6 +30,13 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
|
||||
(* The parser has suspended itself because of a syntax error. Stop. *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
let failure get_win checkpoint =
|
||||
let message = ParErr.message (state checkpoint) in
|
||||
match get_win () with
|
||||
@ -51,7 +46,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
| Lexer.Two (invalid, valid) ->
|
||||
raise (Point (message, Some valid, invalid))
|
||||
|
||||
(* The generic parsing function *)
|
||||
(* The two Menhir APIs are called from the following two functions. *)
|
||||
|
||||
let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t =
|
||||
let supplier = I.lexer_lexbuf_to_supplier read buffer
|
||||
@ -61,4 +56,24 @@ module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
in close (); ast
|
||||
|
||||
let mono_contract = Parser.contract
|
||||
|
||||
(* Errors *)
|
||||
|
||||
let format_error ?(offsets=true) mode (message, valid_opt, invalid) =
|
||||
let invalid_lexeme = LexToken.to_lexeme invalid in
|
||||
let invalid_region = LexToken.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = LexToken.to_lexeme valid
|
||||
in Printf.sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = Printf.sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
header ^ (if message = "" then ".\n" else ":\n" ^ message)
|
||||
|
||||
end
|
||||
|
||||
@ -1,23 +1,22 @@
|
||||
(** Generic parser API for LIGO *)
|
||||
|
||||
(* Errors *)
|
||||
|
||||
val format_error :
|
||||
?offsets:bool -> [`Byte | `Point] ->
|
||||
string Region.reg -> file:bool -> string
|
||||
|
||||
(* Main functor *)
|
||||
|
||||
module Make (Lexer: Lexer.S with module Token := LexToken)
|
||||
(Parser: module type of Parser)
|
||||
(ParErr: sig val message: int -> string end) :
|
||||
sig
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
|
||||
exception Point of message * valid option * invalid
|
||||
(* Monolithic and incremental APIs of Menhir for parsing *)
|
||||
|
||||
val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t
|
||||
val incr_contract : Lexer.instance -> AST.t
|
||||
|
||||
(* Error handling *)
|
||||
|
||||
type message = string
|
||||
type valid = Lexer.token
|
||||
type invalid = Lexer.token
|
||||
type error = message * valid option * invalid
|
||||
|
||||
exception Point of error
|
||||
|
||||
val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string
|
||||
end
|
||||
|
||||
@ -119,43 +119,27 @@ let () =
|
||||
in prerr_string msg
|
||||
|
||||
(* Incremental API of Menhir *)
|
||||
| ParserFront.Point (message, valid_opt, invalid) ->
|
||||
let () = close_all () in
|
||||
let invalid_lexeme = Lexer.Token.to_lexeme invalid in
|
||||
let invalid_region = Lexer.Token.to_region invalid in
|
||||
let header =
|
||||
"Parse error " ^
|
||||
invalid_region#to_string ~offsets:options#offsets
|
||||
options#mode in
|
||||
let after =
|
||||
match valid_opt with
|
||||
None -> ","
|
||||
| Some valid ->
|
||||
let valid_lexeme = Lexer.Token.to_lexeme valid
|
||||
in sprintf ", after \"%s\" and" valid_lexeme in
|
||||
let header = header ^ after in
|
||||
let before = sprintf " before \"%s\"" invalid_lexeme in
|
||||
let header = header ^ before in
|
||||
eprintf "\027[31m%s:\n%s\027[0m%!" header message
|
||||
| ParserFront.Point point ->
|
||||
let () = close_all () in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* Monolithic API of Menhir *)
|
||||
| Parser.Error ->
|
||||
let () = close_all () in
|
||||
let token =
|
||||
let invalid, valid_opt =
|
||||
match get_win () with
|
||||
Lexer.Nil ->
|
||||
assert false (* Safe: There is always at least EOF. *)
|
||||
| Lexer.One token
|
||||
| Lexer.Two (token, _) -> token in
|
||||
let lexeme = Lexer.Token.to_lexeme token
|
||||
and region = Lexer.Token.to_region token in
|
||||
let msg = sprintf "Syntax error on \"%s\".\n" lexeme in
|
||||
let error = Region.{region; value=msg} in
|
||||
let () = close_all () in
|
||||
let msg =
|
||||
ParserAPI.format_error ~offsets:options#offsets
|
||||
options#mode error ~file
|
||||
in prerr_string msg
|
||||
| Lexer.One invalid -> invalid, None
|
||||
| Lexer.Two (invalid, valid) -> invalid, Some valid in
|
||||
let point = "", valid_opt, invalid in
|
||||
let error =
|
||||
ParserFront.format_error ~offsets:options#offsets
|
||||
options#mode point
|
||||
in eprintf "\027[31m%s\027[0m%!" error
|
||||
|
||||
(* I/O errors *)
|
||||
| Sys_error msg -> Utils.highlight msg
|
||||
|
||||
Loading…
Reference in New Issue
Block a user