Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht@contracts

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

@@ -1161,33 +1161,33 @@ 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#804 = #P in let p = rhs#804.0 in let s = rhs#804.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#808 = #P in let p = rhs#808.0 in let s = rhs#808.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
-     do one of the following:
+ 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' |}] ;
+* 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" ; 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#807 = #P in let p = rhs#807.0 in let s = rhs#807.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#811 = #P in let p = rhs#811.0 in let s = rhs#811.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
-     do one of the following:
+ 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' |}] ;
+* 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" ; 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)

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/failwith.mligo

@@ -1,4 +1,4 @@
 type storage = unit
 
 let main (p, store : unit * storage) : operation list * storage =
-  failwith "This contract always fails"
+  (failwith "This contract always fails" : operation list * storage)

src/test/contracts/lambda.religo

@@ -5,4 +5,5 @@ type storage = unit;
      (fun x -> ()) ()
    */
 
-let main = ((p,s) : (unit, storage)) => (((useless : unit)) => ()) ();
+let main = ((p,s) : (unit, storage)) : unit =>
+  (((useless : unit)) => ()) ();

src/test/contracts/lambda2.religo

@@ -4,5 +4,5 @@ type storage = unit;
    let main (p:unit) storage = (fun x -> ()) ()
    */
 
-let main = ((a, s) : (unit, storage)) : (operation (list), storage) =>
+let main = ((a, s) : (unit, storage)) : unit =>
   ((f : (unit => unit)) => f ()) ((useless : unit) => unit);

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/list.religo

@@ -8,9 +8,9 @@ let x : list (int) = [];
 let y : list (int) = [3, 4, 5];
 let z : list (int) = [2, ...y];
 
-let main = ((p,s) : (parameter, storage)) : return => {
+let main = ((action, s) : (parameter, storage)) : return => {
   let storage =
-    switch (p) {
+    switch (action) {
     | [] => s
     | [hd, ...tl] => (s[0] + hd, tl)
     };

src/test/contracts/map.mligo

@@ -43,8 +43,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

@@ -12,7 +12,6 @@ let main = ((action, store): (parameter, storage)) => {
       (switch (action) {
       | Add (n) => n
       | Sub (n) => -n
-      }
-  );
-  (([]: list(operation)), store);
+      });
+  (([]: list (operation)), store);
 };

src/test/contracts/match_bis.religo

@@ -13,5 +13,5 @@ let main = ((action, store) : (parameter, storage)) => {
     | Increment (n) => add (store, n)
     | Decrement (n) => sub (store, n)
     };
-  (([]: list (operation)), store);
+  (([] : list (operation)), store);
 };

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

@@ -1,5 +1,5 @@
-let foo (u: unit) : address =
-  Tezos.self_address
+let foo (u : unit) : address = Tezos.self_address
 
-let main (ps: unit * address): (operation list * address) =
-  ( ([] : operation list) , foo)
+let main (ps : unit * address) : (operation list * address) =
+  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
 
 (*