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 2020-01-24 15:57:41 +01:00
parent 3c9dd93c8b
commit 8843a46975
7 changed files with 152 additions and 225 deletions

View File

@ -6,7 +6,7 @@ let%expect_test _ =
ligo: : Lexical error in file "broken_string.ligo", line 1, characters 18-19: ligo: : Lexical error in file "broken_string.ligo", line 1, characters 18-19:
The string starting here is interrupted by a line break. The string starting here is interrupted by a line break.
Hint: Remove the break, close the string before or insert a backslash. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/broken_string.mligo" ; "main" ] ;
[%expect {| [%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. The string starting here is interrupted by a line break.
Hint: Remove the break, close the string before or insert a backslash. 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 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: ligo: : Lexical error in file "negative_byte_sequence.ligo", line 1, characters 18-23:
Negative byte sequence. Negative byte sequence.
Hint: Remove the leading minus sign. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/negative_byte_sequence.mligo" ; "main" ] ;
[%expect {| [%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. Negative byte sequence.
Hint: Remove the leading minus sign. 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 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: ligo: : Lexical error in file "reserved_name.ligo", line 1, characters 4-13:
Reserved name: arguments. Reserved name: arguments.
Hint: Change the name. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/reserved_name.mligo" ; "main" ] ;
[%expect {| [%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. Reserved name: object.
Hint: Change the name. 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 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 {| [%expect {|
ligo: : Lexical error in file "unexpected_character.ligo", line 1, characters 18-19: ligo: : Lexical error in file "unexpected_character.ligo", line 1, characters 18-19:
Unexpected character '\239'. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/unexpected_character.mligo" ; "main" ] ;
[%expect {| [%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'. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/unterminated_comment.mligo" ; "main" ] ;
[%expect {| [%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. Unterminated comment.
Hint: Close with "*)". 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 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: ligo: : Lexical error in file "invalid_symbol.ligo", line 1, characters 17-20:
Invalid symbol. Invalid symbol.
Hint: Check the LIGO syntax you use. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_symbol.mligo" ; "main" ] ;
[%expect {| [%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. Invalid symbol.
Hint: Check the LIGO syntax you use. 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 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: ligo: : Lexical error in file "missing_break.ligo", line 1, characters 18-18:
Missing break. Missing break.
Hint: Insert some space. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/missing_break.mligo" ; "main" ] ;
[%expect {| [%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. Missing break.
Hint: Insert some space. 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 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: ligo: : Lexical error in file "invalid_character_in_string.ligo", line 1, characters 19-20:
Invalid character in string. Invalid character in string.
Hint: Remove or replace the character. 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 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" ] ; run_ligo_bad [ "compile-contract" ; "../../test/lexer/invalid_character_in_string.mligo" ; "main" ] ;
[%expect {| [%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. Invalid character in string.
Hint: Remove or replace the character. 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 If you're not sure how to fix this error, you can

View File

@ -4,7 +4,7 @@ let%expect_test _ =
run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ; run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ;
[%expect {| [%expect {|
ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17, after "bar" and before "-". 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 If you're not sure how to fix this error, you can

View File

@ -1,11 +1,10 @@
open Trace
module AST = Parser_cameligo.AST module AST = Parser_cameligo.AST
module LexToken = Parser_cameligo.LexToken module LexToken = Parser_cameligo.LexToken
module Lexer = Lexer.Make(LexToken) module Lexer = Lexer.Make(LexToken)
module Scoping = Parser_cameligo.Scoping module Scoping = Parser_cameligo.Scoping
module Region = Simple_utils.Region module Region = Simple_utils.Region
module ParErr = Parser_cameligo.ParErr module ParErr = Parser_cameligo.ParErr
module SSet = Utils.String.Set
(* Mock IOs TODO: Fill them with CLI options *) (* Mock IOs TODO: Fill them with CLI options *)
@ -19,9 +18,8 @@ module PreIO =
struct struct
let ext = ".ligo" let ext = ".ligo"
let pre_options = let pre_options =
EvalOpt.make ~input:None EvalOpt.make ~libs:[]
~libs:[] ~verbose:SSet.empty
~verbose:Utils.String.Set.empty
~offsets:true ~offsets:true
~mode:`Point ~mode:`Point
~cmd:EvalOpt.Quiet ~cmd:EvalOpt.Quiet
@ -47,72 +45,32 @@ module PreUnit =
module Errors = module Errors =
struct struct
let reserved_name Region.{value; region} = (* let data =
let title () = Printf.sprintf "\nReserved name \"%s\"" value in [("location",
let message () = "" in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in 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 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 title () = ""
and message () = value
and loc = region in
let data =
[("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
in error ~data title message *)
let generic message =
let title () = ""
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 end
let parse (module IO : IO) parser = let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let mk_error error = let local_fail error =
Unit.format_error ~offsets:IO.options#offsets Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in IO.options#mode error
|> Errors.generic |> Trace.fail in
match parser () with match parser () with
(* Scoping errors *) Stdlib.Ok semantic_value -> Trace.ok semantic_value
Stdlib.Ok semantic_value -> ok semantic_value (* Lexing and parsing errors *)
| Stdlib.Error error -> fail @@ Errors.parser_error error
| exception Lexer.Error e -> fail @@ Errors.lexer_error e | Stdlib.Error error ->
Trace.fail @@ Errors.generic error
(* Scoping errors *)
| exception Scoping.Error (Scoping.Reserved_name name) -> | exception Scoping.Error (Scoping.Reserved_name name) ->
let token = let token =
@ -122,18 +80,15 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Reserved name.\nHint: Change the name.\n", None, invalid ("Reserved name.\nHint: Change the name.\n", None, invalid))
in fail @@ Errors.reserved_name @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_variant name) -> | exception Scoping.Error (Scoping.Duplicate_variant name) ->
let token = let token =
Lexer.Token.mk_constr name.Region.value name.Region.region in Lexer.Token.mk_constr name.Region.value name.Region.region
let point = in local_fail
"Duplicate constructor in this sum type declaration.\n\ ("Duplicate constructor in this sum type declaration.\n\
Hint: Change the constructor.\n", Hint: Change the constructor.\n", None, token)
None, token
in fail @@ Errors.duplicate_variant @@ mk_error point
| exception Scoping.Error (Scoping.Non_linear_pattern var) -> | exception Scoping.Error (Scoping.Non_linear_pattern var) ->
let token = let token =
@ -143,11 +98,10 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Repeated variable in this pattern.\n\ ("Repeated variable in this pattern.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid))
in fail @@ Errors.non_linear_pattern @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_field name) -> | exception Scoping.Error (Scoping.Duplicate_field name) ->
let token = let token =
@ -157,60 +111,76 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Duplicate field name in this record declaration.\n\ ("Duplicate field name in this record declaration.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid))
in fail @@ Errors.duplicate_field @@ mk_error point)
let parse_file (source: string) = let parse_file (source: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:false let options =
PreIO.pre_options ~input:(Some source) ~expr:false
end in 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 pp_input =
let prefix = Filename.(source |> basename |> remove_extension) if SSet.mem "cpp" IO.options#verbose
and suffix = ".pp.ligo" then prefix ^ suffix
in prefix ^ suffix in else let pp_input, pp_out =
let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s" Filename.open_temp_file prefix suffix
source pp_input in 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 () = 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 module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.Channel channel) with match Lexer.open_token_stream (Lexer.File pp_input) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_contract in let thunk () = Unit.apply instance Unit.parse_contract
parse (module IO) thunk in parse (module IO) thunk
let parse_string (s: string) = let parse_string (s: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:false let options = PreIO.pre_options ~input:None ~expr:false
end in end in
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.String s) with match Lexer.open_token_stream (Lexer.String s) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_contract in let thunk () = Unit.apply instance Unit.parse_contract
parse (module IO) thunk in parse (module IO) thunk
let parse_expression (s: string) = let parse_expression (s: string) =
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~expr:true let options = PreIO.pre_options ~input:None ~expr:true
end in end in
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let instance = let instance =
match Lexer.open_token_stream (Lexer.String s) with match Lexer.open_token_stream (Lexer.String s) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_expr in let thunk () = Unit.apply instance Unit.parse_expr
parse (module IO) thunk in parse (module IO) thunk

View File

@ -217,6 +217,7 @@ let_declaration:
let_binding: let_binding:
"<ident>" nseq(sub_irrefutable) type_annotation? "=" expr { "<ident>" nseq(sub_irrefutable) type_annotation? "=" expr {
Scoping.check_reserved_name $1;
let binders = Utils.nseq_cons (PVar $1) $2 in let binders = Utils.nseq_cons (PVar $1) $2 in
Utils.nseq_iter Scoping.check_pattern binders; Utils.nseq_iter Scoping.check_pattern binders;
{binders; lhs_type=$3; eq=$4; let_rhs=$5} {binders; lhs_type=$3; eq=$4; let_rhs=$5}

View File

@ -31,19 +31,30 @@ module VarSet = Set.Make (Ord)
let reserved = let reserved =
let open SSet in let open SSet in
empty empty
|> add "abs"
|> add "address"
|> add "amount"
|> add "assert" |> add "assert"
|> add "balance" |> add "balance"
|> add "time" |> add "black2b"
|> add "amount" |> add "check"
|> add "gas"
|> add "sender"
|> add "source"
|> add "failwith"
|> add "continue" |> add "continue"
|> add "stop" |> add "failwith"
|> add "gas"
|> add "hash"
|> add "hash_key"
|> add "implicit_account"
|> add "int" |> add "int"
|> add "abs" |> add "pack"
|> add "self_address"
|> add "sender"
|> add "sha256"
|> add "sha512"
|> add "source"
|> add "stop"
|> add "time"
|> add "unit" |> add "unit"
|> add "unpack"
let check_reserved_names vars = let check_reserved_names vars =
let is_reserved elt = SSet.mem elt.value reserved in let is_reserved elt = SSet.mem elt.value reserved in

View File

@ -19,7 +19,7 @@ module PreIO =
let ext = ".ligo" let ext = ".ligo"
let pre_options = let pre_options =
EvalOpt.make ~libs:[] EvalOpt.make ~libs:[]
~verbose:(SSet.singleton "cpp") (* TODO (Debug) *) ~verbose:SSet.empty
~offsets:true ~offsets:true
~mode:`Point ~mode:`Point
~cmd:EvalOpt.Quiet ~cmd:EvalOpt.Quiet
@ -45,81 +45,32 @@ module PreUnit =
module Errors = module Errors =
struct struct
let reserved_name Region.{value; region} = (* let data =
let title () = Printf.sprintf "\nReserved name \"%s\"" value in [("location",
let message () = "" in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
in Trace.error ~data title message
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 title () = ""
and message () = value
and loc = region in
let data =
[("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)]
in Trace.error ~data title message *)
let generic message =
let title () = ""
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 end
let parse (module IO : IO) parser = let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in let module Unit = PreUnit (IO) in
let mk_error error = let local_fail error =
Unit.format_error ~offsets:IO.options#offsets Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in IO.options#mode error
|> Errors.generic |> Trace.fail in
match parser () with match parser () with
(* Scoping errors *)
Stdlib.Ok semantic_value -> Trace.ok semantic_value 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) -> | exception Scoping.Error (Scoping.Reserved_name name) ->
let token = let token =
@ -129,9 +80,8 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Reserved name.\nHint: Change the name.\n", None, invalid ("Reserved name.\nHint: Change the name.\n", None, invalid))
in Trace.fail @@ Errors.reserved_name @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_parameter name) -> | exception Scoping.Error (Scoping.Duplicate_parameter name) ->
let token = let token =
@ -141,19 +91,16 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Duplicate parameter.\nHint: Change the name.\n", ("Duplicate parameter.\nHint: Change the name.\n",
None, invalid None, invalid))
in Trace.fail @@ Errors.duplicate_parameter @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_variant name) -> | exception Scoping.Error (Scoping.Duplicate_variant name) ->
let token = let token =
Lexer.Token.mk_constr name.Region.value name.Region.region in Lexer.Token.mk_constr name.Region.value name.Region.region
let point = in local_fail
"Duplicate constructor in this sum type declaration.\n\ ("Duplicate constructor in this sum type declaration.\n\
Hint: Change the constructor.\n", Hint: Change the constructor.\n", None, token)
None, token
in Trace.fail @@ Errors.duplicate_variant @@ mk_error point
| exception Scoping.Error (Scoping.Non_linear_pattern var) -> | exception Scoping.Error (Scoping.Non_linear_pattern var) ->
let token = let token =
@ -163,11 +110,10 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Repeated variable in this pattern.\n\ ("Repeated variable in this pattern.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid))
in Trace.fail @@ Errors.non_linear_pattern @@ mk_error point)
| exception Scoping.Error (Scoping.Duplicate_field name) -> | exception Scoping.Error (Scoping.Duplicate_field name) ->
let token = let token =
@ -177,11 +123,10 @@ let parse (module IO : IO) parser =
reserved name for the lexer. *) reserved name for the lexer. *)
Stdlib.Error _ -> assert false Stdlib.Error _ -> assert false
| Ok invalid -> | Ok invalid ->
let point = local_fail
"Duplicate field name in this record declaration.\n\ ("Duplicate field name in this record declaration.\n\
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid None, invalid))
in Trace.fail @@ Errors.duplicate_field @@ mk_error point)
let parse_file (source: string) = let parse_file (source: string) =
let module IO = let module IO =