Compiler: Global Deadcode Elimination (#1503)

fix  #595 
---------

Co-authored-by: Jérôme Vouillon <[email protected]>
Co-authored-by: Hugo Heuzard <[email protected]>

CHANGES.md

@@ -1,6 +1,7 @@
 # Dev (2023-??-??) - ??
 
 ## Features/Changes
+* Compiler: global dead code elimination (Micah Cantor, #1503)
 * Compiler: change control-flow compilation strategy (#1496)
 * Compiler: Dead code elimination of unused references (#2076)
 * Compiler: reduce memory consumption (#1516)

TODO.txt

@@ -12,10 +12,6 @@ Compiler optimizations
 
 - cross-function optimizations
 
-- deadcode elimination inside blocks
-  (for instance, elimination of function which are defined in a
-   functor but are not used)
-
 - should we rebind variables from a deeper level ?
   (only if used more than once...)
 

compiler/lib/code.mli

@@ -222,6 +222,10 @@ module Print : sig
     | Instr of (instr * loc)
     | Last of (last * loc)
 
+  val expr : Format.formatter -> expr -> unit
+
+  val constant : Format.formatter -> constant -> unit
+
   val var_list : Format.formatter -> Var.t list -> unit
 
   val instr : Format.formatter -> instr * loc -> unit

compiler/lib/config.ml

@@ -58,6 +58,8 @@ module Flag = struct
 
   let deadcode = o ~name:"deadcode" ~default:true
 
+  let globaldeadcode = o ~name:"globaldeadcode" ~default:true
+
   let shortvar = o ~name:"shortvar" ~default:true
 
   let compact = o ~name:"compact" ~default:true

compiler/lib/config.mli

@@ -25,6 +25,8 @@ module Flag : sig
 
   val deadcode : unit -> bool
 
+  val globaldeadcode : unit -> bool
+
   val optcall : unit -> bool
 
   val shortvar : unit -> bool

compiler/lib/driver.ml

@@ -97,6 +97,10 @@ let effects p =
   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
   if not (Config.Flag.effects ())
   then
     let fast =
@@ -105,8 +109,14 @@ let exact_calls profile p =
       | O1 | O2 -> true
     in
     let info = Global_flow.f ~fast p in
-    Specialize.f ~function_arity:(fun f -> Global_flow.function_arity info f) p
-  else p
+    let p =
+      if Config.Flag.globaldeadcode () && Config.Flag.deadcode ()
+      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
 
 let print p =
   if debug () then Code.Print.program (fun _ _ -> "") p;
@@ -175,7 +185,7 @@ let generate
     ~exported_runtime
     ~wrap_with_fun
     ~warn_on_unhandled_effect
-    ((p, live_vars), cps_calls) =
+    (((p, live_vars), cps_calls), deadcode_sentinal) =
   if times () then Format.eprintf "Start Generation...@.";
   let should_export = should_export wrap_with_fun in
   Generate.f
@@ -185,6 +195,7 @@ let generate
     ~cps_calls
     ~should_export
     ~warn_on_unhandled_effect
+    ~deadcode_sentinal
     d
 
 let debug_linker = Debug.find "linker"
@@ -579,8 +590,7 @@ let full ~standalone ~wrap_with_fun ~profile ~linkall ~source_map formatter d p
        | O2 -> o2
        | O3 -> o3)
     +> exact_calls profile
-    +> effects
-    +> map_fst (Generate_closure.f +> deadcode')
+    +> map_fst (effects +> map_fst (Generate_closure.f +> deadcode'))
   in
   let emit =
     generate d ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone

compiler/lib/generate.ml

@@ -285,12 +285,14 @@ module Ctx = struct
     ; should_export : bool
     ; effect_warning : bool ref
     ; cps_calls : Effects.cps_calls
+    ; deadcode_sentinal : Var.t
     }
 
   let initial
       ~warn_on_unhandled_effect
       ~exported_runtime
       ~should_export
+      ~deadcode_sentinal
       blocks
       live
       cps_calls
@@ -304,6 +306,7 @@ module Ctx = struct
     ; should_export
     ; effect_warning = ref (not warn_on_unhandled_effect)
     ; cps_calls
+    ; deadcode_sentinal
     }
 end
 
@@ -444,7 +447,7 @@ let rec constant_rec ~ctx x level instrs =
   | Float_array a ->
       ( Mlvalue.Array.make
           ~tag:Obj.double_array_tag
-          ~args:(Array.to_list (Array.map a ~f:float_const))
+          ~args:(Array.to_list (Array.map a ~f:(fun x -> J.Element (float_const x))))
       , instrs )
   | Int64 i ->
       let p =
@@ -490,9 +493,9 @@ let rec constant_rec ~ctx x level instrs =
                       let instrs =
                         (J.variable_declaration [ J.V v, (js, J.N) ], J.N) :: instrs
                       in
-                      J.EVar (J.V v) :: acc, instrs
-                  | _ -> js :: acc, instrs)
-            else List.rev l, instrs
+                      J.Element (J.EVar (J.V v)) :: acc, instrs
+                  | _ -> J.Element js :: acc, instrs)
+            else List.map ~f:(fun x -> J.Element x) (List.rev l), instrs
           in
           Mlvalue.Block.make ~tag ~args:l, instrs)
   | Int i -> int32 i, instrs
@@ -1037,6 +1040,14 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
         List.fold_right
           ~f:(fun x (args, prop, queue) ->
             let (prop', cx), queue = access_queue queue x in
+            let cx =
+              match cx with
+              | J.EVar (J.V v) ->
+                  if Var.equal v ctx.deadcode_sentinal
+                  then J.ElementHole
+                  else J.Element cx
+              | _ -> J.Element cx
+            in
             cx :: args, or_p prop prop', queue)
           (Array.to_list a)
           ~init:([], const_p, queue)
@@ -1133,6 +1144,9 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
             let prim = Share.get_prim (runtime_fun ctx) name ctx.Ctx.share in
             prim, const_p, queue
         | Extern "%closure", _ -> assert false
+        | Extern "%undefined", [] ->
+            J.(EVar (ident (Utf8_string.of_string_exn "undefined"))), const_p, queue
+        | Extern "%undefined", _ -> assert false
         | Extern "%caml_js_opt_call", f :: o :: l ->
             let (pf, cf), queue = access_queue' ~ctx queue f in
             let (po, co), queue = access_queue' ~ctx queue o in
@@ -1582,7 +1596,10 @@ and compile_conditional st queue ~fall_through last scope_stack : _ * _ =
     match last with
     | Return x ->
         let (_px, cx), queue = access_queue queue x in
-        true, flush_all queue [ J.Return_statement (Some cx), loc ]
+        let return_expr =
+          if Var.equal st.ctx.deadcode_sentinal x then None else Some cx
+        in
+        true, flush_all queue [ J.Return_statement return_expr, loc ]
     | Raise (x, k) ->
         let (_px, cx), queue = access_queue queue x in
         true, flush_all queue (throw_statement st.ctx cx k loc)
@@ -1791,6 +1808,7 @@ let f
     ~cps_calls
     ~should_export
     ~warn_on_unhandled_effect
+    ~deadcode_sentinal
     debug =
   let t' = Timer.make () in
   let share = Share.get ~cps_calls ~alias_prims:exported_runtime p in
@@ -1802,6 +1820,7 @@ let f
       ~warn_on_unhandled_effect
       ~exported_runtime
       ~should_export
+      ~deadcode_sentinal
       p.blocks
       live_vars
       cps_calls

compiler/lib/generate.mli

@@ -25,6 +25,7 @@ val f :
   -> cps_calls:Effects.cps_calls
   -> should_export:bool
   -> warn_on_unhandled_effect:bool
+  -> deadcode_sentinal:Code.Var.t
   -> Parse_bytecode.Debug.t
   -> Javascript.program