4794045208
I introduced a notion of extended values in Obc expressions, replacing the Epattern constructor. Patterns may now only occur at their rightful place, on the left of an assignment. This change allows to index global constant arrays.
70 lines
2.1 KiB
OCaml
70 lines
2.1 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Heptagon *)
|
|
(* *)
|
|
(* Author : Marc Pouzet *)
|
|
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
|
|
(* control optimisation *)
|
|
|
|
open Idents
|
|
open Misc
|
|
open Obc
|
|
open Obc_utils
|
|
open Clocks
|
|
open Obc_mapfold
|
|
|
|
let fuse_blocks b1 b2 =
|
|
{ b1 with b_locals = b1.b_locals @ b2.b_locals;
|
|
b_body = b1.b_body @ b2.b_body }
|
|
|
|
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 is_deadcode = function
|
|
| Aassgn (lhs, e) ->
|
|
(match e.e_desc with
|
|
| Eextvalue w ->
|
|
let w' = ext_value_of_pattern lhs in
|
|
w = w' (* TODO: proper compare *)
|
|
| _ -> false
|
|
)
|
|
| Acase (_, []) -> true
|
|
| Afor(_, _, _, { b_body = [] }) -> true
|
|
| _ -> false
|
|
|
|
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))
|
|
|
|
and join_block b =
|
|
{ b with b_body = joinlist b.b_body }
|
|
|
|
and joinhandlers h1 h2 =
|
|
match h1 with
|
|
| [] -> h2
|
|
| (c1, s1) :: h1' ->
|
|
let s1', h2' =
|
|
try let s2, h2'' = find c1 h2 in fuse_blocks s1 s2, h2''
|
|
with Not_found -> s1, h2 in
|
|
(c1, join_block s1') :: joinhandlers h1' h2'
|
|
|
|
let block funs acc b =
|
|
{ b with b_body = joinlist b.b_body }, acc
|
|
|
|
let program p =
|
|
let p, _ = program_it { defaults with block = block } () p in
|
|
p
|