Merge branch 'cameligo-type-tuple-bug' into 'dev'

ReasonLIGO improvements to better handle tuples and function arguments

See merge request ligolang/ligo!365

src/passes/1-parser/reasonligo/Parser.mly

@@ -24,6 +24,24 @@ type 'a sequence_or_record =
 
 let (<@) f g x = f (g x)
 
+(** 
+  Covert nsepseq to a chain of TFun's. 
+  
+  Necessary to handle cases like:
+  `type foo = (int, int) => int;`
+*)
+let rec nsepseq_to_curry hd rest = 
+  match hd, rest with 
+  | hd, (sep, item) :: rest -> 
+    let start = type_expr_to_region hd in
+    let stop = nsepseq_to_region type_expr_to_region (hd, rest) in
+    let region = cover start stop in 
+    TFun {
+      value = hd, sep, (nsepseq_to_curry item rest); 
+      region
+    } 
+  | hd, [] -> hd
+
 (* END HEADER *)
 %}
 
@@ -159,24 +177,40 @@ type_decl:
 type_expr:
   cartesian | sum_type | record_type { $1 }
 
-cartesian:
+type_expr_func:
-  fun_type { $1 }
+  "=>" cartesian { 
-| fun_type "," nsepseq(fun_type,",") {
+    $1, $2
-    let value  = Utils.nsepseq_cons $1 $2 $3 in
+  }
-    let region = nsepseq_to_region type_expr_to_region value
-    in TProd {region; value} }
 
-fun_type:
+cartesian:
   core_type { $1 }
-| core_type "=>" fun_type {
+| type_name type_expr_func { 
-    let start  = type_expr_to_region $1
+  let (arrow, c) = $2 in
-    and stop   = type_expr_to_region $3 in
+  let value = TVar $1, arrow, c in
-    let region = cover start stop in
+  let region = cover $1.region (type_expr_to_region c) in
-    TFun {region; value=$1,$2,$3} }
+  TFun { region; value }
+}
+| "(" cartesian ")" type_expr_func { 
+  let (arrow, c) = $4 in
+  let value = $2, arrow, c in
+  let region = cover $1 (type_expr_to_region c) in
+  TFun { region; value }
+}
+| "(" cartesian "," nsepseq(cartesian,",") ")" type_expr_func? {
+    match $6 with 
+    | Some (arrow, c) -> 
+      let (hd, rest) = Utils.nsepseq_cons $2 $3 $4 in
+      let rest = rest @ [(arrow, c)] in          
+      nsepseq_to_curry hd rest
+    | None ->
+      let value  = Utils.nsepseq_cons $2 $3 $4 in
+      let region = cover $1 $5 in
+      TProd {region; value} 
+  }
 
 core_type:
   type_name      { TVar $1 }
-| par(type_expr) { TPar $1 }
+| par(cartesian) { TPar $1 }
 | module_name "." type_name {
     let module_name = $1.value in
     let type_name   = $3.value in
@@ -471,17 +505,55 @@ fun_expr:
           _} ->
           (* ((foo:x, bar) : type) *)
          (arg_to_pattern fun_arg, [])
+      | EPar {value = {inside = EFun {
+          value = {
+              binders = PTyped { value = { pattern; colon; type_expr }; region = fun_region }, [];
+              arrow;
+              body;
+              _
+          };
+          _
+        }; _ }; region} ->
+
+        let expr_to_type = function 
+        | EVar v -> TVar v
+        | e -> let open! SyntaxError
+            in raise (Error (WrongFunctionArguments e))
+        in
+        let type_expr = (
+          match type_expr with
+          | TProd {value; _} -> 
+            let (hd, rest) = value in
+            let rest = rest @ [(arrow, expr_to_type body)] in          
+            nsepseq_to_curry hd rest          
+          | e ->               
+            TFun {
+              value = e, arrow, expr_to_type body;
+              region = fun_region
+            }          
+        )
+        in 
+        PTyped {
+          value = {
+            pattern;
+            colon;
+            type_expr
+          }; 
+          region;
+        }, []
       | EPar {value = {inside =  fun_arg; _ }; _} ->
           arg_to_pattern fun_arg, []
-      | EAnnot e ->
+      | EAnnot _ as e ->
-          arg_to_pattern (EAnnot e), []
+          arg_to_pattern e, []
       | ETuple {value = fun_args; _} ->
           let bindings =
             List.map (arg_to_pattern <@ snd) (snd fun_args) in
           List.iter Scoping.check_pattern bindings;
           arg_to_pattern (fst fun_args), bindings
-      | EUnit e ->
+      | EUnit _ as e ->
-          arg_to_pattern (EUnit e), []
+          arg_to_pattern e, []
+      | EVar _ as e -> 
+          arg_to_pattern e, []
       | e -> let open! SyntaxError
             in raise (Error (WrongFunctionArguments e))
     in

src/test/contracts/tuple_type.mligo

@@ -0,0 +1,14 @@
+let g (b: int) = b + 3
+
+let f (b: int * int) : int -> int = g
+
+let a (b: int * int -> int -> int) : int = (b (5,3)) 5
+
+let test1 (_: int) =
+    a f
+
+let n (a, b: int * int): int = a + b
+
+let o (p: int * int -> int): int = p((3, 9))
+
+let test2 (ignore: int) = o(n)

src/test/contracts/tuple_type.religo

@@ -0,0 +1,49 @@
+/* 
+  The difference between tuples and arguments is subtle in ReasonLIGO. 
+   
+   `f(a, b);` 
+   f is called with two arguments
+
+   `f((a, b));` 
+   f is called with a tuple.
+   
+*/
+
+type fun_type = (int, int) => int;
+
+let arguments = (b: int, c: int) => {
+  b + c;
+}; 
+
+let arguments_type_def = (b: fun_type) => b(5, 3); 
+
+let arguments_test = (ignore: int) => arguments_type_def(arguments);
+
+type tuple_type = ((int, int)) => int;
+
+let tuple = ((a, b): (int, int)) => {
+  a + b;
+};
+
+let tuple_type_def = (b: tuple_type) => b((5, 3));
+
+let tuple_test = (ignore: int) => tuple_type_def(tuple); 
+
+
+/* inline */
+
+let arguments_inline = (b: int, c: int) => {
+  b + c;
+}; 
+
+let arguments_type_def_inline = (b: (int, int) => int) => b(5, 3); 
+
+let arguments_test_inline = (ignore: int) => arguments_type_def_inline(arguments_inline);
+
+let tuple_inline = ((a, b): (int, int)) => {
+  a + b;
+};
+
+let tuple_type_def_inline = (b:  ((int, int)) => int) => b((5, 3));
+
+let tuple_test_inline = (ignore: int) => tuple_type_def_inline(tuple_inline); 

src/test/integration_tests.ml

@@ -2098,6 +2098,44 @@ let empty_case_religo () : unit result =
   in
   ok ()
 
+let tuple_type_mligo () : unit result = 
+  let%bind program = mtype_file "./contracts/tuple_type.mligo" in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 8 in
+    expect_eq_n program "test1" input expected
+  in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 12 in
+    expect_eq_n program "test2" input expected
+  in
+  ok ()
+
+let tuple_type_religo () : unit result = 
+  let%bind program = retype_file "./contracts/tuple_type.religo" in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 8 in
+    expect_eq_n program "arguments_test" input expected
+  in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 8 in
+    expect_eq_n program "tuple_test" input expected
+  in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 8 in
+    expect_eq_n program "arguments_test_inline" input expected
+  in
+  let%bind () = 
+    let input _ = e_int 0 in 
+    let expected _ = e_int 8 in
+    expect_eq_n program "tuple_test_inline" input expected
+  in
+  ok ()
+
 let main = test_suite "Integration (End to End)" [
     test "bytes unpack" bytes_unpack ;
     test "bytes unpack (mligo)" bytes_unpack_mligo ;
@@ -2258,4 +2296,6 @@ let main = test_suite "Integration (End to End)" [
     test "empty case" empty_case ;
     test "empty case (mligo)" empty_case_mligo ;
     test "empty case (religo)" empty_case_religo ;
+    test "tuple type (mligo)" tuple_type_mligo ;
+    test "tuple type (religo)" tuple_type_religo ;
   ]