Compiler: remove empty blocks

Author: hhugo

CHANGES.md

@@ -19,6 +19,7 @@
 * Runtime/wasm: support unmarshaling compressed data (#1898)
 * Runtime/wasm: make resuming a continuation more efficient in Wasm (#1892)
 * Compiler: improve performance of Javascript linking
+* Compiler: remove empty blocks (#1934)
 * Ppx: explicitly disallow polymorphic method (#1897)
 * Ppx: allow "function" in object literals (#1897)
 * Lib: make the Wasm version of Json.output work with native ints and JavaScript objects (#1872)

compiler/lib-wasm/generate.ml

@@ -1238,7 +1238,7 @@ let start () = make_context ~value_type:Gc_target.Value.value
 
 let f ~context ~unit_name p ~live_vars ~in_cps ~deadcode_sentinal ~debug =
   let t = Timer.make () in
-  let p = if effects_cps () then fix_switch_branches p else p in
+  let p = fix_switch_branches p in
   let module G = Generate (Gc_target) in
   let res = G.f ~context ~unit_name ~live_vars ~in_cps ~deadcode_sentinal ~debug p in
   if times () then Format.eprintf "  code gen.: %a@." Timer.print t;

compiler/lib/deadcode.ml

@@ -186,6 +186,62 @@ let add_cont_dep blocks defs (pc, args) =
   | Some block -> add_arg_dep defs block.params args
   | None -> () (* Dead continuation *)
 
+let empty_body b =
+  match b with
+  | [] | [ Event _ ] -> true
+  | _ -> false
+
+let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
+  let shortcuts = Hashtbl.create 16 in
+  let rec resolve_rec visited ((pc, args) as cont) =
+    if Addr.Set.mem pc visited
+    then cont
+    else
+      match Hashtbl.find_opt shortcuts pc with
+      | Some (params, cont) ->
+          let pc', args' = resolve_rec (Addr.Set.add pc visited) cont in
+          let s = Subst.from_map (Subst.build_mapping params args) in
+          pc', List.map ~f:s args'
+      | None -> cont
+  in
+  let resolve cont = resolve_rec Addr.Set.empty cont in
+  Addr.Map.iter
+    (fun pc block ->
+      match block with
+      | { params; body; branch = Branch cont; _ } when empty_body body ->
+          let args =
+            List.fold_left
+              ~f:(fun args x -> Var.Set.add x args)
+              ~init:Var.Set.empty
+              (snd cont)
+          in
+          (* We can skip an empty block if its parameters are only
+             used as argument to the continuation *)
+          if
+            List.for_all
+              ~f:(fun x -> live_vars.(Var.idx x) = 1 && Var.Set.mem x args)
+              params
+          then Hashtbl.add shortcuts pc (params, cont)
+      | _ -> ())
+    p.blocks;
+  let blocks =
+    Addr.Map.map
+      (fun block ->
+        { block with
+          branch =
+            (let branch = block.branch in
+             match branch with
+             | Branch cont -> Branch (resolve cont)
+             | Cond (x, cont1, cont2) -> Cond (x, resolve cont1, resolve cont2)
+             | Switch (x, a1) -> Switch (x, Array.map ~f:resolve a1)
+             | Pushtrap (cont1, x, cont2) -> Pushtrap (resolve cont1, x, resolve cont2)
+             | Poptrap cont -> Poptrap (resolve cont)
+             | Return _ | Raise _ | Stop -> branch)
+        })
+      p.blocks
+  in
+  { p with blocks }
+
 let f ({ blocks; _ } as p : Code.program) =
   let t = Timer.make () in
   let nv = Var.count () in

compiler/lib/deadcode.mli

@@ -22,3 +22,5 @@ type variable_uses =
   int array (* For each variable, indicates how many times it is used. *)
 
 val f : Code.program -> Code.program * variable_uses
+
+val remove_empty_blocks : live_vars:variable_uses -> Code.program -> Code.program

compiler/lib/driver.ml

@@ -49,8 +49,8 @@ let deadcode' p =
   Deadcode.f p
 
 let deadcode p =
-  let r, _ = deadcode' p in
-  r
+  let r, live_vars = deadcode' p in
+  Deadcode.remove_empty_blocks ~live_vars r
 
 let inline p =
   if Config.Flag.inline () && Config.Flag.deadcode ()
@@ -102,7 +102,7 @@ let effects ~deadcode_sentinal p =
   | `Cps | `Double_translation ->
       if debug () then Format.eprintf "Effects...@.";
       let p, live_vars = Deadcode.f p in
-      let p = Effects.remove_empty_blocks ~live_vars p in
+      let p = Deadcode.remove_empty_blocks ~live_vars p in
       let p, live_vars = Deadcode.f p in
       let info = Global_flow.f ~fast:false p in
       let p, live_vars =

compiler/lib/effects.ml

@@ -1106,57 +1106,6 @@ let split_blocks ~cps_needed (p : Code.program) =
 
 (****)
 
-let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
-  let shortcuts = Hashtbl.create 16 in
-  let rec resolve_rec visited ((pc, args) as cont) =
-    if Addr.Set.mem pc visited
-    then cont
-    else
-      match Hashtbl.find_opt shortcuts pc with
-      | Some (params, cont) ->
-          let pc', args' = resolve_rec (Addr.Set.add pc visited) cont in
-          let s = Subst.from_map (Subst.build_mapping params args) in
-          pc', List.map ~f:s args'
-      | None -> cont
-  in
-  let resolve cont = resolve_rec Addr.Set.empty cont in
-  Addr.Map.iter
-    (fun pc block ->
-      match block with
-      | { params; body; branch = Branch cont; _ } when empty_body body ->
-          let args =
-            List.fold_left
-              ~f:(fun args x -> Var.Set.add x args)
-              ~init:Var.Set.empty
-              (snd cont)
-          in
-          (* We can skip an empty block if its parameters are only
-             used as argument to the continuation *)
-          if
-            List.for_all
-              ~f:(fun x -> live_vars.(Var.idx x) = 1 && Var.Set.mem x args)
-              params
-          then Hashtbl.add shortcuts pc (params, cont)
-      | _ -> ())
-    p.blocks;
-  let blocks =
-    Addr.Map.map
-      (fun block ->
-        { block with
-          branch =
-            (let branch = block.branch in
-             match branch with
-             | Branch cont -> Branch (resolve cont)
-             | Cond (x, cont1, cont2) -> Cond (x, resolve cont1, resolve cont2)
-             | Switch (x, a1) -> Switch (x, Array.map ~f:resolve a1)
-             | Pushtrap (cont1, x, cont2) -> Pushtrap (resolve cont1, x, resolve cont2)
-             | Poptrap cont -> Poptrap (resolve cont)
-             | Return _ | Raise _ | Stop -> branch)
-        })
-      p.blocks
-  in
-  { p with blocks }
-
 (****)
 
 let f ~flow_info ~live_vars p =

compiler/lib/effects.mli

@@ -18,8 +18,6 @@
 
 type trampolined_calls = Code.Var.Set.t
 
-val remove_empty_blocks : live_vars:Deadcode.variable_uses -> Code.program -> Code.program
-
 type in_cps = Code.Var.Set.t
 
 val f :

compiler/tests-compiler/cond.ml

@@ -45,12 +45,11 @@ let%expect_test "conditional" =
     function f(a, b, c, d, e, f){
      a:
      {
-      b:
       if(a){
        if(! b && ! c && ! d && ! e && ! f){var x = 1; break a;}
       }
       else if(b){
-       if(! c && ! d){if(e) break b; if(f) break b; var x = 2; break a;}
+       if(! c && ! d && ! e && ! f){var x = 2; break a;}
       }
       else if(c){
        if(! d && ! e && ! f){var x = 3; break a;}
@@ -66,4 +65,5 @@ let%expect_test "conditional" =
      }
      return x + 2 | 0;
     }
-    //end |}]
+    //end
+    |}]

compiler/tests-compiler/exceptions.ml

@@ -35,12 +35,13 @@ let prevent_inline = some_name
     function some_name(param){
      try{
       try{throw caml_maybe_attach_backtrace(Stdlib[8], 1);}
-      catch(x$0){var x = caml_wrap_exception(x$0), i$0 = x;}
+      catch(x$0){var x = caml_wrap_exception(x$0), i = x;}
      }
-     catch(i$1){var i = caml_wrap_exception(i$1), i$0 = i;}
-     throw caml_maybe_attach_backtrace(i$0, 1);
+     catch(_a_){var i = caml_wrap_exception(_a_);}
+     throw caml_maybe_attach_backtrace(i, 1);
     }
-    //end |}];
+    //end
+    |}];
   print_fun_decl (program ~debug:false) None;
   [%expect
     {|

compiler/tests-compiler/gh1007.ml

@@ -332,11 +332,11 @@ let ()  = M.myfun M.x
        len = len$0;
        param = l$0;
       }
-      if(2 <= len) sort(len, l);
-      x$0 = next;
+      if(2 <= len){sort(len, l); x$0 = next;} else x$0 = next;
      }
     }
-    //end |}]
+    //end
+    |}]
 
 let%expect_test _ =
   let prog =