diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index 8a4eb33f9..859f4ccd1 100644 --- a/src/passes/1-parser/cameligo.ml +++ b/src/passes/1-parser/cameligo.ml @@ -18,9 +18,21 @@ module Errors = struct ] in error ~data title message - let parser_error start end_ = + let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "parser error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -32,9 +44,21 @@ module Errors = struct ] in error ~data title message - let unrecognized_error start end_ = + let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "unrecognized error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -52,7 +76,7 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) lexbuf = +let parse (parser: 'a parser) source lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in let result = try @@ -61,14 +85,14 @@ let parse (parser: 'a parser) lexbuf = | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error start end_) + fail @@ (parser_error source start end_ lexbuf) | 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 source start end_ lexbuf) in close (); result @@ -87,12 +111,12 @@ let parse_file (source: string) : AST.t result = generic_try (simple_error "error opening file") @@ (fun () -> open_in pp_input) in let lexbuf = Lexing.from_channel channel in - parse (Parser.contract) lexbuf + parse (Parser.contract) source lexbuf let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - parse (Parser.contract) lexbuf + parse (Parser.contract) "" lexbuf let parse_expression (s:string) : AST.expr result = let lexbuf = Lexing.from_string s in - parse (Parser.interactive_expr) lexbuf \ No newline at end of file + parse (Parser.interactive_expr) "" lexbuf \ No newline at end of file diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 05c0af4df..26447683c 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -18,9 +18,21 @@ module Errors = struct ] in error ~data title message - let parser_error start end_ = + let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "parser error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -32,9 +44,21 @@ module Errors = struct ] in error ~data title message - let unrecognized_error start end_ = + let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "unrecognized error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -52,7 +76,7 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) lexbuf = +let parse (parser: 'a parser) source lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in let result = try @@ -61,14 +85,14 @@ let parse (parser: 'a parser) lexbuf = | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error start end_) + fail @@ (parser_error source start end_ lexbuf) | 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 source start end_ lexbuf) in close (); result @@ -87,12 +111,12 @@ let parse_file (source: string) : AST.t result = generic_try (simple_error "error opening file") @@ (fun () -> open_in pp_input) in let lexbuf = Lexing.from_channel channel in - parse (Parser.contract) lexbuf + parse (Parser.contract) source lexbuf let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - parse (Parser.contract) lexbuf + parse (Parser.contract) "" lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in - parse (Parser.interactive_expr) lexbuf + let lexbuf = Lexing.from_string s in + parse (Parser.interactive_expr) "" lexbuf diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index dbf28b756..e1cbb752a 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -29,9 +29,21 @@ module Errors = struct ] in error ~data title message - let parser_error start end_ = + let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "parser error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -43,9 +55,21 @@ module Errors = struct ] in error ~data title message - let unrecognized_error start end_ = + let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let title () = "unrecognized error" in - let message () = "" in + let file = if source = "" then + "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source + in + let str = Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file + in + let message () = str in let loc = Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) @@ -63,7 +87,7 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) lexbuf = +let parse (parser: 'a parser) source lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in let result = try @@ -74,14 +98,14 @@ let parse (parser: 'a parser) lexbuf = | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error start end_) + fail @@ (parser_error source start end_ lexbuf) | 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 source start end_ lexbuf) in close (); result @@ -100,12 +124,12 @@ let parse_file (source: string) : AST.t result = generic_try (simple_error "error opening file") @@ (fun () -> open_in pp_input) in let lexbuf = Lexing.from_channel channel in - parse (Parser.contract) lexbuf + parse (Parser.contract) source lexbuf let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - parse (Parser.contract) lexbuf + parse (Parser.contract) "" lexbuf let parse_expression (s:string) : AST.expr result = let lexbuf = Lexing.from_string s in - parse (Parser.interactive_expr) lexbuf + parse (Parser.interactive_expr) "" lexbuf