From 5c8e1a47fed42dfd7de0f827aba50be811222cc5 Mon Sep 17 00:00:00 2001 From: Adrien Guatto Date: Wed, 10 Nov 2010 15:32:59 +0100 Subject: [PATCH] Tomato: stop trying to be smart about tuples Removed Elimtuples module. --- compiler/minils/transformations/elimtuples.ml | 66 ------------------- compiler/minils/transformations/introvars.ml | 3 - .../minils/transformations/singletonvars.ml | 11 ++-- compiler/minils/transformations/tomato.ml | 10 ++- 4 files changed, 13 insertions(+), 77 deletions(-) delete mode 100644 compiler/minils/transformations/elimtuples.ml diff --git a/compiler/minils/transformations/elimtuples.ml b/compiler/minils/transformations/elimtuples.ml deleted file mode 100644 index 20dc371..0000000 --- a/compiler/minils/transformations/elimtuples.ml +++ /dev/null @@ -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; } diff --git a/compiler/minils/transformations/introvars.ml b/compiler/minils/transformations/introvars.ml index 9019240..f48fb08 100644 --- a/compiler/minils/transformations/introvars.ml +++ b/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; } diff --git a/compiler/minils/transformations/singletonvars.ml b/compiler/minils/transformations/singletonvars.ml index fb547e5..deb22d3 100644 --- a/compiler/minils/transformations/singletonvars.ml +++ b/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. diff --git a/compiler/minils/transformations/tomato.ml b/compiler/minils/transformations/tomato.ml index f57794c..1e2e283 100644 --- a/compiler/minils/transformations/tomato.ml +++ b/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 =