diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index aa7753789..5d902b5d8 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -36,6 +36,18 @@ module Errors = struct ] in error ~data title message + let multiple_patterns construct (patterns: Raw.pattern list) = + let title () = "multiple patterns" in + let message () = + Format.asprintf "multiple patterns in \"%s\" are not supported yet" construct in + let patterns_loc = + List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p)) + Region.ghost patterns in + let data = [ + ("patterns_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc) + ] in + error ~data title message + let unknown_predefined_type name = let title () = "type constants" in let message () = @@ -123,6 +135,12 @@ module Errors = struct fun () -> Format.asprintf "%a" Location.pp_lift @@ region) ] in error ~data title message + + let corner_case description = + let title () = "corner case" in + let message () = description in + error title message + end open Errors @@ -165,7 +183,7 @@ let rec patterns_to_typed_vars : Raw.pattern nseq -> _ = fun ps -> | Raw.PVar _ -> bind_list [pattern_to_typed_var pattern] | other -> (fail @@ wrong_pattern "bla bla" other) end - | hd, tl -> bind_map_list pattern_to_typed_var (nseq_to_list (hd, tl)) + | _ -> fail @@ multiple_patterns "let" (nseq_to_list ps) let rec simpl_type_expression : Raw.type_expr -> type_expression result = fun te -> trace (simple_info "simplifying this type expression...") @@ @@ -275,7 +293,12 @@ let rec simpl_expression : in ok (var_expr, ty_expr_opt) in let%bind prep_vars = bind_list (List.map prepare_variable variables) in - let rec chain_let_in variables body : _ = + let%bind () = + if (List.length prep_vars) = 0 + then fail @@ corner_case "let ... in without variables passed parsing stage" + else ok () + in + let rec chain_let_in variables body : expression = match variables with | hd :: [] -> if (List.length prep_vars = 1) @@ -285,7 +308,7 @@ let rec simpl_expression : e_let_in hd (e_accessor rhs' [Access_tuple ((List.length prep_vars) - (List.length tl) - 1)]) (chain_let_in tl body) - | [] -> body (* Make this an error *) + | [] -> body (* Precluded by corner case assertion above *) in ok (chain_let_in prep_vars body) | Raw.EAnnot a -> let Raw.{inside=expr, _, type_expr; _}, loc = r_split a in diff --git a/src/test/contracts/let_in_multi_bind.mligo b/src/test/contracts/let_in_multi_bind.mligo index 5555b7ae1..e61dc14a7 100644 --- a/src/test/contracts/let_in_multi_bind.mligo +++ b/src/test/contracts/let_in_multi_bind.mligo @@ -1,2 +1,5 @@ let sum (p: int * int) : int = let i, result = p in i + result + +let sum2 (p: string * string * string * string) : int = + let a, b, c, d = p in a ^ b ^ c ^ d diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index d0931a3cf..f6b58f237 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -1797,7 +1797,14 @@ let type_tuple_destruct () : unit result = let let_in_multi_bind () : unit result = let%bind program = mtype_file "./contracts/let_in_multi_bind.mligo" in - let%bind () = expect_eq program "sum" (e_tuple [e_int 10; e_int 10]) (e_int 20) + let%bind () = expect_eq program "sum" (e_tuple [e_int 10; e_int 10]) (e_int 20) in + let%bind () = expect_eq program "sum2" + (e_tuple + [e_string "my" ; + e_string "name" ; + e_string "is" ; + e_string "bob" ]) + (e_string "mynameisbob") in ok () let main = test_suite "Integration (End to End)" [