Non_null_value layout

ocaml/lambda/matching.ml

@@ -118,7 +118,7 @@ let jkind_layout_must_be_value loc jkind =
    outlived its usefulness and should be deleted. *)
 let check_record_field_jkind lbl =
   match Jkind.(get_default_value lbl.lbl_jkind), lbl.lbl_repres with
-  | (Value | Immediate | Immediate64), _ -> ()
+  | (Value | Immediate | Immediate64 | Non_null_value), _ -> ()
   | Float64, (Record_ufloat | Record_mixed _) -> ()
   | Float64, (Record_boxed _ | Record_inlined _
              | Record_unboxed | Record_float) ->

ocaml/testsuite/tests/typing-layouts/annots.ml

@@ -31,6 +31,16 @@ Error: Layout void is more experimental than allowed by the enabled layouts exte
        You must enable -extension layouts_alpha to use this feature.
 |}]
 
+type t_non_null_value : non_null_value;;
+
+[%%expect{|
+Line 1, characters 24-38:
+1 | type t_non_null_value : non_null_value;;
+                            ^^^^^^^^^^^^^^
+Error: Layout non_null_value is more experimental than allowed by the enabled layouts extension.
+       You must enable -extension layouts_alpha to use this feature.
+|}]
+
 (***************************************)
 (* Test 1: annotation on type variable *)
 

ocaml/testsuite/tests/typing-layouts/basics.ml

@@ -31,6 +31,15 @@ Error: Layout void is more experimental than allowed by the enabled layouts exte
        You must enable -extension layouts_alpha to use this feature.
 |}];;
 
+type t_non_null_value : non_null_value;;
+[%%expect{|
+Line 1, characters 24-38:
+1 | type t_non_null_value : non_null_value;;
+                            ^^^^^^^^^^^^^^
+Error: Layout non_null_value is more experimental than allowed by the enabled layouts extension.
+       You must enable -extension layouts_alpha to use this feature.
+|}]
+
 (******************************************************************)
 (* Test 1: Allow non-representable function args/returns in types *)
 

ocaml/testsuite/tests/typing-layouts/basics_alpha.ml

@@ -9,6 +9,7 @@ type t_imm   : immediate
 type t_imm64 : immediate64
 type t_float64 : float64
 type t_void  : void
+type t_non_null_value : non_null_value
 
 type void_variant = VV of t_void
 type void_record = {vr_void : t_void; vr_int : int}
@@ -21,6 +22,7 @@ type t_imm : immediate
 type t_imm64 : immediate64
 type t_float64 : float64
 type t_void : void
+type t_non_null_value : non_null_value
 type void_variant = VV of t_void
 type void_record = { vr_void : t_void; vr_int : int; }
 type void_unboxed_record = { vur_void : t_void; } [@@unboxed]
@@ -142,10 +144,17 @@ Error: This pattern matches values of type t_any
 module type S = sig
   val f1 : t_value -> t_value
   val f2 : t_imm -> t_imm64
+
+  val f3 : t_non_null_value -> t_non_null_value
 end;;
 
 [%%expect{|
-module type S = sig val f1 : t_value -> t_value val f2 : t_imm -> t_imm64 end
+module type S =
+  sig
+    val f1 : t_value -> t_value
+    val f2 : t_imm -> t_imm64
+    val f3 : t_non_null_value -> t_non_null_value
+  end
 |}];;
 
 module type S2 = sig
@@ -271,6 +280,19 @@ Error: This expression has type string but an expression was expected of type
          of the definition of id_for_imms at line 1, characters 16-35.
 |}]
 
+type ('a : non_null_value) non_null_id = 'a
+
+type my_non_null = t_non_null_value non_null_id
+
+let id_for_non_nulls (x : 'a non_null_id) = x;;
+[%%expect{|
+type ('a : non_null_value) non_null_id = 'a
+type my_non_null = t_non_null_value non_null_id
+val id_for_non_nulls :
+  ('a : non_null_value). 'a non_null_id -> 'a non_null_id = <fun>
+|}]
+
+
 (************************************)
 (* Test 4: parameters and recursion *)
 type ('a : immediate) t4
@@ -348,6 +370,28 @@ type s4 = string t4
 and ('a : any) t4
 |}];;
 
+(* CR layouts v3: all default value types except for ['a Or_null.t]
+   should have layout [non_null_value], but it's not implemented yet. *)
+type s4 = string t4
+and ('a : non_null_value) t4;;
+[%%expect{|
+Line 1, characters 10-16:
+1 | type s4 = string t4
+              ^^^^^^
+Error: This type string should be an instance of type ('a : non_null_value)
+       The layout of string is value, because
+         it is the primitive value type string.
+       But the layout of string must be a sublayout of non_null_value, because
+         of the annotation on 'a in the declaration of the type t4.
+|}];;
+
+type s4 = t_non_null_value t4
+and ('a : non_null_value) t4;;
+[%%expect{|
+type s4 = t_non_null_value t4
+and ('a : non_null_value) t4
+|}];;
+
 (************************************************************)
 (* Test 5: You can touch a void, but not return it directly *)
 
@@ -429,9 +473,11 @@ Error: Non-value layout void detected in [Typeopt.layout] as sort for type
 (* Test 6: explicitly polymorphic types *)
 type ('a : immediate) t6_imm = T6imm of 'a
 type ('a : value) t6_val = T6val of 'a;;
+type ('a : non_null_value) t6_nonnull = T6nonnull of 'a;;
 [%%expect{|
 type ('a : immediate) t6_imm = T6imm of 'a
 type 'a t6_val = T6val of 'a
+type ('a : non_null_value) t6_nonnull = T6nonnull of 'a
 |}];;
 
 let ignore_val6 : 'a . 'a -> unit =
@@ -454,6 +500,20 @@ Error: This definition has type 'b -> unit which is less general than
          of the definition of t6_imm at line 1, characters 0-42.
 |}];;
 
+let ignore_nonnull6 : 'a . 'a -> unit =
+  fun a -> let _ = T6nonnull a in ();;
+[%%expect{|
+Line 2, characters 2-36:
+2 |   fun a -> let _ = T6nonnull a in ();;
+      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This definition has type 'b -> unit which is less general than
+         'a. 'a -> unit
+       The layout of 'a is value, because
+         it is or unifies with an unannotated universal variable.
+       But the layout of 'a must be a sublayout of non_null_value, because
+         of the definition of t6_nonnull at line 3, characters 0-55.
+|}]
+
 let o6 = object
   method ignore_imm6 : 'a . 'a -> unit =
     fun a -> let _ = T6imm a in ()
@@ -573,6 +633,16 @@ Error: Polymorphic variant constructor argument types must have layout value.
          it's the type of the field of a polymorphic variant.
 |}]
 
+module M8_6 = struct
+  type foo = [ `Foo of int | `Baz of t_non_null_value | `Bar of string ];;
+end;;
+[%%expect{|
+module M8_6 :
+  sig
+    type foo = [ `Bar of string | `Baz of t_non_null_value | `Foo of int ]
+  end
+|}]
+
 (************************************************)
 (* Test 9: Tuples only work on values (for now) *)
 
@@ -706,6 +776,13 @@ Error: This expression has type t_void but an expression was expected of type
          it's the type of a tuple element.
 |}];;
 
+module M9_10 = struct
+  type foo = int * t_non_null_value * string;;
+end;;
+[%%expect {|
+module M9_10 : sig type foo = int * t_non_null_value * string end
+|}]
+
 (*************************************************)
 (* Test 10: jkinds are checked by "more general" *)
 
@@ -881,6 +958,21 @@ Error: The type constraints are not consistent.
          it's the type of an object field.
 |}];;
 
+module M11_7 = struct
+  type ('a : non_null_value) t = { x : int; v : 'a }
+  type t' = < m : t_non_null_value >
+
+  let f t = t.v # foo
+end;;
+[%%expect{|
+module M11_7 :
+  sig
+    type ('a : non_null_value) t = { x : int; v : 'a; }
+    type t' = < m : t_non_null_value >
+    val f : < foo : 'a; .. > t -> 'a
+  end
+|}]
+
 (*******************************************************************)
 (* Test 12: class parameters and bound vars must have jkind value *)
 
@@ -1011,6 +1103,18 @@ Error: Variables bound in a class must have layout value.
          it's the type of an instance variable.
 |}];;
 
+module M12_8 = struct
+  class virtual foobar = object
+    val virtual xyz : t_non_null_value
+  end
+end;;
+[%%expect{|
+module M12_8 :
+  sig
+    class virtual foobar : object val virtual xyz : t_non_null_value end
+  end
+|}]
+
 (*************************************************************************)
 (* Test 13: built-in type constructors and support for non-value layouts *)
 
@@ -1055,6 +1159,18 @@ Error: This expression has type ('a : value)
          it's the type of a lazy expression.
 |}];;
 
+type t13 = t_non_null_value Lazy.t
+let x13 (x : t_non_null_value) = lazy x;;
+let y13 x : t_non_null_value =
+  match x with
+  | lazy x -> x
+;;
+[%%expect{|
+type t13 = t_non_null_value Lazy.t
+val x13 : t_non_null_value -> t_non_null_value lazy_t = <fun>
+val y13 : t_non_null_value lazy_t -> t_non_null_value = <fun>
+|}]
+
 (* option *)
 (* CR layouts v5: allow this *)
 type t13 = t_void option;;
@@ -1098,6 +1214,19 @@ Error: This expression has type ('a : value)
          the type argument of option has layout value.
 |}];;
 
+type t13 = t_non_null_value option
+let x13 (x : t_non_null_value) = Some x;;
+let y13 x : t_non_null_value =
+  match x with
+  | Some x -> x
+  | None -> assert false
+;;
+[%%expect{|
+type t13 = t_non_null_value option
+val x13 : t_non_null_value -> t_non_null_value option = <fun>
+val y13 : t_non_null_value option -> t_non_null_value = <fun>
+|}]
+
 (* list *)
 (* CR layouts: should work after relaxing the mixed block restriction. *)
 type t13 = t_void list;;
@@ -1141,6 +1270,20 @@ Error: This expression has type ('a : value)
          the type argument of list has layout value.
 |}];;
 
+
+type t13 = t_non_null_value list
+let x13 (x : t_non_null_value) = [x];;
+let y13 x : t_non_null_value =
+  match x with
+  | [x] -> x
+  | _ -> assert false
+;;
+[%%expect{|
+type t13 = t_non_null_value list
+val x13 : t_non_null_value -> t_non_null_value list = <fun>
+val y13 : t_non_null_value list -> t_non_null_value = <fun>
+|}]
+
 (* array *)
 (* CR layouts v4: should work *)
 type t13 = t_void array;;
@@ -1173,6 +1316,20 @@ Error: Non-value detected in [value_kind].
          it has to be value for the V1 safety check.
 |}];;
 
+type t13 = t_non_null_value array
+let x13 (x : t_non_null_value) = [|x|];;
+let y13 x : t_non_null_value =
+  match x with
+  | [|x|] -> x
+  | _ -> assert false
+;;
+[%%expect{|
+type t13 = t_non_null_value array
+val x13 : t_non_null_value -> t_non_null_value array = <fun>
+val y13 : t_non_null_value array -> t_non_null_value = <fun>
+|}]
+
+
 (****************************************************************************)
 (* Test 14: Examples motivating the trick with the manifest in [enter_type] *)
 type t14 = foo14 list