heptagon/compiler/minils/transformations/elimtuples.ml
2010-09-30 21:52:32 +02:00

67 lines
2.3 KiB
OCaml

(**************************************************************************)
(* *)
(* 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; }