diff --git a/ocaml/boot/menhir/parser.ml b/ocaml/boot/menhir/parser.ml index a9f8cb747a7..56fba497b0a 100644 --- a/ocaml/boot/menhir/parser.ml +++ b/ocaml/boot/menhir/parser.ml @@ -1211,7 +1211,7 @@ let unboxed_float sloc sign (f, m) = let assert_unboxed_float_type ~loc = Language_extension.( - Jane_syntax_parsing.assert_extension_enabled ~loc Layouts Beta) + Jane_syntax_parsing.assert_extension_enabled ~loc Layouts Stable) let unboxed_float_type sloc tys = assert_unboxed_float_type ~loc:(make_loc sloc); diff --git a/ocaml/parsing/builtin_attributes.ml b/ocaml/parsing/builtin_attributes.ml index 7edd0e4b6ff..d4ba8ac8343 100644 --- a/ocaml/parsing/builtin_attributes.ml +++ b/ocaml/parsing/builtin_attributes.ml @@ -506,9 +506,9 @@ let jkind ~legacy_immediate attrs = | Value -> check true | Immediate | Immediate64 -> check (legacy_immediate - || Language_extension.(is_at_least Layouts Beta)) + || Language_extension.(is_at_least Layouts Stable)) | Any | Float64 -> - check Language_extension.(is_at_least Layouts Beta) + check Language_extension.(is_at_least Layouts Stable) | Void -> check Language_extension.(is_at_least Layouts Alpha) diff --git a/ocaml/parsing/parser.mly b/ocaml/parsing/parser.mly index 0e8ec6413b3..6844328c1dc 100644 --- a/ocaml/parsing/parser.mly +++ b/ocaml/parsing/parser.mly @@ -986,7 +986,7 @@ let unboxed_float sloc sign (f, m) = let assert_unboxed_float_type ~loc = Language_extension.( - Jane_syntax_parsing.assert_extension_enabled ~loc Layouts Beta) + Jane_syntax_parsing.assert_extension_enabled ~loc Layouts Stable) let unboxed_float_type sloc tys = assert_unboxed_float_type ~loc:(make_loc sloc); diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml index cf67ffef1a6..d965546997a 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml @@ -1,6 +1,10 @@ (* TEST - flags = "-extension layouts" * expect + flags = "-extension layouts_alpha" + * expect + flags = "-extension layouts_beta" + * expect + flags = "-extension layouts" *) (* This file contains typing tests for the layout [float64]. @@ -10,30 +14,787 @@ convenient example of a concrete [float64] type in some tests, but its behavior isn't the primary purpose of this test. *) -(* CR layouts: Bring tests here from [basics_alpha.ml] once we have float64 by - default *) - type t_float64 [@@float64] -type ('a : float64) t_float64_id = 'a;; +type ('a : float64) t_float64_id = 'a + +(*********************************) +(* Test 1: The identity function *) + +let f1_1 (x : t_float64) = x;; +let f1_2 (x : 'a t_float64_id) = x;; +let f1_3 (x : float#) = x;; +[%%expect{| +type t_float64 : float64 +type ('a : float64) t_float64_id = 'a +val f1_1 : t_float64 -> t_float64 = +val f1_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = +val f1_3 : float# -> float# = +|}];; + +(*****************************************) +(* Test 2: You can let-bind them locally *) +let f2_1 (x : t_float64) = + let y = x in + y;; + +let f2_2 (x : 'a t_float64_id) = + let y = x in + y;; + +let f2_3 (x : float#) = + let y = x in + y;; +[%%expect{| +val f2_1 : t_float64 -> t_float64 = +val f2_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = +val f2_3 : float# -> float# = +|}];; + +(*****************************************) +(* Test 3: No module-level bindings yet. *) + +let x3_1 : t_float64 = assert false;; [%%expect{| -Line 1, characters 15-26: -1 | type t_float64 [@@float64] - ^^^^^^^^^^^ -Error: Layout float64 is used here, but the appropriate layouts extension is not enabled +Line 1, characters 4-8: +1 | let x3_1 : t_float64 = assert false;; + ^^^^ +Error: Top-level module bindings must have layout value, but x3_1 has layout + float64. +|}];; + +let x3_2 : 'a t_float64_id = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_2 : 'a t_float64_id = assert false;; + ^^^^ +Error: Top-level module bindings must have layout value, but x3_2 has layout + float64. +|}];; + +let x3_3 : float# = assert false;; +[%%expect{| +Line 1, characters 4-8: +1 | let x3_3 : float# = assert false;; + ^^^^ +Error: Top-level module bindings must have layout value, but x3_3 has layout + float64. +|}];; + +module M3_4 = struct + let x : t_float64 = assert false +end +[%%expect{| +Line 2, characters 6-7: +2 | let x : t_float64 = assert false + ^ +Error: Top-level module bindings must have layout value, but x has layout + float64. +|}];; + +module M3_5 = struct + let f (x : float#) = x + + let y = f (assert false) +end +[%%expect{| +Line 4, characters 6-7: +4 | let y = f (assert false) + ^ +Error: Top-level module bindings must have layout value, but y has layout + float64. +|}];; + +(*************************************) +(* Test 4: No putting them in tuples *) + +let f4_1 (x : t_float64) = x, false;; +[%%expect{| +Line 1, characters 27-28: +1 | let f4_1 (x : t_float64) = x, false;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f4_2 (x : 'a t_float64_id) = x, false;; +[%%expect{| +Line 1, characters 33-34: +1 | let f4_2 (x : 'a t_float64_id) = x, false;; + ^ +Error: This expression has type 'a t_float64_id = ('a : float64) + but an expression was expected of type ('b : value) + 'a t_float64_id has layout float64, which does not overlap with value. +|}];; + +let f4_3 (x : float#) = x, false;; +[%%expect{| +Line 1, characters 24-25: +1 | let f4_3 (x : float#) = x, false;; + ^ +Error: This expression has type float# but an expression was expected of type + ('a : value) + float# has layout float64, which is not a sublayout of value. +|}];; + +type t4_4 = t_float64 * string;; +[%%expect{| +Line 1, characters 12-21: +1 | type t4_4 = t_float64 * string;; + ^^^^^^^^^ +Error: Tuple element types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +type t4_5 = int * float#;; +[%%expect{| +Line 1, characters 18-24: +1 | type t4_5 = int * float#;; + ^^^^^^ +Error: Tuple element types must have layout value. + float# has layout float64, which is not a sublayout of value. +|}];; + +type ('a : float64) t4_6 = 'a * 'a +[%%expect{| +Line 1, characters 27-29: +1 | type ('a : float64) t4_6 = 'a * 'a + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : float64) + 'a has layout float64, which does not overlap with value. +|}];; + +(* check for layout propagation *) +type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; +[%%expect{| +Line 1, characters 32-34: +1 | type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; + ^^ +Error: This type ('b : value) should be an instance of type ('a : float64) + 'a has layout float64, which does not overlap with value. |}] -(* CR layouts: The below test checks that we give an acceptable error for cases - where a float64 was used from a library in a file where the user forgot to - enable the relevant extension. It can be deleted when float64 is on by - default (though at that time we should add tests for explicitly disabling the - layouts extension). *) -let f x = Stdlib__Float_u.sin x -[%%expect{| -Line 1, characters 6-31: -1 | let f x = Stdlib__Float_u.sin x - ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Non-value layout float64 detected as sort for type float#, - but this requires extension layouts_beta, which is not enabled. - If you intended to use this layout, please add this flag to your build file. - Otherwise, please report this error to the Jane Street compilers team. +(******************************************************************************) +(* Test 5: Can't be put in structures in typedecls, except all-float records. *) + +type t5_1 = { x : t_float64 };; +[%%expect{| +type t5_1 = { x : t_float64; } +|}];; + +(* CR layouts v5: this should work *) +type t5_2 = { y : int; x : t_float64 };; +[%%expect{| +Line 1, characters 0-38: +1 | type t5_2 = { y : int; x : t_float64 };; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Records may not contain both unboxed floats and normal values. +|}];; + +(* CR layouts: this runs afoul of the mixed block restriction, but should work + once we relax that. *) +type t5_2' = { y : string; x : t_float64 };; +[%%expect{| +Line 1, characters 0-42: +1 | type t5_2' = { y : string; x : t_float64 };; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Records may not contain both unboxed floats and normal values. +|}];; + +(* CR layouts 2.5: allow this *) +type t5_3 = { x : t_float64 } [@@unboxed];; +[%%expect{| +Line 1, characters 14-27: +1 | type t5_3 = { x : t_float64 } [@@unboxed];; + ^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64. + Unboxed records may not yet contain types of this layout. +|}];; + +type t5_4 = A of t_float64;; +[%%expect{| +Line 1, characters 12-26: +1 | type t5_4 = A of t_float64;; + ^^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64. + Variants may not yet contain types of this layout. +|}];; + +type t5_5 = A of int * t_float64;; +[%%expect{| +Line 1, characters 12-32: +1 | type t5_5 = A of int * t_float64;; + ^^^^^^^^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64. + Variants may not yet contain types of this layout. +|}];; + +type t5_6 = A of t_float64 [@@unboxed];; +[%%expect{| +Line 1, characters 12-26: +1 | type t5_6 = A of t_float64 [@@unboxed];; + ^^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64. + Variants may not yet contain types of this layout. +|}];; + +type ('a : float64) t5_7 = A of int +type ('a : float64) t5_8 = A of 'a;; +[%%expect{| +type ('a : float64) t5_7 = A of int +Line 2, characters 27-34: +2 | type ('a : float64) t5_8 = A of 'a;; + ^^^^^^^ +Error: Type 'a has layout float64. + Variants may not yet contain types of this layout. +|}] + +type ('a : float64, 'b : float64) t5_9 = {x : 'a; y : 'b; z : 'a} + +type 'a t5_10 = 'a t_float64_id +and 'a t5_11 = {x : 'a t5_10; y : 'a} + +type ('a : float64) t5_12 = {x : 'a; y : float#};; +[%%expect{| +type ('a : float64, 'b : float64) t5_9 = { x : 'a; y : 'b; z : 'a; } +Line 4, characters 20-28: +4 | and 'a t5_11 = {x : 'a t5_10; y : 'a} + ^^^^^^^^ +Error: Layout mismatch in final type declaration consistency check. + This is most often caused by the fact that type inference is not + clever enough to propagate layouts through variables in different + declarations. It is also not clever enough to produce a good error + message, so we'll say this instead: + 'a has layout float64, which does not overlap with value. + The fix will likely be to add a layout annotation on a parameter to + the declaration where this error is reported. +|}];; + +type ('a : float64) t5_13 = {x : 'a; y : float#};; +[%%expect{| +type ('a : float64) t5_13 = { x : 'a; y : float#; } +|}];; + +type 'a t5_14 = {x : 'a; y : float#};; +[%%expect{| +Line 1, characters 0-36: +1 | type 'a t5_14 = {x : 'a; y : float#};; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Records may not contain both unboxed floats and normal values. +|}];; + +type ufref = { mutable contents : float# };; +[%%expect{| +type ufref = { mutable contents : float#; } +|}];; + +(****************************************************) +(* Test 6: Can't be put at top level of signatures. *) +module type S6_1 = sig val x : t_float64 end + +let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; +[%%expect{| +Line 1, characters 31-40: +1 | module type S6_1 = sig val x : t_float64 end + ^^^^^^^^^ +Error: This type signature for x is not a value type. + x has layout float64, which is not a sublayout of value. +|}];; + +module type S6_2 = sig val x : 'a t_float64_id end +[%%expect{| +Line 1, characters 31-46: +1 | module type S6_2 = sig val x : 'a t_float64_id end + ^^^^^^^^^^^^^^^ +Error: This type signature for x is not a value type. + x has layout float64, which does not overlap with value. +|}];; + +module type S6_3 = sig val x : float# end +[%%expect{| +Line 1, characters 31-37: +1 | module type S6_3 = sig val x : float# end + ^^^^^^ +Error: This type signature for x is not a value type. + x has layout float64, which is not a sublayout of value. +|}];; + + +(*********************************************************) +(* Test 7: Can't be used as polymorphic variant argument *) +let f7_1 (x : t_float64) = `A x;; +[%%expect{| +Line 1, characters 30-31: +1 | let f7_1 (x : t_float64) = `A x;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f7_2 (x : 'a t_float64_id) = `A x;; +[%%expect{| +Line 1, characters 36-37: +1 | let f7_2 (x : 'a t_float64_id) = `A x;; + ^ +Error: This expression has type 'a t_float64_id = ('a : float64) + but an expression was expected of type ('b : value) + 'a t_float64_id has layout float64, which does not overlap with value. +|}];; + +let f7_3 (x : float#) = `A x;; +[%%expect{| +Line 1, characters 27-28: +1 | let f7_3 (x : float#) = `A x;; + ^ +Error: This expression has type float# but an expression was expected of type + ('a : value) + float# has layout float64, which is not a sublayout of value. +|}];; + +type f7_4 = [ `A of t_float64 ];; +[%%expect{| +Line 1, characters 20-29: +1 | type f7_4 = [ `A of t_float64 ];; + ^^^^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +type ('a : float64) f7_5 = [ `A of 'a ];; +[%%expect{| +Line 1, characters 35-37: +1 | type ('a : float64) f7_5 = [ `A of 'a ];; + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : float64) + 'a has layout float64, which does not overlap with value. +|}];; +(* CR layouts v2.9: This error could be improved *) + +(************************************************************) +(* Test 8: Normal polymorphic functions don't work on them. *) + +let make_t_float64 () : t_float64 = assert false +let make_t_float64_id () : 'a t_float64_id = assert false +let make_floatu () : float# = assert false + +let id_value x = x;; +[%%expect{| +val make_t_float64 : unit -> t_float64 = +val make_t_float64_id : ('a : float64). unit -> 'a t_float64_id = +val make_floatu : unit -> float# = +val id_value : 'a -> 'a = +|}];; + +let x8_1 = id_value (make_t_float64 ());; +[%%expect{| +Line 1, characters 20-39: +1 | let x8_1 = id_value (make_t_float64 ());; + ^^^^^^^^^^^^^^^^^^^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x8_2 = id_value (make_t_float64_id ());; +[%%expect{| +Line 1, characters 20-42: +1 | let x8_2 = id_value (make_t_float64_id ());; + ^^^^^^^^^^^^^^^^^^^^^^ +Error: This expression has type 'a t_float64_id = ('a : float64) + but an expression was expected of type ('b : value) + 'a t_float64_id has layout float64, which does not overlap with value. +|}];; + +let x8_3 = id_value (make_floatu ());; +[%%expect{| +Line 1, characters 20-36: +1 | let x8_3 = id_value (make_floatu ());; + ^^^^^^^^^^^^^^^^ +Error: This expression has type float# but an expression was expected of type + ('a : value) + float# has layout float64, which is not a sublayout of value. +|}];; + +(*************************************) +(* Test 9: But float64 functions do. *) + +let twice f (x : 'a t_float64_id) = f (f x) + +let f9_1 () = twice f1_1 (make_t_float64 ()) +let f9_2 () = twice f1_2 (make_t_float64_id ()) +let f9_3 () = twice f1_3 (make_floatu ());; +[%%expect{| +val twice : + ('a : float64). + ('a t_float64_id -> 'a t_float64_id) -> + 'a t_float64_id -> 'a t_float64_id = + +val f9_1 : unit -> t_float64 t_float64_id = +val f9_2 : ('a : float64). unit -> 'a t_float64_id = +val f9_3 : unit -> float# t_float64_id = +|}];; + +(**************************************************) +(* Test 10: Invalid uses of float64 and externals *) + +(* Valid uses of float64 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, + - if using a non-value layout in an external, you may not use the old-style + unboxed float directive, and + - unboxed types can't be unboxed more. +*) + +external f10_1 : int -> bool -> float# = "foo";; +[%%expect{| +Line 1, characters 0-46: +1 | external f10_1 : int -> bool -> float# = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_2 : t_float64 -> int = "foo";; +[%%expect{| +Line 1, characters 0-41: +1 | external f10_2 : t_float64 -> int = "foo";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The native code version of the primitive is mandatory + for types with non-value layouts. +|}];; + +external f10_3 : float -> t_float64 = "foo" "bar" "float";; +[%%expect{| +Line 1, characters 0-58: +1 | external f10_3 : float -> t_float64 = "foo" "bar" "float";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Cannot use "float" in conjunction with types of non-value layouts. +|}];; + +external f10_4 : int -> float# -> float = "foo" "bar" "float";; +[%%expect{| +Line 1, characters 0-62: +1 | external f10_4 : int -> float# -> float = "foo" "bar" "float";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Cannot use "float" in conjunction with types of non-value layouts. +|}];; + +external f10_5 : float# -> bool -> string = "foo" "bar" "float";; +[%%expect{| +Line 1, characters 0-64: +1 | external f10_5 : float# -> bool -> string = "foo" "bar" "float";; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Cannot use "float" in conjunction with types of non-value layouts. +|}];; + +external f10_6 : (float#[@unboxed]) -> bool -> string = "foo" "bar";; +[%%expect{| +Line 1, characters 18-24: +1 | external f10_6 : (float#[@unboxed]) -> bool -> string = "foo" "bar";; + ^^^^^^ +Error: Don't know how to unbox this type. + Only float, int32, int64, nativeint, and vector primitives can be unboxed. +|}];; + +external f10_7 : string -> (float#[@unboxed]) = "foo" "bar";; +[%%expect{| +Line 1, characters 28-34: +1 | external f10_7 : string -> (float#[@unboxed]) = "foo" "bar";; + ^^^^^^ +Error: Don't know how to unbox this type. + Only float, int32, int64, nativeint, and vector primitives can be unboxed. +|}];; + +external f10_8 : float -> float# = "foo" "bar" [@@unboxed];; +[%%expect{| +Line 1, characters 26-32: +1 | external f10_8 : float -> float# = "foo" "bar" [@@unboxed];; + ^^^^^^ +Error: Don't know how to unbox this type. + Only float, int32, int64, nativeint, and vector primitives can be unboxed. +|}];; + +(*******************************************************) +(* Test 11: Don't allow float64 in extensible variants *) + +type t11_1 = .. + +type t11_1 += A of t_float64;; +[%%expect{| +type t11_1 = .. +Line 3, characters 14-28: +3 | type t11_1 += A of t_float64;; + ^^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64. + Variants may not yet contain types of this layout. +|}] + +type t11_1 += B of float#;; +[%%expect{| +Line 1, characters 14-25: +1 | type t11_1 += B of float#;; + ^^^^^^^^^^^ +Error: Type float# has layout float64. + Variants may not yet contain types of this layout. +|}] + +type ('a : float64) t11_2 = .. + +type 'a t11_2 += A of int + +type 'a t11_2 += B of 'a;; + +[%%expect{| +type ('a : float64) t11_2 = .. +type 'a t11_2 += A of int +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Type 'a has layout float64. + Variants may not yet contain types of this layout. +|}] + +(***************************************) +(* Test 12: float64 in objects/classes *) + +(* First, disallowed uses: in object types, class parameters, etc. *) +type t12_1 = < x : t_float64 >;; +[%%expect{| +Line 1, characters 15-28: +1 | type t12_1 = < x : t_float64 >;; + ^^^^^^^^^^^^^ +Error: Object field types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +type ('a : float64) t12_2 = < x : 'a >;; +[%%expect{| +Line 1, characters 34-36: +1 | type ('a : float64) t12_2 = < x : 'a >;; + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : float64) + 'a has layout float64, which does not overlap with value. +|}] + +class c12_3 = object method x : t_float64 = assert false end;; +[%%expect{| +Line 1, characters 21-56: +1 | class c12_3 = object method x : t_float64 = assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The method x has type t_float64 but is expected to have type + ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +class ['a] c12_4 = object + method x : 'a t_float64_id -> 'a t_float64_id = assert false +end;; +[%%expect{| +Line 2, characters 13-15: +2 | method x : 'a t_float64_id -> 'a t_float64_id = assert false + ^^ +Error: This type ('a : float64) should be an instance of type ('a0 : value) + 'a has layout value, which does not overlap with float64. +|}];; +(* CR layouts v2.9: Error could be improved *) + +class c12_5 = object val x : t_float64 = assert false end;; +[%%expect{| +Line 1, characters 25-26: +1 | class c12_5 = object val x : t_float64 = assert false end;; + ^ +Error: Variables bound in a class must have layout value. + x has layout float64, which is not a sublayout of value. +|}];; + +class type c12_6 = object method x : float# end;; +[%%expect{| +Line 1, characters 26-43: +1 | class type c12_6 = object method x : float# end;; + ^^^^^^^^^^^^^^^^^ +Error: The method x has type float# but is expected to have type ('a : value) + float# has layout float64, which is not a sublayout of value. +|}];; +(* CR layouts v2.9: Error could be improved *) + +class type c12_7 = object val x : float# end +[%%expect{| +Line 1, characters 26-40: +1 | class type c12_7 = object val x : float# end + ^^^^^^^^^^^^^^ +Error: Variables bound in a class must have layout value. + x has layout float64, which is not a sublayout of value. +|}];; + +class type ['a] c12_8 = object + val x : 'a t_float64_id -> 'a t_float64_id +end +[%%expect{| +Line 2, characters 10-12: +2 | val x : 'a t_float64_id -> 'a t_float64_id + ^^ +Error: This type ('a : float64) should be an instance of type ('a0 : value) + 'a has layout value, which does not overlap with float64. +|}];; + +(* Second, allowed uses: as method parameters / returns *) +type t12_8 = < f : t_float64 -> t_float64 > +let f12_9 (o : t12_8) x = o#f x +let f12_10 o (y : t_float64) : t_float64 = o#baz y y y;; +class ['a] c12_11 = object + method x : t_float64 -> 'a = assert false +end;; +class ['a] c12_12 = object + method x : 'a -> t_float64 = assert false +end;; +[%%expect{| +type t12_8 = < f : t_float64 -> t_float64 > +val f12_9 : t12_8 -> t_float64 -> t_float64 = +val f12_10 : + < baz : t_float64 -> t_float64 -> t_float64 -> t_float64; .. > -> + t_float64 -> t_float64 = +class ['a] c12_11 : object method x : t_float64 -> 'a end +class ['a] c12_12 : object method x : 'a -> t_float64 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_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f12_14 (m1 : t_float64) (m2 : t_float64) = 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. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +(*********************************************************************) +(* Test 13: Ad-hoc polymorphic operations don't work on float64 yet. *) + +(* CR layouts v5: Remember to handle the case of calling these on structures + containing other layouts. *) + +let f13_1 (x : t_float64) = x = x;; +[%%expect{| +Line 1, characters 28-29: +1 | let f13_1 (x : t_float64) = x = x;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f13_2 (x : t_float64) = compare x x;; +[%%expect{| +Line 1, characters 36-37: +1 | let f13_2 (x : t_float64) = compare x x;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f13_3 (x : t_float64) = Marshal.to_bytes x;; +[%%expect{| +Line 1, characters 45-46: +1 | let f13_3 (x : t_float64) = Marshal.to_bytes x;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f13_4 (x : t_float64) = Hashtbl.hash x;; +[%%expect{| +Line 1, characters 41-42: +1 | let f13_4 (x : t_float64) = Hashtbl.hash x;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +(***********************************************************) +(* Test 14: unboxed float records work like normal records *) + +module FU = Stdlib__Float_u + +type t14_1 = { x : float#; y : float# } + +(* pattern matching *) +let f14_1 {x;y} = FU.sub x y + +(* construction *) +let r14 = { x = FU.of_float 3.14; y = FU.of_float 2.72 } + +let sum14_1 = FU.to_float (f14_1 r14) + +(* projection *) +let f14_2 ({y;_} as r) = FU.sub r.x y + +let sum14_2 = FU.to_float (f14_1 r14) + +type t14_2 = { mutable a : float#; b : float#; mutable c : float# } + +let f14_3 ({b; c; _} as r) = + (* pure record update *) + let r' = { r with b = FU.of_float 20.0; c = r.a } in + (* mutation *) + r.a <- FU.sub r.a r'.b; + r'.a <- FU.of_float 42.0; + r' + +let a, b, c, a', b', c' = + let r = {a = FU.of_float 3.1; b = FU.of_float (-0.42); c = FU.of_float 27.7 } in + let r' = f14_3 r in + FU.to_float r.a, + FU.to_float r.b, + FU.to_float r.c, + FU.to_float r'.a, + FU.to_float r'.b, + FU.to_float r'.c + +let f14_4 r = + let {x; y} = r in + FU.add x y + + +[%%expect{| +module FU = Stdlib__Float_u +type t14_1 = { x : float#; y : float#; } +val f14_1 : t14_1 -> float# = +val r14 : t14_1 = {x = ; y = } +val sum14_1 : float = 0.419999999999999929 +val f14_2 : t14_1 -> float# = +val sum14_2 : float = 0.419999999999999929 +type t14_2 = { mutable a : float#; b : float#; mutable c : float#; } +val f14_3 : t14_2 -> t14_2 = +val a : float = -16.9 +val b : float = -0.42 +val c : float = 27.7 +val a' : float = 42. +val b' : float = 20. +val c' : float = 3.1 +val f14_4 : t14_1 -> float# = |}] diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics_alpha_beta.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics_alpha_beta.ml deleted file mode 100644 index 43da4844429..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics_alpha_beta.ml +++ /dev/null @@ -1,798 +0,0 @@ -(* TEST - * expect - flags = "-extension layouts_alpha" - * expect - flags = "-extension layouts_beta" -*) - -(* This file contains typing tests for the layout [float64]. - - Runtime tests for the type [float#] can be found in the [unboxed_float] and - [alloc] tests in this directory. The type [float#] here is used as a - convenient example of a concrete [float64] type in some tests, but its - behavior isn't the primary purpose of this test. *) - -type t_float64 [@@float64] -type ('a : float64) t_float64_id = 'a - -(*********************************) -(* Test 1: The identity function *) - -let f1_1 (x : t_float64) = x;; -let f1_2 (x : 'a t_float64_id) = x;; -let f1_3 (x : float#) = x;; -[%%expect{| -type t_float64 : float64 -type ('a : float64) t_float64_id = 'a -val f1_1 : t_float64 -> t_float64 = -val f1_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = -val f1_3 : float# -> float# = -|}];; - -(*****************************************) -(* Test 2: You can let-bind them locally *) -let f2_1 (x : t_float64) = - let y = x in - y;; - -let f2_2 (x : 'a t_float64_id) = - let y = x in - y;; - -let f2_3 (x : float#) = - let y = x in - y;; -[%%expect{| -val f2_1 : t_float64 -> t_float64 = -val f2_2 : ('a : float64). 'a t_float64_id -> 'a t_float64_id = -val f2_3 : float# -> float# = -|}];; - -(*****************************************) -(* Test 3: No module-level bindings yet. *) - -let x3_1 : t_float64 = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_1 : t_float64 = assert false;; - ^^^^ -Error: Top-level module bindings must have layout value, but x3_1 has layout - float64. -|}];; - -let x3_2 : 'a t_float64_id = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_2 : 'a t_float64_id = assert false;; - ^^^^ -Error: Top-level module bindings must have layout value, but x3_2 has layout - float64. -|}];; - -let x3_3 : float# = assert false;; -[%%expect{| -Line 1, characters 4-8: -1 | let x3_3 : float# = assert false;; - ^^^^ -Error: Top-level module bindings must have layout value, but x3_3 has layout - float64. -|}];; - -module M3_4 = struct - let x : t_float64 = assert false -end -[%%expect{| -Line 2, characters 6-7: -2 | let x : t_float64 = assert false - ^ -Error: Top-level module bindings must have layout value, but x has layout - float64. -|}];; - -module M3_5 = struct - let f (x : float#) = x - - let y = f (assert false) -end -[%%expect{| -Line 4, characters 6-7: -4 | let y = f (assert false) - ^ -Error: Top-level module bindings must have layout value, but y has layout - float64. -|}];; - -(*************************************) -(* Test 4: No putting them in tuples *) - -let f4_1 (x : t_float64) = x, false;; -[%%expect{| -Line 1, characters 27-28: -1 | let f4_1 (x : t_float64) = x, false;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f4_2 (x : 'a t_float64_id) = x, false;; -[%%expect{| -Line 1, characters 33-34: -1 | let f4_2 (x : 'a t_float64_id) = x, false;; - ^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - 'a t_float64_id has layout float64, which does not overlap with value. -|}];; - -let f4_3 (x : float#) = x, false;; -[%%expect{| -Line 1, characters 24-25: -1 | let f4_3 (x : float#) = x, false;; - ^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - float# has layout float64, which is not a sublayout of value. -|}];; - -type t4_4 = t_float64 * string;; -[%%expect{| -Line 1, characters 12-21: -1 | type t4_4 = t_float64 * string;; - ^^^^^^^^^ -Error: Tuple element types must have layout value. - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -type t4_5 = int * float#;; -[%%expect{| -Line 1, characters 18-24: -1 | type t4_5 = int * float#;; - ^^^^^^ -Error: Tuple element types must have layout value. - float# has layout float64, which is not a sublayout of value. -|}];; - -type ('a : float64) t4_6 = 'a * 'a -[%%expect{| -Line 1, characters 27-29: -1 | type ('a : float64) t4_6 = 'a * 'a - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - 'a has layout float64, which does not overlap with value. -|}];; - -(* check for layout propagation *) -type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; -[%%expect{| -Line 1, characters 32-34: -1 | type ('a : float64, 'b) t4_7 = ('a as 'b) -> ('b * 'b);; - ^^ -Error: This type ('b : value) should be an instance of type ('a : float64) - 'a has layout float64, which does not overlap with value. -|}] - -(******************************************************************************) -(* Test 5: Can't be put in structures in typedecls, except all-float records. *) - -type t5_1 = { x : t_float64 };; -[%%expect{| -type t5_1 = { x : t_float64; } -|}];; - -(* CR layouts v5: this should work *) -type t5_2 = { y : int; x : t_float64 };; -[%%expect{| -Line 1, characters 0-38: -1 | type t5_2 = { y : int; x : t_float64 };; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Records may not contain both unboxed floats and normal values. -|}];; - -(* CR layouts: this runs afoul of the mixed block restriction, but should work - once we relax that. *) -type t5_2' = { y : string; x : t_float64 };; -[%%expect{| -Line 1, characters 0-42: -1 | type t5_2' = { y : string; x : t_float64 };; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Records may not contain both unboxed floats and normal values. -|}];; - -(* CR layouts 2.5: allow this *) -type t5_3 = { x : t_float64 } [@@unboxed];; -[%%expect{| -Line 1, characters 14-27: -1 | type t5_3 = { x : t_float64 } [@@unboxed];; - ^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Unboxed records may not yet contain types of this layout. -|}];; - -type t5_4 = A of t_float64;; -[%%expect{| -Line 1, characters 12-26: -1 | type t5_4 = A of t_float64;; - ^^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Variants may not yet contain types of this layout. -|}];; - -type t5_5 = A of int * t_float64;; -[%%expect{| -Line 1, characters 12-32: -1 | type t5_5 = A of int * t_float64;; - ^^^^^^^^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Variants may not yet contain types of this layout. -|}];; - -type t5_6 = A of t_float64 [@@unboxed];; -[%%expect{| -Line 1, characters 12-26: -1 | type t5_6 = A of t_float64 [@@unboxed];; - ^^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Variants may not yet contain types of this layout. -|}];; - -type ('a : float64) t5_7 = A of int -type ('a : float64) t5_8 = A of 'a;; -[%%expect{| -type ('a : float64) t5_7 = A of int -Line 2, characters 27-34: -2 | type ('a : float64) t5_8 = A of 'a;; - ^^^^^^^ -Error: Type 'a has layout float64. - Variants may not yet contain types of this layout. -|}] - -type ('a : float64, 'b : float64) t5_9 = {x : 'a; y : 'b; z : 'a} - -type 'a t5_10 = 'a t_float64_id -and 'a t5_11 = {x : 'a t5_10; y : 'a} - -type ('a : float64) t5_12 = {x : 'a; y : float#};; -[%%expect{| -type ('a : float64, 'b : float64) t5_9 = { x : 'a; y : 'b; z : 'a; } -Line 4, characters 20-28: -4 | and 'a t5_11 = {x : 'a t5_10; y : 'a} - ^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - 'a has layout float64, which does not overlap with value. - The fix will likely be to add a layout annotation on a parameter to - the declaration where this error is reported. -|}];; - -type ('a : float64) t5_13 = {x : 'a; y : float#};; -[%%expect{| -type ('a : float64) t5_13 = { x : 'a; y : float#; } -|}];; - -type 'a t5_14 = {x : 'a; y : float#};; -[%%expect{| -Line 1, characters 0-36: -1 | type 'a t5_14 = {x : 'a; y : float#};; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Records may not contain both unboxed floats and normal values. -|}];; - -type ufref = { mutable contents : float# };; -[%%expect{| -type ufref = { mutable contents : float#; } -|}];; - -(****************************************************) -(* Test 6: Can't be put at top level of signatures. *) -module type S6_1 = sig val x : t_float64 end - -let f6 (m : (module S6_1)) = let module M6 = (val m) in M6.x;; -[%%expect{| -Line 1, characters 31-40: -1 | module type S6_1 = sig val x : t_float64 end - ^^^^^^^^^ -Error: This type signature for x is not a value type. - x has layout float64, which is not a sublayout of value. -|}];; - -module type S6_2 = sig val x : 'a t_float64_id end -[%%expect{| -Line 1, characters 31-46: -1 | module type S6_2 = sig val x : 'a t_float64_id end - ^^^^^^^^^^^^^^^ -Error: This type signature for x is not a value type. - x has layout float64, which does not overlap with value. -|}];; - -module type S6_3 = sig val x : float# end -[%%expect{| -Line 1, characters 31-37: -1 | module type S6_3 = sig val x : float# end - ^^^^^^ -Error: This type signature for x is not a value type. - x has layout float64, which is not a sublayout of value. -|}];; - - -(*********************************************************) -(* Test 7: Can't be used as polymorphic variant argument *) -let f7_1 (x : t_float64) = `A x;; -[%%expect{| -Line 1, characters 30-31: -1 | let f7_1 (x : t_float64) = `A x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f7_2 (x : 'a t_float64_id) = `A x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f7_2 (x : 'a t_float64_id) = `A x;; - ^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - 'a t_float64_id has layout float64, which does not overlap with value. -|}];; - -let f7_3 (x : float#) = `A x;; -[%%expect{| -Line 1, characters 27-28: -1 | let f7_3 (x : float#) = `A x;; - ^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - float# has layout float64, which is not a sublayout of value. -|}];; - -type f7_4 = [ `A of t_float64 ];; -[%%expect{| -Line 1, characters 20-29: -1 | type f7_4 = [ `A of t_float64 ];; - ^^^^^^^^^ -Error: Polymorphic variant constructor argument types must have layout value. - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -type ('a : float64) f7_5 = [ `A of 'a ];; -[%%expect{| -Line 1, characters 35-37: -1 | type ('a : float64) f7_5 = [ `A of 'a ];; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - 'a has layout float64, which does not overlap with value. -|}];; -(* CR layouts v2.9: This error could be improved *) - -(************************************************************) -(* Test 8: Normal polymorphic functions don't work on them. *) - -let make_t_float64 () : t_float64 = assert false -let make_t_float64_id () : 'a t_float64_id = assert false -let make_floatu () : float# = assert false - -let id_value x = x;; -[%%expect{| -val make_t_float64 : unit -> t_float64 = -val make_t_float64_id : ('a : float64). unit -> 'a t_float64_id = -val make_floatu : unit -> float# = -val id_value : 'a -> 'a = -|}];; - -let x8_1 = id_value (make_t_float64 ());; -[%%expect{| -Line 1, characters 20-39: -1 | let x8_1 = id_value (make_t_float64 ());; - ^^^^^^^^^^^^^^^^^^^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let x8_2 = id_value (make_t_float64_id ());; -[%%expect{| -Line 1, characters 20-42: -1 | let x8_2 = id_value (make_t_float64_id ());; - ^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a t_float64_id = ('a : float64) - but an expression was expected of type ('b : value) - 'a t_float64_id has layout float64, which does not overlap with value. -|}];; - -let x8_3 = id_value (make_floatu ());; -[%%expect{| -Line 1, characters 20-36: -1 | let x8_3 = id_value (make_floatu ());; - ^^^^^^^^^^^^^^^^ -Error: This expression has type float# but an expression was expected of type - ('a : value) - float# has layout float64, which is not a sublayout of value. -|}];; - -(*************************************) -(* Test 9: But float64 functions do. *) - -let twice f (x : 'a t_float64_id) = f (f x) - -let f9_1 () = twice f1_1 (make_t_float64 ()) -let f9_2 () = twice f1_2 (make_t_float64_id ()) -let f9_3 () = twice f1_3 (make_floatu ());; -[%%expect{| -val twice : - ('a : float64). - ('a t_float64_id -> 'a t_float64_id) -> - 'a t_float64_id -> 'a t_float64_id = - -val f9_1 : unit -> t_float64 t_float64_id = -val f9_2 : ('a : float64). unit -> 'a t_float64_id = -val f9_3 : unit -> float# t_float64_id = -|}];; - -(**************************************************) -(* Test 10: Invalid uses of float64 and externals *) - -(* Valid uses of float64 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, - - if using a non-value layout in an external, you may not use the old-style - unboxed float directive, and - - unboxed types can't be unboxed more. -*) - -external f10_1 : int -> bool -> float# = "foo";; -[%%expect{| -Line 1, characters 0-46: -1 | external f10_1 : int -> bool -> float# = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_2 : t_float64 -> int = "foo";; -[%%expect{| -Line 1, characters 0-41: -1 | external f10_2 : t_float64 -> int = "foo";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The native code version of the primitive is mandatory - for types with non-value layouts. -|}];; - -external f10_3 : float -> t_float64 = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-58: -1 | external f10_3 : float -> t_float64 = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_4 : int -> float# -> float = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-62: -1 | external f10_4 : int -> float# -> float = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_5 : float# -> bool -> string = "foo" "bar" "float";; -[%%expect{| -Line 1, characters 0-64: -1 | external f10_5 : float# -> bool -> string = "foo" "bar" "float";; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Cannot use "float" in conjunction with types of non-value layouts. -|}];; - -external f10_6 : (float#[@unboxed]) -> bool -> string = "foo" "bar";; -[%%expect{| -Line 1, characters 18-24: -1 | external f10_6 : (float#[@unboxed]) -> bool -> string = "foo" "bar";; - ^^^^^^ -Error: Don't know how to unbox this type. - Only float, int32, int64, nativeint, and vector primitives can be unboxed. -|}];; - -external f10_7 : string -> (float#[@unboxed]) = "foo" "bar";; -[%%expect{| -Line 1, characters 28-34: -1 | external f10_7 : string -> (float#[@unboxed]) = "foo" "bar";; - ^^^^^^ -Error: Don't know how to unbox this type. - Only float, int32, int64, nativeint, and vector primitives can be unboxed. -|}];; - -external f10_8 : float -> float# = "foo" "bar" [@@unboxed];; -[%%expect{| -Line 1, characters 26-32: -1 | external f10_8 : float -> float# = "foo" "bar" [@@unboxed];; - ^^^^^^ -Error: Don't know how to unbox this type. - Only float, int32, int64, nativeint, and vector primitives can be unboxed. -|}];; - -(*******************************************************) -(* Test 11: Don't allow float64 in extensible variants *) - -type t11_1 = .. - -type t11_1 += A of t_float64;; -[%%expect{| -type t11_1 = .. -Line 3, characters 14-28: -3 | type t11_1 += A of t_float64;; - ^^^^^^^^^^^^^^ -Error: Type t_float64 has layout float64. - Variants may not yet contain types of this layout. -|}] - -type t11_1 += B of float#;; -[%%expect{| -Line 1, characters 14-25: -1 | type t11_1 += B of float#;; - ^^^^^^^^^^^ -Error: Type float# has layout float64. - Variants may not yet contain types of this layout. -|}] - -type ('a : float64) t11_2 = .. - -type 'a t11_2 += A of int - -type 'a t11_2 += B of 'a;; - -[%%expect{| -type ('a : float64) t11_2 = .. -type 'a t11_2 += A of int -Line 5, characters 17-24: -5 | type 'a t11_2 += B of 'a;; - ^^^^^^^ -Error: Type 'a has layout float64. - Variants may not yet contain types of this layout. -|}] - -(***************************************) -(* Test 12: float64 in objects/classes *) - -(* First, disallowed uses: in object types, class parameters, etc. *) -type t12_1 = < x : t_float64 >;; -[%%expect{| -Line 1, characters 15-28: -1 | type t12_1 = < x : t_float64 >;; - ^^^^^^^^^^^^^ -Error: Object field types must have layout value. - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -type ('a : float64) t12_2 = < x : 'a >;; -[%%expect{| -Line 1, characters 34-36: -1 | type ('a : float64) t12_2 = < x : 'a >;; - ^^ -Error: This type ('a : value) should be an instance of type ('a0 : float64) - 'a has layout float64, which does not overlap with value. -|}] - -class c12_3 = object method x : t_float64 = assert false end;; -[%%expect{| -Line 1, characters 21-56: -1 | class c12_3 = object method x : t_float64 = assert false end;; - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The method x has type t_float64 but is expected to have type - ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -class ['a] c12_4 = object - method x : 'a t_float64_id -> 'a t_float64_id = assert false -end;; -[%%expect{| -Line 2, characters 13-15: -2 | method x : 'a t_float64_id -> 'a t_float64_id = assert false - ^^ -Error: This type ('a : float64) should be an instance of type ('a0 : value) - 'a has layout value, which does not overlap with float64. -|}];; -(* CR layouts v2.9: Error could be improved *) - -class c12_5 = object val x : t_float64 = assert false end;; -[%%expect{| -Line 1, characters 25-26: -1 | class c12_5 = object val x : t_float64 = assert false end;; - ^ -Error: Variables bound in a class must have layout value. - x has layout float64, which is not a sublayout of value. -|}];; - -class type c12_6 = object method x : float# end;; -[%%expect{| -Line 1, characters 26-43: -1 | class type c12_6 = object method x : float# end;; - ^^^^^^^^^^^^^^^^^ -Error: The method x has type float# but is expected to have type ('a : value) - float# has layout float64, which is not a sublayout of value. -|}];; -(* CR layouts v2.9: Error could be improved *) - -class type c12_7 = object val x : float# end -[%%expect{| -Line 1, characters 26-40: -1 | class type c12_7 = object val x : float# end - ^^^^^^^^^^^^^^ -Error: Variables bound in a class must have layout value. - x has layout float64, which is not a sublayout of value. -|}];; - -class type ['a] c12_8 = object - val x : 'a t_float64_id -> 'a t_float64_id -end -[%%expect{| -Line 2, characters 10-12: -2 | val x : 'a t_float64_id -> 'a t_float64_id - ^^ -Error: This type ('a : float64) should be an instance of type ('a0 : value) - 'a has layout value, which does not overlap with float64. -|}];; - -(* Second, allowed uses: as method parameters / returns *) -type t12_8 = < f : t_float64 -> t_float64 > -let f12_9 (o : t12_8) x = o#f x -let f12_10 o (y : t_float64) : t_float64 = o#baz y y y;; -class ['a] c12_11 = object - method x : t_float64 -> 'a = assert false -end;; -class ['a] c12_12 = object - method x : 'a -> t_float64 = assert false -end;; -[%%expect{| -type t12_8 = < f : t_float64 -> t_float64 > -val f12_9 : t12_8 -> t_float64 -> t_float64 = -val f12_10 : - < baz : t_float64 -> t_float64 -> t_float64 -> t_float64; .. > -> - t_float64 -> t_float64 = -class ['a] c12_11 : object method x : t_float64 -> 'a end -class ['a] c12_12 : object method x : 'a -> t_float64 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_float64 - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f12_14 (m1 : t_float64) (m2 : t_float64) = 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. - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -(*********************************************************************) -(* Test 13: Ad-hoc polymorphic operations don't work on float64 yet. *) - -(* CR layouts v5: Remember to handle the case of calling these on structures - containing other layouts. *) - -let f13_1 (x : t_float64) = x = x;; -[%%expect{| -Line 1, characters 28-29: -1 | let f13_1 (x : t_float64) = x = x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f13_2 (x : t_float64) = compare x x;; -[%%expect{| -Line 1, characters 36-37: -1 | let f13_2 (x : t_float64) = compare x x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f13_3 (x : t_float64) = Marshal.to_bytes x;; -[%%expect{| -Line 1, characters 45-46: -1 | let f13_3 (x : t_float64) = Marshal.to_bytes x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -let f13_4 (x : t_float64) = Hashtbl.hash x;; -[%%expect{| -Line 1, characters 41-42: -1 | let f13_4 (x : t_float64) = Hashtbl.hash x;; - ^ -Error: This expression has type t_float64 - but an expression was expected of type ('a : value) - t_float64 has layout float64, which is not a sublayout of value. -|}];; - -(***********************************************************) -(* Test 14: unboxed float records work like normal records *) - -module FU = Stdlib__Float_u - -type t14_1 = { x : float#; y : float# } - -(* pattern matching *) -let f14_1 {x;y} = FU.sub x y - -(* construction *) -let r14 = { x = FU.of_float 3.14; y = FU.of_float 2.72 } - -let sum14_1 = FU.to_float (f14_1 r14) - -(* projection *) -let f14_2 ({y;_} as r) = FU.sub r.x y - -let sum14_2 = FU.to_float (f14_1 r14) - -type t14_2 = { mutable a : float#; b : float#; mutable c : float# } - -let f14_3 ({b; c; _} as r) = - (* pure record update *) - let r' = { r with b = FU.of_float 20.0; c = r.a } in - (* mutation *) - r.a <- FU.sub r.a r'.b; - r'.a <- FU.of_float 42.0; - r' - -let a, b, c, a', b', c' = - let r = {a = FU.of_float 3.1; b = FU.of_float (-0.42); c = FU.of_float 27.7 } in - let r' = f14_3 r in - FU.to_float r.a, - FU.to_float r.b, - FU.to_float r.c, - FU.to_float r'.a, - FU.to_float r'.b, - FU.to_float r'.c - -let f14_4 r = - let {x; y} = r in - FU.add x y - - -[%%expect{| -module FU = Stdlib__Float_u -type t14_1 = { x : float#; y : float#; } -val f14_1 : t14_1 -> float# = -val r14 : t14_1 = {x = ; y = } -val sum14_1 : float = 0.419999999999999929 -val f14_2 : t14_1 -> float# = -val sum14_2 : float = 0.419999999999999929 -type t14_2 = { mutable a : float#; b : float#; mutable c : float#; } -val f14_3 : t14_2 -> t14_2 = -val a : float = -16.9 -val b : float = -0.42 -val c : float = 27.7 -val a' : float = 42. -val b' : float = 20. -val c' : float = 3.1 -val f14_4 : t14_1 -> float# = -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml b/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml index 1f4dd450264..b1231d1658e 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats.ml @@ -9,12 +9,17 @@ flags = "-extension layouts_beta" ** bytecode flags = "-extension layouts_beta" + ** native + flags = "-extension layouts" + ** bytecode + flags = "-extension layouts" ** setup-ocamlc.byte-build-env ocamlc_byte_exit_status = "2" - flags = "-extension layouts" *** ocamlc.byte compiler_reference = "${test_source_directory}/unboxed_floats_disabled.compilers.reference" **** check-ocamlc.byte-output + + *) (* mshinwell: This test is now only run with flambda2, as the corresponding diff --git a/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference b/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference index 2cd2503c7c8..4218268df18 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference +++ b/ocaml/testsuite/tests/typing-layouts-float64/unboxed_floats_disabled.compilers.reference @@ -1,4 +1,4 @@ -File "unboxed_floats.ml", line 321, characters 25-31: -321 | let ( let* ) x (f : _ -> float#) = f x +File "unboxed_floats.ml", line 326, characters 25-31: +326 | let ( let* ) x (f : _ -> float#) = f x ^^^^^^ -Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used +Error: This construct requires the stable version of the extension "layouts", which is disabled and cannot be used diff --git a/ocaml/testsuite/tests/typing-layouts/annots.ml b/ocaml/testsuite/tests/typing-layouts/annots.ml index a40c545e65c..ce813ae96f6 100644 --- a/ocaml/testsuite/tests/typing-layouts/annots.ml +++ b/ocaml/testsuite/tests/typing-layouts/annots.ml @@ -1,33 +1,29 @@ (* TEST * expect flags = "-extension layouts" + * expect + flags = "-extension layouts_beta" *) - type t_value : value type t_imm : immediate type t_imm64 : immediate64 -;; +type t_float64 : float64 +type t_any : any;; + [%%expect{| type t_value : value type t_imm : immediate type t_imm64 : immediate64 -|}];; - -type t_any : any;; - -[%%expect{| -Line 1, characters 13-16: -1 | type t_any : any;; - ^^^ -Error: Layout any is used here, but the appropriate layouts extension is not enabled +type t_float64 : float64 +type t_any : any |}] -type t_void : void +type t_void : void;; [%%expect{| Line 1, characters 14-18: -1 | type t_void : void +1 | type t_void : void;; ^^^^ Error: Layout void is used here, but the appropriate layouts extension is not enabled |}] @@ -35,60 +31,52 @@ Error: Layout void is used here, but the appropriate layouts extension is not en (***************************************) (* Test 1: annotation on type variable *) -let x : int as ('a : value) = 5 +let x : int as ('a: value) = 5 let x : int as ('a : immediate) = 5 -;; -[%%expect {| -val x : int = 5 -Line 2, characters 21-30: -2 | let x : int as ('a : immediate) = 5 - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. -|}] -(* CR layouts: fix when [immediate] becomes available in [layouts] *) - let x : int as ('a : any) = 5;; [%%expect{| -Line 1, characters 21-24: -1 | let x : int as ('a : any) = 5;; - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val x : int = 5 +val x : int = 5 +val x : int = 5 +|}] + +let x : int as ('a : float64) = 5;; +[%%expect {| +Line 1, characters 8-29: +1 | let x : int as ('a : float64) = 5;; + ^^^^^^^^^^^^^^^^^^^^^ +Error: This alias is bound to type int but is used as an instance of type + ('a : float64) + int has layout immediate, which is not a sublayout of float64. |}] -(* CR layouts: fix when [any] becomes available in [layouts] *) let x : (int as ('a : immediate)) list as ('b : value) = [3;4;5] ;; [%%expect {| -Line 1, characters 22-31: -1 | let x : (int as ('a : immediate)) list as ('b : value) = [3;4;5] - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val x : int list = [3; 4; 5] |}] let x : int list as ('a : immediate) = [3;4;5] ;; [%%expect {| -Line 1, characters 26-35: +Line 1, characters 8-36: 1 | let x : int list as ('a : immediate) = [3;4;5] - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This alias is bound to type int list + but is used as an instance of type ('a : immediate) + int list has layout value, which is not a sublayout of immediate. |}] +(* CR layouts: error message could be phrased better *) (****************************************) (* Test 2: Annotation on type parameter *) -(* CR layouts: move over beta tests once [immediate] is allowed in [layouts] *) - type ('a : value) t2 type (_ : value) t2' type t3 = int t2 type t4 = bool t2 -;; + [%%expect {| type 'a t2 type _ t2' @@ -96,6 +84,31 @@ type t3 = int t2 type t4 = bool t2 |}] +type t = string t2 +;; +[%%expect {| +type t = string t2 +|}] + +type ('a : immediate) t2_imm +type (_ : immediate) t2_imm' +type t1 = int t2_imm +type t2' = bool t2_imm +type ('a : float64) t2_float64 +type (_ : float64) t2_float64' +type t3 = float# t2_float64 + + +[%%expect {| +type ('a : immediate) t2_imm +type (_ : immediate) t2_imm' +type t1 = int t2_imm +type t2' = bool t2_imm +type ('a : float64) t2_float64 +type (_ : float64) t2_float64' +type t3 = float# t2_float64 +|}] + module M1 : sig type ('a : value) t end = struct @@ -113,10 +126,107 @@ module M1 : sig type 'a t end module M2 : sig type _ t end |}] -type t = string t2 +module M1 : sig + type ('a : immediate) t +end = struct + type (_ : immediate) t +end + +module M2 : sig + type (_ : immediate) t +end = struct + type ('a : immediate) t +end + +[%%expect {| +module M1 : sig type ('a : immediate) t end +module M2 : sig type (_ : immediate) t end +|}] + +type t = string t2_imm ;; [%%expect {| -type t = string t2 +Line 1, characters 9-15: +1 | type t = string t2_imm + ^^^^^^ +Error: This type string should be an instance of type ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] + +let f : 'a t2_imm -> 'a t2_imm = fun x -> x +;; +[%%expect {| +val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = +|}] + +let f : ('a : immediate) t2_imm -> ('a : value) t2_imm = fun x -> x +;; +[%%expect {| +val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = +|}] + +let f : ('a : value) t2_imm -> ('a : value) t2_imm = fun x -> x +;; +[%%expect {| +val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = +|}] + +let f : ('a : immediate). 'a t2_imm -> 'a t2_imm = fun x -> x +;; +[%%expect {| +val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = +|}] + +let f : ('a : value). 'a t2_imm -> 'a t2_imm = fun x -> x +;; +[%%expect {| +Line 1, characters 8-44: +1 | let f : ('a : value). 'a t2_imm -> 'a t2_imm = fun x -> x + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The universal type variable 'a was declared to have + layout value, but was inferred to have layout immediate. +|}] + +type 'a t = 'a t2_imm +;; +[%%expect {| +type ('a : immediate) t = 'a t2_imm +|}] + +type ('a : value) t = 'a t2_imm +;; +[%%expect {| +type ('a : immediate) t = 'a t2_imm +|}] + +type ('a : immediate) t = 'a t2_imm +;; +[%%expect {| +type ('a : immediate) t = 'a t2_imm +|}] + +let f : (_ : value) t2_imm -> unit = fun _ -> () +let g : (_ : immediate) t2_imm -> unit = fun _ -> () + +[%%expect {| +val f : ('a : immediate). 'a t2_imm -> unit = +val g : ('a : immediate). 'a t2_imm -> unit = +|}] + +let f : (_ : immediate) -> unit = fun _ -> () +let g : (_ : value) -> unit = fun _ -> () + +[%%expect {| +val f : ('a : immediate). 'a -> unit = +val g : 'a -> unit = +|}] + +let f : (_ : immediate) -> (_ : value) = fun _ -> assert false +let g : (_ : value) -> (_ : immediate) = fun _ -> assert false + +[%%expect {| +val f : 'b ('a : immediate). 'a -> 'b = +val g : ('b : immediate) 'a. 'a -> 'b = |}] (********************************************) @@ -125,37 +235,113 @@ type t = string t2 let f : ('a : any) -> 'a = fun x -> x ;; [%%expect {| -Line 1, characters 14-17: -1 | let f : ('a : any) -> 'a = fun x -> x - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : 'a -> 'a = |}] let f : ('a : any). 'a -> 'a = fun x -> x ;; [%%expect {| -Line 1, characters 14-17: +Line 1, characters 8-28: 1 | let f : ('a : any). 'a -> 'a = fun x -> x - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. + ^^^^^^^^^^^^^^^^^^^^ +Error: The universal type variable 'a was declared to have + layout any, but was inferred to have a representable layout. +|}] +(* CR layouts v2.5: This error message should change to complain + about the [fun x], not the arrow type. *) + +let f : ('a : float64). 'a -> 'a = fun x -> x +;; +[%%expect {| +val f : ('a : float64). 'a -> 'a = |}] -(* CR layouts: fix when [any] becomes available in [layouts] *) (********************************************) (* Test 4: Annotation on record field types *) type r = { field : ('a : immediate). 'a -> 'a } +let f { field } = field 5 +;; +[%%expect {| +type r = { field : ('a : immediate). 'a -> 'a; } +val f : r -> int = +|}] + +type rf = { fieldf : ('a : float64). 'a -> 'a } +let f { fieldf } = fieldf (Stdlib__Float_u.of_float 3.14);; +[%%expect {| +type rf = { fieldf : ('a : float64). 'a -> 'a; } +val f : rf -> float# = +|}] + +let f { field } = field "hello" +;; +[%%expect {| +Line 1, characters 24-31: +1 | let f { field } = field "hello" + ^^^^^^^ +Error: This expression has type string but an expression was expected of type + ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] + +let r = { field = fun x -> x } +let r = { field = Fun.id } +;; +[%%expect {| +val r : r = {field = } +val r : r = {field = } +|}] + +let r = { field = fun (type (a : immediate)) (x : a) -> x } +;; +[%%expect {| +val r : r = {field = } +|}] + +let r = { field = fun (type (a : value)) (x : a) -> x } +;; +[%%expect {| +val r : r = {field = } +|}] + +type r_value = { field : 'a. 'a -> 'a } +let r = { field = fun (type a : immediate) (x : a) -> x } [%%expect{| -Line 1, characters 25-34: -1 | type r = { field : ('a : immediate). 'a -> 'a } - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type r_value = { field : 'a. 'a -> 'a; } +Line 2, characters 18-55: +2 | let r = { field = fun (type a : immediate) (x : a) -> x } + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This field value has type 'b -> 'b which is less general than + 'a. 'a -> 'a + 'a has layout value, which is not a sublayout of immediate. |}] -(* CR layouts: fix when we allow annotations on field types in [layouts] *) +(* CR layouts v1.5: that's a pretty awful error message *) + +type ('a : immediate) t_imm + +type s = { f : ('a : value). 'a -> 'a u } +and 'a u = 'a t_imm + +[%%expect{| +type ('a : immediate) t_imm +Line 3, characters 15-39: +3 | type s = { f : ('a : value). 'a -> 'a u } + ^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Layout mismatch in final type declaration consistency check. + This is most often caused by the fact that type inference is not + clever enough to propagate layouts through variables in different + declarations. It is also not clever enough to produce a good error + message, so we'll say this instead: + 'a has layout value, which is not a sublayout of immediate. + The fix will likely be to add a layout annotation on a parameter to + the declaration where this error is reported. +|}] +(* CR layouts v1.5: the location on that message is wrong. But it's hard + to improve, because it comes from re-checking typedtree, where we don't + have locations any more. I conjecture the same location problem exists + when constraints aren't satisfied. *) (********************) (* Test 5: newtypes *) @@ -169,23 +355,26 @@ val f : 'a -> 'a = let f = fun (type (a : immediate)) (x : a) -> x ;; [%%expect {| -Line 1, characters 23-32: -1 | let f = fun (type (a : immediate)) (x : a) -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = +|}] + +let f = fun (type (a : float64)) (x : a) -> x +;; +[%%expect {| +val f : ('a : float64). 'a -> 'a = |}] let f = fun (type (a : any)) (x : a) -> x ;; [%%expect {| -Line 1, characters 23-26: +Line 1, characters 29-36: 1 | let f = fun (type (a : any)) (x : a) -> x - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. + ^^^^^^^ +Error: This pattern matches values of type a + but a pattern was expected which matches values of type + ('a : '_representable_layout_1) + a has layout any, which is not representable. |}] -(* CR layouts: fix when we allow annotations on newtypes in [layouts] *) (****************************************) (* Test 6: abstract universal variables *) @@ -199,27 +388,52 @@ val f : 'a -> 'a = let f : type (a : immediate). a -> a = fun x -> x ;; [%%expect {| -Line 1, characters 18-27: -1 | let f : type (a : immediate). a -> a = fun x -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = +|}] + +let f : type (a : float64). a -> a = fun x -> x +;; +[%%expect {| +val f : ('a : float64). 'a -> 'a = |}] let f : type (a : any). a -> a = fun x -> x ;; [%%expect {| -Line 1, characters 18-21: +Line 1, characters 24-30: 1 | let f : type (a : any). a -> a = fun x -> x - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. + ^^^^^^ +Error: The universal type variable 'a was declared to have + layout any, but was inferred to have a representable layout. |}] -(* CR layouts: fix when we allow annotations on newtypes in [layouts] *) +(* CR layouts v2.5: This error message will change to complain + about the fun x, not the arrow type. *) (**************************************************) (* Test 7: Defaulting universal variable to value *) +module type S = sig + val f : 'a. 'a t2_imm -> 'a t2_imm +end +;; +[%%expect {| +Line 2, characters 10-36: +2 | val f : 'a. 'a t2_imm -> 'a t2_imm + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The universal type variable 'a was defaulted to have + layout value, but was inferred to have layout immediate. +|}] + +let f : 'a. 'a t2_imm -> 'a t2_imm = fun x -> x + +[%%expect {| +Line 1, characters 8-34: +1 | let f : 'a. 'a t2_imm -> 'a t2_imm = fun x -> x + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The universal type variable 'a was defaulted to have + layout value, but was inferred to have layout immediate. +|}] + (********************************************) (* Test 8: Annotation on universal variable *) @@ -232,18 +446,42 @@ module type S = sig val f : 'a t2 -> 'a t2 end |}] module type S = sig - val f : 'a t2 -> 'a t2 - val g : ('a : immediate). 'a t2 -> 'a t2 + val f : ('a : value). 'a t2_imm -> 'a t2_imm end ;; [%%expect {| -Line 3, characters 16-25: -3 | val g : ('a : immediate). 'a t2 -> 'a t2 - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +Line 2, characters 10-46: +2 | val f : ('a : value). 'a t2_imm -> 'a t2_imm + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: The universal type variable 'a was declared to have + layout value, but was inferred to have layout immediate. +|}] + +module type S = sig + val f : 'a t2_imm -> 'a t2_imm + val g : ('a : immediate). 'a t2_imm -> 'a t2_imm +end +;; +[%%expect {| +module type S = + sig + val f : ('a : immediate). 'a t2_imm -> 'a t2_imm + val g : ('a : immediate). 'a t2_imm -> 'a t2_imm + end +|}] + +module type S = sig + val f : 'a t2_float64 -> 'a t2_float64 + val g : ('a : float64). 'a t2_float64 -> 'a t2_float64 +end +;; +[%%expect {| +module type S = + sig + val f : ('a : float64). 'a t2_float64 -> 'a t2_float64 + val g : ('a : float64). 'a t2_float64 -> 'a t2_float64 + end |}] -(* CR layouts: fix when we allow annotations on universals in [layouts] *) (************************************************************) (* Test 9: Annotation on universal in polymorphic parameter *) @@ -254,16 +492,17 @@ let f (x : ('a : value). 'a -> 'a) = x "string", x 5 val f : ('a. 'a -> 'a) -> string * int = |}] + let f (x : ('a : immediate). 'a -> 'a) = x "string" [%%expect {| -Line 1, characters 17-26: +Line 1, characters 43-51: 1 | let f (x : ('a : immediate). 'a -> 'a) = x "string" - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. + ^^^^^^^^ +Error: This expression has type string but an expression was expected of type + ('a : immediate) + string has layout value, which is not a sublayout of immediate. |}] -(* CR layouts: fix when we allow annotations on universals in [layouts] *) (**************************************) (* Test 10: Parsing & pretty-printing *) @@ -271,21 +510,13 @@ Error: Layout immediate is more experimental than allowed by -extension layouts. let f (type a : immediate) (x : a) = x [%%expect{| -Line 1, characters 16-25: -1 | let f (type a : immediate) (x : a) = x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = |}] let f = fun (type a : immediate) (x : a) -> x [%%expect{| -Line 1, characters 22-31: -1 | let f = fun (type a : immediate) (x : a) -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = |}] let f = fun (type a : value) (x : a) -> x @@ -299,21 +530,13 @@ let o = object end [%%expect{| -Line 2, characters 23-32: -2 | method m : type (a : immediate). a -> a = fun x -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val o : < m : ('a : immediate). 'a -> 'a > = |}] let f : type (a : immediate). a -> a = fun x -> x [%%expect{| -Line 1, characters 18-27: -1 | let f : type (a : immediate). a -> a = fun x -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = |}] let f x = @@ -321,116 +544,77 @@ let f x = g x [@nontail] [%%expect{| -Line 2, characters 25-34: -2 | let local_ g (type a : immediate) (x : a) = x in - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate). 'a -> 'a = |}] let f = fun x y (type (a : immediate)) (z : a) -> z [%%expect{| -Line 1, characters 27-36: -1 | let f = fun x y (type (a : immediate)) (z : a) -> z - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate) 'c 'b. 'b -> 'c -> 'a -> 'a = |}] let f = fun x y (type a : immediate) (z : a) -> z [%%expect{| -Line 1, characters 26-35: -1 | let f = fun x y (type a : immediate) (z : a) -> z - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f : ('a : immediate) 'c 'b. 'b -> 'c -> 'a -> 'a = |}] +(* CR layouts: canonicalizing the order of quantification here + would reduce wibbles in error messages *) external f : ('a : immediate). 'a -> 'a = "%identity" [%%expect{| -Line 1, characters 19-28: -1 | external f : ('a : immediate). 'a -> 'a = "%identity" - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +external f : ('a : immediate). 'a -> 'a = "%identity" |}] -type (_ : any) t2_any - -[%%expect{| -Line 1, characters 10-13: -1 | type (_ : any) t2_any - ^^^ -Error: Layout any is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. -|}] +type (_ : any) t2_any exception E : ('a : immediate) ('b : any). 'b t2_any * 'a list -> exn [%%expect{| -Line 1, characters 20-29: -1 | exception E : ('a : immediate) ('b : any). 'b t2_any * 'a list -> exn - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type (_ : any) t2_any +exception E : ('a : immediate) ('b : any). 'b t2_any * 'a list -> exn |}] + let f (x : ('a : immediate). 'a -> 'a) = x 3, x true -[%%expect {| -Line 1, characters 17-26: -1 | let f (x : ('a : immediate). 'a -> 'a) = x 3, x true - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +[%%expect{| +val f : (('a : immediate). 'a -> 'a) -> int * bool = |}] type _ a = Mk : [> ] * ('a : immediate) -> int a [%%expect {| -Line 1, characters 29-38: -1 | type _ a = Mk : [> ] * ('a : immediate) -> int a - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type _ a = Mk : ('a : immediate). [> ] * 'a -> int a |}] let f_imm : ('a : immediate). 'a -> 'a = fun x -> x [%%expect {| -Line 1, characters 18-27: -1 | let f_imm : ('a : immediate). 'a -> 'a = fun x -> x - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +val f_imm : ('a : immediate). 'a -> 'a = |}] -let f_val : ('a : value). 'a -> 'a = fun x -> x +let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x [%%expect {| -val f_val : 'a -> 'a = +Line 1, characters 37-53: +1 | let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x + ^^^^^^^^^^^^^^^^ +Error: This definition has type 'b -> 'b which is less general than + 'a. 'a -> 'a + 'a has layout value, which is not a sublayout of immediate. |}] type (_ : value) g = | MkG : ('a : immediate). 'a g [%%expect {| -Line 2, characters 16-25: -2 | | MkG : ('a : immediate). 'a g - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type _ g = MkG : ('a : immediate). 'a g |}] type t = int as (_ : immediate) [%%expect {| -Line 1, characters 21-30: -1 | type t = int as (_ : immediate) - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type t = int |}] diff --git a/ocaml/testsuite/tests/typing-layouts/annots_beta.ml b/ocaml/testsuite/tests/typing-layouts/annots_beta.ml deleted file mode 100644 index 714264aed4a..00000000000 --- a/ocaml/testsuite/tests/typing-layouts/annots_beta.ml +++ /dev/null @@ -1,568 +0,0 @@ -(* TEST - flags = "-extension layouts_beta" - * expect -*) - -type t_value : value -type t_imm : immediate -type t_imm64 : immediate64 -type t_float64 : float64 -type t_any : any;; - -[%%expect{| -type t_value : value -type t_imm : immediate -type t_imm64 : immediate64 -type t_float64 : float64 -type t_any : any -|}] - -type t_void : void;; - -[%%expect{| -Line 1, characters 14-18: -1 | type t_void : void;; - ^^^^ -Error: Layout void is used here, but the appropriate layouts extension is not enabled -|}] - -(***************************************) -(* Test 1: annotation on type variable *) - -let x : int as ('a: value) = 5 -let x : int as ('a : immediate) = 5 -let x : int as ('a : any) = 5;; - -[%%expect{| -val x : int = 5 -val x : int = 5 -val x : int = 5 -|}] - -let x : int as ('a : float64) = 5;; -[%%expect {| -Line 1, characters 8-29: -1 | let x : int as ('a : float64) = 5;; - ^^^^^^^^^^^^^^^^^^^^^ -Error: This alias is bound to type int but is used as an instance of type - ('a : float64) - int has layout immediate, which is not a sublayout of float64. -|}] - -let x : (int as ('a : immediate)) list as ('b : value) = [3;4;5] -;; -[%%expect {| -val x : int list = [3; 4; 5] -|}] - -let x : int list as ('a : immediate) = [3;4;5] -;; -[%%expect {| -Line 1, characters 8-36: -1 | let x : int list as ('a : immediate) = [3;4;5] - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This alias is bound to type int list - but is used as an instance of type ('a : immediate) - int list has layout value, which is not a sublayout of immediate. -|}] -(* CR layouts: error message could be phrased better *) - -(****************************************) -(* Test 2: Annotation on type parameter *) - -type ('a : immediate) t2_imm -type (_ : immediate) t2_imm' -type t1 = int t2_imm -type t2 = bool t2_imm -type ('a : float64) t2_float64 -type (_ : float64) t2_float64' -type t3 = float# t2_float64 - - -[%%expect {| -type ('a : immediate) t2_imm -type (_ : immediate) t2_imm' -type t1 = int t2_imm -type t2 = bool t2_imm -type ('a : float64) t2_float64 -type (_ : float64) t2_float64' -type t3 = float# t2_float64 -|}] - -module M1 : sig - type ('a : immediate) t -end = struct - type (_ : immediate) t -end - -module M2 : sig - type (_ : immediate) t -end = struct - type ('a : immediate) t -end - -[%%expect {| -module M1 : sig type ('a : immediate) t end -module M2 : sig type (_ : immediate) t end -|}] - -type t = string t2_imm -;; -[%%expect {| -Line 1, characters 9-15: -1 | type t = string t2_imm - ^^^^^^ -Error: This type string should be an instance of type ('a : immediate) - string has layout value, which is not a sublayout of immediate. -|}] - -let f : 'a t2_imm -> 'a t2_imm = fun x -> x -;; -[%%expect {| -val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = -|}] - -let f : ('a : immediate) t2_imm -> ('a : value) t2_imm = fun x -> x -;; -[%%expect {| -val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = -|}] - -let f : ('a : value) t2_imm -> ('a : value) t2_imm = fun x -> x -;; -[%%expect {| -val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = -|}] - -let f : ('a : immediate). 'a t2_imm -> 'a t2_imm = fun x -> x -;; -[%%expect {| -val f : ('a : immediate). 'a t2_imm -> 'a t2_imm = -|}] - -let f : ('a : value). 'a t2_imm -> 'a t2_imm = fun x -> x -;; -[%%expect {| -Line 1, characters 8-44: -1 | let f : ('a : value). 'a t2_imm -> 'a t2_imm = fun x -> x - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The universal type variable 'a was declared to have - layout value, but was inferred to have layout immediate. -|}] - -type 'a t = 'a t2_imm -;; -[%%expect {| -type ('a : immediate) t = 'a t2_imm -|}] - -type ('a : value) t = 'a t2_imm -;; -[%%expect {| -type ('a : immediate) t = 'a t2_imm -|}] - -type ('a : immediate) t = 'a t2_imm -;; -[%%expect {| -type ('a : immediate) t = 'a t2_imm -|}] - -let f : (_ : value) t2_imm -> unit = fun _ -> () -let g : (_ : immediate) t2_imm -> unit = fun _ -> () - -[%%expect {| -val f : ('a : immediate). 'a t2_imm -> unit = -val g : ('a : immediate). 'a t2_imm -> unit = -|}] - -let f : (_ : immediate) -> unit = fun _ -> () -let g : (_ : value) -> unit = fun _ -> () - -[%%expect {| -val f : ('a : immediate). 'a -> unit = -val g : 'a -> unit = -|}] - -let f : (_ : immediate) -> (_ : value) = fun _ -> assert false -let g : (_ : value) -> (_ : immediate) = fun _ -> assert false - -[%%expect {| -val f : 'b ('a : immediate). 'a -> 'b = -val g : ('b : immediate) 'a. 'a -> 'b = -|}] - -(********************************************) -(* Test 3: Annotation on types in functions *) - -let f : ('a : any) -> 'a = fun x -> x -;; -[%%expect {| -val f : 'a -> 'a = -|}] - -let f : ('a : any). 'a -> 'a = fun x -> x -;; -[%%expect {| -Line 1, characters 8-28: -1 | let f : ('a : any). 'a -> 'a = fun x -> x - ^^^^^^^^^^^^^^^^^^^^ -Error: The universal type variable 'a was declared to have - layout any, but was inferred to have a representable layout. -|}] -(* CR layouts v2.5: This error message should change to complain - about the [fun x], not the arrow type. *) - -let f : ('a : float64). 'a -> 'a = fun x -> x -;; -[%%expect {| -val f : ('a : float64). 'a -> 'a = -|}] - -(********************************************) -(* Test 4: Annotation on record field types *) - -type r = { field : ('a : immediate). 'a -> 'a } -let f { field } = field 5 -;; -[%%expect {| -type r = { field : ('a : immediate). 'a -> 'a; } -val f : r -> int = -|}] - -type rf = { fieldf : ('a : float64). 'a -> 'a } -let f { fieldf } = fieldf (Stdlib__Float_u.of_float 3.14);; -[%%expect {| -type rf = { fieldf : ('a : float64). 'a -> 'a; } -val f : rf -> float# = -|}] - -let f { field } = field "hello" -;; -[%%expect {| -Line 1, characters 24-31: -1 | let f { field } = field "hello" - ^^^^^^^ -Error: This expression has type string but an expression was expected of type - ('a : immediate) - string has layout value, which is not a sublayout of immediate. -|}] - -let r = { field = fun x -> x } -let r = { field = Fun.id } -;; -[%%expect {| -val r : r = {field = } -val r : r = {field = } -|}] - -let r = { field = fun (type (a : immediate)) (x : a) -> x } -;; -[%%expect {| -val r : r = {field = } -|}] - -let r = { field = fun (type (a : value)) (x : a) -> x } -;; -[%%expect {| -val r : r = {field = } -|}] - -type r_value = { field : 'a. 'a -> 'a } -let r = { field = fun (type a : immediate) (x : a) -> x } - -[%%expect{| -type r_value = { field : 'a. 'a -> 'a; } -Line 2, characters 18-55: -2 | let r = { field = fun (type a : immediate) (x : a) -> x } - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This field value has type 'b -> 'b which is less general than - 'a. 'a -> 'a - 'a has layout value, which is not a sublayout of immediate. -|}] -(* CR layouts v1.5: that's a pretty awful error message *) - -type ('a : immediate) t_imm - -type s = { f : ('a : value). 'a -> 'a u } -and 'a u = 'a t_imm - -[%%expect{| -type ('a : immediate) t_imm -Line 3, characters 15-39: -3 | type s = { f : ('a : value). 'a -> 'a u } - ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Layout mismatch in final type declaration consistency check. - This is most often caused by the fact that type inference is not - clever enough to propagate layouts through variables in different - declarations. It is also not clever enough to produce a good error - message, so we'll say this instead: - 'a has layout value, which is not a sublayout of immediate. - The fix will likely be to add a layout annotation on a parameter to - the declaration where this error is reported. -|}] -(* CR layouts v1.5: the location on that message is wrong. But it's hard - to improve, because it comes from re-checking typedtree, where we don't - have locations any more. I conjecture the same location problem exists - when constraints aren't satisfied. *) - -(********************) -(* Test 5: newtypes *) - -let f = fun (type (a : value)) (x : a) -> x -;; -[%%expect {| -val f : 'a -> 'a = -|}] - -let f = fun (type (a : immediate)) (x : a) -> x -;; -[%%expect {| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f = fun (type (a : float64)) (x : a) -> x -;; -[%%expect {| -val f : ('a : float64). 'a -> 'a = -|}] - -let f = fun (type (a : any)) (x : a) -> x -;; -[%%expect {| -Line 1, characters 29-36: -1 | let f = fun (type (a : any)) (x : a) -> x - ^^^^^^^ -Error: This pattern matches values of type a - but a pattern was expected which matches values of type - ('a : '_representable_layout_1) - a has layout any, which is not representable. -|}] - -(****************************************) -(* Test 6: abstract universal variables *) - -let f : type (a : value). a -> a = fun x -> x -;; -[%%expect {| -val f : 'a -> 'a = -|}] - -let f : type (a : immediate). a -> a = fun x -> x -;; -[%%expect {| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f : type (a : float64). a -> a = fun x -> x -;; -[%%expect {| -val f : ('a : float64). 'a -> 'a = -|}] - -let f : type (a : any). a -> a = fun x -> x -;; -[%%expect {| -Line 1, characters 24-30: -1 | let f : type (a : any). a -> a = fun x -> x - ^^^^^^ -Error: The universal type variable 'a was declared to have - layout any, but was inferred to have a representable layout. -|}] -(* CR layouts v2.5: This error message will change to complain - about the fun x, not the arrow type. *) - -(**************************************************) -(* Test 7: Defaulting universal variable to value *) - -module type S = sig - val f : 'a. 'a t2_imm -> 'a t2_imm -end -;; -[%%expect {| -Line 2, characters 10-36: -2 | val f : 'a. 'a t2_imm -> 'a t2_imm - ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The universal type variable 'a was defaulted to have - layout value, but was inferred to have layout immediate. -|}] - -let f : 'a. 'a t2_imm -> 'a t2_imm = fun x -> x - -[%%expect {| -Line 1, characters 8-34: -1 | let f : 'a. 'a t2_imm -> 'a t2_imm = fun x -> x - ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The universal type variable 'a was defaulted to have - layout value, but was inferred to have layout immediate. -|}] - -(********************************************) -(* Test 8: Annotation on universal variable *) - -module type S = sig - val f : ('a : value). 'a t2_imm -> 'a t2_imm -end -;; -[%%expect {| -Line 2, characters 10-46: -2 | val f : ('a : value). 'a t2_imm -> 'a t2_imm - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The universal type variable 'a was declared to have - layout value, but was inferred to have layout immediate. -|}] - -module type S = sig - val f : 'a t2_imm -> 'a t2_imm - val g : ('a : immediate). 'a t2_imm -> 'a t2_imm -end -;; -[%%expect {| -module type S = - sig - val f : ('a : immediate). 'a t2_imm -> 'a t2_imm - val g : ('a : immediate). 'a t2_imm -> 'a t2_imm - end -|}] - -module type S = sig - val f : 'a t2_float64 -> 'a t2_float64 - val g : ('a : float64). 'a t2_float64 -> 'a t2_float64 -end -;; -[%%expect {| -module type S = - sig - val f : ('a : float64). 'a t2_float64 -> 'a t2_float64 - val g : ('a : float64). 'a t2_float64 -> 'a t2_float64 - end -|}] - -(************************************************************) -(* Test 9: Annotation on universal in polymorphic parameter *) - -let f (x : ('a : immediate). 'a -> 'a) = x "string" - -[%%expect {| -Line 1, characters 43-51: -1 | let f (x : ('a : immediate). 'a -> 'a) = x "string" - ^^^^^^^^ -Error: This expression has type string but an expression was expected of type - ('a : immediate) - string has layout value, which is not a sublayout of immediate. -|}] - -(**************************************) -(* Test 10: Parsing & pretty-printing *) - -let f (type a : immediate) (x : a) = x - -[%%expect{| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f = fun (type a : immediate) (x : a) -> x - -[%%expect{| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f = fun (type a : value) (x : a) -> x - -[%%expect{| -val f : 'a -> 'a = -|}] - -let o = object - method m : type (a : immediate). a -> a = fun x -> x -end - -[%%expect{| -val o : < m : ('a : immediate). 'a -> 'a > = -|}] - -let f : type (a : immediate). a -> a = fun x -> x - -[%%expect{| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f x = - let local_ g (type a : immediate) (x : a) = x in - g x [@nontail] - -[%%expect{| -val f : ('a : immediate). 'a -> 'a = -|}] - -let f = fun x y (type (a : immediate)) (z : a) -> z - -[%%expect{| -val f : ('a : immediate) 'c 'b. 'b -> 'c -> 'a -> 'a = -|}] - -let f = fun x y (type a : immediate) (z : a) -> z - -[%%expect{| -val f : ('a : immediate) 'c 'b. 'b -> 'c -> 'a -> 'a = -|}] -(* CR layouts: canonicalizing the order of quantification here - would reduce wibbles in error messages *) - -external f : ('a : immediate). 'a -> 'a = "%identity" - -[%%expect{| -external f : ('a : immediate). 'a -> 'a = "%identity" -|}] - - -type (_ : any) t2_any -exception E : ('a : immediate) ('b : any). 'b t2_any * 'a list -> exn - -[%%expect{| -type (_ : any) t2_any -exception E : ('a : immediate) ('b : any). 'b t2_any * 'a list -> exn -|}] - - -let f (x : ('a : immediate). 'a -> 'a) = x 3, x true - -[%%expect{| -val f : (('a : immediate). 'a -> 'a) -> int * bool = -|}] - -type _ a = Mk : [> ] * ('a : immediate) -> int a - -[%%expect {| -type _ a = Mk : ('a : immediate). [> ] * 'a -> int a -|}] - -let f_imm : ('a : immediate). 'a -> 'a = fun x -> x - -[%%expect {| -val f_imm : ('a : immediate). 'a -> 'a = -|}] - -let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x - -[%%expect {| -Line 1, characters 37-53: -1 | let f_val : ('a : value). 'a -> 'a = fun x -> f_imm x - ^^^^^^^^^^^^^^^^ -Error: This definition has type 'b -> 'b which is less general than - 'a. 'a -> 'a - 'a has layout value, which is not a sublayout of immediate. -|}] - -type (_ : value) g = - | MkG : ('a : immediate). 'a g - -[%%expect {| -type _ g = MkG : ('a : immediate). 'a g -|}] - -type t = int as (_ : immediate) - -[%%expect {| -type t = int -|}] diff --git a/ocaml/testsuite/tests/typing-layouts/basics.ml b/ocaml/testsuite/tests/typing-layouts/basics.ml index afdafc1e9bc..c5ef51bdf83 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics.ml @@ -2,24 +2,22 @@ * expect flags = "-extension layouts" *) + + type t_value : value type t_imm : immediate -type t_imm64 : immediate64;; +type t_imm64 : immediate64 +type t_float64 : float64;; +type t_any : any;; [%%expect{| type t_value : value type t_imm : immediate type t_imm64 : immediate64 +type t_float64 : float64 +type t_any : any |}] -type t_any : any;; -[%%expect{| -Line 1, characters 15-18: -1 | type t_any : any;; - ^^^ -Error: Layout any is used here, but the appropriate layouts extension is not enabled -|}];; - type t_void : void;; [%%expect{| Line 1, characters 15-19: @@ -28,18 +26,85 @@ Line 1, characters 15-19: Error: Layout void is used here, but the appropriate layouts extension is not enabled |}];; - (************************************************************) (* Test 1: Disallow non-representable function args/returns *) -(* CR layouts v3: moved to layouts alpha. Bring here when we have - non-representable layouts enabled by default. *) +module type S1 = sig + val f : int -> t_any +end;; +[%%expect {| +Line 2, characters 17-22: +2 | val f : int -> t_any + ^^^^^ +Error: Function return types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +module type S1 = sig + val f : t_any -> int +end;; +[%%expect {| +Line 2, characters 10-15: +2 | val f : t_any -> int + ^^^^^ +Error: Function argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +module type S1 = sig + type t : any + + type 'a s = 'a -> int constraint 'a = t +end;; +[%%expect{| +Line 4, characters 35-41: +4 | type 'a s = 'a -> int constraint 'a = t + ^^^^^^ +Error: The type constraints are not consistent. + Type ('a : '_representable_layout_1) is not compatible with type t + t has layout any, which is not representable. +|}] + +module type S1 = sig + type t : any + + type 'a s = int -> 'a constraint 'a = t +end;; +[%%expect{| +Line 4, characters 35-41: +4 | type 'a s = int -> 'a constraint 'a = t + ^^^^^^ +Error: The type constraints are not consistent. + Type ('a : '_representable_layout_2) is not compatible with type t + t has layout any, which is not representable. +|}] + +let f1 () : t_any = assert false;; +[%%expect{| +Line 1, characters 20-32: +1 | let f1 () : t_any = assert false;; + ^^^^^^^^^^^^ +Error: This expression has type t_any but an expression was expected of type + ('a : '_representable_layout_3) + t_any has layout any, which is not representable. +|}];; + +let f1 (x : t_any) = ();; +[%%expect{| +Line 1, characters 7-18: +1 | let f1 (x : t_any) = ();; + ^^^^^^^^^^^ +Error: This pattern matches values of type t_any + but a pattern was expected which matches values of type + ('a : '_representable_layout_4) + t_any has layout any, which is not representable. +|}];; (*****************************************************) (* Test 2: Permit representable function arg/returns *) -(* CR layouts v3: much of this test moved to basics_alpha. Add #float versions - and bring them here when #float is allowed by default. *) +(* CR layouts v5: the void bits of this test should be copied here from + basics_alpha *) module type S = sig val f1 : t_value -> t_value val f2 : t_imm -> t_imm64 @@ -49,67 +114,410 @@ end;; module type S = sig val f1 : t_value -> t_value val f2 : t_imm -> t_imm64 end |}];; +module type S2 = sig + val g : float# -> int +end;; +[%%expect{| +module type S2 = sig val g : float# -> int end +|}];; + +module type S2 = sig + val g : int -> float# +end +[%%expect {| +module type S2 = sig val g : int -> float# end +|}];; + +module type S2 = sig + type t' : float64 + type s' = r' -> int + and r' = t' +end;; +[%%expect{| +module type S2 = sig type t' : float64 type s' = r' -> int and r' = t' end +|}] + +module type S2 = sig + val f : int -> t_float64 +end;; +[%%expect {| +module type S2 = sig val f : int -> t_float64 end +|}];; + +module type S = sig + type t' : float64 + type 'a s' = 'a -> int constraint 'a = t' +end;; +[%%expect{| +module type S = + sig type t' : float64 type 'a s' = 'a -> int constraint 'a = t' end +|}] + +module F2 (X : sig val x : t_float64 end) = struct + let f () = X.x +end;; +[%%expect{| +Line 1, characters 27-36: +1 | module F2 (X : sig val x : t_float64 end) = struct + ^^^^^^^^^ +Error: This type signature for x is not a value type. + x has layout float64, which is not a sublayout of value. +|}];; +(* CR layouts v5: the test above should be made to work *) + +module F2 (X : sig val f : t_float64 -> unit end) = struct + let g z = X.f z +end;; +[%%expect{| +module F2 : + functor (X : sig val f : t_float64 -> unit end) -> + sig val g : t_float64 -> unit end +|}];; + (**************************************) (* Test 3: basic annotated parameters *) +type ('a : immediate) imm_id = 'a + +[%%expect{| +type ('a : immediate) imm_id = 'a +|}];; -(* CR layouts: mostly moved to [basics_beta.ml]. Bring back here when we allow - annotations on parameters by default. *) -type ('a : immediate) imm_id = 'a;; +type my_int = int imm_id +let plus_3 (x : my_int) = x + 3 +let plus_3' (x : int imm_id) = x + 3;; + +[%%expect{| +type my_int = int imm_id +val plus_3 : my_int -> int = +val plus_3' : int imm_id -> int = +|}];; + +let string_id (x : string imm_id) = x;; [%%expect{| -Line 1, characters 11-20: -1 | type ('a : immediate) imm_id = 'a;; - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +Line 1, characters 19-25: +1 | let string_id (x : string imm_id) = x;; + ^^^^^^ +Error: This type string should be an instance of type ('a : immediate) + string has layout value, which is not a sublayout of immediate. |}];; +let id_for_imms (x : 'a imm_id) = x + +let three = id_for_imms 3 +let true_ = id_for_imms true;; +[%%expect{| +val id_for_imms : ('a : immediate). 'a imm_id -> 'a imm_id = +val three : int imm_id = 3 +val true_ : bool imm_id = true +|}] + +let not_helloworld = id_for_imms "hello world";; +[%%expect{| +Line 1, characters 33-46: +1 | let not_helloworld = id_for_imms "hello world";; + ^^^^^^^^^^^^^ +Error: This expression has type string but an expression was expected of type + 'a imm_id = ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] + (************************************) (* Test 4: parameters and recursion *) +type ('a : immediate) t4 +and s4 = string t4;; + +[%%expect{| +Line 2, characters 9-15: +2 | and s4 = string t4;; + ^^^^^^ +Error: This type string should be an instance of type ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}];; + +type s4 = string t4 +and ('a : immediate) t4;; + +[%%expect{| +Line 1, characters 10-16: +1 | type s4 = string t4 + ^^^^^^ +Error: This type string should be an instance of type ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] + +type s4 = int t4 +and ('a : immediate) t4;; + +[%%expect{| +type s4 = int t4 +and ('a : immediate) t4 +|}] + +type s4 = s5 t4 +and ('a : immediate) t4 +and s5 = int;; + +[%%expect{| +type s4 = s5 t4 +and ('a : immediate) t4 +and s5 = int +|}] + +type s4 = s5 t4 +and ('a : immediate) t4 +and s5 = string;; + +[%%expect{| +Line 3, characters 0-15: +3 | and s5 = string;; + ^^^^^^^^^^^^^^^ +Error: + s5 has layout value, which is not a sublayout of immediate. +|}] +(* CR layouts v2.9: improve error, which requires layout histories *) + +type ('a : any) t4 = 'a +and s4 = string t4;; +[%%expect{| +type ('a : any) t4 = 'a +and s4 = string t4 +|}];; + +type s4 = string t4 +and ('a : any) t4;; +[%%expect{| +type s4 = string t4 +and ('a : any) t4 +|}];; + +type ('a : void) void4 = Void4 of 'a;; +[%%expect{| +Line 1, characters 11-15: +1 | type ('a : void) void4 = Void4 of 'a;; + ^^^^ +Error: Layout void is more experimental than allowed by -extension layouts. + You must enable -extension layouts_alpha to use this feature. +|}];; -(* CR layouts: immediate bits moved to [basics_beta.ml] and void bits to - [basics_alpha.ml]. Bring each part back here when we allow the relevant - layout annotations on parameters by default. *) +type ('a : any) any4 = Any4 of 'a +[%%expect{| +type 'a any4 = Any4 of 'a +|}];; (************************************************************) (* Test 5: You can touch a void, but not return it directly *) -(* CR layouts v5: these tests moved to [basics_alpha.ml]. Bring them back here - when we allow void by default. Also the tests will change because we'll - allow returning void. *) +(* CR layouts v5: these tests moved to [basics_alpha.ml]. Bring them here. + Also the tests will change because we'll allow returning void. *) (****************************************) (* Test 6: explicitly polymorphic types *) +type ('a : immediate) t6_imm = T6imm of 'a +type ('a : value) t6_val = T6val of 'a;; +[%%expect{| +type ('a : immediate) t6_imm = T6imm of 'a +type 'a t6_val = T6val of 'a +|}];; + +let ignore_val6 : 'a . 'a -> unit = + fun a -> let _ = T6val a in ();; +[%%expect{| +val ignore_val6 : 'a -> unit = +|}];; -(* CR layouts: These tests can come back from [layouts_beta.ml] when we allow parameter - jkind annotations by default. *) +let ignore_imm6 : 'a . 'a -> unit = + fun a -> let _ = T6imm a in ();; +[%%expect{| +Line 2, characters 2-32: +2 | fun a -> let _ = T6imm a in ();; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This definition has type 'b -> unit which is less general than + 'a. 'a -> unit + 'a has layout value, which is not a sublayout of immediate. +|}];; -(*****************************************) -(* Test 7: the layout check in unify_var *) +let o6 = object + method ignore_imm6 : 'a . 'a -> unit = + fun a -> let _ = T6imm a in () +end;; +[%%expect{| +Line 3, characters 4-34: +3 | fun a -> let _ = T6imm a in () + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This method has type 'b -> unit which is less general than + 'a. 'a -> unit + 'a has layout value, which is not a sublayout of immediate. +|}];; + +(* CR layouts v1.5: add more tests here once you can annotate these types with + jkinds. *) + +(****************************************) +(* Test 7: the jkind check in unify_var *) -(* CR layouts: This test can come back from [layouts_beta.ml] when we allow - parameter layout annotations by default. *) +type ('a : immediate) t7 = Foo7 of 'a + +type t7' = (int * int) t7;; +[%%expect{| +type ('a : immediate) t7 = Foo7 of 'a +Line 3, characters 12-21: +3 | type t7' = (int * int) t7;; + ^^^^^^^^^ +Error: This type int * int should be an instance of type ('a : immediate) + int * int has layout value, which is not a sublayout of immediate. +|}] (**********************************************************) (* Test 8: Polymorphic variants take value args (for now) *) -(* CR layouts: these tests moved to [basics_alphs.ml] because they need a - non-value layout. Similar tests should be added here once we have another - sort enabled by default (though we will probably chose to allow it as an arg - to polymorphic variants, not ban it). *) +(* CR layouts v5: Bring over void versions of these tests. *) + +module M8_1f = struct + type foo1 = [ `Foo1 of int | `Baz1 of t_float64 | `Bar1 of string ];; +end +[%%expect{| +Line 2, characters 40-49: +2 | type foo1 = [ `Foo1 of int | `Baz1 of t_float64 | `Bar1 of string ];; + ^^^^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M8_2f = struct + let foo x = + match x with + | `Baz 42 -> Stdlib__Float_u.of_float 3.14 + | `Bar v -> v + | `Bas i -> Stdlib__Float_u.of_float 3.14 +end;; +[%%expect {| +Line 5, characters 16-17: +5 | | `Bar v -> v + ^ +Error: This expression has type ('a : value) + but an expression was expected of type float# + float# has layout float64, which is not a sublayout of value. +|}];; + +module M8_3f = struct + type 'a t = [ `Foo of 'a | `Baz of int ] + + type bad = t_float64 t +end;; +[%%expect {| +Line 4, characters 13-22: +4 | type bad = t_float64 t + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M8_4f = struct + type 'a t = [ `Foo of 'a | `Baz of int ] constraint 'a = t_float64 +end;; +[%%expect {| +Line 2, characters 54-68: +2 | type 'a t = [ `Foo of 'a | `Baz of int ] constraint 'a = t_float64 + ^^^^^^^^^^^^^^ +Error: The type constraints are not consistent. + Type ('a : value) is not compatible with type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module type S8_5f = sig + val x : [`A of t_float64] +end;; +[%%expect{| +Line 2, characters 17-26: +2 | val x : [`A of t_float64] + ^^^^^^^^^ +Error: Polymorphic variant constructor argument types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}] (************************************************) (* Test 9: Tuples only work on values (for now) *) -(* CR layouts: these tests moved to [basics_alphs.ml] because they need a - non-value layout. Similar tests should be added here once we have another - sort enabled by default. *) +(* CR layouts v5: bring over void tests. *) +module M9_1f = struct + type foo1 = int * t_float64 * [ `Foo1 of int | `Bar1 of string ];; +end +[%%expect{| +Line 2, characters 20-29: +2 | type foo1 = int * t_float64 * [ `Foo1 of int | `Bar1 of string ];; + ^^^^^^^^^ +Error: Tuple element types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M9_2f = struct + type result = V of (string * t_float64) | I of int +end;; +[%%expect {| +Line 2, characters 31-40: +2 | type result = V of (string * t_float64) | I of int + ^^^^^^^^^ +Error: Tuple element types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M9_4f = struct + let f_id (x : float#) = x + + let foo x = + match x with + | (a, _) -> f_id a +end;; +[%%expect {| +Line 6, characters 21-22: +6 | | (a, _) -> f_id a + ^ +Error: This expression has type ('a : value) + but an expression was expected of type float# + float# has layout float64, which is not a sublayout of value. +|}];; + +module M9_5f = struct + type 'a t = (int * 'a) + + type bad = t_float64 t +end;; +[%%expect {| +Line 4, characters 13-22: +4 | type bad = t_float64 t + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M9_6f = struct + type 'a t = int * 'a constraint 'a = t_float64 +end;; +[%%expect {| +Line 2, characters 34-48: +2 | type 'a t = int * 'a constraint 'a = t_float64 + ^^^^^^^^^^^^^^ +Error: The type constraints are not consistent. + Type ('a : value) is not compatible with type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module type S9_7f = sig + val x : int * t_float64 +end;; +[%%expect{| +Line 2, characters 16-25: +2 | val x : int * t_float64 + ^^^^^^^^^ +Error: Tuple element types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; (*************************************************) (* Test 10: jkinds are checked by "more general" *) -(* CR layouts: These tests moved to [basics_beta.ml] because they use annotated - type parameters. Bring them back here when we allow this by default. *) - +(* This hits the first linktype in moregen (no expansion required to see it's a + var) *) module M10_1 : sig val x : string end = struct @@ -119,19 +527,74 @@ end = struct let x = f (assert false) end;; -[%%expect{| -Line 4, characters 13-22: +[%%expect {| +Lines 3-9, characters 6-3: +3 | ......struct 4 | type ('a : immediate) t = 'a - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +5 | +6 | let f : 'a t -> 'a = fun x -> x +7 | +8 | let x = f (assert false) +9 | end.. +Error: Signature mismatch: + Modules do not match: + sig + type ('a : immediate) t = 'a + val f : ('a : immediate). 'a t -> 'a + val x : ('a : immediate). 'a + end + is not included in + sig val x : string end + Values do not match: + val x : ('a : immediate). 'a + is not included in + val x : string + The type ('a : immediate) is not compatible with the type string + string has layout value, which is not a sublayout of immediate. +|}];; + +(* This hits the second linktype in moregen (requires expansion to see it's a + var) *) +module M10_2 : sig + val x : string +end = struct + type ('a : immediate) t = 'a + + let f (x : 'a t) : 'a t = x + + let x = f (assert false) +end;; +[%%expect {| +Lines 3-9, characters 6-3: +3 | ......struct +4 | type ('a : immediate) t = 'a +5 | +6 | let f (x : 'a t) : 'a t = x +7 | +8 | let x = f (assert false) +9 | end.. +Error: Signature mismatch: + Modules do not match: + sig + type ('a : immediate) t = 'a + val f : ('a : immediate). 'a t -> 'a t + val x : ('a : immediate). 'a t + end + is not included in + sig val x : string end + Values do not match: + val x : ('a : immediate). 'a t + is not included in + val x : string + The type 'a t = ('a : immediate) is not compatible with the type + string + string has layout value, which is not a sublayout of immediate. |}] -(**************************************************************) -(* Test 11: objects are values and methods take/return values *) +(**********************************************************************) +(* Test 11: objects are values. methods may take/return other sorts. *) -(* CR layouts: These tests moved to [basics_alpha.ml] as they need a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring the void versions back here. *) module M11_1 = struct type ('a : void) t = { x : int; v : 'a } @@ -146,20 +609,340 @@ Error: Layout void is more experimental than allowed by -extension layouts. You must enable -extension layouts_alpha to use this feature. |}] +module M11_1f = struct + type ('a : float64) t = 'a + + let f (x : 'a t) = + x # baz11 +end;; +[%%expect{| +Line 5, characters 4-5: +5 | x # baz11 + ^ +Error: Method types must have layout value. + This expression has layout float64, which does not overlap with value. +|}] + +module M11_2f = struct + type ('a : float64) t = 'a + let f_id (x : 'a t) = x + let foo x = f_id (x # getfloat) +end;; +[%%expect{| +Line 4, characters 19-33: +4 | let foo x = f_id (x # getfloat) + ^^^^^^^^^^^^^^ +Error: This expression has type ('a : value) + but an expression was expected of type 'b t = ('b : float64) + 'a t has layout float64, which does not overlap with value. +|}];; + +module M11_3f = struct + type ('a : float64) t = 'a + + let foo o (x : 'a t) = o # usefloat x +end;; +[%%expect{| +module M11_3f : + sig + type ('a : float64) t = 'a + val foo : 'b ('a : float64). < usefloat : 'a t -> 'b; .. > -> 'a t -> 'b + end +|}];; + +module M11_4f = struct + val x : < l : t_float64 > +end;; +[%%expect{| +Line 2, characters 12-25: +2 | val x : < l : t_float64 > + ^^^^^^^^^^^^^ +Error: Object field types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +module M11_5f = struct + type 'a t = < l : 'a s > + and ('a : float64) s = 'a +end;; +[%%expect{| +Line 3, characters 2-27: +3 | and ('a : float64) s = 'a + ^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: + 'a s has layout float64, which does not overlap with value. +|}];; + +module M11_6f = struct + type 'a t = < l : 'a > constraint 'a = t_float64 +end;; +[%%expect{| +Line 2, characters 36-50: +2 | type 'a t = < l : 'a > constraint 'a = t_float64 + ^^^^^^^^^^^^^^ +Error: The type constraints are not consistent. + Type ('a : value) is not compatible with type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + (*******************************************************************) -(* Test 12: class parameters and bound vars must have layout value *) +(* Test 12: class parameters and bound vars must have jkind value *) + +(* CR layouts v5: Bring the void versions back here. *) + +(* Hits `Pcl_let` *) +module M12_1f = struct + let f : ('a : float64) . unit -> 'a = fun () -> assert false + class foo12 u = + let d = f u in + object + val bar = () + end;; +end +[%%expect{| +Line 4, characters 8-9: +4 | let d = f u in + ^ +Error: The types of variables bound by a 'let' in a class function + must have layout value. Instead, d's type has layout float64. +|}];; + +(* Hits the Cfk_concrete case of Pcf_val *) +module M12_2f = struct + let f : ('a : float64) . unit -> 'a = fun () -> assert false + class foo u = + object + val bar = f u + end +end;; +[%%expect{| +Line 5, characters 10-13: +5 | val bar = f u + ^^^ +Error: Variables bound in a class must have layout value. + bar has layout float64, which does not overlap with value. +|}];; -(* CR layouts: These tests moved to [basics_alpha.ml] as they need a non-value - sort. Bring back here when we have one enabled by default. *) +(* Hits the Cfk_virtual case of Pcf_val *) +module M12_3f = struct + class virtual foo = + object + val virtual bar : t_float64 + end +end;; +[%%expect{| +Line 4, characters 18-21: +4 | val virtual bar : t_float64 + ^^^ +Error: Variables bound in a class must have layout value. + bar has layout float64, which is not a sublayout of value. +|}];; + +module M12_4f = struct + type ('a : float64) t + + class virtual ['a] foo = + object + val virtual baz : 'a t + end +end +[%%expect{| +Line 6, characters 24-26: +6 | val virtual baz : 'a t + ^^ +Error: This type ('a : float64) should be an instance of type ('a0 : value) + 'a has layout value, which does not overlap with float64. +|}];; + +module M12_5f = struct + type ('a : float64) t = 'a + + class ['a] foo = + object + method void_id (a : 'a t) : 'a t = a + end +end;; +[%%expect{| +Line 6, characters 26-28: +6 | method void_id (a : 'a t) : 'a t = a + ^^ +Error: This type ('a : float64) should be an instance of type ('a0 : value) + 'a has layout value, which does not overlap with float64. +|}];; + +module type S12_6f = sig + type ('a : float64) t = 'a + + class ['a] foo : + 'a t -> + object + method baz : int + end +end;; +[%%expect{| +Line 5, characters 4-6: +5 | 'a t -> + ^^ +Error: This type ('a : float64) should be an instance of type ('a0 : value) + 'a has layout value, which does not overlap with float64. +|}];; + +module type S12_7f = sig + class foo : + object + val baz : t_float64 + end +end;; +[%%expect{| +Line 4, characters 6-25: +4 | val baz : t_float64 + ^^^^^^^^^^^^^^^^^^^ +Error: Variables bound in a class must have layout value. + baz has layout float64, which is not a sublayout of value. +|}];; (***********************************************************) (* Test 13: built-in type constructors work only on values *) -(* CR layouts: These tests moved to [basics_alpha.ml] as they need a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: Bring the void versions over from basics_alpha *) + +(* lazy *) +type t13f = t_float64 Lazy.t;; +[%%expect{| +Line 1, characters 12-21: +1 | type t13f = t_float64 Lazy.t;; + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13f (v : t_float64) = lazy v;; +[%%expect{| +Line 1, characters 32-33: +1 | let x13f (v : t_float64) = lazy v;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let f_id (x : t_float64) = x +let x13f v = + match v with + | lazy v -> f_id v +[%%expect{| +val f_id : t_float64 -> t_float64 = +Line 4, characters 19-20: +4 | | lazy v -> f_id v + ^ +Error: This expression has type ('a : value) + but an expression was expected of type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +(* option *) +(* CR layouts v5: allow this *) +type t13f = t_float64 option;; +[%%expect{| +Line 1, characters 12-21: +1 | type t13f = t_float64 option;; + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13f (v : t_float64) = Some v;; +[%%expect{| +Line 1, characters 32-33: +1 | let x13f (v : t_float64) = Some v;; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13f v = + match v with + | Some v -> f_id v + | None -> assert false +[%%expect{| +Line 3, characters 19-20: +3 | | Some v -> f_id v + ^ +Error: This expression has type ('a : value) + but an expression was expected of type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +(* list *) +type t13f = t_float64 list;; +[%%expect{| +Line 1, characters 12-21: +1 | type t13f = t_float64 list;; + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13 (v : t_float64) = [v];; +[%%expect{| +Line 1, characters 27-28: +1 | let x13 (v : t_float64) = [v];; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13 v = + match v with + | [v] -> f_id v + | _ -> assert false +[%%expect{| +Line 3, characters 16-17: +3 | | [v] -> f_id v + ^ +Error: This expression has type ('a : value) + but an expression was expected of type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +(* array *) +type t13f = t_float64 array;; +[%%expect{| +Line 1, characters 12-21: +1 | type t13f = t_float64 array;; + ^^^^^^^^^ +Error: This type t_float64 should be an instance of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13f (v : t_float64) = [| v |];; +[%%expect{| +Line 1, characters 30-31: +1 | let x13f (v : t_float64) = [| v |];; + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}];; + +let x13f v = + match v with + | [| v |] -> f_id v + | _ -> assert false +[%%expect{| +Line 3, characters 20-21: +3 | | [| v |] -> f_id v + ^ +Error: This expression has type ('a : value) + but an expression was expected of type t_float64 + t_float64 has layout float64, which is not a sublayout of value. +|}];; (****************************************************************************) (* Test 14: Examples motivating the trick with the manifest in [enter_type] *) + type t14 = foo14 list and foo14 = string;; [%%expect{| @@ -167,20 +950,36 @@ type t14 = foo14 list and foo14 = string |}];; -(* CR layouts: Part of this test moved to [basics_alpha.ml] as it needs a - non-value sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: Bring back void version from basics_alpha. *) + +type t14 = foo14 list +and foo14 = t_float64;; +[%%expect{| +Line 2, characters 0-21: +2 | and foo14 = t_float64;; + ^^^^^^^^^^^^^^^^^^^^^ +Error: + foo14 has layout float64, which is not a sublayout of value. +|}];; (****************************************************) -(* Test 15: Type aliases need not have layout value *) +(* Test 15: Type aliases need not have jkind value *) + +(* CR layouts v5: Bring back void version from basics_alpha. *) + +type ('a : float64) t15 +type ('a, 'b) foo15 = ('a as 'b) t15 -> 'b t15;; +[%%expect{| +type ('a : float64) t15 +type ('a : float64, 'b) foo15 = 'a t15 -> 'a t15 constraint 'b = 'a +|}] -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) (********************************************************) (* Test 16: seperability: [msig_of_external_type] logic *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: This test moved to [basics_alpha.ml] as it needs a non-value + sort in a variant. Bring back here when we have one. *) type 'a t_void_16 : void;; [%%expect{| @@ -191,8 +990,8 @@ Error: Layout void is used here, but the appropriate layouts extension is not en |}];; (**************************************************************************) -(* Test 17: incremental layout checking of @@unboxed types - see comment on - [constrain_type_layout]. *) +(* Test 17: incremental jkind checking of @@unboxed types - see comment on + [constrain_type_jkind]. *) type 'a t17 = 'a list type s17 = { lbl : s17 t17 } [@@unboxed];; @@ -204,7 +1003,7 @@ type s17 = { lbl : s17 t17; } [@@unboxed] (*****************************************) (* Test 18: expansion in [check_univars] *) -(* This test isn't really layouts-specific, but it checks that the layout checks +(* This test isn't really jkinds-specific, but it checks that the jkind checks we've added in [Typecore.check_univars] don't choke when expansion is needed to see a variable *) type 'a t18 = 'a @@ -222,120 +1021,445 @@ val f18 : 'a -> 'a = (********************************) (* Test 19: non-value coercions *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let f19f () = + let x : t_float64 = assert false in + let _y = (x :> t_float64) in + ();; +[%%expect{| +val f19f : unit -> unit = +|}];; (********************************************) (* Test 20: Non-value bodies for let module *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let f20f () = + let x : t_float64 = assert false in + let _y = + let module M = struct end in + x + in + ();; +[%%expect{| +val f20f : unit -> unit = +|}];; (**********************************) (* Test 21: Non-value unpack body *) +module type M21 = sig end -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let f21f () = + let x : t_float64 = assert false in + let _y = + let (module M) = (module struct end : M21) in + x + in + ();; +[%%expect{| +module type M21 = sig end +val f21f : unit -> unit = +|}];; (***************************************************************) (* Test 22: approx_type catch-all can't be restricted to value *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +type ('a : float64) t22f = 'a -type t_void : void;; +let f () = + let rec g x : _ t22f = g x in + g (assert false);; [%%expect{| -Line 1, characters 14-18: -1 | type t_void : void;; - ^^^^ -Error: Layout void is used here, but the appropriate layouts extension is not enabled +type ('a : float64) t22f = 'a +val f : ('a : float64). unit -> 'a t22f t22f = |}];; -(* CR layouts v5: Once we allow non-value top-level module definitions, add - tests showing that things get defaulted to value. -*) (********************************************************************) (* Test 23: checking the error message from impossible GADT matches *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +type (_ : any, _ : any) eq = Refl : ('a, 'a) eq + +module Mf : sig + type t_float64 : float64 + type t_imm : immediate +end = struct + type t_float64 : float64 + type t_imm : immediate +end +(* these are abstract, so the only trouble with unifying them in a GADT + match is around their layouts *) + +let f (x : (Mf.t_float64, Mf.t_imm) eq) = + match x with + | Refl -> () + +[%%expect{| +type (_ : any, _ : any) eq = Refl : ('a : any). ('a, 'a) eq +module Mf : sig type t_float64 : float64 type t_imm : immediate end +Line 15, characters 4-8: +15 | | Refl -> () + ^^^^ +Error: This pattern matches values of type (Mf.t_float64, Mf.t_float64) eq + but a pattern was expected which matches values of type + (Mf.t_float64, Mf.t_imm) eq + Mf.t_float64 has layout float64, + which does not overlap with immediate. +|}] (*****************************************************) (* Test 24: Polymorphic parameter with exotic layout *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) +type 'a t2_float : float64 + +let f (x : 'a. 'a t2_float) = x + +[%%expect{| +type 'a t2_float : float64 +val f : ('a. 'a t2_float) -> 'b t2_float = +|}] (**************************************************) (* Test 25: Optional parameter with exotic layout *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let f (x : t_float64) = + let g ?(x2 = x) () = () in + () + +[%%expect{| +Line 2, characters 15-16: +2 | let g ?(x2 = x) () = () in + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}] (*********************************************************) (* Test 26: Inferring an application to an exotic layout *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let g f (x : t_float64) : t_float64 = f x + +[%%expect{| +val g : (t_float64 -> t_float64) -> t_float64 -> t_float64 = +|}] (******************************************) (* Test 27: Exotic layouts in approx_type *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let rec f : _ -> _ = fun (x : t_float64) -> x + +[%%expect{| +val f : t_float64 -> t_float64 = +|}] (************************************) (* Test 28: Exotic layouts in letop *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +(* 28.1: non-value letop arg *) +let ( let* ) (x : t_float64) f = () + +let q () = + let* x = assert false in + () + +[%%expect{| +val ( let* ) : t_float64 -> 'a -> unit = +val q : unit -> unit = +|}] + +(* 28.2: non-value letop binder arg without and *) +let ( let* ) x (f : t_float64 -> _) = () + +let q () = + let* x = assert false in + () + +[%%expect{| +val ( let* ) : 'a -> (t_float64 -> 'b) -> unit = +val q : unit -> unit = +|}] + +(* 28.3: non-value letop binder result *) +let ( let* ) x (f : _ -> t_float64) = () + +let q () = + let* x = assert false in + assert false + +[%%expect{| +val ( let* ) : 'a -> ('b -> t_float64) -> unit = +val q : unit -> unit = +|}] + +(* 28.4: non-value letop result *) +let ( let* ) x f : t_float64 = assert false + +let q () = + let* x = 5 in + () + +[%%expect{| +val ( let* ) : 'a -> 'b -> t_float64 = +val q : unit -> t_float64 = +|}] + +(* 28.5: non-value andop second arg *) +let ( let* ) x f = () +let ( and* ) x1 (x2 : t_float64) = () +let q () = + let* x = 5 + and* y = assert false + in + () + +[%%expect{| +val ( let* ) : 'a -> 'b -> unit = +val ( and* ) : 'a -> t_float64 -> unit = +val q : unit -> unit = +|}] + +(* 28.6: non-value andop first arg *) +let ( let* ) x f = () +let ( and* ) (x1 : t_float64) x2 = () +let q () = + let* x = assert false + and* y = 5 + in + () + +[%%expect{| +val ( let* ) : 'a -> 'b -> unit = +val ( and* ) : t_float64 -> 'a -> unit = +val q : unit -> unit = +|}] + +(* 28.7: non-value andop result *) +let ( let* ) (x : (_ : float64)) f = () +let ( and* ) x1 x2 : t_float64 = assert false +let q () = + let* x = 5 + and* y = 5 + in + () + +[%%expect{| +val ( let* ) : 'b ('a : float64). 'a -> 'b -> unit = +val ( and* ) : 'a -> 'b -> t_float64 = +val q : unit -> unit = +|}] + +(* 28.8: non-value letop binder arg with and *) +let ( let* ) x f = () +let ( and* ) x1 x2 = assert false +let q () = + let* x : t_float64 = assert false + and* y = 5 + in + () + +[%%expect{| +val ( let* ) : 'a -> 'b -> unit = +val ( and* ) : '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) + t_float64 has layout float64, which is not a sublayout of value. +|}] (*******************************************) (* Test 29: [external]s default to [value] *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +external eq : 'a -> 'a -> bool = "%equal" +let mk_float64 () : t_float64 = assert false +let x () = eq (mk_float64 ()) (mk_float64 ()) + +[%%expect{| +external eq : 'a -> 'a -> bool = "%equal" +val mk_float64 : unit -> t_float64 = +Line 3, characters 14-29: +3 | let x () = eq (mk_float64 ()) (mk_float64 ()) + ^^^^^^^^^^^^^^^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}] (**************************************) (* Test 30: [val]s default to [value] *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +module M : sig + val f : 'a -> 'a +end = struct + let f x = x +end + +let g (x : t_float64) = M.f x + +[%%expect{| +module M : sig val f : 'a -> 'a end +Line 7, characters 28-29: +7 | let g (x : t_float64) = M.f x + ^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}] (**************************************************) (* Test 31: checking that #poly_var patterns work *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +type ('a : float64) poly_var = [`A of int * 'a | `B] + +let f #poly_var = "hello" + +[%%expect{| +Line 1, characters 44-46: +1 | type ('a : float64) poly_var = [`A of int * 'a | `B] + ^^ +Error: This type ('a : value) should be an instance of type ('a0 : float64) + 'a has layout float64, which does not overlap with value. +|}] (*********************************************************) (* Test 32: Polymorphic variant constructors take values *) -(* CR layouts: This test moved to [basics_alpha.ml] as it needs a non-value - sort. Bring back here when we have one enabled by default. *) +(* CR layouts v5: bring void version here from layouts_alpha *) + +let f _ = `Mk (assert false : t_float64) + +[%%expect{| +Line 1, characters 14-40: +1 | let f _ = `Mk (assert false : t_float64) + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: This expression has type t_float64 + but an expression was expected of type ('a : value) + t_float64 has layout float64, which is not a sublayout of value. +|}] (******************************************************) (* Test 33: Externals must have representable types *) -(* CR layouts v2.5: This test moved to [basics_alpha.ml] as it needs a - non-representable layout. Bring it back here when we can mention [t_any] in - [-extension layouts]. *) +external foo33 : t_any = "foo33";; + +[%%expect{| +Line 1, characters 17-22: +1 | external foo33 : t_any = "foo33";; + ^^^^^ +Error: This type signature for foo33 is not a value type. + foo33 has layout any, which is not a sublayout of value. +|}] (****************************************************) (* Test 34: Layout clash in polymorphic record type *) -(* CR layouts: This test moved to [basics_beta.ml] as it needs an immediate - type parameter. Bring back here when we have one enabled by default. *) +type ('a : immediate) t2_imm + +type s = { f : ('a : value) . 'a -> 'a u } +and 'a u = 'a t2_imm + +[%%expect {| +type ('a : immediate) t2_imm +Line 3, characters 15-40: +3 | type s = { f : ('a : value) . 'a -> 'a u } + ^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Layout mismatch in final type declaration consistency check. + This is most often caused by the fact that type inference is not + clever enough to propagate layouts through variables in different + declarations. It is also not clever enough to produce a good error + message, so we'll say this instead: + 'a has layout value, which is not a sublayout of immediate. + The fix will likely be to add a layout annotation on a parameter to + the declaration where this error is reported. +|}] (****************************************************) (* Test 35: check bad layout error in filter_arrow *) -(* CR layouts: This test moved to [basics_beta.ml] as it needs an immediate - type parameter. Bring back here when we have one enabled by default. *) +type ('a : immediate) t35 = 'a +let f35 : 'a t35 = fun () -> () + +[%%expect {| +type ('a : immediate) t35 = 'a +Line 2, characters 19-31: +2 | let f35 : 'a t35 = fun () -> () + ^^^^^^^^^^^^ +Error: + 'a -> 'b has layout value, which is not a sublayout of immediate. +|}] (**************************************************) (* Test 36: Disallow non-representable statements *) -(* CR layouts: This test moved to [basics_beta.ml]. Bring here when we have - non-representable layouts enabled by default. *) +let () = (assert false : t_any); () +[%%expect{| +Line 1, characters 9-31: +1 | let () = (assert false : t_any); () + ^^^^^^^^^^^^^^^^^^^^^^ +Warning 10 [non-unit-statement]: this expression should have type unit. + +Line 1, characters 10-22: +1 | let () = (assert false : t_any); () + ^^^^^^^^^^^^ +Error: This expression has type t_any but an expression was expected of type + ('a : '_representable_layout_5) + because it is in the left-hand side of a sequence + t_any has layout any, which is not representable. +|}] + +let () = while false do (assert false : t_any); done +[%%expect{| +Line 1, characters 24-46: +1 | let () = while false do (assert false : t_any); done + ^^^^^^^^^^^^^^^^^^^^^^ +Warning 10 [non-unit-statement]: this expression should have type unit. + +Line 1, characters 25-37: +1 | let () = while false do (assert false : t_any); done + ^^^^^^^^^^^^ +Error: This expression has type t_any but an expression was expected of type + ('a : '_representable_layout_6) + because it is in the body of a while-loop + t_any has layout any, which is not representable. +|}] + +let () = for i = 0 to 0 do (assert false : t_any); done +[%%expect{| +Line 1, characters 27-49: +1 | let () = for i = 0 to 0 do (assert false : t_any); done + ^^^^^^^^^^^^^^^^^^^^^^ +Warning 10 [non-unit-statement]: this expression should have type unit. + +Line 1, characters 28-40: +1 | let () = for i = 0 to 0 do (assert false : t_any); done + ^^^^^^^^^^^^ +Error: This expression has type t_any but an expression was expected of type + ('a : '_representable_layout_7) + because it is in the body of a for-loop + t_any has layout any, which is not representable. +|}] diff --git a/ocaml/testsuite/tests/typing-layouts/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts/basics_beta.ml index 4c1999730f5..dc86ed0d4d4 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics_beta.ml @@ -1,8 +1,9 @@ (* TEST - flags = "-extension layouts_beta" * expect + flags = "-extension layouts_beta" *) + type t_value : value type t_imm : immediate type t_imm64 : immediate64 diff --git a/ocaml/testsuite/tests/typing-layouts/datatypes.ml b/ocaml/testsuite/tests/typing-layouts/datatypes.ml index d6d72ba3c15..b2098b88280 100644 --- a/ocaml/testsuite/tests/typing-layouts/datatypes.ml +++ b/ocaml/testsuite/tests/typing-layouts/datatypes.ml @@ -1,6 +1,8 @@ (* TEST * expect flags = "-extension layouts" + * expect + flags = "-extension layouts_beta" *) (* Tests for jkinds in algebraic datatypes *) @@ -9,17 +11,11 @@ type t_value : value type t_immediate : immediate;; +type t_any : any;; [%%expect {| type t_value : value type t_immediate : immediate -|}];; - -type t_any : any;; -[%%expect{| -Line 1, characters 13-16: -1 | type t_any : any;; - ^^^ -Error: Layout any is used here, but the appropriate layouts extension is not enabled +type t_any : any |}];; type t_void : void;; @@ -30,64 +26,331 @@ Line 1, characters 14-18: Error: Layout void is used here, but the appropriate layouts extension is not enabled |}];; -(***************************************************) -(* Test 1: constructor arguments may have any sort *) +(********************************************************) +(* Test 1: constructor arguments may be values or voids *) -(* CR layouts: Needs non-value jkind - moved to [datatypes_alpha.ml] *) +(* CR layouts v5: Needs void - moved to [datatypes_alpha.ml] *) (************************************) (* Test 2: but not the "any" layout *) -(* CR layouts: Needs the ability to talk about any - moved to - [datatypes_alpha.ml] *) +type t2_any1 = T2_any1 of t_any +[%%expect {| +Line 1, characters 15-31: +1 | type t2_any1 = T2_any1 of t_any + ^^^^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t2_any2 = T2_any2 of t_immediate * t_any +[%%expect {| +Line 1, characters 15-45: +1 | type t2_any2 = T2_any2 of t_immediate * t_any + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t2_any3 = T2_any3 of t_any * t_value +[%%expect {| +Line 1, characters 15-41: +1 | type t2_any3 = T2_any3 of t_any * t_value + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type 'a t1_constraint = T1_con of 'a constraint 'a = 'b t1_constraint' +and 'b t1_constraint' = t_any +[%%expect {| +Line 2, characters 0-29: +2 | and 'b t1_constraint' = t_any + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: + 'b t1_constraint' has layout any, which is not representable. +|}] (******************************************************) (* Test 3: void allowed in records, but not by itself *) -(* CR layouts: Needs void - moved to [datatypes_alpha.ml]. Will change by the - time we add back void anyway. *) +(* CR layouts v5: Needs void - moved to [datatypes_alpha.ml]. Will change by + the time we add back void anyway. *) (**************************) (* Test 4: but any is not *) -(* CR layouts: Needs the ability to talk about any - moved to - [datatypes_alpha.ml] *) +type t4_any1 = { x : t_any } +[%%expect {| +Line 1, characters 17-26: +1 | type t4_any1 = { x : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_any2 = { x : t_immediate; y : t_any } +[%%expect {| +Line 1, characters 34-43: +1 | type t4_any2 = { x : t_immediate; y : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_any3 = { x : t_any; y : t_value } +[%%expect {| +Line 1, characters 18-28: +1 | type t4_any3 = { x : t_any; y : t_value } + ^^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany1 = C of { x : t_any } +[%%expect {| +Line 1, characters 23-32: +1 | type t4_cany1 = C of { x : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany2 = C of { x : t_immediate; y : t_any } +[%%expect {| +Line 1, characters 40-49: +1 | type t4_cany2 = C of { x : t_immediate; y : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany3 = C of { x : t_any; y : t_value } +[%%expect {| +Line 1, characters 23-33: +1 | type t4_cany3 = C of { x : t_any; y : t_value } + ^^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +(*********************************************************) +(* Test 5: These same rules apply to extensible variants *) + +(* CR layouts v5: void parts of this test from datatypes_alpha. *) +type t4_any1 = { x : t_any } +[%%expect {| +Line 1, characters 17-26: +1 | type t4_any1 = { x : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_any2 = { x : t_immediate; y : t_any } +[%%expect {| +Line 1, characters 34-43: +1 | type t4_any2 = { x : t_immediate; y : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_any3 = { x : t_any; y : t_value } +[%%expect {| +Line 1, characters 18-28: +1 | type t4_any3 = { x : t_any; y : t_value } + ^^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany1 = C of { x : t_any } +[%%expect {| +Line 1, characters 23-32: +1 | type t4_cany1 = C of { x : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany2 = C of { x : t_immediate; y : t_any } +[%%expect {| +Line 1, characters 40-49: +1 | type t4_cany2 = C of { x : t_immediate; y : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t4_cany3 = C of { x : t_any; y : t_value } +[%%expect {| +Line 1, characters 23-33: +1 | type t4_cany3 = C of { x : t_any; y : t_value } + ^^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; (*********************************************************) (* Test 5: These same rules apply to extensible variants *) -(* CR layouts: Needs void and the ability to talk about any - moved to - [datatypes_alpha.ml] *) +(* CR layouts v5: void parts of this test from [datatypes_alpha] *) +type t5 = .. + +type t5 += T5_2 of t_value +type t5 += T5_3 of t_immediate + +type t5 += T5_6 of t_value * t_immediate;; +[%%expect{| +type t5 = .. +type t5 += T5_2 of t_value +type t5 += T5_3 of t_immediate +type t5 += T5_6 of t_value * t_immediate +|}] + + +type t5 += T5_7 of t_any +[%%expect {| +Line 1, characters 11-24: +1 | type t5 += T5_7 of t_any + ^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t5 += T5_8 of t_immediate * t_any +[%%expect {| +Line 1, characters 11-38: +1 | type t5 += T5_8 of t_immediate * t_any + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t5 += T5_9 of t_any * t_value +[%%expect {| +Line 1, characters 11-34: +1 | type t5 += T5_9 of t_any * t_value + ^^^^^^^^^^^^^^^^^^^^^^^ +Error: Constructor argument types must have a representable layout. + t_any has layout any, which is not representable. +|}];; + +type t5 += T5_11 of { x : t_value } +type t5 += T5_12 of { x : t_immediate } + +type t5 += T5_15 of { x : t_value; y : t_immediate };; +[%%expect{| +type t5 += T5_11 of { x : t_value; } +type t5 += T5_12 of { x : t_immediate; } +type t5 += T5_15 of { x : t_value; y : t_immediate; } +|}];; + +type t5 += T5_17 of { x : t_immediate; y : t_any } +[%%expect {| +Line 1, characters 39-48: +1 | type t5 += T5_17 of { x : t_immediate; y : t_any } + ^^^^^^^^^ +Error: Record element types must have a representable layout. + t_any has layout any, which is not representable. +|}];; (**************************************************************************) (* Test 6: fields in all-float records get jkind value. may change in the future, but record fields must at least be representable. *) - -(* CR layouts: Needs jkind annotations on type parameters. Moved to - [datatypes_beta.ml]. Bring back when that isn't behind an extension flag. *) - type t6 = { fld6 : float } type ('a : immediate) s6 = S6 of 'a -[%%expect{| + +let f6 x = + let { fld6 = fld6 } = x in fld6 + +let f6' x = + let { fld6 = fld6 } = x in S6 fld6;; +[%%expect {| type t6 = { fld6 : float; } -Line 2, characters 11-20: -2 | type ('a : immediate) s6 = S6 of 'a - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. -|}] +type ('a : immediate) s6 = S6 of 'a +val f6 : t6 -> float = +Line 8, characters 32-36: +8 | let { fld6 = fld6 } = x in S6 fld6;; + ^^^^ +Error: This expression has type float but an expression was expected of type + ('a : immediate) + float has layout value, which is not a sublayout of immediate. +|}];; (*****************************************************) (* Test 7: Recursive propagation of immediacy checks *) -(* CR layouts: copy test from datatypes_alpha with float64 when available *) +(* CR layouts v5: copy test from datatypes_alpha when non-values can go in + general datatype declarations. *) (***********************************************************************) (* Test 8: Type parameters in the presence of recursive concrete usage *) (* CR layouts: copy test from datatypes_alpha with float64 when available *) +type t_float64 : float64 +type ('a : float64) float64_t + +[%%expect {| +type t_float64 : float64 +type ('a : float64) float64_t +|}] + +type 'b t = 'b float64_t * t2 +and t2 = t_float64 float64_t + +[%%expect {| +type ('b : float64) t = 'b float64_t * t2 +and t2 = t_float64 float64_t +|}] + +type 'b t = 'b float64_t * t2 +and t2 = Mk1 of t_float64 t | Mk2 + +[%%expect {| +type ('b : float64) t = 'b float64_t * t2 +and t2 = Mk1 of t_float64 t | Mk2 +|}] + +type 'a t8_5 = { x : 'a t8_6; y : string} +and 'a t8_6 = 'a float64_t;; +[%%expect {| +Line 1, characters 21-28: +1 | type 'a t8_5 = { x : 'a t8_6; y : string} + ^^^^^^^ +Error: Layout mismatch in final type declaration consistency check. + This is most often caused by the fact that type inference is not + clever enough to propagate layouts through variables in different + declarations. It is also not clever enough to produce a good error + message, so we'll say this instead: + 'a has layout float64, which does not overlap with value. + The fix will likely be to add a layout annotation on a parameter to + the declaration where this error is reported. +|}] + + (*****************************************************************************) (* Test 9: Looking through polytypes in mutually recursive type declarations *) -(* CR layouts: copy test from datatypes_beta float64 is available. *) +type 'a t9_1 = unit +and t9_2 = { x : string t9_1 } +and t9_3 = { x : 'a. 'a t9_1 } + +[%%expect {| +type 'a t9_1 = unit +and t9_2 = { x : string t9_1; } +and t9_3 = { x : 'a. 'a t9_1; } +|}] + +type 'a floaty = float# +and t9_4 = { x : float#; y : string floaty } +and t9_5 = { x : float#; y : 'a. 'a floaty } + +[%%expect {| +type 'a floaty = float# +and t9_4 = { x : float#; y : string floaty; } +and t9_5 = { x : float#; y : 'a. 'a floaty; } +|}] + diff --git a/ocaml/testsuite/tests/typing-layouts/datatypes_beta.ml b/ocaml/testsuite/tests/typing-layouts/datatypes_beta.ml deleted file mode 100644 index 3947166c421..00000000000 --- a/ocaml/testsuite/tests/typing-layouts/datatypes_beta.ml +++ /dev/null @@ -1,313 +0,0 @@ -(* TEST - flags = "-extension layouts_beta" - * expect -*) - -(* Tests for jkinds in algebraic datatypes *) - -(* CR layouts v5: add mixed block restriction tests. *) - -type t_value : value -type t_immediate : immediate;; -type t_any : any;; -[%%expect {| -type t_value : value -type t_immediate : immediate -type t_any : any -|}];; - -type t_void : void;; -[%%expect{| -Line 1, characters 14-18: -1 | type t_void : void;; - ^^^^ -Error: Layout void is used here, but the appropriate layouts extension is not enabled -|}];; - -(********************************************************) -(* Test 1: constructor arguments may be values or voids *) - -(* CR layouts v5: Needs void - moved to [datatypes_alpha.ml] *) - -(************************************) -(* Test 2: but not the "any" layout *) - -type t2_any1 = T2_any1 of t_any -[%%expect {| -Line 1, characters 15-31: -1 | type t2_any1 = T2_any1 of t_any - ^^^^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t2_any2 = T2_any2 of t_immediate * t_any -[%%expect {| -Line 1, characters 15-45: -1 | type t2_any2 = T2_any2 of t_immediate * t_any - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t2_any3 = T2_any3 of t_any * t_value -[%%expect {| -Line 1, characters 15-41: -1 | type t2_any3 = T2_any3 of t_any * t_value - ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type 'a t1_constraint = T1_con of 'a constraint 'a = 'b t1_constraint' -and 'b t1_constraint' = t_any -[%%expect {| -Line 2, characters 0-29: -2 | and 'b t1_constraint' = t_any - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: - 'b t1_constraint' has layout any, which is not representable. -|}] - -(******************************************************) -(* Test 3: void allowed in records, but not by itself *) - -(* CR layouts v5: Needs void - moved to [datatypes_alpha.ml]. Will change by - the time we add back void anyway. *) - -(**************************) -(* Test 4: but any is not *) - -type t4_any1 = { x : t_any } -[%%expect {| -Line 1, characters 17-26: -1 | type t4_any1 = { x : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_any2 = { x : t_immediate; y : t_any } -[%%expect {| -Line 1, characters 34-43: -1 | type t4_any2 = { x : t_immediate; y : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_any3 = { x : t_any; y : t_value } -[%%expect {| -Line 1, characters 18-28: -1 | type t4_any3 = { x : t_any; y : t_value } - ^^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany1 = C of { x : t_any } -[%%expect {| -Line 1, characters 23-32: -1 | type t4_cany1 = C of { x : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany2 = C of { x : t_immediate; y : t_any } -[%%expect {| -Line 1, characters 40-49: -1 | type t4_cany2 = C of { x : t_immediate; y : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany3 = C of { x : t_any; y : t_value } -[%%expect {| -Line 1, characters 23-33: -1 | type t4_cany3 = C of { x : t_any; y : t_value } - ^^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -(*********************************************************) -(* Test 5: These same rules apply to extensible variants *) - -(* CR layouts v5: void parts of this test from datatypes_alpha. *) -type t4_any1 = { x : t_any } -[%%expect {| -Line 1, characters 17-26: -1 | type t4_any1 = { x : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_any2 = { x : t_immediate; y : t_any } -[%%expect {| -Line 1, characters 34-43: -1 | type t4_any2 = { x : t_immediate; y : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_any3 = { x : t_any; y : t_value } -[%%expect {| -Line 1, characters 18-28: -1 | type t4_any3 = { x : t_any; y : t_value } - ^^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany1 = C of { x : t_any } -[%%expect {| -Line 1, characters 23-32: -1 | type t4_cany1 = C of { x : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany2 = C of { x : t_immediate; y : t_any } -[%%expect {| -Line 1, characters 40-49: -1 | type t4_cany2 = C of { x : t_immediate; y : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t4_cany3 = C of { x : t_any; y : t_value } -[%%expect {| -Line 1, characters 23-33: -1 | type t4_cany3 = C of { x : t_any; y : t_value } - ^^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -(*********************************************************) -(* Test 5: These same rules apply to extensible variants *) - -(* CR layouts v5: void parts of this test from [datatypes_alpha] *) -type t5 = .. - -type t5 += T5_2 of t_value -type t5 += T5_3 of t_immediate - -type t5 += T5_6 of t_value * t_immediate;; -[%%expect{| -type t5 = .. -type t5 += T5_2 of t_value -type t5 += T5_3 of t_immediate -type t5 += T5_6 of t_value * t_immediate -|}] - - -type t5 += T5_7 of t_any -[%%expect {| -Line 1, characters 11-24: -1 | type t5 += T5_7 of t_any - ^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t5 += T5_8 of t_immediate * t_any -[%%expect {| -Line 1, characters 11-38: -1 | type t5 += T5_8 of t_immediate * t_any - ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t5 += T5_9 of t_any * t_value -[%%expect {| -Line 1, characters 11-34: -1 | type t5 += T5_9 of t_any * t_value - ^^^^^^^^^^^^^^^^^^^^^^^ -Error: Constructor argument types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -type t5 += T5_11 of { x : t_value } -type t5 += T5_12 of { x : t_immediate } - -type t5 += T5_15 of { x : t_value; y : t_immediate };; -[%%expect{| -type t5 += T5_11 of { x : t_value; } -type t5 += T5_12 of { x : t_immediate; } -type t5 += T5_15 of { x : t_value; y : t_immediate; } -|}];; - -type t5 += T5_17 of { x : t_immediate; y : t_any } -[%%expect {| -Line 1, characters 39-48: -1 | type t5 += T5_17 of { x : t_immediate; y : t_any } - ^^^^^^^^^ -Error: Record element types must have a representable layout. - t_any has layout any, which is not representable. -|}];; - -(**************************************************************************) -(* Test 6: fields in all-float records get jkind value. may change in the - future, but record fields must at least be representable. *) -type t6 = { fld6 : float } -type ('a : immediate) s6 = S6 of 'a - -let f6 x = - let { fld6 = fld6 } = x in fld6 - -let f6' x = - let { fld6 = fld6 } = x in S6 fld6;; -[%%expect {| -type t6 = { fld6 : float; } -type ('a : immediate) s6 = S6 of 'a -val f6 : t6 -> float = -Line 8, characters 32-36: -8 | let { fld6 = fld6 } = x in S6 fld6;; - ^^^^ -Error: This expression has type float but an expression was expected of type - ('a : immediate) - float has layout value, which is not a sublayout of immediate. -|}];; - -(*****************************************************) -(* Test 7: Recursive propagation of immediacy checks *) - -(* CR layouts v5: copy test from datatypes_alpha when non-values can go in - general datatype declarations. *) - -(***********************************************************************) -(* Test 8: Type parameters in the presence of recursive concrete usage *) - -(* CR layouts v5: copy test from datatypes_alpha when non-values can go in - general datatype declarations. *) - -(*****************************************************************************) -(* Test 9: Looking through polytypes in mutually recursive type declarations *) - -type 'a t9_1 = unit -and t9_2 = { x : string t9_1 } -and t9_3 = { x : 'a. 'a t9_1 } - -[%%expect {| -type 'a t9_1 = unit -and t9_2 = { x : string t9_1; } -and t9_3 = { x : 'a. 'a t9_1; } -|}] - -type 'a floaty = float# -and t9_4 = { x : float#; y : string floaty } -and t9_5 = { x : float#; y : 'a. 'a floaty } - -[%%expect {| -type 'a floaty = float# -and t9_4 = { x : float#; y : string floaty; } -and t9_5 = { x : float#; y : 'a. 'a floaty; } -|}] diff --git a/ocaml/testsuite/tests/typing-layouts/modules.ml b/ocaml/testsuite/tests/typing-layouts/modules.ml index a41bfb0428c..c6fa3d3cc9f 100644 --- a/ocaml/testsuite/tests/typing-layouts/modules.ml +++ b/ocaml/testsuite/tests/typing-layouts/modules.ml @@ -5,19 +5,15 @@ type t_value : value type t_imm : immediate -type t_imm64 : immediate64;; +type t_imm64 : immediate64 +type t_float64 : float64 +type t_any : any;; [%%expect {| type t_value : value type t_imm : immediate type t_imm64 : immediate64 -|}];; - -type t_any : any;; -[%%expect{| -Line 1, characters 15-18: -1 | type t_any : any;; - ^^^ -Error: Layout any is used here, but the appropriate layouts extension is not enabled +type t_float64 : float64 +type t_any : any |}];; type t_void : void;; @@ -31,9 +27,8 @@ Error: Layout void is used here, but the appropriate layouts extension is not en (*********************************************************) (* Test 1: Simple with type constraints respect jkinds. *) -(* CR layouts: parts of this test moved to [modules_alpha.ml] because they - need a non-value jkind. Bring back here when we have one enabled by - default. *) +(* CR layouts v5: parts of this test moved to [modules_alpha.ml] because they + need void. Bring back here when we have it. *) module type S1 = sig type ('a : void) t type s @@ -46,40 +41,149 @@ Error: Layout void is more experimental than allowed by -extension layouts. You must enable -extension layouts_alpha to use this feature. |}];; -(* CR layouts: parts of this test moved to [modules_beta.ml] because they need - immediate annotations on type parameters. Bring back here when we turn that - on by default. *) -module type S1_2 = sig - type ('a : immediate) t +module type S1f = sig + type ('a : float64) t + type s end;; + +type ('a : float64) t1;; + +module type S1f' = S1f with type 'a t = t_float64 t1 and type s = t_float64 t1;; + [%%expect {| -Line 2, characters 13-22: -2 | type ('a : immediate) t - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +module type S1f = sig type ('a : float64) t type s end +type ('a : float64) t1 +module type S1f' = + sig type ('a : float64) t = t_float64 t1 type s = t_float64 t1 end |}];; +module type S1f'' = S1f with type 'a t = 'a list;; +[%%expect {| +Line 1, characters 34-36: +1 | module type S1f'' = S1f with type 'a t = 'a list;; + ^^ +Error: The type constraints are not consistent. + Type ('a : value) is not compatible with type ('b : float64) + 'a has layout float64, which does not overlap with value. +|}];; + +module type S1f'' = S1f with type s = t_float64;; + +[%%expect{| +Line 1, characters 29-47: +1 | module type S1f'' = S1f with type s = t_float64;; + ^^^^^^^^^^^^^^^^^^ +Error: Type t_float64 has layout float64, which is not a sublayout of value. +|}] + +module type S1_2 = sig + type ('a : immediate) t +end + +module type S1_2' = S1_2 with type 'a t = 'a list + +module M1_2' : S1_2' = struct + type ('a : immediate) t = 'a list +end;; +[%%expect{| +module type S1_2 = sig type ('a : immediate) t end +module type S1_2' = sig type ('a : immediate) t = 'a list end +module M1_2' : S1_2' +|}] + +(* CR layouts - annoyingly, the immediate annotation on 'a is required. We + can probably relax this so you don't have to label the parameter explcitly + and the jkind is determined from the signature. But we anticipate it'll + require non-trivial refactoring of eqtype, so we've put it off for now. *) +module M1_2'': S1_2' = struct + type 'a t = 'a list +end;; +[%%expect{| +Lines 1-3, characters 23-3: +1 | .......................struct +2 | type 'a t = 'a list +3 | end.. +Error: Signature mismatch: + Modules do not match: + sig type 'a t = 'a list end + is not included in + S1_2' + Type declarations do not match: + type 'a t = 'a list + is not included in + type ('a : immediate) t = 'a list + The type ('a : value) is not equal to the type ('a0 : immediate) + because their layouts are different. +|}] + +module M1_2''' : S1_2 = struct + type 'a t = 'a list +end;; +[%%expect{| +Lines 1-3, characters 24-3: +1 | ........................struct +2 | type 'a t = 'a list +3 | end.. +Error: Signature mismatch: + Modules do not match: + sig type 'a t = 'a list end + is not included in + S1_2 + Type declarations do not match: + type 'a t = 'a list + is not included in + type ('a : immediate) t + Their parameters differ: + The type ('a : value) is not equal to the type ('a0 : immediate) + because their layouts are different. +|}] + (************************************************************************) (* Test 2: with type constraints for fixed types (the complicated case of Type_mod.merge_constraint) *) - -(* CR layouts: this test moved to [modules_beta.ml] because it needs immediate - annotations on type parameters. Bring back here when we turn that on by - default. *) module type S2 = sig type ('a : immediate) t +end + +type ('a : immediate) r2 = R +type ('a : immediate) s2 = private [> `A of 'a r2] + +module type T2 = S2 with type 'a t = 'a s2 + +module F2 (X : T2) = struct + let f () : 'a X.t = `A R end;; [%%expect{| -Line 2, characters 13-22: -2 | type ('a : immediate) t - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. -|}];; +module type S2 = sig type ('a : immediate) t end +type ('a : immediate) r2 = R +type (!'a : immediate) s2 = private [> `A of 'a r2 ] +module type T2 = sig type ('a : immediate) t = 'a s2 end +module F2 : + functor (X : T2) -> sig val f : ('a : immediate). unit -> 'a X.t end +|}] + +type ('a : immediate) s2' = private [> `B of 'a] +module type T2' = S2 with type 'a t = 'a s2' + +module F2' (X : T2') = struct + let f () : 'a X.t = `B "bad" +end +[%%expect{| +type (!'a : immediate) s2' = private [> `B of 'a ] +module type T2' = sig type ('a : immediate) t = 'a s2' end +Line 5, characters 25-30: +5 | let f () : 'a X.t = `B "bad" + ^^^^^ +Error: This expression has type string but an expression was expected of type + ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] (******************************************************************) (* Test 3: Recursive modules, with and without jkind annotations *) + +(* CR layouts v5: Some parts of this test need void. *) + module rec Foo3 : sig val create : Bar3.t -> unit end = struct @@ -96,9 +200,6 @@ module rec Foo3 : sig val create : Bar3.t -> unit end and Bar3 : sig type t end |}];; -(* CR layouts: parts of this test moved to [modules_alpha.ml] because they - need a non-value jkind. Bring back here when we have one enabled by - default. *) module rec Foo3 : sig val create : Bar3.t -> unit end = struct @@ -117,6 +218,22 @@ Line 8, characters 11-15: Error: Layout void is used here, but the appropriate layouts extension is not enabled |}];; +module rec Foo3f : sig + val create : Bar3f.t -> unit +end = struct + let create _ = () +end + +and Bar3f : sig + type t : float64 +end = struct + type t : float64 +end;; +[%%expect {| +module rec Foo3f : sig val create : Bar3f.t -> unit end +and Bar3f : sig type t : float64 end +|}];; + module rec Foo3 : sig type t : immediate = Bar3.t end = struct @@ -151,22 +268,159 @@ module rec Foo3 : sig type t = Bar3.t end and Bar3 : sig type t : immediate end |}];; -(* CR layouts: more bits moved to [modules_alpha.ml] from down here. *) +module rec Foo3f : sig + type 'a t = 'a Bar3f.t * 'a list +end = struct + type t = 'a Bar3f.t * 'a list +end + +and Bar3f : sig + type ('a : float64) t +end = struct + type 'a t +end;; +[%%expect {| +Line 2, characters 27-29: +2 | type 'a t = 'a Bar3f.t * 'a list + ^^ +Error: This type ('a : float64) should be an instance of type ('b : value) + 'a has layout float64, which does not overlap with value. +|}];; + +type t3f : float64 + +module rec Foo3f : sig + type t = t3f +end = struct + type t = t3f +end + +and Bar3f : sig + type ('a : float64) t + + type s = Foo3f.t t +end = struct + type ('a : float64) t + type s = Foo3f.t t +end;; +[%%expect {| +type t3f : float64 +Line 12, characters 11-18: +12 | type s = Foo3f.t t + ^^^^^^^ +Error: This type Foo3f.t should be an instance of type ('a : float64) + Foo3f.t has layout value, which is not a sublayout of float64. +|}];; + +(* Previous example works with annotation *) +module rec Foo3f : sig + type t : float64 = t3f +end = struct + type t = t3f +end + +and Bar3 : sig + type ('a : float64) t + + type s = Foo3f.t t +end = struct + type ('a : float64) t + type s = Foo3f.t t +end;; +[%%expect {| +module rec Foo3f : sig type t = t3f end +and Bar3 : sig type ('a : float64) t type s = Foo3f.t t end +|}];; (*************************************************************************) (* Test 4: Nondep typedecl jkind approximation in the Nondep_cannot_erase case. *) -(* CR layouts: This test moved to [modules_beta.ml] and [modules_alpha.ml]. - Parts of it can come back when we have the ability to annotate type parameter - jkinds without extension flags, and other parts need a non-value jkind. *) +(* CR layouts v5: Bring back the void part of this test. *) +module F4(X : sig type t end) = struct + type s = Foo of X.t +end + +module M4 = F4(struct type t = T end) + +type ('a : value) t4_val + +type t4 = M4.s t4_val;; +[%%expect {| +module F4 : functor (X : sig type t end) -> sig type s = Foo of X.t end +module M4 : sig type s end +type 'a t4_val +type t4 = M4.s t4_val +|}] + +type ('a : float64) t4_float64 +type t4f' = M4.s t4_float64;; +[%%expect {| +type ('a : float64) t4_float64 +Line 2, characters 12-16: +2 | type t4f' = M4.s t4_float64;; + ^^^^ +Error: This type M4.s should be an instance of type ('a : float64) + M4.s has layout value, which is not a sublayout of float64. +|}] + +module F4'(X : sig type t : immediate end) = struct + type s : immediate = Foo of X.t [@@unboxed] +end + +module M4' = F4'(struct type t = T end) + +type ('a : immediate) t4_imm + +type t4 = M4'.s t4_imm;; +[%%expect{| +module F4' : + functor (X : sig type t : immediate end) -> + sig type s : immediate = Foo of X.t [@@unboxed] end +module M4' : sig type s : immediate end +type ('a : immediate) t4_imm +type t4 = M4'.s t4_imm +|}];; + +type t4 = M4'.s t4_float64;; +[%%expect{| +Line 1, characters 10-15: +1 | type t4 = M4'.s t4_float64;; + ^^^^^ +Error: This type M4'.s should be an instance of type ('a : float64) + M4'.s has layout immediate, which is not a sublayout of float64. +|}];; + (************************************) (* Test 5: Destructive substitution *) +module type S3_1 = sig + type ('a : immediate) t + val f : 'a -> 'a t +end + +module type S3_1' = S3_1 with type 'a t := 'a list + +module M3_1 : S3_1' = struct + let f x = [x] +end -(* CR layouts: The first part of this test has been moved to [modules_beta.ml]. - It can come back when we have the ability to annotate jkind parameters - without extensions. *) +let x3 = M3_1.f 42 + +let x3' = M3_1.f "test";; +[%%expect{| +module type S3_1 = + sig type ('a : immediate) t val f : ('a : immediate). 'a -> 'a t end +module type S3_1' = sig val f : ('a : immediate). 'a -> 'a list end +module M3_1 : S3_1' +val x3 : int list = [42] +Line 14, characters 17-23: +14 | let x3' = M3_1.f "test";; + ^^^^^^ +Error: This expression has type string but an expression was expected of type + ('a : immediate) + string has layout value, which is not a sublayout of immediate. +|}] module type S3_2 = sig type t : immediate @@ -184,9 +438,7 @@ Error: Type string has layout value, which is not a sublayout of immediate. (*****************************************) (* Test 6: With constraints on packages. *) -(* CR layouts: The first part of this test needs a non-value jkind and has - been moved to modules_alpha.ml. Bring it back once we have a non-value - jkind enabled by default. *) +(* CR layouts v5: Bring over void versions of these tests from modules_alpha *) module type S6_1 = sig type t : void end @@ -197,6 +449,42 @@ Line 2, characters 11-15: Error: Layout void is used here, but the appropriate layouts extension is not enabled |}] +module type S6_1f = sig + type t : float64 +end + +module type S6_2f = sig + val m : (module S6_1f with type t = int) +end;; +[%%expect{| +module type S6_1f = sig type t : float64 end +Line 6, characters 10-42: +6 | val m : (module S6_1f with type t = int) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: In this `with' constraint, the new definition of t + does not match its original definition in the constrained signature: + Type declarations do not match: + type t + is not included in + type t : float64 + the first has layout value, which is not a sublayout of float64. +|}];; + +module type S6_3 = sig + type t : value +end + +module type S6_4f = sig + val m : (module S6_3 with type t = t_float64) +end;; +[%%expect{| +module type S6_3 = sig type t : value end +Line 6, characters 33-34: +6 | val m : (module S6_3 with type t = t_float64) + ^ +Error: Signature package constraint types must have layout value. + t_float64 has layout float64, which is not a sublayout of value. +|}];; module type S6_5 = sig type t : immediate @@ -236,10 +524,7 @@ Error: In this `with' constraint, the new definition of t the first has layout value, which is not a sublayout of immediate. |}];; -(* CR layouts: this is broken because of the package with-type hack. It was - already broken before jkinds, but it would be nice to fix. See the comment - on See the comments in the [Ptyp_package] case of - [Typetexp.transl_type_aux]. *) +(* CR layouts: S6_6'' should be fixed *) module type S6_6'' = sig type s = int val m : (module S6_5 with type t = int) @@ -269,4 +554,16 @@ module F : sig end -> sig end (****************************************) (* Test 8: [val]s must be representable *) -(* CR layouts: Bring this test back from modules_alpha *) +module type S = sig val x : t_any end + +module M = struct + let x : t_void = assert false +end + +[%%expect{| +Line 1, characters 28-33: +1 | module type S = sig val x : t_any end + ^^^^^ +Error: This type signature for x is not a value type. + x has layout any, which is not a sublayout of value. +|}] diff --git a/ocaml/testsuite/tests/typing-layouts/modules_beta.ml b/ocaml/testsuite/tests/typing-layouts/modules_beta.ml index 6cd24bdfb3e..8f09445e171 100644 --- a/ocaml/testsuite/tests/typing-layouts/modules_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts/modules_beta.ml @@ -1,6 +1,6 @@ (* TEST - flags = "-extension layouts_beta" * expect + flags = "-extension layouts_beta" *) type t_value : value diff --git a/ocaml/testsuite/tests/typing-layouts/parsing.ml b/ocaml/testsuite/tests/typing-layouts/parsing.ml deleted file mode 100644 index 5da5f7b332d..00000000000 --- a/ocaml/testsuite/tests/typing-layouts/parsing.ml +++ /dev/null @@ -1,18 +0,0 @@ -(* TEST - * toplevel - flags = "-extension layouts" -*) - -type ('a : value) t0 = 'a list;; - -type ('a : immediate) t0 = 'a list;; - -type ('a : void) t0 = 'a list;; - -type ('a : valu) t0 = 'a list;; - -type t = float#;; - -type t = int#;; - -type t = Float.t#;; diff --git a/ocaml/testsuite/tests/typing-layouts/parsing.compilers.reference b/ocaml/testsuite/tests/typing-layouts/parsing_stable.compilers.reference similarity index 59% rename from ocaml/testsuite/tests/typing-layouts/parsing.compilers.reference rename to ocaml/testsuite/tests/typing-layouts/parsing_stable.compilers.reference index 91b08f0449f..536715de49f 100644 --- a/ocaml/testsuite/tests/typing-layouts/parsing.compilers.reference +++ b/ocaml/testsuite/tests/typing-layouts/parsing_stable.compilers.reference @@ -1,9 +1,5 @@ type 'a t0 = 'a list -Line 2, characters 11-20: -2 | type ('a : immediate) t0 = 'a list;; - ^^^^^^^^^ -Error: Layout immediate is more experimental than allowed by -extension layouts. - You must enable -extension layouts_beta to use this feature. +type ('a : immediate) t0 = 'a list Line 2, characters 11-15: 2 | type ('a : void) t0 = 'a list;; ^^^^ @@ -13,10 +9,7 @@ Line 2, characters 11-15: 2 | type ('a : valu) t0 = 'a list;; ^^^^ Error: Unknown layout valu -Line 2, characters 9-15: -2 | type t = float#;; - ^^^^^^ -Error: This construct requires the beta version of the extension "layouts", which is disabled and cannot be used +type t = float# Line 2, characters 9-13: 2 | type t = int#;; ^^^^ diff --git a/ocaml/testsuite/tests/typing-layouts/parsing_beta.ml b/ocaml/testsuite/tests/typing-layouts/parsing_stable_beta.ml similarity index 54% rename from ocaml/testsuite/tests/typing-layouts/parsing_beta.ml rename to ocaml/testsuite/tests/typing-layouts/parsing_stable_beta.ml index 60ec1ccc5f4..daa14c9dbaf 100644 --- a/ocaml/testsuite/tests/typing-layouts/parsing_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts/parsing_stable_beta.ml @@ -1,6 +1,10 @@ (* TEST - flags = "-extension layouts_beta" * toplevel + flags = "-extension layouts" + compiler_reference = "${test_source_directory}/parsing_stable.compilers.reference" + * toplevel + flags = "-extension layouts_beta" + compiler_reference = "${test_source_directory}/parsing_beta.compilers.reference" *) type ('a : value) t0 = 'a list;; diff --git a/ocaml/typing/jkind.ml b/ocaml/typing/jkind.ml index 77cb2042dde..5be411c8c85 100644 --- a/ocaml/typing/jkind.ml +++ b/ocaml/typing/jkind.ml @@ -527,8 +527,7 @@ let raise ~loc err = raise (User_error (loc, err)) let get_required_layouts_level (context : annotation_context) (jkind : const) : Language_extension.maturity = match context, jkind with - | _, Value -> Stable - | _, (Immediate | Immediate64 | Any | Float64) -> Beta + | _, (Value | Immediate | Immediate64 | Any | Float64) -> Stable | _, Void -> Alpha (******************************) diff --git a/ocaml/typing/typeopt.ml b/ocaml/typing/typeopt.ml index 51e6cfccd4b..91680914905 100644 --- a/ocaml/typing/typeopt.ml +++ b/ocaml/typing/typeopt.ml @@ -564,25 +564,25 @@ let value_kind env loc ty = let layout env loc sort ty = match Jkind.Sort.get_default_value sort with | Value -> Lambda.Pvalue (value_kind env loc ty) - | Float64 when Language_extension.(is_at_least Layouts Beta) -> + | Float64 when Language_extension.(is_at_least Layouts Stable) -> Lambda.Punboxed_float | Float64 -> - raise (Error (loc, Sort_without_extension (Jkind.Sort.float64, Beta, Some ty))) + raise (Error (loc, Sort_without_extension (Jkind.Sort.float64, Stable, Some ty))) | Void -> raise (Error (loc, Non_value_sort (Jkind.Sort.void,ty))) let layout_of_sort loc sort = match Jkind.Sort.get_default_value sort with | Value -> Lambda.Pvalue Pgenval - | Float64 when Language_extension.(is_at_least Layouts Beta) -> + | Float64 when Language_extension.(is_at_least Layouts Stable) -> Lambda.Punboxed_float | Float64 -> - raise (Error (loc, Sort_without_extension (Jkind.Sort.float64, Beta, None))) + raise (Error (loc, Sort_without_extension (Jkind.Sort.float64, Stable, None))) | Void -> raise (Error (loc, Non_value_sort_unknown_ty Jkind.Sort.void)) let layout_of_const_sort (s : Jkind.Sort.const) = match s with | Value -> Lambda.Pvalue Pgenval - | Float64 when Language_extension.(is_at_least Layouts Beta) -> + | Float64 when Language_extension.(is_at_least Layouts Stable) -> Lambda.Punboxed_float | Float64 -> Misc.fatal_error "layout_of_const_sort: float64 encountered" | Void -> Misc.fatal_error "layout_of_const_sort: void encountered"