From 9e3867bec16b42f5daf214e2e53f6f5d56129488 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?L=C3=A9lio=20Brun?= <lb@leliobrun.net>
Date: Tue, 14 Mar 2023 12:43:24 +0900
Subject: [PATCH] restrict dead code elim to variables eliminated by the
 constructor elimination step

---
 src/optimize_machine.ml | 57 +++++++++++++++++++++++++----------------
 1 file changed, 35 insertions(+), 22 deletions(-)

diff --git a/src/optimize_machine.ml b/src/optimize_machine.ml
index 4cfc7005..ce4120fc 100644
--- a/src/optimize_machine.ml
+++ b/src/optimize_machine.ml
@@ -1200,52 +1200,65 @@ and instrs_reduce m v branches instrs cont =
   | i1 :: i2 :: q ->
     i1 :: instrs_reduce m v branches (i2 :: q) cont
 
-let rec instrs_fusion m instrs =
+let rec instrs_fusion m vars instrs =
   match instrs with
   | [] | [ _ ] ->
-    false, instrs
+    vars, instrs
   | i1 :: i2 :: q -> (
     match i2.instr_desc with
     | MBranch ({ value_desc = Var v; _ }, hl, _) when instr_constant_assign v i1
       ->
-      ( true,
+      let vars, branches =
+        List.fold_right
+          (fun (h, b) (vars, brs) ->
+            let vars, instrs = instrs_fusion m vars b in
+            vars, (h, instrs) :: brs)
+          hl
+          (vars, [])
+      in
+      let vars, q = instrs_fusion m vars q in
+      let instrs =
         instr_reduce
           m
           v
-          (List.map (fun (h, b) -> h, snd (instrs_fusion m b)) hl)
+          branches
           { i1 with instr_spec = i1.instr_spec @ i2.instr_spec }
-          (snd (instrs_fusion m q)) )
+          q
+      in
+      ISet.add v.var_id vars, instrs
     | _ ->
-      let b, instrs = instrs_fusion m (i2 :: q) in
-      b, i1 :: instrs)
+      let vars, instrs = instrs_fusion m vars (i2 :: q) in
+      vars, i1 :: instrs)
 
-let step_fusion m step =
-  let b, step_instrs = instrs_fusion m step.step_instrs in
-  b, { step with step_instrs }
+let step_fusion m vars step =
+  let vars, step_instrs = instrs_fusion m vars step.step_instrs in
+  vars, { step with step_instrs }
 
 let machine_fusion m =
-  let b, mstep = step_fusion m m.mstep in
-  b, { m with mstep }
+  let vars, mstep = step_fusion m ISet.empty m.mstep in
+  vars, { m with mstep }
 
 let machines_fusion prog =
   Log.report ~level:1 (fun fmt ->
       Format.fprintf
         fmt
         "@[<v 2>.. machines optimization: enumerated constructors elimination@,");
-  let bs, prog = List.(split (map machine_fusion prog)) in
+  let prog = List.map machine_fusion prog in
   Log.report ~level:3 (fun fmt ->
-      if List.exists (fun b -> b) bs then
+      if List.exists (fun (vars, _) -> not (ISet.is_empty vars)) prog then
         Format.fprintf
           fmt
           "@[<v 2>.. generated machines (enum elim):@ %a@]@ "
           pp_machines
-          prog
+          (List.map snd prog)
       else pp_no_effect fmt);
   Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@]@,");
   prog
 
-let machine_clean m =
+let machine_clean (vars, m) =
   let unused = Machine_code_dep.compute_unused_variables m in
+  (* restrict to previously eliminated vars *)
+  let unused = ISet.inter vars unused in
   let is_unused unused v = ISet.mem v.var_id unused in
   (* unused that are written by a step call are not unused if they are not all
      unused *)
@@ -1294,25 +1307,25 @@ let machine_clean m =
       instrs
   in
   let step_instrs = filter_instrs m.mstep.step_instrs in
-  ( not (ISet.is_empty unused),
-    { m with mstep = { m.mstep with step_locals; step_instrs } } )
+  unused, { m with mstep = { m.mstep with step_locals; step_instrs } }
 
 let machines_clean prog =
   Log.report ~level:1 (fun fmt ->
       Format.fprintf
         fmt
         "@[<v 2>.. machines optimization: cleaning unused variables@,");
-  let bs, prog = List.(split (map machine_clean prog)) in
+  let prog = List.map machine_clean prog in
+  let prog' = List.map snd prog in
   Log.report ~level:3 (fun fmt ->
-      if List.exists (fun b -> b) bs then
+      if List.exists (fun (vars, _) -> not (ISet.is_empty vars)) prog then
         Format.fprintf
           fmt
           "@[<v 2>.. generated machines (cleaning):@ %a@]@ "
           pp_machines
-          prog
+          prog'
       else pp_no_effect fmt);
   Log.report ~level:1 (fun fmt -> Format.fprintf fmt "@]@,");
-  prog
+  prog'
 
 (* Additional function to modify the prog according to removed variables map *)
 
-- 
GitLab