Added missing check for reserved names in CameLIGO.
The calls to the lexer and parser of CameLIGO through the compiler use now their error messages, like in PascaLIGO.
This commit is contained in:
Christian Rinderknecht
parent
3c9dd93c8b
commit
8843a46975
@ -6,7 +6,7 @@ let%expect_test _ =
|
||||
ligo: : Lexical error in file "broken_string.ligo", line 1, characters 18-19:
|
||||
The string starting here is interrupted by a line break.
|
||||
Hint: Remove the break, close the string before or insert a backslash.
|
||||
{"parser_loc":"in file \"broken_string.ligo\", line 1, characters 18-19"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -20,10 +20,10 @@ ligo: : Lexical error in file "broken_string.ligo", line 1, characters 18-19:
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/broken_string.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 8-9:
|
||||
ligo: : Lexical error in file "broken_string.mligo", line 1, characters 8-9:
|
||||
The string starting here is interrupted by a line break.
|
||||
Hint: Remove the break, close the string before or insert a backslash.
|
||||
{"parser_loc":"in file \"broken_string.mligo\", line 1, characters 8-9"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -57,7 +57,7 @@ run_ligo_bad [ "compile-contract" ; "../../test/lexer/negative_byte_sequence.lig
|
||||
ligo: : Lexical error in file "negative_byte_sequence.ligo", line 1, characters 18-23:
|
||||
Negative byte sequence.
|
||||
Hint: Remove the leading minus sign.
|
||||
{"parser_loc":"in file \"negative_byte_sequence.ligo\", line 1, characters 18-23"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -71,10 +71,10 @@ ligo: : Lexical error in file "negative_byte_sequence.ligo", line 1, characters
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/negative_byte_sequence.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 8-13:
|
||||
ligo: : Lexical error in file "negative_byte_sequence.mligo", line 1, characters 8-13:
|
||||
Negative byte sequence.
|
||||
Hint: Remove the leading minus sign.
|
||||
{"parser_loc":"in file \"negative_byte_sequence.mligo\", line 1, characters 8-13"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -108,7 +108,7 @@ ligo: : Lexical error at line 1, characters 8-13:
|
||||
ligo: : Lexical error in file "reserved_name.ligo", line 1, characters 4-13:
|
||||
Reserved name: arguments.
|
||||
Hint: Change the name.
|
||||
{"parser_loc":"in file \"reserved_name.ligo\", line 1, characters 4-13"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -139,10 +139,10 @@ ligo: : Lexical error at line 1, characters 4-7:
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/reserved_name.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 4-10:
|
||||
ligo: : Lexical error in file "reserved_name.mligo", line 1, characters 4-10:
|
||||
Reserved name: object.
|
||||
Hint: Change the name.
|
||||
{"parser_loc":"in file \"reserved_name.mligo\", line 1, characters 4-10"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -158,7 +158,7 @@ run_ligo_bad [ "compile-contract" ; "../../test/lexer/unexpected_character.ligo"
|
||||
[%expect {|
|
||||
ligo: : Lexical error in file "unexpected_character.ligo", line 1, characters 18-19:
|
||||
Unexpected character '\239'.
|
||||
{"parser_loc":"in file \"unexpected_character.ligo\", line 1, characters 18-19"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -172,9 +172,9 @@ ligo: : Lexical error in file "unexpected_character.ligo", line 1, characters 18
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/unexpected_character.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 8-9:
|
||||
ligo: : Lexical error in file "unexpected_character.mligo", line 1, characters 8-9:
|
||||
Unexpected character '\239'.
|
||||
{"parser_loc":"in file \"unexpected_character.mligo\", line 1, characters 8-9"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -204,10 +204,10 @@ ligo: : Lexical error at line 1, characters 8-9:
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/unterminated_comment.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 0-2:
|
||||
ligo: : Lexical error in file "unterminated_comment.mligo", line 1, characters 0-2:
|
||||
Unterminated comment.
|
||||
Hint: Close with "*)".
|
||||
{"parser_loc":"in file \"unterminated_comment.mligo\", line 1, characters 0-2"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -224,7 +224,7 @@ run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_symbol.ligo" ; "ma
|
||||
ligo: : Lexical error in file "invalid_symbol.ligo", line 1, characters 17-20:
|
||||
Invalid symbol.
|
||||
Hint: Check the LIGO syntax you use.
|
||||
{"parser_loc":"in file \"invalid_symbol.ligo\", line 1, characters 17-20"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -238,10 +238,10 @@ ligo: : Lexical error in file "invalid_symbol.ligo", line 1, characters 17-20:
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_symbol.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 10-13:
|
||||
ligo: : Lexical error in file "invalid_symbol.mligo", line 1, characters 10-13:
|
||||
Invalid symbol.
|
||||
Hint: Check the LIGO syntax you use.
|
||||
{"parser_loc":"in file \"invalid_symbol.mligo\", line 1, characters 10-13"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -275,7 +275,7 @@ ligo: : Lexical error at line 1, characters 10-11:
|
||||
ligo: : Lexical error in file "missing_break.ligo", line 1, characters 18-18:
|
||||
Missing break.
|
||||
Hint: Insert some space.
|
||||
{"parser_loc":"in file \"missing_break.ligo\", line 1, characters 18-18"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -289,10 +289,10 @@ ligo: : Lexical error in file "missing_break.ligo", line 1, characters 18-18:
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/missing_break.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 11-11:
|
||||
ligo: : Lexical error in file "missing_break.mligo", line 1, characters 11-11:
|
||||
Missing break.
|
||||
Hint: Insert some space.
|
||||
{"parser_loc":"in file \"missing_break.mligo\", line 1, characters 11-11"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -326,7 +326,7 @@ run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_character_in_strin
|
||||
ligo: : Lexical error in file "invalid_character_in_string.ligo", line 1, characters 19-20:
|
||||
Invalid character in string.
|
||||
Hint: Remove or replace the character.
|
||||
{"parser_loc":"in file \"invalid_character_in_string.ligo\", line 1, characters 19-20"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
@ -340,10 +340,10 @@ ligo: : Lexical error in file "invalid_character_in_string.ligo", line 1, charac
|
||||
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_character_in_string.mligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Lexical error at line 1, characters 9-10:
|
||||
ligo: : Lexical error in file "invalid_character_in_string.mligo", line 1, characters 9-10:
|
||||
Invalid character in string.
|
||||
Hint: Remove or replace the character.
|
||||
{"parser_loc":"in file \"invalid_character_in_string.mligo\", line 1, characters 9-10"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
|
||||
@ -4,7 +4,7 @@ let%expect_test _ =
|
||||
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ;
|
||||
[%expect {|
|
||||
ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17, after "bar" and before "-".
|
||||
{"parser_loc":"in file \"error_syntax.ligo\", line 1, characters 16-17"}
|
||||
{}
|
||||
|
||||
|
||||
If you're not sure how to fix this error, you can
|
||||
|
||||
@ -1,11 +1,10 @@
|
||||
open Trace
|
||||
|
||||
module AST = Parser_cameligo.AST
|
||||
module AST = Parser_cameligo.AST
|
||||
module LexToken = Parser_cameligo.LexToken
|
||||
module Lexer = Lexer.Make(LexToken)
|
||||
module Scoping = Parser_cameligo.Scoping
|
||||
module Region = Simple_utils.Region
|
||||
module ParErr = Parser_cameligo.ParErr
|
||||
module Lexer = Lexer.Make(LexToken)
|
||||
module Scoping = Parser_cameligo.Scoping
|
||||
module Region = Simple_utils.Region
|
||||
module ParErr = Parser_cameligo.ParErr
|
||||
module SSet = Utils.String.Set
|
||||
|
||||
(* Mock IOs TODO: Fill them with CLI options *)
|
||||
|
||||
@ -19,9 +18,8 @@ module PreIO =
|
||||
struct
|
||||
let ext = ".ligo"
|
||||
let pre_options =
|
||||
EvalOpt.make ~input:None
|
||||
~libs:[]
|
||||
~verbose:Utils.String.Set.empty
|
||||
EvalOpt.make ~libs:[]
|
||||
~verbose:SSet.empty
|
||||
~offsets:true
|
||||
~mode:`Point
|
||||
~cmd:EvalOpt.Quiet
|
||||
@ -47,72 +45,32 @@ module PreUnit =
|
||||
|
||||
module Errors =
|
||||
struct
|
||||
let reserved_name Region.{value; region} =
|
||||
let title () = Printf.sprintf "\nReserved name \"%s\"" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in error ~data title message
|
||||
(* let data =
|
||||
[("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
|
||||
*)
|
||||
|
||||
let duplicate_variant Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nDuplicate variant \"%s\" in this \
|
||||
type declaration" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in error ~data title message
|
||||
|
||||
let non_linear_pattern Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nRepeated variable \"%s\" in this pattern" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in error ~data title message
|
||||
|
||||
let duplicate_field Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nDuplicate field name \"%s\" \
|
||||
in this record declaration" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in error ~data title message
|
||||
|
||||
let parser_error Region.{value; region} =
|
||||
let generic message =
|
||||
let title () = ""
|
||||
and message () = value
|
||||
and loc = region in
|
||||
let data =
|
||||
[("parser_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
|
||||
in error ~data title message
|
||||
and message () = message.Region.value
|
||||
in Trace.error ~data:[] title message
|
||||
|
||||
let lexer_error (e: Lexer.error AST.reg) =
|
||||
let title () = "\nLexer 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
|
||||
end
|
||||
|
||||
let parse (module IO : IO) parser =
|
||||
let module Unit = PreUnit (IO) in
|
||||
let mk_error error =
|
||||
let local_fail error =
|
||||
Unit.format_error ~offsets:IO.options#offsets
|
||||
IO.options#mode error in
|
||||
IO.options#mode error
|
||||
|> Errors.generic |> Trace.fail in
|
||||
match parser () with
|
||||
(* Scoping errors *)
|
||||
Stdlib.Ok semantic_value -> Trace.ok semantic_value
|
||||
|
||||
Stdlib.Ok semantic_value -> ok semantic_value
|
||||
| Stdlib.Error error -> fail @@ Errors.parser_error error
|
||||
| exception Lexer.Error e -> fail @@ Errors.lexer_error e
|
||||
(* Lexing and parsing errors *)
|
||||
|
||||
| Stdlib.Error error ->
|
||||
Trace.fail @@ Errors.generic error
|
||||
(* Scoping errors *)
|
||||
|
||||
| exception Scoping.Error (Scoping.Reserved_name name) ->
|
||||
let token =
|
||||
@ -122,18 +80,15 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Reserved name.\nHint: Change the name.\n", None, invalid
|
||||
in fail @@ Errors.reserved_name @@ mk_error point)
|
||||
local_fail
|
||||
("Reserved name.\nHint: Change the name.\n", None, invalid))
|
||||
|
||||
| exception Scoping.Error (Scoping.Duplicate_variant name) ->
|
||||
let token =
|
||||
Lexer.Token.mk_constr name.Region.value name.Region.region in
|
||||
let point =
|
||||
"Duplicate constructor in this sum type declaration.\n\
|
||||
Hint: Change the constructor.\n",
|
||||
None, token
|
||||
in fail @@ Errors.duplicate_variant @@ mk_error point
|
||||
Lexer.Token.mk_constr name.Region.value name.Region.region
|
||||
in local_fail
|
||||
("Duplicate constructor in this sum type declaration.\n\
|
||||
Hint: Change the constructor.\n", None, token)
|
||||
|
||||
| exception Scoping.Error (Scoping.Non_linear_pattern var) ->
|
||||
let token =
|
||||
@ -143,11 +98,10 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Repeated variable in this pattern.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid
|
||||
in fail @@ Errors.non_linear_pattern @@ mk_error point)
|
||||
local_fail
|
||||
("Repeated variable in this pattern.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid))
|
||||
|
||||
| exception Scoping.Error (Scoping.Duplicate_field name) ->
|
||||
let token =
|
||||
@ -157,60 +111,76 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Duplicate field name in this record declaration.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid
|
||||
in fail @@ Errors.duplicate_field @@ mk_error point)
|
||||
local_fail
|
||||
("Duplicate field name in this record declaration.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid))
|
||||
|
||||
let parse_file (source: string) =
|
||||
let module IO =
|
||||
struct
|
||||
let ext = PreIO.ext
|
||||
let options = PreIO.pre_options ~expr:false
|
||||
let options =
|
||||
PreIO.pre_options ~input:(Some source) ~expr:false
|
||||
end in
|
||||
let lib_path =
|
||||
match IO.options#libs with
|
||||
[] -> ""
|
||||
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
|
||||
in List.fold_right mk_I libs "" in
|
||||
let prefix =
|
||||
match IO.options#input with
|
||||
None | Some "-" -> "temp"
|
||||
| Some file -> Filename.(file |> basename |> remove_extension) in
|
||||
let suffix = ".pp" ^ IO.ext in
|
||||
let pp_input =
|
||||
let prefix = Filename.(source |> basename |> remove_extension)
|
||||
and suffix = ".pp.ligo"
|
||||
in prefix ^ suffix in
|
||||
let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
|
||||
source pp_input in
|
||||
if SSet.mem "cpp" IO.options#verbose
|
||||
then prefix ^ suffix
|
||||
else let pp_input, pp_out =
|
||||
Filename.open_temp_file prefix suffix
|
||||
in close_out pp_out; pp_input in
|
||||
let cpp_cmd =
|
||||
match IO.options#input with
|
||||
None | Some "-" ->
|
||||
Printf.sprintf "cpp -traditional-cpp%s - > %s"
|
||||
lib_path pp_input
|
||||
| Some file ->
|
||||
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
|
||||
lib_path file pp_input in
|
||||
let open Trace in
|
||||
let%bind () = sys_command cpp_cmd in
|
||||
let%bind channel =
|
||||
generic_try (simple_error "Error when opening file") @@
|
||||
(fun () -> open_in pp_input) in
|
||||
let module Unit = PreUnit (IO) in
|
||||
let instance =
|
||||
match Lexer.open_token_stream (Lexer.Channel channel) with
|
||||
match Lexer.open_token_stream (Lexer.File pp_input) with
|
||||
Ok instance -> instance
|
||||
| Stdlib.Error _ -> assert false (* No file opening *) in
|
||||
let thunk () = Unit.apply instance Unit.parse_contract in
|
||||
parse (module IO) thunk
|
||||
let thunk () = Unit.apply instance Unit.parse_contract
|
||||
in parse (module IO) thunk
|
||||
|
||||
let parse_string (s: string) =
|
||||
let module IO =
|
||||
struct
|
||||
let ext = PreIO.ext
|
||||
let options = PreIO.pre_options ~expr:false
|
||||
let options = PreIO.pre_options ~input:None ~expr:false
|
||||
end in
|
||||
let module Unit = PreUnit (IO) in
|
||||
let instance =
|
||||
match Lexer.open_token_stream (Lexer.String s) with
|
||||
Ok instance -> instance
|
||||
| Stdlib.Error _ -> assert false (* No file opening *) in
|
||||
let thunk () = Unit.apply instance Unit.parse_contract in
|
||||
parse (module IO) thunk
|
||||
let thunk () = Unit.apply instance Unit.parse_contract
|
||||
in parse (module IO) thunk
|
||||
|
||||
let parse_expression (s: string) =
|
||||
let module IO =
|
||||
struct
|
||||
let ext = PreIO.ext
|
||||
let options = PreIO.pre_options ~expr:true
|
||||
let options = PreIO.pre_options ~input:None ~expr:true
|
||||
end in
|
||||
let module Unit = PreUnit (IO) in
|
||||
let instance =
|
||||
match Lexer.open_token_stream (Lexer.String s) with
|
||||
Ok instance -> instance
|
||||
| Stdlib.Error _ -> assert false (* No file opening *) in
|
||||
let thunk () = Unit.apply instance Unit.parse_expr in
|
||||
parse (module IO) thunk
|
||||
let thunk () = Unit.apply instance Unit.parse_expr
|
||||
in parse (module IO) thunk
|
||||
|
||||
@ -217,6 +217,7 @@ let_declaration:
|
||||
|
||||
let_binding:
|
||||
"<ident>" nseq(sub_irrefutable) type_annotation? "=" expr {
|
||||
Scoping.check_reserved_name $1;
|
||||
let binders = Utils.nseq_cons (PVar $1) $2 in
|
||||
Utils.nseq_iter Scoping.check_pattern binders;
|
||||
{binders; lhs_type=$3; eq=$4; let_rhs=$5}
|
||||
|
||||
@ -31,19 +31,30 @@ module VarSet = Set.Make (Ord)
|
||||
let reserved =
|
||||
let open SSet in
|
||||
empty
|
||||
|> add "abs"
|
||||
|> add "address"
|
||||
|> add "amount"
|
||||
|> add "assert"
|
||||
|> add "balance"
|
||||
|> add "time"
|
||||
|> add "amount"
|
||||
|> add "gas"
|
||||
|> add "sender"
|
||||
|> add "source"
|
||||
|> add "failwith"
|
||||
|> add "black2b"
|
||||
|> add "check"
|
||||
|> add "continue"
|
||||
|> add "stop"
|
||||
|> add "failwith"
|
||||
|> add "gas"
|
||||
|> add "hash"
|
||||
|> add "hash_key"
|
||||
|> add "implicit_account"
|
||||
|> add "int"
|
||||
|> add "abs"
|
||||
|> add "pack"
|
||||
|> add "self_address"
|
||||
|> add "sender"
|
||||
|> add "sha256"
|
||||
|> add "sha512"
|
||||
|> add "source"
|
||||
|> add "stop"
|
||||
|> add "time"
|
||||
|> add "unit"
|
||||
|> add "unpack"
|
||||
|
||||
let check_reserved_names vars =
|
||||
let is_reserved elt = SSet.mem elt.value reserved in
|
||||
|
||||
@ -19,7 +19,7 @@ module PreIO =
|
||||
let ext = ".ligo"
|
||||
let pre_options =
|
||||
EvalOpt.make ~libs:[]
|
||||
~verbose:(SSet.singleton "cpp") (* TODO (Debug) *)
|
||||
~verbose:SSet.empty
|
||||
~offsets:true
|
||||
~mode:`Point
|
||||
~cmd:EvalOpt.Quiet
|
||||
@ -45,81 +45,32 @@ module PreUnit =
|
||||
|
||||
module Errors =
|
||||
struct
|
||||
let reserved_name Region.{value; region} =
|
||||
let title () = Printf.sprintf "\nReserved name \"%s\"" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in Trace.error ~data title message
|
||||
(* let data =
|
||||
[("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
|
||||
*)
|
||||
|
||||
let duplicate_parameter Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nDuplicate parameter \"%s\"" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in Trace.error ~data title message
|
||||
|
||||
let duplicate_variant Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nDuplicate variant \"%s\" in this \
|
||||
type declaration" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in Trace.error ~data title message
|
||||
|
||||
let non_linear_pattern Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nRepeated variable \"%s\" in this pattern" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in Trace.error ~data title message
|
||||
|
||||
let duplicate_field Region.{value; region} =
|
||||
let title () =
|
||||
Printf.sprintf "\nDuplicate field name \"%s\" \
|
||||
in this record declaration" value in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in Trace.error ~data title message
|
||||
|
||||
let parser_error Region.{value; region} =
|
||||
let generic message =
|
||||
let title () = ""
|
||||
and message () = value
|
||||
and loc = region in
|
||||
let data =
|
||||
[("parser_loc",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
|
||||
in Trace.error ~data title message
|
||||
and message () = message.Region.value
|
||||
in Trace.error ~data:[] title message
|
||||
|
||||
let lexer_error (e: Lexer.error AST.reg) =
|
||||
let title () = "\nLexer 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 Trace.error ~data title message
|
||||
end
|
||||
|
||||
let parse (module IO : IO) parser =
|
||||
let module Unit = PreUnit (IO) in
|
||||
let mk_error error =
|
||||
let local_fail error =
|
||||
Unit.format_error ~offsets:IO.options#offsets
|
||||
IO.options#mode error in
|
||||
IO.options#mode error
|
||||
|> Errors.generic |> Trace.fail in
|
||||
match parser () with
|
||||
(* Scoping errors *)
|
||||
|
||||
Stdlib.Ok semantic_value -> Trace.ok semantic_value
|
||||
| Stdlib.Error error -> Trace.fail @@ Errors.parser_error error
|
||||
| exception Lexer.Error e -> Trace.fail @@ Errors.lexer_error e
|
||||
|
||||
(* Lexing and parsing errors *)
|
||||
|
||||
| Stdlib.Error error ->
|
||||
Trace.fail @@ Errors.generic error
|
||||
(* Scoping errors *)
|
||||
|
||||
| exception Scoping.Error (Scoping.Reserved_name name) ->
|
||||
let token =
|
||||
@ -129,9 +80,8 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Reserved name.\nHint: Change the name.\n", None, invalid
|
||||
in Trace.fail @@ Errors.reserved_name @@ mk_error point)
|
||||
local_fail
|
||||
("Reserved name.\nHint: Change the name.\n", None, invalid))
|
||||
|
||||
| exception Scoping.Error (Scoping.Duplicate_parameter name) ->
|
||||
let token =
|
||||
@ -141,19 +91,16 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Duplicate parameter.\nHint: Change the name.\n",
|
||||
None, invalid
|
||||
in Trace.fail @@ Errors.duplicate_parameter @@ mk_error point)
|
||||
local_fail
|
||||
("Duplicate parameter.\nHint: Change the name.\n",
|
||||
None, invalid))
|
||||
|
||||
| exception Scoping.Error (Scoping.Duplicate_variant name) ->
|
||||
let token =
|
||||
Lexer.Token.mk_constr name.Region.value name.Region.region in
|
||||
let point =
|
||||
"Duplicate constructor in this sum type declaration.\n\
|
||||
Hint: Change the constructor.\n",
|
||||
None, token
|
||||
in Trace.fail @@ Errors.duplicate_variant @@ mk_error point
|
||||
Lexer.Token.mk_constr name.Region.value name.Region.region
|
||||
in local_fail
|
||||
("Duplicate constructor in this sum type declaration.\n\
|
||||
Hint: Change the constructor.\n", None, token)
|
||||
|
||||
| exception Scoping.Error (Scoping.Non_linear_pattern var) ->
|
||||
let token =
|
||||
@ -163,11 +110,10 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Repeated variable in this pattern.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid
|
||||
in Trace.fail @@ Errors.non_linear_pattern @@ mk_error point)
|
||||
local_fail
|
||||
("Repeated variable in this pattern.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid))
|
||||
|
||||
| exception Scoping.Error (Scoping.Duplicate_field name) ->
|
||||
let token =
|
||||
@ -177,11 +123,10 @@ let parse (module IO : IO) parser =
|
||||
reserved name for the lexer. *)
|
||||
Stdlib.Error _ -> assert false
|
||||
| Ok invalid ->
|
||||
let point =
|
||||
"Duplicate field name in this record declaration.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid
|
||||
in Trace.fail @@ Errors.duplicate_field @@ mk_error point)
|
||||
local_fail
|
||||
("Duplicate field name in this record declaration.\n\
|
||||
Hint: Change the name.\n",
|
||||
None, invalid))
|
||||
|
||||
let parse_file (source: string) =
|
||||
let module IO =
|
||||
|
||||
@ -980,7 +980,7 @@ let open_token_stream input =
|
||||
with
|
||||
Sys_error msg -> Stdlib.Error (File_opening msg))
|
||||
| String s ->
|
||||
Ok (Lexing.from_string s, fun () -> ())
|
||||
Ok (Lexing.from_string s, fun () -> ())
|
||||
| Channel chan ->
|
||||
let close () = close_in chan in
|
||||
Ok (Lexing.from_channel chan, close)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user