From 2aed0f6537092073a154de08192bf6cd094cad59 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gwena=C3=ABl=20Delaval?= <gwenael.delaval@inria.fr>
Date: Mon, 18 Jan 2016 14:32:54 +0100
Subject: [PATCH] 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        |  3 +-
 compiler/obc/transformations/deadcode.ml | 57 ++++++++++++++++++------
 2 files changed, 45 insertions(+), 15 deletions(-)

diff --git a/compiler/obc/main/obc_compiler.ml b/compiler/obc/main/obc_compiler.ml
index 24adacc..a81a754 100644
--- a/compiler/obc/main/obc_compiler.ml
+++ b/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
diff --git a/compiler/obc/transformations/deadcode.ml b/compiler/obc/transformations/deadcode.ml
index b9a9c12..d5a6ae8 100644
--- a/compiler/obc/transformations/deadcode.ml
+++ b/compiler/obc/transformations/deadcode.ml
@@ -28,23 +28,52 @@
 (***********************************************************************)
 open Obc
 open Obc_mapfold
-
-let is_deadcode = function
-    | 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
+open Types
+open Initial
 
 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
+  match a with
+  | Aassgn (lhs, e) -> (* remove x=x equations *)
+     (match e.e_desc with
+      | 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