diff --git a/ocaml/jane/doc/extensions/unboxed-types/index.md b/ocaml/jane/doc/extensions/unboxed-types/index.md index 965aed9ed0b..cb5a72e66de 100644 --- a/ocaml/jane/doc/extensions/unboxed-types/index.md +++ b/ocaml/jane/doc/extensions/unboxed-types/index.md @@ -36,6 +36,14 @@ by a *type*. There is a small fixed set of layouts: * `any` is a layout that is the superlayout of all other layouts. It doesn't correspond to a specific runtime representation. More information [below](#the-any-layout). +* `value_or_null` is a superlayout of `value` including normal OCaml values + and null pointers. Unless `-extension-universe alpha` is set, it is displayed + as `value` and can't be used in jkind annotations. +* `any_non_null` is a sublayout of `any` forbidding null pointers. Unless + `-extension-universe alpha` is set, it is displayed as `any`. + Additionally, `any` jkind annotations are interpreted as `any_non_null` for + backwards compatibility for definitions using arrays. + Over time, we'll be adding more layouts here. # Layout annotation @@ -353,7 +361,7 @@ orders: * Records * Constructors - + Unboxed numbers can't be put in these structures: * Constructors with inline record fields @@ -361,11 +369,11 @@ Unboxed numbers can't be put in these structures: * Extensible variant constructors * Top-level fields of modules * Tuples - + There aren't fundamental issues with the structures that lack support. They will just take some work to implement. -Here's an example of a record with an unboxed field. We call such a record +Here's an example of a record with an unboxed field. We call such a record a "mixed record". ```ocaml @@ -429,7 +437,7 @@ These operations aren't supported: * polymorphic comparison and equality * polymorphic hash * marshaling - + These operations raise an exception at runtime, similar to how polymorphic comparison raises when called on a function. @@ -453,7 +461,7 @@ scanned by the garbage collector. [^can-or-must]: "Can-or-must" is a bit of a mouthful, but it captures the right nuance. Pointer values *must* be scanned, unboxed number fields *must* be skipped, and immediate values *can* be scanned or skipped. The ordering constraint on structure fields is a reflection of the same -ordering restriction in the runtime representation. +ordering restriction in the runtime representation. ## C bindings for mixed blocks diff --git a/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml b/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml index 0bb4f9fd3a1..ecc44427d38 100644 --- a/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-arrays/basics.ml @@ -2,9 +2,6 @@ include stdlib_upstream_compatible; flambda2; { - flags = "-extension layouts_alpha -extension small_numbers"; - expect; - }{ flags = "-extension layouts_beta -extension small_numbers"; expect; }{ diff --git a/ocaml/testsuite/tests/typing-layouts-arrays/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts-arrays/basics_alpha.ml new file mode 100644 index 00000000000..f0f3ff39990 --- /dev/null +++ b/ocaml/testsuite/tests/typing-layouts-arrays/basics_alpha.ml @@ -0,0 +1,343 @@ +(* TEST + include stdlib_upstream_compatible; + flambda2; + { + flags = "-extension layouts_alpha -extension small_numbers"; + expect; + } +*) +(* Tests around type-checking arrays of unboxed types. Tests around + compilation correctness should go somewhere else. *) + +(*******************************************) +(* Test 1: Support unboxed types in arrays *) + +type t_any_non_null : any_non_null + +type t1 = float# array +type t2 = int32# array +type t3 = int64# array +type t4 = nativeint# array +type t5 = t_any_non_null array +type t6 = float32# array + +type ('a : float64) t1' = 'a array +type ('a : bits32) t2' = 'a array +type ('a : bits64) t3' = 'a array +type ('a : word) t4' = 'a array +type ('a : any_non_null) t5' = 'a array +type ('a : float32) t6' = 'a array + +[%%expect{| +type t_any_non_null : any_non_null +type t1 = float# array +type t2 = int32# array +type t3 = int64# array +type t4 = nativeint# array +type t5 = t_any_non_null array +type t6 = float32# array +type ('a : float64) t1' = 'a array +type ('a : bits32) t2' = 'a array +type ('a : bits64) t3' = 'a array +type ('a : word) t4' = 'a array +type ('a : any_non_null) t5' = 'a array +type ('a : float32) t6' = 'a array +|}];; + +(*****************************) +(* Test 2: array expressions *) + +let v1 = [| #1. |] +[%%expect{| +val v1 : float# array = [||] +|}];; + + +let v2 = [| #1l |] +[%%expect{| +val v2 : int32# array = [||] +|}];; + + +let v3 = [| #1L |] +[%%expect{| +val v3 : int64# array = [||] +|}];; + + +let v4 = [| #1n |] +[%%expect{| +val v4 : nativeint# array = [||] +|}];; + +let v5 = [| #1.s |] +[%%expect{| +val v5 : float32# array = [||] +|}];; + +(****************************************) +(* Test 3: Array operations do not work *) + +let f (x : float# array) = x.(0) +[%%expect{| +Line 1, characters 27-28: +1 | let f (x : float# array) = x.(0) + ^ +Error: This expression has type float# array + but an expression was expected of type 'a array + The layout of float# is float64 + because it is the primitive float64 type float#. + But the layout of float# must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f (x : float# array) = Array.length x +[%%expect{| +Line 1, characters 40-41: +1 | let f (x : float# array) = Array.length x + ^ +Error: This expression has type float# array + but an expression was expected of type 'a array + The layout of float# is float64 + because it is the primitive float64 type float#. + But the layout of float# must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +(*****************************************************************) +(* Test 4: Calling wrong primitives on unboxed array kinds fails *) + +external get : float# array -> int -> float = "%floatarray_safe_get" +let d (x : float# array) = get x 0 + +[%%expect{| +external get : float# array -> int -> float = "%floatarray_safe_get" +Line 2, characters 27-34: +2 | let d (x : float# array) = get x 0 + ^^^^^^^ +Error: Floatarray primitives can't be used on arrays containing + unboxed types. +|}];; + + +(* [Obj.magic] can bypass the error but this should be discouraged *) +external get : floatarray -> int -> float = "%floatarray_safe_get" +let d (x : float# array) = get (Obj.magic x : floatarray) 0 + +[%%expect{| +external get : floatarray -> int -> float = "%floatarray_safe_get" +val d : float# array -> float = +|}];; + +external get : ('a : any_non_null). 'a array -> int -> float = "%floatarray_safe_get" +let d (x : 'a array) = get x 0 + +[%%expect{| +external get : ('a : any_non_null). 'a array -> int -> float + = "%floatarray_safe_get" +Line 2, characters 23-30: +2 | let d (x : 'a array) = get x 0 + ^^^^^^^ +Error: A representable layout is required here. + The layout of 'a is any + because of the definition of d at line 2, characters 6-30. + But the layout of 'a must be representable + because it's the type of an array element. +|}];; + +external get : int32# array -> int -> float = "%floatarray_safe_get" +let d (x : int32# array) = get x 0 + +[%%expect{| +external get : int32# array -> int -> float = "%floatarray_safe_get" +Line 2, characters 27-34: +2 | let d (x : int32# array) = get x 0 + ^^^^^^^ +Error: Floatarray primitives can't be used on arrays containing + unboxed types. +|}];; + +external get : int64# array -> int -> float = "%floatarray_safe_get" +let d (x : int64# array) = get x 0 + +[%%expect{| +external get : int64# array -> int -> float = "%floatarray_safe_get" +Line 2, characters 27-34: +2 | let d (x : int64# array) = get x 0 + ^^^^^^^ +Error: Floatarray primitives can't be used on arrays containing + unboxed types. +|}];; + +external get : nativeint# array -> int -> float = "%floatarray_safe_get" +let d (x : nativeint# array) = get x 0 + +[%%expect{| +external get : nativeint# array -> int -> float = "%floatarray_safe_get" +Line 2, characters 31-38: +2 | let d (x : nativeint# array) = get x 0 + ^^^^^^^ +Error: Floatarray primitives can't be used on arrays containing + unboxed types. +|}];; + +external get : float32# array -> int -> float = "%floatarray_safe_get" +let d (x : float32# array) = get x 0 + +[%%expect{| +external get : float32# array -> int -> float = "%floatarray_safe_get" +Line 2, characters 29-36: +2 | let d (x : float32# array) = get x 0 + ^^^^^^^ +Error: Floatarray primitives can't be used on arrays containing + unboxed types. +|}];; + +(**************************) +(* Test 5: [@layout_poly] *) + +external[@layout_poly] get : ('a : any_non_null). 'a array -> int -> 'a = "%array_safe_get" +let f1 (x : float# array) = get x 0 +let f2 (x : int32# array) = get x 0 +let f3 (x : int64# array) = get x 0 +let f4 (x : nativeint# array) = get x 0 +let f5 (x : float32# array) = get x 0 + +[%%expect{| +external get : ('a : any_non_null). 'a array -> int -> 'a = "%array_safe_get" + [@@layout_poly] +val f1 : float# array -> float# = +val f2 : int32# array -> int32# = +val f3 : int64# array -> int64# = +val f4 : nativeint# array -> nativeint# = +val f5 : float32# array -> float32# = +|}];; + +external[@layout_poly] set : ('a : any_non_null). 'a array -> int -> 'a -> unit = "%array_safe_set" +let f1 (x : float# array) v = set x 0 v +let f2 (x : int32# array) v = set x 0 v +let f3 (x : int64# array) v = set x 0 v +let f4 (x : nativeint# array) v = set x 0 v +let f5 (x : float32# array) v = set x 0 v + +[%%expect{| +external set : ('a : any_non_null). 'a array -> int -> 'a -> unit + = "%array_safe_set" [@@layout_poly] +val f1 : float# array -> float# -> unit = +val f2 : int32# array -> int32# -> unit = +val f3 : int64# array -> int64# -> unit = +val f4 : nativeint# array -> nativeint# -> unit = +val f5 : float32# array -> float32# -> unit = +|}] + +(***********************************) +(* Test 6: sort variable inference *) + +module M6_1 = struct + (* sort var in pat *) + + let get_third arr = + match arr with + | [| _; _; z |] -> z + | _ -> assert false + + let _ = assert (Stdlib_upstream_compatible.Int32_u.equal #42l (get_third [| #0l; #1l; #42l |])) + + let _ = assert (Stdlib_upstream_compatible.Int64_u.equal #42L (get_third [| #0L; #1L; #42L |])) +end + +[%%expect{| +Line 11, characters 79-82: +11 | let _ = assert (Stdlib_upstream_compatible.Int64_u.equal #42L (get_third [| #0L; #1L; #42L |])) + ^^^ +Error: This expression has type int64# but an expression was expected of type + ('a : bits32) + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of bits32 + because of the definition of get_third at lines 4-7, characters 16-23. +|}] + +module M6_2 = struct + (* sort var in exp *) + + external[@layout_poly] get : ('a : any_non_null). 'a array -> int -> 'a = "%array_safe_get" + + let arr = [||] + + let f1 idx : float# = get arr idx + let f2 idx : int32# = get arr idx +end + +(* CR layouts v2.8: The jkind in the error message is wrong. It should really be + ('a : layout float64) *) +[%%expect{| +Line 9, characters 24-35: +9 | let f2 idx : int32# = get arr idx + ^^^^^^^^^^^ +Error: This expression has type ('a : float64) + but an expression was expected of type int32# + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of float64 + because of the definition of arr at line 6, characters 12-16. +|}] + +(*********************) +(* Test 7: rec check *) + +(* See upstream PR #6939 *) + +let _ = + let[@warning "-10"] rec x = [| x |]; #42.0 in + ();; +[%%expect{| +Line 2, characters 30-44: +2 | let[@warning "-10"] rec x = [| x |]; #42.0 in + ^^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}] + +let _ = + let[@warning "-10"] rec x = [| x |]; #42l in + ();; + +[%%expect{| +Line 2, characters 30-43: +2 | let[@warning "-10"] rec x = [| x |]; #42l in + ^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}] + +let _ = + let[@warning "-10"] rec x = [| x |]; #42L in + ();; + +[%%expect{| +Line 2, characters 30-43: +2 | let[@warning "-10"] rec x = [| x |]; #42L in + ^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}] + +let _ = + let[@warning "-10"] rec x = [| x |]; #42n in + ();; + +[%%expect{| +Line 2, characters 30-43: +2 | let[@warning "-10"] rec x = [| x |]; #42n in + ^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}] + +let _ = + let[@warning "-10"] rec x = [| x |]; #42.0s in + ();; + +[%%expect{| +Line 2, characters 30-45: +2 | let[@warning "-10"] rec x = [| x |]; #42.0s in + ^^^^^^^^^^^^^^^ +Error: This kind of expression is not allowed as right-hand side of `let rec' +|}] diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml b/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml index 8f1a652f620..bf170b12375 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits32/basics.ml @@ -1,9 +1,6 @@ (* TEST { expect; - }{ - flags = "-extension layouts_alpha"; - expect; }{ flags = "-extension layouts_beta"; expect; @@ -196,7 +193,8 @@ Error: This type ('b : value) should be an instance of type ('a : bits32) The layout of 'a is bits32 because of the annotation on 'a in the declaration of the type t4_7. But the layout of 'a must overlap with value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. |}] (*********************************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts-bits32/basics_alpha.ml new file mode 100644 index 00000000000..9088619418a --- /dev/null +++ b/ocaml/testsuite/tests/typing-layouts-bits32/basics_alpha.ml @@ -0,0 +1,769 @@ +(* TEST + { + flags = "-extension layouts_alpha"; + expect; + } +*) + +(* This file contains typing tests for the layout [bits32]. + + Runtime tests for the type [int32#] can be found in the + [unboxed_int32], [alloc], and [test_int32_u] tests in this + directory. The type [int32#] here is used as a convenient example of a + concrete [bits32] type in some tests, but its behavior isn't the primary + purpose of this test. *) + +type t_bits32 : bits32 +type ('a : bits32) t_bits32_id = 'a + +(*********************************) +(* Test 1: The identity function *) + +let f1_1 (x : t_bits32) = x;; +let f1_2 (x : 'a t_bits32_id) = x;; +let f1_3 (x : int32#) = x;; +[%%expect{| +type t_bits32 : bits32 +type ('a : bits32) t_bits32_id = 'a +val f1_1 : t_bits32 -> t_bits32 = +val f1_2 : ('a : bits32). 'a t_bits32_id -> 'a t_bits32_id = +val f1_3 : int32# -> int32# = +|}];; + +(*****************************************) +(* Test 2: You can let-bind them locally *) +let f2_1 (x : t_bits32) = + let y = x in + y;; + +let f2_2 (x : 'a t_bits32_id) = + let y = x in + y;; + +let f2_3 (x : int32#) = + let y = x in + y;; +[%%expect{| +val f2_1 : t_bits32 -> t_bits32 = +val f2_2 : ('a : bits32). 'a t_bits32_id -> 'a t_bits32_id = +val f2_3 : int32# -> int32# = +|}];; + +(*****************************************) +(* Test 3: No module-level bindings yet. *) + +let x3_1 : t_bits32 = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_1 : t_bits32 = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_1 has layout bits32. +|}];; + +let x3_2 : 'a t_bits32_id = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_2 : 'a t_bits32_id = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_2 has layout bits32. +|}];; + +let x3_3 : int32# = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_3 : int32# = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_3 has layout bits32. +|}];; + +module M3_4 = struct + let x : t_bits32 = assert false +end +[%%expect{| +Line 2, characters 6-7: +2 | let x : t_bits32 = assert false + ^ +Error: Types of top-level module bindings must have layout value, but + the type of x has layout bits32. +|}];; + +module M3_5 = struct + let f (x : int32#) = x + + let y = f (assert false) +end +[%%expect{| +Line 4, characters 6-7: +4 | let y = f (assert false) + ^ +Error: Types of top-level module bindings must have layout value, but + the type of y has layout bits32. +|}];; + +(*************************************) +(* Test 4: No putting them in tuples *) + +let f4_1 (x : t_bits32) = x, false;; +[%%expect{| +Line 1, characters 26-27: +1 | let f4_1 (x : t_bits32) = x, false;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of a tuple element. +|}];; + +let f4_2 (x : 'a t_bits32_id) = x, false;; +[%%expect{| +Line 1, characters 32-33: +1 | let f4_2 (x : 'a t_bits32_id) = x, false;; + ^ +Error: This expression has type 'a t_bits32_id = ('a : bits32) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits32_id is bits32 + because of the definition of t_bits32_id at line 2, characters 0-35. + But the layout of 'a t_bits32_id must overlap with value + because it's the type of a tuple element. +|}];; + +let f4_3 (x : int32#) = x, false;; +[%%expect{| +Line 1, characters 24-25: +1 | let f4_3 (x : int32#) = x, false;; + ^ +Error: This expression has type int32# but an expression was expected of type + ('a : value_or_null) + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_4 = t_bits32 * string;; +[%%expect{| +Line 1, characters 12-20: +1 | type t4_4 = t_bits32 * string;; + ^^^^^^^^ +Error: Tuple element types must have layout value. + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_5 = int * int32#;; +[%%expect{| +Line 1, characters 18-24: +1 | type t4_5 = int * int32#;; + ^^^^^^ +Error: Tuple element types must have layout value. + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type ('a : bits32) t4_6 = 'a * 'a +[%%expect{| +Line 1, characters 26-28: +1 | type ('a : bits32) t4_6 = 'a * 'a + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : bits32) + The layout of 'a is bits32 + because of the annotation on 'a in the declaration of the type t4_6. + But the layout of 'a must overlap with value + because it's the type of a tuple element. +|}];; + +(* check for layout propagation *) +type ('a : bits32, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; +[%%expect{| +Line 1, characters 31-33: +1 | type ('a : bits32, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; + ^^ +Error: This type ('b : value) should be an instance of type ('a : bits32) + The layout of 'a is bits32 + because of the annotation on 'a in the declaration of the type t4_7. + But the layout of 'a must overlap with value + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. +|}] + +(*********************************************************) +(* Test 5: Allowed in some structures in typedecls. *) + +type t5_1 = { x : t_bits32 };; +[%%expect{| +type t5_1 = { x : t_bits32; } +|}];; + +type t5_2 = { y : int; x : t_bits32 };; +[%%expect{| +type t5_2 = { y : int; x : t_bits32; } +|}];; + +type t5_2' = { y : string; x : t_bits32 };; +[%%expect{| +type t5_2' = { y : string; x : t_bits32; } +|}];; + +(* CR layouts 2.5: allow this *) +type t5_3 = { x : t_bits32 } [@@unboxed];; +[%%expect{| +Line 1, characters 14-26: +1 | type t5_3 = { x : t_bits32 } [@@unboxed];; + ^^^^^^^^^^^^ +Error: Type t_bits32 has layout bits32. + Unboxed records may not yet contain types of this layout. +|}];; + + +type t5_4 = A of t_bits32;; +[%%expect{| +type t5_4 = A of t_bits32 +|}];; + +type t5_5 = A of int * t_bits32;; +[%%expect{| +type t5_5 = A of int * t_bits32 +|}];; + +type ('a : bits32) t5_7 = A of int +type ('a : bits32) t5_8 = A of 'a;; +[%%expect{| +type ('a : bits32) t5_7 = A of int +type ('a : bits32) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_bits32 * 'a + +[%%expect{| +Line 1, characters 23-41: +1 | type 'a t_disallowed = A of t_bits32 * 'a + ^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_bits32, but found boxed argument, 'a. +|}] + +type t5_6 = A of t_bits32 [@@unboxed];; +[%%expect{| +Line 1, characters 12-25: +1 | type t5_6 = A of t_bits32 [@@unboxed];; + ^^^^^^^^^^^^^ +Error: Type t_bits32 has layout bits32. + Unboxed variants may not yet contain types of this layout. +|}];; + +(****************************************************) +(* Test 6: Can't be put at top level of signatures. *) +module type S6_1 = sig val x : t_bits32 end + +let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; +[%%expect{| +Line 1, characters 31-39: +1 | module type S6_1 = sig val x : t_bits32 end + ^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of type t_bits32 must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_2 = sig val x : 'a t_bits32_id end +[%%expect{| +Line 1, characters 31-45: +1 | module type S6_2 = sig val x : 'a t_bits32_id end + ^^^^^^^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type 'a t_bits32_id is bits32 + because of the definition of t_bits32_id at line 2, characters 0-35. + But the layout of type 'a t_bits32_id must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_3 = sig val x : int32# end +[%%expect{| +Line 1, characters 31-37: +1 | module type S6_3 = sig val x : int32# end + ^^^^^^ +Error: This type signature for x is not a value type. + The layout of type int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of type int32# must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + + +(*********************************************************) +(* Test 7: Can't be used as polymorphic variant argument *) +let f7_1 (x : t_bits32) = `A x;; +[%%expect{| +Line 1, characters 29-30: +1 | let f7_1 (x : t_bits32) = `A x;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_2 (x : 'a t_bits32_id) = `A x;; +[%%expect{| +Line 1, characters 35-36: +1 | let f7_2 (x : 'a t_bits32_id) = `A x;; + ^ +Error: This expression has type 'a t_bits32_id = ('a : bits32) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits32_id is bits32 + because of the definition of t_bits32_id at line 2, characters 0-35. + But the layout of 'a t_bits32_id must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_3 (x : int32#) = `A x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f7_3 (x : int32#) = `A x;; + ^ +Error: This expression has type int32# but an expression was expected of type + ('a : value_or_null) + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type f7_4 = [ `A of t_bits32 ];; +[%%expect{| +Line 1, characters 20-28: +1 | type f7_4 = [ `A of t_bits32 ];; + ^^^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type ('a : bits32) f7_5 = [ `A of 'a ];; +[%%expect{| +Line 1, characters 34-36: +1 | type ('a : bits32) f7_5 = [ `A of 'a ];; + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : bits32) + The layout of 'a is bits32 + because of the annotation on 'a in the declaration of the type f7_5. + But the layout of 'a must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +(************************************************************) +(* Test 8: Normal polymorphic functions don't work on them. *) + +let make_t_bits32 () : t_bits32 = assert false +let make_t_bits32_id () : 'a t_bits32_id = assert false +let make_int32u () : int32# = assert false + +let id_value x = x;; +[%%expect{| +val make_t_bits32 : unit -> t_bits32 = +val make_t_bits32_id : ('a : bits32). unit -> 'a t_bits32_id = +val make_int32u : unit -> int32# = +val id_value : ('a : value_or_null). 'a -> 'a = +|}];; + +let x8_1 = id_value (make_t_bits32 ());; +[%%expect{| +Line 1, characters 20-38: +1 | let x8_1 = id_value (make_t_bits32 ());; + ^^^^^^^^^^^^^^^^^^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_2 = id_value (make_t_bits32_id ());; +[%%expect{| +Line 1, characters 20-41: +1 | let x8_2 = id_value (make_t_bits32_id ());; + ^^^^^^^^^^^^^^^^^^^^^ +Error: This expression has type 'a t_bits32_id = ('a : bits32) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits32_id is bits32 + because of the definition of make_t_bits32_id at line 2, characters 21-55. + But the layout of 'a t_bits32_id must overlap with value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_3 = id_value (make_int32u ());; +[%%expect{| +Line 1, characters 20-36: +1 | let x8_3 = id_value (make_int32u ());; + ^^^^^^^^^^^^^^^^ +Error: This expression has type int32# but an expression was expected of type + ('a : value_or_null) + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +(*************************************) +(* Test 9: But bits32 functions do. *) + +let twice f (x : 'a t_bits32_id) = f (f x) + +let f9_1 () = twice f1_1 (make_t_bits32 ()) +let f9_2 () = twice f1_2 (make_t_bits32_id ()) +let f9_3 () = twice f1_3 (make_int32u ());; +[%%expect{| +val twice : + ('a : bits32). + ('a t_bits32_id -> 'a t_bits32_id) -> 'a t_bits32_id -> 'a t_bits32_id = + +val f9_1 : unit -> t_bits32 t_bits32_id = +val f9_2 : ('a : bits32). unit -> 'a t_bits32_id = +val f9_3 : unit -> int32# t_bits32_id = +|}];; + +(**************************************************) +(* Test 10: Invalid uses of bits32 and externals *) + +(* Valid uses of bits32 in externals are tested elsewhere - this is just a test + for uses the typechecker should reject. In particular + - if using a non-value layout in an external, you must supply separate + bytecode and native code implementations, + - [@unboxed] is allowed on unboxed types but has no effect. Same is not + true for [@untagged]. +*) + +external f10_1 : int -> bool -> int32# = "foo";; +[%%expect{| +Line 1, characters 0-46: +1 | external f10_1 : int -> bool -> int32# = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_2 : t_bits32 -> int = "foo";; +[%%expect{| +Line 1, characters 0-40: +1 | external f10_2 : t_bits32 -> int = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_6 : (int32#[@unboxed]) -> bool -> string = "foo" "bar";; +[%%expect{| +external f10_6 : int32# -> bool -> string = "foo" "bar" +|}];; + +external f10_7 : string -> (int32#[@unboxed]) = "foo" "bar";; +[%%expect{| +external f10_7 : string -> int32# = "foo" "bar" +|}];; + +external f10_8 : int32 -> int32# = "foo" "bar" [@@unboxed];; +[%%expect{| +external f10_8 : (int32 [@unboxed]) -> int32# = "foo" "bar" +|}];; + +external f10_9 : (int32#[@untagged]) -> bool -> string = "foo" "bar";; +[%%expect{| +Line 1, characters 18-24: +1 | external f10_9 : (int32#[@untagged]) -> bool -> string = "foo" "bar";; + ^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +external f10_10 : string -> (int32#[@untagged]) = "foo" "bar";; +[%%expect{| +Line 1, characters 29-35: +1 | external f10_10 : string -> (int32#[@untagged]) = "foo" "bar";; + ^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +(*************************************************) +(* Test 11: bits32 banned in extensible variants *) + +type t11_1 = .. + +type t11_1 += A of t_bits32;; +[%%expect{| +type t11_1 = .. +Line 3, characters 14-27: +3 | type t11_1 += A of t_bits32;; + ^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type t11_1 += B of int32#;; +[%%expect{| +Line 1, characters 14-25: +1 | type t11_1 += B of int32#;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type ('a : bits32) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : bits32) t11_2 = .. +type 'a t11_2 += A of int +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +(* not allowed: value in flat suffix *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] + +(***************************************) +(* Test 12: bits32 in objects/classes *) + +(* First, disallowed uses: in object types, class parameters, etc. *) +type t12_1 = < x : t_bits32 >;; +[%%expect{| +Line 1, characters 15-27: +1 | type t12_1 = < x : t_bits32 >;; + ^^^^^^^^^^^^ +Error: Object field types must have layout value. + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of an object field. +|}];; + +type ('a : bits32) t12_2 = < x : 'a >;; +[%%expect{| +Line 1, characters 33-35: +1 | type ('a : bits32) t12_2 = < x : 'a >;; + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : bits32) + The layout of 'a is bits32 + because of the annotation on 'a in the declaration of the type t12_2. + But the layout of 'a must overlap with value + because it's the type of an object field. +|}] + +class c12_3 = object method x : t_bits32 = assert false end;; +[%%expect{| +Line 1, characters 21-55: +1 | class c12_3 = object method x : t_bits32 = assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The method x has type t_bits32 but is expected to have type + ('a : value) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of an object field. +|}];; + +class ['a] c12_4 = object + method x : 'a t_bits32_id -> 'a t_bits32_id = assert false +end;; +[%%expect{| +Line 2, characters 13-15: +2 | method x : 'a t_bits32_id -> 'a t_bits32_id = assert false + ^^ +Error: This type ('a : bits32) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with bits32 + because of the definition of t_bits32_id at line 2, characters 0-35. +|}];; + +class c12_5 = object val x : t_bits32 = assert false end;; +[%%expect{| +Line 1, characters 25-26: +1 | class c12_5 = object val x : t_bits32 = assert false end;; + ^ +Error: Variables bound in a class must have layout value. + The layout of x is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of x must be a sublayout of value + because it's the type of a class field. +|}];; + +class type c12_6 = object method x : int32# end;; +[%%expect{| +Line 1, characters 26-43: +1 | class type c12_6 = object method x : int32# end;; + ^^^^^^^^^^^^^^^^^ +Error: The method x has type int32# but is expected to have type ('a : value) + The layout of int32# is bits32 + because it is the primitive bits32 type int32#. + But the layout of int32# must be a sublayout of value + because it's the type of an object field. +|}];; + +class type c12_7 = object val x : int32# end +[%%expect{| +Line 1, characters 26-40: +1 | class type c12_7 = object val x : int32# end + ^^^^^^^^^^^^^^ +Error: Variables bound in a class must have layout value. + The layout of x is bits32 + because it is the primitive bits32 type int32#. + But the layout of x must be a sublayout of value + because it's the type of an instance variable. +|}];; + +class type ['a] c12_8 = object + val x : 'a t_bits32_id -> 'a t_bits32_id +end +[%%expect{| +Line 2, characters 10-12: +2 | val x : 'a t_bits32_id -> 'a t_bits32_id + ^^ +Error: This type ('a : bits32) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with bits32 + because of the definition of t_bits32_id at line 2, characters 0-35. +|}];; + +(* Second, allowed uses: as method parameters / returns *) +type t12_8 = < f : t_bits32 -> t_bits32 > +let f12_9 (o : t12_8) x = o#f x +let f12_10 o (y : t_bits32) : t_bits32 = o#baz y y y;; +class ['a] c12_11 = object + method x : t_bits32 -> 'a = assert false +end;; +class ['a] c12_12 = object + method x : 'a -> t_bits32 = assert false +end;; +[%%expect{| +type t12_8 = < f : t_bits32 -> t_bits32 > +val f12_9 : t12_8 -> t_bits32 -> t_bits32 = +val f12_10 : + < baz : t_bits32 -> t_bits32 -> t_bits32 -> t_bits32; .. > -> + t_bits32 -> t_bits32 = +class ['a] c12_11 : object method x : t_bits32 -> 'a end +class ['a] c12_12 : object method x : 'a -> t_bits32 end +|}];; + +(* Third, another disallowed use: capture in an object. *) +let f12_13 m1 m2 = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: This expression has type ('a : value) + but an expression was expected of type t_bits32 + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +let f12_14 (m1 : t_bits32) (m2 : t_bits32) = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: m1 must have a type of layout value because it is captured by an object. + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +(*********************************************************************) +(* Test 13: Ad-hoc polymorphic operations don't work on bits32 yet. *) + +(* CR layouts v5: Remember to handle the case of calling these on structures + containing other layouts. *) + +let f13_1 (x : t_bits32) = x = x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f13_1 (x : t_bits32) = x = x;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_2 (x : t_bits32) = compare x x;; +[%%expect{| +Line 1, characters 35-36: +1 | let f13_2 (x : t_bits32) = compare x x;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_3 (x : t_bits32) = Marshal.to_bytes x;; +[%%expect{| +Line 1, characters 44-45: +1 | let f13_3 (x : t_bits32) = Marshal.to_bytes x;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_4 (x : t_bits32) = Hashtbl.hash x;; +[%%expect{| +Line 1, characters 40-41: +1 | let f13_4 (x : t_bits32) = Hashtbl.hash x;; + ^ +Error: This expression has type t_bits32 + but an expression was expected of type ('a : value) + The layout of t_bits32 is bits32 + because of the definition of t_bits32 at line 1, characters 0-22. + But the layout of t_bits32 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml b/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml index c95bd80d326..3bc6954a408 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits64/basics.ml @@ -1,9 +1,6 @@ (* TEST { expect; - }{ - flags = "-extension layouts_alpha"; - expect; }{ flags = "-extension layouts_beta"; expect; @@ -196,7 +193,8 @@ Error: This type ('b : value) should be an instance of type ('a : bits64) The layout of 'a is bits64 because of the annotation on 'a in the declaration of the type t4_7. But the layout of 'a must overlap with value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. |}] (****************************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts-bits64/basics_alpha.ml new file mode 100644 index 00000000000..261a8a3fd4d --- /dev/null +++ b/ocaml/testsuite/tests/typing-layouts-bits64/basics_alpha.ml @@ -0,0 +1,771 @@ +(* TEST + { + flags = "-extension layouts_alpha"; + expect; + } +*) + +(* This file contains typing tests for the layout [bits64]. + + Runtime tests for the type [int64#] can be found in the + [unboxed_int64], [alloc], and [test_int64_u] tests in this + directory. The type [int64#] here is used as a convenient example of a + concrete [bits64] type in some tests, but its behavior isn't the primary + purpose of this test. *) + +type t_bits64 : bits64 +type ('a : bits64) t_bits64_id = 'a + +(*********************************) +(* Test 1: The identity function *) + +let f1_1 (x : t_bits64) = x;; +let f1_2 (x : 'a t_bits64_id) = x;; +let f1_3 (x : int64#) = x;; +[%%expect{| +type t_bits64 : bits64 +type ('a : bits64) t_bits64_id = 'a +val f1_1 : t_bits64 -> t_bits64 = +val f1_2 : ('a : bits64). 'a t_bits64_id -> 'a t_bits64_id = +val f1_3 : int64# -> int64# = +|}];; + +(*****************************************) +(* Test 2: You can let-bind them locally *) +let f2_1 (x : t_bits64) = + let y = x in + y;; + +let f2_2 (x : 'a t_bits64_id) = + let y = x in + y;; + +let f2_3 (x : int64#) = + let y = x in + y;; +[%%expect{| +val f2_1 : t_bits64 -> t_bits64 = +val f2_2 : ('a : bits64). 'a t_bits64_id -> 'a t_bits64_id = +val f2_3 : int64# -> int64# = +|}];; + +(*****************************************) +(* Test 3: No module-level bindings yet. *) + +let x3_1 : t_bits64 = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_1 : t_bits64 = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_1 has layout bits64. +|}];; + +let x3_2 : 'a t_bits64_id = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_2 : 'a t_bits64_id = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_2 has layout bits64. +|}];; + +let x3_3 : int64# = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_3 : int64# = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_3 has layout bits64. +|}];; + +module M3_4 = struct + let x : t_bits64 = assert false +end +[%%expect{| +Line 2, characters 6-7: +2 | let x : t_bits64 = assert false + ^ +Error: Types of top-level module bindings must have layout value, but + the type of x has layout bits64. +|}];; + +module M3_5 = struct + let f (x : int64#) = x + + let y = f (assert false) +end +[%%expect{| +Line 4, characters 6-7: +4 | let y = f (assert false) + ^ +Error: Types of top-level module bindings must have layout value, but + the type of y has layout bits64. +|}];; + +(*************************************) +(* Test 4: No putting them in tuples *) + +let f4_1 (x : t_bits64) = x, false;; +[%%expect{| +Line 1, characters 26-27: +1 | let f4_1 (x : t_bits64) = x, false;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of a tuple element. +|}];; + +let f4_2 (x : 'a t_bits64_id) = x, false;; +[%%expect{| +Line 1, characters 32-33: +1 | let f4_2 (x : 'a t_bits64_id) = x, false;; + ^ +Error: This expression has type 'a t_bits64_id = ('a : bits64) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits64_id is bits64 + because of the definition of t_bits64_id at line 2, characters 0-35. + But the layout of 'a t_bits64_id must overlap with value + because it's the type of a tuple element. +|}];; + +let f4_3 (x : int64#) = x, false;; +[%%expect{| +Line 1, characters 24-25: +1 | let f4_3 (x : int64#) = x, false;; + ^ +Error: This expression has type int64# but an expression was expected of type + ('a : value_or_null) + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_4 = t_bits64 * string;; +[%%expect{| +Line 1, characters 12-20: +1 | type t4_4 = t_bits64 * string;; + ^^^^^^^^ +Error: Tuple element types must have layout value. + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_5 = int * int64#;; +[%%expect{| +Line 1, characters 18-24: +1 | type t4_5 = int * int64#;; + ^^^^^^ +Error: Tuple element types must have layout value. + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type ('a : bits64) t4_6 = 'a * 'a +[%%expect{| +Line 1, characters 26-28: +1 | type ('a : bits64) t4_6 = 'a * 'a + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : bits64) + The layout of 'a is bits64 + because of the annotation on 'a in the declaration of the type t4_6. + But the layout of 'a must overlap with value + because it's the type of a tuple element. +|}];; + +(* check for layout propagation *) +type ('a : bits64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; +[%%expect{| +Line 1, characters 31-33: +1 | type ('a : bits64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; + ^^ +Error: This type ('b : value) should be an instance of type ('a : bits64) + The layout of 'a is bits64 + because of the annotation on 'a in the declaration of the type t4_7. + But the layout of 'a must overlap with value + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. +|}] + +(****************************************************) +(* Test 5: Allowed in some structures in typedecls. *) + +type t5_1 = { x : t_bits64 };; +[%%expect{| +type t5_1 = { x : t_bits64; } +|}];; + +type t5_2 = { y : int; x : t_bits64 };; +[%%expect{| +type t5_2 = { y : int; x : t_bits64; } +|}];; + +type t5_2' = { y : string; x : t_bits64 };; +[%%expect{| +type t5_2' = { y : string; x : t_bits64; } +|}];; + +(* CR layouts 2.5: allow this *) +type t5_3 = { x : t_bits64 } [@@unboxed];; +[%%expect{| +Line 1, characters 14-26: +1 | type t5_3 = { x : t_bits64 } [@@unboxed];; + ^^^^^^^^^^^^ +Error: Type t_bits64 has layout bits64. + Unboxed records may not yet contain types of this layout. +|}];; + +type t5_4 = A of t_bits64;; +[%%expect{| +type t5_4 = A of t_bits64 +|}];; + +type t5_5 = A of int * t_bits64;; +[%%expect{| +type t5_5 = A of int * t_bits64 +|}];; + +type ('a : bits64) t5_7 = A of int +type ('a : bits64) t5_8 = A of 'a;; +[%%expect{| +type ('a : bits64) t5_7 = A of int +type ('a : bits64) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_bits64 * 'a + +[%%expect{| +Line 1, characters 23-41: +1 | type 'a t_disallowed = A of t_bits64 * 'a + ^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_bits64, but found boxed argument, 'a. +|}] + + +type t5_6 = A of t_bits64 [@@unboxed];; +[%%expect{| +Line 1, characters 12-25: +1 | type t5_6 = A of t_bits64 [@@unboxed];; + ^^^^^^^^^^^^^ +Error: Type t_bits64 has layout bits64. + Unboxed variants may not yet contain types of this layout. +|}];; + +(****************************************************) +(* Test 6: Can't be put at top level of signatures. *) +module type S6_1 = sig val x : t_bits64 end + +let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; +[%%expect{| +Line 1, characters 31-39: +1 | module type S6_1 = sig val x : t_bits64 end + ^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of type t_bits64 must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_2 = sig val x : 'a t_bits64_id end +[%%expect{| +Line 1, characters 31-45: +1 | module type S6_2 = sig val x : 'a t_bits64_id end + ^^^^^^^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type 'a t_bits64_id is bits64 + because of the definition of t_bits64_id at line 2, characters 0-35. + But the layout of type 'a t_bits64_id must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_3 = sig val x : int64# end +[%%expect{| +Line 1, characters 31-37: +1 | module type S6_3 = sig val x : int64# end + ^^^^^^ +Error: This type signature for x is not a value type. + The layout of type int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of type int64# must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + + +(*********************************************************) +(* Test 7: Can't be used as polymorphic variant argument *) +let f7_1 (x : t_bits64) = `A x;; +[%%expect{| +Line 1, characters 29-30: +1 | let f7_1 (x : t_bits64) = `A x;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_2 (x : 'a t_bits64_id) = `A x;; +[%%expect{| +Line 1, characters 35-36: +1 | let f7_2 (x : 'a t_bits64_id) = `A x;; + ^ +Error: This expression has type 'a t_bits64_id = ('a : bits64) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits64_id is bits64 + because of the definition of t_bits64_id at line 2, characters 0-35. + But the layout of 'a t_bits64_id must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_3 (x : int64#) = `A x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f7_3 (x : int64#) = `A x;; + ^ +Error: This expression has type int64# but an expression was expected of type + ('a : value_or_null) + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type f7_4 = [ `A of t_bits64 ];; +[%%expect{| +Line 1, characters 20-28: +1 | type f7_4 = [ `A of t_bits64 ];; + ^^^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type ('a : bits64) f7_5 = [ `A of 'a ];; +[%%expect{| +Line 1, characters 34-36: +1 | type ('a : bits64) f7_5 = [ `A of 'a ];; + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : bits64) + The layout of 'a is bits64 + because of the annotation on 'a in the declaration of the type f7_5. + But the layout of 'a must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +(************************************************************) +(* Test 8: Normal polymorphic functions don't work on them. *) + +let make_t_bits64 () : t_bits64 = assert false +let make_t_bits64_id () : 'a t_bits64_id = assert false +let make_int64u () : int64# = assert false + +let id_value x = x;; +[%%expect{| +val make_t_bits64 : unit -> t_bits64 = +val make_t_bits64_id : ('a : bits64). unit -> 'a t_bits64_id = +val make_int64u : unit -> int64# = +val id_value : ('a : value_or_null). 'a -> 'a = +|}];; + +let x8_1 = id_value (make_t_bits64 ());; +[%%expect{| +Line 1, characters 20-38: +1 | let x8_1 = id_value (make_t_bits64 ());; + ^^^^^^^^^^^^^^^^^^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value_or_null) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_2 = id_value (make_t_bits64_id ());; +[%%expect{| +Line 1, characters 20-41: +1 | let x8_2 = id_value (make_t_bits64_id ());; + ^^^^^^^^^^^^^^^^^^^^^ +Error: This expression has type 'a t_bits64_id = ('a : bits64) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_bits64_id is bits64 + because of the definition of make_t_bits64_id at line 2, characters 21-55. + But the layout of 'a t_bits64_id must overlap with value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_3 = id_value (make_int64u ());; +[%%expect{| +Line 1, characters 20-36: +1 | let x8_3 = id_value (make_int64u ());; + ^^^^^^^^^^^^^^^^ +Error: This expression has type int64# but an expression was expected of type + ('a : value_or_null) + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +(*************************************) +(* Test 9: But bits64 functions do. *) + +let twice f (x : 'a t_bits64_id) = f (f x) + +let f9_1 () = twice f1_1 (make_t_bits64 ()) +let f9_2 () = twice f1_2 (make_t_bits64_id ()) +let f9_3 () = twice f1_3 (make_int64u ());; +[%%expect{| +val twice : + ('a : bits64). + ('a t_bits64_id -> 'a t_bits64_id) -> 'a t_bits64_id -> 'a t_bits64_id = + +val f9_1 : unit -> t_bits64 t_bits64_id = +val f9_2 : ('a : bits64). unit -> 'a t_bits64_id = +val f9_3 : unit -> int64# t_bits64_id = +|}];; + +(**************************************************) +(* Test 10: Invalid uses of bits64 and externals *) + +(* Valid uses of bits64 in externals are tested elsewhere - this is just a test + for uses the typechecker should reject. In particular + - if using a non-value layout in an external, you must supply separate + bytecode and native code implementations, + - [@unboxed] is allowed on unboxed types but has no effect. Same is not + true for [@untagged]. +*) + +external f10_1 : int -> bool -> int64# = "foo";; +[%%expect{| +Line 1, characters 0-46: +1 | external f10_1 : int -> bool -> int64# = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_2 : t_bits64 -> int = "foo";; +[%%expect{| +Line 1, characters 0-40: +1 | external f10_2 : t_bits64 -> int = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_6 : (int64#[@unboxed]) -> bool -> string = "foo" "bar";; +[%%expect{| +external f10_6 : int64# -> bool -> string = "foo" "bar" +|}];; + +external f10_7 : string -> (int64#[@unboxed]) = "foo" "bar";; +[%%expect{| +external f10_7 : string -> int64# = "foo" "bar" +|}];; + +external f10_8 : int64 -> int64# = "foo" "bar" [@@unboxed];; +[%%expect{| +external f10_8 : (int64 [@unboxed]) -> int64# = "foo" "bar" +|}];; + +external f10_9 : (int64#[@untagged]) -> bool -> string = "foo" "bar";; +[%%expect{| +Line 1, characters 18-24: +1 | external f10_9 : (int64#[@untagged]) -> bool -> string = "foo" "bar";; + ^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +external f10_10 : string -> (int64#[@untagged]) = "foo" "bar";; +[%%expect{| +Line 1, characters 29-35: +1 | external f10_10 : string -> (int64#[@untagged]) = "foo" "bar";; + ^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +(*************************************************) +(* Test 11: bits64 banned in extensible variants *) + +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + +type t11_1 = .. + +type t11_1 += A of t_bits64;; +[%%expect{| +type t11_1 = .. +Line 3, characters 14-27: +3 | type t11_1 += A of t_bits64;; + ^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type t11_1 += B of int64#;; +[%%expect{| +Line 1, characters 14-25: +1 | type t11_1 += B of int64#;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type ('a : bits64) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : bits64) t11_2 = .. +type 'a t11_2 += A of int +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +(* not allowed: value in flat suffix *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] + +(***************************************) +(* Test 12: bits64 in objects/classes *) + +(* First, disallowed uses: in object types, class parameters, etc. *) +type t12_1 = < x : t_bits64 >;; +[%%expect{| +Line 1, characters 15-27: +1 | type t12_1 = < x : t_bits64 >;; + ^^^^^^^^^^^^ +Error: Object field types must have layout value. + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of an object field. +|}];; + +type ('a : bits64) t12_2 = < x : 'a >;; +[%%expect{| +Line 1, characters 33-35: +1 | type ('a : bits64) t12_2 = < x : 'a >;; + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : bits64) + The layout of 'a is bits64 + because of the annotation on 'a in the declaration of the type t12_2. + But the layout of 'a must overlap with value + because it's the type of an object field. +|}] + +class c12_3 = object method x : t_bits64 = assert false end;; +[%%expect{| +Line 1, characters 21-55: +1 | class c12_3 = object method x : t_bits64 = assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The method x has type t_bits64 but is expected to have type + ('a : value) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of an object field. +|}];; + +class ['a] c12_4 = object + method x : 'a t_bits64_id -> 'a t_bits64_id = assert false +end;; +[%%expect{| +Line 2, characters 13-15: +2 | method x : 'a t_bits64_id -> 'a t_bits64_id = assert false + ^^ +Error: This type ('a : bits64) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with bits64 + because of the definition of t_bits64_id at line 2, characters 0-35. +|}];; + +class c12_5 = object val x : t_bits64 = assert false end;; +[%%expect{| +Line 1, characters 25-26: +1 | class c12_5 = object val x : t_bits64 = assert false end;; + ^ +Error: Variables bound in a class must have layout value. + The layout of x is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of x must be a sublayout of value + because it's the type of a class field. +|}];; + +class type c12_6 = object method x : int64# end;; +[%%expect{| +Line 1, characters 26-43: +1 | class type c12_6 = object method x : int64# end;; + ^^^^^^^^^^^^^^^^^ +Error: The method x has type int64# but is expected to have type ('a : value) + The layout of int64# is bits64 + because it is the primitive bits64 type int64#. + But the layout of int64# must be a sublayout of value + because it's the type of an object field. +|}];; + +class type c12_7 = object val x : int64# end +[%%expect{| +Line 1, characters 26-40: +1 | class type c12_7 = object val x : int64# end + ^^^^^^^^^^^^^^ +Error: Variables bound in a class must have layout value. + The layout of x is bits64 + because it is the primitive bits64 type int64#. + But the layout of x must be a sublayout of value + because it's the type of an instance variable. +|}];; + +class type ['a] c12_8 = object + val x : 'a t_bits64_id -> 'a t_bits64_id +end +[%%expect{| +Line 2, characters 10-12: +2 | val x : 'a t_bits64_id -> 'a t_bits64_id + ^^ +Error: This type ('a : bits64) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with bits64 + because of the definition of t_bits64_id at line 2, characters 0-35. +|}];; + +(* Second, allowed uses: as method parameters / returns *) +type t12_8 = < f : t_bits64 -> t_bits64 > +let f12_9 (o : t12_8) x = o#f x +let f12_10 o (y : t_bits64) : t_bits64 = o#baz y y y;; +class ['a] c12_11 = object + method x : t_bits64 -> 'a = assert false +end;; +class ['a] c12_12 = object + method x : 'a -> t_bits64 = assert false +end;; +[%%expect{| +type t12_8 = < f : t_bits64 -> t_bits64 > +val f12_9 : t12_8 -> t_bits64 -> t_bits64 = +val f12_10 : + < baz : t_bits64 -> t_bits64 -> t_bits64 -> t_bits64; .. > -> + t_bits64 -> t_bits64 = +class ['a] c12_11 : object method x : t_bits64 -> 'a end +class ['a] c12_12 : object method x : 'a -> t_bits64 end +|}];; + +(* Third, another disallowed use: capture in an object. *) +let f12_13 m1 m2 = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: This expression has type ('a : value) + but an expression was expected of type t_bits64 + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +let f12_14 (m1 : t_bits64) (m2 : t_bits64) = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: m1 must have a type of layout value because it is captured by an object. + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +(*********************************************************************) +(* Test 13: Ad-hoc polymorphic operations don't work on bits64 yet. *) + +(* CR layouts v5: Remember to handle the case of calling these on structures + containing other layouts. *) + +let f13_1 (x : t_bits64) = x = x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f13_1 (x : t_bits64) = x = x;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_2 (x : t_bits64) = compare x x;; +[%%expect{| +Line 1, characters 35-36: +1 | let f13_2 (x : t_bits64) = compare x x;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_3 (x : t_bits64) = Marshal.to_bytes x;; +[%%expect{| +Line 1, characters 44-45: +1 | let f13_3 (x : t_bits64) = Marshal.to_bytes x;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_4 (x : t_bits64) = Hashtbl.hash x;; +[%%expect{| +Line 1, characters 40-41: +1 | let f13_4 (x : t_bits64) = Hashtbl.hash x;; + ^ +Error: This expression has type t_bits64 + but an expression was expected of type ('a : value) + The layout of t_bits64 is bits64 + because of the definition of t_bits64 at line 1, characters 0-22. + But the layout of t_bits64 must be a sublayout of value + because of layout requirements from an imported definition. +|}];; diff --git a/ocaml/testsuite/tests/typing-layouts-err-msg/debug_printer.compilers.reference b/ocaml/testsuite/tests/typing-layouts-err-msg/debug_printer.compilers.reference index b3e962de98c..9d4065f8049 100644 --- a/ocaml/testsuite/tests/typing-layouts-err-msg/debug_printer.compilers.reference +++ b/ocaml/testsuite/tests/typing-layouts-err-msg/debug_printer.compilers.reference @@ -1,4 +1,4 @@ type ('a : float64) t = 'a -val f : 'b ('a : float64). 'b -> 'a t -> unit = +val f : ('b : value_or_null) ('a : float64). 'b -> 'a t -> unit = f has the wrong type for a printing function. diff --git a/ocaml/testsuite/tests/typing-layouts-err-msg/test.ml b/ocaml/testsuite/tests/typing-layouts-err-msg/test.ml index 8f9ebce88cf..4f775aaa982 100644 --- a/ocaml/testsuite/tests/typing-layouts-err-msg/test.ml +++ b/ocaml/testsuite/tests/typing-layouts-err-msg/test.ml @@ -171,7 +171,7 @@ Line 1, characters 26-27: 1 | let f2 (x: t_void) = A.f2 x ^ Error: This expression has type t_void but an expression was expected of type - ('a : value) + ('a : value_or_null) The layout of t_void is void because of the definition of t_void at line 2, characters 0-18. But the layout of t_void must be a sublayout of value diff --git a/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml b/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml index 1ab59f6fb13..6356ffa81e8 100644 --- a/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml +++ b/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml @@ -278,7 +278,7 @@ Line 1, characters 27-28: 1 | let f (x : t_float64) = `A x;; ^ Error: This expression has type t_float64 - but an expression was expected of type ('a : value) + but an expression was expected of type ('a : value_or_null) The layout of t_float64 is float64 because of the definition of t_float64 at line 5, characters 0-24. But the layout of t_float64 must be a sublayout of value diff --git a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml index 2d2166efda8..39db3f54429 100644 --- a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml @@ -191,7 +191,8 @@ Error: This type ('b : value) should be an instance of type ('a : float32) The layout of 'a is float32 because of the annotation on 'a in the declaration of the type t4_7. But the layout of 'a must overlap with value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. |}] (*****************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml index 2a40a25ba61..d6a72051d6b 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml @@ -191,7 +191,8 @@ Error: This type ('b : value) should be an instance of type ('a : float64) The layout of 'a is float64 because of the annotation on 'a in the declaration of the type t4_7. But the layout of 'a must overlap with value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. |}] (*****************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-or-null/array.ml b/ocaml/testsuite/tests/typing-layouts-or-null/array.ml index c0df804bde8..633241afaae 100644 --- a/ocaml/testsuite/tests/typing-layouts-or-null/array.ml +++ b/ocaml/testsuite/tests/typing-layouts-or-null/array.ml @@ -3,7 +3,7 @@ expect; *) -(* CR layouts v3.0: array type arguments should be [any_non_null]: *) +(* Array type arguments are [any_non_null]: *) type t_any : any @@ -11,7 +11,14 @@ type should_fail = t_any array [%%expect{| type t_any : any -type should_fail = t_any array +Line 3, characters 19-24: +3 | type should_fail = t_any array + ^^^^^ +Error: This type t_any should be an instance of type ('a : any_non_null) + The kind of t_any is any + because of the definition of t_any at line 1, characters 0-16. + But the kind of t_any must be a subkind of any_non_null + because it's the type argument to the array type. |}] type t_value_or_null : value_or_null @@ -20,5 +27,13 @@ type should_fail = t_value_or_null array [%%expect{| type t_value_or_null : value_or_null -type should_fail = t_value_or_null array +Line 3, characters 19-34: +3 | type should_fail = t_value_or_null array + ^^^^^^^^^^^^^^^ +Error: This type t_value_or_null should be an instance of type + ('a : any_non_null) + The kind of t_value_or_null is value_or_null + because of the definition of t_value_or_null at line 1, characters 0-36. + But the kind of t_value_or_null must be a subkind of any_non_null + because it's the type argument to the array type. |}] diff --git a/ocaml/testsuite/tests/typing-layouts-or-null/basics.ml b/ocaml/testsuite/tests/typing-layouts-or-null/basics.ml index d2183225bd3..0a4f403dde4 100644 --- a/ocaml/testsuite/tests/typing-layouts-or-null/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-or-null/basics.ml @@ -86,35 +86,18 @@ Error: This expression has type t_any_non_null because we must know concretely how to return a function result. |}] -(* CR layouts v3.0: [value_or_null] should be representable *) +(* [value_or_null] is representable *) let f (x : t_value_or_null) = x [%%expect{| -Line 1, characters 6-27: -1 | let f (x : t_value_or_null) = x - ^^^^^^^^^^^^^^^^^^^^^ -Error: This pattern matches values of type t_value_or_null - but a pattern was expected which matches values of type ('a : value) - The kind of t_value_or_null is value_or_null - because of the definition of t_value_or_null at line 3, characters 0-36. - But the kind of t_value_or_null must be a subkind of value - because we must know concretely how to pass a function argument, - defaulted to kind value. +val f : t_value_or_null -> t_value_or_null = |}] type t = { x : t_value_or_null } [%%expect {| -Line 1, characters 11-30: -1 | type t = { x : t_value_or_null } - ^^^^^^^^^^^^^^^^^^^ -Error: Record element types must have a representable layout. - The kind of t_value_or_null is value_or_null - because of the definition of t_value_or_null at line 3, characters 0-36. - But the kind of t_value_or_null must be a subkind of value - because it is the type of record field x, - defaulted to kind value. +type t = { x : t_value_or_null; } |}] module type S1 = sig @@ -122,14 +105,7 @@ module type S1 = sig end [%%expect {| -Line 2, characters 10-25: -2 | val x : t_value_or_null - ^^^^^^^^^^^^^^^ -Error: This type signature for x is not a value type. - The kind of type t_value_or_null is value_or_null - because of the definition of t_value_or_null at line 3, characters 0-36. - But the kind of type t_value_or_null must be a subkind of value - because it's the type of something stored in a module structure. +module type S1 = sig val x : t_value_or_null end |}] module type S2 = sig @@ -145,16 +121,7 @@ module M2 (X : S2) = struct end [%%expect{| -Line 2, characters 13-19: -2 | let f () = X.f () - ^^^^^^ -Error: This expression has type t_value_or_null - but an expression was expected of type ('a : value) - The kind of t_value_or_null is value_or_null - because of the definition of t_value_or_null at line 3, characters 0-36. - But the kind of t_value_or_null must be a subkind of value - because we must know concretely how to return a function result, - defaulted to kind value. +module M2 : functor (X : S2) -> sig val f : unit -> t_value_or_null end |}] type ('a : any) id_any = 'a diff --git a/ocaml/testsuite/tests/typing-layouts-or-null/variables.ml b/ocaml/testsuite/tests/typing-layouts-or-null/variables.ml index 1631a7dddac..60dd2fb8e96 100644 --- a/ocaml/testsuite/tests/typing-layouts-or-null/variables.ml +++ b/ocaml/testsuite/tests/typing-layouts-or-null/variables.ml @@ -16,6 +16,7 @@ type ('a : value_or_null) id_value_or_null = 'a type 'a should_not_accept_or_null = 'a id_value_or_null +type should_not_work = t_value_or_null should_not_accept_or_null type should_not_work = t_value_or_null should_not_accept_or_null [%%expect{| @@ -30,22 +31,12 @@ Error: This type t_value_or_null should be an instance of type ('a : value) because of the definition of should_not_accept_or_null at line 1, characters 0-55. |}] -(* CR layouts v3.0: [value_or_null] types should be accepted for - function arguments and results. *) +(* [value_or_null] is accepted for function arguments and results. *) let should_work (x : t_value_or_null) = x [%%expect{| -Line 1, characters 16-37: -1 | let should_work (x : t_value_or_null) = x - ^^^^^^^^^^^^^^^^^^^^^ -Error: This pattern matches values of type t_value_or_null - but a pattern was expected which matches values of type ('a : value) - The kind of t_value_or_null is value_or_null - because of the definition of t_value_or_null at line 1, characters 0-36. - But the kind of t_value_or_null must be a subkind of value - because we must know concretely how to pass a function argument, - defaulted to kind value. +val should_work : t_value_or_null -> t_value_or_null = |}] (* Type variables in function definitions default to [value]. *) @@ -224,6 +215,34 @@ Error: Signature mismatch: |}] +module M : sig + val f : ('a : value_or_null) . 'a -> 'a +end = struct + let f : type a. a -> a = fun x -> x +end + +[%%expect{| +Lines 3-5, characters 6-3: +3 | ......struct +4 | let f : type a. a -> a = fun x -> x +5 | end +Error: Signature mismatch: + Modules do not match: + sig val f : 'a -> 'a end + is not included in + sig val f : ('a : value_or_null). 'a -> 'a end + Values do not match: + val f : 'a -> 'a + is not included in + val f : ('a : value_or_null). 'a -> 'a + The type 'a -> 'a is not compatible with the type 'b -> 'b + The kind of 'a is value_or_null + because of the definition of f at line 2, characters 2-41. + But the kind of 'a must be a subkind of value + because of the definition of f at line 4, characters 6-7. +|}] + + module M : sig val f : ('a : value_or_null) . 'a -> 'a end = struct @@ -254,15 +273,15 @@ Error: Signature mismatch: (* CR layouts v3.0: this should work. *) module M : sig - val f : ('a : value_or_null). 'a -> 'a + val f : ('a : value_or_null) . 'a -> 'a end = struct - let f x = x + let f : type a. a -> a = fun x -> x end [%%expect{| Lines 3-5, characters 6-3: 3 | ......struct -4 | let f x = x +4 | let f : type a. a -> a = fun x -> x 5 | end Error: Signature mismatch: Modules do not match: @@ -275,9 +294,9 @@ Error: Signature mismatch: val f : ('a : value_or_null). 'a -> 'a The type 'a -> 'a is not compatible with the type 'b -> 'b The kind of 'a is value_or_null - because of the definition of f at line 2, characters 2-40. + because of the definition of f at line 2, characters 2-41. But the kind of 'a must be a subkind of value - because of the definition of f at line 4, characters 8-13. + because of the definition of f at line 4, characters 6-7. |}] (* CR layouts v3.0: annotations on non-rigid type variables are upper bounds. diff --git a/ocaml/testsuite/tests/typing-layouts-word/basics.ml b/ocaml/testsuite/tests/typing-layouts-word/basics.ml index 15a91738727..cfc29c6f8b2 100644 --- a/ocaml/testsuite/tests/typing-layouts-word/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-word/basics.ml @@ -1,9 +1,6 @@ (* TEST { expect; - }{ - flags = "-extension layouts_alpha"; - expect; }{ flags = "-extension layouts_beta"; expect; @@ -196,7 +193,8 @@ Error: This type ('b : value) should be an instance of type ('a : word) The layout of 'a is word because of the annotation on 'a in the declaration of the type t4_7. But the layout of 'a must overlap with value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. |}] (****************************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-word/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts-word/basics_alpha.ml new file mode 100644 index 00000000000..fa0a4d77fa1 --- /dev/null +++ b/ocaml/testsuite/tests/typing-layouts-word/basics_alpha.ml @@ -0,0 +1,769 @@ +(* TEST + { + flags = "-extension layouts_alpha"; + expect; + } +*) + +(* This file contains typing tests for the layout [word]. + + Runtime tests for the type [nativeint#] can be found in the + [unboxed_nativeint], [alloc], and [test_nativeint_u] tests in this + directory. The type [nativeint#] here is used as a convenient example of a + concrete [word] type in some tests, but its behavior isn't the primary + purpose of this test. *) + +type t_word : word +type ('a : word) t_word_id = 'a + +(*********************************) +(* Test 1: The identity function *) + +let f1_1 (x : t_word) = x;; +let f1_2 (x : 'a t_word_id) = x;; +let f1_3 (x : nativeint#) = x;; +[%%expect{| +type t_word : word +type ('a : word) t_word_id = 'a +val f1_1 : t_word -> t_word = +val f1_2 : ('a : word). 'a t_word_id -> 'a t_word_id = +val f1_3 : nativeint# -> nativeint# = +|}];; + +(*****************************************) +(* Test 2: You can let-bind them locally *) +let f2_1 (x : t_word) = + let y = x in + y;; + +let f2_2 (x : 'a t_word_id) = + let y = x in + y;; + +let f2_3 (x : nativeint#) = + let y = x in + y;; +[%%expect{| +val f2_1 : t_word -> t_word = +val f2_2 : ('a : word). 'a t_word_id -> 'a t_word_id = +val f2_3 : nativeint# -> nativeint# = +|}];; + +(*****************************************) +(* Test 3: No module-level bindings yet. *) + +let x3_1 : t_word = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_1 : t_word = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_1 has layout word. +|}];; + +let x3_2 : 'a t_word_id = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_2 : 'a t_word_id = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_2 has layout word. +|}];; + +let x3_3 : nativeint# = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_3 : nativeint# = assert false;; + ^^^^ +Error: Types of top-level module bindings must have layout value, but + the type of x3_3 has layout word. +|}];; + +module M3_4 = struct + let x : t_word = assert false +end +[%%expect{| +Line 2, characters 6-7: +2 | let x : t_word = assert false + ^ +Error: Types of top-level module bindings must have layout value, but + the type of x has layout word. +|}];; + +module M3_5 = struct + let f (x : nativeint#) = x + + let y = f (assert false) +end +[%%expect{| +Line 4, characters 6-7: +4 | let y = f (assert false) + ^ +Error: Types of top-level module bindings must have layout value, but + the type of y has layout word. +|}];; + +(*************************************) +(* Test 4: No putting them in tuples *) + +let f4_1 (x : t_word) = x, false;; +[%%expect{| +Line 1, characters 24-25: +1 | let f4_1 (x : t_word) = x, false;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value_or_null) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of a tuple element. +|}];; + +let f4_2 (x : 'a t_word_id) = x, false;; +[%%expect{| +Line 1, characters 30-31: +1 | let f4_2 (x : 'a t_word_id) = x, false;; + ^ +Error: This expression has type 'a t_word_id = ('a : word) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_word_id is word + because of the definition of t_word_id at line 2, characters 0-31. + But the layout of 'a t_word_id must overlap with value + because it's the type of a tuple element. +|}];; + +let f4_3 (x : nativeint#) = x, false;; +[%%expect{| +Line 1, characters 28-29: +1 | let f4_3 (x : nativeint#) = x, false;; + ^ +Error: This expression has type nativeint# + but an expression was expected of type ('a : value_or_null) + The layout of nativeint# is word + because it is the primitive word type nativeint#. + But the layout of nativeint# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_4 = t_word * string;; +[%%expect{| +Line 1, characters 12-18: +1 | type t4_4 = t_word * string;; + ^^^^^^ +Error: Tuple element types must have layout value. + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type t4_5 = int * nativeint#;; +[%%expect{| +Line 1, characters 18-28: +1 | type t4_5 = int * nativeint#;; + ^^^^^^^^^^ +Error: Tuple element types must have layout value. + The layout of nativeint# is word + because it is the primitive word type nativeint#. + But the layout of nativeint# must be a sublayout of value + because it's the type of a tuple element. +|}];; + +type ('a : word) t4_6 = 'a * 'a +[%%expect{| +Line 1, characters 24-26: +1 | type ('a : word) t4_6 = 'a * 'a + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : word) + The layout of 'a is word + because of the annotation on 'a in the declaration of the type t4_6. + But the layout of 'a must overlap with value + because it's the type of a tuple element. +|}];; + +(* check for layout propagation *) +type ('a : word, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; +[%%expect{| +Line 1, characters 29-31: +1 | type ('a : word, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; + ^^ +Error: This type ('b : value) should be an instance of type ('a : word) + The layout of 'a is word + because of the annotation on 'a in the declaration of the type t4_7. + But the layout of 'a must overlap with value + because it instantiates an unannotated type parameter of t4_7, + defaulted to layout value. +|}] + +(****************************************************) +(* Test 5: Allowed in some structures in typedecls. *) + +type t5_1 = { x : t_word };; +[%%expect{| +type t5_1 = { x : t_word; } +|}];; + +type t5_2 = { y : int; x : t_word };; +[%%expect{| +type t5_2 = { y : int; x : t_word; } +|}];; + +type t5_2' = { y : string; x : t_word };; +[%%expect{| +type t5_2' = { y : string; x : t_word; } +|}];; + +(* CR layouts 2.5: allow this *) +type t5_3 = { x : t_word } [@@unboxed];; +[%%expect{| +Line 1, characters 14-24: +1 | type t5_3 = { x : t_word } [@@unboxed];; + ^^^^^^^^^^ +Error: Type t_word has layout word. + Unboxed records may not yet contain types of this layout. +|}];; + +type t5_4 = A of t_word;; +[%%expect{| +type t5_4 = A of t_word +|}];; + +type t5_5 = A of int * t_word;; +[%%expect{| +type t5_5 = A of int * t_word +|}];; + +type ('a : word) t5_7 = A of int +type ('a : word) t5_8 = A of 'a;; +[%%expect{| +type ('a : word) t5_7 = A of int +type ('a : word) t5_8 = A of 'a +|}] + +(* not allowed: value in flat suffix *) +type 'a t_disallowed = A of t_word * 'a + +[%%expect{| +Line 1, characters 23-39: +1 | type 'a t_disallowed = A of t_word * 'a + ^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, + t_word, but found boxed argument, 'a. +|}] + +type t5_6 = A of t_word [@@unboxed];; +[%%expect{| +Line 1, characters 12-23: +1 | type t5_6 = A of t_word [@@unboxed];; + ^^^^^^^^^^^ +Error: Type t_word has layout word. + Unboxed variants may not yet contain types of this layout. +|}];; + +(****************************************************) +(* Test 6: Can't be put at top level of signatures. *) +module type S6_1 = sig val x : t_word end + +let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; +[%%expect{| +Line 1, characters 31-37: +1 | module type S6_1 = sig val x : t_word end + ^^^^^^ +Error: This type signature for x is not a value type. + The layout of type t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of type t_word must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_2 = sig val x : 'a t_word_id end +[%%expect{| +Line 1, characters 31-43: +1 | module type S6_2 = sig val x : 'a t_word_id end + ^^^^^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type 'a t_word_id is word + because of the definition of t_word_id at line 2, characters 0-31. + But the layout of type 'a t_word_id must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + +module type S6_3 = sig val x : nativeint# end +[%%expect{| +Line 1, characters 31-41: +1 | module type S6_3 = sig val x : nativeint# end + ^^^^^^^^^^ +Error: This type signature for x is not a value type. + The layout of type nativeint# is word + because it is the primitive word type nativeint#. + But the layout of type nativeint# must be a sublayout of value + because it's the type of something stored in a module structure. +|}];; + + +(*********************************************************) +(* Test 7: Can't be used as polymorphic variant argument *) +let f7_1 (x : t_word) = `A x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f7_1 (x : t_word) = `A x;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value_or_null) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_2 (x : 'a t_word_id) = `A x;; +[%%expect{| +Line 1, characters 33-34: +1 | let f7_2 (x : 'a t_word_id) = `A x;; + ^ +Error: This expression has type 'a t_word_id = ('a : word) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_word_id is word + because of the definition of t_word_id at line 2, characters 0-31. + But the layout of 'a t_word_id must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +let f7_3 (x : nativeint#) = `A x;; +[%%expect{| +Line 1, characters 31-32: +1 | let f7_3 (x : nativeint#) = `A x;; + ^ +Error: This expression has type nativeint# + but an expression was expected of type ('a : value_or_null) + The layout of nativeint# is word + because it is the primitive word type nativeint#. + But the layout of nativeint# must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type f7_4 = [ `A of t_word ];; +[%%expect{| +Line 1, characters 20-26: +1 | type f7_4 = [ `A of t_word ];; + ^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of the field of a polymorphic variant. +|}];; + +type ('a : word) f7_5 = [ `A of 'a ];; +[%%expect{| +Line 1, characters 32-34: +1 | type ('a : word) f7_5 = [ `A of 'a ];; + ^^ +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : word) + The layout of 'a is word + because of the annotation on 'a in the declaration of the type f7_5. + But the layout of 'a must overlap with value + because it's the type of the field of a polymorphic variant. +|}];; + +(************************************************************) +(* Test 8: Normal polymorphic functions don't work on them. *) + +let make_t_word () : t_word = assert false +let make_t_word_id () : 'a t_word_id = assert false +let make_nativeintu () : nativeint# = assert false + +let id_value x = x;; +[%%expect{| +val make_t_word : unit -> t_word = +val make_t_word_id : ('a : word). unit -> 'a t_word_id = +val make_nativeintu : unit -> nativeint# = +val id_value : ('a : value_or_null). 'a -> 'a = +|}];; + +let x8_1 = id_value (make_t_word ());; +[%%expect{| +Line 1, characters 20-36: +1 | let x8_1 = id_value (make_t_word ());; + ^^^^^^^^^^^^^^^^ +Error: This expression has type t_word but an expression was expected of type + ('a : value_or_null) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_2 = id_value (make_t_word_id ());; +[%%expect{| +Line 1, characters 20-39: +1 | let x8_2 = id_value (make_t_word_id ());; + ^^^^^^^^^^^^^^^^^^^ +Error: This expression has type 'a t_word_id = ('a : word) + but an expression was expected of type ('b : value_or_null) + The layout of 'a t_word_id is word + because of the definition of make_t_word_id at line 2, characters 19-51. + But the layout of 'a t_word_id must overlap with value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +let x8_3 = id_value (make_nativeintu ());; +[%%expect{| +Line 1, characters 20-40: +1 | let x8_3 = id_value (make_nativeintu ());; + ^^^^^^^^^^^^^^^^^^^^ +Error: This expression has type nativeint# + but an expression was expected of type ('a : value_or_null) + The layout of nativeint# is word + because it is the primitive word type nativeint#. + But the layout of nativeint# must be a sublayout of value + because of the definition of id_value at line 5, characters 13-18. +|}];; + +(*************************************) +(* Test 9: But word functions do. *) + +let twice f (x : 'a t_word_id) = f (f x) + +let f9_1 () = twice f1_1 (make_t_word ()) +let f9_2 () = twice f1_2 (make_t_word_id ()) +let f9_3 () = twice f1_3 (make_nativeintu ());; +[%%expect{| +val twice : + ('a : word). ('a t_word_id -> 'a t_word_id) -> 'a t_word_id -> 'a t_word_id = + +val f9_1 : unit -> t_word t_word_id = +val f9_2 : ('a : word). unit -> 'a t_word_id = +val f9_3 : unit -> nativeint# t_word_id = +|}];; + +(**************************************************) +(* Test 10: Invalid uses of word and externals *) + +(* Valid uses of word in externals are tested elsewhere - this is just a test + for uses the typechecker should reject. In particular + - if using a non-value layout in an external, you must supply separate + bytecode and native code implementations, + - [@unboxed] is allowed on unboxed types but has no effect. Same is not + true for [@untagged]. +*) + +external f10_1 : int -> bool -> nativeint# = "foo";; +[%%expect{| +Line 1, characters 0-50: +1 | external f10_1 : int -> bool -> nativeint# = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_2 : t_word -> int = "foo";; +[%%expect{| +Line 1, characters 0-38: +1 | external f10_2 : t_word -> int = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_6 : (nativeint#[@unboxed]) -> bool -> string = "foo" "bar";; +[%%expect{| +external f10_6 : nativeint# -> bool -> string = "foo" "bar" +|}];; + +external f10_7 : string -> (nativeint#[@unboxed]) = "foo" "bar";; +[%%expect{| +external f10_7 : string -> nativeint# = "foo" "bar" +|}];; + +external f10_8 : nativeint -> nativeint# = "foo" "bar" [@@unboxed];; +[%%expect{| +external f10_8 : (nativeint [@unboxed]) -> nativeint# = "foo" "bar" +|}];; + +external f10_9 : (nativeint#[@untagged]) -> bool -> string = "foo" "bar";; +[%%expect{| +Line 1, characters 18-28: +1 | external f10_9 : (nativeint#[@untagged]) -> bool -> string = "foo" "bar";; + ^^^^^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +external f10_10 : string -> (nativeint#[@untagged]) = "foo" "bar";; +[%%expect{| +Line 1, characters 29-39: +1 | external f10_10 : string -> (nativeint#[@untagged]) = "foo" "bar";; + ^^^^^^^^^^ +Error: Don't know how to untag this type. Only int can be untagged. +|}];; + +(***********************************************) +(* Test 11: word banned in extensible variants *) + +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + +type t11_1 = .. + +type t11_1 += A of t_word;; +[%%expect{| +type t11_1 = .. +Line 3, characters 14-25: +3 | type t11_1 += A of t_word;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type t11_1 += B of nativeint#;; +[%%expect{| +Line 1, characters 14-29: +1 | type t11_1 += B of nativeint#;; + ^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +type ('a : word) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : word) t11_2 = .. +type 'a t11_2 += A of int +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. +|}] + +(* not allowed: value in flat suffix *) +type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + +[%%expect{| +Line 1, characters 17-40: +1 | type 'a t11_2 += C : 'a * 'b -> 'a t11_2 + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Expected all flat constructor arguments after non-value argument, 'a, + but found boxed argument, 'b. +|}] + +(***************************************) +(* Test 12: word in objects/classes *) + +(* First, disallowed uses: in object types, class parameters, etc. *) +type t12_1 = < x : t_word >;; +[%%expect{| +Line 1, characters 15-25: +1 | type t12_1 = < x : t_word >;; + ^^^^^^^^^^ +Error: Object field types must have layout value. + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of an object field. +|}];; + +type ('a : word) t12_2 = < x : 'a >;; +[%%expect{| +Line 1, characters 31-33: +1 | type ('a : word) t12_2 = < x : 'a >;; + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : word) + The layout of 'a is word + because of the annotation on 'a in the declaration of the type t12_2. + But the layout of 'a must overlap with value + because it's the type of an object field. +|}] + +class c12_3 = object method x : t_word = assert false end;; +[%%expect{| +Line 1, characters 21-53: +1 | class c12_3 = object method x : t_word = assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The method x has type t_word but is expected to have type ('a : value) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of an object field. +|}];; + +class ['a] c12_4 = object + method x : 'a t_word_id -> 'a t_word_id = assert false +end;; +[%%expect{| +Line 2, characters 13-15: +2 | method x : 'a t_word_id -> 'a t_word_id = assert false + ^^ +Error: This type ('a : word) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with word + because of the definition of t_word_id at line 2, characters 0-31. +|}];; + +class c12_5 = object val x : t_word = assert false end;; +[%%expect{| +Line 1, characters 25-26: +1 | class c12_5 = object val x : t_word = assert false end;; + ^ +Error: Variables bound in a class must have layout value. + The layout of x is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of x must be a sublayout of value + because it's the type of a class field. +|}];; + +class type c12_6 = object method x : nativeint# end;; +[%%expect{| +Line 1, characters 26-47: +1 | class type c12_6 = object method x : nativeint# end;; + ^^^^^^^^^^^^^^^^^^^^^ +Error: The method x has type nativeint# but is expected to have type + ('a : value) + The layout of nativeint# is word + because it is the primitive word type nativeint#. + But the layout of nativeint# must be a sublayout of value + because it's the type of an object field. +|}];; + +class type c12_7 = object val x : nativeint# end +[%%expect{| +Line 1, characters 26-44: +1 | class type c12_7 = object val x : nativeint# end + ^^^^^^^^^^^^^^^^^^ +Error: Variables bound in a class must have layout value. + The layout of x is word + because it is the primitive word type nativeint#. + But the layout of x must be a sublayout of value + because it's the type of an instance variable. +|}];; + +class type ['a] c12_8 = object + val x : 'a t_word_id -> 'a t_word_id +end +[%%expect{| +Line 2, characters 10-12: +2 | val x : 'a t_word_id -> 'a t_word_id + ^^ +Error: This type ('a : word) should be an instance of type ('a0 : value) + The layout of 'a is value + because it's a type argument to a class constructor. + But the layout of 'a must overlap with word + because of the definition of t_word_id at line 2, characters 0-31. +|}];; + +(* Second, allowed uses: as method parameters / returns *) +type t12_8 = < f : t_word -> t_word > +let f12_9 (o : t12_8) x = o#f x +let f12_10 o (y : t_word) : t_word = o#baz y y y;; +class ['a] c12_11 = object + method x : t_word -> 'a = assert false +end;; +class ['a] c12_12 = object + method x : 'a -> t_word = assert false +end;; +[%%expect{| +type t12_8 = < f : t_word -> t_word > +val f12_9 : t12_8 -> t_word -> t_word = +val f12_10 : + < baz : t_word -> t_word -> t_word -> t_word; .. > -> t_word -> t_word = + +class ['a] c12_11 : object method x : t_word -> 'a end +class ['a] c12_12 : object method x : 'a -> t_word end +|}];; + +(* Third, another disallowed use: capture in an object. *) +let f12_13 m1 m2 = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: This expression has type ('a : value) + but an expression was expected of type t_word + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +let f12_14 (m1 : t_word) (m2 : t_word) = object + val f = fun () -> + let _ = f1_1 m1 in + let _ = f1_1 m2 in + () +end;; +[%%expect{| +Line 3, characters 17-19: +3 | let _ = f1_1 m1 in + ^^ +Error: m1 must have a type of layout value because it is captured by an object. + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because it's the type of a variable captured in an object. +|}];; + +(*********************************************************************) +(* Test 13: Ad-hoc polymorphic operations don't work on word yet. *) + +(* CR layouts v5: Remember to handle the case of calling these on structures + containing other layouts. *) + +let f13_1 (x : t_word) = x = x;; +[%%expect{| +Line 1, characters 25-26: +1 | let f13_1 (x : t_word) = x = x;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_2 (x : t_word) = compare x x;; +[%%expect{| +Line 1, characters 33-34: +1 | let f13_2 (x : t_word) = compare x x;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_3 (x : t_word) = Marshal.to_bytes x;; +[%%expect{| +Line 1, characters 42-43: +1 | let f13_3 (x : t_word) = Marshal.to_bytes x;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because of layout requirements from an imported definition. +|}];; + +let f13_4 (x : t_word) = Hashtbl.hash x;; +[%%expect{| +Line 1, characters 38-39: +1 | let f13_4 (x : t_word) = Hashtbl.hash x;; + ^ +Error: This expression has type t_word but an expression was expected of type + ('a : value) + The layout of t_word is word + because of the definition of t_word at line 1, characters 0-18. + But the layout of t_word must be a sublayout of value + because of layout requirements from an imported definition. +|}];; diff --git a/ocaml/testsuite/tests/typing-layouts/annots.ml b/ocaml/testsuite/tests/typing-layouts/annots.ml index eec5531fb7a..4696c97cfd5 100644 --- a/ocaml/testsuite/tests/typing-layouts/annots.ml +++ b/ocaml/testsuite/tests/typing-layouts/annots.ml @@ -35,11 +35,7 @@ Error: Layout void is more experimental than allowed by the enabled layouts exte type t_any_non_null : any_non_null;; [%%expect{| -Line 1, characters 22-34: -1 | type t_any_non_null : any_non_null;; - ^^^^^^^^^^^^ -Error: Layout any_non_null is more experimental than allowed by the enabled layouts extension. - You must enable -extension layouts_alpha to use this feature. +type t_any_non_null : any_non_null |}] type t_value_or_null : value_or_null;; diff --git a/ocaml/testsuite/tests/typing-layouts/basics.ml b/ocaml/testsuite/tests/typing-layouts/basics.ml index 8c9f22de443..1794469a199 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics.ml @@ -34,11 +34,7 @@ Error: Layout void is more experimental than allowed by the enabled layouts exte type t_any_non_null : any_non_null;; [%%expect{| -Line 1, characters 22-34: -1 | type t_any_non_null : any_non_null;; - ^^^^^^^^^^^^ -Error: Layout any_non_null is more experimental than allowed by the enabled layouts extension. - You must enable -extension layouts_alpha to use this feature. +type t_any_non_null : any_non_null |}] type t_value_or_null : value_or_null;; @@ -767,7 +763,8 @@ Error: The type constraints are not consistent. The layout of t_float64 is float64 because of the definition of t_float64 at line 4, characters 0-24. But the layout of t_float64 must be a sublayout of value - because it's the type of the field of a polymorphic variant. + because it instantiates an unannotated type parameter of t, + defaulted to layout value. |}];; module type S8_5f = sig @@ -863,7 +860,8 @@ Error: The type constraints are not consistent. The layout of t_float64 is float64 because of the definition of t_float64 at line 4, characters 0-24. But the layout of t_float64 must be a sublayout of value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t, + defaulted to layout value. |}];; module type S9_7f = sig diff --git a/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml index 5bec8f1dd90..d33ad163e5d 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml @@ -560,7 +560,8 @@ Error: The type constraints are not consistent. The layout of void_unboxed_record is void because of the definition of t_void at line 6, characters 0-19. But the layout of void_unboxed_record must be a sublayout of value - because it's the type of the field of a polymorphic variant. + because it instantiates an unannotated type parameter of t, + defaulted to layout value. |}];; module type S8_5 = sig @@ -622,7 +623,7 @@ Line 7, characters 13-14: 7 | | V t -> t, 27 ^ Error: This expression has type void_unboxed_record - but an expression was expected of type ('a : value) + but an expression was expected of type ('a : value_or_null) The layout of void_unboxed_record is void because of the definition of t_void at line 6, characters 0-19. But the layout of void_unboxed_record must be a sublayout of value @@ -674,7 +675,8 @@ Error: The type constraints are not consistent. The layout of void_unboxed_record is void because of the definition of t_void at line 6, characters 0-19. But the layout of void_unboxed_record must be a sublayout of value - because it's the type of a tuple element. + because it instantiates an unannotated type parameter of t, + defaulted to layout value. |}];; module type S9_7 = sig @@ -703,7 +705,7 @@ Line 5, characters 11-23: 5 | match 3, X.vr.vr_void with ^^^^^^^^^^^^ Error: This expression has type t_void but an expression was expected of type - ('a : value) + ('a : value_or_null) The layout of t_void is void because of the definition of t_void at line 6, characters 0-19. But the layout of t_void must be a sublayout of value @@ -1448,7 +1450,7 @@ let q () = () [%%expect{| -val ( let* ) : t_float64 -> 'a -> unit = +val ( let* ) : ('a : value_or_null). t_float64 -> 'a -> unit = val q : unit -> unit = |}] @@ -1474,7 +1476,8 @@ let q () = () [%%expect{| -val ( let* ) : 'a ('b : any). 'a -> (t_float64 -> 'b) -> unit = +val ( let* ) : + ('a : value_or_null) ('b : any). 'a -> (t_float64 -> 'b) -> unit = val q : unit -> unit = |}] @@ -1500,7 +1503,8 @@ let q () = assert false [%%expect{| -val ( let* ) : 'a ('b : any). 'a -> ('b -> t_float64) -> unit = +val ( let* ) : + ('a : value_or_null) ('b : any). 'a -> ('b -> t_float64) -> unit = val q : unit -> unit = |}] @@ -1526,7 +1530,8 @@ let q () = () [%%expect{| -val ( let* ) : 'a -> 'b -> t_float64 = +val ( let* ) : + ('a : value_or_null) ('b : value_or_null). 'a -> 'b -> t_float64 = val q : unit -> t_float64 = |}] @@ -1556,8 +1561,9 @@ let q () = () [%%expect{| -val ( let* ) : 'a -> 'b -> unit = -val ( and* ) : 'a -> t_float64 -> unit = +val ( let* ) : ('a : value_or_null) ('b : value_or_null). 'a -> 'b -> unit = + +val ( and* ) : ('a : value_or_null). 'a -> t_float64 -> unit = val q : unit -> unit = |}] @@ -1587,8 +1593,9 @@ let q () = () [%%expect{| -val ( let* ) : 'a -> 'b -> unit = -val ( and* ) : t_float64 -> 'a -> unit = +val ( let* ) : ('a : value_or_null) ('b : value_or_null). 'a -> 'b -> unit = + +val ( and* ) : ('a : value_or_null). t_float64 -> 'a -> unit = val q : unit -> unit = |}] @@ -1618,8 +1625,9 @@ let q () = () [%%expect{| -val ( let* ) : ('a : float64) 'b. 'a -> 'b -> unit = -val ( and* ) : 'a -> 'b -> t_float64 = +val ( let* ) : ('a : float64) ('b : value_or_null). 'a -> 'b -> unit = +val ( and* ) : + ('a : value_or_null) ('b : value_or_null). 'a -> 'b -> t_float64 = val q : unit -> unit = |}] @@ -1639,7 +1647,8 @@ Line 4, characters 9-19: 4 | let* x : t_void = assert false ^^^^^^^^^^ Error: This pattern matches values of type t_void - but a pattern was expected which matches values of type ('a : value) + but a pattern was expected which matches values of type + ('a : value_or_null) The layout of t_void is void because of the definition of t_void at line 1, characters 0-18. But the layout of t_void must be a sublayout of value @@ -1655,13 +1664,18 @@ let q () = () [%%expect{| -val ( let* ) : 'a -> 'b -> unit = -val ( and* ) : 'a -> 'b -> 'c = +val ( let* ) : ('a : value_or_null) ('b : value_or_null). 'a -> 'b -> unit = + +val ( and* ) : + ('a : value_or_null) ('b : value_or_null) ('c : value_or_null). + 'a -> 'b -> 'c = + Line 4, characters 9-22: 4 | let* x : t_float64 = assert false ^^^^^^^^^^^^^ Error: This pattern matches values of type t_float64 - but a pattern was expected which matches values of type ('a : value) + but a pattern was expected which matches values of type + ('a : value_or_null) The layout of t_float64 is float64 because of the definition of t_float64 at line 5, characters 0-24. But the layout of t_float64 must be a sublayout of value @@ -1734,7 +1748,8 @@ let f #poly_var = "hello" Line 1, characters 41-43: 1 | type ('a : void) poly_var = [`A of int * 'a | `B] ^^ -Error: This type ('a : value) should be an instance of type ('a0 : void) +Error: This type ('a : value_or_null) should be an instance of type + ('a0 : void) The layout of 'a is void because of the annotation on 'a in the declaration of the type poly_var. @@ -1757,7 +1772,7 @@ Line 1, characters 14-37: 1 | let f _ = `Mk (assert false : t_void) ^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type t_void but an expression was expected of type - ('a : value) + ('a : value_or_null) The layout of t_void is void because of the definition of t_void at line 1, characters 0-18. But the layout of t_void must be a sublayout of value diff --git a/ocaml/testsuite/tests/typing-layouts/layout_poly.ml b/ocaml/testsuite/tests/typing-layouts/layout_poly.ml index c193c0050bc..de95f1cd26e 100644 --- a/ocaml/testsuite/tests/typing-layouts/layout_poly.ml +++ b/ocaml/testsuite/tests/typing-layouts/layout_poly.ml @@ -550,8 +550,7 @@ Error: This expression has type ('a : float64) But the layout of int64# must be a sublayout of float64 because it's the layout polymorphic type in an external declaration ([@layout_poly] forces all variables of layout 'any' to be - representable at call sites), - defaulted to layout float64. + representable at call sites). |}] (* CR layouts v2.9: the default part is not quite correct *) diff --git a/ocaml/typing/ctype.ml b/ocaml/typing/ctype.ml index 4a92475cfd9..229fef7b8a1 100644 --- a/ocaml/typing/ctype.ml +++ b/ocaml/typing/ctype.ml @@ -2278,6 +2278,12 @@ let type_sort ~why env ty = | Ok _ -> Ok sort | Error _ as e -> e +let type_legacy_sort ~why env ty = + let jkind, sort = Jkind.of_new_legacy_sort_var ~why in + match constrain_type_jkind env ty jkind with + | Ok _ -> Ok sort + | Error _ as e -> e + (* Note: Because [estimate_type_jkind] actually returns an upper bound, this function computes an inaccurate intersection in some cases. diff --git a/ocaml/typing/ctype.mli b/ocaml/typing/ctype.mli index 7ab3cf9066f..0c433921740 100644 --- a/ocaml/typing/ctype.mli +++ b/ocaml/typing/ctype.mli @@ -78,10 +78,9 @@ val newty: type_desc -> type_expr val new_scoped_ty: int -> type_desc -> type_expr val newvar: ?name:string -> Jkind.t -> type_expr -(* CR layouts v3.0: this should allow [or_null]. *) val new_rep_var : ?name:string - -> why:Jkind.History.concrete_default_creation_reason + -> why:Jkind.History.concrete_creation_reason -> unit -> type_expr * Jkind.sort (* Return a fresh representable variable, along with its sort *) @@ -551,11 +550,16 @@ val type_jkind : Env.t -> type_expr -> jkind expansion. *) val type_jkind_purely : Env.t -> type_expr -> jkind -(* CR layouts v3.0: this should allow [or_null]. *) (* Find a type's sort (constraining it to be an arbitrary sort variable, if needed) *) val type_sort : - why:Jkind.History.concrete_default_creation_reason -> + why:Jkind.History.concrete_creation_reason -> + Env.t -> type_expr -> (Jkind.sort, Jkind.Violation.t) result + +(* As [type_sort], but constrain the jkind to be non-null. + Used for checking array elements. *) +val type_legacy_sort : + why:Jkind.History.concrete_legacy_creation_reason -> Env.t -> type_expr -> (Jkind.sort, Jkind.Violation.t) result (* Jkind checking. [constrain_type_jkind] will update the jkind of type diff --git a/ocaml/typing/jkind.ml b/ocaml/typing/jkind.ml index c072f457ece..50b60865530 100644 --- a/ocaml/typing/jkind.ml +++ b/ocaml/typing/jkind.ml @@ -96,22 +96,6 @@ module Layout = struct | Word | Bits32 | Bits64 - - let to_string = function - | Any -> "any" - (* CR layouts v3.0: drop [or_null]/[non_null] suffixes - if the layout extension level is less than alpha. *) - | Any_non_null -> "any_non_null" - | Value_or_null -> "value_or_null" - | Value -> "value" - | Void -> "void" - | Immediate64 -> "immediate64" - | Immediate -> "immediate" - | Float64 -> "float64" - | Float32 -> "float32" - | Word -> "word" - | Bits32 -> "bits32" - | Bits64 -> "bits64" end end @@ -508,6 +492,21 @@ module Const = struct word; bits32; bits64 ] + + (* CR layouts v3.0: remove this hack once [or_null] is out of [Alpha]. *) + let all_non_null = + [ any; + { any_non_null with name = "any" }; + { value_or_null with name = "value" }; + value; + void; + immediate; + immediate64; + float64; + float32; + word; + bits32; + bits64 ] end module To_out_jkind_const = struct @@ -588,20 +587,21 @@ module Const = struct | [out] -> Some out | [] -> None - let convert jkind = + let convert ~allow_null jkind = (* For each primitive jkind, we try to print the jkind in terms of it (this is possible if the primitive is a subjkind of it). We then choose the "simplest". The "simplest" is taken to mean the one with the least number of modes that need to follow the [mod]. *) let simplest = - Primitive.all + (* CR layouts v3.0: remove this hack once [or_null] is out of [Alpha]. *) + (if allow_null then Primitive.all else Primitive.all_non_null) |> List.filter_map (fun base -> convert_with_base ~base jkind) |> select_simplest in let printable_jkind = match simplest with | Some simplest -> simplest - | None -> + | None -> ( (* CR layouts v2.8: sometimes there is no valid way to build a jkind from a built-in abbreviation. For now, we just pretend that the layout name is a valid jkind abbreviation whose modal bounds are all max, even though this is a @@ -619,9 +619,26 @@ module Const = struct } jkind in - (* convert_with_base is guaranteed to succeed since the layout matches and the - modal bounds are all max *) - Option.get out_jkind_verbose + match out_jkind_verbose with + | Some out_jkind -> out_jkind + | None -> + (* If we fail, try again with nullable jkinds. *) + let out_jkind_verbose = + convert_with_base + ~base: + { jkind = + { layout = jkind.layout; + modes_upper_bounds = Modes.max; + externality_upper_bound = Externality.max; + nullability_upper_bound = Nullability.max + }; + name = Layout.Const.to_string jkind.layout + } + jkind + in + (* convert_with_base is guaranteed to succeed since the layout matches and the + modal bounds are all max *) + Option.get out_jkind_verbose) in match printable_jkind with | { base; modal_bounds = _ :: _ as modal_bounds } -> @@ -631,10 +648,16 @@ module Const = struct Outcometree.Ojkind_const_abbreviation base end - let to_out_jkind_const = To_out_jkind_const.convert + let to_out_jkind_const jkind = + let allow_null = Language_extension.(is_at_least Layouts Alpha) in + To_out_jkind_const.convert ~allow_null jkind let format ppf jkind = to_out_jkind_const jkind |> !Oprint.out_jkind_const ppf + let format_no_hiding ppf jkind = + To_out_jkind_const.convert ~allow_null:true jkind + |> !Oprint.out_jkind_const ppf + let of_attribute : Builtin_attributes.jkind_attribute -> t = function | Immediate -> Primitive.immediate.jkind | Immediate64 -> Primitive.immediate64.jkind @@ -685,7 +708,11 @@ module Const = struct in (* CR layouts 2.8: move this to predef *) match name with - | "any" -> Primitive.any.jkind + (* CR layouts 3.0: remove this hack once non-null jkinds are out of alpha. + It is confusing, but preserves backwards compatibility for arrays. *) + | "any" when Language_extension.(is_at_least Layouts Alpha) -> + Primitive.any.jkind + | "any" -> Primitive.any_non_null.jkind | "any_non_null" -> Primitive.any_non_null.jkind | "value_or_null" -> Primitive.value_or_null.jkind | "value" -> Primitive.value.jkind @@ -1028,21 +1055,22 @@ module Primitive = struct ~why:(Any_non_null_creation why) let value_v1_safety_check = - { jkind = Jkind_desc.Primitive.value; - history = Creation (Value_creation V1_safety_check); + { jkind = Jkind_desc.Primitive.value_or_null; + history = Creation (Value_or_null_creation V1_safety_check); has_warned = false } let void ~why = fresh_jkind Jkind_desc.Primitive.void ~why:(Void_creation why) let value_or_null ~why = - fresh_jkind Jkind_desc.Primitive.value_or_null - ~why:(Value_or_null_creation why) + match (why : History.value_or_null_creation_reason) with + | V1_safety_check -> value_v1_safety_check + | _ -> + fresh_jkind Jkind_desc.Primitive.value_or_null + ~why:(Value_or_null_creation why) let value ~(why : History.value_creation_reason) = - match why with - | V1_safety_check -> value_v1_safety_check - | _ -> fresh_jkind Jkind_desc.Primitive.value ~why:(Value_creation why) + fresh_jkind Jkind_desc.Primitive.value ~why:(Value_creation why) let immediate64 ~why = fresh_jkind Jkind_desc.Primitive.immediate64 ~why:(Immediate64_creation why) @@ -1087,19 +1115,28 @@ let get_required_layouts_level (context : History.annotation_context) match context, legacy_layout with | ( _, ( Value | Immediate | Immediate64 | Any | Float64 | Float32 | Word - | Bits32 | Bits64 ) ) -> + | Bits32 | Bits64 | Any_non_null ) ) -> + (* CR layouts v3.0: we allow [Any_non_null] because, without [Alpha], + explicit [Any] annotations are converted to [Any_non_null] to + preserve compatibility with array arguments. *) Stable - | _, (Any_non_null | Value_or_null | Void) -> Alpha + | _, (Value_or_null | Void) -> Alpha (******************************) (* construction *) let of_new_sort_var ~why = - let jkind, sort = Jkind_desc.of_new_sort_var Non_null in - fresh_jkind jkind ~why:(Concrete_default_creation why), sort + let jkind, sort = Jkind_desc.of_new_sort_var Maybe_null in + fresh_jkind jkind ~why:(Concrete_creation why), sort let of_new_sort ~why = fst (of_new_sort_var ~why) +let of_new_legacy_sort_var ~why = + let jkind, sort = Jkind_desc.of_new_sort_var Non_null in + fresh_jkind jkind ~why:(Concrete_legacy_creation why), sort + +let of_new_legacy_sort ~why = fst (of_new_legacy_sort_var ~why) + (* CR layouts v2.8: remove this function *) let of_const ~why ({ layout; @@ -1324,16 +1361,13 @@ module Format_history = struct let to_ordinal num = Int.to_string num ^ Misc.ordinal_suffix num in match arity with 1 -> "" | _ -> to_ordinal position ^ " " - let format_concrete_default_creation_reason ppf : - History.concrete_default_creation_reason -> unit = function + let format_concrete_creation_reason ppf : + History.concrete_creation_reason -> unit = function | Match -> fprintf ppf "a value of this type is matched against a pattern" | Constructor_declaration _ -> fprintf ppf "it's the type of a constructor field" | Label_declaration lbl -> fprintf ppf "it is the type of record field %s" (Ident.name lbl) - | Unannotated_type_parameter path -> - fprintf ppf "it instantiates an unannotated type parameter of %a" - !printtyp_path path | Record_projection -> fprintf ppf "it's the record type used in a projection" | Record_assignment -> @@ -1350,8 +1384,6 @@ module Format_history = struct | External_result -> fprintf ppf "it's the type of the result of an external declaration" | Statement -> fprintf ppf "it's the type of a statement" - | Wildcard -> fprintf ppf "it's a _ in the type" - | Unification_var -> fprintf ppf "it's a fresh unification variable" | Optional_arg_default -> fprintf ppf "it's the type of an optional argument default" | Layout_poly_in_external -> @@ -1359,6 +1391,14 @@ module Format_history = struct "it's the layout polymorphic type in an external declaration@ \ ([@@layout_poly] forces all variables of layout 'any' to be@ \ representable at call sites)" + + let format_concrete_legacy_creation_reason ppf : + History.concrete_legacy_creation_reason -> unit = function + | Unannotated_type_parameter path -> + fprintf ppf "it instantiates an unannotated type parameter of %a" + !printtyp_path path + | Wildcard -> fprintf ppf "it's a _ in the type" + | Unification_var -> fprintf ppf "it's a fresh unification variable" | Array_element -> fprintf ppf "it's the type of an array element" let rec format_annotation_context ppf : History.annotation_context -> unit = @@ -1386,12 +1426,12 @@ module Format_history = struct function | Missing_cmi p -> fprintf ppf "the .cmi file for %a is missing" !printtyp_path p - | Wildcard -> format_with_notify_js ppf "there's a _ in the type" - | Unification_var -> - format_with_notify_js ppf "it's a fresh unification variable" | Initial_typedecl_env -> format_with_notify_js ppf "a dummy kind of any is used to check mutually recursive datatypes" + | Wildcard -> format_with_notify_js ppf "there's a _ in the type" + | Unification_var -> + format_with_notify_js ppf "it's a fresh unification variable" | Dummy_jkind -> format_with_notify_js ppf "it's assigned a dummy kind that should have been overwritten" @@ -1400,6 +1440,9 @@ module Format_history = struct format_with_notify_js ppf "there's a call to [type_expression] via the ocaml API" | Inside_of_Tarrow -> fprintf ppf "argument or result of a function type" + + let format_any_non_null_creation_reason ppf : + History.any_non_null_creation_reason -> unit = function | Array_type_argument -> fprintf ppf "it's the type argument to the array type" @@ -1421,11 +1464,22 @@ module Format_history = struct | Separability_check -> fprintf ppf "the check that a type is definitely not `float`" + let format_value_or_null_creation_reason ppf : + History.value_or_null_creation_reason -> _ = function + | Tuple_element -> fprintf ppf "it's the type of a tuple element" + | Separability_check -> + fprintf ppf "the check that a type is definitely not `float`" + | Polymorphic_variant_field -> + fprintf ppf "it's the type of the field of a polymorphic variant" + | Structure_element -> + fprintf ppf "it's the type of something stored in a module structure" + | V1_safety_check -> + fprintf ppf "it has to be value for the V1 safety check" + let format_value_creation_reason ppf ~layout_or_kind : History.value_creation_reason -> _ = function | Class_let_binding -> fprintf ppf "it's the type of a let-bound variable in a class expression" - | Tuple_element -> fprintf ppf "it's the type of a tuple element" | Probe -> format_with_notify_js ppf "it's a probe" | Object -> fprintf ppf "it's the type of an object" | Instance_variable -> fprintf ppf "it's the type of an instance variable" @@ -1451,12 +1505,8 @@ module Format_history = struct format_with_notify_js ppf "it's an internal Tnil type (you shouldn't see this)" | First_class_module -> fprintf ppf "it's a first-class module type" - | Separability_check -> - fprintf ppf "the check that a type is definitely not `float`" | Univar -> fprintf ppf "it is or unifies with an unannotated universal variable" - | Polymorphic_variant_field -> - fprintf ppf "it's the type of the field of a polymorphic variant" | Default_type_jkind -> fprintf ppf "an abstract type has the value %s by default" layout_or_kind | Existential_type_variable -> @@ -1469,13 +1519,9 @@ module Format_history = struct | Class_term_argument -> fprintf ppf "it's the type of a term-level argument to a class constructor" - | Structure_element -> - fprintf ppf "it's the type of something stored in a module structure" | Debug_printer_argument -> format_with_notify_js ppf "it's the type of an argument to a debugger printer function" - | V1_safety_check -> - fprintf ppf "it has to be value for the V1 safety check" | Captured_in_object -> fprintf ppf "it's the type of a variable captured in an object" | Recmod_fun_arg -> @@ -1519,13 +1565,14 @@ module Format_history = struct | Missing_cmi p -> fprintf ppf "the .cmi file for %a is missing" !printtyp_path p | Any_creation any -> format_any_creation_reason ppf any - | Any_non_null_creation _ -> . + | Any_non_null_creation any -> format_any_non_null_creation_reason ppf any | Immediate_creation immediate -> format_immediate_creation_reason ppf immediate | Immediate64_creation immediate64 -> format_immediate64_creation_reason ppf immediate64 | Void_creation _ -> . - | Value_or_null_creation _ -> . + | Value_or_null_creation value -> + format_value_or_null_creation_reason ppf value | Value_creation value -> format_value_creation_reason ppf ~layout_or_kind value | Float64_creation float -> format_float64_creation_reason ppf float @@ -1533,9 +1580,9 @@ module Format_history = struct | Word_creation word -> format_word_creation_reason ppf word | Bits32_creation bits32 -> format_bits32_creation_reason ppf bits32 | Bits64_creation bits64 -> format_bits64_creation_reason ppf bits64 - | Concrete_creation _ -> . - | Concrete_default_creation concrete -> - format_concrete_default_creation_reason ppf concrete + | Concrete_creation concrete -> format_concrete_creation_reason ppf concrete + | Concrete_legacy_creation concrete -> + format_concrete_legacy_creation_reason ppf concrete | Imported -> fprintf ppf "of %s requirements from an imported definition" layout_or_kind @@ -1570,7 +1617,7 @@ module Format_history = struct | Creation reason -> ( fprintf ppf "@ because %a" (format_creation_reason ~layout_or_kind) reason; match reason, jkind_desc with - | Concrete_default_creation _, Const _ -> + | Concrete_legacy_creation _, Const _ -> fprintf ppf ",@ defaulted to %s %a" layout_or_kind Desc.format jkind_desc | _ -> ()) @@ -1751,7 +1798,7 @@ let score_reason = function (* error_message annotated by the user should always take priority *) | Creation (Annotated (With_error_message _, _)) -> 1 (* Concrete creation is quite vague, prefer more specific reasons *) - | Creation (Concrete_creation _ | Concrete_default_creation _) -> -1 + | Creation (Concrete_creation _ | Concrete_legacy_creation _) -> -1 | _ -> 0 let combine_histories reason lhs rhs = @@ -1819,15 +1866,13 @@ let has_layout_any jkind = module Debug_printers = struct open Format - let concrete_default_creation_reason ppf : - History.concrete_default_creation_reason -> unit = function + let concrete_creation_reason ppf : History.concrete_creation_reason -> unit = + function | Match -> fprintf ppf "Match" | Constructor_declaration idx -> fprintf ppf "Constructor_declaration %d" idx | Label_declaration lbl -> fprintf ppf "Label_declaration %a" Ident.print lbl - | Unannotated_type_parameter path -> - fprintf ppf "Unannotated_type_parameter %a" !printtyp_path path | Record_projection -> fprintf ppf "Record_projection" | Record_assignment -> fprintf ppf "Record_assignment" | Let_binding -> fprintf ppf "Let_binding" @@ -1837,10 +1882,15 @@ module Debug_printers = struct | External_argument -> fprintf ppf "External_argument" | External_result -> fprintf ppf "External_result" | Statement -> fprintf ppf "Statement" - | Wildcard -> fprintf ppf "Wildcard" - | Unification_var -> fprintf ppf "Unification_var" | Optional_arg_default -> fprintf ppf "Optional_arg_default" | Layout_poly_in_external -> fprintf ppf "Layout_poly_in_external" + + let concrete_legacy_creation_reason ppf : + History.concrete_legacy_creation_reason -> unit = function + | Unannotated_type_parameter path -> + fprintf ppf "Unannotated_type_parameter %a" !printtyp_path path + | Wildcard -> fprintf ppf "Wildcard" + | Unification_var -> fprintf ppf "Unification_var" | Array_element -> fprintf ppf "Array_element" let rec annotation_context ppf : History.annotation_context -> unit = function @@ -1864,10 +1914,13 @@ module Debug_printers = struct | Missing_cmi p -> fprintf ppf "Missing_cmi %a" Path.print p | Initial_typedecl_env -> fprintf ppf "Initial_typedecl_env" | Dummy_jkind -> fprintf ppf "Dummy_jkind" - | Type_expression_call -> fprintf ppf "Type_expression_call" - | Inside_of_Tarrow -> fprintf ppf "Inside_of_Tarrow" | Wildcard -> fprintf ppf "Wildcard" | Unification_var -> fprintf ppf "Unification_var" + | Type_expression_call -> fprintf ppf "Type_expression_call" + | Inside_of_Tarrow -> fprintf ppf "Inside_of_Tarrow" + + let any_non_null_creation_reason ppf : + History.any_non_null_creation_reason -> unit = function | Array_type_argument -> fprintf ppf "Array_type_argument" let immediate_creation_reason ppf : History.immediate_creation_reason -> _ = @@ -1882,9 +1935,16 @@ module Debug_printers = struct = function | Separability_check -> fprintf ppf "Separability_check" + let value_or_null_creation_reason ppf : + History.value_or_null_creation_reason -> _ = function + | Tuple_element -> fprintf ppf "Tuple_element" + | Separability_check -> fprintf ppf "Separability_check" + | Polymorphic_variant_field -> fprintf ppf "Polymorphic_variant_field" + | Structure_element -> fprintf ppf "Structure_element" + | V1_safety_check -> fprintf ppf "V1_safety_check" + let value_creation_reason ppf : History.value_creation_reason -> _ = function | Class_let_binding -> fprintf ppf "Class_let_binding" - | Tuple_element -> fprintf ppf "Tuple_element" | Probe -> fprintf ppf "Probe" | Object -> fprintf ppf "Object" | Instance_variable -> fprintf ppf "Instance_variable" @@ -1904,18 +1964,14 @@ module Debug_printers = struct | Tfield -> fprintf ppf "Tfield" | Tnil -> fprintf ppf "Tnil" | First_class_module -> fprintf ppf "First_class_module" - | Separability_check -> fprintf ppf "Separability_check" | Univar -> fprintf ppf "Univar" - | Polymorphic_variant_field -> fprintf ppf "Polymorphic_variant_field" | Default_type_jkind -> fprintf ppf "Default_type_jkind" | Existential_type_variable -> fprintf ppf "Existential_type_variable" | Array_comprehension_element -> fprintf ppf "Array_comprehension_element" | Lazy_expression -> fprintf ppf "Lazy_expression" | Class_type_argument -> fprintf ppf "Class_type_argument" | Class_term_argument -> fprintf ppf "Class_term_argument" - | Structure_element -> fprintf ppf "Structure_element" | Debug_printer_argument -> fprintf ppf "Debug_printer_argument" - | V1_safety_check -> fprintf ppf "V1_safety_check" | Captured_in_object -> fprintf ppf "Captured_in_object" | Recmod_fun_arg -> fprintf ppf "Recmod_fun_arg" | Unknown s -> fprintf ppf "Unknown %s" s @@ -1945,13 +2001,16 @@ module Debug_printers = struct loc | Missing_cmi p -> fprintf ppf "Missing_cmi %a" !printtyp_path p | Any_creation any -> fprintf ppf "Any_creation %a" any_creation_reason any - | Any_non_null_creation _ -> . + | Any_non_null_creation any -> + fprintf ppf "Any_non_null_creation %a" any_non_null_creation_reason any | Immediate_creation immediate -> fprintf ppf "Immediate_creation %a" immediate_creation_reason immediate | Immediate64_creation immediate64 -> fprintf ppf "Immediate64_creation %a" immediate64_creation_reason immediate64 - | Value_or_null_creation _ -> . + | Value_or_null_creation value -> + fprintf ppf "Value_or_null_creation %a" value_or_null_creation_reason + value | Value_creation value -> fprintf ppf "Value_creation %a" value_creation_reason value | Void_creation _ -> . @@ -1965,10 +2024,11 @@ module Debug_printers = struct fprintf ppf "Bits32_creation %a" bits32_creation_reason bits32 | Bits64_creation bits64 -> fprintf ppf "Bits64_creation %a" bits64_creation_reason bits64 - | Concrete_creation _ -> . - | Concrete_default_creation concrete -> - fprintf ppf "Concrete_default_creation %a" - concrete_default_creation_reason concrete + | Concrete_creation concrete -> + fprintf ppf "Concrete_creation %a" concrete_creation_reason concrete + | Concrete_legacy_creation concrete -> + fprintf ppf "Concrete_legacy_creation %a" concrete_legacy_creation_reason + concrete | Imported -> fprintf ppf "Imported" | Imported_type_argument { parent_path; position; arity } -> fprintf ppf "Imported_type_argument (pos %d, arity %d) of %a" position @@ -2013,7 +2073,7 @@ let report_error ~loc : Error.t -> _ = function "@[A type declaration's layout can be given at most once.@;\ This declaration has an layout annotation (%a) and a layout attribute \ ([@@@@%a]).@]" - Const.format from_annotation Const.format from_attribute + Const.format_no_hiding from_annotation Const.format from_attribute | Insufficient_level { jkind; required_layouts_level } -> ( let hint ppf = Format.fprintf ppf "You must enable -extension %s to use this feature." @@ -2032,7 +2092,7 @@ let report_error ~loc : Error.t -> _ = function "@[Layout %a is more experimental than allowed by the enabled \ layouts extension.@;\ %t@]" - Const.format jkind hint) + Const.format_no_hiding jkind hint) let () = Location.register_error_of_exn (function diff --git a/ocaml/typing/jkind.mli b/ocaml/typing/jkind.mli index 37266d8cfed..bb56240ee28 100644 --- a/ocaml/typing/jkind.mli +++ b/ocaml/typing/jkind.mli @@ -91,8 +91,6 @@ module Layout : sig | Word | Bits32 | Bits64 - - val to_string : t -> string end end end @@ -306,15 +304,23 @@ val add_portability_and_contention_crossing : from:t -> t -> t * bool (******************************) (* construction *) -(* CR layouts v3.0: split those functions in two versions, - one [or_null] and one [non_null]. *) - (** Create a fresh sort variable, packed into a jkind, returning both the resulting kind and the sort. *) -val of_new_sort_var : why:History.concrete_default_creation_reason -> t * sort +val of_new_sort_var : why:History.concrete_creation_reason -> t * sort (** Create a fresh sort variable, packed into a jkind. *) -val of_new_sort : why:History.concrete_default_creation_reason -> t +val of_new_sort : why:History.concrete_creation_reason -> t + +(** Same as [of_new_sort_var], but the jkind is lowered to [Non_null] + to mirror "legacy" OCaml values. + Defaulting the sort variable produces exactly [value]. *) +val of_new_legacy_sort_var : + why:History.concrete_legacy_creation_reason -> t * sort + +(** Same as [of_new_sort], but the jkind is lowered to [Non_null] + to mirror "legacy" OCaml values. + Defaulting the sort variable produces exactly [value]. *) +val of_new_legacy_sort : why:History.concrete_legacy_creation_reason -> t val of_const : why:History.creation_reason -> Const.t -> t diff --git a/ocaml/typing/jkind_intf.ml b/ocaml/typing/jkind_intf.ml index 609eff371ea..f51ea039dfc 100644 --- a/ocaml/typing/jkind_intf.ml +++ b/ocaml/typing/jkind_intf.ml @@ -148,17 +148,11 @@ module type Sort = sig end module History = struct - (* CR layouts v3: move most [concrete_default_creation_reason]s here. *) (* For sort variables that are topmost on the jkind lattice. *) - type concrete_creation_reason = | - - (* For sort variables that are in the "default" position - on the jkind lattice, defaulting exactly to [value]. *) - type concrete_default_creation_reason = + type concrete_creation_reason = | Match | Constructor_declaration of int | Label_declaration of Ident.t - | Unannotated_type_parameter of Path.t | Record_projection | Record_assignment | Let_binding @@ -168,10 +162,17 @@ module History = struct | External_argument | External_result | Statement - | Wildcard - | Unification_var | Optional_arg_default | Layout_poly_in_external + + (* For sort variables that are in the "legacy" position + on the jkind lattice, defaulting exactly to [value]. *) + (* CR layouts v3: after implementing separability, [Array_element] + should instead accept representable separable jkinds. *) + type concrete_legacy_creation_reason = + | Unannotated_type_parameter of Path.t + | Wildcard + | Unification_var | Array_element type annotation_context = @@ -184,12 +185,20 @@ module History = struct | Type_wildcard of Location.t | With_error_message of string * annotation_context - (* CR layouts v3: move some [value_creation_reason]s here. *) - type value_or_null_creation_reason = | + (* CR layouts v3: move some [value_creation_reason]s + related to objects here. *) + (* CR layouts v3: add a copy of [Type_argument] once we support + enough subjkinding for interfaces to accept [value_or_null] + in [list] or [option]. *) + type value_or_null_creation_reason = + | Tuple_element + | Separability_check + | Polymorphic_variant_field + | Structure_element + | V1_safety_check type value_creation_reason = | Class_let_binding - | Tuple_element | Probe | Object | Instance_variable @@ -212,18 +221,14 @@ module History = struct | Tfield | Tnil | First_class_module - | Separability_check | Univar - | Polymorphic_variant_field | Default_type_jkind | Existential_type_variable | Array_comprehension_element | Lazy_expression | Class_type_argument | Class_term_argument - | Structure_element | Debug_printer_argument - | V1_safety_check | Captured_in_object | Recmod_fun_arg | Unknown of string (* CR layouts: get rid of these *) @@ -250,10 +255,8 @@ module History = struct | Inside_of_Tarrow | Wildcard | Unification_var - | Array_type_argument - (* CR layouts v3: move some [any_creation_reason]s here. *) - type any_non_null_creation_reason = | + type any_non_null_creation_reason = Array_type_argument type float64_creation_reason = Primitive of Ident.t @@ -281,7 +284,7 @@ module History = struct | Bits32_creation of bits32_creation_reason | Bits64_creation of bits64_creation_reason | Concrete_creation of concrete_creation_reason - | Concrete_default_creation of concrete_default_creation_reason + | Concrete_legacy_creation of concrete_legacy_creation_reason | Imported | Imported_type_argument of { parent_path : Path.t; diff --git a/ocaml/typing/predef.ml b/ocaml/typing/predef.ml index 6b3b0b9c9d8..d4b59465f29 100644 --- a/ocaml/typing/predef.ml +++ b/ocaml/typing/predef.ml @@ -326,7 +326,7 @@ let build_initial_env add_type add_extension empty_env = |> add_type1 ident_array ~variance:Variance.full ~separability:Separability.Ind - ~param_jkind:(Jkind.Primitive.any ~why:Array_type_argument) + ~param_jkind:(Jkind.Primitive.any_non_null ~why:Array_type_argument) |> add_type1 ident_iarray ~variance:Variance.covariant ~separability:Separability.Ind diff --git a/ocaml/typing/printtyp.ml b/ocaml/typing/printtyp.ml index ceb7ac15a4a..2f71295817c 100644 --- a/ocaml/typing/printtyp.ml +++ b/ocaml/typing/printtyp.ml @@ -1277,7 +1277,12 @@ let out_jkind_of_const_jkind jkind = let out_jkind_option_of_jkind jkind = match Jkind.get jkind with | Const jkind -> - begin match Jkind.Const.equal jkind Jkind.Const.Primitive.value.jkind with + let is_value = Jkind.Const.equal jkind Jkind.Const.Primitive.value.jkind + (* CR layouts v3.0: remove this hack once [or_null] is out of [Alpha]. *) + || (not Language_extension.(is_at_least Layouts Alpha) + && Jkind.Const.equal jkind Jkind.Const.Primitive.value_or_null.jkind) + in + begin match is_value with | true -> None | false -> Some (out_jkind_of_const_jkind jkind) end diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml index 1a3ec1142f9..ae591eac837 100644 --- a/ocaml/typing/typecore.ml +++ b/ocaml/typing/typecore.ml @@ -1453,7 +1453,7 @@ let solve_Ppat_tuple ~refine ~alloc_mode loc env args expected_ty = (fun (label, p) mode -> ( label, p, - newgenvar (Jkind.Primitive.value ~why:Tuple_element), + newgenvar (Jkind.Primitive.value_or_null ~why:Tuple_element), simple_pat_mode mode )) args arg_modes in @@ -1622,7 +1622,7 @@ let solve_Ppat_array ~refine loc env mutability expected_ty = if Types.is_mutable mutability then Predef.type_array else Predef.type_iarray in - let jkind, arg_sort = Jkind.of_new_sort_var ~why:Array_element in + let jkind, arg_sort = Jkind.of_new_legacy_sort_var ~why:Array_element in let ty_elt = newgenvar jkind in let expected_ty = generic_instance expected_ty in unify_pat_types ~refine @@ -1656,7 +1656,7 @@ let solve_Ppat_variant ~refine loc env tag no_arg expected_ty = let arg_type = if no_arg then [] - else [newgenvar (Jkind.Primitive.value ~why:Polymorphic_variant_field)] + else [newgenvar (Jkind.Primitive.value_or_null ~why:Polymorphic_variant_field)] in let fields = [tag, rf_either ~no_arg arg_type ~matched:true] in let make_row more = @@ -4248,7 +4248,7 @@ and type_approx_aux_jane_syntax and type_tuple_approx (env: Env.t) loc ty_expected l = let labeled_tys = List.map - (fun (label, _) -> label, newvar (Jkind.Primitive.value ~why:Tuple_element)) l + (fun (label, _) -> label, newvar (Jkind.Primitive.value_or_null ~why:Tuple_element)) l in let ty = newty (Ttuple labeled_tys) in begin try unify env ty ty_expected with Unify err -> @@ -5552,7 +5552,7 @@ and type_expect_ | None -> None | Some sarg -> let ty_expected = - newvar (Jkind.Primitive.value ~why:Polymorphic_variant_field) + newvar (Jkind.Primitive.value_or_null ~why:Polymorphic_variant_field) in let alloc_mode, argument_mode = register_allocation expected_mode in let arg = @@ -6289,7 +6289,7 @@ and type_expect_ | [] -> spat_acc, ty_acc, ty_acc_sort | { pbop_pat = spat; _} :: rest -> (* CR layouts v5: eliminate value requirement *) - let ty = newvar (Jkind.Primitive.value ~why:Tuple_element) in + let ty = newvar (Jkind.Primitive.value_or_null ~why:Tuple_element) in let loc = Location.ghostify slet.pbop_op.loc in let spat_acc = Ast_helper.Pat.tuple ~loc [spat_acc; spat] in let ty_acc = newty (Ttuple [None, ty_acc; None, ty]) in @@ -6308,7 +6308,7 @@ and type_expect_ | [] -> Jkind.of_new_sort_var ~why:Function_argument (* CR layouts v5: eliminate value requirement for tuple elements *) - | _ -> Jkind.Primitive.value ~why:Tuple_element, Jkind.Sort.value + | _ -> Jkind.Primitive.value_or_null ~why:Tuple_element, Jkind.Sort.value in loop slet.pbop_pat (newvar initial_jkind) initial_sort sands in @@ -7727,7 +7727,7 @@ and type_tuple ~loc ~env ~(expected_mode : expected_mode) ~ty_expected (* CR layouts v5: non-values in tuples *) let labeled_subtypes = List.map (fun (label, _) -> label, - newgenvar (Jkind.Primitive.value ~why:Tuple_element)) + newgenvar (Jkind.Primitive.value_or_null ~why:Tuple_element)) sexpl in let to_unify = newgenty (Ttuple labeled_subtypes) in @@ -8753,7 +8753,7 @@ and type_generic_array in check_construct_mutability ~loc ~env mutability argument_mode; let argument_mode = mode_modality modalities argument_mode in - let jkind, elt_sort = Jkind.of_new_sort_var ~why:Array_element in + let jkind, elt_sort = Jkind.of_new_legacy_sort_var ~why:Array_element in let ty = newgenvar jkind in let to_unify = type_ ty in with_explanation explanation (fun () -> diff --git a/ocaml/typing/typecore.mli b/ocaml/typing/typecore.mli index d6263013ff8..007e9eaee60 100644 --- a/ocaml/typing/typecore.mli +++ b/ocaml/typing/typecore.mli @@ -128,7 +128,7 @@ val type_let: val type_expression: Env.t -> Parsetree.expression -> Typedtree.expression val type_representable_expression: - why:Jkind.History.concrete_default_creation_reason -> + why:Jkind.History.concrete_creation_reason -> Env.t -> Parsetree.expression -> Typedtree.expression * Jkind.sort val type_class_arg_pattern: string -> Env.t -> Env.t -> arg_label -> Parsetree.pattern -> diff --git a/ocaml/typing/typedecl.ml b/ocaml/typing/typedecl.ml index 34dd15aad6d..82084e174d4 100644 --- a/ocaml/typing/typedecl.ml +++ b/ocaml/typing/typedecl.ml @@ -2907,7 +2907,7 @@ let transl_value_decl env loc valdecl = in (* CR layouts v5: relax this to check for representability. *) begin match Ctype.constrain_type_jkind env cty.ctyp_type - (Jkind.Primitive.value ~why:Structure_element) with + (Jkind.Primitive.value_or_null ~why:Structure_element) with | Ok () -> () | Error err -> raise(Error(cty.ctyp_loc, Non_value_in_sig(err,valdecl.pval_name.txt,cty.ctyp_type))) diff --git a/ocaml/typing/typedecl_separability.ml b/ocaml/typing/typedecl_separability.ml index 61bcb59b427..dcbaf793c84 100644 --- a/ocaml/typing/typedecl_separability.ml +++ b/ocaml/typing/typedecl_separability.ml @@ -480,7 +480,7 @@ let msig_of_external_type env decl = let check_jkind = Ctype.check_decl_jkind env decl in - if Result.is_error (check_jkind (Jkind.Primitive.value ~why:Separability_check)) + if Result.is_error (check_jkind (Jkind.Primitive.value_or_null ~why:Separability_check)) || Result.is_ok (check_jkind (Jkind.Primitive.immediate64 ~why:Separability_check)) then best_msig decl diff --git a/ocaml/typing/typeopt.ml b/ocaml/typing/typeopt.ml index 459c6c35e24..ed14985e860 100644 --- a/ocaml/typing/typeopt.ml +++ b/ocaml/typing/typeopt.ml @@ -99,13 +99,15 @@ let maybe_pointer_type env ty = let maybe_pointer exp = maybe_pointer_type exp.exp_env exp.exp_type -(* CR layouts v2.8: Calling [type_sort] in [typeopt] is not ideal and - this function should be removed at some point. To do that, there +(* CR layouts v2.8: Calling [type_legacy_sort] in [typeopt] is not ideal + and this function should be removed at some point. To do that, there needs to be a way to store sort vars on [Tconstr]s. That means either introducing a [Tpoly_constr], allow type parameters with sort info, or do something else. *) -let type_sort ~why env loc ty = - match Ctype.type_sort ~why env ty with +(* CR layouts v3.0: have a better error message + for nullable jkinds.*) +let type_legacy_sort ~why env loc ty = + match Ctype.type_legacy_sort ~why env ty with | Ok sort -> sort | Error err -> raise (Error (loc, Not_a_sort (ty, err))) @@ -172,7 +174,7 @@ let array_type_kind ~elt_sort env loc ty = match elt_sort with | Some s -> s | None -> - type_sort ~why:Array_element env loc elt_ty + type_legacy_sort ~why:Array_element env loc elt_ty in begin match classify env loc elt_ty elt_sort with | Any -> if Config.flat_float_array then Pgenarray else Paddrarray @@ -345,13 +347,13 @@ let rec value_kind env ~loc ~visited ~depth ~num_nodes_visited ty This should be understood, but for now the simple fall back thing is sufficient. *) - match Ctype.check_type_jkind env scty (Jkind.Primitive.value ~why:V1_safety_check) + match Ctype.check_type_jkind env scty (Jkind.Primitive.value_or_null ~why:V1_safety_check) with | Ok _ -> () | Error _ -> match Ctype.(check_type_jkind env - (correct_levels ty) (Jkind.Primitive.value ~why:V1_safety_check)) + (correct_levels ty) (Jkind.Primitive.value_or_null ~why:V1_safety_check)) with | Ok _ -> () | Error violation -> diff --git a/ocaml/typing/typetexp.ml b/ocaml/typing/typetexp.ml index 939838c065d..a0aa54d6044 100644 --- a/ocaml/typing/typetexp.ml +++ b/ocaml/typing/typetexp.ml @@ -430,9 +430,12 @@ end = struct let new_jkind ~is_named { jkind_initialization } = match jkind_initialization with + (* CR layouts v3.0: while [Any] case allows nullable jkinds, [Sort] does not. + From testing, we need all callsites that use [Sort] to be non-null to + preserve backwards compatibility. But we also need [Any] callsites + to accept nullable jkinds to allow cases like [type ('a : value_or_null) t = 'a]. *) | Any -> Jkind.Primitive.any ~why:(if is_named then Unification_var else Wildcard) - | Sort -> Jkind.of_new_sort ~why:(if is_named then Unification_var else Wildcard) - + | Sort -> Jkind.of_new_legacy_sort ~why:(if is_named then Unification_var else Wildcard) let new_any_var loc env jkind = function | { extensibility = Fixed } -> raise(Error(loc, env, No_type_wildcards)) @@ -538,7 +541,7 @@ let transl_type_param env path styp = to ask for it with an annotation. Some restriction here seems necessary for backwards compatibility (e.g., we wouldn't want [type 'a id = 'a] to have jkind any). But it might be possible to infer [any] in some cases. *) - let jkind = Jkind.of_new_sort ~why:(Unannotated_type_parameter path) in + let jkind = Jkind.of_new_legacy_sort ~why:(Unannotated_type_parameter path) in let attrs = styp.ptyp_attributes in match styp.ptyp_desc with Ptyp_any -> transl_type_param_var env loc attrs None jkind None @@ -554,7 +557,7 @@ let transl_type_param env path styp = let get_type_param_jkind path styp = match Jane_syntax.Core_type.of_ast styp with - | None -> Jkind.of_new_sort ~why:(Unannotated_type_parameter path) + | None -> Jkind.of_new_legacy_sort ~why:(Unannotated_type_parameter path) | Some (Jtyp_layout (Ltyp_var { name; jkind }), _attrs) -> let jkind, _ = Jkind.of_annotation @@ -853,7 +856,7 @@ and transl_type_aux env ~row_context ~aliased ~policy mode styp = polymorphic variants. *) match constrain_type_jkind env ctyp_type - (Jkind.Primitive.value ~why:Polymorphic_variant_field) + (Jkind.Primitive.value_or_null ~why:Polymorphic_variant_field) with | Ok _ -> () | Error e -> @@ -1146,7 +1149,7 @@ and transl_type_aux_tuple env ~policy ~row_context stl = List.iter (fun (_, {ctyp_type; ctyp_loc}) -> (* CR layouts v5: remove value requirement *) match - constrain_type_jkind env ctyp_type (Jkind.Primitive.value ~why:Tuple_element) + constrain_type_jkind env ctyp_type (Jkind.Primitive.value_or_null ~why:Tuple_element) with | Ok _ -> () | Error e ->