From 6551168a564a753ebbc833881987807d3360c62d Mon Sep 17 00:00:00 2001 From: Sander Date: Thu, 30 Jan 2020 17:38:01 +0000 Subject: [PATCH] ReasonLIGO type declaration improvements for tuples and function arguments. CameLIGO tests for tuples and function arguments. --- src/passes/1-parser/reasonligo/Parser.mly | 108 ++++++++++++++++++---- src/test/contracts/tuple_type.mligo | 14 +++ src/test/contracts/tuple_type.religo | 49 ++++++++++ src/test/integration_tests.ml | 40 ++++++++ 4 files changed, 193 insertions(+), 18 deletions(-) create mode 100644 src/test/contracts/tuple_type.mligo create mode 100644 src/test/contracts/tuple_type.religo diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index d147c6313..8c7fb65a6 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/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: - fun_type { $1 } -| fun_type "," nsepseq(fun_type,",") { - let value = Utils.nsepseq_cons $1 $2 $3 in - let region = nsepseq_to_region type_expr_to_region value - in TProd {region; value} } +type_expr_func: + "=>" cartesian { + $1, $2 + } -fun_type: +cartesian: core_type { $1 } -| core_type "=>" fun_type { - let start = type_expr_to_region $1 - and stop = type_expr_to_region $3 in - let region = cover start stop in - TFun {region; value=$1,$2,$3} } +| type_name type_expr_func { + let (arrow, c) = $2 in + let value = TVar $1, arrow, c in + let region = cover $1.region (type_expr_to_region c) in + 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 = 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 -> - arg_to_pattern (EAnnot e), [] + | EAnnot _ as 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 -> - arg_to_pattern (EUnit e), [] + | EUnit _ as e -> + arg_to_pattern e, [] + | EVar _ as e -> + arg_to_pattern e, [] | e -> let open! SyntaxError in raise (Error (WrongFunctionArguments e)) in diff --git a/src/test/contracts/tuple_type.mligo b/src/test/contracts/tuple_type.mligo new file mode 100644 index 000000000..d9cdb62b5 --- /dev/null +++ b/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) diff --git a/src/test/contracts/tuple_type.religo b/src/test/contracts/tuple_type.religo new file mode 100644 index 000000000..6148840c0 --- /dev/null +++ b/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); diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 789f2a6c4..2449e085e 100644 --- a/src/test/integration_tests.ml +++ b/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 ; ]