Deadcode removal pass
This commit is contained in:
parent
448c163181
commit
032fe693ef
|
@ -25,18 +25,7 @@ let rec find c = function
|
||||||
| (c1, s1) :: h ->
|
| (c1, s1) :: h ->
|
||||||
if c = c1 then s1, h else let s, h = find c h in s, (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 rec joinlist l =
|
||||||
let l = List.filter (fun a -> not (is_deadcode a)) l in
|
|
||||||
match l with
|
match l with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
| [s1] -> [s1]
|
| [s1] -> [s1]
|
||||||
|
|
|
@ -20,4 +20,7 @@ let compile_program p =
|
||||||
(* Memory allocation application *)
|
(* Memory allocation application *)
|
||||||
let p = pass "Application of Memory Allocation" !do_mem_alloc Memalloc_apply.program p pp in
|
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
|
p
|
||||||
|
|
60
compiler/obc/obc_compare.ml
Normal file
60
compiler/obc/obc_compare.ml
Normal 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
|
29
compiler/obc/transformations/deadcode.ml
Normal file
29
compiler/obc/transformations/deadcode.ml
Normal 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
|
||||||
|
|
Loading…
Reference in a new issue