Avoid polymorphic compare.

backend/CSE_utils.ml

@@ -1,3 +1,5 @@
+open! Int_replace_polymorphic_compare
+
 type valnum = int
 
 (* Classification of operations *)
@@ -221,6 +223,6 @@ let remove_mutable_load_numbering n =
 
 let kill_addr_regs n =
   { n with num_reg =
-              Reg.Map.filter (fun r _n -> r.Reg.typ <> Cmm.Addr) n.num_reg }
+              Reg.Map.filter (fun r _n -> not (Cmm.equal_machtype_component r.Reg.typ Cmm.Addr)) n.num_reg }
 
 end

backend/CSEgen.ml

@@ -16,6 +16,8 @@
 (* Common subexpression elimination by value numbering over extended
    basic blocks. *)
 
+open! Int_replace_polymorphic_compare
+
 open Mach
 open CSE_utils
 

backend/afl_instrument.ml

@@ -14,6 +14,7 @@
 
 (* Insert instrumentation for afl-fuzz *)
 
+open! Int_replace_polymorphic_compare
 open Cmm
 
 module V = Backend_var

backend/branch_relaxation.ml

@@ -14,6 +14,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Mach
 open Linear
 

backend/cmm.ml

@@ -13,6 +13,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
+
 type machtype_component = Cmx_format.machtype_component =
   | Val
   | Addr

backend/cmm_builtins.ml

@@ -13,6 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Cmm
 open Cmm_helpers
 open Arch
@@ -52,7 +53,7 @@ let if_operation_supported op ~f =
   match Proc.operation_supported op with true -> Some (f ()) | false -> None
 
 let if_operation_supported_bi bi op ~f =
-  if bi = Primitive.Unboxed_int64 && size_int = 4
+  if Primitive.equal_unboxed_integer bi Primitive.Unboxed_int64 && size_int = 4
   then None
   else if_operation_supported op ~f
 
@@ -85,13 +86,14 @@ let clz ~arg_is_non_zero bi arg dbg =
   let op = Cclz { arg_is_non_zero } in
   if_operation_supported_bi bi op ~f:(fun () ->
       let res = Cop (op, [make_unsigned_int bi arg dbg], dbg) in
-      if bi = Primitive.Unboxed_int32 && size_int = 8
+      if Primitive.equal_unboxed_integer bi Primitive.Unboxed_int32
+         && size_int = 8
       then Cop (Caddi, [res; Cconst_int (-32, dbg)], dbg)
       else res)
 
 let ctz ~arg_is_non_zero bi arg dbg =
   let arg = make_unsigned_int bi arg dbg in
-  if bi = Primitive.Unboxed_int32 && size_int = 8
+  if Primitive.equal_unboxed_integer bi Primitive.Unboxed_int32 && size_int = 8
   then
     (* regardless of the value of the argument [arg_is_non_zero], always set the
        corresponding field to [true], because we make it non-zero below by
@@ -798,7 +800,10 @@ let builtin_even_if_not_annotated = function
 
 let extcall ~dbg ~returns ~alloc ~is_c_builtin ~effects ~coeffects ~ty_args name
     typ_res args =
-  if not returns then assert (typ_res = typ_void);
+  if not returns
+  then
+    assert (
+      Misc.Stdlib.Array.equal Cmm.equal_machtype_component typ_res typ_void);
   let default =
     Cop
       ( Cextcall

backend/cmm_helpers.ml

@@ -15,6 +15,8 @@
 
 [@@@ocaml.warning "+a-4-9-40-41-42-44-45"]
 
+(* CR-soon xclerc for xclerc: try to add open!
+   Int_replace_polymorphic_compare *)
 module V = Backend_var
 module VP = Backend_var.With_provenance
 open Cmm

backend/cmm_invariants.ml

@@ -14,6 +14,8 @@
 
 [@@@ocaml.warning "-40"]
 
+open! Int_replace_polymorphic_compare
+
 module Int = Numbers.Int
 
 (* Check a number of continuation-related invariants *)

backend/cmmgen_state.ml

@@ -17,6 +17,8 @@
 
 [@@@ocaml.warning "+a-4-30-40-41-42"]
 
+open! Int_replace_polymorphic_compare
+
 module S = Misc.Stdlib.String
 
 type ustructured_constant =

backend/coloring.ml

@@ -15,6 +15,8 @@
 
 (* Register allocation by coloring of the interference graph *)
 
+open! Int_replace_polymorphic_compare
+
 module OrderedRegSet =
   Set.Make(struct
     type t = Reg.t

backend/comballoc.ml

@@ -14,6 +14,9 @@
 (**************************************************************************)
 [@@@ocaml.warning "+a-30-40-41-42"]
 
+(* note: no `open! Int_replace_polymorphic_compare` as the module is about
+   to be deleted. *)
+
 (* Combine heap allocations occurring in the same basic block *)
 
 open Mach

backend/dataflow.ml

@@ -13,6 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Mach
 
 module type DOMAIN = sig

backend/deadcode.ml

@@ -16,6 +16,7 @@
 (* Dead code elimination: remove pure instructions whose results are
    not used. *)
 
+open! Int_replace_polymorphic_compare
 open Mach
 
 module Int = Numbers.Int

backend/emitaux.ml

@@ -15,6 +15,8 @@
 
 (* Common functions for emitting assembly code *)
 
+open! Int_replace_polymorphic_compare
+
 type error =
   | Stack_frame_too_large of int
   | Stack_frame_way_too_large of int
@@ -46,16 +48,21 @@ let emit_symbol s =
   done
 
 let emit_string_literal s =
+  let between x low high =
+    Char.compare x low >= 0 && Char.compare x high <= 0
+  in
   let last_was_escape = ref false in
   emit_string "\"";
   for i = 0 to String.length s - 1 do
     let c = s.[i] in
-    if c >= '0' && c <= '9'
+    if between c '0' '9'
     then
       if !last_was_escape
       then Printf.fprintf !output_channel "\\%o" (Char.code c)
       else output_char !output_channel c
-    else if c >= ' ' && c <= '~' && c <> '"' (* '"' *) && c <> '\\'
+    else if between c ' ' '~'
+            && (not (Char.equal c '"'))
+            (* '"' *) && not (Char.equal c '\\')
     then (
       output_char !output_channel c;
       last_was_escape := false)
@@ -181,6 +188,8 @@ type emit_frame_actions =
     efa_string : string -> unit
   }
 
+let is_empty = function [] -> true | _ :: _ -> false
+
 let emit_frames a =
   let filenames = Hashtbl.create 7 in
   let label_filename name =
@@ -203,7 +212,7 @@ let emit_frames a =
     type t = bool * Debuginfo.Dbg.t
 
     let equal ((rs1 : bool), dbg1) (rs2, dbg2) =
-      rs1 = rs2 && Debuginfo.Dbg.compare dbg1 dbg2 = 0
+      Bool.equal rs1 rs2 && Debuginfo.Dbg.compare dbg1 dbg2 = 0
 
     let hash (rs, dbg) = Hashtbl.hash (rs, Debuginfo.Dbg.hash dbg)
   end) in
@@ -344,8 +353,8 @@ let emit_frames a =
       in
       let info =
         if is_fully_packable
-        then fully_pack_info rs d (rest <> [])
-        else partially_pack_info rs d (rest <> [])
+        then fully_pack_info rs d (not (is_empty rest))
+        else partially_pack_info rs d (not (is_empty rest))
       in
       let loc =
         if is_fully_packable
@@ -380,7 +389,7 @@ let emit_frames a =
 
 let isprefix s1 s2 =
   String.length s1 <= String.length s2
-  && String.sub s2 0 (String.length s1) = s1
+  && String.equal (String.sub s2 0 (String.length s1)) s1
 
 let is_generic_function name =
   List.exists
@@ -510,7 +519,7 @@ let reduce_heap_size ~reset =
     then float !Flambda_backend_flags.heap_reduction_threshold
     else Float.infinity
   in
-  if major_words > heap_reduction_threshold
+  if Float.compare major_words heap_reduction_threshold > 0
   then
     Profile.record_call "compact" (fun () ->
         reset ();

backend/fdo_info.ml

@@ -12,6 +12,8 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
+
 type info =
   {
     dbg: Debuginfo.t;

backend/generic_fns.ml

@@ -10,6 +10,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Cmm
 open Cmm_helpers
 module CU = Compilation_unit
@@ -117,7 +118,8 @@ module Tbl0 = struct
   let entries t : Cmx_format.generic_fns =
     let sorted_keys tbl =
       let keys = Hashtbl.fold (fun k () acc -> k :: acc) tbl [] in
-      List.sort compare keys
+      (* CR-soon xclerc for xclerc: avoid polymorphic compare *)
+      List.sort Stdlib.compare keys
     in
     { curry_fun = sorted_keys t.curry;
       apply_fun = sorted_keys t.apply;

backend/interf.ml

@@ -16,6 +16,9 @@
 (* Construction of the interference graph.
    Annotate pseudoregs with interference lists and preference lists. *)
 
+(* note: no `open! Int_replace_polymorphic_compare` as the module is about
+   to be deleted. *)
+
 let check_collisions = false
 
 let assert_no_collisions set =

backend/interval.ml

@@ -16,6 +16,7 @@
 
 (* Live intervals for the linear scan register allocator. *)
 
+open! Int_replace_polymorphic_compare
 open Mach
 open Reg
 

backend/linear.ml

@@ -14,6 +14,8 @@
 (**************************************************************************)
 
 (* Transformation of Mach code into a list of pseudo-instructions. *)
+open! Int_replace_polymorphic_compare
+
 type label = Cmm.label
 
 type instruction =

backend/linscan.ml

@@ -16,6 +16,9 @@
 
 (* Linear scan register allocation. *)
 
+(* note: no `open! Int_replace_polymorphic_compare` as the module is about
+   to be deleted. *)
+
 open Interval
 open Reg
 

backend/liveness.ml

@@ -16,6 +16,7 @@
 (* Liveness analysis.
    Annotate mach code with the set of regs live at each point. *)
 
+open! Int_replace_polymorphic_compare
 open Mach
 
 module Domain = struct

backend/mach.ml

@@ -15,6 +15,7 @@
 
 (* Representation of machine code by sequences of pseudoinstructions *)
 
+open! Int_replace_polymorphic_compare
 open Simple_operation
 
 type operation =

backend/operation.ml

@@ -26,6 +26,8 @@
 
 [@@@ocaml.warning "+a-4-9-40-41-42"]
 
+open! Int_replace_polymorphic_compare [@@ocaml.warning "-66"]
+
 type t =
   | Move
   | Spill

backend/polling.ml

@@ -17,6 +17,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Mach
 open Format
 open Polling_utils

backend/polling_utils.ml

@@ -17,6 +17,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 module String = Misc.Stdlib.String
 
 let function_is_assumed_to_never_poll func =

backend/printcmm.ml

@@ -15,6 +15,7 @@
 
 (* Pretty-printing of C-- code *)
 
+open! Int_replace_polymorphic_compare
 open Format
 open Cmm
 

backend/printlinear.ml

@@ -15,6 +15,7 @@
 
 (* Pretty-printing of linearized machine code *)
 
+open! Int_replace_polymorphic_compare
 open Format
 open Linear
 

backend/printmach.ml

@@ -15,6 +15,7 @@
 
 (* Pretty-printing of pseudo machine code *)
 
+open! Int_replace_polymorphic_compare
 open Format
 open Cmm
 open Reg

backend/printoperation.ml

@@ -1,5 +1,6 @@
 [@@@ocaml.warning "+a-4-9-40-41-42"]
 
+open! Int_replace_polymorphic_compare
 open Format
 
 let operation ?(print_reg = Printreg.reg) (op : Operation.t) arg ppf res =

backend/printreg.ml

@@ -17,6 +17,7 @@
 
 [@@@ocaml.warning "+a-4-9-40-41-42"]
 
+open! Int_replace_polymorphic_compare [@@ocaml.warning "-66"]
 open Format
 open! Reg
 

backend/reg.ml

@@ -13,6 +13,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
+open! Int_replace_polymorphic_compare
 open Cmm
 
 type irc_work_list =
@@ -223,7 +224,7 @@ let reset() =
      soft pseudo-registers *)
   if !first_virtual_reg_stamp = -1 then begin
     first_virtual_reg_stamp := !currstamp;
-    assert (!reg_list = []) (* Only hard regs created before now *)
+    assert (match !reg_list with [] -> true | _ :: _ -> false) (* Only hard regs created before now *)
   end;
   currstamp := !first_virtual_reg_stamp;
   reg_list := [];