Proper error with location

This commit is contained in:
Lesenechal Remi 2020-01-02 15:11:02 +01:00
parent 8584bacf83
commit 46027de719

View File

@ -2,15 +2,26 @@ open Ast_simplified
open Trace open Trace
open Proto_alpha_utils open Proto_alpha_utils
module Errors = struct
let bad_literal_address s_addr loc () =
let title = (thunk ("Badly formatted address \""^s_addr^"\"")) 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 peephole_expression : expression -> expression result = fun e ->
let return expression = ok { e with expression } in let return expression = ok { e with expression } in
match e.expression with match e.expression with
| E_literal (Literal_address s) as e -> ( | E_literal (Literal_address s) as l -> (
let open Memory_proto_alpha in let open Memory_proto_alpha in
let%bind (_contract:Protocol.Alpha_context.Contract.t) = let%bind (_contract:Protocol.Alpha_context.Contract.t) =
Trace.trace_alpha_tzresult (simple_error ("address \""^s^"\" is not a valid address")) @@ Trace.trace_alpha_tzresult (bad_literal_address s e.location) @@
Protocol.Alpha_context.Contract.of_b58check s in Protocol.Alpha_context.Contract.of_b58check s in
return e return l
) )
| E_constant (C_BIG_MAP_LITERAL , lst) -> ( | E_constant (C_BIG_MAP_LITERAL , lst) -> (
let%bind elt = let%bind elt =