Remove objects from CSE code (#3806)

asmcomp/asmgen.ml

@@ -313,6 +313,7 @@ let available_regs ~stack_slots ~f x =
 
 let compile_cfg ppf_dump ~funcnames fd_cmm cfg_with_layout =
   let register_allocator = register_allocator fd_cmm in
+  let module CSE = Cfg_cse.Cse_generic (CSE) in
   let cfg_with_infos =
     cfg_with_layout
     ++ (fun cfg_with_layout ->

backend/amd64/CSE.ml

@@ -12,45 +12,40 @@
 (*   special exception on linking described in the file LICENSE.          *)
 (*                                                                        *)
 (**************************************************************************)
-[@@@ocaml.warning "+4"]
+[@@@ocaml.warning "+a-30-40-41-42"]
 
-open! Int_replace_polymorphic_compare
+open! Int_replace_polymorphic_compare [@@ocaml.warning "-66"]
 
 (* CSE for the AMD64 *)
 
 open Arch
 
-let of_simd_class (cl : Simd.operation_class) : Cfg_cse.op_class =
+let of_simd_class (cl : Simd.operation_class) : Cfg_cse_target_intf.op_class =
   match cl with
   | Pure -> Op_pure
   | Load { is_mutable = true } -> Op_load Mutable
   | Load { is_mutable = false } -> Op_load Immutable
 
-class cfg_cse = object
-
-  inherit Cfg_cse.cse_generic as super
-
-  method! class_of_operation
-  : Operation.t -> Cfg_cse.op_class
-  = fun op ->
+let class_of_operation (op : Operation.t)
+    : Cfg_cse_target_intf.class_of_operation_result =
   match op with
-    | Specific spec ->
+  | Specific spec ->
     begin match spec with
-    | Ilea _ | Isextend32 | Izextend32 -> Op_pure
-    | Istore_int(_, _, is_asg) -> Op_store is_asg
-    | Ioffset_loc(_, _) -> Op_store true
-    | Ifloatarithmem _ -> Op_load Mutable
-    | Ibswap _ -> super#class_of_operation op
+    | Ilea _ | Isextend32 | Izextend32 -> Class Op_pure
+    | Istore_int(_, _, is_asg) -> Class (Op_store is_asg)
+    | Ioffset_loc(_, _) -> Class (Op_store true)
+    | Ifloatarithmem _ -> Class (Op_load Mutable)
+    | Ibswap _ -> Use_default
     | Irdtsc | Irdpmc
-    | Ilfence | Isfence | Imfence -> Op_other
+    | Ilfence | Isfence | Imfence -> Class Op_other
     | Isimd op ->
-      of_simd_class (Simd.class_of_operation op)
+      Class (of_simd_class (Simd.class_of_operation op))
     | Isimd_mem (op,_addr) ->
-      of_simd_class (Simd.Mem.class_of_operation op)
+      Class (of_simd_class (Simd.Mem.class_of_operation op))
     | Ipause
     | Icldemote _
-    | Iprefetch _ -> Op_other
-      end
+    | Iprefetch _ -> Class Op_other
+    end
   | Move | Spill | Reload
   | Floatop _
   | Csel _
@@ -61,9 +56,8 @@ class cfg_cse = object
   | Intop _ | Intop_imm _ | Intop_atomic _
   | Name_for_debugger _ | Probe_is_enabled _ | Opaque
   | Begin_region | End_region | Poll | Dls_get
-    -> super#class_of_operation op
-
-end
+    -> Use_default
 
-let cfg_with_layout cfg_with_layout =
-  (new cfg_cse)#cfg_with_layout cfg_with_layout
+let is_cheap_operation _op
+    : Cfg_cse_target_intf.is_cheap_operation_result =
+  Use_default

backend/arm64/CSE.ml

@@ -12,67 +12,66 @@
 (*   special exception on linking described in the file LICENSE.          *)
 (*                                                                        *)
 (**************************************************************************)
+
 [@@@ocaml.warning "+a-40-41-42"]
+
 (* CSE for ARM64 *)
 
 open! Int_replace_polymorphic_compare
 
-let of_simd_class (cl : Simd.operation_class) : Cfg_cse.op_class =
+let of_simd_class (cl : Simd.operation_class) : Cfg_cse_target_intf.op_class =
   match cl with
   | Pure -> Op_pure
 
-class cfg_cse = object
-
-  inherit Cfg_cse.cse_generic as super
-
-  method! class_of_operation op =
-    match op with
-    | Specific spec ->
-      (match spec with
-       | Ifar_poll
-       | Ifar_alloc _
-       | Ishiftarith _
-       | Imuladd
-       | Imulsub
-       | Inegmulf
-       | Imuladdf
-       | Inegmuladdf
-       | Imulsubf
-       | Inegmulsubf
-       | Isqrtf
-       | Ibswap _
-       | Imove32
-       | Isignext _ -> Op_pure
-       | Isimd op -> of_simd_class (Simd.class_of_operation op))
-    | Move | Spill | Reload
-    | Floatop _
-    | Csel _
-    | Reinterpret_cast _ | Static_cast _
-    | Const_int _ | Const_float32 _ | Const_float _
-    | Const_symbol _ | Const_vec128 _
-    | Stackoffset _ | Load _ | Store _ | Alloc _
-    | Intop _ | Intop_imm _ | Intop_atomic _
-    | Name_for_debugger _ | Probe_is_enabled _ | Opaque
-    | Begin_region | End_region | Poll | Dls_get
-      -> super#class_of_operation op
-
-  method! is_cheap_operation op =
-    match op with
-    | Const_int n -> Nativeint.compare n 65535n <= 0 && Nativeint.compare n 0n >= 0
-    | Specific _
-    | Move | Spill | Reload
-    | Floatop _
-    | Csel _
-    | Reinterpret_cast _ | Static_cast _
-    | Const_float32 _ | Const_float _
-    | Const_symbol _ | Const_vec128 _
-    | Stackoffset _ | Load _ | Store _ | Alloc _
-    | Intop _ | Intop_imm _ | Intop_atomic _
-    | Name_for_debugger _ | Probe_is_enabled _ | Opaque
-    | Begin_region | End_region | Poll | Dls_get
-      -> false
-
-end
+let class_of_operation (op : Operation.t)
+    : Cfg_cse_target_intf.class_of_operation_result =
+  match op with
+  | Specific spec ->
+    let op_class : Cfg_cse_target_intf.op_class =
+      match spec with
+      | Ifar_poll
+      | Ifar_alloc _
+      | Ishiftarith _
+      | Imuladd
+      | Imulsub
+      | Inegmulf
+      | Imuladdf
+      | Inegmuladdf
+      | Imulsubf
+      | Inegmulsubf
+      | Isqrtf
+      | Ibswap _
+      | Imove32
+      | Isignext _ -> Op_pure
+      | Isimd op -> of_simd_class (Simd.class_of_operation op)
+    in
+    Class op_class
+  | Move | Spill | Reload
+  | Floatop _
+  | Csel _
+  | Reinterpret_cast _ | Static_cast _
+  | Const_int _ | Const_float32 _ | Const_float _
+  | Const_symbol _ | Const_vec128 _
+  | Stackoffset _ | Load _ | Store _ | Alloc _
+  | Intop _ | Intop_imm _ | Intop_atomic _
+  | Name_for_debugger _ | Probe_is_enabled _ | Opaque
+  | Begin_region | End_region | Poll | Dls_get
+    -> Use_default
 
-let cfg_with_layout cfg_with_layout =
-  (new cfg_cse)#cfg_with_layout cfg_with_layout
+let is_cheap_operation (op : Operation.t)
+    : Cfg_cse_target_intf.is_cheap_operation_result =
+  match op with
+  | Const_int n ->
+    Cheap (Nativeint.compare n 65535n <= 0 && Nativeint.compare n 0n >= 0)
+  | Specific _
+  | Move | Spill | Reload
+  | Floatop _
+  | Csel _
+  | Reinterpret_cast _ | Static_cast _
+  | Const_float32 _ | Const_float _
+  | Const_symbol _ | Const_vec128 _
+  | Stackoffset _ | Load _ | Store _ | Alloc _
+  | Intop _ | Intop_imm _ | Intop_atomic _
+  | Name_for_debugger _ | Probe_is_enabled _ | Opaque
+  | Begin_region | End_region | Poll | Dls_get
+    -> Cheap false