Merge branch 'fix-function-type-annotation-in-camel-simplifer' into 'dev'

Repare function annotation in let binding for Camligo and ReasonLigo and fix some contracts

See merge request ligolang/ligo!458

gitlab-pages/docs/language-basics/functions.md

@@ -136,7 +136,7 @@ returns an integer as well:
 ```cameligo group=b
 let add (a, b : int * int) : int = a + b             // Uncurried
 let add_curry (a : int) (b : int) : int = add (a, b) // Curried
-let increment (b : int) : int = add_curry 1          // Partial application
+let increment : int -> int = add_curry 1             // Partial application
 ```
 
 You can run the `increment` function defined above using the LIGO

gitlab-pages/docs/language-basics/maps-records.md

@@ -772,7 +772,7 @@ function fold_op (const m : register) : int is
 <Syntax syntax="cameligo">
 
 ```cameligo group=maps
-let fold_op (m : register) : register =
+let fold_op (m : register) : int =
   let folded = fun (i,j : int * (address * move)) -> i + j.1.1
   in Map.fold folded m 5
 ```
@@ -781,7 +781,7 @@ let fold_op (m : register) : register =
 <Syntax syntax="reasonligo">
 
 ```reasonligo group=maps
-let fold_op = (m : register) : register => {
+let fold_op = (m : register) : int => {
   let folded = ((i,j): (int, (address, move))) => i + j[1][1];
   Map.fold (folded, m, 5);
 };

gitlab-pages/docs/reference/map.md

@@ -400,7 +400,7 @@ function fold_op (const m : register) : int is
 <Syntax syntax="cameligo">
 
 ```cameligo group=maps
-let fold_op (m : register) : register =
+let fold_op (m : register) : int =
   let folded = fun (i,j : int * (address * move)) -> i + j.1.1
   in Map.fold folded m 5
 ```
@@ -409,7 +409,7 @@ let fold_op (m : register) : register =
 <Syntax syntax="reasonligo">
 
 ```reasonligo group=maps
-let fold_op = (m : register) : register => {
+let fold_op = (m : register) : int => {
   let folded = ((i,j): (int, (address, move))) => i + j[1][1];
   Map.fold (folded, m, 5);
 };

src/bin/expect_tests/contract_tests.ml

@@ -1149,7 +1149,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * string ):Some(( nat * string ))) : None return let rhs#752 = #P in let p = rhs#752.0 in let s = rhs#752.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
+    ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * string ):Some(( nat * string ))) : None return let rhs#756 = #P in let p = rhs#756.0 in let s = rhs#756.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"}
 
 
      If you're not sure how to fix this error, you can
@@ -1162,7 +1162,7 @@ let%expect_test _ =
 
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * int ):Some(( nat * int ))) : None return let rhs#755 = #P in let p = rhs#755.0 in let s = rhs#755.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
+    ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P : ( nat * int ):Some(( nat * int ))) : None return let rhs#759 = #P in let p = rhs#759.0 in let s = rhs#759.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"}
 
 
      If you're not sure how to fix this error, you can
@@ -1175,7 +1175,7 @@ let%expect_test _ =
 
   run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_no_inline.mligo" ; "main" ] ;
   [%expect {|
-    ligo: in file "create_contract_no_inline.mligo", line 9, characters 19-89. CREATE_CONTRACT first argument must be inlined: contract code can be inlined using a lambda {"expression":"CREATE_CONTRACT(dummy_contract , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_no_inline.mligo\", line 9, characters 19-89"}
+    ligo: unbound type variable:  {"variable":"return","in":"- E[foo -> int]\tT[] ]","did_you_mean":"no suggestion"}
 
 
      If you're not sure how to fix this error, you can

src/bin/expect_tests/typer_error_tests.ml

@@ -1,6 +1,45 @@
 open Cli_expect
 
 let%expect_test _ =
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_1.mligo"; "main"];
+  [%expect {|
+    ligo: in file "", line 0, characters 0-0. different type constructors: Expected these two constant type constructors to be the same, but they're different {"a":"unit","b":"int"}
+
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}];
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_2.mligo"; "f"];
+  [%expect {|
+    ligo: in file "error_function_annotation_2.mligo", line 1, characters 14-43. different kinds:  {"a":"int","b":"( int * int ) -> int"}
+
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}];
+
+  run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_function_annotation_3.mligo"; "f"];
+  [%expect {|
+    ligo: in file "", line 0, characters 0-0. different kinds:  {"a":"( (TO_list(operation)) * sum[Add -> int , Sub -> int] )","b":"sum[Add -> int , Sub -> int]"}
+
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}];
+
   run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_type.ligo" ; "main" ] ;
   [%expect {|
     ligo: in file "error_type.ligo", line 3, characters 18-28. Adding modulo with wrong types: Expected arguments with one of the following combinations of types: add(nat , nat) or add(int , int) or add(mutez , mutez) or add(nat , int) or add(int , nat) or add(timestamp , int) or add(int , timestamp) but got this combination instead: add(int , string)
@@ -135,4 +174,4 @@ let%expect_test _ =
     * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
     * Ask a question on our Discord: https://discord.gg/9rhYaEt
     * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
-    * Check the changelog by running 'ligo changelog' |}];
+    * Check the changelog by running 'ligo changelog' |}];

src/passes/2-simplify/cameligo.ml

@@ -156,6 +156,14 @@ let rec pattern_to_var : Raw.pattern -> _ = fun p ->
   | Raw.PWild r -> ok @@ ({ region = r ; value = "_" } : Raw.variable)
   | _ -> fail @@ wrong_pattern "single var" p
 
+let rec tuple_pattern_to_vars : Raw.pattern -> _ = fun pattern ->
+  match pattern with
+  | Raw.PPar pp -> tuple_pattern_to_vars pp.value.inside
+  | Raw.PTuple pt -> bind_map_list pattern_to_var (npseq_to_list pt.value)
+  | Raw.PVar _ | Raw.PWild _-> bind_list [pattern_to_var pattern]
+  | other -> (fail @@ wrong_pattern "parenthetical, tuple, or variable" other)
+
+
 let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
   match p with
   | Raw.PPar p -> pattern_to_typed_var p.value.inside
@@ -180,11 +188,21 @@ let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
   | Raw.PVar _ -> bind_list [pattern_to_typed_var pattern]
   | other -> (fail @@ wrong_pattern "parenthetical, tuple, or variable" other)
 
-let rec unpar_pattern : Raw.pattern -> Raw.pattern = function
+let rec typed_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
+  match pattern with
+  | Raw.PPar pp -> typed_pattern_to_typed_vars pp.value.inside
+  | Raw.PTyped pt ->
+     let (p,t) = pt.value.pattern,pt.value.type_expr in
+     let%bind p = tuple_pattern_to_vars p in 
+     let%bind t = simpl_type_expression t in
+     ok @@ (p,t)
+  | other -> (fail @@ wrong_pattern "parenthetical or type annotation" other)
+
+and unpar_pattern : Raw.pattern -> Raw.pattern = function
   | PPar p -> unpar_pattern p.value.inside
   | _ as p -> p
 
-let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
+and simpl_type_expression : Raw.type_expr -> type_expression result = fun te ->
   trace (simple_info "simplifying this type expression...") @@
   match te with
     TPar x -> simpl_type_expression x.value.inside
@@ -793,12 +811,9 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
         let%bind var = pattern_to_var hd in
         ok (var , tl)
       in
-      match args with
-      | [] ->
-          let%bind lhs_type' =
-            bind_map_option (fun (_,te) -> simpl_type_expression te) lhs_type in
-          let%bind rhs' = simpl_expression let_rhs in
-          ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type' , inline, rhs'))]
+      let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in
+      let%bind let_rhs,lhs_type = match args with
+      | [] -> ok (let_rhs, lhs_type')
       | param1::others ->
           let fun_ = {
             kwd_fun = Region.ghost;
@@ -807,9 +822,13 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
             arrow   = Region.ghost;
             body    = let_rhs
           } in
-          let rhs = Raw.EFun {region=Region.ghost ; value=fun_} in
-          let%bind rhs' = simpl_expression rhs in
-          ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , None , inline, rhs'))]
+          let f_args = nseq_to_list (param1,others) in
+          let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
+          let aux acc ty = Option.map (t_function (snd ty)) acc in
+          ok (Raw.EFun {region=Region.ghost ; value=fun_},List.fold_right' aux lhs_type' ty)
+      in
+      let%bind rhs' = simpl_expression let_rhs in
+      ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
     )
 
 and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result =

src/test/contracts/balance_constant.religo

@@ -12,6 +12,6 @@ generated. unrecognized constant: {"constant":"BALANCE","location":"generated"}
 
 type storage = tez;
 
-let main2 = (p: unit, storage) => ([]: list(operation), balance);
+let main2 = (p: unit, s: storage) => ([]: list(operation), balance);
 
 let main = (x: (unit, storage)) => main2(x[0],x[1]);

src/test/contracts/counter.religo

@@ -1,7 +1,6 @@
 
 type storage = int;
 
-let main2 = (p: int, storage): string => ([]: list(operation), p + storage);
+let main2 = (p: int, s: storage): string => ([]: list(operation), p + s);
 
 let main = (x: (int, storage)) : string => main2(x[0],x[1]);
-

src/test/contracts/failwith.mligo

@@ -1,4 +1,4 @@
 type storage = unit
 
-let main (p: unit) storage =
+let main (p: unit) (s:storage) =
   if true then failwith "This contract always fails" else ()

src/test/contracts/lambda.religo

@@ -5,6 +5,6 @@ type storage = unit;
      (fun x -> ()) ()
    */
 
-let main2 = ((p: unit), storage) => (((xxx: unit)) => ())();
+let main2 = ((p: unit), s: storage) => (((xxx: unit)) => ())();
 
 let main = (x: (unit, storage)) => main2(x[0], x[1]);

src/test/contracts/lambda2.religo

@@ -4,7 +4,7 @@ type storage = unit;
    let main (p:unit) storage = (fun x -> ()) ()
    */
 
-let main2 = (z: unit, storage) =>
+let main2 = (z: unit, s: storage) =>
   ((f: (unit => unit)) => f())((z: unit) => unit);
 
 let main = (x: (unit, storage)) => main2(x[0],x[1]);

src/test/contracts/let_in_multi_bind.mligo

@@ -1,5 +1,5 @@
 let sum (p: int * int) : int =
   let i, result = p in i + result
 
-let sum2 (p: string * string * string * string) : int =
+let sum2 (p: string * string * string * string) : string =
   let a, b, c, d = p in a ^ b ^ c ^ d

src/test/contracts/letin.religo

@@ -1,9 +1,9 @@
 type storage = (int, int);
 
-let main2 = ((n : int), storage) => {
+let main2 = ((n : int), s: storage) => {
   let x: (int, int) = {
     let x: int = 7;
-    (x + n, storage[0] + storage[1]);
+    (x + n, s[0] + s[1]);
   };
   ([]: list(operation), x);
 };

src/test/contracts/list.religo

@@ -6,7 +6,7 @@ let x: list(int) = [];
 let y: list(int) = [3, 4, 5];
 let z: list(int) = [2, ...y];
 
-let main2 = (p: param, storage) => {
+let main2 = (p: param, storage : storage) => {
   let storage =
     switch (p) {
     | [] => storage

src/test/contracts/map.mligo

@@ -42,8 +42,8 @@ let map_op (m : foobar) : foobar =
   let increment = fun (i: int * int) -> i.1 + 1
   in Map.map increment m
 
-let fold_op (m : foobar) : foobar =
-  let aggregate = fun (i: int * (int * int)) -> i.0 + i.1.0 + i.1.1
+let fold_op (m : foobar) : int =
+  let aggregate = fun (i,m: int * (int * int)) -> i + m.0 + m.1
   in Map.fold aggregate m 10
 
 let deep_op (m: foobar) : foobar =

src/test/contracts/match.religo

@@ -4,9 +4,9 @@ type param =
   | Add(int)
   | Sub(int);
 
-let main2 = ((p: param), storage) => {
+let main2 = ((p: param), s: storage) => {
   let storage =
-    storage
+    s
     + (
       switch (p) {
       | Add(n) => n

src/test/contracts/match_bis.religo

@@ -12,7 +12,7 @@ let subtract = ((a: int), (b: int)) => a - b;
 
 /* real entrypoint that re-routes the flow based on the action provided */
 
-let main2 = ((p: action), storage) => {
+let main2 = ((p: action), storage : storage) => {
   let storage =
     switch (p) {
     | Increment(n) => add(storage, n)

src/test/contracts/negative/error_function_annotation_1.mligo

@@ -0,0 +1 @@
+let main (a:int) : unit = a

src/test/contracts/negative/error_function_annotation_2.mligo

@@ -0,0 +1,2 @@
+let f : int = fun (x, y : int*int) -> x + y
+let g (x, y : int * int) : int = f (x, y)

src/test/contracts/negative/error_function_annotation_3.mligo

@@ -0,0 +1,9 @@
+type op =
+  | Add of int
+  | Sub of int
+
+
+let main (p,s : int  * op) : (operation list) * op =
+  match s with
+  | Add si -> Add si
+  | Sub si -> Sub si

src/test/contracts/negative/self_in_lambda.mligo

@@ -2,4 +2,5 @@ let foo (u: unit) : address =
   Current.self_address
 
 let main (ps: unit * address): (operation list * address) =
-  ( ([] : operation list) , foo)
+  let dummy = foo() in
+  ( ([] : operation list) , foo())

src/test/contracts/set_arithmetic.mligo

@@ -9,7 +9,7 @@ let add_op (s : string set) : string set =
 let remove_op (s : string set) : string set =
    Set.remove "foobar" s
 
-let remove_deep (s : string set * nat) : string set * nat =
+let remove_deep (s : string set * nat) : string set =
   Set.remove "foobar" s.0
 
 (*