Replace Cfg_with_liveness with Cfg_with_infos (oxcaml#1521)

Author: xclerc

backend/asmgen.ml

@@ -293,19 +293,19 @@ let compile_fundecl ~ppf_dump ~funcnames fd_cmm =
         let cfg =
           fd
           ++ Profile.record ~accumulate:true "cfgize" cfgize
-          ++ Cfg_with_liveness.make
+          ++ Cfg_with_infos.make
           ++ Profile.record ~accumulate:true "cfg_deadcode" Cfg_deadcode.run
         in
         let cfg_description =
-            Regalloc_validate.Description.create (Cfg_with_liveness.cfg_with_layout cfg)
+            Regalloc_validate.Description.create (Cfg_with_infos.cfg_with_layout cfg)
         in
         cfg
         ++ begin match regalloc with
           | IRC -> Profile.record ~accumulate:true "cfg_irc" Regalloc_irc.run
           | LS -> Profile.record ~accumulate:true "cfg_ls" Regalloc_ls.run
           | Upstream -> assert false
         end
-        ++ Cfg_with_liveness.cfg_with_layout
+        ++ Cfg_with_infos.cfg_with_layout
         ++ Profile.record ~accumulate:true "cfg_validate_description" (Regalloc_validate.run cfg_description)
         ++ Profile.record ~accumulate:true "cfg_simplify" Regalloc_utils.simplify_cfg
         ++ Profile.record ~accumulate:true "save_cfg" save_cfg

backend/cfg/cfg_deadcode.ml

@@ -4,7 +4,7 @@ open! Regalloc_utils
 module DLL = Flambda_backend_utils.Doubly_linked_list
 
 let live_before :
-    type a. a Cfg.instruction -> Cfg_with_liveness.liveness -> Reg.Set.t =
+    type a. a Cfg.instruction -> Cfg_with_infos.liveness -> Reg.Set.t =
  fun instr liveness ->
   match Cfg_dataflow.Instr.Tbl.find_opt liveness instr.id with
   | None -> fatal "no liveness information for instruction %d" instr.id
@@ -28,12 +28,11 @@ let remove_deadcode (body : Cfg.basic_instruction_list) changed liveness
       changed := !changed || is_deadcode;
       not is_deadcode)
 
-let run cfg_with_liveness =
-  let liveness = Cfg_with_liveness.liveness cfg_with_liveness in
+let run cfg_with_infos =
+  let liveness = Cfg_with_infos.liveness cfg_with_infos in
   let changed = ref false in
-  Cfg.iter_blocks (Cfg_with_liveness.cfg cfg_with_liveness)
-    ~f:(fun _label block ->
+  Cfg.iter_blocks (Cfg_with_infos.cfg cfg_with_infos) ~f:(fun _label block ->
       remove_deadcode block.body changed liveness
         (live_before block.terminator liveness));
-  if !changed then Cfg_with_liveness.invalidate_liveness cfg_with_liveness;
-  cfg_with_liveness
+  if !changed then Cfg_with_infos.invalidate_liveness cfg_with_infos;
+  cfg_with_infos

backend/cfg/cfg_deadcode.mli

@@ -2,4 +2,4 @@
 
 (* Dead code elimination: remove pure instructions whose results are not
    used. *)
-val run : Cfg_with_liveness.t -> Cfg_with_liveness.t
+val run : Cfg_with_infos.t -> Cfg_with_infos.t

backend/cfg/cfg_with_infos.ml

@@ -0,0 +1,67 @@
+[@@@ocaml.warning "+a-30-40-41-42"]
+
+type liveness = Cfg_liveness.Liveness.domain Cfg_dataflow.Instr.Tbl.t
+
+let liveness_analysis : Cfg_with_layout.t -> liveness =
+ fun cfg_with_layout ->
+  let cfg = Cfg_with_layout.cfg cfg_with_layout in
+  let init = { Cfg_liveness.before = Reg.Set.empty; across = Reg.Set.empty } in
+  match
+    Cfg_liveness.Liveness.run cfg ~init ~map:Cfg_liveness.Liveness.Instr ()
+  with
+  | Ok liveness -> liveness
+  | Aborted _ -> .
+  | Max_iterations_reached ->
+    Misc.fatal_errorf "Unable to compute liveness from CFG for function %s@."
+      cfg.Cfg.fun_name
+
+type t =
+  { cfg_with_layout : Cfg_with_layout.t;
+    liveness : liveness option ref;
+    dominators : Cfg_dominators.t option ref;
+    loop_infos : Cfg_loop_infos.t option ref
+  }
+
+let make cfg_with_layout =
+  { cfg_with_layout;
+    liveness = ref None;
+    dominators = ref None;
+    loop_infos = ref None
+  }
+
+let cfg_with_layout t = t.cfg_with_layout
+
+let cfg t = Cfg_with_layout.cfg t.cfg_with_layout
+
+let fold_blocks t ~f ~init = Cfg.fold_blocks (cfg t) ~f ~init
+
+let get_block_exn t label = Cfg.get_block_exn (cfg t) label
+
+let[@inline] compute_if_necessary r ~f =
+  match !r with
+  | Some value -> value
+  | None ->
+    let value = f () in
+    r := Some value;
+    value
+
+let liveness t =
+  compute_if_necessary t.liveness ~f:(fun () ->
+      liveness_analysis t.cfg_with_layout)
+
+let liveness_find t id = Cfg_dataflow.Instr.Tbl.find (liveness t) id
+
+let liveness_find_opt t id = Cfg_dataflow.Instr.Tbl.find_opt (liveness t) id
+
+let invalidate_liveness t = t.liveness := None
+
+let dominators t =
+  compute_if_necessary t.dominators ~f:(fun () -> Cfg_dominators.build (cfg t))
+
+let loop_infos t =
+  compute_if_necessary t.loop_infos ~f:(fun () ->
+      Cfg_loop_infos.build (cfg t) (dominators t))
+
+let invalidate_dominators_and_loop_infos t =
+  t.dominators := None;
+  t.loop_infos := None

backend/cfg/cfg_with_infos.mli

@@ -0,0 +1,42 @@
+[@@@ocaml.warning "+a-30-40-41-42"]
+
+type liveness = Cfg_liveness.Liveness.domain Cfg_dataflow.Instr.Tbl.t
+
+(** Holds a Cfg_with_layout.t value, and "caches" for:
+    - the liveness information;
+    - the dominators information;
+    - the loop information.
+
+   Each cache can be invalidated, and should be when modification of the
+   underlying CFG would cause the cached information to become invalid.
+
+   Typically, any structural change to the graph, or change to the `arg` and
+   `res` field of the instrutions is likely to result in a different liveness
+   information, but only structural changes to the graph would affect dominators
+   and loop information. *)
+type t
+
+val make : Cfg_with_layout.t -> t
+
+val cfg_with_layout : t -> Cfg_with_layout.t
+
+val cfg : t -> Cfg.t
+
+val fold_blocks :
+  t -> f:(Label.t -> Cfg.basic_block -> 'a -> 'a) -> init:'a -> 'a
+
+val get_block_exn : t -> Label.t -> Cfg.basic_block
+
+val liveness : t -> liveness
+
+val liveness_find : t -> int -> Cfg_liveness.Liveness.domain
+
+val liveness_find_opt : t -> int -> Cfg_liveness.Liveness.domain option
+
+val invalidate_liveness : t -> unit
+
+val dominators : t -> Cfg_dominators.t
+
+val loop_infos : t -> Cfg_loop_infos.t
+
+val invalidate_dominators_and_loop_infos : t -> unit

backend/cfg/cfg_with_liveness.ml

@@ -222,13 +222,13 @@ let postcondition_layout : Cfg_with_layout.t -> unit =
         fatal "register class %d has the following unused slots: %s" reg_class
           (string_of_set unused))
 
-let postcondition_liveness : Cfg_with_liveness.t -> unit =
- fun cfg_with_liveness ->
-  postcondition_layout (Cfg_with_liveness.cfg_with_layout cfg_with_liveness);
-  let cfg = Cfg_with_liveness.cfg cfg_with_liveness in
+let postcondition_liveness : Cfg_with_infos.t -> unit =
+ fun cfg_with_infos ->
+  postcondition_layout (Cfg_with_infos.cfg_with_layout cfg_with_infos);
+  let cfg = Cfg_with_infos.cfg cfg_with_infos in
   let entry_block = Cfg.get_block_exn cfg cfg.entry_label in
   let live_at_entry_point =
-    Cfg_with_liveness.liveness_find cfg_with_liveness
+    Cfg_with_infos.liveness_find cfg_with_infos
       (Cfg.first_instruction_id entry_block)
   in
   Reg.Set.iter

backend/cfg/cfg_with_liveness.mli

@@ -4,4 +4,4 @@ val precondition : Cfg_with_layout.t -> unit
 
 val postcondition_layout : Cfg_with_layout.t -> unit
 
-val postcondition_liveness : Cfg_with_liveness.t -> unit
+val postcondition_liveness : Cfg_with_infos.t -> unit