Merge branch 'new_deadcode' of https://github.com/micahcantor/js_of_o…

…caml into new_deadcode

CHANGES.md

@@ -3,6 +3,7 @@
 ## Features/Changes
 * Compiler: change control-flow compilation strategy (#1496)
 * Lib: add download attribute to anchor element
+* Dead code elimination of unused references (#2076)
 
 ## Bug fixes
 * Runtime: fix Dom_html.onIE (#1493)

compiler/lib/deadcode.ml

@@ -28,6 +28,11 @@ open Code
 type def =
   | Expr of expr
   | Var of Var.t
+  | Field_update of Var.t
+
+let add_def defs x i =
+  let idx = Var.idx x in
+  defs.(idx) <- i :: defs.(idx)
 
 type variable_uses = int array
 
@@ -48,11 +53,15 @@ let pure_expr pure_funs e = Pure_fun.pure_expr pure_funs e && Config.Flag.deadco
 let rec mark_var st x =
   let x = Var.idx x in
   st.live.(x) <- st.live.(x) + 1;
-  if st.live.(x) = 1 then List.iter st.defs.(x) ~f:(fun e -> mark_def st e)
+  if st.live.(x) = 1 then List.iter st.defs.(x) ~f:(fun e -> mark_def st x e)
 
-and mark_def st d =
+and mark_def st x d =
   match d with
-  | Var x -> mark_var st x
+  | Var y -> mark_var st y
+  | Field_update y ->
+      (* A [Set_field (x, _, y)] becomes live *)
+      st.live.(x) <- st.live.(x) + 1;
+      mark_var st y
   | Expr e -> if pure_expr st.pure_funs e then mark_expr st e
 
 and mark_expr st e =
@@ -81,9 +90,14 @@ and mark_reachable st pc =
         match i with
         | Let (_, e) -> if not (pure_expr st.pure_funs e) then mark_expr st e
         | Assign _ -> ()
-        | Set_field (x, _, y) ->
-            mark_var st x;
-            mark_var st y
+        | Set_field (x, _, y) -> (
+            match st.defs.(Var.idx x) with
+            | [ Expr (Block _) ] when st.live.(Var.idx x) = 0 ->
+                (* We will keep this instruction only if x is live *)
+                add_def st.defs x (Field_update y)
+            | _ ->
+                mark_var st x;
+                mark_var st y)
         | Array_set (x, y, z) ->
             mark_var st x;
             mark_var st y;
@@ -109,8 +123,8 @@ and mark_reachable st pc =
 let live_instr st i =
   match i with
   | Let (x, e) -> st.live.(Var.idx x) > 0 || not (pure_expr st.pure_funs e)
-  | Assign (x, _) -> st.live.(Var.idx x) > 0
-  | Set_field _ | Offset_ref _ | Array_set _ -> true
+  | Assign (x, _) | Set_field (x, _, _) -> st.live.(Var.idx x) > 0
+  | Offset_ref _ | Array_set _ -> true
 
 let rec filter_args st pl al =
   match pl, al with
@@ -165,10 +179,6 @@ let annot st pc xi =
 
 (****)
 
-let add_def defs x i =
-  let idx = Var.idx x in
-  defs.(idx) <- i :: defs.(idx)
-
 let rec add_arg_dep defs params args =
   match params, args with
   | x :: params, y :: args ->

compiler/tests-compiler/effects_continuations.ml

@@ -158,7 +158,7 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
     }
     //end
     function loop1(b, cont){
-     var all = [0, 0], _m_ = Stdlib[79];
+     var _m_ = Stdlib[79];
      return caml_cps_call2
              (_m_,
               cst_static_examples_ml,
@@ -169,7 +169,6 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
                         (_o_,
                          ic,
                          function(line){
-                          all[1] = [0, line, all[1]];
                           return b
                                   ? caml_cps_call2(Stdlib[53], line, _n_)
                                   : caml_cps_exact_call1(_n_, 0);
@@ -180,7 +179,7 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
     }
     //end
     function loop2(param, cont){
-     var all = [0, 0], _h_ = Stdlib[79];
+     var _h_ = Stdlib[79];
      return caml_cps_call2
              (_h_,
               cst_static_examples_ml$0,
@@ -192,7 +191,6 @@ let%expect_test "test-compiler/lib-effects/test1.ml" =
                         (_k_,
                          ic,
                          function(line){
-                          all[1] = [0, line, all[1]];
                           return caml_cps_call2(Stdlib[53], line, _j_);
                          });
                }

compiler/tests-compiler/error.ml

@@ -32,7 +32,6 @@ let%expect_test "uncaugh error" =
     {|
     Fatal error: exception Not_found
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   compile_and_run_bytecode prog;
@@ -57,7 +56,6 @@ let _ = raise C |}
     {|
     Fatal error: exception Test.C
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -74,7 +72,6 @@ let _ = raise (D(2,"test",43L))
     {|
     Fatal error: exception Test.D(2, "test", _)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -89,7 +86,6 @@ let _ = assert false |}
     {|
     Fatal error: exception Assert_failure("test.ml", 4, 8)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
   let prog =
@@ -104,7 +100,6 @@ let () = Callback.register "Printexc.handle_uncaught_exception" null
     {|
     Fatal error: exception Match_failure("test.ml", 4, 33)
 
-
     process exited with error code 2
      %{NODE} test.js |}];
 

compiler/tests-jsoo/bin/error1-unregister.expected

@@ -1,2 +1 @@
 Fatal error: exception Dune__exe__Error1.D(2, "test", _)
-

compiler/tests-jsoo/bin/error2-unregister.expected

@@ -1,2 +1 @@
 Fatal error: exception Match_failure("compiler/tests-jsoo/bin/error2.ml", 13, 2)
-

compiler/tests-ocaml/lib-effects/unhandled_unlinked.reference

@@ -1,2 +1 @@
 Fatal error: exception Effect.Unhandled
-

runtime/sys.js

@@ -90,7 +90,7 @@ function caml_fatal_uncaught_exception(err){
       var msg = caml_format_exception(err);
       var at_exit = caml_named_value("Pervasives.do_at_exit");
       if(at_exit) caml_callback(at_exit, [0]);
-      console.error("Fatal error: exception " + msg + "\n");
+      console.error("Fatal error: exception " + msg);
       if(err.js_error) throw err.js_error;
     }
   }