heptagon/compiler/obc/control.ml

69 lines
2 KiB
OCaml
Raw Normal View History

2010-06-15 10:49:03 +02:00
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
(* control optimisation *)
(* $Id$ *)
open Minils
open Ident
open Misc
2010-07-08 17:17:00 +02:00
open Obc
2010-06-15 10:49:03 +02:00
let var_from_name map x =
begin try
Env.find x map
2010-06-15 10:49:03 +02:00
with
_ -> assert false
end
let rec find c = function
| [] -> raise Not_found
| (c1, s1) :: h ->
if c = c1 then s1, h else let s, h = find c h in s, (c1, s1) :: h
let rec control map ck s =
match ck with
| Cbase | Cvar { contents = Cindex _ } -> s
| Cvar { contents = Clink ck } -> control map ck s
| Con(ck, c, n) ->
2010-07-08 17:17:00 +02:00
let x = var_from_name map n in
control map ck [Acase(mk_exp (Elhs x), [(c, s)])]
2010-06-15 10:49:03 +02:00
2010-07-08 17:17:00 +02:00
let is_deadcode = function
| Aassgn (lhs, e) ->
(match e.e_desc with
| Elhs l -> l = lhs
| _ -> false
)
2010-07-08 17:17:00 +02:00
| Acase (e, []) -> true
| Afor(_, _, _, []) -> true
| _ -> false
2010-06-15 10:49:03 +02:00
2010-07-08 17:17:00 +02:00
let rec joinlist l =
let l = List.filter (fun a -> not (is_deadcode a)) l in
match l with
| [] -> []
| [s1] -> [s1]
| s1::s2::l ->
match s1, s2 with
| Acase(e1, h1),
Acase(e2, h2) when e1.e_desc = e2.e_desc ->
joinlist ((Acase(e1, joinhandlers h1 h2))::l)
| s1, s2 -> s1::(joinlist (s2::l))
2010-06-15 10:49:03 +02:00
and joinhandlers h1 h2 =
match h1 with
| [] -> h2
| (c1, s1) :: h1' ->
let s1', h2' =
2010-07-08 17:17:00 +02:00
try let s2, h2'' = find c1 h2 in s1@s2, h2''
with Not_found -> s1, h2 in
(c1, joinlist s1') :: joinhandlers h1' h2'