Compiler: do not prevent deadcode to preserve tailcall

CHANGES.md

@@ -44,6 +44,7 @@
 * Compiler: minifier fix (#1867)
 * Compiler: fix assert failure with double translation (#1870)
 * Compiler: fix path rewriting of Wasm source maps (#1882)
+* Compiler: fix global dead code in presence of dead tailcall (#2010)
 * Compiler/wasm: fix bound check for empty float array (#1904)
 * Lib: fix Dom_html.Keyboard_code.of_event (#1878)
 * Runtime: fix path normalization (#1848)

compiler/lib/global_deadcode.ml

@@ -434,7 +434,7 @@ let solver vars uses defs live_vars scoped_live_vars =
     + They are returned; or
     + They are applied to a function.
  *)
-let zero prog sentinal live_table =
+let zero prog pure_funs sentinal live_table =
   let compact_vars vars =
     let i = ref (Array.length vars - 1) in
     while !i >= 0 && Var.equal vars.(!i) sentinal do
@@ -483,13 +483,17 @@ let zero prog sentinal live_table =
       (* Zero out return values in last instruction, otherwise do nothing. *)
       match block.branch with
       | Return x ->
-          let tc =
-            (* We don't want to break tailcalls. *)
+          let live_tc =
+            (* Don't break tailcalls, it's needed for generate_closure
+               and effects passes.  If the (tail)call is dead, it will
+               be eliminated later by the deadcode pass, don't make it live again by
+               returning its result. *)
             match List.last body with
-            | Some (Let (x', Apply _)) when Code.Var.equal x' x -> true
+            | Some (Let (x', (Apply _ as e))) ->
+                Code.Var.equal x x' && (is_live x' || not (Pure_fun.pure_expr pure_funs e))
             | Some _ | None -> false
           in
-          if tc then Return x else Return (zero_var x)
+          if live_tc then Return x else Return (zero_var x)
       | Raise (_, _)
       | Stop | Branch _
       | Cond (_, _, _)
@@ -581,7 +585,7 @@ let f p ~deadcode_sentinal global_info =
     Print.print_uses uses;
     Print.print_live_tbl live_table);
   (* Zero out dead fields *)
-  let p = zero p deadcode_sentinal live_table in
+  let p = zero p pure_funs deadcode_sentinal live_table in
   if debug ()
   then (
     Format.eprintf "After Zeroing:@.";

compiler/tests-compiler/tailcall.ml

@@ -111,3 +111,33 @@ let%expect_test _ =
     }
     //end
     |}]
+
+let%expect_test "global-deadcode-bug" =
+  let prog =
+    {|
+     let log_success () = print_endline "Success!"
+     type t = { a : bool; b : bool }
+     let fun1 () =
+     let g f = if f.b then true else false in
+     let f x = print_endline "here"; g { a = true; b = false} in
+     let _ = (f 5000) in
+     log_success ()
+     let () = fun1 ()
+    |}
+  in
+  Util.compile_and_run ~flags:[ "--disable"; "inline" ] prog;
+  [%expect {|
+    here
+    Success!
+    |}];
+  let program = Util.compile_and_parse ~flags:[ "--disable"; "inline" ] prog in
+  Util.print_fun_decl program (Some "fun1");
+  [%expect
+    {|
+    function fun1(param){
+     function f(x){caml_call1(Stdlib[46], cst_here);}
+     f(5000);
+     return log_success(0);
+    }
+    //end
+    |}]