Linscan (CFG): use DLL.t instead of List.t for ranges (ocaml-flam…

…bda#3169)

backend/regalloc/regalloc_ls.ml

@@ -51,9 +51,9 @@ let build_intervals : State.t -> Cfg_with_infos.t -> unit =
     match Reg.Tbl.find_opt past_ranges reg with
     | None ->
       Reg.Tbl.replace past_ranges reg
-        { Interval.reg; begin_; end_; ranges = [range] }
+        { Interval.reg; begin_; end_; ranges = DLL.make_single range }
     | Some (interval : Interval.t) ->
-      interval.ranges <- range :: interval.ranges;
+      DLL.add_end interval.ranges range;
       interval.end_ <- end_
   in
   let update_range (reg : Reg.t) ~(begin_ : int) ~(end_ : int) : unit =
@@ -104,10 +104,6 @@ let build_intervals : State.t -> Cfg_with_infos.t -> unit =
          present at the end of every "block". *)
       incr pos);
   Reg.Tbl.iter (fun reg (range : Range.t) -> add_range reg range) current_ranges;
-  Reg.Tbl.iter
-    (fun _reg (interval : Interval.t) ->
-      interval.ranges <- List.rev interval.ranges)
-    past_ranges;
   if ls_debug && Lazy.force ls_verbose
   then
     iter_cfg_dfs (Cfg_with_layout.cfg cfg_with_layout) ~f:(fun block ->

backend/regalloc/regalloc_ls_state.ml

@@ -65,25 +65,27 @@ let[@inline] get_and_incr_instruction_id state =
   state.next_instruction_id <- succ res;
   res
 
-let rec check_ranges (prev : Range.t) (l : Range.t list) : int =
+let rec check_ranges (prev : Range.t) (cell : Range.t DLL.cell option) : int =
   if prev.begin_ > prev.end_
   then fatal "Regalloc_ls_state.check_ranges: prev.begin_ > prev.end_";
-  match l with
-  | [] -> prev.end_
-  | hd :: tl ->
-    if prev.end_ >= hd.begin_
+  match cell with
+  | None -> prev.end_
+  | Some cell ->
+    let value = DLL.value cell in
+    if prev.end_ >= value.begin_
     then fatal "Regalloc_ls_state.check_ranges: prev.end_ >= hd.begin_";
-    check_ranges hd tl
+    check_ranges value (DLL.next cell)
 
 let rec check_intervals (prev : Interval.t) (l : Interval.t list) : unit =
   if prev.begin_ > prev.end_
   then fatal "Regalloc_ls_state.check_intervals: prev.begin_ > prev.end_";
-  (match prev.ranges with
-  | [] -> fatal "Regalloc_ls_state.check_intervals: no ranges"
-  | hd :: tl ->
-    if hd.begin_ <> prev.begin_
+  (match DLL.hd_cell prev.ranges with
+  | None -> fatal "Regalloc_ls_state.check_intervals: no ranges"
+  | Some cell ->
+    let value = DLL.value cell in
+    if value.begin_ <> prev.begin_
     then fatal "Regalloc_ls_state.check_intervals: hd.begin_ <> prev.begin_";
-    let end_ = check_ranges hd tl in
+    let end_ = check_ranges value (DLL.next cell) in
     if end_ <> prev.end_
     then fatal "Regalloc_ls_state.check_intervals: end_ <> prev.end_");
   match l with
@@ -93,11 +95,13 @@ let rec check_intervals (prev : Interval.t) (l : Interval.t list) : unit =
     then fatal "Regalloc_ls_state.check_intervals: prev.begin_ > hd.begin_";
     check_intervals hd tl
 
-let rec is_in_a_range ls_order (l : Range.t list) : bool =
-  match l with
-  | [] -> false
-  | hd :: tl ->
-    (ls_order >= hd.begin_ && ls_order <= hd.end_) || is_in_a_range ls_order tl
+let rec is_in_a_range ls_order (cell : Range.t DLL.cell option) : bool =
+  match cell with
+  | None -> false
+  | Some cell ->
+    let value = DLL.value cell in
+    (ls_order >= value.begin_ && ls_order <= value.end_)
+    || is_in_a_range ls_order (DLL.next cell)
 
 let[@inline] invariant_intervals state cfg_with_infos =
   if ls_debug && Lazy.force ls_invariants
@@ -136,7 +140,7 @@ let[@inline] invariant_intervals state cfg_with_infos =
               fatal
                 "Regalloc_ls_state.invariant_intervals: instr.ls_order > \
                  interval.end_";
-            if not (is_in_a_range instr.ls_order interval.ranges)
+            if not (is_in_a_range instr.ls_order (DLL.hd_cell interval.ranges))
             then
               fatal
                 "Regalloc_ls_state.invariant_intervals: not (is_in_a_range \

backend/regalloc/regalloc_ls_utils.ml

@@ -93,63 +93,83 @@ module Range = struct
 
   let print ppf r = Format.fprintf ppf "[%d,%d]" r.begin_ r.end_
 
-  let rec overlap : t list -> t list -> bool =
+  let rec overlap_cell : t DLL.cell option -> t DLL.cell option -> bool =
    fun left right ->
     match left, right with
-    | left_hd :: left_tl, right_hd :: right_tl ->
-      if left_hd.end_ >= right_hd.begin_ && right_hd.end_ >= left_hd.begin_
+    | Some left_cell, Some right_cell ->
+      let left_value = DLL.value left_cell in
+      let right_value = DLL.value right_cell in
+      if left_value.end_ >= right_value.begin_
+         && right_value.end_ >= left_value.begin_
       then true
-      else if left_hd.end_ < right_hd.end_
-      then overlap left_tl right
-      else if left_hd.end_ > right_hd.end_
-      then overlap left right_tl
-      else overlap left_tl right_tl
-    | [], _ | _, [] -> false
-
-  let rec is_live : t list -> pos:int -> bool =
-   fun l ~pos ->
-    match l with
-    | [] -> false
-    | hd :: tl ->
-      if pos < hd.begin_
+      else if left_value.end_ < right_value.end_
+      then overlap_cell (DLL.next left_cell) right
+      else if left_value.end_ > right_value.end_
+      then overlap_cell left (DLL.next right_cell)
+      else overlap_cell (DLL.next left_cell) (DLL.next right_cell)
+    | None, _ | _, None -> false
+
+  let overlap : t DLL.t -> t DLL.t -> bool =
+   fun left right -> overlap_cell (DLL.hd_cell left) (DLL.hd_cell right)
+
+  let rec is_live_cell : t DLL.cell option -> pos:int -> bool =
+   fun cell ~pos ->
+    match cell with
+    | None -> false
+    | Some cell ->
+      let value = DLL.value cell in
+      if pos < value.begin_
       then false
-      else if pos <= hd.end_
+      else if pos <= value.end_
       then true
-      else is_live tl ~pos
-
-  let rec remove_expired : t list -> pos:int -> t list =
-   fun l ~pos ->
-    match l with
-    | [] -> []
-    | hd :: tl -> if pos < hd.end_ then l else remove_expired tl ~pos
+      else is_live_cell (DLL.next cell) ~pos
+
+  let is_live : t DLL.t -> pos:int -> bool =
+   fun l ~pos -> is_live_cell (DLL.hd_cell l) ~pos
+
+  let rec remove_expired_cell : t DLL.cell option -> pos:int -> unit =
+   fun cell ~pos ->
+    match cell with
+    | None -> ()
+    | Some cell ->
+      let value = DLL.value cell in
+      if pos < value.end_
+      then ()
+      else
+        let next = DLL.next cell in
+        DLL.delete_curr cell;
+        remove_expired_cell next ~pos
+
+  let remove_expired : t DLL.t -> pos:int -> unit =
+   fun l ~pos -> remove_expired_cell (DLL.hd_cell l) ~pos
 end
 
 module Interval = struct
   type t =
     { reg : Reg.t;
       mutable begin_ : int;
       mutable end_ : int;
-      mutable ranges : Range.t list
+      ranges : Range.t DLL.t
     }
 
   let copy t =
     { reg = t.reg;
       begin_ = t.begin_;
       end_ = t.end_;
-      ranges = List.map t.ranges ~f:Range.copy
+      ranges = DLL.map t.ranges ~f:Range.copy
     }
 
   let print ppf t =
     Format.fprintf ppf "%a[%d,%d]:" Printmach.reg t.reg t.begin_ t.end_;
-    List.iter t.ranges ~f:(fun r -> Format.fprintf ppf " %a" Range.print r)
+    DLL.iter t.ranges ~f:(fun r -> Format.fprintf ppf " %a" Range.print r)
 
   let overlap : t -> t -> bool =
    fun left right -> Range.overlap left.ranges right.ranges
 
   let is_live : t -> pos:int -> bool = fun t ~pos -> Range.is_live t.ranges ~pos
 
   let remove_expired : t -> pos:int -> unit =
-   fun t ~pos -> t.ranges <- Range.remove_expired t.ranges ~pos
+   fun t ~pos -> Range.remove_expired t.ranges ~pos
 
   module List = struct
     let print ppf l =
@@ -238,11 +258,12 @@ let log_interval ~indent ~kind (interval : Interval.t) =
   let reg_class = Proc.register_class interval.reg in
   log ~indent "%s %a (class %d) [%d..%d]" kind Printmach.reg interval.reg
     reg_class interval.begin_ interval.end_;
-  let ranges =
-    List.map interval.ranges ~f:(fun { Range.begin_; end_ } ->
-        Printf.sprintf "[%d..%d]" begin_ end_)
-  in
-  log ~indent:(succ indent) "%s" (String.concat ", " ranges)
+  let ranges = Buffer.create 128 in
+  let first = ref true in
+  DLL.iter interval.ranges ~f:(fun { Range.begin_; end_ } ->
+      if !first then first := false else Buffer.add_string ranges ", ";
+      Buffer.add_string ranges (Printf.sprintf "[%d..%d]" begin_ end_));
+  log ~indent:(succ indent) "%s" (Buffer.contents ranges)
 
 let log_intervals ~indent ~kind (intervals : Interval.t list) =
   List.iter intervals ~f:(fun (interval : Interval.t) ->

backend/regalloc/regalloc_ls_utils.mli

@@ -1,6 +1,7 @@
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
 open Regalloc_utils
+module DLL = Flambda_backend_utils.Doubly_linked_list
 
 val ls_debug : bool
 
@@ -42,11 +43,11 @@ module Range : sig
 
   val print : Format.formatter -> t -> unit
 
-  val overlap : t list -> t list -> bool
+  val overlap : t DLL.t -> t DLL.t -> bool
 
-  val is_live : t list -> pos:int -> bool
+  val is_live : t DLL.t -> pos:int -> bool
 
-  val remove_expired : t list -> pos:int -> t list
+  val remove_expired : t DLL.t -> pos:int -> unit
 end
 
 module Interval : sig
@@ -55,7 +56,7 @@ module Interval : sig
     { reg : Reg.t;
       mutable begin_ : int;
       mutable end_ : int;
-      mutable ranges : Range.t list
+      ranges : Range.t DLL.t
     }
 
   val copy : t -> t

utils/doubly_linked_list.ml

@@ -362,3 +362,8 @@ let transfer ~to_ ~from () =
     from.first <- Empty;
     from.last <- Empty;
     from.length <- 0
+
+let map t ~f =
+  let res = make_empty () in
+  iter t ~f:(fun x -> add_end res (f x));
+  res

utils/doubly_linked_list.mli

@@ -82,3 +82,5 @@ val to_list : 'a t -> 'a list
 
 (* Adds all of the elements of `from` to `to_`, and clears `from`. *)
 val transfer : to_:'a t -> from:'a t -> unit -> unit
+
+val map : 'a t -> f:('a -> 'b) -> 'b t