balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improved error messages

Browse Source
This commit is contained in:
Georges Dupéron 2019-06-05 19:16:54 +02:00
parent 0e01353c7d
commit 347774e42b
3 changed files with 43 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
src/ast_typed/misc.ml
View File

@ -6,8 +6,8 @@ module Errors = struct
let title = (thunk "different kinds") in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.type_value b )
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
] in
error ~data title message ()
@ -15,8 +15,8 @@ module Errors = struct
let title = (thunk "different constants") in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%s)" a) ;
("b" , fun () -> Format.asprintf "(%s)" b )
("a" , fun () -> Format.asprintf "%s" a) ;
("b" , fun () -> Format.asprintf "%s" b )
] in
error ~data title message ()
@ -24,8 +24,8 @@ module Errors = struct
let title () = name ^ " have different sizes" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.type_value b )
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
] in
error ~data title message ()
@ -33,8 +33,8 @@ module Errors = struct
let title () = "different keys in record" in
let message () = "" in
let data = [
("key_a" , fun () -> Format.asprintf "(%s)" ka) ;
("key_b" , fun () -> Format.asprintf "(%s)" kb )
("key_a" , fun () -> Format.asprintf "%s" ka) ;
("key_b" , fun () -> Format.asprintf "%s" kb )
] in
error ~data title message ()
@ -50,8 +50,8 @@ module Errors = struct
let title () = name ^ " are different" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.type_value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.type_value b )
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
] in
error ~data title message ()
@ -59,8 +59,8 @@ module Errors = struct
let title () = name ^ " are different" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.literal b )
("a" , fun () -> Format.asprintf "%a" PP.literal a) ;
("b" , fun () -> Format.asprintf "%a" PP.literal b )
] in
error ~data title message ()
@ -68,8 +68,8 @@ module Errors = struct
let title () = name ^ " are different" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.value b )
("a" , fun () -> Format.asprintf "%a" PP.value a) ;
("b" , fun () -> Format.asprintf "%a" PP.value b )
] in
error ~data title message ()
@ -77,8 +77,8 @@ module Errors = struct
let title () = "literals have different types: " ^ name in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.literal b )
("a" , fun () -> Format.asprintf "%a" PP.literal a) ;
("b" , fun () -> Format.asprintf "%a" PP.literal b )
] in
error ~data title message ()
@ -86,26 +86,26 @@ module Errors = struct
let title () = "values have different types: " ^ name in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.value b )
("a" , fun () -> Format.asprintf "%a" PP.value a) ;
("b" , fun () -> Format.asprintf "%a" PP.value b )
] in
error ~data title message ()
let error_uncomparable_literals name a b () =
let title () = name ^ " are different" in
let title () = name ^ " are not comparable" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.literal a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.literal b )
("a" , fun () -> Format.asprintf "%a" PP.literal a) ;
("b" , fun () -> Format.asprintf "%a" PP.literal b )
] in
error ~data title message ()
let error_uncomparable_values name a b () =
let title () = name ^ " are different" in
let title () = name ^ " are not comparable" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.value b )
("a" , fun () -> Format.asprintf "%a" PP.value a) ;
("b" , fun () -> Format.asprintf "%a" PP.value b )
] in
error ~data title message ()
@ -113,8 +113,8 @@ module Errors = struct
let title () = name in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "(%a)" PP.value a) ;
("b" , fun () -> Format.asprintf "(%a)" PP.value b )
("a" , fun () -> Format.asprintf "%a" PP.value a) ;
("b" , fun () -> Format.asprintf "%a" PP.value b )
] in
error ~data title message ()

2
src/bin/cli.ml
View File

@ -46,7 +46,7 @@ let compile_file =
let f source entry_point syntax =
toplevel @@
let%bind contract =
trace (simple_error "compile michelson") @@
trace (simple_info "compiling contract to michelson") @@
Ligo.Run.compile_contract_file source entry_point syntax in
Format.printf "Contract:\n%s\n" contract ;
ok ()

23
src/operators/helpers.ml
View File

@ -9,8 +9,17 @@ module Typer = struct
let full () = Format.asprintf "constant name: %s\nexpected: %d\ngot: %d\n"
name expected (List.length got) in
error title full
end
let error_uncomparable_types a b () =
let title () = "these types are not comparable" in
let message () = "" in
let data = [
("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
("b" , fun () -> Format.asprintf "%a" PP.type_value b )
] in
error ~data title message ()
end
open Errors
type type_result = string * type_value
type typer' = type_value list -> type_value option -> type_result result
@ -22,7 +31,7 @@ module Typer = struct
let%bind tv' = f tv_opt in
ok (s , tv')
)
| _ -> fail @@ Errors.wrong_param_number s 0 lst
| _ -> fail @@ wrong_param_number s 0 lst
let typer_0 name f : typer = (name , typer'_0 name f)
let typer'_1 : name -> (type_value -> type_value result) -> typer' = fun s f lst _ ->
@ -31,7 +40,7 @@ module Typer = struct
let%bind tv' = f a in
ok (s , tv')
)
| _ -> fail @@ Errors.wrong_param_number s 1 lst
| _ -> fail @@ wrong_param_number s 1 lst
let typer_1 name f : typer = (name , typer'_1 name f)
let typer'_1_opt : name -> (type_value -> type_value option -> type_value result) -> typer' = fun s f lst tv_opt ->
@ -40,7 +49,7 @@ module Typer = struct
let%bind tv' = f a tv_opt in
ok (s , tv')
)
| _ -> fail @@ Errors.wrong_param_number s 1 lst
| _ -> fail @@ wrong_param_number s 1 lst
let typer_1_opt name f : typer = (name , typer'_1_opt name f)
let typer'_2 : name -> (type_value -> type_value -> type_value result) -> typer' = fun s f lst _ ->
@ -49,7 +58,7 @@ module Typer = struct
let%bind tv' = f a b in
ok (s , tv')
)
| _ -> fail @@ Errors.wrong_param_number s 2 lst
| _ -> fail @@ wrong_param_number s 2 lst
let typer_2 name f : typer = (name , typer'_2 name f)
let typer'_3 : name -> (type_value -> type_value -> type_value -> type_value result) -> typer' = fun s f lst _ ->
@ -58,7 +67,7 @@ module Typer = struct
let%bind tv' = f a b c in
ok (s , tv')
)
| _ -> fail @@ Errors.wrong_param_number s 3 lst
| _ -> fail @@ wrong_param_number s 3 lst
let typer_3 name f : typer = (name , typer'_3 name f)
let constant name cst = typer_0 name (fun _ -> ok cst)
@ -70,7 +79,7 @@ module Typer = struct
let comparator : string -> typer = fun s -> typer_2 s @@ fun a b ->
let%bind () =
trace_strong (simple_error "Types a and b aren't comparable") @@
trace_strong (error_uncomparable_types a b) @@
Assert.assert_true @@
List.exists (eq_2 (a , b)) [
t_int () ;