From 347774e42baf7d6207ea6bebfd1921d078f2776b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@nomadic-labs.com>
Date: Wed, 5 Jun 2019 19:16:54 +0200
Subject: [PATCH] Improved error messages

---
 src/ast_typed/misc.ml    | 52 ++++++++++++++++++++--------------------
 src/bin/cli.ml           |  2 +-
 src/operators/helpers.ml | 23 ++++++++++++------
 3 files changed, 43 insertions(+), 34 deletions(-)

diff --git a/src/ast_typed/misc.ml b/src/ast_typed/misc.ml
index 53b03c2be..077f00c0a 100644
--- a/src/ast_typed/misc.ml
+++ b/src/ast_typed/misc.ml
@@ -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 ()
 
diff --git a/src/bin/cli.ml b/src/bin/cli.ml
index 13ca1f970..be7626c86 100644
--- a/src/bin/cli.ml
+++ b/src/bin/cli.ml
@@ -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 ()
diff --git a/src/operators/helpers.ml b/src/operators/helpers.ml
index a04f566f5..7cdc617f4 100644
--- a/src/operators/helpers.ml
+++ b/src/operators/helpers.ml
@@ -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 () ;