From 2d10ef84dff2edc4ec277db2b9e0b7aa0547633a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Fri, 16 Jul 2010 15:30:51 +0200 Subject: [PATCH] Present with Hept_mapfold Seems so simple, I feel like I missed something... --- .../transformations/present_mapfold.ml | 34 +++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 compiler/heptagon/transformations/present_mapfold.ml diff --git a/compiler/heptagon/transformations/present_mapfold.ml b/compiler/heptagon/transformations/present_mapfold.ml new file mode 100644 index 0000000..cb9935b --- /dev/null +++ b/compiler/heptagon/transformations/present_mapfold.ml @@ -0,0 +1,34 @@ +(**************************************************************************) +(* *) +(* Heptagon *) +(* *) +(* Author : Marc Pouzet *) +(* Organization : Demons, LRI, University of Paris-Sud, Orsay *) +(* *) +(**************************************************************************) +(* removing present statements *) +open Heptagon +open Hept_mapfold + +let translate_present_handlers handlers cont = + let translate_present_handler { p_cond = e; p_block = b } cont = + let statefull = b.b_statefull or cont.b_statefull in + mk_block ~statefull:statefull b.b_defnames + [mk_switch_equation + ~statefull:statefull e + [{ w_name = Initial.ptrue; w_block = b }; + { w_name = Initial.pfalse; w_block = cont }]] in + let b = List.fold_right translate_present_handler handlers cont in + (List.hd (b.b_equs)).eq_desc + +let eqdesc funs acc eqd = + let eqd, _ = Hept_mapfold.eqdesc funs acc eqd in + match eqd with + | Epresent(ph, b) -> translate_present_handlers ph b, acc + | _ -> eqd, acc + +let program p = + let funs = { Hept_mapfold.defaults with eqdesc = eqdesc } in + let p, _ = Hept_mapfold.program_it funs false p in + p +