From 6814e7786a1c4c66b14339d3548a0697b2cd5ec8 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 26 Dec 2019 18:57:02 +0100 Subject: [PATCH] Same error formatting for the incremental and monolithic API of Menhir. --- src/passes/1-parser/cameligo/ParserAPI.ml | 43 ++++++++++++------- src/passes/1-parser/cameligo/ParserAPI.mli | 25 ++++++----- src/passes/1-parser/cameligo/ParserMain.ml | 44 +++++++------------- src/passes/1-parser/pascaligo/ParserAPI.ml | 43 ++++++++++++------- src/passes/1-parser/pascaligo/ParserAPI.mli | 25 ++++++----- src/passes/1-parser/pascaligo/ParserMain.ml | 44 +++++++------------- src/passes/1-parser/reasonligo/ParserAPI.ml | 43 ++++++++++++------- src/passes/1-parser/reasonligo/ParserAPI.mli | 25 ++++++----- src/passes/1-parser/reasonligo/ParserMain.ml | 44 +++++++------------- 9 files changed, 165 insertions(+), 171 deletions(-) diff --git a/src/passes/1-parser/cameligo/ParserAPI.ml b/src/passes/1-parser/cameligo/ParserAPI.ml index abfdad840..24f663d90 100644 --- a/src/passes/1-parser/cameligo/ParserAPI.ml +++ b/src/passes/1-parser/cameligo/ParserAPI.ml @@ -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 diff --git a/src/passes/1-parser/cameligo/ParserAPI.mli b/src/passes/1-parser/cameligo/ParserAPI.mli index 239d076ee..7d969a33c 100644 --- a/src/passes/1-parser/cameligo/ParserAPI.mli +++ b/src/passes/1-parser/cameligo/ParserAPI.mli @@ -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 diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index 32cbd604b..8ed546f50 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -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 diff --git a/src/passes/1-parser/pascaligo/ParserAPI.ml b/src/passes/1-parser/pascaligo/ParserAPI.ml index abfdad840..24f663d90 100644 --- a/src/passes/1-parser/pascaligo/ParserAPI.ml +++ b/src/passes/1-parser/pascaligo/ParserAPI.ml @@ -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 diff --git a/src/passes/1-parser/pascaligo/ParserAPI.mli b/src/passes/1-parser/pascaligo/ParserAPI.mli index 239d076ee..7d969a33c 100644 --- a/src/passes/1-parser/pascaligo/ParserAPI.mli +++ b/src/passes/1-parser/pascaligo/ParserAPI.mli @@ -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 diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 46564b994..489008453 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -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 diff --git a/src/passes/1-parser/reasonligo/ParserAPI.ml b/src/passes/1-parser/reasonligo/ParserAPI.ml index abfdad840..24f663d90 100644 --- a/src/passes/1-parser/reasonligo/ParserAPI.ml +++ b/src/passes/1-parser/reasonligo/ParserAPI.ml @@ -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 diff --git a/src/passes/1-parser/reasonligo/ParserAPI.mli b/src/passes/1-parser/reasonligo/ParserAPI.mli index 239d076ee..7d969a33c 100644 --- a/src/passes/1-parser/reasonligo/ParserAPI.mli +++ b/src/passes/1-parser/reasonligo/ParserAPI.mli @@ -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 diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index b8965a110..0af4c4a76 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -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