Deadcode removal improvement

Deadcode removal in Obc :
- suppression of switch unused cases :

switch(true) {
  case false: ...
}

- activation with -deadcode option

compiler/obc/main/obc_compiler.ml

@@ -45,7 +45,8 @@ let compile_program p =
 
   (*Dead code removal*)
   let p = pass "Dead code removal"
-    (!do_mem_alloc || !do_linear_typing) Deadcode.program p pp in
+	       (!do_mem_alloc || !do_linear_typing || !deadcode)
+	       Deadcode.program p pp in
 
   (*Control optimization*)
   let p = pass "Control optimization" true Control.program p pp in

compiler/obc/transformations/deadcode.ml

@@ -28,23 +28,52 @@
 (***********************************************************************)
 open Obc
 open Obc_mapfold
-
+open Types
-let is_deadcode = function
+open Initial
-    | Aassgn (lhs, e) -> (* remove x=x equations *)
-        (match e.e_desc with
-           | Eextvalue w -> Obc_compare.compare_lhs_extvalue lhs w = 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
+  match a with
-      a, act_list
+  | Aassgn (lhs, e) -> (* remove x=x equations *)
-    else
+     (match e.e_desc with
-      a, a::act_list
+      | Eextvalue w when (Obc_compare.compare_lhs_extvalue lhs w = 0)
+	-> a, act_list	(* removal of action *)
+      | _ -> a, a :: act_list
+     )
+  | Acase (_, []) -> a, act_list (* removal *)
+  | Acase ({e_desc =
+	      Eextvalue(
+		  {w_desc = Wconst ({se_desc = Sbool b})}
+		)
+	   },
+	   c_b_l) ->
+     let pb = if b then ptrue else pfalse in
+     let c_b_l = List.filter (fun (c,b) -> c = pb) c_b_l in
+     begin
+       match c_b_l with
+	 [c,b] ->
+	 let a = Ablock b in
+	 a, a :: act_list
+       | [] -> a, act_list
+       | _ -> assert false (* More than one case after filter *)
+     end
+  | Acase ({e_desc =
+	      Eextvalue(
+		  {w_desc = Wconst ({se_desc = Sconstructor ce})}
+		)
+	   },
+	   c_b_l) ->
+     let c_b_l = List.filter (fun (c,b) -> c = ce) c_b_l in
+     begin
+       match c_b_l with
+	 [c,b] ->
+	 let a = Ablock b in
+	 a, a :: act_list
+       | [] -> a, act_list
+       | _ -> assert false (* More than one case after filter *)
+     end
+  | Afor(_, _, _, { b_body = [] }) -> a, act_list (* removal *)
+  | _ -> a, a :: act_list
 
 let block funs acc b =
   let _, act_list = Obc_mapfold.block funs [] b in