Tomato: stop trying to be smart about tuples

Removed Elimtuples module.

compiler/minils/transformations/elimtuples.ml

@@ -1,66 +0,0 @@
-(**************************************************************************)
-(*                                                                        *)
-(*  Heptagon                                                              *)
-(*                                                                        *)
-(*  Author : Marc Pouzet                                                  *)
-(*  Organization : Demons, LRI, University of Paris-Sud, Orsay            *)
-(*                                                                        *)
-(**************************************************************************)
-
-(* This module removes tuple-patterns when possible.
-
-   (x, y) = if b then (1, 2) else (3, 4);
-   ->
-   x = if b then 1 else 3;
-   y = if b then 2 else 4;
-
-   However, if f() is a function/node returning multiple values, the following
-   equation stay the same:
-
-   (x, y) = if b then (1, 2) else f(arg);
-*)
-
-open Misc
-open Names
-open Idents
-open Signature
-open Minils
-open Mls_utils
-open Mls_printer
-open Types
-open Clocks
-open Pp_tools
-
-(* raised when a multi-valued call is found *)
-exception Call
-
-(* never leaves the scope of a precise pattern, i.e. [e_list] never changes type
-   during subsequent recursive calls. *)
-let rec control e_list =
-  let exp e e_list = match e.e_desc with
-    | Eapp ({ a_op = Efun _ | Enode _; }, _, _) -> raise Call
-    | Eapp ({ a_op = Etuple; }, arg_list, _) -> arg_list @ e_list
-    | Econst { se_desc = Stuple arg_list; } ->
-        List.map (fun se -> mk_exp ~ty:se.se_ty (Econst se)) arg_list
-    | Eapp ({ a_op = Eifthenelse; } as op, [c; t; e], rst) ->
-        let t_children = control [t]
-        and e_children = control [e] in
-        let add_condition t e =
-          mk_exp ~ty:t.e_ty (Eapp (op, [c; t; e], rst)) in
-        List.map2 add_condition t_children e_children
-    | _ -> e :: e_list in
-  List.fold_right exp e_list []
-
-let rec eq equ eq_list = match equ.eq_lhs with
-  | Evarpat _ -> equ :: eq_list
-  | Etuplepat pat_list ->
-      try
-        let new_eqs = List.map2 mk_equation pat_list (control [equ.eq_rhs]) in
-        List.fold_right eq new_eqs eq_list
-      with Call -> equ :: eq_list
-
-let node nd =
-  let eq_list = List.fold_right eq nd.n_equs [] in
-  { nd with n_equs = eq_list; }
-
-let program p = { p with p_nodes = List.map node p.p_nodes; }

compiler/minils/transformations/introvars.ml

@@ -123,9 +123,6 @@ let eq eq (eq_list, var_list) =
   intro_vars_pat eq.eq_lhs eq.eq_rhs (eq_list, var_list)
 
 let node nd =
-  let nd = Elimtuples.node nd in
-  debug_do (fun _ ->
-              Format.printf "Detuplized node:@\n%a@." print_node nd);
   let (eq_list, var_list) = List.fold_right eq nd.n_equs ([], nd.n_local) in
   { nd with n_equs = eq_list; n_local = var_list; }
 

compiler/minils/transformations/singletonvars.ml

@@ -112,14 +112,15 @@ let node nd =
   let (eq_list, subst) =
     let add_to_subst eq (eq_list, subst) =
       match (eq.eq_lhs, eq.eq_rhs.e_desc) with
-        | Etuplepat _, Eapp ({ a_op = (Efun _ | Enode _); }, _, _) ->
-            (eq :: eq_list, subst) (* cannot factor out multi-ret fun calls *)
+        (* do not inline tuple patterns  *)
+        | Etuplepat _, _ -> (eq :: eq_list, subst)
         | _ ->
             let id_list = Vars.def [] eq in
             let e_list, rst, unsafe = match eq.eq_rhs.e_desc with
-              | Eapp ({ a_op = Etuple; a_unsafe = unsafe; }, e_list, rst) ->
-                  e_list, rst, unsafe
-              | _ -> [eq.eq_rhs], None, false in
+            (* | Eapp ({ a_op = Etuple; a_unsafe = unsafe; }, e_list, rst)
+               -> *)
+            (*     e_list, rst, unsafe *)
+               | _ -> [eq.eq_rhs], None, false in
 
             (* Walk over variables/exps couples of eq, gathering equations to
                be inlined.

compiler/minils/transformations/tomato.ml

@@ -338,7 +338,7 @@ let factor_classes (env : PatEnv.t) =
           List.fold_right filter_pattern pat_list [] in
 
         match filter_patterns (PatEnv.fold gather env []) with
-          | [] -> Evarpat (Idents.fresh "tom")
+          | [] -> Evarpat (ident_of_int "tom" cl_id)
           | [pat] -> pat
           | pat_list ->
               let concat pat prefix =
@@ -362,7 +362,11 @@ let factor_classes (env : PatEnv.t) =
       let remap ident =
         (* Inputs won't be present in env *)
         try match PatEnv.P.find (Evarpat ident) subst with
-          | Evarpat ident -> ident
+          | Evarpat ident' ->
+              Format.printf "Remapping %a to %a@."
+                print_ident ident
+                print_ident ident';
+              ident'
           | Etuplepat _ -> assert false
         with Not_found -> ident in
       List.map remap children in
@@ -497,7 +501,7 @@ let node nd =
       try
         (List.find (fun vd -> vd.v_ident = id) nd.n_input).v_type
       with Not_found ->
-        Format.printf "Could not find %a@." print_ident id;
+        Format.printf "Could not find input type for %a@." print_ident id;
         assert false in
     reconstruct input_type env in
   let var_list =