diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 92250a149..0a6fe63d3 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -247,7 +247,9 @@ module Errors = struct let pattern_loc = Raw.pattern_to_region p in let data = [ ("pattern_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) + fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) ; + ("pattern", + fun () -> Format.asprintf "%a" (Simple_utils.PP_helpers.printer Parser.Pascaligo.ParserLog.print_pattern) p) ; ] in error ~data title message @@ -914,7 +916,6 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - | p -> fail @@ unsupported_non_var_pattern p in let get_tuple (t: Raw.pattern) = match t with - | PCons v -> npseq_to_list v.value | PTuple v -> npseq_to_list v.value.inside | x -> [ x ] in let get_single (t: Raw.pattern) = @@ -923,6 +924,15 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - trace_strong (unsupported_tuple_pattern t) @@ Assert.assert_list_size t' 1 in ok (List.hd t') in + let get_toplevel (t : Raw.pattern) = + match t with + | PCons x -> ( + let (x' , lst) = x.value in + match lst with + | [] -> ok x' + | _ -> ok t + ) + | _ -> fail @@ corner_case ~loc:__LOC__ "unexpected pattern" in let get_constr (t: Raw.pattern) = match t with | PConstr v -> ( @@ -943,10 +953,8 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - | _ -> fail @@ only_constructors t in let%bind patterns = let aux (x , y) = - let xs = get_tuple x in - trace_strong (unsupported_tuple_pattern x) @@ - Assert.assert_list_size xs 1 >>? fun () -> - ok (List.hd xs , y) + let%bind x' = get_toplevel x in + ok (x' , y) in bind_map_list aux t in match patterns with | [(PFalse _ , f) ; (PTrue _ , t)] diff --git a/src/test/contracts/list.mligo b/src/test/contracts/list.mligo index 31e2f7d50..34450fde8 100644 --- a/src/test/contracts/list.mligo +++ b/src/test/contracts/list.mligo @@ -2,6 +2,10 @@ type storage = int * int list type param = int list +let x : int list = [] +let y : int list = [ 3 ; 4 ; 5 ] +let z : int list = 2 :: y + let%entry main (p : param) storage = let storage = match p with diff --git a/src/test/contracts/match.ligo b/src/test/contracts/match.ligo index ff5e3a0a4..cddde26c0 100644 --- a/src/test/contracts/match.ligo +++ b/src/test/contracts/match.ligo @@ -29,3 +29,10 @@ function match_expr_option (const o : option(int)) : int is | None -> 42 | Some (s) -> s end + +function match_expr_list (const l : list(int)) : int is + begin skip end with + case l of + | nil -> -1 + | hd # tl -> hd + end diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e7030bc1f..9215b5a5c 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -517,6 +517,13 @@ let matching () : unit result = bind_iter_list aux [Some 0 ; Some 2 ; Some 42 ; Some 163 ; Some (-1) ; None] in + let%bind () = + let aux lst = e_annotation (e_list @@ List.map e_int lst) (t_list t_int) in + let%bind () = expect_eq program "match_expr_list" (aux [ 14 ; 2 ; 3 ]) (e_int 14) in + let%bind () = expect_eq program "match_expr_list" (aux [ 13 ; 2 ; 3 ]) (e_int 13) in + let%bind () = expect_eq program "match_expr_list" (aux []) (e_int (-1)) in + ok () + in ok () let declarations () : unit result = @@ -635,13 +642,20 @@ let match_matej () : unit result = let mligo_list () : unit result = let%bind program = mtype_file "./contracts/list.mligo" in - let make_input n = - e_pair (e_list [e_int n; e_int (2*n)]) - (e_pair (e_int 3) (e_list [e_int 8])) in - let make_expected n = - e_pair (e_typed_list [] t_operation) - (e_pair (e_int (n+3)) (e_list [e_int (2*n)])) - in expect_eq_n program "main" make_input make_expected + let%bind () = + let make_input n = + e_pair (e_list [e_int n; e_int (2*n)]) + (e_pair (e_int 3) (e_list [e_int 8])) in + let make_expected n = + e_pair (e_typed_list [] t_operation) + (e_pair (e_int (n+3)) (e_list [e_int (2*n)])) + in + expect_eq_n program "main" make_input make_expected + in + let%bind () = expect_eq_evaluate program "x" (e_list []) in + let%bind () = expect_eq_evaluate program "y" (e_list @@ List.map e_int [3 ; 4 ; 5]) in + let%bind () = expect_eq_evaluate program "z" (e_list @@ List.map e_int [2 ; 3 ; 4 ; 5]) in + ok () let lambda_mligo () : unit result = let%bind program = mtype_file "./contracts/lambda.mligo" in