From 3288696784271525c04562769a5aa19925164304 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 2 Jan 2020 19:30:09 +0100 Subject: [PATCH 1/9] add the name of the variable in the unbound variable error message title --- src/passes/4-typer-new/typer.ml | 5 +++-- src/passes/4-typer-old/typer.ml | 5 +++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index f22dd61f9..ea607c505 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -23,10 +23,11 @@ module Errors = struct error ~data title message () let unbound_variable (e:environment) (n:I.expression_variable) (loc:Location.t) () = - let title = (thunk "unbound variable") in + let name = Format.asprintf "%a" Stage_common.PP.name n in + let title = (thunk ("unbound variable "^name)) in let message () = "" in let data = [ - ("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.name n) ; + ("variable" , fun () -> name) ; ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ] in diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index b54b7e579..ff0ef2fe9 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -30,10 +30,11 @@ module Errors = struct error ~data title message () let unbound_variable (e:environment) (n:I.expression_variable) (loc:Location.t) () = - let title = (thunk "unbound variable") in + let name = Format.asprintf "%a" Stage_common.PP.name n in + let title = (thunk ("unbound variable "^name)) in let message () = "" in let data = [ - ("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.name n) ; + ("variable" , fun () -> name) ; ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ] in From 4d56a71bd1ab74f90c88387180b67a9352370302 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 2 Jan 2020 19:30:19 +0100 Subject: [PATCH 2/9] propagate location for cameligo variables --- src/passes/2-simplify/cameligo.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index b2bef414c..7dbb027d7 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -327,9 +327,9 @@ let rec simpl_expression : let%bind type_expr' = simpl_type_expression type_expr in return @@ e_annotation ~loc expr' type_expr' | EVar c -> - let c' = c.value in + let (c',loc) = r_split c in (match constants c' with - | Error _ -> return @@ e_variable (Var.of_name c.value) + | Error _ -> return @@ e_variable ~loc (Var.of_name c.value) | Ok (s,_) -> return @@ e_constant s []) | ECall x -> ( let ((e1 , e2) , loc) = r_split x in From a3a09dc0e568dd26e29f448bd51cc41201af934b Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Thu, 2 Jan 2020 19:39:31 +0100 Subject: [PATCH 3/9] functionize the name in the error --- src/passes/4-typer-new/typer.ml | 6 +++--- src/passes/4-typer-old/typer.ml | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index ea607c505..e6848c232 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -23,11 +23,11 @@ module Errors = struct error ~data title message () let unbound_variable (e:environment) (n:I.expression_variable) (loc:Location.t) () = - let name = Format.asprintf "%a" Stage_common.PP.name n in - let title = (thunk ("unbound variable "^name)) in + let name () = Format.asprintf "%a" Stage_common.PP.name n in + let title = (thunk ("unbound variable "^(name ()))) in let message () = "" in let data = [ - ("variable" , fun () -> name) ; + ("variable" , name) ; ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ] in diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index ff0ef2fe9..20b54514b 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/src/passes/4-typer-old/typer.ml @@ -30,11 +30,11 @@ module Errors = struct error ~data title message () let unbound_variable (e:environment) (n:I.expression_variable) (loc:Location.t) () = - let name = Format.asprintf "%a" Stage_common.PP.name n in - let title = (thunk ("unbound variable "^name)) in + let name () = Format.asprintf "%a" Stage_common.PP.name n in + let title = (thunk ("unbound variable "^(name ()))) in let message () = "" in let data = [ - ("variable" , fun () -> name) ; + ("variable" , name) ; ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ; ("location" , fun () -> Format.asprintf "%a" Location.pp loc) ] in From c805a27b9969237c98f52e438e6d70b469639ecf Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 3 Jan 2020 17:46:07 +0100 Subject: [PATCH 4/9] adding timestamp literals as string or int --- .../tezos_type_annotation.ml | 20 ++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/src/passes/3-self_ast_simplified/tezos_type_annotation.ml b/src/passes/3-self_ast_simplified/tezos_type_annotation.ml index d79ab628d..a6436257f 100644 --- a/src/passes/3-self_ast_simplified/tezos_type_annotation.ml +++ b/src/passes/3-self_ast_simplified/tezos_type_annotation.ml @@ -1,11 +1,29 @@ open Ast_simplified open Trace +module Errors = struct + let bad_string_timestamp ts loc () = + let title = (thunk ("Badly formatted timestamp \""^ts^"\"")) in + let message () = "" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp loc) + ] in + error ~data title message () +end +open Errors + let peephole_expression : expression -> expression result = fun e -> let return expression = ok { e with expression } in match e.expression with | E_ascription (e' , t) as e -> ( match (e'.expression , t.type_expression') with + | (E_literal (Literal_int i) , T_constant (TC_timestamp)) -> return @@ E_literal (Literal_timestamp i) + | (E_literal (Literal_string str) , T_constant (TC_timestamp)) -> + let%bind time = + trace_option (bad_string_timestamp str e'.location) + @@ Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation str in + let itime = Int64.to_int @@ Tezos_utils.Time.Protocol.to_seconds time in + return @@ E_literal (Literal_timestamp itime) | (E_literal (Literal_string str) , T_constant (TC_address)) -> return @@ E_literal (Literal_address str) | (E_literal (Literal_string str) , T_constant (TC_bytes)) -> ( let%bind e' = e'_bytes str in @@ -13,4 +31,4 @@ let peephole_expression : expression -> expression result = fun e -> ) | _ -> return e ) - | e -> return e + | e -> return e \ No newline at end of file From 1a2a29bc03d2fecc3b19195a51222c750b8c6066 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 3 Jan 2020 17:46:31 +0100 Subject: [PATCH 5/9] negative timestamp literal test --- src/bin/expect_tests/contract_tests.ml | 4 ++++ src/test/contracts/bad_timestamp.ligo | 7 +++++++ 2 files changed, 11 insertions(+) create mode 100644 src/test/contracts/bad_timestamp.ligo diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 0ce94f98d..1ba33c139 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -936,3 +936,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad [ "compile-contract" ; contract "bad_address_format.religo" ; "main" ] ; [%expect {| ligo: in file "bad_address_format.religo", line 2, characters 25-47. Badly formatted address "KT1badaddr": {"location":"in file \"bad_address_format.religo\", line 2, characters 25-47"} |}] + +let%expect_test _ = + run_ligo_bad [ "compile-contract" ; contract "bad_timestamp.ligo" ; "main" ] ; + [%expect {| ligo: in file "bad_timestamp.ligo", line 5, characters 29-43. Badly formatted timestamp "badtimestamp": {"location":"in file \"bad_timestamp.ligo\", line 5, characters 29-43"} |}] \ No newline at end of file diff --git a/src/test/contracts/bad_timestamp.ligo b/src/test/contracts/bad_timestamp.ligo new file mode 100644 index 000000000..42850560d --- /dev/null +++ b/src/test/contracts/bad_timestamp.ligo @@ -0,0 +1,7 @@ +type storage_ is timestamp + +function main(const p : unit; const s : storage_) : list(operation) * storage_ is + block { + var toto : timestamp := ("badtimestamp" : timestamp); + } + with ((nil: list(operation)), toto) \ No newline at end of file From 0a676d72a58d7ffa0f425189a40aedffd124e3a1 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 3 Jan 2020 18:09:16 +0100 Subject: [PATCH 6/9] add --predecessor-timestamp to compile-storage/parameter --- src/bin/cli.ml | 16 +++++----- src/bin/expect_tests/contract_tests.ml | 4 +++ src/bin/expect_tests/help_tests.ml | 42 ++++++++++++++++++++++---- src/test/contracts/timestamp.ligo | 3 ++ 4 files changed, 52 insertions(+), 13 deletions(-) create mode 100644 src/test/contracts/timestamp.ligo diff --git a/src/bin/cli.ml b/src/bin/cli.ml index edc0d9b44..61c4e7a4e 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -90,7 +90,7 @@ let predecessor_timestamp = let open Arg in let info = let docv = "PREDECESSOR_TIMESTAMP" in - let doc = "$(docv) is the pedecessor_timestamp the michelson interpreter transaction will use (e.g. '2000-01-01T10:10:10Z')" in + let doc = "$(docv) is the pedecessor_timestamp (now value) the michelson interpreter will use (e.g. '2000-01-01T10:10:10Z')" in info ~docv ~doc ["predecessor-timestamp"] in value @@ opt (some string) None info @@ -156,7 +156,7 @@ let measure_contract = (Term.ret term , Term.info ~doc cmdname) let compile_parameter = - let f source_file entry_point expression syntax display_format michelson_format = + let f source_file entry_point expression syntax amount sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind typed_prg,state = Compile.Of_simplified.compile simplified in @@ -174,11 +174,12 @@ let compile_parameter = let%bind compiled_param = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_parameter entry_point typed_prg typed_param in let%bind () = Compile.Of_michelson.assert_equal_contract_type Check_parameter michelson_prg compiled_param in - let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in + let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in + let%bind value = Run.evaluate_expression ~options compiled_param.expr compiled_param.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = - Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax $ display_format $ michelson_code_format) in + Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ syntax $ amount $ sender $ source $ predecessor_timestamp $ display_format $ michelson_code_format) in let cmdname = "compile-parameter" in let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in (Term.ret term , Term.info ~doc cmdname) @@ -213,7 +214,7 @@ let interpret = let compile_storage = - let f source_file entry_point expression syntax display_format michelson_format = + let f source_file entry_point expression syntax amount sender source predecessor_timestamp display_format michelson_format = toplevel ~display_format @@ let%bind simplified = Compile.Of_source.compile source_file (Syntax_name syntax) in let%bind typed_prg,state = Compile.Of_simplified.compile simplified in @@ -231,11 +232,12 @@ let compile_storage = let%bind compiled_param = Compile.Of_mini_c.compile_expression mini_c_param in let%bind () = Compile.Of_typed.assert_equal_contract_type Check_storage entry_point typed_prg typed_param in let%bind () = Compile.Of_michelson.assert_equal_contract_type Check_storage michelson_prg compiled_param in - let%bind value = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in + let%bind options = Run.make_dry_run_options {predecessor_timestamp ; amount ; sender ; source } in + let%bind value = Run.evaluate_expression ~options compiled_param.expr compiled_param.expr_ty in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = - Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ michelson_code_format) in + Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ amount $ sender $ source $ predecessor_timestamp $ display_format $ michelson_code_format) in let cmdname = "compile-storage" in let doc = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract." in (Term.ret term , Term.info ~doc cmdname) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 1ba33c139..b9b34c076 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -30,6 +30,10 @@ let%expect_test _ = () +let%expect_test _ = + run_ligo_good [ "compile-storage" ; contract "timestamp.ligo" ; "main" ; "now" ; "--predecessor-timestamp" ; "2042-01-01T00:00:00Z" ] ; + [%expect {| "2042-01-01T00:00:01Z" |}] + let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "coase.ligo" ; "main" ] ; [%expect {| diff --git a/src/bin/expect_tests/help_tests.ml b/src/bin/expect_tests/help_tests.ml index e804c8283..af5ab1797 100644 --- a/src/bin/expect_tests/help_tests.ml +++ b/src/bin/expect_tests/help_tests.ml @@ -176,6 +176,9 @@ let%expect_test _ = contract. OPTIONS + --amount=AMOUNT (absent=0) + AMOUNT is the amount the michelson interpreter will use. + --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT (absent=human-readable) DISPLAY_FORMAT is the format that will be used by the CLI. @@ -194,11 +197,23 @@ let%expect_test _ = compile-contract for the resulting Michelson. Available formats are 'text' (default), 'json' and 'hex'. + --predecessor-timestamp=PREDECESSOR_TIMESTAMP + PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the + michelson interpreter will use (e.g. '2000-01-01T10:10:10Z') + -s SYNTAX, --syntax=SYNTAX (absent=auto) SYNTAX is the syntax that will be used. Currently supported syntaxes are "pascaligo" and "cameligo". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively). + --sender=SENDER + SENDER is the sender the michelson interpreter transaction will + use. + + --source=SOURCE + SOURCE is the source the michelson interpreter transaction will + use. + --version Show version information. |} ] ; @@ -226,6 +241,9 @@ let%expect_test _ = STORAGE_EXPRESSION is the expression that will be compiled. OPTIONS + --amount=AMOUNT (absent=0) + AMOUNT is the amount the michelson interpreter will use. + --format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT (absent=human-readable) DISPLAY_FORMAT is the format that will be used by the CLI. @@ -244,11 +262,23 @@ let%expect_test _ = compile-contract for the resulting Michelson. Available formats are 'text' (default), 'json' and 'hex'. + --predecessor-timestamp=PREDECESSOR_TIMESTAMP + PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the + michelson interpreter will use (e.g. '2000-01-01T10:10:10Z') + -s SYNTAX, --syntax=SYNTAX (absent=auto) SYNTAX is the syntax that will be used. Currently supported syntaxes are "pascaligo" and "cameligo". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively). + --sender=SENDER + SENDER is the sender the michelson interpreter transaction will + use. + + --source=SOURCE + SOURCE is the source the michelson interpreter transaction will + use. + --version Show version information. |} ] ; @@ -294,8 +324,8 @@ let%expect_test _ = `plain' whenever the TERM env var is `dumb' or undefined. --predecessor-timestamp=PREDECESSOR_TIMESTAMP - PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson - interpreter transaction will use (e.g. '2000-01-01T10:10:10Z') + PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the + michelson interpreter will use (e.g. '2000-01-01T10:10:10Z') -s SYNTAX, --syntax=SYNTAX (absent=auto) SYNTAX is the syntax that will be used. Currently supported @@ -352,8 +382,8 @@ let%expect_test _ = `plain' whenever the TERM env var is `dumb' or undefined. --predecessor-timestamp=PREDECESSOR_TIMESTAMP - PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson - interpreter transaction will use (e.g. '2000-01-01T10:10:10Z') + PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the + michelson interpreter will use (e.g. '2000-01-01T10:10:10Z') -s SYNTAX, --syntax=SYNTAX (absent=auto) SYNTAX is the syntax that will be used. Currently supported @@ -405,8 +435,8 @@ let%expect_test _ = `plain' whenever the TERM env var is `dumb' or undefined. --predecessor-timestamp=PREDECESSOR_TIMESTAMP - PREDECESSOR_TIMESTAMP is the pedecessor_timestamp the michelson - interpreter transaction will use (e.g. '2000-01-01T10:10:10Z') + PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value) the + michelson interpreter will use (e.g. '2000-01-01T10:10:10Z') -s SYNTAX, --syntax=SYNTAX (absent=auto) SYNTAX is the syntax that will be used. Currently supported diff --git a/src/test/contracts/timestamp.ligo b/src/test/contracts/timestamp.ligo new file mode 100644 index 000000000..4e105c45f --- /dev/null +++ b/src/test/contracts/timestamp.ligo @@ -0,0 +1,3 @@ +type storage_ is timestamp + +function main(const p : unit; const s : storage_) : list(operation) * storage_ is ((nil: list(operation)), now) \ No newline at end of file From 0ce29e22b9d5884f09a532abc3157bce632df571 Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Fri, 3 Jan 2020 21:38:40 +0100 Subject: [PATCH 7/9] add some timestamp doc --- gitlab-pages/docs/advanced/timestamps-addresses.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/gitlab-pages/docs/advanced/timestamps-addresses.md b/gitlab-pages/docs/advanced/timestamps-addresses.md index b3f1d2a0a..5e29f1954 100644 --- a/gitlab-pages/docs/advanced/timestamps-addresses.md +++ b/gitlab-pages/docs/advanced/timestamps-addresses.md @@ -19,6 +19,8 @@ const today: timestamp = now; ``` +> When running code with ligo CLI, option `--predecessor-timestamp` is allowing you to control what `now` returns. + ### Timestamp arithmetic In LIGO, timestamps can be added with `int`(s), this enables you to set e.g. time constraints for your smart contracts like this: @@ -30,6 +32,8 @@ In LIGO, timestamps can be added with `int`(s), this enables you to set e.g. tim const today: timestamp = now; const one_day: int = 86400; const in_24_hrs: timestamp = today + one_day; +const some_date: timestamp = ("2000-01-01T10:10:10Z" : timestamp); +const one_day_later: timestamp = some_date + one_day; ``` From e89aace91c7350e25adfcca701fb6377b005e33c Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Fri, 3 Jan 2020 12:49:42 -0800 Subject: [PATCH 8/9] Clean up description of --predecessor-timestamp flag in logs --- gitlab-pages/docs/advanced/timestamps-addresses.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gitlab-pages/docs/advanced/timestamps-addresses.md b/gitlab-pages/docs/advanced/timestamps-addresses.md index 5e29f1954..adc11a833 100644 --- a/gitlab-pages/docs/advanced/timestamps-addresses.md +++ b/gitlab-pages/docs/advanced/timestamps-addresses.md @@ -19,7 +19,7 @@ const today: timestamp = now; ``` -> When running code with ligo CLI, option `--predecessor-timestamp` is allowing you to control what `now` returns. +> When running code with ligo CLI, the option `--predecessor-timestamp` allows you to control what `now` returns. ### Timestamp arithmetic From 10b26f610f0aeb6e09fb96bfa399ba51bb18ac32 Mon Sep 17 00:00:00 2001 From: John David Pressman Date: Sat, 4 Jan 2020 08:24:16 +0000 Subject: [PATCH 9/9] Show lexer error messages in ReasonLIGO --- src/passes/1-parser/reasonligo.ml | 15 ++++++++++++++- src/passes/1-parser/shared/Lexer.mli | 2 ++ src/passes/1-parser/shared/Lexer.mll | 11 +++++++---- 3 files changed, 23 insertions(+), 5 deletions(-) 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