Rename Float to Float_boxed in flat suffix variant (#2590)

ncik-roberts · web-flow · commit 5401722df7ce · 2024-05-17T13:30:10.000-04:00
* Rename identifiers

* make fmt
diff --git a/backend/cmm_helpers.ml b/backend/cmm_helpers.ml
@@ -1594,7 +1594,7 @@ let make_mixed_alloc ~mode dbg tag shape args =
     else
       match flat_suffix.(idx - value_prefix_len) with
       | Imm -> int_array_set arr ofs newval dbg
-      | Float | Float64 -> float_array_set arr ofs newval dbg
+      | Float_boxed | Float64 -> float_array_set arr ofs newval dbg
       | Float32 -> setfield_unboxed_float32 arr ofs newval dbg
       | Bits32 -> setfield_unboxed_int32 arr ofs newval dbg
       | Bits64 | Word -> setfield_unboxed_int64_or_nativeint arr ofs newval dbg
diff --git a/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml b/middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml
@@ -994,7 +994,7 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
           | Value_prefix
           | Flat_suffix (Float64 | Float32 | Imm | Bits32 | Bits64 | Word) ->
             arg
-          | Flat_suffix Float -> unbox_float arg)
+          | Flat_suffix Float_boxed -> unbox_float arg)
         args
     in
     let mode = Alloc_mode.For_allocations.from_lambda mode ~current_region in
@@ -1463,7 +1463,7 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
             (match read with
             | Flat_read flat_element ->
               P.Mixed_block_flat_element.from_lambda flat_element
-            | Flat_read_float _ -> Float)
+            | Flat_read_float_boxed _ -> Float_boxed)
       in
       Mixed { tag = Unknown; field_kind; size = Unknown }
     in
@@ -1472,7 +1472,7 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
     in
     match read with
     | Mread_value_prefix _ | Mread_flat_suffix (Flat_read _) -> [block_access]
-    | Mread_flat_suffix (Flat_read_float mode) ->
+    | Mread_flat_suffix (Flat_read_float_boxed mode) ->
       [box_float mode block_access ~current_region])
   | ( Psetfield (index, immediate_or_pointer, initialization_or_assignment),
       [[block]; [value]] ) ->
@@ -1535,7 +1535,7 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
       | Mwrite_value_prefix _
       | Mwrite_flat_suffix (Imm | Float64 | Float32 | Bits32 | Bits64 | Word) ->
         value
-      | Mwrite_flat_suffix Float -> unbox_float value
+      | Mwrite_flat_suffix Float_boxed -> unbox_float value
     in
     [ Ternary
         (Block_set (block_access, init_or_assign), block, Simple field, value)
diff --git a/middle_end/flambda2/terms/code_size.ml b/middle_end/flambda2/terms/code_size.ml
@@ -163,7 +163,8 @@ let block_set (kind : Flambda_primitive.Block_access_kind.t)
         { field_kind =
             ( Value_prefix _
             | Flat_suffix
-                (Imm | Float | Float64 | Float32 | Bits32 | Bits64 | Word) );
+                (Imm | Float_boxed | Float64 | Float32 | Bits32 | Bits64 | Word)
+              );
           _
         },
       (Assignment _ | Initialization) ) ->
diff --git a/middle_end/flambda2/terms/flambda_primitive.ml b/middle_end/flambda2/terms/flambda_primitive.ml
@@ -61,7 +61,7 @@ end
 module Mixed_block_flat_element = struct
   type t =
     | Imm
-    | Float
+    | Float_boxed
     | Float64
     | Float32
     | Bits32
@@ -70,7 +70,7 @@ module Mixed_block_flat_element = struct
 
   let from_lambda : Lambda.flat_element -> t = function
     | Imm -> Imm
-    | Float -> Float
+    | Float_boxed -> Float_boxed
     | Float64 -> Float64
     | Float32 -> Float32
     | Bits32 -> Bits32
@@ -79,7 +79,7 @@ module Mixed_block_flat_element = struct
 
   let to_lambda : t -> Lambda.flat_element = function
     | Imm -> Imm
-    | Float -> Float
+    | Float_boxed -> Float_boxed
     | Float64 -> Float64
     | Float32 -> Float32
     | Bits32 -> Bits32
@@ -88,7 +88,7 @@ module Mixed_block_flat_element = struct
 
   let to_string = function
     | Imm -> "Imm"
-    | Float -> "Float"
+    | Float_boxed -> "Float_boxed"
     | Float64 -> "Float64"
     | Float32 -> "Float32"
     | Bits32 -> "Bits32"
@@ -98,7 +98,7 @@ module Mixed_block_flat_element = struct
   let compare t1 t2 =
     match t1, t2 with
     | Imm, Imm
-    | Float, Float
+    | Float_boxed, Float_boxed
     | Float64, Float64
     | Float32, Float32
     | Word, Word
@@ -107,8 +107,8 @@ module Mixed_block_flat_element = struct
       0
     | Imm, _ -> -1
     | _, Imm -> 1
-    | Float, _ -> -1
-    | _, Float -> 1
+    | Float_boxed, _ -> -1
+    | _, Float_boxed -> 1
     | Float64, _ -> -1
     | _, Float64 -> 1
     | Float32, _ -> -1
@@ -122,7 +122,7 @@ module Mixed_block_flat_element = struct
 
   let element_kind = function
     | Imm -> K.value
-    | Float | Float64 -> K.naked_float
+    | Float_boxed | Float64 -> K.naked_float
     | Float32 -> K.naked_float32
     | Bits32 -> K.naked_int32
     | Bits64 -> K.naked_int64
@@ -539,7 +539,7 @@ module Block_access_kind = struct
     | Mixed { field_kind = Flat_suffix field_kind; _ } -> (
       match field_kind with
       | Imm -> K.With_subkind.tagged_immediate
-      | Float | Float64 -> K.With_subkind.naked_float
+      | Float_boxed | Float64 -> K.With_subkind.naked_float
       | Float32 -> K.With_subkind.naked_float32
       | Bits32 -> K.With_subkind.naked_int32
       | Bits64 -> K.With_subkind.naked_int64
diff --git a/middle_end/flambda2/terms/flambda_primitive.mli b/middle_end/flambda2/terms/flambda_primitive.mli
@@ -65,7 +65,7 @@ end
 module Mixed_block_flat_element : sig
   type t =
     | Imm
-    | Float
+    | Float_boxed
     | Float64
     | Float32
     | Bits32
diff --git a/middle_end/flambda2/to_cmm/to_cmm_primitive.ml b/middle_end/flambda2/to_cmm/to_cmm_primitive.ml
@@ -107,7 +107,7 @@ let block_load ~dbg (kind : P.Block_access_kind.t) (mutability : Mutability.t)
   | Mixed { field_kind = Flat_suffix field_kind; _ } -> (
     match field_kind with
     | Imm -> C.get_field_computed Immediate mutability ~block ~index dbg
-    | Float | Float64 ->
+    | Float_boxed | Float64 ->
       (* CR layouts v5.1: We should use the mutability here to generate better
          code if the load is immutable. *)
       C.unboxed_float_array_ref block index dbg
@@ -132,7 +132,7 @@ let block_set ~dbg (kind : P.Block_access_kind.t) (init : P.Init_or_assign.t)
       match field_kind with
       | Imm ->
         C.setfield_computed Immediate init_or_assign block index new_value dbg
-      | Float | Float64 -> C.float_array_set block index new_value dbg
+      | Float_boxed | Float64 -> C.float_array_set block index new_value dbg
       | Float32 -> C.setfield_unboxed_float32 block index new_value dbg
       | Bits32 -> C.setfield_unboxed_int32 block index new_value dbg
       | Bits64 | Word ->
diff --git a/ocaml/lambda/lambda.ml b/ocaml/lambda/lambda.ml
@@ -343,10 +343,17 @@ and block_shape =
   value_kind list option
 
 and flat_element = Types.flat_element =
-    Imm | Float | Float64 | Float32 | Bits32 | Bits64 | Word
+  | Imm
+  | Float_boxed
+  | Float64
+  | Float32
+  | Bits32
+  | Bits64
+  | Word
+
 and flat_element_read =
   | Flat_read of flat_element (* invariant: not [Float] *)
-  | Flat_read_float of alloc_mode
+  | Flat_read_float_boxed of alloc_mode
 and mixed_block_read =
   | Mread_value_prefix of immediate_or_pointer
   | Mread_flat_suffix of flat_element_read
@@ -1264,11 +1271,11 @@ let get_mixed_block_element = Types.get_mixed_product_element
 
 let flat_read_non_float flat_element =
   match flat_element with
-  | Float -> Misc.fatal_error "flat_element_read_non_float Float"
+  | Float_boxed -> Misc.fatal_error "flat_element_read_non_float Float_boxed"
   | Imm | Float64 | Float32 | Bits32 | Bits64 | Word as flat_element ->
       Flat_read flat_element
 
-let flat_read_float alloc_mode = Flat_read_float alloc_mode
+let flat_read_float_boxed alloc_mode = Flat_read_float_boxed alloc_mode
 
 (* Compile a sequence of expressions *)
 
@@ -1674,7 +1681,7 @@ let primitive_may_allocate : primitive -> alloc_mode option = function
   | Pmixedfield (_, read, _) -> begin
       match read with
       | Mread_value_prefix _ -> None
-      | Mread_flat_suffix (Flat_read_float m) -> Some m
+      | Mread_flat_suffix (Flat_read_float_boxed m) -> Some m
       | Mread_flat_suffix (Flat_read _) -> None
     end
   | Psetfloatfield _ -> None
@@ -1824,7 +1831,7 @@ let array_ref_kind_result_layout = function
 let layout_of_mixed_field (kind : mixed_block_read) =
   match kind with
   | Mread_value_prefix _ -> layout_value_field
-  | Mread_flat_suffix (Flat_read_float (_ : alloc_mode)) ->
+  | Mread_flat_suffix (Flat_read_float_boxed (_ : alloc_mode)) ->
       layout_boxed_float Pfloat64
   | Mread_flat_suffix (Flat_read proj) ->
       match proj with
@@ -1834,7 +1841,7 @@ let layout_of_mixed_field (kind : mixed_block_read) =
       | Bits32 -> layout_unboxed_int32
       | Bits64 -> layout_unboxed_int64
       | Word -> layout_unboxed_nativeint
-      | Float -> layout_boxed_float Pfloat64
+      | Float_boxed -> layout_boxed_float Pfloat64
 
 let primitive_result_layout (p : primitive) =
   assert !Clflags.native_code;
diff --git a/ocaml/lambda/lambda.mli b/ocaml/lambda/lambda.mli
@@ -351,10 +351,17 @@ and block_shape =
   value_kind list option
 
 and flat_element = Types.flat_element =
-    Imm | Float | Float64 | Float32 | Bits32 | Bits64 | Word
+  | Imm
+  | Float_boxed
+  | Float64
+  | Float32
+  | Bits32
+  | Bits64
+  | Word
+
 and flat_element_read = private
   | Flat_read of flat_element (* invariant: not [Float] *)
-  | Flat_read_float of alloc_mode
+  | Flat_read_float_boxed of alloc_mode
 and mixed_block_read =
   | Mread_value_prefix of immediate_or_pointer
   | Mread_flat_suffix of flat_element_read
@@ -606,7 +613,7 @@ type lambda =
      a subset of those open at the point of the [Lstaticraise] that jumps to it,
      as we can't reopen closed regions. All regions that were open at the point of
      the [Lstaticraise] but not in the handler will be closed just before the [Lstaticraise].
-   
+
      However, to be able to express the fact
      that the [Lstaticraise] might be under a [Lexclave], the [pop_region] flag
      is used to specify what regions are considered open in the handler. If it
@@ -838,9 +845,9 @@ type mixed_block_element =
 (** Raises if the int is out of bounds. *)
 val get_mixed_block_element : mixed_block_shape -> int -> mixed_block_element
 
-(** Raises if [flat_element] is float. *)
+(** Raises if [flat_element] is [Float_boxed]. *)
 val flat_read_non_float : flat_element -> flat_element_read
-val flat_read_float : alloc_mode -> flat_element_read
+val flat_read_float_boxed : alloc_mode -> flat_element_read
 
 val make_sequence: ('a -> lambda) -> 'a list -> lambda
 
diff --git a/ocaml/lambda/matching.ml b/ocaml/lambda/matching.ml
@@ -1811,7 +1811,7 @@ let get_expr_args_constr ~scopes head (arg, _mut, sort, layout) rem =
             | Flat_suffix flat ->
                 let flat_read =
                   match flat with
-                  | Float ->
+                  | Float_boxed ->
                       Misc.fatal_error
                         "unexpected flat float of layout value in \
                          constructor field"
@@ -2185,9 +2185,9 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
                   match flat_suffix.(pos - value_prefix_len) with
                   | Imm | Float64 | Float32 | Bits32 | Bits64 | Word as non_float ->
                       flat_read_non_float non_float
-                  | Float ->
+                  | Float_boxed ->
                       (* TODO: could optimise to Alloc_local sometimes *)
-                      flat_read_float alloc_heap
+                      flat_read_float_boxed alloc_heap
                 in
                 Mread_flat_suffix read
             in
diff --git a/ocaml/lambda/printlambda.ml b/ocaml/lambda/printlambda.ml
@@ -324,7 +324,7 @@ let flat_element ppf : flat_element -> unit = fun x ->
 let flat_element_read ppf : flat_element_read -> unit = function
   | Flat_read flat ->
       pp_print_string ppf (Types.flat_element_to_lowercase_string flat)
-  | Flat_read_float m -> fprintf ppf "float[%a]" alloc_mode m
+  | Flat_read_float_boxed m -> fprintf ppf "float[%a]" alloc_mode m
 
 let mixed_block_read ppf : mixed_block_read -> unit = function
   | Mread_value_prefix Immediate -> pp_print_string ppf "value_int"
diff --git a/ocaml/lambda/translcore.ml b/ocaml/lambda/translcore.ml
@@ -611,10 +611,10 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
             else
               let flat_read =
                 match flat_suffix.(lbl.lbl_num - value_prefix_len) with
-                | Float ->
+                | Float_boxed ->
                   (match float with
                     | Boxing (mode, _) ->
-                        flat_read_float (transl_alloc_mode_r mode)
+                        flat_read_float_boxed (transl_alloc_mode_r mode)
                     | Non_boxing _ ->
                         Misc.fatal_error
                           "expected typechecking to make [float] boxing mode\
@@ -1734,11 +1734,11 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
                     else
                       let read =
                         match flat_suffix.(lbl.lbl_num - value_prefix_len) with
-                        | Float ->
+                        | Float_boxed ->
                             (* See the handling of [Record_float] above for
                                 why we choose Alloc_heap.
                             *)
-                            flat_read_float alloc_heap
+                            flat_read_float_boxed alloc_heap
                         | non_float -> flat_read_non_float non_float
                       in
                       Mread_flat_suffix read
diff --git a/ocaml/toplevel/genprintval.ml b/ocaml/toplevel/genprintval.ml
@@ -580,7 +580,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
                         match Types.get_mixed_product_element shape pos with
                         | Value_prefix -> `Continue (O.field obj pos)
                         | Flat_suffix Imm -> `Continue (O.field obj pos)
-                        | Flat_suffix (Float | Float64) ->
+                        | Flat_suffix (Float_boxed | Float64) ->
                             `Continue (O.repr (O.double_field obj pos))
                         | Flat_suffix (Float32 | Bits32 | Bits64 | Word) ->
                             `Stop (Oval_stuff "<abstr>")
diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml
@@ -5738,7 +5738,7 @@ and type_expect_
           | Record_float -> true
           | Record_mixed mixed -> begin
               match Types.get_mixed_product_element mixed label.lbl_num with
-              | Flat_suffix Float -> true
+              | Flat_suffix Float_boxed -> true
               | Flat_suffix (Float64 | Float32 | Imm | Bits32 | Bits64 | Word) -> false
               | Value_prefix -> false
             end
diff --git a/ocaml/typing/typedecl.ml b/ocaml/typing/typedecl.ml
@@ -1423,7 +1423,7 @@ let update_decl_jkind env dpath decl =
               List.map
                 (fun ((repr : Element_repr.t), _lbl) ->
                   match repr with
-                  | Float_element -> Float
+                  | Float_element -> Float_boxed
                   | Unboxed_element Float64 -> Float64
                   | Element_without_runtime_component { ty; loc } ->
                       raise (Error (loc,
diff --git a/ocaml/typing/types.ml b/ocaml/typing/types.ml
diff --git a/ocaml/typing/types.mli b/ocaml/typing/types.mli
