Make instruction identifiers abstract (#3635)

backend/amd64/cfg_selection.ml

@@ -345,5 +345,5 @@ class selector =
   end
 
 let fundecl ~future_funcnames f =
-  Cfg.reset_next_instr_id ();
+  Cfg.reset_instr_id ();
   (new selector)#emit_fundecl ~future_funcnames f

backend/amd64/emit.ml

@@ -2807,4 +2807,3 @@ let end_assembly () =
   (* The internal assembler does not work if reset_all is called here *)
   if not !Flambda_backend_flags.internal_assembler then
     reset_all ()
-

backend/arm64/cfg_selection.ml

@@ -180,5 +180,5 @@ class selector =
   end
 
 let fundecl ~future_funcnames f =
-  Cfg.reset_next_instr_id ();
+  Cfg.reset_instr_id ();
   (new selector)#emit_fundecl ~future_funcnames f

backend/cfg/cfg.ml

@@ -218,7 +218,7 @@ let map_first_instruction (block : basic_block) (t : 'a instr_mapper) =
   | None -> t.f block.terminator
   | Some first_instr -> t.f first_instr
 
-let first_instruction_id (block : basic_block) : int =
+let first_instruction_id (block : basic_block) : InstructionId.t =
   map_first_instruction block { f = (fun instr -> instr.id) }
 
 let first_instruction_stack_offset (block : basic_block) : int =
@@ -527,14 +527,11 @@ let make_instruction ~desc ?(arg = [||]) ?(res = [||]) ?(dbg = Debuginfo.none)
     available_across
   }
 
-let next_instr_id = ref 0
+let instr_id = InstructionId.make_sequence ()
 
-let reset_next_instr_id () = next_instr_id := 0
+let reset_instr_id () = InstructionId.reset instr_id
 
-let next_instr_id () : int =
-  let res = !next_instr_id in
-  incr next_instr_id;
-  res
+let next_instr_id () = InstructionId.get_next instr_id
 
 let make_instr desc arg res dbg =
   { desc;
@@ -594,3 +591,13 @@ let basic_block_contains_calls block =
          match[@ocaml.warning "-4"] instr.desc with
          | Op (Alloc _ | Poll) -> true
          | _ -> false)
+
+let max_instr_id t =
+  (* CR-someday xclerc for xclerc: factor out with similar function in
+     regalloc/. *)
+  fold_blocks t ~init:InstructionId.none ~f:(fun _label block max_id ->
+      let max_id =
+        DLL.fold_left block.body ~init:max_id ~f:(fun max_id instr ->
+            InstructionId.max max_id instr.id)
+      in
+      InstructionId.max max_id block.terminator.id)

backend/cfg/cfg.mli

@@ -135,7 +135,7 @@ val replace_successor_labels :
     vice versa. *)
 val can_raise_interproc : basic_block -> bool
 
-val first_instruction_id : basic_block -> int
+val first_instruction_id : basic_block -> InstructionId.t
 
 val first_instruction_stack_offset : basic_block -> int
 
@@ -217,7 +217,7 @@ val make_instruction :
   ?fdo:Fdo_info.t ->
   ?live:Reg.Set.t ->
   stack_offset:int ->
-  id:int ->
+  id:InstructionId.t ->
   ?irc_work_list:irc_work_list ->
   ?ls_order:int ->
   ?available_before:Reg_availability_set.t option ->
@@ -230,11 +230,14 @@ val make_instr :
   'a -> Reg.t array -> Reg.t array -> Debuginfo.t -> 'a instruction
 
 (** These IDs are also used by [make_instr] *)
-val next_instr_id : unit -> int
+val next_instr_id : unit -> InstructionId.t
 
-val reset_next_instr_id : unit -> unit
+val reset_instr_id : unit -> unit
 
 val make_empty_block : ?label:Label.t -> terminator instruction -> basic_block
 
 (** "Contains calls" in the traditional sense as used in upstream [Selectgen]. *)
 val basic_block_contains_calls : basic_block -> bool
+
+(* [max_instr_id cfg] returns the maximum instruction identifier in [cfg]. *)
+val max_instr_id : t -> InstructionId.t

backend/cfg/cfg_comballoc.ml

@@ -21,18 +21,6 @@ type compatible_allocations =
     next_cell : cell option
   }
 
-(* [max_instr_id cfg] returns the maximum instruction identifier in [cfg]. *)
-let max_instr_id : Cfg.t -> int =
- fun cfg ->
-  (* CR-someday xclerc for xclerc: factor out with similar function in
-     regalloc/. *)
-  Cfg.fold_blocks cfg ~init:Int.min_int ~f:(fun _label block max_id ->
-      let max_id =
-        DLL.fold_left block.body ~init:max_id ~f:(fun max_id instr ->
-            Int.max max_id instr.Cfg.id)
-      in
-      Int.max max_id block.terminator.id)
-
 (* [find_next_allocation cell] returns the first allocation found by iterating
    from [cell]. *)
 let rec find_next_allocation : cell option -> allocation option =
@@ -130,8 +118,8 @@ let find_compatible_allocations :
     - the "first" allocation is made bigger to account for all allocations;
     - the other allocations are replaced with a reference to the result of the
       previous allocation, with a different offset. *)
-let rec combine : max_instr_id:int ref -> cell option -> unit =
- fun ~max_instr_id cell ->
+let rec combine : instr_id:InstructionId.sequence -> cell option -> unit =
+ fun ~instr_id cell ->
   let first_allocation = find_next_allocation cell in
   match first_allocation with
   | None -> ()
@@ -176,22 +164,23 @@ let rec combine : max_instr_id:int ref -> cell option -> unit =
                    mode
                  })
         };
-      incr max_instr_id;
       DLL.insert_after cell
         { first_allocation_instr with
           desc =
             Cfg.Op
               (Intop_imm (Simple_operation.Iadd, total_size_of_other_allocations));
           arg = [| first_allocation_res0 |];
           res = [| first_allocation_res0 |];
-          id = !max_instr_id
+          id = InstructionId.get_next instr_id
         });
-    combine ~max_instr_id compatible_allocs.next_cell
+    combine ~instr_id compatible_allocs.next_cell
 
 let run : Cfg_with_layout.t -> Cfg_with_layout.t =
  fun cfg_with_layout ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  let max_instr_id = ref (max_instr_id cfg) in
+  let instr_id =
+    InstructionId.make_sequence ~last_used:(Cfg.max_instr_id cfg) ()
+  in
   Cfg.iter_blocks cfg ~f:(fun _label block ->
-      combine ~max_instr_id (DLL.hd_cell block.body));
+      combine ~instr_id (DLL.hd_cell block.body));
   cfg_with_layout

backend/cfg/cfg_cse.ml

@@ -1,7 +1,6 @@
 [@@@ocaml.warning "+a-30-40-41-42"]
 
 module DLL = Flambda_backend_utils.Doubly_linked_list
-module Instruction = Regalloc_utils.Instruction
 module List = ListLabels
 module Array = ArrayLabels
 
@@ -17,19 +16,19 @@ let debug = false
 module State : sig
   type t
 
-  val make : next_instruction_id:Instruction.id -> t
+  val make : last_used:InstructionId.t -> t
 
-  val get_and_incr_instruction_id : t -> Instruction.id
+  val get_and_incr_instruction_id : t -> InstructionId.t
 end = struct
   (* CR-soon xclerc for xclerc: factor out with the state of GI, IRC, LS. *)
-  type t = { mutable next_instruction_id : Instruction.id }
+  type t = { instruction_id : InstructionId.sequence }
 
-  let make ~next_instruction_id = { next_instruction_id }
+  let make ~last_used =
+    let instruction_id = InstructionId.make_sequence ~last_used () in
+    { instruction_id }
 
   let get_and_incr_instruction_id state =
-    let res = state.next_instruction_id in
-    state.next_instruction_id <- succ res;
-    res
+    InstructionId.get_next state.instruction_id
 end
 
 let insert_single_move :
@@ -277,9 +276,7 @@ class cse_generic =
         (if not (List.mem ~set:cfg.fun_codegen_options Cfg.No_CSE)
         then
           let cfg_infos = Regalloc_utils.collect_cfg_infos cfg_with_layout in
-          let state =
-            State.make ~next_instruction_id:(succ cfg_infos.max_instruction_id)
-          in
+          let state = State.make ~last_used:cfg_infos.max_instruction_id in
           self#cse_blocks state cfg);
         cfg_with_layout
   end

backend/cfg/cfg_dataflow.ml

@@ -1,7 +1,6 @@
 [@@@ocaml.warning "+a-4-30-40-41-42-69"]
 
 open! Int_replace_polymorphic_compare
-module Instr = Numbers.Int
 module DLL = Flambda_backend_utils.Doubly_linked_list
 
 module type Transfer_domain_S = sig
@@ -33,7 +32,7 @@ module type Dataflow_direction_S = sig
   type context
 
   val transfer_block :
-    update_instr:(int -> instr_domain -> unit) ->
+    update_instr:(InstructionId.t -> instr_domain -> unit) ->
     Transfer_domain.t ->
     Cfg.basic_block ->
     context ->
@@ -57,7 +56,7 @@ module type Dataflow_S = sig
 
   val get_res_block : work_state -> Transfer_domain.t Label.Tbl.t
 
-  val get_res_instr_exn : work_state -> instr_domain Instr.Tbl.t
+  val get_res_instr_exn : work_state -> instr_domain InstructionId.Tbl.t
 
   val run : max_iteration:int -> work_state -> context -> (unit, unit) Result.t
 end
@@ -123,7 +122,7 @@ module Make_dataflow (D : Dataflow_direction_S) :
     { cfg : Cfg.t;
       mutable queue : WorkSet.t;
       map_block : Transfer_domain.t Label.Tbl.t;
-      map_instr : D.instr_domain Instr.Tbl.t option
+      map_instr : D.instr_domain InstructionId.Tbl.t option
     }
 
   type instr_domain = D.instr_domain
@@ -197,11 +196,11 @@ module Make_dataflow (D : Dataflow_direction_S) :
     assert (Label.Tbl.length priorities = Label.Tbl.length cfg.blocks);
     priorities
 
-  let update_instr : work_state -> int -> instr_domain -> unit =
+  let update_instr : work_state -> InstructionId.t -> instr_domain -> unit =
    fun t instr_id value ->
     match t.map_instr with
     | None -> ()
-    | Some map_instr -> Instr.Tbl.replace map_instr instr_id value
+    | Some map_instr -> InstructionId.Tbl.replace map_instr instr_id value
 
   let create :
       Cfg.t ->
@@ -217,7 +216,7 @@ module Make_dataflow (D : Dataflow_direction_S) :
       then
         let map_instr =
           (* CR-soon xclerc for xclerc: review the `16` constant. *)
-          Instr.Tbl.create (Label.Tbl.length cfg.Cfg.blocks * 16)
+          InstructionId.Tbl.create (Label.Tbl.length cfg.Cfg.blocks * 16)
         in
         Some map_instr
       else None
@@ -345,7 +344,7 @@ module Forward (D : Domain_S) (T : Forward_transfer with type domain = D.t) :
     type context = T.context
 
     let transfer_block :
-        update_instr:(int -> instr_domain -> unit) ->
+        update_instr:(InstructionId.t -> instr_domain -> unit) ->
         Transfer_domain.t ->
         Cfg.basic_block ->
         context ->
@@ -426,8 +425,8 @@ module type Backward_S = sig
 
   type _ map =
     | Block : domain Label.Tbl.t map
-    | Instr : domain Instr.Tbl.t map
-    | Both : (domain Instr.Tbl.t * domain Label.Tbl.t) map
+    | Instr : domain InstructionId.Tbl.t map
+    | Both : (domain InstructionId.Tbl.t * domain Label.Tbl.t) map
 
   val run :
     Cfg.t ->
@@ -497,7 +496,7 @@ module Backward (D : Domain_S) (T : Backward_transfer with type domain = D.t) :
     type context = T.context
 
     let transfer_block :
-        update_instr:(int -> instr_domain -> unit) ->
+        update_instr:(InstructionId.t -> instr_domain -> unit) ->
         Transfer_domain.t ->
         Cfg.basic_block ->
         context ->
@@ -532,8 +531,8 @@ module Backward (D : Domain_S) (T : Backward_transfer with type domain = D.t) :
 
   type _ map =
     | Block : domain Label.Tbl.t map
-    | Instr : domain Instr.Tbl.t map
-    | Both : (domain Instr.Tbl.t * domain Label.Tbl.t) map
+    | Instr : domain InstructionId.Tbl.t map
+    | Both : (domain InstructionId.Tbl.t * domain Label.Tbl.t) map
 
   let run :
       type a.

backend/cfg/cfg_dataflow.mli

@@ -83,8 +83,6 @@ module type Backward_transfer = sig
   val exception_ : domain -> context -> (domain, error) result
 end
 
-module Instr : Identifiable.S with type t = int
-
 module Dataflow_result : sig
   type ('a, 'e) t =
     | Ok of 'a
@@ -101,8 +99,8 @@ module type Backward_S = sig
 
   type _ map =
     | Block : domain Label.Tbl.t map
-    | Instr : domain Instr.Tbl.t map
-    | Both : (domain Instr.Tbl.t * domain Label.Tbl.t) map
+    | Instr : domain InstructionId.Tbl.t map
+    | Both : (domain InstructionId.Tbl.t * domain Label.Tbl.t) map
 
   val run :
     Cfg.t ->

backend/cfg/cfg_deadcode.ml

@@ -6,8 +6,10 @@ module DLL = Flambda_backend_utils.Doubly_linked_list
 let live_before :
     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
+  match InstructionId.Tbl.find_opt liveness instr.id with
+  | None ->
+    fatal "no liveness information for instruction %a" InstructionId.format
+      instr.id
   | Some { Cfg_liveness.before; across = _ } -> before
 
 let remove_deadcode (body : Cfg.basic_instruction_list) changed liveness

backend/cfg/cfg_intf.ml

@@ -96,7 +96,7 @@ module S = struct
       mutable fdo : Fdo_info.t;
       mutable live : Reg.Set.t;
       mutable stack_offset : int;
-      id : int;
+      id : InstructionId.t;
       mutable irc_work_list : irc_work_list;
       mutable ls_order : int;
       mutable available_before : Reg_availability_set.t option;

backend/cfg/cfg_polling.ml

@@ -71,7 +71,7 @@ module Polls_before_prtc_transfer = struct
 
   type context =
     { future_funcnames : String.Set.t;
-      optimistic_prologue_poll_instr_id : int
+      optimistic_prologue_poll_instr_id : InstructionId.t
     }
 
   type error = |
@@ -81,7 +81,7 @@ module Polls_before_prtc_transfer = struct
    fun dom instr { future_funcnames = _; optimistic_prologue_poll_instr_id } ->
     match instr.desc with
     | Op Poll ->
-      if instr.id = optimistic_prologue_poll_instr_id
+      if InstructionId.equal instr.id optimistic_prologue_poll_instr_id
       then Ok dom
       else Ok Always_polls
     | Op (Alloc _) -> Ok Always_polls
@@ -121,7 +121,7 @@ end
 
 let potentially_recursive_tailcall :
     future_funcnames:String.Set.t ->
-    optimistic_prologue_poll_instr_id:int ->
+    optimistic_prologue_poll_instr_id:InstructionId.t ->
     Cfg.t ->
     Polls_before_prtc_domain.t =
  fun ~future_funcnames ~optimistic_prologue_poll_instr_id cfg ->
@@ -192,16 +192,13 @@ let instr_cfg_with_layout :
     bool =
  fun cfg_with_layout ~safe_map ~back_edges ->
   let cfg = Cfg_with_layout.cfg cfg_with_layout in
-  let next_instruction_id =
+  let instruction_id =
     lazy
-      (let cfg_infos = Regalloc_utils.collect_cfg_infos cfg_with_layout in
-       ref (succ cfg_infos.max_instruction_id))
+      (let cfg = Cfg_with_layout.cfg cfg_with_layout in
+       InstructionId.make_sequence ~last_used:(Cfg.max_instr_id cfg) ())
   in
   let next_instruction_id () =
-    let next_ref = Lazy.force next_instruction_id in
-    let res = !next_ref in
-    incr next_ref;
-    res
+    InstructionId.get_next (Lazy.force instruction_id)
   in
   Cfg_loop_infos.EdgeSet.fold
     (fun { Cfg_loop_infos.Edge.src; dst } added_poll ->
@@ -368,7 +365,7 @@ let instrument_fundecl :
 let requires_prologue_poll :
     future_funcnames:Misc.Stdlib.String.Set.t ->
     fun_name:string ->
-    optimistic_prologue_poll_instr_id:int ->
+    optimistic_prologue_poll_instr_id:InstructionId.t ->
     Cfg.t ->
     bool =
  fun ~future_funcnames ~fun_name ~optimistic_prologue_poll_instr_id cfg ->