flambda-backend: Promote float32 to stable (#2709)

* start

* progress

* impl

* missing fns

* bigarrays

* tests

* fix r5

* move to stable

* fix tests

* fix cvtsi2ss instruction

* promote

* fix bounds check tests

* address comments

* Code review

* format

---------

Co-authored-by: Mark Shinwell <[email protected]>

Author: TheNumbat

otherlibs/stdlib_beta/.ocamlformat-enable

@@ -1,4 +1,3 @@
-beta.mli
-beta.ml
-float32.mli
-float32.ml
+stdlib_beta.mli
+stdlib_beta.ml
+

otherlibs/stdlib_beta/stdlib_beta.ml

@@ -1,2 +0,0 @@
-module Float32 = Float32
-module Float32_u = Float32_u

otherlibs/stdlib_beta/stdlib_beta.mli

@@ -1,2 +0,0 @@
-module Float32 = Float32
-module Float32_u = Float32_u

otherlibs/stdlib_stable/.ocamlformat-enable

@@ -1,2 +1,4 @@
-stable.mli
-stable.ml
+stdlib_stable.mli
+stdlib_stable.ml
+float32.mli
+float32.ml

otherlibs/stdlib_beta/float32.ml renamed to otherlibs/stdlib_stable/float32.ml

@@ -1,2 +1,4 @@
 module Iarray = Iarray
 module IarrayLabels = IarrayLabels
+module Float32 = Float32
+module Float32_u = Float32_u

otherlibs/stdlib_beta/float32.mli renamed to otherlibs/stdlib_stable/float32.mli

@@ -1,2 +1,4 @@
 module Iarray = Iarray
 module IarrayLabels = IarrayLabels
+module Float32 = Float32
+module Float32_u = Float32_u

otherlibs/stdlib_beta/float32_u.ml renamed to otherlibs/stdlib_stable/float32_u.ml

@@ -1,2 +1,2 @@
-upstream_compatible.mli
-upstream_compatible.ml
+stdlib_upstream_compatible.mli
+stdlib_upstream_compatible.ml

otherlibs/stdlib_beta/float32_u.mli renamed to otherlibs/stdlib_stable/float32_u.mli

@@ -1,6 +1,6 @@
 (* TEST
    runtime5;
-   include stdlib_beta;
+   include stdlib_stable;
    ocamlopt_flags="-extension layouts_alpha -extension small_numbers";
    native;
 *)
@@ -10,7 +10,7 @@
    https://github.com/ocaml-flambda/flambda-backend/pull/2763
 *)
 
-module Float32_u = Stdlib_beta.Float32_u
+module Float32_u = Stdlib_stable.Float32_u
 
 type t =
   | Mutable_str of { mutable x : string }

otherlibs/stdlib_stable/stdlib_stable.ml

@@ -1,7 +1,7 @@
 (* TEST
-   flags = "-extension layouts_beta -extension small_numbers";
-   include stdlib_beta;
+   flags = "-extension layouts_beta";
    flambda2;
+   include stdlib_stable;
    include stdlib_upstream_compatible;
    {
    native;
@@ -13,8 +13,8 @@
 (*****************************************)
 (* Prelude: Functions on unboxed numbers *)
 
-module Float32_u = Stdlib_beta.Float32_u
-module Float32 = Stdlib_beta.Float32
+module Float32_u = Stdlib_stable.Float32_u
+module Float32 = Stdlib_stable.Float32
 module Float_u = Stdlib_upstream_compatible.Float_u
 module Int32_u = Stdlib_upstream_compatible.Int32_u
 module Int64_u = Stdlib_upstream_compatible.Int64_u

otherlibs/stdlib_stable/stdlib_stable.mli

@@ -247,7 +247,7 @@ let type_to_field_integrity_check type_ ~access1 ~access2 ~message =
     | Imm -> "check_int", None
     | Float -> "check_float", None
     | Float64 -> "check_float", Some "Stdlib_upstream_compatible.Float_u.to_float"
-    | Float32 -> "check_float32", Some "Stdlib_beta.Float32_u.to_float32"
+    | Float32 -> "check_float32", Some "Stdlib_stable.Float32_u.to_float32"
     | Bits32 -> "check_int32", Some "Stdlib_upstream_compatible.Int32_u.to_int32"
     | Bits64 -> "check_int64", Some "Stdlib_upstream_compatible.Int64_u.to_int64"
     | Word -> "check_int", Some "Stdlib_upstream_compatible.Nativeint_u.to_int"
@@ -612,8 +612,8 @@ let main n ~bytecode =
     List.iter2 values (List.tl values @ [ List.hd values]) ~f
   in
   line {|(* TEST
- flags = "-extension layouts_beta -extension small_numbers";
- include stdlib_beta;
+ flags = "-extension layouts_beta";
+ include stdlib_stable;
  include stdlib_upstream_compatible;|};
   if bytecode then (
     line {| bytecode;|};
@@ -628,9 +628,9 @@ let main n ~bytecode =
   line {|let create_string () = String.make (Random.int 100) 'a'|};
   line {|let create_int () = Random.int 0x3FFF_FFFF|};
   line {|let create_float () = Random.float Float.max_float|};
-  line {|let create_float32 () = Stdlib_beta.Float32.of_float (Random.float Float.max_float)|};
+  line {|let create_float32 () = Stdlib_stable.Float32.of_float (Random.float Float.max_float)|};
   line {|let create_float_u () = Stdlib_upstream_compatible.Float_u.of_float (create_float ())|};
-  line {|let create_float32_u () = Stdlib_beta.Float32_u.of_float32 (create_float32 ())|};
+  line {|let create_float32_u () = Stdlib_stable.Float32_u.of_float32 (create_float32 ())|};
   line {|let create_int32_u () = Stdlib_upstream_compatible.Int32_u.of_int32 (Random.int32 0x7FFF_FFFFl)|};
   line {|let create_int64_u () = Stdlib_upstream_compatible.Int64_u.of_int64 (Random.int64 0x7FFF_FFFF_FFFF_FFFFL)|};
   line {|let create_nativeint_u () = Stdlib_upstream_compatible.Nativeint_u.of_nativeint (Random.nativeint 0x7FFF_FFFF_FFFF_FFFFn)|};
@@ -648,7 +648,7 @@ let main n ~bytecode =
   check_gen ~equal:Float.equal ~to_string:Float.to_string|};
   line
    {|let check_float32 =
-  check_gen ~equal:Stdlib_beta.Float32.equal ~to_string:Stdlib_beta.Float32.to_string|};
+  check_gen ~equal:Stdlib_stable.Float32.equal ~to_string:Stdlib_stable.Float32.to_string|};
   line
    {|let check_int32 =
   check_gen ~equal:Int32.equal ~to_string:Int32.to_string|};

otherlibs/stdlib_upstream_compatible/.ocamlformat-enable

@@ -1,27 +1,25 @@
 (* TEST
  readonly_files = "gen_u_array.ml test_gen_u_array.ml";
  modules = "${readonly_files}";
- include stdlib_beta;
+ include stdlib_stable;
  flambda2;
  {
-   flags = "-extension small_numbers";
    bytecode;
  }{
-   flags = "-extension small_numbers";
    native;
  }{
-   flags = "-extension layouts_beta -extension small_numbers";
+   flags = "-extension layouts_beta";
    bytecode;
  }{
-   flags = "-extension layouts_beta -extension small_numbers";
+   flags = "-extension layouts_beta";
    native;
  }
 *)
 (* Test compilation correctness for array of unboxed float32s. General
    tests around type-checking should go to [basics.ml]. *)
 
 module Float32_I = struct
-  include Stdlib_beta.Float32
+  include Stdlib_stable.Float32
   let max_val = max_float
   let min_val = min_float
   let rand f = of_float (Random.float (to_float f))
@@ -66,15 +64,15 @@ module Float32_u_array0 : Gen_u_array.S0
     "caml_array_blit" "caml_unboxed_float32_vect_blit"
   let empty () = [||]
   external to_boxed : ('a : float32) -> (float32[@local_opt]) = "%box_float32"
-  let compare_element x y = Stdlib_beta.Float32.compare (to_boxed (x ())) (to_boxed (y ()))
+  let compare_element x y = Stdlib_stable.Float32.compare (to_boxed (x ())) (to_boxed (y ()))
 end
 
 module Float32_u_array = Gen_u_array.Make (Float32_u_array0)
 module Float32_u_array_boxed : Test_gen_u_array.S with type t = float32# array = Test_gen_u_array.Make_boxed (struct
   module M = Float32_u_array
   module I = Float32_I
   module E = struct
-    open Stdlib_beta.Float32_u
+    open Stdlib_stable.Float32_u
     let to_boxed x = to_float32 (x ())
     let of_boxed x () = of_float32 x
   end
@@ -189,7 +187,7 @@ let () =
 
 (* expression and patterns *)
 let () =
-  let ( = ) = Stdlib_beta.Float32_u.equal in
+  let ( = ) = Stdlib_stable.Float32_u.equal in
   (* match statement *)
   let d = [| #1.s; #2.s |] in
   (match d with

testsuite/tests/mixed-blocks/closure_padding_float32.ml

@@ -1,8 +1,7 @@
 (* TEST
  flambda2;
  {
-   include stdlib_beta;
-   flags = "-extension-universe beta";
+   include stdlib_stable;
    native;
  }
 *)
@@ -15,7 +14,7 @@
    floats. *)
 
 module Float32_u = struct
-  include Stdlib_beta.Float32_u
+  include Stdlib_stable.Float32_u
 
   let ( + ) = add
   let ( - ) = sub
@@ -82,12 +81,12 @@ struct
       measure_alloc (fun () -> go #0.s #0.s)
     in
     Printf.printf "Unboxed:\n  estimate: %f\n  allocations: %s\n"
-      (Stdlib_beta.Float32.to_float (to_float32 est) *. 4.) (get_allocations ())
+      (Stdlib_stable.Float32.to_float (to_float32 est) *. 4.) (get_allocations ())
 end
 
 module Pi_boxed =
 struct
-  open Stdlib_beta.Float32
+  open Stdlib_stable.Float32
   open Operators
 
   let[@inline never] step n estimate =
@@ -125,8 +124,10 @@ let print_record_and_allocs s r =
   Printf.printf
     "%s:\n  allocated bytes: %.2f\n  a: %.2f\n  b: %.2f\n  c: %.2f\n  d: %.2f\n"
     s allocs
-    (Stdlib_beta.Float32.to_float (Float32_u.to_float32 r.a)) (Stdlib_beta.Float32.to_float (Float32_u.to_float32 r.b))
-    (Stdlib_beta.Float32.to_float (Float32_u.to_float32 r.c)) (Stdlib_beta.Float32.to_float (Float32_u.to_float32 r.d))
+    (Stdlib_stable.Float32.to_float (Float32_u.to_float32 r.a))
+    (Stdlib_stable.Float32.to_float (Float32_u.to_float32 r.b))
+    (Stdlib_stable.Float32.to_float (Float32_u.to_float32 r.c))
+    (Stdlib_stable.Float32.to_float (Float32_u.to_float32 r.d))
 
 (* Building a record should only allocate the box *)
 let[@inline never] build x =

testsuite/tests/mixed-blocks/constructor_args.ml

@@ -1,18 +1,18 @@
 (* TEST
  reference = "${test_source_directory}/unboxed_float32s.reference";
- include stdlib_beta;
+ include stdlib_stable;
  flambda2;
  {
-   flags = "-extension layouts_alpha -extension small_numbers";
+   flags = "-extension layouts_alpha";
    native;
  }{
-   flags = "-extension layouts_alpha -extension small_numbers";
+   flags = "-extension layouts_alpha";
    bytecode;
  }{
-   flags = "-extension layouts_beta -extension small_numbers";
+   flags = "-extension layouts_beta";
    native;
  }{
-   flags = "-extension layouts_beta -extension small_numbers";
+   flags = "-extension layouts_beta";
    bytecode;
  }
 *)
@@ -34,7 +34,7 @@
 (* Prelude: Functions on unboxed floats. *)
 
 module Float32 = struct
-  include Stdlib_beta.Float32
+  include Stdlib_stable.Float32
 
   let ( + ) = add
   let ( - ) = sub
@@ -45,7 +45,7 @@ module Float32 = struct
 end
 
 module Float32_u = struct
-  include Stdlib_beta.Float32_u
+  include Stdlib_stable.Float32_u
 
   let ( + ) = add
   let ( - ) = sub

testsuite/tests/mixed-blocks/generate_mixed_blocks_code.ml

@@ -44,6 +44,7 @@ Line 1, characters 9-18:
 1 | type t = float32x4;;
              ^^^^^^^^^
 Error: Unbound type constructor float32x4
+Hint: Did you mean float32 or float32#?
 |}];;
 
 type t = float64x2;;
@@ -52,4 +53,5 @@ Line 1, characters 9-18:
 1 | type t = float64x2;;
              ^^^^^^^^^
 Error: Unbound type constructor float64x2
+Hint: Did you mean float32?
 |}];;

testsuite/tests/mixed-blocks/generated_byte_test.ml

@@ -1,4 +1,5 @@
 (* TEST
+ flags = "-no-extension small_numbers";
  expect;
 *)
 

testsuite/tests/mixed-blocks/generated_native_test.ml

@@ -63,7 +63,7 @@ let get_level_ops : type a. a t -> (module Extension_level with type t = a) =
   | Layouts -> (module Maturity)
   | SIMD -> (module Unit)
   | Labeled_tuples -> (module Unit)
-  | Small_numbers -> (module Unit)
+  | Small_numbers -> (module Maturity)
 
 module Exist_pair = struct
   include Exist_pair
@@ -79,17 +79,19 @@ module Exist_pair = struct
     | Pair (Layouts, m) -> m
     | Pair (SIMD, ()) -> Stable
     | Pair (Labeled_tuples, ()) -> Stable
-    | Pair (Small_numbers, ()) -> Beta
+    | Pair (Small_numbers, m) -> m
 
   let is_erasable : t -> bool = function Pair (ext, _) -> is_erasable ext
 
   let to_string = function
     | Pair (Layouts, m) -> to_string Layouts ^ "_" ^ maturity_to_string m
     | Pair (Mode, m) -> to_string Mode ^ "_" ^ maturity_to_string m
+    | Pair (Small_numbers, m) ->
+      to_string Small_numbers ^ "_" ^ maturity_to_string m
     | Pair
         ( (( Comprehensions | Unique | Include_functor | Polymorphic_parameters
-           | Immutable_arrays | Module_strengthening | SIMD | Labeled_tuples
-           | Small_numbers ) as ext),
+           | Immutable_arrays | Module_strengthening | SIMD | Labeled_tuples )
+          as ext),
           _ ) ->
       to_string ext
 end

testsuite/tests/typing-layouts-arrays/test_float32_u_array.ml

@@ -22,7 +22,7 @@ type 'a t = 'a Language_extension_kernel.t =
   | Layouts : maturity t
   | SIMD : unit t
   | Labeled_tuples : unit t
-  | Small_numbers : unit t
+  | Small_numbers : maturity t
 
 (** Existentially packed language extension *)
 module Exist : sig

testsuite/tests/typing-layouts-float32/alloc.ml

@@ -12,7 +12,7 @@ type _ t =
   | Layouts : maturity t
   | SIMD : unit t
   | Labeled_tuples : unit t
-  | Small_numbers : unit t
+  | Small_numbers : maturity t
 
 type 'a language_extension_kernel = 'a t
 
@@ -72,7 +72,8 @@ let pair_of_string extn_name : Exist_pair.t option =
   | "layouts_beta" -> Some (Pair (Layouts, Beta))
   | "simd" -> Some (Pair (SIMD, ()))
   | "labeled_tuples" -> Some (Pair (Labeled_tuples, ()))
-  | "small_numbers" -> Some (Pair (Small_numbers, ()))
+  | "small_numbers" -> Some (Pair (Small_numbers, Stable))
+  | "small_numbers_beta" -> Some (Pair (Small_numbers, Beta))
   | _ -> None
 
 let maturity_to_string = function

testsuite/tests/typing-layouts-float32/unboxed_float32s.ml

@@ -21,7 +21,7 @@ type _ t =
   | Layouts : maturity t
   | SIMD : unit t
   | Labeled_tuples : unit t
-  | Small_numbers : unit t
+  | Small_numbers : maturity t
 
 module Exist : sig
   type 'a extn = 'a t