From d495be0e464ea00797dc01135a5d491427fde0b4 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 4 Jun 2024 15:59:17 -0400 Subject: [PATCH] Disable mixed blocks in extensible variants --- .../tests/mixed-blocks/constructor_args.ml | 83 ++----------------- .../mixed-blocks/constructor_args.reference | 9 +- .../typing-layouts-bits32/basics_beta.ml | 15 +++- .../typing-layouts-bits64/basics_beta.ml | 17 +++- .../tests/typing-layouts-float32/basics.ml | 9 +- .../typing-layouts-float32/basics_beta.ml | 15 +++- .../tests/typing-layouts-float64/basics.ml | 11 ++- .../typing-layouts-float64/basics_beta.ml | 17 +++- .../tests/typing-layouts-word/basics_beta.ml | 17 +++- .../mixed_constructor_arguments.ml | 21 ++--- .../mixed_constructor_arguments_beta.ml | 37 ++++++--- ocaml/typing/typedecl.ml | 13 +++ ocaml/typing/typedecl.mli | 1 + 13 files changed, 133 insertions(+), 132 deletions(-) diff --git a/ocaml/testsuite/tests/mixed-blocks/constructor_args.ml b/ocaml/testsuite/tests/mixed-blocks/constructor_args.ml index 1f5f882e383..ea3ae3aa563 100644 --- a/ocaml/testsuite/tests/mixed-blocks/constructor_args.ml +++ b/ocaml/testsuite/tests/mixed-blocks/constructor_args.ml @@ -43,21 +43,6 @@ type t = | Mixed11 of float * int32# * float32# * float# * int64# * nativeint# | Uniform2 of float * float -type t_ext = .. - -type t_ext += - | Ext_mixed1 of float# - | Ext_mixed2 of float * float# - | Ext_mixed3 of float * float# * float# - | Ext_mixed4 of float * float# * int32# - | Ext_mixed5 of float * float# * int * int32# * nativeint# * int64# - | Ext_mixed6 of float * int32# * float# - | Ext_mixed7 of float * int64# * float# * nativeint# - | Ext_mixed8 of float * int32# * float# * int64# * float# - | Ext_mixed9 of float * float# * float32# - | Ext_mixed10 of float * float32# * float# * int64# * float# - | Ext_mixed11 of float * int32# * float32# * float# * int64# * nativeint# - let sprintf = Printf.sprintf let to_string = function @@ -98,57 +83,18 @@ let to_string = function (Float_u.to_float x4) (Int64_u.to_int x5) (Nativeint_u.to_int x6) | Uniform2 (x1, x2) -> sprintf "Uniform2 (%f, %f)" x1 x2 -let ext_to_string = function - | Ext_mixed1 x -> sprintf "Ext_mixed1 %f" (Float_u.to_float x) - | Ext_mixed2 (x1, x2) -> sprintf "Ext_mixed2 (%f, %f)" x1 (Float_u.to_float x2) - | Ext_mixed3 (x1, x2, x3) -> - sprintf "Ext_mixed3 (%f, %f, %f)" - x1 (Float_u.to_float x2) (Float_u.to_float x3) - | Ext_mixed4 (x1, x2, x3) -> - sprintf "Ext_mixed4 (%f, %f, %i)" - x1 (Float_u.to_float x2) (Int32_u.to_int x3) - | Ext_mixed5 (x1, x2, x3, x4, x5, x6) -> - sprintf "Mixed5 (%f, %f, %i, %i, %i, %i)" - x1 (Float_u.to_float x2) x3 (Int32_u.to_int x4) (Nativeint_u.to_int x5) - (Int64_u.to_int x6) - | Ext_mixed6 (x1, x2, x3) -> - sprintf "Ext_mixed6 (%f, %i, %f)" - x1 (Int32_u.to_int x2) (Float_u.to_float x3) - | Ext_mixed7 (x1, x2, x3, x4) -> - sprintf "Ext_mixed7 (%f, %i, %f, %i)" - x1 (Int64_u.to_int x2) (Float_u.to_float x3) (Nativeint_u.to_int x4) - | Ext_mixed8 (x1, x2, x3, x4, x5) -> - sprintf "Ext_mixed8 (%f, %i, %f, %i, %f)" - x1 (Int32_u.to_int x2) (Float_u.to_float x3) (Int64_u.to_int x4) - (Float_u.to_float x5) - | Ext_mixed9 (x1, x2, x3) -> - sprintf "Ext_mixed9 (%f, %f, %f)" x1 (Float_u.to_float x2) - (Float_u.to_float (Float32_u.to_float x3)) - | Ext_mixed10 (x1, x2, x3, x4, x5) -> - sprintf "Ext_mixed10 (%f, %f, %f, %i, %f)" - x1 (Float_u.to_float (Float32_u.to_float x2)) (Float_u.to_float x3) - (Int64_u.to_int x4) (Float_u.to_float x5) - | Ext_mixed11 (x1, x2, x3, x4, x5, x6) -> - sprintf "Ext_mixed11 (%f, %i, %f, %f, %i, %i)" - x1 (Int32_u.to_int x2) (Float_u.to_float (Float32_u.to_float x3)) - (Float_u.to_float x4) (Int64_u.to_int x5) (Nativeint_u.to_int x6) - | _ -> "" - let print t = print_endline (" " ^ to_string t) -let print_ext t = print_endline (" " ^ ext_to_string t) (**********************) (* Test: construction *) let toplevel = Mixed1 #7.0 -let toplevel_ext = Ext_mixed1 #8.0 let run f = print_endline "Test (construction)"; let lit = Mixed2 (3.0, #4.5) in let half_lit = Mixed3 (6.0, f, #5.0) in print toplevel; - print_ext toplevel_ext; print lit; print half_lit; ;; @@ -179,17 +125,6 @@ let construct_and_destruct uf uf' f f' i i32 i64 i_n f32 = let Mixed9 (f, uf, f32) = Mixed9 (f, uf, f32) in let Mixed10 (f, f32, uf, i64, uf') = Mixed10 (f, f32, uf, i64, uf') in let Mixed11 (f, i32, f32, uf, i64, i_n) = Mixed11 (f, i32, f32, uf, i64, i_n) in - let Ext_mixed1 uf = Ext_mixed1 uf in - let Ext_mixed2 (f, uf) = Ext_mixed2 (f, uf) in - let Ext_mixed3 (f, uf, uf') = Ext_mixed3 (f, uf, uf') in - let Ext_mixed4 (f, uf, i32) = Ext_mixed4 (f, uf, i32) in - let Ext_mixed5 (f, uf, i, i32, i_n, i64) = Ext_mixed5 (f, uf, i, i32, i_n, i64) in - let Ext_mixed6 (f, i32, uf) = Ext_mixed6 (f, i32, uf) in - let Ext_mixed7 (f, i64, uf, i_n) = Ext_mixed7 (f, i64, uf, i_n) in - let Ext_mixed8 (f, i32, uf, i64, uf') = Ext_mixed8 (f, i32, uf, i64, uf') in - let Ext_mixed9 (f, uf, f32) = Ext_mixed9 (f, uf, f32) in - let Ext_mixed10 (f, f32, uf, i64, uf') = Ext_mixed10 (f, f32, uf, i64, uf') in - let Ext_mixed11 (f, i32, f32, uf, i64, i_n) = Ext_mixed11 (f, i32, f32, uf, i64, i_n) in let Uniform2 (f, f') = Uniform2 (f, f') in sum uf uf' f f' i i32 i64 i_n f32 [@@ocaml.warning "-partial-match"] @@ -220,12 +155,12 @@ let () = (* Test: recursive groups *) let rec f r = - match r, t_rec1, t_rec2, t_ext_rec1, t_ext_rec2 with + match r, t_rec1, t_rec2, t_rec3, t_rec4 with | Mixed1 a, Mixed1 x, Mixed2 (y1, y2), - Ext_mixed1 z, - Ext_mixed2 (w1, w2) -> + Mixed1 z, + Mixed2 (w1, w2) -> Float_u.to_float x +. y1 +. Float_u.to_float y2 +. Float_u.to_float z +. @@ -234,21 +169,21 @@ let rec f r = and t_rec1 = Mixed1 #4.0 and t_rec2 = Mixed2 (5.0, #4.0) -and t_ext_rec1 = Ext_mixed1 #5.0 -and t_ext_rec2 = Ext_mixed2 (6.0, #7.0) +and t_rec3 = Mixed1 #5.0 +and t_rec4 = Mixed2 (6.0, #7.0) let _ = Printf.printf "Test (mixed constructors in recursive groups):\n"; print t_rec1; print t_rec2; - print_ext t_ext_rec2; - print_ext t_ext_rec2; + print t_rec3; + print t_rec4; let result = f t_rec1 in print_float " result (31.00)" result; print t_rec1; print t_rec2; - print_ext t_ext_rec2; - print_ext t_ext_rec2; + print t_rec3; + print t_rec4; ;; (**************************) diff --git a/ocaml/testsuite/tests/mixed-blocks/constructor_args.reference b/ocaml/testsuite/tests/mixed-blocks/constructor_args.reference index 14c4bbe4cb1..f966d463e1c 100644 --- a/ocaml/testsuite/tests/mixed-blocks/constructor_args.reference +++ b/ocaml/testsuite/tests/mixed-blocks/constructor_args.reference @@ -1,19 +1,18 @@ Test (construction) Mixed1 7.000000 - Ext_mixed1 8.000000 Mixed2 (3.000000, 4.500000) Mixed3 (6.000000, 17.000000, 5.000000) Test (construct and destruct): 150.900000 = 150.900000 (PASS) Test (mixed constructors in recursive groups): Mixed1 4.000000 Mixed2 (5.000000, 4.000000) - Ext_mixed2 (6.000000, 7.000000) - Ext_mixed2 (6.000000, 7.000000) + Mixed1 5.000000 + Mixed2 (6.000000, 7.000000) result (31.00): 31.00 Mixed1 4.000000 Mixed2 (5.000000, 4.000000) - Ext_mixed2 (6.000000, 7.000000) - Ext_mixed2 (6.000000, 7.000000) + Mixed1 5.000000 + Mixed2 (6.000000, 7.000000) Test (pattern matching). Contents of fields: 4.000 diff --git a/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml index 09733c57de4..6996c65134d 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits32/basics_beta.ml @@ -71,12 +71,18 @@ type t11_1 = .. type t11_1 += A of t_bits32;; [%%expect{| type t11_1 = .. -type t11_1 += A of t_bits32 +Line 3, characters 14-27: +3 | type t11_1 += A of t_bits32;; + ^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of int32#;; [%%expect{| -type t11_1 += B of int32# +Line 1, characters 14-25: +1 | type t11_1 += B of int32#;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : bits32) t11_2 = .. @@ -88,7 +94,10 @@ type 'a t11_2 += B of 'a;; [%%expect{| type ('a : bits32) t11_2 = .. type 'a t11_2 += A of int -type 'a t11_2 += B of 'a +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (* not allowed: value in flat suffix *) diff --git a/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml index e24291a35b8..606e84552f0 100644 --- a/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts-bits64/basics_beta.ml @@ -68,18 +68,26 @@ Error: Expected all flat constructor arguments after non-value argument, (*****************************************************) (* Test 11: Allow bits64 in some extensible variants *) +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + (* See [basics_alpha.ml] and [basics_beta.ml] for now *) type t11_1 = .. type t11_1 += A of t_bits64;; [%%expect{| type t11_1 = .. -type t11_1 += A of t_bits64 +Line 3, characters 14-27: +3 | type t11_1 += A of t_bits64;; + ^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of int64#;; [%%expect{| -type t11_1 += B of int64# +Line 1, characters 14-25: +1 | type t11_1 += B of int64#;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : bits64) t11_2 = .. @@ -91,7 +99,10 @@ type 'a t11_2 += B of 'a;; [%%expect{| type ('a : bits64) t11_2 = .. type 'a t11_2 += A of int -type 'a t11_2 += B of 'a +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (* not allowed: value in flat suffix *) diff --git a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml index 9e39c6adc51..26d901540ff 100644 --- a/ocaml/testsuite/tests/typing-layouts-float32/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float32/basics.ml @@ -582,8 +582,7 @@ type t11_1 = .. Line 3, characters 14-28: 3 | type t11_1 += A of t_float32;; ^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of float32#;; @@ -591,8 +590,7 @@ type t11_1 += B of float32#;; Line 1, characters 14-27: 1 | type t11_1 += B of float32#;; ^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : float32) t11_2 = .. @@ -607,8 +605,7 @@ type 'a t11_2 += A of int Line 5, characters 17-24: 5 | type 'a t11_2 += B of 'a;; ^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (***************************************) diff --git a/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml index a075c764f45..40f58f9c835 100644 --- a/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts-float32/basics_beta.ml @@ -560,12 +560,18 @@ type t11_1 = .. type t11_1 += A of t_float32;; [%%expect{| type t11_1 = .. -type t11_1 += A of t_float32 +Line 3, characters 14-28: +3 | type t11_1 += A of t_float32;; + ^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of float32#;; [%%expect{| -type t11_1 += B of float32# +Line 1, characters 14-27: +1 | type t11_1 += B of float32#;; + ^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : float32) t11_2 = .. @@ -577,7 +583,10 @@ type 'a t11_2 += B of 'a;; [%%expect{| type ('a : float32) t11_2 = .. type 'a t11_2 += A of int -type 'a t11_2 += B of 'a +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += C of t_float32 * string;; diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml index 70e612fd8ed..44a13cedc7d 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/basics.ml @@ -573,6 +573,8 @@ Error: Don't know how to untag this type. Only int can be untagged. (******************************************************) (* Test 11: Allow float64 in some extensible variants *) +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + (* Currently these are only supported in alpha *) type t11_1 = .. @@ -583,8 +585,7 @@ type t11_1 = .. Line 3, characters 14-28: 3 | type t11_1 += A of t_float64;; ^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of float#;; @@ -592,8 +593,7 @@ type t11_1 += B of float#;; Line 1, characters 14-25: 1 | type t11_1 += B of float#;; ^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : float64) t11_2 = .. @@ -608,8 +608,7 @@ type 'a t11_2 += A of int Line 5, characters 17-24: 5 | type 'a t11_2 += B of 'a;; ^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (* Some extensible variants aren't supported, though. *) diff --git a/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml index 266c7202f61..b5d3fba1166 100644 --- a/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts-float64/basics_beta.ml @@ -560,6 +560,8 @@ Error: Don't know how to untag this type. Only int can be untagged. (******************************************************) (* Test 11: Allow float64 in some extensible variants *) +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + (* Currently these are only supported in alpha *) type t11_1 = .. @@ -567,12 +569,18 @@ type t11_1 = .. type t11_1 += A of t_float64;; [%%expect{| type t11_1 = .. -type t11_1 += A of t_float64 +Line 3, characters 14-28: +3 | type t11_1 += A of t_float64;; + ^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of float#;; [%%expect{| -type t11_1 += B of float# +Line 1, characters 14-25: +1 | type t11_1 += B of float#;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : float64) t11_2 = .. @@ -584,7 +592,10 @@ type 'a t11_2 += B of 'a;; [%%expect{| type ('a : float64) t11_2 = .. type 'a t11_2 += A of int -type 'a t11_2 += B of 'a +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (* Some extensible variants aren't supported, though. *) diff --git a/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml b/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml index 1bafe095921..6b581b49c95 100644 --- a/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts-word/basics_beta.ml @@ -68,17 +68,25 @@ Error: Expected all flat constructor arguments after non-value argument, (***************************************************) (* Test 11: Allow word in some extensible variants *) +(* CR layouts v5.9: Actually allow mixed extensible variant blocks. *) + type t11_1 = .. type t11_1 += A of t_word;; [%%expect{| type t11_1 = .. -type t11_1 += A of t_word +Line 3, characters 14-25: +3 | type t11_1 += A of t_word;; + ^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type t11_1 += B of nativeint#;; [%%expect{| -type t11_1 += B of nativeint# +Line 1, characters 14-29: +1 | type t11_1 += B of nativeint#;; + ^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] type ('a : word) t11_2 = .. @@ -90,7 +98,10 @@ type 'a t11_2 += B of 'a;; [%%expect{| type ('a : word) t11_2 = .. type 'a t11_2 += A of int -type 'a t11_2 += B of 'a +Line 5, characters 17-24: +5 | type 'a t11_2 += B of 'a;; + ^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}] (* not allowed: value in flat suffix *) diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml index 9d409ffb110..f96504f125f 100644 --- a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml +++ b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments.ml @@ -28,8 +28,7 @@ type t_ext += A of float * float# Line 1, characters 14-33: 1 | type t_ext += A of float * float# ^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* The fact that the float args aren't flat is evidenced by the fact this @@ -121,8 +120,7 @@ type t_ext += A of float * float# * int Line 1, characters 14-39: 1 | type t_ext += A of float * float# * int ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* The third field can't be flat because a non-float/float# field [d] appears.*) @@ -205,8 +203,7 @@ type t_ext += A of float# * float# * int Line 1, characters 14-40: 1 | type t_ext += A of float# * float# * int ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type t_cstr_flat_int_multi = @@ -235,8 +232,7 @@ type t_ext += Line 2, characters 2-30: 2 | | A of float# * float# * int ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* Parameterized types *) @@ -257,8 +253,7 @@ type ('a : float64) t_cstr_param_ext1 = .. Line 2, characters 29-45: 2 | type 'a t_cstr_param_ext1 += A of string * 'a ^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b @@ -278,8 +273,7 @@ type ('a : float64, 'b : immediate) t_cstr_param_ext2 = .. Line 2, characters 35-56: 2 | type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b;; ^^^^^^^^^^^^^^^^^^^^^ -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type 'a t_cstr_bad_value_after_float = C of float# * 'a @@ -436,8 +430,7 @@ Lines 2-35, characters 2-16: 33 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * 34 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * 35 | int * float# -Error: The enabled layouts extension does not allow for mixed constructors. - You must enable -extension layouts_beta to use this feature. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* GADT syntax *) diff --git a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml index 9891b8c9383..8f4c034da53 100644 --- a/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml +++ b/ocaml/testsuite/tests/typing-layouts/mixed_constructor_arguments_beta.ml @@ -22,7 +22,10 @@ type t_cstr_boxed_float = A of float * float# type t_ext += A of float * float# [%%expect{| -type t_ext += A of float * float# +Line 1, characters 14-33: +1 | type t_ext += A of float * float# + ^^^^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* The fact that the float args aren't flat is evidenced by the fact this @@ -107,7 +110,10 @@ type t_cstr_boxed_float = A of float * float# * int type t_ext += A of float * float# * int [%%expect{| -type t_ext += A of float * float# * int +Line 1, characters 14-39: +1 | type t_ext += A of float * float# * int + ^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* The third field can't be flat because a non-float/float# field [d] appears.*) @@ -183,7 +189,10 @@ type t_cstr_flat_int = A of float# * float# * int type t_ext += A of float# * float# * int [%%expect{| -type t_ext += A of float# * float# * int +Line 1, characters 14-40: +1 | type t_ext += A of float# * float# * int + ^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type t_cstr_flat_int_multi = @@ -210,12 +219,10 @@ type t_ext += | E of int * float# * int * float# [%%expect{| -type t_ext += - A of float# * float# * int - | B of int - | C of float# * int - | D of float# * int * float# - | E of int * float# * int * float# +Line 2, characters 2-30: +2 | | A of float# * float# * int + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* Parameterized types *) @@ -229,7 +236,10 @@ type ('a : float64) t_cstr_param_ext1 = .. type 'a t_cstr_param_ext1 += A of string * 'a [%%expect{| type ('a : float64) t_cstr_param_ext1 = .. -type 'a t_cstr_param_ext1 += A of string * 'a +Line 2, characters 29-45: +2 | type 'a t_cstr_param_ext1 += A of string * 'a + ^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type ('a : float64, 'b : immediate) t_cstr_param2 = A of string * 'a * 'b @@ -242,7 +252,10 @@ type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b;; [%%expect{| type ('a : float64, 'b : immediate) t_cstr_param_ext2 = .. -type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b +Line 2, characters 35-56: +2 | type ('a, 'b) t_cstr_param_ext2 += A of string * 'a * 'b;; + ^^^^^^^^^^^^^^^^^^^^^ +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; type 'a t_cstr_bad_value_after_float = C of float# * 'a @@ -397,7 +410,7 @@ Lines 2-35, characters 2-16: 33 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * ptr * 34 | ptr * ptr * ptr * ptr * ptr * ptr * ptr * 35 | int * float# -Error: Mixed constructors may contain at most 254 value fields prior to the flat suffix, but this one contains 255. +Error: Extensible types can't have fields of unboxed type. Consider wrapping the unboxed fields in a record. |}];; (* GADT syntax *) diff --git a/ocaml/typing/typedecl.ml b/ocaml/typing/typedecl.ml index 7d977d1be28..20ab7d69785 100644 --- a/ocaml/typing/typedecl.ml +++ b/ocaml/typing/typedecl.ml @@ -55,6 +55,7 @@ end type mixed_product_violation = | Runtime_support_not_enabled of Mixed_product_kind.t + | Extension_constructor | Value_prefix_too_long of { value_prefix_len : int; max_value_prefix_len : int; @@ -1316,6 +1317,7 @@ end let update_constructor_representation env (cd_args : Types.constructor_arguments) arg_jkinds ~loc + ~is_extension_constructor = let flat_suffix = let arg_jkinds = Array.to_list arg_jkinds in @@ -1363,6 +1365,11 @@ let update_constructor_representation let value_prefix_len = Array.length arg_jkinds - Array.length flat_suffix in + (* CR layouts v5.9: Enable extension constructors in the flambda2 + middle-end so that we can permit them in the source language. + *) + if is_extension_constructor then + raise (Error (loc, Illegal_mixed_product Extension_constructor)); assert_mixed_product_support loc Cstr_tuple ~value_prefix_len; Constructor_mixed { value_prefix_len; flat_suffix } @@ -1545,6 +1552,7 @@ let update_decl_jkind env dpath decl = in let cstr_repr = update_constructor_representation env cd_args arg_jkinds + ~is_extension_constructor:false ~loc:cstr.Types.cd_loc in let () = @@ -2223,6 +2231,7 @@ let transl_extension_constructor_decl in let constructor_shape = update_constructor_representation env args jkinds ~loc + ~is_extension_constructor:true in args, jkinds, constructor_shape, constant, ret_type, Text_decl(tvars, targs, tret_type) @@ -3614,6 +3623,10 @@ let report_error ppf = function fprintf ppf "@[This OCaml runtime doesn't support mixed %s.@]" (Mixed_product_kind.to_plural_string mixed_product_kind) + | Extension_constructor -> + fprintf ppf + "@[Extensible types can't have fields of unboxed type. Consider \ + wrapping the unboxed fields in a record.@]" | Value_prefix_too_long { value_prefix_len; max_value_prefix_len; mixed_product_kind } -> fprintf ppf diff --git a/ocaml/typing/typedecl.mli b/ocaml/typing/typedecl.mli index 8c2ac3a3d2a..2494148d071 100644 --- a/ocaml/typing/typedecl.mli +++ b/ocaml/typing/typedecl.mli @@ -95,6 +95,7 @@ end type mixed_product_violation = | Runtime_support_not_enabled of Mixed_product_kind.t + | Extension_constructor | Value_prefix_too_long of { value_prefix_len : int; max_value_prefix_len : int;