diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 804bcddea..a6eea7961 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -428,8 +428,22 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | e -> let open! SyntaxError - in raise (Error (WrongFunctionArguments e)) + | ETuple { value; region } -> + PTuple { value = Utils.nsepseq_map arg_to_pattern value; region} + | EAnnot {region; value = {inside = t, colon, typ; _}} -> + let value = { pattern = arg_to_pattern t; colon; type_expr = typ} in + PPar { + value = { + lpar = Region.ghost; + rpar = Region.ghost; + inside = PTyped {region; value} + }; + region + } + | e -> ( + let open! SyntaxError in + raise (Error (WrongFunctionArguments e)) + ) in let fun_args_to_pattern = function EAnnot { diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index fb16694fb..917d001bf 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -36,7 +36,7 @@ module Errors = struct ] in error ~data title message - let unsuppported_let_in_function (patterns : Raw.pattern list) = + let unsupported_let_in_function (patterns : Raw.pattern list) = let title () = "unsupported 'let ... in' function" in let message () = "defining functions via 'let ... in' is not supported yet" in let patterns_loc = @@ -179,6 +179,10 @@ 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 + | PPar p -> unpar_pattern p.value.inside + | _ as p -> p + let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> trace (simple_info "simplifying this type expression...") @@ match te with @@ -354,7 +358,7 @@ let rec simpl_expression : (* let f p1 ps... = rhs in body *) | (f, p1 :: ps) -> - fail @@ unsuppported_let_in_function (f :: p1 :: ps) + fail @@ unsupported_let_in_function (f :: p1 :: ps) end | Raw.EAnnot a -> let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in @@ -541,7 +545,8 @@ and simpl_fun lamb' : expr result = (match pt with | Raw.PTyped pt -> begin - match pt.value.pattern with + let pt_pattern = unpar_pattern pt.value.pattern in + match pt_pattern with | Raw.PVar _ -> params | Raw.PTuple _ -> [Raw.PTyped @@ -581,10 +586,10 @@ and simpl_fun lamb' : expr result = match destruct with (* Handle tuple parameter destructuring *) (* In this section we create a let ... in that binds the original parameters *) | Raw.PPar pp -> - (match pp.value.inside with + (match unpar_pattern pp.value.inside with | Raw.PTyped pt -> let vars = pt.value in - (match vars.pattern with + (match unpar_pattern vars.pattern with | PTuple vars -> let let_in_binding: Raw.let_binding = {binders = (PTuple vars, []) ; diff --git a/src/test/contracts/tuple_param_destruct.mligo b/src/test/contracts/tuple_param_destruct.mligo index 6dfe30fe4..d9cfc6513 100644 --- a/src/test/contracts/tuple_param_destruct.mligo +++ b/src/test/contracts/tuple_param_destruct.mligo @@ -1 +1,2 @@ -let sum (result, i : int * int) : int = result + i +let sum (result, i : int * int) : int = result - i +let parentheses ((((result, i))) : ((int * int))) : int = result - i diff --git a/src/test/contracts/tuple_param_destruct.religo b/src/test/contracts/tuple_param_destruct.religo new file mode 100644 index 000000000..3641ab8d0 --- /dev/null +++ b/src/test/contracts/tuple_param_destruct.religo @@ -0,0 +1,2 @@ +let sum = ((result, i) : (int, int)) : int => result - i; +let parentheses = (((((result, i)))) : (((int, int)))) : int => result - i; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 394bcc4f0..6abe31226 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1943,8 +1943,15 @@ let type_tuple_destruct () : unit result = let tuple_param_destruct () : unit result = let%bind program = mtype_file "./contracts/tuple_param_destruct.mligo" in - let%bind () = expect_eq program "sum" (e_tuple [e_int 10; e_int 10]) (e_int 20) - in ok () + let%bind () = expect_eq program "sum" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + let%bind () = expect_eq program "parentheses" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + ok () + +let tuple_param_destruct_religo () : unit result = + let%bind program = retype_file "./contracts/tuple_param_destruct.religo" in + let%bind () = expect_eq program "sum" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + let%bind () = expect_eq program "parentheses" (e_tuple [e_int 20; e_int 10]) (e_int 10) in + ok () let let_in_multi_bind () : unit result = let%bind program = mtype_file "./contracts/let_in_multi_bind.mligo" in @@ -2159,6 +2166,7 @@ let main = test_suite "Integration (End to End)" [ test "attributes (religo)" attributes_religo; test "let in multi-bind (mligo)" let_in_multi_bind ; test "tuple param destruct (mligo)" tuple_param_destruct ; + test "tuple param destruct (religo)" tuple_param_destruct_religo ; test "empty case" empty_case ; test "empty case (mligo)" empty_case_mligo ; test "empty case (religo)" empty_case_religo ;