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

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

@@ -133,7 +133,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 (b : int) : int = add_curry 1 b        // Partial application
 ```
 
 You can run the `increment` function defined above using the LIGO

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

@@ -697,7 +697,7 @@ function fold_op (const m : register) : int is
 <!--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
 ```
@@ -705,7 +705,7 @@ let fold_op (m : register) : register =
 <!--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

@@ -341,14 +341,14 @@ function fold_op (const m : register) : int is
 
 <!--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
 ```
 
 <!--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/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,10 +811,9 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
         let%bind var = pattern_to_var hd in
         ok (var , tl)
       in
+      let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type 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'))]
       | param1::others ->
@@ -809,7 +826,10 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
           } 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%bind ty = bind_map_list typed_pattern_to_typed_vars args in
+          let aux acc ty = Option.map (t_function (snd ty)) acc in
+          let func_type = List.fold_right' aux lhs_type' ty in
+          ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , func_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: unit) storage =
+let main (p: unit) (s:storage) =
   if true then failwith "This contract always fails" else ()

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/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 fold_op (m : foobar) : int =
-  let aggregate = fun (i: int * (int * int)) -> i.0 + i.1.0 + i.1.1
+  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/negative/self_in_lambda.mligo

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