Show lexer error messages in CameLIGO + PascaLIGO.
This commit is contained in:
Sander Spies
parent
e8a70411b8
commit
301defda3f
@ -6,107 +6,93 @@ module ParserLog = Parser_cameligo.ParserLog
|
||||
module LexToken = Parser_cameligo.LexToken
|
||||
module Lexer = Lexer.Make(LexToken)
|
||||
|
||||
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 parser_error start end_ =
|
||||
let title () = "parser error" in
|
||||
let message () = "" in
|
||||
let loc = Region.make
|
||||
~start:(Pos.from_byte start)
|
||||
~stop:(Pos.from_byte end_)
|
||||
in
|
||||
let data = [
|
||||
("parser_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||
)
|
||||
] in
|
||||
error ~data title message
|
||||
|
||||
let unrecognized_error start end_ =
|
||||
let title () = "unrecognized error" in
|
||||
let message () = "" in
|
||||
let loc = Region.make
|
||||
~start:(Pos.from_byte start)
|
||||
~stop:(Pos.from_byte end_)
|
||||
in
|
||||
let data = [
|
||||
("unrecognized_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||
)
|
||||
] in
|
||||
error ~data title message
|
||||
|
||||
end
|
||||
|
||||
open Errors
|
||||
|
||||
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
|
||||
|
||||
let parse (parser: 'a parser) lexbuf =
|
||||
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
|
||||
let result =
|
||||
try
|
||||
ok (parser read lexbuf)
|
||||
with
|
||||
| Parser.Error ->
|
||||
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_)
|
||||
in
|
||||
close ();
|
||||
result
|
||||
|
||||
let parse_file (source: string) : AST.t result =
|
||||
let pp_input =
|
||||
let prefix = Filename.(source |> basename |> remove_extension)
|
||||
and suffix = ".pp.mligo"
|
||||
in prefix ^ suffix in
|
||||
let prefix = Filename.(source |> basename |> remove_extension)
|
||||
and suffix = ".pp.mligo"
|
||||
in prefix ^ suffix in
|
||||
|
||||
let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
|
||||
source pp_input in
|
||||
let%bind () = sys_command cpp_cmd in
|
||||
source pp_input in
|
||||
let%bind () = sys_command cpp_cmd in
|
||||
|
||||
let%bind channel =
|
||||
generic_try (simple_error "error opening file") @@
|
||||
(fun () -> open_in pp_input) in
|
||||
let lexbuf = Lexing.from_channel channel in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname source
|
||||
in
|
||||
simple_error str
|
||||
)
|
||||
| exn ->
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
||||
(Printexc.to_string exn)
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname source
|
||||
in
|
||||
simple_error str
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
parse (Parser.contract) lexbuf
|
||||
|
||||
let parse_string (s:string) : AST.t result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
||||
simple_error str
|
||||
)
|
||||
| _ -> simple_error "unrecognized parse_ error"
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
parse (Parser.contract) lexbuf
|
||||
|
||||
let parse_expression (s:string) : AST.expr result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let Lexer.{read ; close; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
||||
simple_error str
|
||||
)
|
||||
| exn ->
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
|
||||
(Printexc.to_string exn)
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname s
|
||||
in
|
||||
simple_error str
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.interactive_expr read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
let lexbuf = Lexing.from_string s in
|
||||
parse (Parser.interactive_expr) lexbuf
|
||||
@ -6,6 +6,73 @@ module ParserLog = Parser_pascaligo.ParserLog
|
||||
module LexToken = Parser_pascaligo.LexToken
|
||||
module Lexer = Lexer.Make(LexToken)
|
||||
|
||||
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 parser_error start end_ =
|
||||
let title () = "parser error" in
|
||||
let message () = "" in
|
||||
let loc = Region.make
|
||||
~start:(Pos.from_byte start)
|
||||
~stop:(Pos.from_byte end_)
|
||||
in
|
||||
let data = [
|
||||
("parser_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||
)
|
||||
] in
|
||||
error ~data title message
|
||||
|
||||
let unrecognized_error start end_ =
|
||||
let title () = "unrecognized error" in
|
||||
let message () = "" in
|
||||
let loc = Region.make
|
||||
~start:(Pos.from_byte start)
|
||||
~stop:(Pos.from_byte end_)
|
||||
in
|
||||
let data = [
|
||||
("unrecognized_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
|
||||
)
|
||||
] in
|
||||
error ~data title message
|
||||
|
||||
end
|
||||
|
||||
open Errors
|
||||
|
||||
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
|
||||
|
||||
let parse (parser: 'a parser) lexbuf =
|
||||
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
|
||||
let result =
|
||||
try
|
||||
ok (parser read lexbuf)
|
||||
with
|
||||
| Parser.Error ->
|
||||
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_)
|
||||
in
|
||||
close ();
|
||||
result
|
||||
|
||||
let parse_file (source: string) : AST.t result =
|
||||
let pp_input =
|
||||
let prefix = Filename.(source |> basename |> remove_extension)
|
||||
@ -20,93 +87,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
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname source
|
||||
in
|
||||
simple_error str
|
||||
)
|
||||
| exn ->
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
|
||||
(Printexc.to_string exn)
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname source
|
||||
in
|
||||
simple_error str
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
parse (Parser.contract) lexbuf
|
||||
|
||||
let parse_string (s:string) : AST.t result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let Lexer.{read ; close ; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
||||
simple_error str
|
||||
)
|
||||
| _ -> simple_error "unrecognized parse_ error"
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.contract read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
parse (Parser.contract) lexbuf
|
||||
|
||||
let parse_expression (s:string) : AST.expr result =
|
||||
let lexbuf = Lexing.from_string s in
|
||||
let Lexer.{read ; close; _} =
|
||||
Lexer.open_token_stream None in
|
||||
specific_try (function
|
||||
| Parser.Error -> (
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
|
||||
simple_error str
|
||||
)
|
||||
| exn ->
|
||||
let start = Lexing.lexeme_start_p lexbuf in
|
||||
let end_ = Lexing.lexeme_end_p lexbuf in
|
||||
let str = Format.sprintf
|
||||
"Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
|
||||
(Printexc.to_string exn)
|
||||
(Lexing.lexeme lexbuf)
|
||||
start.pos_lnum (start.pos_cnum - start.pos_bol)
|
||||
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
|
||||
start.pos_fname s
|
||||
in
|
||||
simple_error str
|
||||
) @@ (fun () ->
|
||||
let raw = Parser.interactive_expr read lexbuf in
|
||||
close () ;
|
||||
raw
|
||||
) >>? fun raw ->
|
||||
ok raw
|
||||
let lexbuf = Lexing.from_string s in
|
||||
parse (Parser.interactive_expr) lexbuf
|
||||
|
||||
Loading…
Reference in New Issue
Block a user