Deadcode removal pass

This commit is contained in:
Cédric Pasteur 2011-04-21 11:24:04 +02:00
parent 448c163181
commit 032fe693ef
4 changed files with 92 additions and 11 deletions

View file

@ -25,18 +25,7 @@ let rec find c = function
| (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
| Epattern l -> l = lhs
| _ -> 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]

View file

@ -20,4 +20,7 @@ let compile_program p =
(* Memory allocation application *)
let p = pass "Application of Memory Allocation" !do_mem_alloc Memalloc_apply.program p pp in
(*Dead code removal*)
let p = pass "Dead code removal" !do_mem_alloc Deadcode.program p pp in
p

View file

@ -0,0 +1,60 @@
open Obc
open Idents
open Global_compare
open Misc
let rec pat_compare pat1 pat2 =
let cr = type_compare pat1.pat_ty pat2.pat_ty in
if cr <> 0 then cr
else
match pat1.pat_desc, pat2.pat_desc with
| Lvar x1, Lvar x2 -> ident_compare x1 x2
| Lmem x1, Lmem x2 -> ident_compare x1 x2
| Lfield(r1, f1), Lfield(r2, f2) ->
let cr = compare f1 f2 in
if cr <> 0 then cr else pat_compare r1 r2
| Larray(l1, e1), Larray(l2, e2) ->
let cr = pat_compare l1 l2 in
if cr <> 0 then cr else exp_compare e1 e2
| Lvar _, _ -> 1
| Lmem _, Lvar _ -> -1
| Lmem _, _ -> 1
| Lfield _, (Lvar _ | Lmem _) -> -1
| Lfield _, _ -> 1
| Larray _, _ -> -1
and exp_compare e1 e2 =
let cr = type_compare e1.e_ty e2.e_ty in
if cr <> 0 then cr
else
match e1.e_desc, e2.e_desc with
| Epattern pat1, Epattern pat2 -> pat_compare pat1 pat2
| Econst se1, Econst se2 -> static_exp_compare se1 se2
| Eop(op1, el1), Eop(op2, el2) ->
let cr = compare op1 op2 in
if cr <> 0 then cr else list_compare exp_compare el1 el2
| Estruct(_, fnel1), Estruct (_, fnel2) ->
let compare_fne (fn1, e1) (fn2, e2) =
let cr = compare fn1 fn2 in
if cr <> 0 then cr else exp_compare e1 e2
in
list_compare compare_fne fnel1 fnel2
| Earray el1, Earray el2 ->
list_compare exp_compare el1 el2
| Epattern _, _ -> 1
| Econst _, Epattern _ -> -1
| Econst _, _ -> 1
| Eop _, (Epattern _ | Econst _) -> -1
| Eop _, _ -> 1
| Estruct _, (Epattern _ | Econst _ | Eop _) -> -1
| Estruct _, _ -> 1
| Earray _, _ -> -1

View file

@ -0,0 +1,29 @@
open Obc
open Obc_mapfold
let is_deadcode = function
| Aassgn (lhs, e) ->
(match e.e_desc with
| Epattern l -> Obc_compare.pat_compare l lhs = 0
| _ -> false
)
| Acase (_, []) -> true
| Afor(_, _, _, { b_body = [] }) -> true
| _ -> false
let act funs act_list a =
let a, _ = Obc_mapfold.act funs [] a in
if is_deadcode a then
a, act_list
else
a, a::act_list
let block funs acc b =
let _, act_list = Obc_mapfold.block funs [] b in
{ b with b_body = List.rev act_list }, acc
let program p =
let funs = { Obc_mapfold.defaults with block = block; act = act } in
let p, _ = Obc_mapfold.program_it funs [] p in
p