Compiler: global deadcode with effects

compiler/lib/driver.ml

@@ -89,18 +89,27 @@ let ( +> ) f g x = g (f x)
 
 let map_fst f (x, y) = f x, y
 
-let effects p =
+let effects ~deadcode_sentinal p =
   if Config.Flag.effects ()
   then (
     if debug () then Format.eprintf "Effects...@.";
-    p |> Deadcode.f +> Effects.f +> map_fst Lambda_lifting.f)
+    let p, live_vars = Deadcode.f p in
+    let p = Effects.remove_empty_blocks ~live_vars p in
+    let p, live_vars = Deadcode.f p in
+    let p, live_vars =
+      if Config.Flag.globaldeadcode ()
+      then
+        let info = Global_flow.f ~fast:false p in
+        let p = Global_deadcode.f p ~deadcode_sentinal info in
+        Deadcode.f p
+      else p, live_vars
+    in
+    let info = Global_flow.f ~fast:false p in
+    let p, cps = p |> Effects.f ~flow_info:info ~live_vars +> map_fst Lambda_lifting.f in
+    p, cps)
   else p, (Code.Var.Set.empty : Effects.cps_calls)
 
-let exact_calls profile p =
-  let deadcode_sentinal =
-    (* If deadcode is disabled, this field is just fresh variable *)
-    Code.Var.fresh ()
-  in
+let exact_calls profile ~deadcode_sentinal p =
   if not (Config.Flag.effects ())
   then
     let fast =
@@ -114,9 +123,8 @@ let exact_calls profile p =
       then Global_deadcode.f p ~deadcode_sentinal info
       else p
     in
-    let p = Specialize.f ~function_arity:(fun f -> Global_flow.function_arity info f) p in
-    p, deadcode_sentinal
-  else p, deadcode_sentinal
+    Specialize.f ~function_arity:(fun f -> Global_flow.function_arity info f) p
+  else p
 
 let print p =
   if debug () then Code.Print.program (fun _ _ -> "") p;
@@ -185,7 +193,8 @@ let generate
     ~exported_runtime
     ~wrap_with_fun
     ~warn_on_unhandled_effect
-    (((p, live_vars), cps_calls), deadcode_sentinal) =
+    ~deadcode_sentinal
+    ((p, live_vars), cps_calls) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
   Generate.f
@@ -583,17 +592,26 @@ let configure formatter =
 
 let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p =
   let exported_runtime = not standalone in
+  let deadcode_sentinal =
+    (* If deadcode is disabled, this field is just fresh variable *)
+    Code.Var.fresh_n "undef"
+  in
   let opt =
     specialize_js_once
     +> (match profile with
        | O1 -> o1
        | O2 -> o2
        | O3 -> o3)
-    +> exact_calls profile
-    +> map_fst (effects +> map_fst (Generate_closure.f +> deadcode'))
+    +> exact_calls ~deadcode_sentinal profile
+    +> (effects ~deadcode_sentinal +> map_fst (Generate_closure.f +> deadcode'))
   in
   let emit =
-    generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone
+    generate
+      d
+      ~exported_runtime
+      ~wrap_with_fun
+      ~warn_on_unhandled_effect:standalone
+      ~deadcode_sentinal
     +> link ~standalone ~linkall
     +> pack ~wrap_with_fun ~standalone
     +> coloring

compiler/lib/effects.ml

@@ -923,13 +923,12 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
 
 (****)
 
-let f (p, live_vars) =
+let f ~flow_info ~live_vars p =
   let t = Timer.make () in
-  let p = remove_empty_blocks ~live_vars p in
-  let flow_info = Global_flow.f ~fast:false p in
   let cps_needed = Partial_cps_analysis.f p flow_info in
   let p, cps_needed = rewrite_toplevel ~cps_needed p in
   let p = split_blocks ~cps_needed p in
   let p, cps_calls = cps_transform ~live_vars ~flow_info ~cps_needed p in
   if Debug.find "times" () then Format.eprintf "  effects: %a@." Timer.print t;
+  Code.invariant p;
   p, cps_calls

compiler/lib/effects.mli

@@ -18,4 +18,10 @@
 
 type cps_calls = Code.Var.Set.t
 
-val f : Code.program * Deadcode.variable_uses -> Code.program * cps_calls
+val remove_empty_blocks : live_vars:Deadcode.variable_uses -> Code.program -> Code.program
+
+val f :
+     flow_info:Global_flow.info
+  -> live_vars:Deadcode.variable_uses
+  -> Code.program
+  -> Code.program * cps_calls

compiler/lib/global_deadcode.ml

@@ -352,7 +352,8 @@ let zero prog sentinal live_table =
     let branch =
       (* Zero out return values in last instruction, otherwise do nothing. *)
       match block.branch with
-      | Return x, loc -> Return (zero_var x), loc
+      | Return x, loc ->
+          if Config.Flag.effects () then block.branch else Return (zero_var x), loc
       | Raise (_, _), _
       | Stop, _
       | Branch _, _
@@ -412,6 +413,7 @@ let add_sentinal p sentinal =
 
 (** Run the liveness analysis and replace dead variables with the given sentinal. *)
 let f p ~deadcode_sentinal global_info =
+  Code.invariant p;
   let t = Timer.make () in
   (* Add sentinal variable *)
   let p = add_sentinal p deadcode_sentinal in

compiler/tests-compiler/direct_calls.ml

@@ -58,25 +58,25 @@ let%expect_test "direct calls without --enable effects" =
     {|
     function test1(param){
      function f(g, x){caml_call1(g, x); return;}
-     var _e_ = 7;
-     f(function(x){return x + 1 | 0;}, _e_);
-     var _f_ = 4.;
-     f(function(x){return x * 2.;}, _f_);
+     var _d_ = 7;
+     f(function(x){return x + 1 | 0;}, _d_);
+     var _e_ = 4.;
+     f(function(x){return x * 2.;}, _e_);
      return 0;
     }
     //end
     function test2(param){
      function f(g, x){caml_call1(g, x); return;}
-     var _d_ = 7;
-     f(function(x){return x + 1 | 0;}, _d_);
+     var _c_ = 7;
+     f(function(x){return x + 1 | 0;}, _c_);
      f(function(x){return caml_call2(Stdlib[28], x, cst_a$0);}, cst_a);
      return 0;
     }
     //end
     function test3(x){
      function F(symbol){function f(x){return x + 1 | 0;} return [0, f];}
-     var M1 = F([0]), M2 = F([0]), _c_ = M2[1].call(null, 2);
-     return [0, M1[1].call(null, 1), _c_];
+     var M1 = F([0]), M2 = F([0]), _b_ = M2[1].call(null, 2);
+     return [0, M1[1].call(null, 1), _b_];
     }
     //end
     function test4(x){
@@ -130,11 +130,9 @@ let%expect_test "direct calls with --enable effects" =
   [%expect
     {|
     function test1(param, cont){
-     function f(g, x){return g(x);}
-     var _k_ = 7;
-     f(function(x){return x + 1 | 0;}, _k_);
-     var _l_ = 4.;
-     f(function(x){return x * 2.;}, _l_);
+     function f(g, x){return g(undef);}
+     f(function(x){return x + 1 | 0;}, undef);
+     f(function(x){return x * 2.;}, undef);
      return cont(0);
     }
     //end
@@ -157,7 +155,7 @@ let%expect_test "direct calls with --enable effects" =
     //end
     function test3(x, cont){
      function F(symbol){function f(x){return x + 1 | 0;} return [0, f];}
-     var M1 = F([0]), M2 = F([0]), _e_ = M2[1].call(null, 2);
+     var M1 = F(undef), M2 = F(undef), _e_ = M2[1].call(null, 2);
      return cont([0, M1[1].call(null, 1), _e_]);
     }
     //end
@@ -166,7 +164,7 @@ let%expect_test "direct calls with --enable effects" =
       function f(x, cont){return caml_cps_call3(Stdlib_Printf[2], _a_, x, cont);}
       return [0, f];
      }
-     var M1 = F([0]), M2 = F([0]), _b_ = 1, _c_ = M1[1];
+     var M1 = F(undef), M2 = F(undef), _b_ = 1, _c_ = M1[1];
      return caml_cps_exact_call2
              (_c_,
               _b_,

compiler/tests-compiler/effects_toplevel.ml

@@ -65,6 +65,7 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
        return caml_callback
                (function(cont){
                  var
+                  undef = undefined,
                   global_data = runtime.caml_get_global_data(),
                   Stdlib_Printf = global_data.Stdlib__Printf,
                   _a_ =
@@ -74,17 +75,16 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
                  function g(param, cont){
                   return caml_cps_call2(Stdlib_Printf[2], _a_, cont);
                  }
-                 caml_callback(g, [0]);
+                 caml_callback(g, [undef]);
                  var _b_ = 1;
                  function _c_(i){
-                  var _d_ = 0;
                   return caml_cps_exact_call2
                           (g,
-                           _d_,
-                           function(_e_){
-                            var _f_ = i + 1 | 0;
-                            if(5 !== i) return caml_cps_exact_call1(_c_, _f_);
-                            caml_callback(g, [0]);
+                           undef,
+                           function(_d_){
+                            var _e_ = i + 1 | 0;
+                            if(5 !== i) return caml_cps_exact_call1(_c_, _e_);
+                            caml_callback(g, [undef]);
                             var Test = [0];
                             runtime.caml_register_global(2, Test, "Test");
                             return;

compiler/tests-compiler/gh1494.ml

@@ -39,7 +39,7 @@ let () =
   [%expect
     {|
     function bug(param){
-     var g = [0, function(x){return function(_d_){return _d_;};}];
+     var g = [0, function(x){return function(_c_){return _c_;};}];
      return [0, function(param){return caml_call1(g[1], 1);}, g];
     }
     //end |}]

compiler/tests-compiler/global_deadcode.ml

@@ -40,30 +40,30 @@ let%expect_test "Eliminates unused functions from functor" =
     function create(l, v, r){
      if(l) var h = l[4], hl = h; else var hl = 0;
      if(r) var h$0 = r[4], hr = h$0; else var hr = 0;
-     var _n_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-     return [0, l, v, r, _n_];
+     var _m_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
+     return [0, l, v, r, _m_];
     }
     function bal(l, v, r){
      if(l) var h = l[4], hl = h; else var hl = 0;
      if(r) var h$0 = r[4], hr = h$0; else var hr = 0;
      if((hr + 2 | 0) < hl){
       if(! l) return invalid_arg(_b_);
-      var lr = l[3], lv = l[2], ll = l[1], _i_ = height(lr);
-      if(_i_ <= height(ll)) return create(ll, lv, create(lr, v, r));
+      var lr = l[3], lv = l[2], ll = l[1], _h_ = height(lr);
+      if(_h_ <= height(ll)) return create(ll, lv, create(lr, v, r));
       if(! lr) return invalid_arg(_a_);
-      var lrr = lr[3], lrv = lr[2], lrl = lr[1], _j_ = create(lrr, v, r);
-      return create(create(ll, lv, lrl), lrv, _j_);
+      var lrr = lr[3], lrv = lr[2], lrl = lr[1], _i_ = create(lrr, v, r);
+      return create(create(ll, lv, lrl), lrv, _i_);
      }
      if((hl + 2 | 0) >= hr){
-      var _m_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
-      return [0, l, v, r, _m_];
+      var _l_ = hr <= hl ? hl + 1 | 0 : hr + 1 | 0;
+      return [0, l, v, r, _l_];
      }
      if(! r) return invalid_arg(_d_);
-     var rr = r[3], rv = r[2], rl = r[1], _k_ = height(rl);
-     if(_k_ <= height(rr)) return create(create(l, v, rl), rv, rr);
+     var rr = r[3], rv = r[2], rl = r[1], _j_ = height(rl);
+     if(_j_ <= height(rr)) return create(create(l, v, rl), rv, rr);
      if(! rl) return invalid_arg(_c_);
-     var rlr = rl[3], rlv = rl[2], rll = rl[1], _l_ = create(rlr, rv, rr);
-     return create(create(l, v, rll), rlv, _l_);
+     var rlr = rl[3], rlv = rl[2], rll = rl[1], _k_ = create(rlr, rv, rr);
+     return create(create(l, v, rll), rlv, _k_);
     }
     function add(x, t){
      if(! t) return [0, 0, x, 0, 1];