more lists

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)]

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

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

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%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
+    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