Merge branch 'feature/typer-error-messages' into 'dev'

Better typer error messages

See merge request ligolang/ligo!268

src/bin/expect_tests/typer_error_tests.ml

@@ -1,11 +1,25 @@
 open Cli_expect
 
 let%expect_test _ =
-  run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_1.mligo" ; "foo" ] ;
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_1.mligo" ; "main" ] ;
   [%expect {| ligo: in file "error_typer_1.mligo", line 3, characters 19-27. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"int"} |} ] ;
 
-  run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_2.mligo" ; "foo" ] ;
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_2.mligo" ; "main" ] ;
   [%expect {| ligo: in file "error_typer_2.mligo", line 3, characters 24-39. different type constructors: Expected these two n-ary type constructors to be the same, but they're different {"a":"(TO_list(string))","b":"(TO_option(int))"} |} ] ;
 
-  (* run_ligo_bad [ "compile-contract" ; "../../test/contracts/error_typer_3.mligo" ; "foo" ] ;
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_3.mligo" ; "main" ] ;
-   * [%expect …some type error… ] ; *)
+  [%expect {| ligo: in file "error_typer_3.mligo", line 3, characters 34-53. tuples have different sizes: Expected these two types to be the same, but they're different (both are tuples, but with a different number of arguments) {"a":"tuple[int , string , bool]","b":"tuple[int , string]"} |} ] ;
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_4.mligo" ; "main" ] ;
+  [%expect {| ligo: in file "error_typer_4.mligo", line 4, characters 17-56. different keys in record:  {"key_a":"d","key_b":"c"} |} ] ;
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_5.mligo" ; "main" ] ;
+  [%expect {| ligo: unbound type variable:  {"variable":"boolean","in":"- E[]\tT[] ]","did_you_mean":"bool"} |} ] ;
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_6.mligo" ; "main" ] ;
+  [%expect {| ligo: in file "error_typer_6.mligo", line 1, characters 30-64. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"string","b":"bool"} |} ] ;
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_typer_7.mligo" ; "main" ] ;
+  [%expect {| ligo: in file "error_typer_7.mligo", line 4, characters 17-56. records have different sizes: Expected these two types to be the same, but they're different (both are records, but with a different number of arguments) {"a":"record[b -> string , a -> int]","b":"record[c -> bool , b -> string , a -> int]"} |} ] ;
+
+

src/passes/4-typer-old/typer.ml

@@ -12,13 +12,20 @@ type environment = Environment.t
 
 module Errors = struct
   let unbound_type_variable (e:environment) (tv:I.type_variable) () =
+    let name = Var.to_name tv in
+    let suggestion = match name with
+        | "integer" -> "int"
+        | "str" -> "string"
+        | "boolean" -> "bool"
+        | _ -> "no suggestion" in
     let title = (thunk "unbound type variable") in
     let message () = "" in
     let data = [
       ("variable" , fun () -> Format.asprintf "%a" Stage_common.PP.type_variable tv) ;
       (* TODO: types don't have srclocs for now. *)
       (* ("location" , fun () -> Format.asprintf "%a" Location.pp (n.location)) ; *)
-      ("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e)
+      ("in" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ;
+      ("did_you_mean" , fun () -> suggestion)
     ] in
     error ~data title message ()
 
@@ -464,8 +471,6 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
         | None -> ok ()
         | Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in
       ok(ae)
-
-
   (* Sum *)
   | E_constructor (c, expr) ->
       let%bind (c_tv, sum_tv) =
@@ -793,7 +798,12 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
         (Some tv)
         (Some expr'.type_annotation)
         (internal_assertion_failure "merge_annotations (Some ...) (Some ...) failed") in
-    ok {expr' with type_annotation}
+    (* check type annotation of the expression as a whole (e.g. let x : t = (v : t') ) *)
+    let%bind () =
+      match tv_opt with
+      | None -> ok ()
+      | Some tv' -> O.assert_type_value_eq (tv' , type_annotation) in
+    ok @@ {expr' with type_annotation}
 
 
 and type_constant (name:I.constant) (lst:O.type_value list) (tv_opt:O.type_value option) : (O.constant * O.type_value) result =

src/stages/ast_typed/misc.ml

@@ -56,7 +56,7 @@ module Errors = struct
 
   let different_types name a b () =
     let title () = name ^ " are different" in
-    let message () = "" in
+    let message () = "Expected these two types to be the same, but they're different" in
     let data = [
       ("a" , fun () -> Format.asprintf "%a" PP.type_value a) ;
       ("b" , fun () -> Format.asprintf "%a" PP.type_value b )
@@ -321,7 +321,7 @@ let rec assert_type_value_eq (a, b: (type_value * type_value)) : unit result = m
       | TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb]) 
       | _,_ -> fail @@ different_operators opa opb
       in
-    trace (different_types "constant sub-expression" a b)
+    trace (different_types "arguments to type operators" a b)
       @@ bind_list_iter (fun (a,b) -> assert_type_value_eq (a,b) )(List.combine lsta lstb)
   )
   | T_operator _, _ -> fail @@ different_kinds a b

src/test/contracts/error_typer_1.mligo

@@ -1,3 +0,0 @@
-type toto = int
-
-let foo : string = 42 + 127

src/test/contracts/error_typer_2.mligo

@@ -1,3 +0,0 @@
-type toto = int option
-
-let foo : string list = Some (42 + 127)

src/test/contracts/negative/README

@@ -0,0 +1 @@
+This folder contains contracts for negative tests: contracts that are expected to fail (parse error, type error and so on).

src/test/contracts/negative/error_typer_1.mligo

@@ -0,0 +1,6 @@
+type toto = int
+
+let foo : string = 42 + 127
+
+let main (p:int) (storage : int) =
+  (([] : operation list) , p + foo)

src/test/contracts/negative/error_typer_2.mligo

@@ -0,0 +1,6 @@
+type toto = int option
+
+let foo : string list = Some (42 + 127)
+
+let main (p:int) (storage : int) =
+  (([] : operation list) , p)

src/test/contracts/negative/error_typer_4.mligo

@@ -0,0 +1,7 @@
+type toto = { a : int ; b : string ; c : bool }
+type tata = { a : int ; d : string ; c : bool }
+
+let foo : tata = ({a = 1 ; b = "foo" ; c = true} : toto)
+
+let main (p:int) (storage : int) =
+  (([] : operation list) , p + foo.a)

src/test/contracts/negative/error_typer_5.mligo

@@ -0,0 +1,4 @@
+let foo : boolean = 3
+
+let main (p:int) (storage : int) =
+  (([] : operation list) , p + foo)

src/test/contracts/negative/error_typer_6.mligo

@@ -0,0 +1,3 @@
+let foo : (int, string) map = (Map.literal [] : (int, bool) map)
+let main (p:int) (storage : int) =
+  (([] : operation list) , p)

src/test/contracts/negative/error_typer_7.mligo

@@ -0,0 +1,7 @@
+type toto = { a : int ; b : string }
+type tata = { a : int ; }
+
+let foo : tata = ({a = 1 ; b = "foo" ; c = true} : toto)
+
+let main (p:int) (storage : int) =
+  (([] : operation list) , p + foo.a)

src/test/dune

@@ -15,7 +15,8 @@
 (alias
   (name ligo-test)
   (action (run ./test.exe))
-  (deps (glob_files contracts/*))
+  (deps (glob_files contracts/*)
+        (glob_files contracts/negative/*))
 )
 
 (alias