Add new matching cases and fix compilation of match_tuples

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -960,7 +960,7 @@ and compile_declaration : Raw.declaration -> declaration Location.wrap list resu
       ok @@ [loc x @@ (Declaration_constant (Var.of_name var.value , lhs_type , inline, rhs'))]
     )
 
-and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_content result =
+and compile_cases : (Raw.pattern * expression) list -> matching_expr result =
   fun t ->
   let open Raw in
   let rec get_var (t:Raw.pattern) =
@@ -1031,7 +1031,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
   match patterns with
   | [(PFalse _, f) ; (PTrue _, t)]
   | [(PTrue _, t) ; (PFalse _, f)] ->
-      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
+      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)])
   | [(PList (PCons c), cons); (PList (PListComp sugar_nil), nil)]
   | [(PList (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
       let%bind () =
@@ -1044,7 +1044,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
         let%bind a = get_var a in
         let%bind b = get_var b in
         ok (a, b) in
-      ok @@ Match_list {match_cons=(Var.of_name a, Var.of_name b, cons, ()); match_nil=nil}
+      ok @@ Match_list {match_cons=(Var.of_name a, Var.of_name b, cons); match_nil=nil}
   | lst ->
       let error x =
         let title () = "Pattern" in
@@ -1075,7 +1075,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
         | [ (("None", None), none_expr);
             (("Some", Some some_var), some_expr) ] ->
            ok @@ Match_option {
-                    match_some = (Var.of_name some_var, some_expr, ());
+                    match_some = (Var.of_name some_var, some_expr);
                     match_none = none_expr }
         | _ -> simple_fail "bad option pattern"
       in bind_or (as_option () , as_variant ())

src/passes/02-concrete_to_imperative/pascaligo.ml

@@ -1059,14 +1059,14 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
   match patterns with
   | [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
   | [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
-      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
+      ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)])
   | [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
   | [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
       let (_, v) = v.value in
       let%bind v = match v.value.inside with
         | PVar v -> ok v.value
         | p -> fail @@ unsupported_deep_Some_patterns p in
-      ok @@ Match_option {match_none = none ; match_some = (Var.of_name v, some, ()) }
+      ok @@ Match_option {match_none = none ; match_some = (Var.of_name v, some) }
     )
   | [(PList PCons c, cons) ; (PList (PNil _), nil)]
   | [(PList (PNil _), nil) ; (PList PCons c, cons)] ->
@@ -1079,7 +1079,7 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
         | _ -> fail @@ unsupported_deep_list_patterns c
 
       in
-      ok @@ Match_list {match_cons = (Var.of_name a, Var.of_name b, cons,()) ; match_nil = nil}
+      ok @@ Match_list {match_cons = (Var.of_name a, Var.of_name b, cons) ; match_nil = nil}
   | lst ->
       trace (simple_info "currently, only booleans, options, lists and \
                          user-defined constructors are supported in patterns") @@

src/passes/03-self_ast_imperative/helpers.ml

@@ -114,31 +114,37 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       let%bind res = self res body in
       ok res  
 
-     
-
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init match_nil in
-      let%bind res = fold_expression f res cons in
-      ok res
-    )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
-      let%bind res = fold_expression f init match_none in
-      let%bind res = fold_expression f res some in
-      ok res
-    )
-  | Match_tuple ((_ , e), _) -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
       let%bind res = bind_fold_list aux init lst in
       ok res
     )
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
+      let%bind res = fold_expression f init match_nil in
+      let%bind res = fold_expression f res cons in
+      ok res
+    )
+  | Match_option { match_none ; match_some = (_ , some) } -> (
+      let%bind res = fold_expression f init match_none in
+      let%bind res = fold_expression f res some in
+      ok res
+    )
+  | Match_record (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_tuple (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_variable (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
 
 type exp_mapper = expression -> expression result
 type ty_exp_mapper = type_expression -> type_expression result
@@ -284,27 +290,35 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind match_nil = map_expression f match_nil in
-      let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind match_none = map_expression f match_none in
-      let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind match_nil = map_expression f match_nil in
+      let%bind cons = map_expression f cons in
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind match_none = map_expression f match_none in
+      let%bind some = map_expression f some in
+      ok @@ Match_option { match_none ; match_some = (name , some) }
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_record (names, ty_opt, e')
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_tuple (names, ty_opt, e')
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_variable (name, ty_opt, e')
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -440,25 +454,33 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind (init, match_nil) = fold_map_expression f init match_nil in
-      let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind (init, match_none) = fold_map_expression f init match_none in
-      let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind (init, match_nil) = fold_map_expression f init match_nil in
+      let%bind (init, cons) = fold_map_expression f init cons in
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind (init, match_none) = fold_map_expression f init match_none in
+      let%bind (init, some) = fold_map_expression f init some in
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_record (names, ty_opt, e'))
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_tuple (names, ty_opt, e'))
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_variable (name, ty_opt, e'))
     )

src/passes/04-imperative_to_sugar/imperative_to_sugar.ml

@@ -365,7 +365,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
   match cases with 
     | I.Match_option {match_none;match_some} ->
       let%bind match_none' = compile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr' = compile_expression expr in
       let env = Var.fresh () in
       let%bind ((_,free_vars_none), match_none) = repair_mutable_variable_in_matching match_none' [] env in
@@ -374,7 +374,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let expr       = add_to_end expr (O.e_variable env) in
       let free_vars = List.sort_uniq Var.compare @@ free_vars_none @ free_vars_some in
       if (List.length free_vars != 0) then
-        let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr,tv)}) in
+        let match_expr  = O.e_matching matchee (O.Match_option {match_none; match_some=(n,expr)}) in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -382,10 +382,10 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       else
-        return @@ O.e_matching ~loc matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr',tv)}
+        return @@ O.e_matching ~loc matchee @@ O.Match_option {match_none=match_none'; match_some=(n,expr')}
     | I.Match_list {match_nil;match_cons} ->
       let%bind match_nil' = compile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr' = compile_expression expr in
       let env = Var.fresh () in
       let%bind ((_,free_vars_nil), match_nil) = repair_mutable_variable_in_matching match_nil' [] env in
@@ -394,7 +394,7 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let expr      = add_to_end expr (O.e_variable env) in
       let free_vars = List.sort_uniq Var.compare @@ free_vars_nil @ free_vars_cons in
       if (List.length free_vars != 0) then
-        let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}) in
+        let match_expr  = O.e_matching matchee (O.Match_list {match_nil; match_cons=(hd,tl,expr)}) in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -402,11 +402,8 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       else
-        return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr',tv)}
+        return @@ O.e_matching ~loc matchee @@ O.Match_list {match_nil=match_nil'; match_cons=(hd,tl,expr')}
-    | I.Match_tuple ((lst,expr), tv) ->
+    | I.Match_variant lst ->
-      let%bind expr = compile_expression expr in
-      return @@ O.e_matching ~loc matchee @@ O.Match_tuple ((lst,expr), tv)
-    | I.Match_variant (lst,tv) ->
       let env = Var.fresh () in
       let aux fv ((c,n),expr) =
         let%bind expr = compile_expression expr in
@@ -418,10 +415,10 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
       let free_vars = List.sort_uniq Var.compare @@ List.concat fv in
       if (List.length free_vars == 0) then (
         let cases = List.map (fun case -> let (a,_,b) = case in (a,b)) cases in
-        return @@ O.e_matching ~loc matchee @@ O.Match_variant (cases,tv)
+        return @@ O.e_matching ~loc matchee @@ O.Match_variant cases
       ) else (
         let cases = List.map (fun case -> let (a,b,_) = case in (a,b)) cases in
-        let match_expr = O.e_matching matchee @@ O.Match_variant (cases,tv) in
+        let match_expr = O.e_matching matchee @@ O.Match_variant cases in
         let return_expr = fun expr ->
           O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
           O.e_let_in (env,None) false false match_expr @@
@@ -429,6 +426,18 @@ and compile_matching : I.matching -> Location.t -> (O.expression option -> O.exp
         in
         ok @@ restore_mutable_variable return_expr free_vars env
       )
+    | I.Match_record (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list compile_type_expression) ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_record (lst,ty_opt,expr)
+    | I.Match_tuple (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option (bind_map_list compile_type_expression) ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_tuple (lst,ty_opt,expr)
+    | I.Match_variable (lst,ty_opt,expr) ->
+      let%bind expr = compile_expression expr in
+      let%bind ty_opt = bind_map_option compile_type_expression ty_opt in
+      return @@ O.e_matching ~loc matchee @@ O.Match_variable (lst,ty_opt,expr)
  
 and compile_while I.{condition;body} =
   let env_rec = Var.fresh () in
@@ -707,22 +716,31 @@ and uncompile_matching : O.matching_expr -> I.matching_expr result =
   match m with 
     | O.Match_list {match_nil;match_cons} ->
       let%bind match_nil = uncompile_expression' match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr = uncompile_expression' expr in
-      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | O.Match_option {match_none;match_some} ->
       let%bind match_none = uncompile_expression' match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr = uncompile_expression' expr in
-      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ I.Match_option {match_none; match_some=(n,expr)}
-    | O.Match_tuple ((lst,expr), tv) ->
+    | O.Match_variant lst ->
-      let%bind expr = uncompile_expression' expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | O.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
           let%bind expr = uncompile_expression' expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ I.Match_variant (lst,tv)
+      ok @@ I.Match_variant lst
+    | O.Match_record (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression' expr in
+      let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in
+      ok @@ I.Match_record (lst,ty_opt,expr)
+    | O.Match_tuple (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression' expr in
+      let%bind ty_opt = bind_map_option (bind_map_list uncompile_type_expression) ty_opt in
+      ok @@ I.Match_tuple (lst,ty_opt,expr)
+    | O.Match_variable (lst,ty_opt,expr) ->
+      let%bind expr = uncompile_expression' expr in
+      let%bind ty_opt = bind_map_option uncompile_type_expression ty_opt in
+      ok @@ I.Match_variable (lst,ty_opt,expr)

src/passes/05-self_ast_sugar/helpers.ml

@@ -100,30 +100,37 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
      ok res
     )
      
-
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init match_nil in
-      let%bind res = fold_expression f res cons in
-      ok res
-    )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
-      let%bind res = fold_expression f init match_none in
-      let%bind res = fold_expression f res some in
-      ok res
-    )
-  | Match_tuple ((_ , e), _) -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
       let%bind res = bind_fold_list aux init lst in
       ok res
     )
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
+      let%bind res = fold_expression f init match_nil in
+      let%bind res = fold_expression f res cons in
+      ok res
+    )
+  | Match_option { match_none ; match_some = (_ , some) } -> (
+      let%bind res = fold_expression f init match_none in
+      let%bind res = fold_expression f res some in
+      ok res
+    )
+  | Match_record (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_tuple (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
+  | Match_variable (_, _, e) -> (
+      let%bind res = fold_expression f init e in
+      ok res
+    )
 
 type exp_mapper = expression -> expression result
 type ty_exp_mapper = type_expression -> type_expression result
@@ -250,27 +257,35 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind match_nil = map_expression f match_nil in
-      let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind match_none = map_expression f match_none in
-      let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind match_nil = map_expression f match_nil in
+      let%bind cons = map_expression f cons in
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind match_none = map_expression f match_none in
+      let%bind some = map_expression f some in
+      ok @@ Match_option { match_none ; match_some = (name , some) }
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_record (names, ty_opt, e')
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_tuple (names, ty_opt, e')
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind e' = map_expression f e in
+      ok @@ Match_variable (name, ty_opt, e')
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -389,28 +404,35 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
       ok (res, return @@ E_sequence {expr1;expr2})
     )
   | E_literal _ | E_variable _ | E_skip as e' -> ok (init', return e')
-
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_variant lst -> (
-      let%bind (init, match_nil) = fold_map_expression f init match_nil in
-      let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
-    )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
-      let%bind (init, match_none) = fold_map_expression f init match_none in
-      let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
-    )
-  | Match_tuple ((names , e), _) -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
+    )
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
+      let%bind (init, match_nil) = fold_map_expression f init match_nil in
+      let%bind (init, cons) = fold_map_expression f init cons in
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
+    )
+  | Match_option { match_none ; match_some = (name , some) } -> (
+      let%bind (init, match_none) = fold_map_expression f init match_none in
+      let%bind (init, some) = fold_map_expression f init some in
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
+    )
+  | Match_record (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_record (names, ty_opt, e'))
+    )
+  | Match_tuple (names, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_tuple (names, ty_opt, e'))
+    )
+  | Match_variable (name, ty_opt, e) -> (
+      let%bind (init, e') = fold_map_expression f init e in
+      ok @@ (init, Match_variable (name, ty_opt, e'))
     )

src/passes/06-sugar_to_core/sugar_to_core.ml

@@ -76,8 +76,7 @@ let rec compile_expression : I.expression -> O.expression result =
       return @@ O.E_constructor {constructor;element}
     | I.E_matching {matchee; cases} ->
       let%bind matchee = compile_expression matchee in
-      let%bind cases   = compile_matching cases in
+      compile_matching e.location matchee cases
-      return @@ O.E_matching {matchee;cases}
     | I.E_record record ->
       let record = I.LMap.to_kv_list record in
       let%bind record = 
@@ -137,7 +136,7 @@ let rec compile_expression : I.expression -> O.expression result =
       let%bind matchee = compile_expression condition in
       let%bind match_true = compile_expression then_clause in
       let%bind match_false = compile_expression else_clause in
-      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)],())}
+      return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)])}
     | I.E_sequence {expr1; expr2} ->
       let%bind expr1 = compile_expression expr1 in
       let%bind expr2 = compile_expression expr2 in
@@ -166,30 +165,64 @@ and compile_lambda : I.lambda -> O.lambda result =
     let%bind output_type = bind_map_option idle_type_expression output_type in
     let%bind result = compile_expression result in
     ok @@ O.{binder;input_type;output_type;result}
-and compile_matching : I.matching_expr -> O.matching_expr result =
+and compile_matching : Location.t -> O.expression -> I.matching_expr -> O.expression result =
-  fun m -> 
+  fun loc e m -> 
   match m with 
     | I.Match_list {match_nil;match_cons} ->
       let%bind match_nil = compile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr = compile_expression expr in
-      ok @@ O.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ O.e_matching ~loc e @@ O.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | I.Match_option {match_none;match_some} ->
       let%bind match_none = compile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr = compile_expression expr in
-      ok @@ O.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ O.e_matching ~loc e @@ O.Match_option {match_none; match_some=(n,expr)}
-    | I.Match_tuple ((lst,expr), tv) ->
+    | I.Match_variant lst ->
-      let%bind expr = compile_expression expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | I.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
           let%bind expr = compile_expression expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ O.Match_variant (lst,tv)
+      ok @@ O.e_matching ~loc e @@ O.Match_variant lst
+    | I.Match_record (fields,field_types, expr) ->
+      let combine fields field_types =
+        match field_types with
+          Some ft -> List.combine fields @@ List.map (fun x -> Some x) ft
+        | None    -> List.map (fun x -> (x, None)) fields
+      in
+      let%bind next   = compile_expression expr in
+      let%bind field_types = bind_map_option (bind_map_list idle_type_expression) field_types in
+      let aux ((index,expr) : int * _ ) ((field,name): (O.label * (O.expression_variable * O.type_expression option))) =
+        let f = fun expr' -> O.e_let_in name false (O.e_record_accessor e field) expr' in
+        (index+1, fun expr' -> expr (f expr'))
+      in
+      let (_,header) = List.fold_left aux (0, fun e -> e) @@
+        List.map (fun ((a,b),c) -> (a,(b,c))) @@
+        combine fields field_types
+      in
+      ok @@ header next
+    | I.Match_tuple (fields,field_types, expr) ->
+      let combine fields field_types =
+        match field_types with
+          Some ft -> List.combine fields @@ List.map (fun x -> Some x) ft
+        | None    -> List.map (fun x -> (x, None)) fields
+      in
+      let%bind next   = compile_expression expr in
+      let%bind field_types = bind_map_option (bind_map_list idle_type_expression) field_types in
+      let aux ((index,expr) : int * _ ) (field: O.expression_variable * O.type_expression option) =
+        let f = fun expr' -> O.e_let_in field false (O.e_record_accessor e (Label (string_of_int index))) expr' in
+        (index+1, fun expr' -> expr (f expr'))
+      in
+      let (_,header) = List.fold_left aux (0, fun e -> e) @@
+        combine fields field_types
+      in
+      ok @@ header next
+    | I.Match_variable (a, ty_opt, expr) ->
+      let%bind ty_opt = bind_map_option idle_type_expression ty_opt in
+      let%bind expr = compile_expression expr in
+      ok @@ O.e_let_in (a,ty_opt) false e expr
  
 let compile_declaration : I.declaration Location.wrap -> _ =
   fun {wrap_content=declaration;location} ->
@@ -313,22 +346,19 @@ and uncompile_matching : O.matching_expr -> I.matching_expr result =
   match m with 
     | O.Match_list {match_nil;match_cons} ->
       let%bind match_nil = uncompile_expression match_nil in
-      let (hd,tl,expr,tv) = match_cons in
+      let (hd,tl,expr) = match_cons in
       let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr,tv)}
+      ok @@ I.Match_list {match_nil; match_cons=(hd,tl,expr)}
     | O.Match_option {match_none;match_some} ->
       let%bind match_none = uncompile_expression match_none in
-      let (n,expr,tv) = match_some in
+      let (n,expr) = match_some in
       let%bind expr = uncompile_expression expr in
-      ok @@ I.Match_option {match_none; match_some=(n,expr,tv)}
+      ok @@ I.Match_option {match_none; match_some=(n,expr)}
-    | O.Match_tuple ((lst,expr), tv) ->
+    | O.Match_variant lst ->
-      let%bind expr = uncompile_expression expr in
-      ok @@ O.Match_tuple ((lst,expr), tv)
-    | O.Match_variant (lst,tv) ->
       let%bind lst = bind_map_list (
         fun ((c,n),expr) ->
           let%bind expr = uncompile_expression expr in
           ok @@ ((c,n),expr)
       ) lst 
       in
-      ok @@ I.Match_variant (lst,tv)
+      ok @@ I.Match_variant lst

src/passes/07-self_ast_core/helpers.ml

@@ -72,21 +72,17 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
 
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (_ , _ , cons) } -> (
       let%bind res = fold_expression f init match_nil in
       let%bind res = fold_expression f res cons in
       ok res
     )
-  | Match_option { match_none ; match_some = (_ , some, _) } -> (
+  | Match_option { match_none ; match_some = (_ , some) } -> (
       let%bind res = fold_expression f init match_none in
       let%bind res = fold_expression f res some in
       ok res
     )
-  | Match_tuple ((_ , e), _) -> (
+  | Match_variant lst -> (
-      let%bind res = fold_expression f init e in
-      ok res
-    )
-  | Match_variant (lst, _) -> (
       let aux init' ((_ , _) , e) =
         let%bind res' = fold_expression f init' e in
         ok res' in
@@ -174,27 +170,23 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
 
 and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
       let%bind match_nil = map_expression f match_nil in
       let%bind cons = map_expression f cons in
-      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons, ()) }
+      ok @@ Match_list { match_nil ; match_cons = (hd , tl , cons) }
     )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
+  | Match_option { match_none ; match_some = (name , some) } -> (
       let%bind match_none = map_expression f match_none in
       let%bind some = map_expression f some in
-      ok @@ Match_option { match_none ; match_some = (name , some, ()) }
+      ok @@ Match_option { match_none ; match_some = (name , some) }
     )
-  | Match_tuple ((names , e), _) -> (
+  | Match_variant lst -> (
-      let%bind e' = map_expression f e in
-      ok @@ Match_tuple ((names , e'), [])
-    )
-  | Match_variant (lst, _) -> (
       let aux ((a , b) , e) =
         let%bind e' = map_expression f e in
         ok ((a , b) , e')
       in
       let%bind lst' = bind_map_list aux lst in
-      ok @@ Match_variant (lst', ())
+      ok @@ Match_variant lst'
     )
 
 and map_program : abs_mapper -> program -> program result = fun m p ->
@@ -274,25 +266,21 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
 
 and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
   match m with
-  | Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
+  | Match_list { match_nil ; match_cons = (hd , tl , cons) } -> (
       let%bind (init, match_nil) = fold_map_expression f init match_nil in
       let%bind (init, cons) = fold_map_expression f init cons in
-      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons, ()) })
+      ok @@ (init, Match_list { match_nil ; match_cons = (hd , tl , cons) })
     )
-  | Match_option { match_none ; match_some = (name , some, _) } -> (
+  | Match_option { match_none ; match_some = (name , some) } -> (
       let%bind (init, match_none) = fold_map_expression f init match_none in
       let%bind (init, some) = fold_map_expression f init some in
-      ok @@ (init, Match_option { match_none ; match_some = (name , some, ()) })
+      ok @@ (init, Match_option { match_none ; match_some = (name , some) })
     )
-  | Match_tuple ((names , e), _) -> (
+  | Match_variant lst -> (
-      let%bind (init, e') = fold_map_expression f init e in
-      ok @@ (init, Match_tuple ((names , e'), []))
-    )
-  | Match_variant (lst, _) -> (
       let aux init ((a , b) , e) =
         let%bind (init,e') = fold_map_expression f init e in
         ok (init, ((a , b) , e'))
       in
       let%bind (init,lst') = bind_fold_map_list aux init lst in
-      ok @@ (init, Match_variant (lst', ()))
+      ok @@ (init, Match_variant lst')
     )  

src/passes/08-typer-new/todo_use_fold_generator.ml

@@ -3,6 +3,7 @@ module O = Ast_typed
 
 let convert_constructor' (I.Constructor c) = O.Constructor c
 let convert_label (I.Label c) = O.Label c
+
 let convert_type_constant : I.type_constant -> O.type_constant = function
     | TC_unit -> TC_unit
     | TC_string -> TC_string

src/passes/08-typer-new/typer.ml

@@ -40,7 +40,7 @@ and type_match : environment -> O'.typer_state -> O.type_expression -> I.matchin
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_option t in
       let%bind (match_none , state') = type_expression e state match_none in
-      let (opt, b, _) = match_some in
+      let (opt, b) = match_some in
       let e' = Environment.add_ez_binder opt tv e in
       let%bind (body , state'') = type_expression e' state' b in
       ok (O.Match_option {match_none ; match_some = { opt; body; tv}} , state'')
@@ -49,23 +49,12 @@ and type_match : environment -> O'.typer_state -> O.type_expression -> I.matchin
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_list t in
       let%bind (match_nil , state') = type_expression e state match_nil in
-      let (hd, tl, b, _) = match_cons in
+      let (hd, tl, b) = match_cons in
       let e' = Environment.add_ez_binder hd t_elt e in
       let e' = Environment.add_ez_binder tl t e' in
       let%bind (body , state'') = type_expression e' state' b in
       ok (O.Match_list {match_nil ; match_cons = {hd; tl; body;tv=t}} , state'')
-    | Match_tuple ((vars, b),_) ->
+    | Match_variant lst ->
-      let%bind tvs =
-        trace_strong (match_error ~expected:i ~actual:t loc)
-        @@ get_t_tuple t in
-      let%bind lst' =
-        generic_try (match_tuple_wrong_arity tvs vars loc)
-        @@ (fun () -> List.combine vars tvs) in
-      let aux prev (name, tv) = Environment.add_ez_binder name tv prev in
-      let e' = List.fold_left aux e lst' in
-      let%bind (body , state') = type_expression e' state b in
-      ok (O.Match_tuple {vars ; body ; tvs} , state')
-    | Match_variant (lst,_) ->
       let%bind variant_opt =
         let aux acc ((constructor_name , _) , _) =
           let%bind (_ , variant) =
@@ -362,7 +351,6 @@ and type_expression : environment -> O'.typer_state -> ?tv_opt:O.type_expression
           match cur with
           | Match_list { match_nil ; match_cons = { hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
           | Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
-          | Match_tuple { vars=_ ; body ; tvs=_ } -> [ body ]
           | Match_variant { cases ; tv=_ } -> List.map (fun ({constructor=_; pattern=_; body} : O.matching_content_case) -> body) cases in
         List.map get_type_expression @@ aux m' in
       let%bind () = match tvs with

src/passes/08-typer-new/untyper.ml

@@ -264,8 +264,8 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
     return (e_record @@ LMap.of_list r')
   | E_record_accessor {record; path} ->
     let%bind r' = untype_expression record in
-    let Label s = path in
+    let Label path = path in
-    return (e_record_accessor r' s)
+    return (e_record_accessor r' (Label path))
   | E_record_update {record; path; update} ->
     let%bind r' = untype_expression record in
     let%bind e = untype_expression update in 
@@ -299,22 +299,19 @@ and untype_lambda ty {binder; result} : I.lambda result =
 and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
   let open I in
   match m with
-  | Match_tuple { vars ; body ; tvs=_ } ->
-      let%bind b = f body in
-      ok @@ I.Match_tuple ((vars, b),[])
   | Match_option {match_none ; match_some = {opt; body;tv=_}} ->
       let%bind match_none = f match_none in
       let%bind some = f body in
-      let match_some = opt, some, () in
+      let match_some = opt, some in
       ok @@ Match_option {match_none ; match_some}
   | Match_list {match_nil ; match_cons = {hd;tl;body;tv=_}} ->
       let%bind match_nil = f match_nil in
       let%bind cons = f body in
-      let match_cons = hd , tl , cons, () in
+      let match_cons = hd , tl , cons in
       ok @@ Match_list {match_nil ; match_cons}
   | Match_variant { cases ; tv=_ } ->
       let aux ({constructor;pattern;body} : O.matching_content_case) =
         let%bind body = f body in
         ok ((unconvert_constructor' constructor,pattern),body) in
       let%bind lst' = bind_map_list aux cases in
-      ok @@ Match_variant (lst',())
+      ok @@ Match_variant lst'

src/passes/08-typer-old/typer.ml

@@ -125,17 +125,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-
-  let match_tuple_wrong_arity (expected:'a list) (actual:'b list) (loc:Location.t) () =
-    let title () = "matching tuple of different size" in
-    let message () = "" in
-    let data = [
-      ("expected" , fun () -> Format.asprintf "%d" (List.length expected)) ;
-      ("actual" , fun () -> Format.asprintf "%d" (List.length actual)) ;
-      ("location" , fun () -> Format.asprintf "%a" Location.pp loc)
-    ] in
-    error ~data title message ()
-
   (* TODO: this should be a trace_info? *)
   let program_error (p:I.program) () =
     let message () = "" in
@@ -528,7 +517,7 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_option t in
       let%bind match_none = f e match_none in
-      let (opt, b,_) = match_some in
+      let (opt, b) = match_some in
       let e' = Environment.add_ez_binder opt tv e in
       let%bind body = f e' b in
       ok (O.Match_option {match_none ; match_some = {opt; body; tv}})
@@ -537,23 +526,12 @@ and type_match : (environment -> I.expression -> O.expression result) -> environ
         trace_strong (match_error ~expected:i ~actual:t loc)
         @@ get_t_list t in
       let%bind match_nil = f e match_nil in
-      let (hd, tl, b,_) = match_cons in
+      let (hd, tl, b) = match_cons in
       let e' = Environment.add_ez_binder hd t_elt e in
       let e' = Environment.add_ez_binder tl t e' in
       let%bind body = f e' b in
       ok (O.Match_list {match_nil ; match_cons = {hd; tl; body; tv=t_elt}})
-  | Match_tuple ((vars, b),_) ->
+  | Match_variant lst ->
-      let%bind tvs =
-        trace_strong (match_error ~expected:i ~actual:t loc)
-        @@ get_t_tuple t in
-      let%bind vars' =
-        generic_try (match_tuple_wrong_arity tvs vars loc)
-        @@ (fun () -> List.combine vars tvs) in
-      let aux prev (name, tv) = Environment.add_ez_binder name tv prev in
-      let e' = List.fold_left aux e vars' in
-      let%bind body = f e' b in
-      ok (O.Match_tuple { vars ; body ; tvs})
-  | Match_variant (lst,_) ->
       let%bind variant_cases' =
         trace (match_error ~expected:i ~actual:t loc)
         @@ Ast_typed.Combinators.get_t_sum t in
@@ -937,7 +915,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
           match cur with
           | Match_list { match_nil ; match_cons = {hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
           | Match_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; body ]
-          | Match_tuple {vars=_;body;tvs=_} -> [ body ]
           | Match_variant {cases; tv=_} -> List.map (fun (c : O.matching_content_case) -> c.body) cases in
         List.map get_type_expression @@ aux m' in
       let aux prec cur =
@@ -1081,7 +1058,7 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
   | E_record_accessor {record; path} ->
       let%bind r' = untype_expression record in
       let Label s = path in
-      return (e_record_accessor r' s)
+      return (e_record_accessor r' (Label s))
   | E_record_update {record=r; path=O.Label l; update=e} ->
     let%bind r' = untype_expression r in
     let%bind e = untype_expression e in 
@@ -1104,22 +1081,19 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
 and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
   let open I in
   match m with
-  | Match_tuple {vars; body;tvs=_} ->
-      let%bind b = f body in
-      ok @@ I.Match_tuple ((vars, b),[])
   | Match_option {match_none ; match_some = {opt; body ; tv=_}} ->
       let%bind match_none = f match_none in
       let%bind some = f body in
-      let match_some = opt, some, () in
+      let match_some = opt, some in
       ok @@ Match_option {match_none ; match_some}
   | Match_list {match_nil ; match_cons = {hd ; tl ; body ; tv=_}} ->
       let%bind match_nil = f match_nil in
       let%bind cons = f body in
-      let match_cons = hd , tl , cons, () in
+      let match_cons = hd , tl , cons in
       ok @@ Match_list {match_nil ; match_cons}
   | Match_variant {cases;tv=_} ->
       let aux ({constructor;pattern;body} : O.matching_content_case) =
         let%bind c' = f body in
         ok ((unconvert_constructor' constructor,pattern),c') in
       let%bind lst' = bind_map_list aux cases in
-      ok @@ Match_variant (lst',())
+      ok @@ Match_variant lst'

src/passes/09-self_ast_typed/helpers.ml

@@ -63,10 +63,6 @@ and fold_cases : 'a . 'a folder -> 'a -> matching_expr -> 'a result = fun f init
       let%bind res = fold_expression f res body in
       ok res
     )
-  | Match_tuple {vars=_ ; body; tvs=_} -> (
-      let%bind res = fold_expression f init body in
-      ok res
-    )
   | Match_variant {cases;tv=_} -> (
       let aux init' {constructor=_; pattern=_ ; body} =
         let%bind res' = fold_expression f init' body in
@@ -140,10 +136,6 @@ and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
       let%bind body = map_expression f body in
       ok @@ Match_option { match_none ; match_some = { opt ; body ; tv } }
     )
-  | Match_tuple { vars ; body ; tvs } -> (
-      let%bind body = map_expression f body in
-      ok @@ Match_tuple { vars ; body ; tvs }
-    )
   | Match_variant {cases;tv} -> (
       let aux { constructor ; pattern ; body } =
         let%bind body = map_expression f body in
@@ -231,10 +223,6 @@ and fold_map_cases : 'a . 'a fold_mapper -> 'a -> matching_expr -> ('a * matchin
       let%bind (init, body) = fold_map_expression f init body in
       ok @@ (init, Match_option { match_none ; match_some = { opt ; body ; tv } })
     )
-  | Match_tuple { vars ; body ; tvs } -> (
-      let%bind (init, body) = fold_map_expression f init body in
-      ok @@ (init, Match_tuple {vars ; body ; tvs })
-    )
   | Match_variant {cases ; tv} -> (
       let aux init {constructor ; pattern ; body} =
         let%bind (init, body) = fold_map_expression f init body in

src/passes/09-self_ast_typed/tail_recursion.ml

@@ -67,9 +67,6 @@ and check_recursive_call_in_matching = fun n final_path c ->
     let%bind _ = check_recursive_call n final_path match_none in
     let%bind _ = check_recursive_call n final_path body in
     ok ()
-  | Match_tuple {vars=_;body;tvs=_} ->
-    let%bind _ = check_recursive_call n final_path body in
-    ok ()
   | Match_variant {cases;tv=_} ->
     let aux {constructor=_; pattern=_; body} =
       let%bind _ = check_recursive_call n final_path body in

src/passes/10-transpiler/transpiler.ml

@@ -32,16 +32,6 @@ them. please report this to the developers." in
     let content () = Format.asprintf "%a" Var.pp name in
     error title content
 
-  let row_loc l = ("location" , fun () -> Format.asprintf "%a" Location.pp l)
-
-  let unsupported_pattern_matching kind location =
-    let title () = "unsupported pattern-matching" in
-    let content () = Format.asprintf "%s patterns aren't supported yet" kind in
-    let data = [
-        row_loc location ;
-      ] in
-    error ~data title content
-
   let not_functional_main location =
     let title () = "not functional main" in
     let content () = "main should be a function" in
@@ -615,7 +605,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
           trace_strong (corner_case ~loc:__LOC__ "building constructor") @@
           aux expr' tree''
        )
-      | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location
   )
 
 and transpile_lambda l (input_type , output_type) =
@@ -739,7 +728,6 @@ and transpile_recursive {fun_name; fun_type; lambda} =
           trace_strong (corner_case ~loc:__LOC__ "building constructor") @@
           aux expr tree''
        )
-      | AST.Match_tuple _ -> failwith "match_tuple not supported"
   in
   let%bind fun_type = transpile_type fun_type in
   let%bind (input_type,output_type) = get_t_function fun_type in

src/stages/1-ast_imperative/PP.ml

@@ -184,27 +184,35 @@ and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * ex
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some
+    | Match_tuple (lst, _,b) ->
+        fprintf ppf "(%a) -> %a" (list_sep_d expression_variable) lst f b
+    | Match_record (lst, _,b) ->
+        fprintf ppf "{%a} -> %a" (list_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression_variable b)) lst f b
+    | Match_variable (a, _,b) ->
+        fprintf ppf "%a -> %a" expression_variable a f b
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"
   | Match_option _ ->
       fprintf ppf "option"
+  | Match_tuple _ ->
+      fprintf ppf "tuple"
+  | Match_record _ ->
+      fprintf ppf "record"
+  | Match_variable _ ->
+      fprintf ppf "variable"
 
 and matching_variant_case_type ppf ((c,n),_a) =
   fprintf ppf "| %a %a" constructor c expression_variable n

src/stages/1-ast_imperative/combinators.ml

@@ -148,9 +148,14 @@ let e_bool ?loc   b : expression = e_constructor ?loc (string_of_bool b) (e_unit
 
 let ez_match_variant (lst : ((string * string) * 'a) list) =
   let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
-  Match_variant (lst,())
+  Match_variant lst
 let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) =
   e_matching ?loc a (ez_match_variant lst)
+
+let e_matching_record   ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_record   (lst,ty_opt, expr)
+let e_matching_tuple    ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_tuple    (lst,ty_opt, expr)
+let e_matching_variable ?loc m var ty_opt expr = e_matching ?loc m @@ Match_variable (var,ty_opt, expr)
+
 let e_record_ez ?loc (lst : (string * expr) list) : expression =
   let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
   make_e ?loc @@ E_record map

src/stages/1-ast_imperative/combinators.mli

@@ -98,8 +98,11 @@ val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option
 
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
-val ez_match_variant : ((string * string ) * 'a ) list -> ('a,unit) matching_content
+val ez_match_variant : ((string * string ) * expression) list -> matching_expr
 val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
+val e_matching_record  : ?loc:Location.t -> expression -> (label * expression_variable) list -> type_expression list option -> expression -> expression
+val e_matching_tuple   : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
+val e_matching_variable: ?loc:Location.t -> expression -> expression_variable -> type_expression option -> expression -> expression
 
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
 val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression

src/stages/1-ast_imperative/types.ml

@@ -110,7 +110,20 @@ and record_update   = {record: expression; path: label ; update: expression}
 
 
 
-and matching_expr = (expr,unit) matching_content
+and matching_expr =
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_tuple of expression_variable list * type_expression list option * expression
+  | Match_record of (label * expression_variable) list * type_expression list option * expression
+  | Match_variable of expression_variable * type_expression option * expression
+
 and matching =
   { matchee: expression
   ; cases: matching_expr

src/stages/2-ast_sugar/PP.ml

@@ -150,27 +150,35 @@ and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * ex
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a -> %a" constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "| None -> %a @.| Some %a -> %a" f match_none expression_variable some f match_some
+    | Match_tuple (lst, _,b) ->
+        fprintf ppf "(%a) -> %a" (list_sep_d expression_variable) lst f b
+    | Match_record (lst, _,b) ->
+        fprintf ppf "{%a} -> %a" (list_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression_variable b)) lst f b
+    | Match_variable (a, _,b) ->
+        fprintf ppf "%a -> %a" expression_variable a f b
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"
   | Match_option _ ->
       fprintf ppf "option"
+  | Match_tuple _ ->
+      fprintf ppf "tuple"
+  | Match_record _ ->
+      fprintf ppf "record"
+  | Match_variable _ ->
+      fprintf ppf "variable"
 
 and matching_variant_case_type ppf ((c,n),_a) =
   fprintf ppf "| %a %a" constructor c expression_variable n

src/stages/2-ast_sugar/types.ml

@@ -106,7 +106,20 @@ and constructor = {constructor: constructor'; element: expression}
 and record_accessor = {record: expression; path: label}
 and record_update   = {record: expression; path: label ; update: expression}
 
-and matching_expr = (expr,unit) matching_content
+and matching_expr =
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_tuple of expression_variable list * type_expression list option * expression
+  | Match_record of (label * expression_variable) list * type_expression list option * expression
+  | Match_variable of expression_variable * type_expression option * expression
+
 and matching =
   { matchee: expression
   ; cases: matching_expr

src/stages/3-ast_core/PP.ml

@@ -66,26 +66,22 @@ and assoc_expression ppf : expr * expr -> unit =
 and single_record_patch ppf ((p, expr) : label * expr) =
   fprintf ppf "%a <- %a" label p expression expr
 
-and matching_variant_case : type a . (_ -> a -> unit) -> _ -> (constructor' * expression_variable) * a -> unit =
+and matching_variant_case : (_ -> expression -> unit) -> _ -> (constructor' * expression_variable) * expression -> unit =
   fun f ppf ((c,n),a) ->
   fprintf ppf "| %a %a ->@;<1 2>%a@ " constructor c expression_variable n f a
 
-and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matching_content -> unit =
+and matching : (formatter -> expression -> unit) -> formatter -> matching_expr -> unit =
   fun f ppf m -> match m with
-    | Match_tuple ((lst, b), _) ->
+    | Match_variant lst ->
-        fprintf ppf "@[<hv>| (%a) ->@;<1 2>%a@]" (list_sep_d expression_variable) lst f b
-    | Match_variant (lst, _) ->
         fprintf ppf "@[<hv>%a@]" (list_sep (matching_variant_case f) (tag "@ ")) lst
-    | Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
+    | Match_list {match_nil ; match_cons = (hd, tl, match_cons)} ->
         fprintf ppf "@[<hv>| Nil ->@;<1 2>%a@ | %a :: %a ->@;<1 2>%a@]" f match_nil expression_variable hd expression_variable tl f match_cons
-    | Match_option {match_none ; match_some = (some, match_some, _)} ->
+    | Match_option {match_none ; match_some = (some, match_some)} ->
         fprintf ppf "@[<hv>| None ->@;<1 2>%a@ | Some %a ->@;<1 2>%a@]" f match_none expression_variable some f match_some
 
 (* Shows the type expected for the matched value *)
 and matching_type ppf m = match m with
-  | Match_tuple _ ->
+  | Match_variant lst ->
-      fprintf ppf "tuple"
-  | Match_variant (lst, _) ->
       fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
   | Match_list _ ->
       fprintf ppf "list"

src/stages/3-ast_core/combinators.ml

@@ -107,7 +107,7 @@ let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constru
 let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
 
 let e_record ?loc map = make_e ?loc @@ E_record map
-let e_record_accessor ?loc a b = make_e ?loc @@ E_record_accessor {record = a; path = Label b}
+let e_record_accessor ?loc a b = make_e ?loc @@ E_record_accessor {record = a; path = b}
 let e_record_update ?loc record path update = make_e ?loc @@ E_record_update {record; path; update}
 
 let e_annotation ?loc anno_expr ty = make_e ?loc @@ E_ascription {anno_expr; type_annotation = ty}

src/stages/3-ast_core/combinators.mli

@@ -74,7 +74,7 @@ val e_string_cat : ?loc:Location.t -> expression -> expression -> expression
 val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> expression
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
-val e_record_accessor : ?loc:Location.t -> expression -> string -> expression
+val e_record_accessor : ?loc:Location.t -> expression -> label -> expression
 val e_variable : ?loc:Location.t -> expression_variable -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
 val e_annotation : ?loc:Location.t -> expression -> type_expression -> expression

src/stages/3-ast_core/types.ml

@@ -76,7 +76,17 @@ and constructor = {constructor: constructor'; element: expression}
 and record_accessor = {record: expression; path: label}
 and record_update   = {record: expression; path: label ; update: expression}
 
-and matching_expr = (expr,unit) matching_content
+and matching_expr =
+  | Match_list of {
+      match_nil  : expression ;
+      match_cons : expression_variable * expression_variable * expression ;
+    }
+  | Match_option of {
+      match_none : expression ;
+      match_some : expression_variable * expression ;
+    }
+  | Match_variant of ((constructor' * expression_variable) * expression) list
+
 and matching =
   { matchee: expression
   ; cases: matching_expr

src/stages/4-ast_typed/PP.ml

@@ -315,8 +315,6 @@ and matching_variant_case : (_ -> expression -> unit) -> _ -> matching_content_c
   fprintf ppf "| %a %a -> %a" constructor c expression_variable pattern f body
 
 and matching : (formatter -> expression -> unit) -> _ -> matching_expr -> unit = fun f ppf m -> match m with
-  | Match_tuple {vars; body; tvs=_} ->
-      fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) vars f body
   | Match_variant {cases ; tv=_} ->
       fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) cases
   | Match_list {match_nil ; match_cons = {hd; tl; body; tv=_}} -> 

src/stages/4-ast_typed/ast.ml

@@ -124,12 +124,6 @@ and matching_content_option = {
 and expression_variable_list = expression_variable list
 and type_expression_list = type_expression list
 
-and matching_content_tuple = {
-    vars : expression_variable_list ;
-    body : expression ;
-    tvs : type_expression_list ;
-  }
-
 and matching_content_case = {
     constructor : constructor' ;
     pattern : expression_variable ;
@@ -146,7 +140,6 @@ and matching_content_variant = {
 and matching_expr =
   | Match_list    of matching_content_list
   | Match_option  of matching_content_option
-  | Match_tuple   of matching_content_tuple
   | Match_variant of matching_content_variant
 
 and constant' =

src/stages/4-ast_typed/compute_environment.ml

@@ -92,21 +92,6 @@ and cases : environment -> matching_expr -> matching_expr = fun env cs ->
     in
     return @@ Match_option { match_none ; match_some }
   )
-  | Match_tuple c -> (
-    let var_tvs =
-      try (
-        List.combine c.vars c.tvs
-      ) with _ -> raise (Failure ("Internal error: broken invariant at " ^ __LOC__))
-    in
-    let env' =
-      let aux prev (var , tv) =
-        Environment.add_ez_binder var tv prev
-      in
-      List.fold_left aux env var_tvs
-    in
-    let body = self ~env' c.body in
-    return @@ Match_tuple { c with body }
-  )
   | Match_variant c -> (
     let variant_type = Combinators.get_t_sum_exn c.tv in
     let cases =

src/stages/4-ast_typed/misc.ml

@@ -236,8 +236,6 @@ module Free_variables = struct
     match m with
     | Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } -> union (f b n) (f (union (of_list [hd ; tl]) b) body)
     | Match_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
-    | Match_tuple { vars ; body ; tvs=_ } ->
-       f (union (of_list vars) b) body
     | Match_variant { cases ; tv=_ } -> unions @@ List.map (matching_variant_case f b) cases
 
   and matching_expression = fun x -> matching expression x

src/stages/4-ast_typed/misc_smart.ml

@@ -90,8 +90,6 @@ module Captured_variables = struct
       let%bind n' = f b n in
       let%bind s' = f (union (singleton opt) b) body in
       ok @@ union n' s'
-    | Match_tuple { vars ; body ; tvs=_ } ->
-      f (union (of_list vars) b) body
     | Match_variant { cases ; tv=_ } ->
       let%bind lst' = bind_map_list (matching_variant_case f b) cases in
       ok @@ unions lst'

src/stages/common/ast_common.ml

@@ -1,3 +1,5 @@
+include Types 
+
 module Types = Types
 module PP = PP
 module Helpers = Helpers

src/stages/common/types.ml

@@ -11,6 +11,7 @@ type label = Label of string
 module CMap = Map.Make( struct type t = constructor' let compare (Constructor a) (Constructor b) = compare a b end)
 module LMap = Map.Make( struct type t = label let compare (Label a) (Label b) = String.compare a b end)
 
+
 type 'a label_map = 'a LMap.t
 type 'a constructor_map = 'a CMap.t
 
@@ -169,18 +170,6 @@ type literal =
   | Literal_void
   | Literal_operation of
       Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
-and ('a,'tv) matching_content =
-  | Match_list of {
-      match_nil : 'a ;
-      match_cons : expression_variable * expression_variable * 'a * 'tv;
-    }
-  | Match_option of {
-      match_none : 'a ;
-      match_some : expression_variable * 'a * 'tv;
-    }
-  | Match_tuple of (expression_variable list * 'a) * 'tv list
-  | Match_variant of ((constructor' * expression_variable) * 'a) list * 'tv
-
 and constant' =
   | C_INT
   | C_UNIT