Don't leave unused blocks after Eval.f and Deadcode.remove_empty_blocks

Author: vouillon

compiler/lib/deadcode.ml

@@ -183,6 +183,26 @@ let annot st pc xi =
 
 (****)
 
+let remove_unused_blocks p =
+  let visited = BitSet.create' p.free_pc in
+  let rec mark_used pc =
+    if not (BitSet.mem visited pc)
+    then (
+      BitSet.set visited pc;
+      let block = Addr.Map.find pc p.blocks in
+      List.iter
+        ~f:(fun i ->
+          match i with
+          | Let (_, Closure (_, (pc', _), _)) -> mark_used pc'
+          | _ -> ())
+        block.body;
+      Code.fold_children p.blocks pc (fun pc' () -> mark_used pc') ())
+  in
+  mark_used p.start;
+  { p with blocks = Addr.Map.filter (fun pc _ -> BitSet.mem visited pc) p.blocks }
+
+(****)
+
 let rec add_arg_dep defs params args =
   match params, args with
   | x :: params, y :: args ->
@@ -250,7 +270,7 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
         })
       p.blocks
   in
-  { p with blocks }
+  remove_unused_blocks { p with blocks }
 
 let f ({ blocks; _ } as p : Code.program) =
   let t = Timer.make () in

compiler/lib/deadcode.mli

@@ -24,3 +24,5 @@ type variable_uses =
 val f : Code.program -> Code.program * variable_uses
 
 val remove_empty_blocks : live_vars:variable_uses -> Code.program -> Code.program
+
+val remove_unused_blocks : Code.program -> Code.program

compiler/lib/eval.ml

@@ -760,11 +760,12 @@ let f info p =
   let t = Timer.make () in
   let blocks = eval update_count ~target:(Config.target ()) info p.blocks in
   let blocks = drop_exception_handler drop_count blocks in
+  let p = Deadcode.remove_unused_blocks { p with blocks } in
   if times () then Format.eprintf "  eval: %a@." Timer.print t;
   if stats ()
   then
     Format.eprintf
       "Stats - eval: %d optimizations, %d dropped exception handlers@."
       !update_count
       !drop_count;
-  { p with blocks }
+  p