flambda-backend: Define 'a or_null (#2614)

* `or_null` predef

* `Or_null.t` in `Stdlib_alpha`

* Enable `test_or_null`

* Test that `Or_null` is exported

* Formatting

* Fix comment

* Update `ppx-empty-cases` test numbering

* `Just` -> `This`

* Due to issues with arrays and separability, mark `float` as nullable

* Fix tests

* Fix test

---------

Co-authored-by: Diana Kalinichenko <dkalinichenko@janestreet.com>

Author: dkalinichenko-js

otherlibs/stdlib_alpha/or_null.ml

@@ -12,4 +12,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-type ('a : non_null_value) t = 'a option
+type ('a : non_null_value) t = 'a or_null =
+  | Null
+  | This of 'a

otherlibs/stdlib_alpha/or_null.mli

@@ -13,4 +13,6 @@
 (**************************************************************************)
 
 (** Unboxed option type. Unimplemented. *)
-type ('a : non_null_value) t
+type ('a : non_null_value) t = 'a or_null =
+  | Null
+  | This of 'a

testsuite/tests/ppx-empty-cases/test.compilers.reference

@@ -3,35 +3,35 @@
     (empty_cases_returning_string/269 =
        (function {nlocal = 0} param/271
          (raise
-           (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 28 50])))
+           (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 28 50])))
      empty_cases_returning_float64/272 =
        (function {nlocal = 0} param/274 : unboxed_float
          (raise
-           (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 29 50])))
+           (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 29 50])))
      empty_cases_accepting_string/275 =
        (function {nlocal = 0} param/277
          (raise
-           (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 30 50])))
+           (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 30 50])))
      empty_cases_accepting_float64/278 =
        (function {nlocal = 0} param/280[unboxed_float]
          (raise
-           (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 31 50])))
+           (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 31 50])))
      non_empty_cases_returning_string/281 =
        (function {nlocal = 0} param/283
          (raise
-           (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 32 68])))
+           (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 32 68])))
      non_empty_cases_returning_float64/284 =
        (function {nlocal = 0} param/286 : unboxed_float
          (raise
-           (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 33 68])))
+           (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 33 68])))
      non_empty_cases_accepting_string/287 =
        (function {nlocal = 0} param/289
          (raise
-           (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 34 68])))
+           (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 34 68])))
      non_empty_cases_accepting_float64/290 =
        (function {nlocal = 0} param/292[unboxed_float]
          (raise
-           (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 35 68]))))
+           (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 35 68]))))
     (makeblock 0 empty_cases_returning_string/269
       empty_cases_returning_float64/272 empty_cases_accepting_string/275
       empty_cases_accepting_float64/278 non_empty_cases_returning_string/281

testsuite/tests/typing-layouts-non-null-value/arguments.ml

@@ -49,7 +49,7 @@ let _ = [| Fake_or_null.some 3 |]
 
 let _ = [: Fake_or_null.some "test " :]
 
-let _ = Some (Fake_or_null.some 4.2)
+let _ = Some (Fake_or_null.some 42)
 
 let _ = lazy (Fake_or_null.none)
 ;;
@@ -58,7 +58,7 @@ let _ = lazy (Fake_or_null.none)
 - : 'a Fake_or_null.t list = [<abstr>]
 - : int Fake_or_null.t array = [|<abstr>|]
 - : string Fake_or_null.t iarray = [:<abstr>:]
-- : float Fake_or_null.t option = Some <abstr>
+- : int Fake_or_null.t option = Some <abstr>
 - : 'a Fake_or_null.t lazy_t = lazy <abstr>
 |}]
 

testsuite/tests/typing-layouts-non-null-value/basics.ml

@@ -166,8 +166,6 @@ let _ = id_non_null_value None
 
 let _ = id_non_null_value (Some 0)
 
-let _ = id_non_null_value 3.14
-
 let _ = id_non_null_value [| 3.; 8. |]
 
 let _ = id_non_null_value 4L
@@ -189,7 +187,6 @@ let _ = id_non_null_value (Bytes.empty)
 - : string * string = ("a", "b")
 - : 'a option = None
 - : int option = Some 0
-- : float = 3.14
 - : float array = [|3.; 8.|]
 - : int64 = 4L
 - : nativeint = 15n
@@ -199,6 +196,23 @@ let _ = id_non_null_value (Bytes.empty)
 - : bytes = Bytes.of_string ""
 |}]
 
+(* CR layouts v3: [float] should be non-null: *)
+
+let _ = id_non_null_value 3.14
+;;
+
+[%%expect{|
+Line 1, characters 26-30:
+1 | let _ = id_non_null_value 3.14
+                              ^^^^
+Error: This expression has type float but an expression was expected of type
+         ('a : non_null_value)
+       The layout of float is value, because
+         it is the primitive value type float.
+       But the layout of float must be a sublayout of non_null_value, because
+         of the definition of id_non_null_value at line 3, characters 4-21.
+|}]
+
 (* Boxed records and variants are non-null: *)
 
 type t1 = { x : int; y : string }