diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index 260ddae3d..77c2e8e42 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -9,6 +9,16 @@ module SyntaxError = Parser_reasonligo.SyntaxError module Errors = struct + let lexer_error (e: Lexer.error AST.reg) = + let title () = "lexer error" in + let message () = Lexer.error_to_string e.value in + let data = [ + ("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region + ) + ] in + error ~data title message + let wrong_function_arguments expr = let title () = "wrong function arguments" in let message () = "" in @@ -65,10 +75,13 @@ let parse (parser: 'a parser) lexbuf = let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in fail @@ (parser_error start end_) + | Lexer.Error e -> + fail @@ (lexer_error e) | _ -> + let _ = Printexc.print_backtrace Pervasives.stdout in let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (unrecognized_error start end_) + fail @@ (unrecognized_error start end_) in close (); result diff --git a/src/passes/1-parser/shared/Lexer.mli b/src/passes/1-parser/shared/Lexer.mli index 50754e45f..e52d1d09f 100644 --- a/src/passes/1-parser/shared/Lexer.mli +++ b/src/passes/1-parser/shared/Lexer.mli @@ -138,6 +138,8 @@ module type S = type error + val error_to_string : error -> string + exception Error of error Region.reg val print_error : diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 1e8e382fa..b9c41b895 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -160,6 +160,9 @@ module type S = sig (* Error reporting *) type error + + val error_to_string : error -> string + exception Error of error Region.reg val print_error : ?offsets:bool -> [`Byte | `Point] -> @@ -345,7 +348,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = | Negative_byte_sequence | Broken_string | Invalid_character_in_string - | Reserved_name + | Reserved_name of string | Invalid_symbol | Invalid_natural @@ -387,8 +390,8 @@ module Make (Token: TOKEN) : (S with module Token = Token) = | Invalid_character_in_string -> "Invalid character in string.\n\ Hint: Remove or replace the character.\n" - | Reserved_name -> - "Reserved named.\n\ + | Reserved_name s -> + "Reserved name: " ^ s ^ ".\n\ Hint: Change the name.\n" | Invalid_symbol -> "Invalid symbol.\n\ @@ -486,7 +489,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = let region, lexeme, state = sync state buffer in match Token.mk_ident lexeme region with Ok token -> token, state - | Error Token.Reserved_name -> fail region Reserved_name + | Error Token.Reserved_name -> fail region (Reserved_name lexeme) let mk_constr state buffer = let region, lexeme, state = sync state buffer