diff --git a/compiler/obc/control.ml b/compiler/obc/control.ml index 9fe3dfc..3f18218 100644 --- a/compiler/obc/control.ml +++ b/compiler/obc/control.ml @@ -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] diff --git a/compiler/obc/main/obc_compiler.ml b/compiler/obc/main/obc_compiler.ml index 333c3c0..e1fc3b4 100644 --- a/compiler/obc/main/obc_compiler.ml +++ b/compiler/obc/main/obc_compiler.ml @@ -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 diff --git a/compiler/obc/obc_compare.ml b/compiler/obc/obc_compare.ml new file mode 100644 index 0000000..f0048ef --- /dev/null +++ b/compiler/obc/obc_compare.ml @@ -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 diff --git a/compiler/obc/transformations/deadcode.ml b/compiler/obc/transformations/deadcode.ml new file mode 100644 index 0000000..b73bdf0 --- /dev/null +++ b/compiler/obc/transformations/deadcode.ml @@ -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 +