Fix simplifyer and test

gitlab-pages/docs/advanced/entrypoints-contracts.md

@@ -310,7 +310,7 @@ let main (action, store: parameter * storage) : return =
 ```reasonligo group=c
 let owner : address = ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address);
 
-let main = ((action, store) : (parameter, storage)) : storage => {
+let main = ((action, store) : (parameter, storage)) : return => {
   if (Tezos.source != owner) { (failwith ("Access denied.") : return); }
   else { (([] : list (operation)), store); };
 };
@@ -478,4 +478,3 @@ let proxy = ((action, store): (parameter, storage)) : return => {
 > *deprecated*.
 
 </Syntax>
-

src/passes/2-simplify/cameligo.ml

@@ -176,6 +176,11 @@ let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
   | Raw.PWild r -> ok (({ region = r ; value = "_" } : Raw.variable) , None)
   | _ -> fail @@ wrong_pattern "single typed variable" p
 
+let rec expr_to_typed_expr : Raw.expr -> _ = function
+  EPar e -> expr_to_typed_expr e.value.inside
+| EAnnot {value={inside=e,_,t; _}; _} -> ok (e, Some t)
+| e -> ok (e , None)
+
 let rec tuple_pattern_to_typed_vars : Raw.pattern -> _ = fun pattern ->
   match pattern with
   | Raw.PPar pp -> tuple_pattern_to_typed_vars pp.value.inside
@@ -641,8 +646,9 @@ and simpl_fun lamb' : expr result =
        | _ ->  ok lamb.body)
     | _ ->  ok lamb.body
   in
+  let%bind (body , body_type) = expr_to_typed_expr body in
   let%bind output_type =
-    bind_map_option (fun x -> simpl_type_expression @@ snd x) lamb.lhs_type in
+    bind_map_option simpl_type_expression body_type in
   let%bind body = simpl_expression body in
   let rec layer_arguments (arguments: (Raw.variable * type_expression) list) =
     match arguments with
@@ -805,8 +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 let_rhs = match args with
+      let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in
-      | [] -> ok (let_rhs)
+      let%bind let_rhs,lhs_type = match args with
+      | [] -> ok (let_rhs, lhs_type')
       | param1::others ->
           let fun_ = {
             kwd_fun = Region.ghost;
@@ -815,17 +822,23 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
             arrow   = Region.ghost;
             body    = let_rhs
           } in
-          ok (Raw.EFun {region=Region.ghost ; value=fun_})
+          let f_args = nseq_to_list (param1,others) in
-      in
-      let%bind rhs' = simpl_expression let_rhs in
-      let%bind lhs_type = match let_rhs with
-        | Raw.EFun {value={binders;lhs_type};_} -> 
-          let f_args = nseq_to_list (binders) 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
+      let%bind lhs_type = match lhs_type with 
+      | None -> (match let_rhs with 
+        | EFun {value={binders;lhs_type}} -> 
+          let f_args = nseq_to_list (binders) in
           let%bind lhs_type' = bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type in
-          ok @@ List.fold_right' aux lhs_type' ty
+          let%bind ty = bind_map_list typed_pattern_to_typed_vars f_args in
-        | _ -> bind_map_option (fun x -> simpl_type_expression (snd x)) lhs_type
+          let aux acc ty = Option.map (t_function (snd ty)) acc in
+          ok @@ (List.fold_right' aux lhs_type' ty)
+        | _ -> ok None
+        )
+      | Some t -> ok @@ Some t
       in
       ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
     )

src/test/contracts/balance_constant.religo

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

src/test/contracts/set_arithmetic.religo

@@ -6,10 +6,10 @@ let literal_op = (p: unit) : set (string) =>
 let add_op = (s: set (string)) : set (string) =>
   Set.add ("foobar", s);
 
-let remove_op = (s: set (string)) : set(string) =>
+let remove_op = (s: set (string)) : set (string) =>
   Set.remove ("foobar", s);
 
-let remove_deep = (s: (set (string), nat)): (set (string), nat) =>
+let remove_deep = (s: (set (string), nat)): set (string) =>
   Set.remove ("foobar", s[0]);
 
 let mem_op = (s: set (string)) : bool =>