Simplify the logging logic (register allocators) (#3777)

backend/regalloc/regalloc_gi.ml

@@ -8,13 +8,9 @@ module State = Regalloc_gi_state
 module Utils = struct
   include Regalloc_gi_utils
 
-  let debug = gi_debug
+  let debug = debug
 
-  let invariants = gi_invariants
-
-  let log = log
-
-  let log_body_and_terminator = log_body_and_terminator
+  let invariants = invariants
 
   let is_spilled reg = reg.Reg.spill
 
@@ -43,7 +39,7 @@ let rewrite : State.t -> Cfg_with_infos.t -> spilled_nodes:Reg.t list -> bool =
 
 let update_register_locations : State.t -> unit =
  fun state ->
-  if gi_debug
+  if debug
   then (
     log "update_register_locations";
     indent ());
@@ -57,14 +53,14 @@ let update_register_locations : State.t -> unit =
         (* a register may "disappear" because of split/rename *)
         ()
       | Some location ->
-        if gi_debug
+        if debug
         then
           log "updating %a to %a" Printreg.reg reg
             Hardware_register.print_location location;
         reg.Reg.loc <- Hardware_register.reg_location_of_location location)
   in
   List.iter (Reg.all_registers ()) ~f:update_register;
-  if gi_debug then dedent ()
+  if debug then dedent ()
 
 module Prio_queue = Make_max_priority_queue (Int)
 
@@ -78,7 +74,7 @@ let priority_heuristics : Reg.t -> Interval.t -> int =
 
 let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
     Hardware_registers.t * prio_queue =
-  if gi_debug
+  if debug
   then (
     log "creating registers and queue";
     indent ());
@@ -92,7 +88,7 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
     (fun reg interval ->
       match reg.loc with
       | Reg _ -> (
-        if gi_debug
+        if debug
         then (
           log "pre-assigned register %a" Printreg.reg reg;
           indent ();
@@ -104,7 +100,7 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
           Hardware_register.add_non_evictable hardware_reg reg interval)
       | Unknown ->
         let priority = priority_heuristics reg interval in
-        if gi_debug
+        if debug
         then (
           log "register %a" Printreg.reg reg;
           indent ();
@@ -113,15 +109,15 @@ let make_hardware_registers_and_prio_queue (cfg_with_infos : Cfg_with_infos.t) :
           dedent ());
         Prio_queue.add prio_queue ~priority ~data:(reg, interval)
       | Stack _ ->
-        if gi_debug
+        if debug
         then (
           log "stack register %a" Printreg.reg reg;
           indent ();
           log "%a" Interval.print interval;
           dedent ());
         ())
     intervals;
-  if gi_debug then dedent ();
+  if debug then dedent ();
   hardware_registers, prio_queue
 
 (* CR xclerc for xclerc: try to find a reasonable threshold. *)
@@ -144,15 +140,15 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
     fatal "register allocation introduced %d temporaries after starting with %d"
       (State.introduced_temporary_count state)
       (State.initial_temporary_count state);
-  if gi_debug
+  if debug
   then (
     log "main, round #%d" round;
     log_cfg_with_infos cfg_with_infos);
-  if gi_debug then log "updating spilling costs";
+  if debug then log "updating spilling costs";
   update_spill_cost cfg_with_infos ~flat ();
   State.iter_introduced_temporaries state ~f:(fun (reg : Reg.t) ->
       reg.Reg.spill_cost <- reg.Reg.spill_cost + 10_000);
-  if gi_debug
+  if debug
   then (
     log "spilling costs";
     indent ();
@@ -168,19 +164,19 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
   indent ();
   while not (Prio_queue.is_empty prio_queue) do
     incr step;
-    if gi_debug then log "step #%d (size=%d)" !step (Prio_queue.size prio_queue);
+    if debug then log "step #%d (size=%d)" !step (Prio_queue.size prio_queue);
     let { Prio_queue.priority; data = reg, interval } =
       Prio_queue.get_and_remove prio_queue
     in
-    if gi_debug
+    if debug
     then (
       indent ();
       log "got register %a (prio=%d)" Printreg.reg reg priority);
     (match
        Hardware_registers.find_available hardware_registers reg interval
      with
     | For_assignment { hardware_reg } ->
-      if gi_debug
+      if debug
       then
         log "assigning %a to %a" Printreg.reg reg
           Hardware_register.print_location hardware_reg.location;
@@ -189,7 +185,7 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
         <- { Hardware_register.pseudo_reg = reg; interval; evictable = true }
            :: hardware_reg.assigned
     | For_eviction { hardware_reg; evicted_regs } ->
-      if gi_debug
+      if debug
       then
         log "evicting %a from %a" Printreg.regs
           (Array.of_list
@@ -225,16 +221,16 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
                          Reg.same r r')))
     | Split_or_spill ->
       (* CR xclerc for xclerc: we should actually try to split. *)
-      if gi_debug then log "spilling %a" Printreg.reg reg;
+      if debug then log "spilling %a" Printreg.reg reg;
       reg.Reg.spill <- true;
       spilling := (reg, interval) :: !spilling);
-    if gi_debug then dedent ()
+    if debug then dedent ()
   done;
   dedent ();
   match !spilling with
   | [] -> ()
   | _ :: _ as spilled_nodes -> (
-    if gi_debug
+    if debug
     then (
       log_cfg_with_infos cfg_with_infos;
       indent ();
@@ -269,11 +265,12 @@ let rec main : round:int -> flat:bool -> State.t -> Cfg_with_infos.t -> unit =
       rewrite state cfg_with_infos
         ~spilled_nodes:(List.map spilled_nodes ~f:fst)
     with
-    | false -> if gi_debug then log "(end of main)"
+    | false -> if debug then log "(end of main)"
     | true -> main ~round:(succ round) ~flat state cfg_with_infos)
 
 let run : Cfg_with_infos.t -> Cfg_with_infos.t =
  fun cfg_with_infos ->
+  if debug then reset_indentation ();
   let cfg_with_layout = Cfg_with_infos.cfg_with_layout cfg_with_infos in
   let cfg_infos, stack_slots =
     Regalloc_rewrite.prelude
@@ -285,7 +282,7 @@ let run : Cfg_with_infos.t -> Cfg_with_infos.t =
      the creation of the state to `prelude`. *)
   let all_temporaries = Reg.Set.union cfg_infos.arg cfg_infos.res in
   let initial_temporaries = Reg.Set.cardinal all_temporaries in
-  if gi_debug then log "#temporaries=%d" initial_temporaries;
+  if debug then log "#temporaries=%d" initial_temporaries;
   let state =
     State.make ~stack_slots ~initial_temporaries
       ~last_used:cfg_infos.max_instruction_id
@@ -306,7 +303,7 @@ let run : Cfg_with_infos.t -> Cfg_with_infos.t =
     | Random_for_testing -> Spilling_heuristics.random ()
   in
   main ~round:1 ~flat state cfg_with_infos;
-  if gi_debug
+  if debug
   then (
     indent ();
     log_cfg_with_infos cfg_with_infos;

backend/regalloc/regalloc_gi_utils.ml

@@ -4,21 +4,16 @@ open! Int_replace_polymorphic_compare
 open! Regalloc_utils
 module DLL = Flambda_backend_utils.Doubly_linked_list
 
-let gi_debug = true
-
 let gi_rng = Random.State.make [| 4; 6; 2 |]
 
-let bool_of_param param_name =
-  bool_of_param ~guard:(gi_debug, "gi_debug") param_name
-
-let gi_invariants : bool Lazy.t = bool_of_param "GI_INVARIANTS"
-
 let log_function = lazy (make_log_function ~label:"gi")
 
 let indent () = (Lazy.force log_function).indent ()
 
 let dedent () = (Lazy.force log_function).dedent ()
 
+let reset_indentation () = (Lazy.force log_function).reset_indentation ()
+
 let log : type a. ?no_eol:unit -> (a, Format.formatter, unit) format -> a =
  fun ?no_eol fmt -> (Lazy.force log_function).log ?no_eol fmt
 
@@ -454,7 +449,7 @@ end
 
 let build_intervals : Cfg_with_infos.t -> Interval.t Reg.Tbl.t =
  fun cfg_with_infos ->
-  if gi_debug
+  if debug
   then (
     log "build_intervals";
     indent ());
@@ -521,12 +516,12 @@ let build_intervals : Cfg_with_infos.t -> Interval.t Reg.Tbl.t =
     (fun _reg (interval : Interval.t) ->
       interval.ranges <- List.rev interval.ranges)
     past_ranges;
-  if gi_debug && Lazy.force verbose
+  if debug && Lazy.force verbose
   then
     iter_cfg_layout cfg_with_layout ~f:(fun block ->
         log "(block %a)" Label.format block.start;
         log_body_and_terminator block.body block.terminator liveness);
-  if gi_debug then dedent ();
+  if debug then dedent ();
   past_ranges
 
 module Hardware_register = struct
@@ -633,7 +628,7 @@ module Hardware_registers = struct
 
   let overlap (hardware_reg : Hardware_register.t) (interval : Interval.t) :
       bool =
-    if gi_debug
+    if debug
     then (
       log "considering %a" Hardware_register.print_location
         hardware_reg.location;
@@ -646,7 +641,7 @@ module Hardware_registers = struct
            -> Interval.overlap itv interval)
     in
     let overlap = overlap_hard || overlap_assigned in
-    if gi_debug
+    if debug
     then (
       log "overlap=%B (hard=%B, assigned=%B)" overlap overlap_hard
         overlap_assigned;
@@ -676,7 +671,7 @@ module Hardware_registers = struct
   let find_evictable (t : t) (reg : Reg.t) (interval : Interval.t) : available =
     let eviction =
       fold_class t ~of_reg:reg ~init:None ~f:(fun acc hardware_reg ->
-          if gi_debug
+          if debug
           then
             log "considering %a (length=%d)" Hardware_register.print_location
               hardware_reg.location
@@ -685,7 +680,7 @@ module Hardware_registers = struct
           if overlap_hard
           then acc
           else (
-            if gi_debug then indent ();
+            if debug then indent ();
             let overlaping : Hardware_register.assigned list =
               List.filter hardware_reg.assigned
                 ~f:(fun
@@ -695,7 +690,7 @@ module Hardware_registers = struct
                      }
                    ->
                   let overlap = Interval.overlap interval itv in
-                  if gi_debug
+                  if debug
                   then
                     log "%a is assigned / overlap=%B" Printreg.reg pseudo_reg
                       overlap;
@@ -712,7 +707,7 @@ module Hardware_registers = struct
                    ->
                   acc_cost + actual_cost pseudo_reg, acc_evictable && evictable)
             in
-            if gi_debug then dedent ();
+            if debug then dedent ();
             if not evictable
             then acc
             else
@@ -721,7 +716,7 @@ module Hardware_registers = struct
               in
               if cost < evict_cost && cost < actual_cost reg
               then (
-                if gi_debug
+                if debug
                 then
                   List.iter overlaping ~f:(fun assigned ->
                       log "evicting %a" Hardware_register.print_assigned
@@ -746,21 +741,20 @@ module Hardware_registers = struct
       match heuristic with
       | Selection_heuristics.Random_for_testing -> assert false
       | Selection_heuristics.First_available ->
-        if gi_debug
+        if debug
         then log "trying to find an available register with 'first-available'";
         find_first t reg interval
       | Selection_heuristics.Best_fit ->
-        if gi_debug
-        then log "trying to find an available register with 'best-fit'";
+        if debug then log "trying to find an available register with 'best-fit'";
         find_using_length t reg interval ~better:( > )
       | Selection_heuristics.Worst_fit ->
-        if gi_debug
+        if debug
         then log "trying to find an available register with 'worst-fit'";
         find_using_length t reg interval ~better:( < )
     in
     match with_no_overlap with
     | Some hardware_reg -> For_assignment { hardware_reg }
     | None ->
-      if gi_debug then log "trying to find an evictable register";
+      if debug then log "trying to find an evictable register";
       find_evictable t reg interval
 end

backend/regalloc/regalloc_gi_utils.mli

@@ -2,16 +2,14 @@
 
 open Regalloc_utils
 
-val gi_debug : bool
-
-val gi_invariants : bool Lazy.t
-
 val log : ?no_eol:unit -> ('a, Format.formatter, unit) format -> 'a
 
 val indent : unit -> unit
 
 val dedent : unit -> unit
 
+val reset_indentation : unit -> unit
+
 val log_body_and_terminator :
   Cfg.basic_instruction_list ->
   Cfg.terminator Cfg.instruction ->