diff --git a/ocaml/otherlibs/alpha/dune b/ocaml/otherlibs/alpha/dune index 2a20af2d54e..b764137905d 100644 --- a/ocaml/otherlibs/alpha/dune +++ b/ocaml/otherlibs/alpha/dune @@ -39,7 +39,7 @@ (rule (deps (glob_files ../stdlib_alpha/*.{ml,mli})) - (targets alpha.ml alpha.mli or_null.ml or_null.mli) + (targets alpha.ml alpha.mli) (action (bash "cp ../stdlib_alpha/*.{ml,mli} .; mv stdlib_alpha.ml alpha.ml; mv stdlib_alpha.mli alpha.mli"))) diff --git a/ocaml/otherlibs/stdlib_alpha/or_null.ml b/ocaml/otherlibs/stdlib_alpha/or_null.ml deleted file mode 100644 index b20b47fba3a..00000000000 --- a/ocaml/otherlibs/stdlib_alpha/or_null.ml +++ /dev/null @@ -1,17 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Diana Kalinichenko, Jane Street, New York *) -(* *) -(* Copyright 2024 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -type ('a : non_null_value) t = 'a or_null = - | Null - | This of 'a diff --git a/ocaml/otherlibs/stdlib_alpha/or_null.mli b/ocaml/otherlibs/stdlib_alpha/or_null.mli deleted file mode 100644 index 71900daf874..00000000000 --- a/ocaml/otherlibs/stdlib_alpha/or_null.mli +++ /dev/null @@ -1,18 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Diana Kalinichenko, Jane Street, New York *) -(* *) -(* Copyright 2024 Jane Street Group LLC *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Unboxed option type. Unimplemented. *) -type ('a : non_null_value) t = 'a or_null = - | Null - | This of 'a diff --git a/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.ml b/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.ml index 2f3c2463c3e..e69de29bb2d 100644 --- a/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.ml +++ b/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.ml @@ -1 +0,0 @@ -module Or_null = Or_null diff --git a/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.mli b/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.mli index 2f3c2463c3e..e69de29bb2d 100644 --- a/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.mli +++ b/ocaml/otherlibs/stdlib_alpha/stdlib_alpha.mli @@ -1 +0,0 @@ -module Or_null = Or_null diff --git a/ocaml/testsuite/tests/ppx-empty-cases/test.compilers.reference b/ocaml/testsuite/tests/ppx-empty-cases/test.compilers.reference index 25a0daeb744..fcfebfb74c5 100644 --- a/ocaml/testsuite/tests/ppx-empty-cases/test.compilers.reference +++ b/ocaml/testsuite/tests/ppx-empty-cases/test.compilers.reference @@ -3,35 +3,35 @@ (empty_cases_returning_string/269 = (function {nlocal = 0} param/271 (raise - (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 28 50]))) + (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 28 50]))) empty_cases_returning_float64/272 = (function {nlocal = 0} param/274 : unboxed_float (raise - (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 29 50]))) + (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 29 50]))) empty_cases_accepting_string/275 = (function {nlocal = 0} param/277 (raise - (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 30 50]))) + (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 30 50]))) empty_cases_accepting_float64/278 = (function {nlocal = 0} param/280[unboxed_float] (raise - (makeblock 0 (getpredef Match_failure/33!!) [0: "test.ml" 31 50]))) + (makeblock 0 (getpredef Match_failure/32!!) [0: "test.ml" 31 50]))) non_empty_cases_returning_string/281 = (function {nlocal = 0} param/283 (raise - (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 32 68]))) + (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 32 68]))) non_empty_cases_returning_float64/284 = (function {nlocal = 0} param/286 : unboxed_float (raise - (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 33 68]))) + (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 33 68]))) non_empty_cases_accepting_string/287 = (function {nlocal = 0} param/289 (raise - (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 34 68]))) + (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 34 68]))) non_empty_cases_accepting_float64/290 = (function {nlocal = 0} param/292[unboxed_float] (raise - (makeblock 0 (getpredef Assert_failure/43!!) [0: "test.ml" 35 68])))) + (makeblock 0 (getpredef Assert_failure/42!!) [0: "test.ml" 35 68])))) (makeblock 0 empty_cases_returning_string/269 empty_cases_returning_float64/272 empty_cases_accepting_string/275 empty_cases_accepting_float64/278 non_empty_cases_returning_string/281 diff --git a/ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml b/ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml index 5c110714016..c3f698d31c9 100644 --- a/ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml +++ b/ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml @@ -90,7 +90,7 @@ Line 1, characters 9-33: ^^^^^^^^^^^^^^^^^^^^^^^^ Error: This alias is bound to type 'a -> int but is used as an instance of type ('b : void) - The layout of 'a -> int is non_null_value, because + The layout of 'a -> int is value, because it's a function type. But the layout of 'a -> int must be a sublayout of void, because of the annotation on the type variable 'b. @@ -104,7 +104,7 @@ Line 1, characters 27-31: 1 | type t = 'a -> int as (_ : void) ^^^^ Error: Bad layout annotation: - The layout of 'a -> int is non_null_value, because + The layout of 'a -> int is value, because it's a function type. But the layout of 'a -> int must be a sublayout of void, because of the annotation on the wildcard _ at line 1, characters 27-31. diff --git a/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml b/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml index a7185aecd56..efe5de7b328 100644 --- a/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml +++ b/ocaml/testsuite/tests/typing-layouts-err-msg/value.ml @@ -121,7 +121,7 @@ type r : void = {a:string} Line 1, characters 0-26: 1 | type r : void = {a:string} ^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type r is non_null_value, because +Error: The layout of type r is value, because it's a boxed record type. But the layout of type r must be a sublayout of void, because of the annotation on the declaration of the type r. @@ -133,7 +133,7 @@ type v : void = A of t_value Line 1, characters 0-28: 1 | type v : void = A of t_value ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type v is non_null_value, because +Error: The layout of type v is value, because it's a boxed variant type. But the layout of type v must be a sublayout of void, because of the annotation on the declaration of the type v. @@ -145,7 +145,7 @@ type attr : void = .. Line 1, characters 0-21: 1 | type attr : void = .. ^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type attr is non_null_value, because +Error: The layout of type attr is value, because it's an extensible variant type. But the layout of type attr must be a sublayout of void, because of the annotation on the declaration of the type attr. @@ -159,8 +159,8 @@ Line 1, characters 40-45: ^^^^^ Error: This expression has type string but an expression was expected of type ('a : void) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of void, because of the annotation on the type variable 'a. |}];; @@ -187,7 +187,7 @@ Line 1, characters 40-45: ^^^^^ Error: This expression has type 'b * 'c but an expression was expected of type ('a : void) - The layout of 'a * 'b is non_null_value, because + The layout of 'a * 'b is value, because it's a tuple type. But the layout of 'a * 'b must be a sublayout of void, because of the annotation on the type variable 'a. @@ -206,7 +206,7 @@ Line 2, characters 36-37: ^ Error: This expression has type [ `A of int | `B ] but an expression was expected of type 'a t = ('a : void) - The layout of [ `A of int | `B ] is non_null_value, because + The layout of [ `A of int | `B ] is value, because it's a polymorphic variant type. But the layout of [ `A of int | `B ] must be a sublayout of void, because of the definition of t at line 1, characters 0-22. @@ -222,7 +222,7 @@ Line 2, characters 31-32: ^ Error: This expression has type int -> int but an expression was expected of type 'a t = ('a : void) - The layout of int -> int is non_null_value, because + The layout of int -> int is value, because it's a function type. But the layout of int -> int must be a sublayout of void, because of the definition of t at line 1, characters 0-22. @@ -248,7 +248,7 @@ Line 4, characters 17-39: ^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type (module X_int) but an expression was expected of type 'a t = ('a : void) - The layout of (module X_int) is non_null_value, because + The layout of (module X_int) is value, because it's a first-class module type. But the layout of (module X_int) must be a sublayout of void, because of the definition of t at line 1, characters 0-22. diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/arguments.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/arguments.ml deleted file mode 100644 index 11e69d0bb6b..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-non-null-value/arguments.ml +++ /dev/null @@ -1,173 +0,0 @@ -(* TEST - flags = "-extension-universe alpha"; - expect; -*) - -module Fake_or_null : sig - type ('a : non_null_value) t : value - - val none : 'a t - val some : 'a -> 'a t -end = struct - type ('a : non_null_value) t = 'a option - - let none = None - let some x = Some x -end -;; - -[%%expect{| -module Fake_or_null : - sig - type ('a : non_null_value) t : value - val none : ('a : non_null_value). 'a t - val some : ('a : non_null_value). 'a -> 'a t - end -|}] - -let _ = Fake_or_null.some (Fake_or_null.none) -;; - -[%%expect{| -Line 1, characters 26-45: -1 | let _ = Fake_or_null.some (Fake_or_null.none) - ^^^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a Fake_or_null.t - but an expression was expected of type ('b : non_null_value) - The layout of 'a Fake_or_null.t is value, because - of the definition of t at line 2, characters 2-38. - But the layout of 'a Fake_or_null.t must be a sublayout of non_null_value, because - of the definition of some at line 5, characters 2-23. -|}] - - -(* Built-in containers accept nullable values: *) - -let _ = [ Fake_or_null.none ] - -let _ = [| Fake_or_null.some 3 |] - -let _ = [: Fake_or_null.some "test " :] - -let _ = Some (Fake_or_null.some 42) - -let _ = lazy (Fake_or_null.none) -;; - -[%%expect{| -- : 'a Fake_or_null.t list = [] -- : int Fake_or_null.t array = [||] -- : string Fake_or_null.t iarray = [::] -- : int Fake_or_null.t option = Some -- : 'a Fake_or_null.t lazy_t = lazy -|}] - -module M1 : sig - type 'a t - - val mk : 'a -> 'a t -end = struct - type 'a t = 'a - - let mk x = x -end - -(* CR layouts v3.0: abstract types and type parameters to - abstract types should default to non-null: *) - -let _ = Fake_or_null.some (M1.mk 2) -;; -[%%expect{| -module M1 : sig type 'a t val mk : 'a -> 'a t end -Line 14, characters 26-35: -14 | let _ = Fake_or_null.some (M1.mk 2) - ^^^^^^^^^ -Error: This expression has type int M1.t - but an expression was expected of type ('a : non_null_value) - The layout of int M1.t is value, because - of the definition of t at line 2, characters 2-11. - But the layout of int M1.t must be a sublayout of non_null_value, because - of the definition of some at line 5, characters 2-23. -|}] - -let _ = M1.mk (Fake_or_null.some 5) -;; - -[%%expect{| -- : int Fake_or_null.t M1.t = -|}] - -let my_id1 x = x -let my_id2 (x : 'a) = x -let my_id3 : 'a . 'a -> 'a = fun x -> x -let my_id4 (type a) (x : a) = x -;; - -[%%expect{| -val my_id1 : 'a -> 'a = -val my_id2 : 'a -> 'a = -val my_id3 : 'a -> 'a = -val my_id4 : 'a -> 'a = -|}] - -(* By default, type variables in functions are nullable: *) - -let _ = my_id1 (Fake_or_null.some 1) - -let _ = my_id2 (Fake_or_null.some 2) - -let _ = my_id3 (Fake_or_null.some 3) - -let _ = my_id4 (Fake_or_null.some 4) -;; - -[%%expect{| -- : int Fake_or_null.t = -- : int Fake_or_null.t = -- : int Fake_or_null.t = -- : int Fake_or_null.t = -|}] - -(* Check behavior of type arguments and unboxed annotations. *) - -module M2 : sig - type 'a t = { v : 'a } [@@unboxed] - - val box : 'a -> 'a t - val unbox : 'a t -> 'a -end = struct - type 'a t = { v : 'a } [@@unboxed] - - let box v = { v } - let unbox { v } = v -end - -[%%expect{| -module M2 : - sig - type 'a t = { v : 'a; } [@@unboxed] - val box : 'a -> 'a t - val unbox : 'a t -> 'a - end -|}] - -module M3 : sig - type 'a t = V of 'a [@@unboxed] - - val box : 'a -> 'a t - val unbox : 'a t -> 'a -end = struct - type 'a t = V of 'a [@@unboxed] - - let box v = V v - let unbox (V v) = v -end - -[%%expect{| -module M3 : - sig - type 'a t = V of 'a [@@unboxed] - val box : 'a -> 'a t - val unbox : 'a t -> 'a - end -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/basics.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/basics.ml index e2fd3a8d4f0..53ac62da73f 100644 --- a/ocaml/testsuite/tests/typing-layouts-non-null-value/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts-non-null-value/basics.ml @@ -1,6 +1,5 @@ (* TEST - flags = "-extension-universe alpha"; - include stdlib_upstream_compatible; + flags = "-extension layouts_alpha"; expect; *) type t_non_null_value : non_null_value @@ -133,302 +132,3 @@ Error: Signature mismatch: But the layout of the first must be a sublayout of non_null_value, because of the definition of t at line 2, characters 2-25. |}] - -(* Immediates are non-null: *) - -let _ = id_non_null_value 3 - -let _ = id_non_null_value 'x' - -let () = id_non_null_value () - -let _ = id_non_null_value true - -let _ = id_non_null_value 3l -;; - -[%%expect{| -- : int = 3 -- : char = 'x' -- : bool = true -- : int32 = 3l -|}] - -(* Built-in types are non-null: *) - -let _ = id_non_null_value "test" - -let _ = id_non_null_value [ 1; 2; 3 ] - -let _ = id_non_null_value ("a", "b") - -let _ = id_non_null_value None - -let _ = id_non_null_value (Some 0) - -let _ = id_non_null_value [| 3.; 8. |] - -let _ = id_non_null_value 4L - -let _ = id_non_null_value 15n - -let _ = id_non_null_value Exit - -let _ = id_non_null_value (Float.Array.create 2) - -let _ = id_non_null_value [:0:] - -let _ = id_non_null_value (Bytes.empty) -;; - -[%%expect{| -- : string = "test" -- : int list = [1; 2; 3] -- : string * string = ("a", "b") -- : 'a option = None -- : int option = Some 0 -- : float array = [|3.; 8.|] -- : int64 = 4L -- : nativeint = 15n -- : exn = Stdlib.Exit -- : Float.Array.t = -- : int iarray = [:0:] -- : bytes = Bytes.of_string "" -|}] - -(* CR layouts v3: [float] should be non-null: *) - -let _ = id_non_null_value 3.14 -;; - -[%%expect{| -Line 1, characters 26-30: -1 | let _ = id_non_null_value 3.14 - ^^^^ -Error: This expression has type float but an expression was expected of type - ('a : non_null_value) - The layout of float is value, because - it is the primitive value type float. - But the layout of float must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -(* Boxed records and variants are non-null: *) - -type t1 = { x : int; y : string } - -type t2 = | A | B of char - -let _ = id_non_null_value { x = 3; y = "test" } - -let _ = id_non_null_value A - -let _ = id_non_null_value (`Some_variant "foo") - -let _ = ref 0 -;; - -[%%expect{| -type t1 = { x : int; y : string; } -type t2 = A | B of char -- : t1 = {x = 3; y = "test"} -- : t2 = A -- : [> `Some_variant of string ] = `Some_variant "foo" -- : int ref = {contents = 0} -|}] - -(* Functions are non-null: *) -module M1 = struct - [@@@warning "-5"] - - let foo = id_non_null_value (fun x -> x) - - let bar = id_non_null_value (fun (_ : float#) -> 2) -end -;; - -[%%expect{| -module M1 : sig val foo : '_weak1 -> '_weak1 val bar : float# -> int end -|}] - -(* First-class modules are non-null: *) - -module type S1 = sig - val bar : float# -> int -end - -let _ = id_non_null_value (module M1 : S1) -;; - -[%%expect{| -module type S1 = sig val bar : float# -> int end -- : (module S1) = -|}] - -(* CR layouts v3.0: objects should be non-null. *) - -let _ = id_non_null_value (object val foo = () end) -;; - -[%%expect{| -Line 1, characters 26-51: -1 | let _ = id_non_null_value (object val foo = () end) - ^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type < > but an expression was expected of type - ('a : non_null_value) - The layout of < > is value, because - it's the type of an object. - But the layout of < > must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -(* CR layouts v3.0: [lazy_t] should be non-null. *) - -let _ = id_non_null_value (lazy 3) -;; - -[%%expect{| -Line 1, characters 26-34: -1 | let _ = id_non_null_value (lazy 3) - ^^^^^^^^ -Error: This expression has type 'a lazy_t - but an expression was expected of type ('b : non_null_value) - The layout of 'a lazy_t is value, because - it is the primitive value type lazy_t. - But the layout of 'a lazy_t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -(* Unboxed types are not values, so they are not non-null. *) - -let _ = id_non_null_value (Stdlib_upstream_compatible.Float_u.of_float 3.14) -;; - -[%%expect{| -Line 1, characters 26-76: -1 | let _ = id_non_null_value (Stdlib_upstream_compatible.Float_u.of_float 3.14) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Stdlib_upstream_compatible.Float_u.t = float# - but an expression was expected of type ('a : non_null_value) - The layout of Stdlib_upstream_compatible.Float_u.t is float64, because - it is the primitive float64 type float#. - But the layout of Stdlib_upstream_compatible.Float_u.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -let _ = id_non_null_value (Stdlib_upstream_compatible.Int32_u.of_int 314) -;; - -[%%expect{| -Line 1, characters 26-73: -1 | let _ = id_non_null_value (Stdlib_upstream_compatible.Int32_u.of_int 314) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Stdlib_upstream_compatible.Int32_u.t = int32# - but an expression was expected of type ('a : non_null_value) - The layout of Stdlib_upstream_compatible.Int32_u.t is bits32, because - it is the primitive bits32 type int32#. - But the layout of Stdlib_upstream_compatible.Int32_u.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -module Possibly_null : sig - type t : value - - val create : int -> t - val destroy : t -> int -end = struct - type t = int - - let create x = x - let destroy x = x -end -;; - -[%%expect{| -module Possibly_null : - sig type t : value val create : int -> t val destroy : t -> int end -|}] - -let _ = id_non_null_value (Possibly_null.create 0) -;; - -[%%expect{| -Line 1, characters 26-50: -1 | let _ = id_non_null_value (Possibly_null.create 0) - ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Possibly_null.t - but an expression was expected of type ('a : non_null_value) - The layout of Possibly_null.t is value, because - of the definition of t at line 2, characters 2-16. - But the layout of Possibly_null.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -type 'a single_field_record = { value : 'a } [@@unboxed] -;; - -type 'a single_field_variant = Value of 'a [@@unboxed] - -[%%expect{| -type 'a single_field_record = { value : 'a; } [@@unboxed] -type 'a single_field_variant = Value of 'a [@@unboxed] -|}] - -(* Single-field records and and variants inherit non-nullability. *) - -let _ = id_non_null_value { value = 3 } - -let _ = id_non_null_value { value = Possibly_null.create 1 } -;; - -[%%expect{| -- : int single_field_record = {value = 3} -Line 3, characters 26-60: -3 | let _ = id_non_null_value { value = Possibly_null.create 1 } - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Possibly_null.t single_field_record - but an expression was expected of type ('a : non_null_value) - The layout of Possibly_null.t single_field_record is value, because - of the definition of t at line 2, characters 2-16. - But the layout of Possibly_null.t single_field_record must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -let _ = id_non_null_value (Value "a") - -let _ = id_non_null_value (Value (Possibly_null.create 1)) -;; - -[%%expect{| -- : string single_field_variant = -Line 3, characters 33-57: -3 | let _ = id_non_null_value (Value (Possibly_null.create 1)) - ^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Possibly_null.t - but an expression was expected of type ('a : non_null_value) - The layout of Possibly_null.t is value, because - of the definition of t at line 2, characters 2-16. - But the layout of Possibly_null.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 3, characters 4-21. -|}] - -(* CR layouts: recursive single-field records should be nullable values. *) - -type loopy = { field : loopy } [@@unboxed] - -let rec loopy = { field = loopy } - -let _ = id_non_null_value loopy -;; - -[%%expect{| -Line 1, characters 15-28: -1 | type loopy = { field : loopy } [@@unboxed] - ^^^^^^^^^^^^^ -Error: Unboxed record element types must have a representable layout. - The layout of loopy is any, because - a dummy layout of any is used to check mutually recursive datatypes. - Please notify the Jane Street compilers group if you see this output. - But the layout of loopy must be representable, because - it is the type of record field field. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/hiding.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/hiding.ml deleted file mode 100644 index 4c0fdd774b1..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-non-null-value/hiding.ml +++ /dev/null @@ -1,62 +0,0 @@ -(* TEST - flags = "-extension-universe stable"; - include stdlib_alpha; - expect; -*) - -(* Test that [non_null_value] layouts are hidden from users. *) - -(* Despite [string]'s true layout being [non_null_value], - the error displays [value]. *) - -type ('a : bits64) id_bits64 = 'a - -type fail = string id_bits64 -;; - -[%%expect{| -type ('a : bits64) id_bits64 = 'a -Line 3, characters 12-18: -3 | type fail = string id_bits64 - ^^^^^^ -Error: This type string should be an instance of type ('a : bits64) - The layout of string is value, because - it is the primitive value type string. - But the layout of string must be a sublayout of bits64, because - of the definition of id_bits64 at line 1, characters 0-33. -|}] - -(* [non_null_value] is still displayed on annotation errors. *) - -type t_non_null_value : non_null_value -;; - -[%%expect{| -Line 1, characters 24-38: -1 | type t_non_null_value : non_null_value - ^^^^^^^^^^^^^^ -Error: Layout non_null_value is more experimental than allowed by the enabled layouts extension. - You must enable -extension layouts_alpha to use this feature. -|}] - -(* It should normally be impossible to get a sublayout error - between [value] and [non_null_value] without enabling [-extension-universe alpha]. - We trigger it here by using [Stdlib_alpha.Or_null]. - - In this case, [non_null_value] is still displayed. *) - -type t_value : value -type fail = t_value Stdlib_alpha.Or_null.t -;; - -[%%expect{| -type t_value : value -Line 2, characters 12-19: -2 | type fail = t_value Stdlib_alpha.Or_null.t - ^^^^^^^ -Error: This type t_value should be an instance of type ('a : value) - The layout of t_value is value, because - of the definition of t_value at line 1, characters 0-20. - But the layout of t_value must be a sublayout of non_null_value, because - the type argument of Stdlib_alpha.Or_null.t has this layout. -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/or_null.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/or_null.ml new file mode 100644 index 00000000000..a33be00ac66 --- /dev/null +++ b/ocaml/testsuite/tests/typing-layouts-non-null-value/or_null.ml @@ -0,0 +1,332 @@ +(* TEST + reason = "Unboxed types aren't implemented yet"; + skip; + expect; +*) +(* CR layouts (v3): enable this test *) + +module type Or_null = sig + (* CR layouts (v3): Not sure how to express that None and Some should + be part of this module. They're not quite constructors. So the syntax + here might plausibly change. *) + type 'a t = 'a or_null = + | None + | Some of 'a + + val none : 'a or_null + val some : 'a -> 'a or_null + val value : 'a or_null -> default:'a -> 'a + val get : 'a or_null -> 'a + val bind : 'a or_null -> ('a -> 'b or_null) -> 'b or_null + (* unlike [option] we cannot have [join] *) + val map : ('a -> 'b) -> 'a or_null -> 'b or_null + val fold : none:'a -> some:('b -> 'a) -> 'b or_null -> 'a + val iter : ('a -> unit) -> 'a or_null -> unit + + val is_none : 'a or_null -> bool + val is_some : 'a or_null -> bool + val equal : ('a -> 'a -> bool) -> 'a or_null -> 'a or_null -> bool + val compare : ('a -> 'a -> int) -> 'a or_null -> 'a or_null -> int + + val to_result : none:'e -> 'a or_null -> ('a, 'e) result + val to_list : 'a or_null -> 'a list + val to_seq : 'a or_null -> 'a Seq.t + + val to_option : 'a or_null -> 'a option + val of_option : 'a option -> 'a or_null +end + +module Or_null : Or_null = Or_null + +(* CR layouts (v3): check output to see how bad the pretty-printing is. + In particular, it would be nice to suppress layout annotations that + are implied by the rest of the signature, but this may be hard. *) +[%%expect {| +success +|}] + +(* ensure that immediacy "looks through" or_null *) +type t1 : immediate = int or_null +type t2 : immediate = bool or_null + +[%%expect {| +success +|}] + +type t : immediate = string or_null + +[%%expect {| +error +|}] + +type t : value = string or_null + +[%%expect {| +success +|}] + +(* ensure that or_null can't be repeated *) +type 'a t = 'a or_null or_null + +[%%expect {| +error +|}] + +(* check inference around or_null *) +type 'a t = 'a or_null +type ('a : immediate) t = 'a or_null + +[%%expect {| +success +success (inferring an immediate jkind for [t] and non_null_immediate for ['a]) +|}] + +(* more jkind checking *) +type t : non_null_value = string or_null + +[%%expect {| +error +|}] + +type t1 : non_null_value = string +type t2 : non_null_value = int +type t3 : non_null_immediate = int +type t4 : value = int or_null + +[%%expect {| +success +|}] + +(* magic looking-through of [or_null] can't be abstracted over *) +type 'a t = 'a or_null +type q1 : value = string t +type q2 : immediate = int t (* but t isn't abstract, so this is OK *) + +[%%expect {| +success +|}] + +type q = string t t + +[%%expect {| +error +|}] + +type q = int t t + +[%%expect {| +error +|}] + +type 'a q1 = 'a t +type ('a : immediate) q2 : immediate = 'a t + +[%%expect {| +success +|}] + +module type T = sig + type t +end + +[%%expect {| +success +|}] + +(* this should be rejected, because the default for [t] is [non_null_value] *) +module M : T = struct + type t = string or_null +end + +[%%expect {| +error +|}] + +module M : T = struct + type t = int or_null +end + +[%%expect {| +error +|}] + +module M : sig + type 'a t +end = struct + type 'a t = 'a or_null +end + +(* CR layouts (v3): This error message had better be excellent, because the + solution -- to add a [: value] annotation -- will be unusual. Normally, + people think of [value] as the default! *) +[%%expect {| +error +|}] + +module M : sig + type 'a t : value +end = struct + type 'a t = 'a or_null +end + +[%%expect {| +success +|}] + +type t = string M.t + +[%%expect {| +success +|}] + +type t = int M.t + +[%%expect {| +success +|}] + +type t = (int M.t : immediate) (* this is the one that requires "looking through" *) + +[%%expect {| +error +|}] + +(* tests that or_null actually works at runtime *) + +let x = match Or_null.some 5 with + | None -> 6 + | Some n -> n + +let x = match Or_null.Some 5 with + | None -> 6 + | Some n -> n + +let x = match Or_null.some "hello" with + | None -> "bad" + | Some s -> s + +let x = match Or_null.Some "hello" with + | None -> "bad" + | Some s -> s + +let x = match Or_null.none with + | None -> 6 + | Some s -> s + +let x = match Or_null.None with + | None -> 6 + | Some s -> s + +let x = match Or_null.none with + | None -> "good" + | Some s -> s + +let x = match Or_null.None with + | None -> "good" + | Some s -> s + +[%%expect {| +5 +5 +"hello" +"hello" +6 +6 +"good" +"good" +|}] + +let b = Or_null.some 0 = Obj.magic 0 + +(* this should work because they're immediate, though it's technically unspecified *) +let b = Or_null.some 0 == Obj.magic 0 + +let b = (Or_null.none : int or_null) = Obj.magic 0 + +let b = (Or_null.none : string or_null) = Obj.magic 0 + +let b = (Or_null.none : int or_null) = Obj.magic (Or_null.none : string or_null) + +[%%expect {| +true +true +false +false +true +|}] + +(* CR layouts (v3): make other reference-implementation tests for the + [Or_null] interface once we have the quickcheck-like architecture + (TANDC-1809). *) + +(* check allocation behavior *) + +let measure_alloc f = + (* NB: right-to-left evaluation order gets this right *) + let baseline_allocation = Gc.allocated_bytes() -. Gc.allocated_bytes() in + let before = Gc.allocated_bytes () in + let result = (f[@inlined never]) () in + let after = Gc.allocated_bytes () in + (after -. before) -. baseline_allocation, result + +[%%expect {| +success +|}] + +let alloc = measure_alloc (fun () -> let x = Or_null.some 5 in ()) +let alloc = measure_alloc (fun () -> let x = Or_null.Some 5 in ()) +let alloc = + measure_alloc (fun () -> + (* this should infer f to be local, and thus the closures at usage + sites won't allocate *) + let bind opt f = Or_null.(match opt with + None -> None + Some x -> f x + ) in + let x = Or_null.some 5 in + let y = Or_null.some 6 in + let f a b = bind x (fun x -> bind y Or_null.(fun y -> some (x + y))) in + f x y) + +[%%expect {| +0 +0 +0 +|}] + +(* sub-typing *) + +let f x = (x : int :> int or_null) +let f x = (x : string :> string or_null) +let f x = (x : int list :> int or_null list) +let f x = (x : string list :> string or_null list) +let f x = (x : int list :> int list or_null) +let f x = (x : string list :> string list or_null) + +[%%expect {| +success +|}] + +let f x = (x : int or_null :> int) + +[%%expect {| +error +|}] + +let f x = (x : string or_null :> string) + +[%%expect {| +error +|}] + +let f x = (x : int :> int or_null or_null) + +[%%expect {| +error +|}] + +let f x = (x : int :> string or_null) + +[%%expect {| +error +|}] diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/stdlib_defs.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/stdlib_defs.ml deleted file mode 100644 index bc06868d34e..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-non-null-value/stdlib_defs.ml +++ /dev/null @@ -1,522 +0,0 @@ -(* TEST - flags = "-extension-universe alpha"; - expect; -*) - -let id_non_null_value : ('a : non_null_value). 'a -> 'a = fun x -> x - -module Possibly_null : sig - type t : value - - val create : int -> t - val destroy : t -> int - val compare : t -> t -> int -end = struct - type t = int - - let create x = x - let destroy x = x - let compare = Int.compare -end -;; - -[%%expect{| -val id_non_null_value : ('a : non_null_value). 'a -> 'a = -module Possibly_null : - sig - type t : value - val create : int -> t - val destroy : t -> int - val compare : t -> t -> int - end -|}] -;; - -(* CR layouts v3.0: decide whether [Atomic.t] should be non-null and accept - nullable values. *) - -let _ = id_non_null_value (Atomic.make 3) -;; - -[%%expect{| -Line 1, characters 26-41: -1 | let _ = id_non_null_value (Atomic.make 3) - ^^^^^^^^^^^^^^^ -Error: This expression has type int Atomic.t - but an expression was expected of type ('a : non_null_value) - The layout of int Atomic.t is value, because - of layout requirements from an imported definition. - But the layout of int Atomic.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - - -let _ = Atomic.make (Possibly_null.create 2) -;; - -[%%expect{| -- : Possibly_null.t Atomic.t = -|}] - -(* CR layouts v3.0: [Bigarray.t] should be non-null. *) - -let _ = id_non_null_value (Bigarray.Array1.create Bigarray.float64 Bigarray.c_layout 3) -;; - -[%%expect{| -Line 1, characters 26-87: -1 | let _ = id_non_null_value (Bigarray.Array1.create Bigarray.float64 Bigarray.c_layout 3) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type - (float, Bigarray.float64_elt, Bigarray.c_layout) Bigarray.Array1.t - but an expression was expected of type ('a : non_null_value) - The layout of (float, Bigarray.float64_elt, Bigarray.c_layout) - Bigarray.Array1.t is value, because - of layout requirements from an imported definition. - But the layout of (float, Bigarray.float64_elt, Bigarray.c_layout) - Bigarray.Array1.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Buffer.t] should be non-null. *) - -let _ = id_non_null_value (Buffer.create 5) -;; - -[%%expect{| -Line 1, characters 26-43: -1 | let _ = id_non_null_value (Buffer.create 5) - ^^^^^^^^^^^^^^^^^ -Error: This expression has type Buffer.t - but an expression was expected of type ('a : non_null_value) - The layout of Buffer.t is value, because - of layout requirements from an imported definition. - But the layout of Buffer.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Condition.t] should be non-null. *) - -let _ = id_non_null_value (Condition.create ()) -;; - -[%%expect{| -Line 1, characters 26-47: -1 | let _ = id_non_null_value (Condition.create ()) - ^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Condition.t - but an expression was expected of type ('a : non_null_value) - The layout of Condition.t is value, because - of layout requirements from an imported definition. - But the layout of Condition.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Hashtbl.t] should be non-null and accept nullable values. *) - -let _ = id_non_null_value (Hashtbl.create 2) -;; - -[%%expect{| -Line 1, characters 26-44: -1 | let _ = id_non_null_value (Hashtbl.create 2) - ^^^^^^^^^^^^^^^^^^ -Error: This expression has type ('a, 'b) Hashtbl.t - but an expression was expected of type ('c : non_null_value) - The layout of ('a, 'b) Hashtbl.t is value, because - of layout requirements from an imported definition. - But the layout of ('a, 'b) Hashtbl.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = Hashtbl.add (Hashtbl.create 1) "test" (Possibly_null.create 7) -;; - -[%%expect{| -- : unit = () -|}] - -(* CR layouts v3.0: [In_channel.t] and [Out_channel.t] should be non-null. *) - -let _ = id_non_null_value stdin -;; - -[%%expect{| -Line 1, characters 26-31: -1 | let _ = id_non_null_value stdin - ^^^^^ -Error: This expression has type in_channel - but an expression was expected of type ('a : non_null_value) - The layout of in_channel is value, because - of layout requirements from an imported definition. - But the layout of in_channel must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = id_non_null_value stdout -;; - -[%%expect{| -Line 1, characters 26-32: -1 | let _ = id_non_null_value stdout - ^^^^^^ -Error: This expression has type out_channel - but an expression was expected of type ('a : non_null_value) - The layout of out_channel is value, because - of layout requirements from an imported definition. - But the layout of out_channel must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Map.t] should be non-null and accept nullable values. *) - -module M0 = Map.Make(Possibly_null) -;; - -[%%expect{| -module M0 : - sig - type key = Possibly_null.t - type 'a t = 'a Map.Make(Possibly_null).t - val empty : 'a t - val add : key -> 'a -> 'a t -> 'a t - val add_to_list : key -> 'a -> 'a list t -> 'a list t - val update : key -> ('a option -> 'a option) -> 'a t -> 'a t - val singleton : key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge : - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val cardinal : 'a t -> int - val bindings : 'a t -> (key * 'a) list - val min_binding : 'a t -> key * 'a - val min_binding_opt : 'a t -> (key * 'a) option - val max_binding : 'a t -> key * 'a - val max_binding_opt : 'a t -> (key * 'a) option - val choose : 'a t -> key * 'a - val choose_opt : 'a t -> (key * 'a) option - val find : key -> 'a t -> 'a - val find_opt : key -> 'a t -> 'a option - val find_first : (key -> bool) -> 'a t -> key * 'a - val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option - val find_last : (key -> bool) -> 'a t -> key * 'a - val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val split : key -> 'a t -> 'a t * 'a option * 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val to_list : 'a t -> (key * 'a) list - val of_list : (key * 'a) list -> 'a t - val to_seq : 'a t -> (key * 'a) Seq.t - val to_rev_seq : 'a t -> (key * 'a) Seq.t - val to_seq_from : key -> 'a t -> (key * 'a) Seq.t - val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t - val of_seq : (key * 'a) Seq.t -> 'a t - end -|}] - -module M1 = Map.Make(String) -;; - -[%%expect{| -module M1 : - sig - type key = String.t - type 'a t = 'a Map.Make(String).t - val empty : 'a t - val add : key -> 'a -> 'a t -> 'a t - val add_to_list : key -> 'a -> 'a list t -> 'a list t - val update : key -> ('a option -> 'a option) -> 'a t -> 'a t - val singleton : key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge : - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val cardinal : 'a t -> int - val bindings : 'a t -> (key * 'a) list - val min_binding : 'a t -> key * 'a - val min_binding_opt : 'a t -> (key * 'a) option - val max_binding : 'a t -> key * 'a - val max_binding_opt : 'a t -> (key * 'a) option - val choose : 'a t -> key * 'a - val choose_opt : 'a t -> (key * 'a) option - val find : key -> 'a t -> 'a - val find_opt : key -> 'a t -> 'a option - val find_first : (key -> bool) -> 'a t -> key * 'a - val find_first_opt : (key -> bool) -> 'a t -> (key * 'a) option - val find_last : (key -> bool) -> 'a t -> key * 'a - val find_last_opt : (key -> bool) -> 'a t -> (key * 'a) option - val iter : (key -> 'a -> unit) -> 'a t -> unit - val fold : (key -> 'a -> 'acc -> 'acc) -> 'a t -> 'acc -> 'acc - val map : ('a -> 'b) -> 'a t -> 'b t - val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t - val filter : (key -> 'a -> bool) -> 'a t -> 'a t - val filter_map : (key -> 'a -> 'b option) -> 'a t -> 'b t - val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val split : key -> 'a t -> 'a t * 'a option * 'a t - val is_empty : 'a t -> bool - val mem : key -> 'a t -> bool - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val for_all : (key -> 'a -> bool) -> 'a t -> bool - val exists : (key -> 'a -> bool) -> 'a t -> bool - val to_list : 'a t -> (key * 'a) list - val of_list : (key * 'a) list -> 'a t - val to_seq : 'a t -> (key * 'a) Seq.t - val to_rev_seq : 'a t -> (key * 'a) Seq.t - val to_seq_from : key -> 'a t -> (key * 'a) Seq.t - val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t - val of_seq : (key * 'a) Seq.t -> 'a t - end -|}] - -let _ = id_non_null_value M1.empty -;; - -[%%expect{| -Line 1, characters 26-34: -1 | let _ = id_non_null_value M1.empty - ^^^^^^^^ -Error: This expression has type 'a M1.t = 'a Map.Make(String).t - but an expression was expected of type ('b : non_null_value) - The layout of 'a M1.t is value, because - of layout requirements from an imported definition. - But the layout of 'a M1.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = M1.add "test" (Possibly_null.create 8) M1.empty -;; - -[%%expect{| -- : Possibly_null.t M1.t = -|}] - -(* CR layouts v3.0: [Mutex.t] should be non-null. *) - -let _ = id_non_null_value (Mutex.create ()) -;; - -[%%expect{| -Line 1, characters 26-43: -1 | let _ = id_non_null_value (Mutex.create ()) - ^^^^^^^^^^^^^^^^^ -Error: This expression has type Mutex.t - but an expression was expected of type ('a : non_null_value) - The layout of Mutex.t is value, because - of layout requirements from an imported definition. - But the layout of Mutex.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Queue.t] should be non-null and accept nullable values. *) - -let _ = id_non_null_value (Queue.create ()) -;; -[%%expect{| -Line 1, characters 26-43: -1 | let _ = id_non_null_value (Queue.create ()) - ^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a Queue.t - but an expression was expected of type ('b : non_null_value) - The layout of 'a Queue.t is value, because - of layout requirements from an imported definition. - But the layout of 'a Queue.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - - -let _ = Queue.add (Possibly_null.create 8) (Queue.create ()) -;; - -[%%expect{| -- : unit = () -|}] - -(* CR layouts v3.0: [Random.State.t] should be non-null. *) - -let _ = id_non_null_value (Random.State.make_self_init ()) -;; - -[%%expect{| -Line 1, characters 26-58: -1 | let _ = id_non_null_value (Random.State.make_self_init ()) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Random.State.t - but an expression was expected of type ('a : non_null_value) - The layout of Random.State.t is value, because - of layout requirements from an imported definition. - But the layout of Random.State.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Semaphore.Counting.t] and [Semaphore.Binary.t] - should be non-null. *) - -let _ = id_non_null_value (Semaphore.Counting.make 3) -;; - -[%%expect{| -Line 1, characters 26-53: -1 | let _ = id_non_null_value (Semaphore.Counting.make 3) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Semaphore.Counting.t - but an expression was expected of type ('a : non_null_value) - The layout of Semaphore.Counting.t is value, because - of layout requirements from an imported definition. - But the layout of Semaphore.Counting.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = id_non_null_value (Semaphore.Binary.make false) -;; - -[%%expect{| -Line 1, characters 26-55: -1 | let _ = id_non_null_value (Semaphore.Binary.make false) - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: This expression has type Semaphore.Binary.t - but an expression was expected of type ('a : non_null_value) - The layout of Semaphore.Binary.t is value, because - of layout requirements from an imported definition. - But the layout of Semaphore.Binary.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Set.t] should be non-null and accept nullable values. *) - -module M2 = Set.Make(Possibly_null) -;; - -[%%expect{| -module M2 : - sig - type elt = Possibly_null.t - type t = Set.Make(Possibly_null).t - val empty : t - val add : elt -> t -> t - val singleton : elt -> t - val remove : elt -> t -> t - val union : t -> t -> t - val inter : t -> t -> t - val disjoint : t -> t -> bool - val diff : t -> t -> t - val cardinal : t -> int - val elements : t -> elt list - val min_elt : t -> elt - val min_elt_opt : t -> elt option - val max_elt : t -> elt - val max_elt_opt : t -> elt option - val choose : t -> elt - val choose_opt : t -> elt option - val find : elt -> t -> elt - val find_opt : elt -> t -> elt option - val find_first : (elt -> bool) -> t -> elt - val find_first_opt : (elt -> bool) -> t -> elt option - val find_last : (elt -> bool) -> t -> elt - val find_last_opt : (elt -> bool) -> t -> elt option - val iter : (elt -> unit) -> t -> unit - val fold : (elt -> 'acc -> 'acc) -> t -> 'acc -> 'acc - val map : (elt -> elt) -> t -> t - val filter : (elt -> bool) -> t -> t - val filter_map : (elt -> elt option) -> t -> t - val partition : (elt -> bool) -> t -> t * t - val split : elt -> t -> t * bool * t - val is_empty : t -> bool - val mem : elt -> t -> bool - val equal : t -> t -> bool - val compare : t -> t -> int - val subset : t -> t -> bool - val for_all : (elt -> bool) -> t -> bool - val exists : (elt -> bool) -> t -> bool - val to_list : t -> elt list - val of_list : elt list -> t - val to_seq_from : elt -> t -> elt Seq.t - val to_seq : t -> elt Seq.t - val to_rev_seq : t -> elt Seq.t - val add_seq : elt Seq.t -> t -> t - val of_seq : elt Seq.t -> t - end -|}] - -let _ = id_non_null_value M2.empty -;; - -[%%expect{| -Line 1, characters 26-34: -1 | let _ = id_non_null_value M2.empty - ^^^^^^^^ -Error: This expression has type M2.t = Set.Make(Possibly_null).t - but an expression was expected of type ('a : non_null_value) - The layout of M2.t is value, because - of layout requirements from an imported definition. - But the layout of M2.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -(* CR layouts v3.0: [Stack.t] should be non-null and accept nullable values. *) - -let _ = id_non_null_value (Stack.create ()) -;; - -[%%expect{| -Line 1, characters 26-43: -1 | let _ = id_non_null_value (Stack.create ()) - ^^^^^^^^^^^^^^^^^ -Error: This expression has type 'a Stack.t - but an expression was expected of type ('b : non_null_value) - The layout of 'a Stack.t is value, because - of layout requirements from an imported definition. - But the layout of 'a Stack.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = Stack.push (Possibly_null.create 0) (Stack.create ()) -;; - -[%%expect{| -- : unit = () -|}] - -(* CR layouts v3.0: [Uchar.t] should be non-null. *) - -let _ = id_non_null_value (Uchar.of_char 'x') -;; - -[%%expect{| -- : Uchar.t = -|}] - -(* CR layouts v3.0: [Weak.t] should be non-null and possibly accept nullable values. *) - -let _ = id_non_null_value (Weak.create 2) -;; - -[%%expect{| -Line 1, characters 26-41: -1 | let _ = id_non_null_value (Weak.create 2) - ^^^^^^^^^^^^^^^ -Error: This expression has type 'a Weak.t - but an expression was expected of type ('b : non_null_value) - The layout of 'a Weak.t is value, because - of layout requirements from an imported definition. - But the layout of 'a Weak.t must be a sublayout of non_null_value, because - of the definition of id_non_null_value at line 1, characters 4-21. -|}] - -let _ = Weak.set (Weak.create 2) 0 (Some (Possibly_null.create 0)) -;; - -[%%expect{| -- : unit = () -|}] diff --git a/ocaml/testsuite/tests/typing-layouts-non-null-value/test_or_null.ml b/ocaml/testsuite/tests/typing-layouts-non-null-value/test_or_null.ml deleted file mode 100644 index 660a510210f..00000000000 --- a/ocaml/testsuite/tests/typing-layouts-non-null-value/test_or_null.ml +++ /dev/null @@ -1,486 +0,0 @@ -(* TEST - flags = "-extension-universe alpha"; - include stdlib_alpha; - expect; -*) - -module type Or_null = sig - type ('a : non_null_value) t = 'a or_null = - | Null - | This of 'a - - (* CR layouts v3.0: implement those functions. *) - - (* val none : 'a or_null - val some : 'a -> 'a or_null - val value : 'a or_null -> default:'a -> 'a - val get : 'a or_null -> 'a - val bind : 'a or_null -> ('a -> 'b or_null) -> 'b or_null - (* unlike [option] we cannot have [join] *) - val map : ('a -> 'b) -> 'a or_null -> 'b or_null - val fold : none:'a -> some:('b -> 'a) -> 'b or_null -> 'a - val iter : ('a -> unit) -> 'a or_null -> unit - - val is_none : 'a or_null -> bool - val is_some : 'a or_null -> bool - val equal : ('a -> 'a -> bool) -> 'a or_null -> 'a or_null -> bool - val compare : ('a -> 'a -> int) -> 'a or_null -> 'a or_null -> int - - val to_result : none:'e -> 'a or_null -> ('a, 'e) result - val to_list : 'a or_null -> 'a list - val to_seq : 'a or_null -> 'a Seq.t - - val to_option : 'a or_null -> 'a option - val of_option : 'a option -> 'a or_null *) -end - -module Or_null : Or_null = Stdlib_alpha.Or_null - -(* CR layouts (v3): check output to see how bad the pretty-printing is. - In particular, it would be nice to suppress layout annotations that - are implied by the rest of the signature, but this may be hard. *) -[%%expect {| -module type Or_null = - sig type ('a : non_null_value) t = 'a or_null = Null | This of 'a end -module Or_null : Or_null -|}] - -(* CR layouts v3.0: ensure that immediacy "looks through" or_null. - Currently, [immediate] is always non-null, so we can't test this. *) -type t1 : immediate = int or_null -type t2 : immediate = bool or_null - -[%%expect {| -Line 1, characters 0-33: -1 | type t1 : immediate = int or_null - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type int or_null is value, because - it is the primitive value type or_null. - But the layout of type int or_null must be a sublayout of immediate, because - of the definition of t1 at line 1, characters 0-33. -|}] - -type t : immediate = string or_null - -[%%expect {| -Line 1, characters 0-35: -1 | type t : immediate = string or_null - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type string or_null is value, because - it is the primitive value type or_null. - But the layout of type string or_null must be a sublayout of immediate, because - of the definition of t at line 1, characters 0-35. -|}] - -type t : value = string or_null - -[%%expect {| -type t = string or_null -|}] - -(* ensure that or_null can't be repeated *) -type 'a t = 'a or_null or_null - -[%%expect {| -Line 1, characters 12-22: -1 | type 'a t = 'a or_null or_null - ^^^^^^^^^^ -Error: This type 'a or_null should be an instance of type - ('b : non_null_value) - The layout of 'a or_null is value, because - it is the primitive value type or_null. - But the layout of 'a or_null must be a sublayout of non_null_value, because - the type argument of option has layout non_null_value. -|}] - -(* check inference around or_null *) -type 'a t = 'a or_null -type ('a : immediate) t = 'a or_null - -[%%expect {| -type ('a : non_null_value) t = 'a or_null -type ('a : immediate) t = 'a or_null -|}] - -(* more jkind checking *) -type t : non_null_value = string or_null - -[%%expect {| -Line 1, characters 0-40: -1 | type t : non_null_value = string or_null - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -Error: The layout of type string or_null is value, because - it is the primitive value type or_null. - But the layout of type string or_null must be a sublayout of non_null_value, because - of the definition of t at line 1, characters 0-40. -|}] - -(* CR layouts v3.0: implement [immediate_or_null] *) - -type t1 : non_null_value = string -type t2 : non_null_value = int -type t3 : immediate = int -type t4 : immediate_or_null = int or_null - -[%%expect {| -type t1 = string -type t2 = int -type t3 = int -Line 4, characters 10-27: -4 | type t4 : immediate_or_null = int or_null - ^^^^^^^^^^^^^^^^^ -Error: Unknown layout immediate_or_null -|}] - -(* magic looking-through of [or_null] can't be abstracted over *) -type 'a t = 'a or_null -type q1 : value = string t -type q2 : immediate_or_null = int t (* but t isn't abstract, so this is OK *) - -[%%expect {| -type ('a : non_null_value) t = 'a or_null -type q1 = string t -Line 3, characters 10-27: -3 | type q2 : immediate_or_null = int t (* but t isn't abstract, so this is OK *) - ^^^^^^^^^^^^^^^^^ -Error: Unknown layout immediate_or_null -|}] - -type q = string t t - -[%%expect {| -Line 1, characters 9-17: -1 | type q = string t t - ^^^^^^^^ -Error: This type string t = string or_null should be an instance of type - ('a : non_null_value) - The layout of string t is value, because - it is the primitive value type or_null. - But the layout of string t must be a sublayout of non_null_value, because - of the definition of t at line 1, characters 0-22. -|}] - -type q = int t t - -[%%expect {| -Line 1, characters 9-14: -1 | type q = int t t - ^^^^^ -Error: This type int t = int or_null should be an instance of type - ('a : non_null_value) - The layout of int t is value, because - it is the primitive value type or_null. - But the layout of int t must be a sublayout of non_null_value, because - of the definition of t at line 1, characters 0-22. -|}] - -(* CR layouts v2.8: Make [or_null] kind polymorphic, so this is accepted. *) - -type 'a q1 = 'a t -type ('a : immediate) q2 : immediate_or_null = 'a t - -[%%expect {| -type ('a : non_null_value) q1 = 'a t -Line 2, characters 27-44: -2 | type ('a : immediate) q2 : immediate_or_null = 'a t - ^^^^^^^^^^^^^^^^^ -Error: Unknown layout immediate_or_null -|}] - -(* CR layouts v3.0: default to [non_null_value] for abstract types *) -module type T = sig - type t -end - -[%%expect {| -module type T = sig type t end -|}] - -(* this should be rejected, because the default for [t] is [non_null_value] *) -module M : T = struct - type t = string or_null -end - -[%%expect {| -module M : T -|}] - -module M : T = struct - type t = int or_null -end - -[%%expect {| -module M : T -|}] - -module M : sig - type 'a t -end = struct - type 'a t = 'a or_null -end - -(* CR layouts (v3): This error message had better be excellent, because the - solution -- to add a [: value] annotation -- will be unusual. Normally, - people think of [value] as the default! *) -[%%expect {| -Lines 3-5, characters 6-3: -3 | ......struct -4 | type 'a t = 'a or_null -5 | end -Error: Signature mismatch: - Modules do not match: - sig type ('a : non_null_value) t = 'a or_null end - is not included in - sig type 'a t end - Type declarations do not match: - type ('a : non_null_value) t = 'a or_null - is not included in - type 'a t - Their parameters differ: - The type ('a : non_null_value) is not equal to the type ('a0 : value) - because their layouts are different. -|}] - -(* CR layouts v3.0: ['a] in signature should default to [non_null_value] *) - -module M : sig - type 'a t : value -end = struct - type 'a t = 'a or_null -end - -[%%expect {| -Lines 3-5, characters 6-3: -3 | ......struct -4 | type 'a t = 'a or_null -5 | end -Error: Signature mismatch: - Modules do not match: - sig type ('a : non_null_value) t = 'a or_null end - is not included in - sig type 'a t : value end - Type declarations do not match: - type ('a : non_null_value) t = 'a or_null - is not included in - type 'a t : value - Their parameters differ: - The type ('a : non_null_value) is not equal to the type ('a0 : value) - because their layouts are different. -|}] - -module M : sig - type ('a : non_null_value) t : value -end = struct - type 'a t = 'a or_null -end - -[%%expect {| -module M : sig type ('a : non_null_value) t : value end -|}] - -type t = string M.t - -[%%expect {| -type t = string M.t -|}] - -type t = int M.t - -[%%expect {| -type t = int M.t -|}] - -type ('a : immediate) id_imm = 'a - -type t = (int M.t) id_imm (* this is the one that requires "looking through" *) - -[%%expect {| -type ('a : immediate) id_imm = 'a -Line 3, characters 10-17: -3 | type t = (int M.t) id_imm (* this is the one that requires "looking through" *) - ^^^^^^^ -Error: This type int M.t should be an instance of type ('a : immediate) - The layout of int M.t is value, because - of the definition of t at line 2, characters 2-38. - But the layout of int M.t must be a sublayout of immediate, because - of the definition of id_imm at line 1, characters 0-33. -|}] - -(* CR layouts v3: [float or_null] should compile: *) - -type t = float or_null -;; - -[%%expect {| -Line 1, characters 9-14: -1 | type t = float or_null - ^^^^^ -Error: This type float should be an instance of type ('a : non_null_value) - The layout of float is value, because - it is the primitive value type float. - But the layout of float must be a sublayout of non_null_value, because - the type argument of option has layout non_null_value. -|}] - -(* CR layouts v3: [float or_null array] should not compile, - but for a different reason: *) - -type t = float or_null array -;; - -[%%expect {| -Line 1, characters 9-14: -1 | type t = float or_null array - ^^^^^ -Error: This type float should be an instance of type ('a : non_null_value) - The layout of float is value, because - it is the primitive value type float. - But the layout of float must be a sublayout of non_null_value, because - the type argument of option has layout non_null_value. -|}] - -(* CR layouts v3.0: implement features below. *) - -(* - -(* tests that or_null actually works at runtime *) - -let x = match Or_null.some 5 with - | None -> 6 - | Some n -> n - -let x = match Or_null.Some 5 with - | None -> 6 - | Some n -> n - -let x = match Or_null.some "hello" with - | None -> "bad" - | Some s -> s - -let x = match Or_null.Some "hello" with - | None -> "bad" - | Some s -> s - -let x = match Or_null.none with - | None -> 6 - | Some s -> s - -let x = match Or_null.None with - | None -> 6 - | Some s -> s - -let x = match Or_null.none with - | None -> "good" - | Some s -> s - -let x = match Or_null.None with - | None -> "good" - | Some s -> s - -[%%expect {| -5 -5 -"hello" -"hello" -6 -6 -"good" -"good" -|}] - -let b = Or_null.some 0 = Obj.magic 0 - -(* this should work because they're immediate, though it's technically unspecified *) -let b = Or_null.some 0 == Obj.magic 0 - -let b = (Or_null.none : int or_null) = Obj.magic 0 - -let b = (Or_null.none : string or_null) = Obj.magic 0 - -let b = (Or_null.none : int or_null) = Obj.magic (Or_null.none : string or_null) - -[%%expect {| -true -true -false -false -true -|}] - -(* CR layouts (v3): make other reference-implementation tests for the - [Or_null] interface once we have the quickcheck-like architecture - (TANDC-1809). *) - -(* check allocation behavior *) - -let measure_alloc f = - (* NB: right-to-left evaluation order gets this right *) - let baseline_allocation = Gc.allocated_bytes() -. Gc.allocated_bytes() in - let before = Gc.allocated_bytes () in - let result = (f[@inlined never]) () in - let after = Gc.allocated_bytes () in - (after -. before) -. baseline_allocation, result - -[%%expect {| -success -|}] - -let alloc = measure_alloc (fun () -> let x = Or_null.some 5 in ()) -let alloc = measure_alloc (fun () -> let x = Or_null.Some 5 in ()) -let alloc = - measure_alloc (fun () -> - (* this should infer f to be local, and thus the closures at usage - sites won't allocate *) - let bind opt f = Or_null.(match opt with - None -> None - Some x -> f x - ) in - let x = Or_null.some 5 in - let y = Or_null.some 6 in - let f a b = bind x (fun x -> bind y Or_null.(fun y -> some (x + y))) in - f x y) - -[%%expect {| -0 -0 -0 -|}] - -(* sub-typing *) - -let f x = (x : int :> int or_null) -let f x = (x : string :> string or_null) -let f x = (x : int list :> int or_null list) -let f x = (x : string list :> string or_null list) -let f x = (x : int list :> int list or_null) -let f x = (x : string list :> string list or_null) - -[%%expect {| -success -|}] - -let f x = (x : int or_null :> int) - -[%%expect {| -error -|}] - -let f x = (x : string or_null :> string) - -[%%expect {| -error -|}] - -let f x = (x : int :> int or_null or_null) - -[%%expect {| -error -|}] - -let f x = (x : int :> string or_null) - -[%%expect {| -error -|}] - -*) diff --git a/ocaml/testsuite/tests/typing-layouts/basics.ml b/ocaml/testsuite/tests/typing-layouts/basics.ml index 54c5b843f48..a90b00f47a2 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics.ml @@ -2388,8 +2388,8 @@ Line 2, characters 0-14: 2 | and 'a t2 = 'a ^^^^^^^^^^^^^^ Error: - The layout of 'a t2 is '_representable_layout_9, because - it instantiates an unannotated type parameter of t2. + The layout of 'a t2 is value, because + it instantiates an unannotated type parameter of t2, defaulted to layout value. But the layout of 'a t2 must be a sublayout of immediate, because of the annotation on the wildcard _ at line 1, characters 27-36. |}] diff --git a/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml b/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml index 99b891df119..8e923c2ec69 100644 --- a/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml +++ b/ocaml/testsuite/tests/typing-layouts/basics_alpha.ml @@ -251,8 +251,8 @@ 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) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of imm_id at line 1, characters 0-33. |}];; @@ -274,8 +274,8 @@ Line 1, characters 33-46: ^^^^^^^^^^^^^ Error: This expression has type string but an expression was expected of type 'a imm_id = ('a : immediate) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of id_for_imms at line 1, characters 16-35. |}] @@ -303,8 +303,8 @@ Line 2, characters 9-15: 2 | and s4 = string t4;; ^^^^^^ Error: This type string should be an instance of type ('a : immediate) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the annotation on 'a in the declaration of the type t4. |}];; @@ -317,8 +317,8 @@ Line 1, characters 10-16: 1 | type s4 = string t4 ^^^^^^ Error: This type string should be an instance of type ('a : immediate) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the annotation on 'a in the declaration of the type t4. |}] @@ -350,8 +350,8 @@ Line 3, characters 0-15: 3 | and s5 = string;; ^^^^^^^^^^^^^^^ Error: - The layout of s5 is non_null_value, because - it is the primitive non-null value type string. + The layout of s5 is value, because + it is the primitive value type string. But the layout of s5 must be a sublayout of immediate, because of the annotation on 'a in the declaration of the type t4. |}] @@ -370,11 +370,19 @@ type s4 = string t4 and ('a : any) t4 |}];; +(* CR layouts v3: all default value types except for ['a Or_null.t] + should have layout [non_null_value], but it's not implemented yet. *) type s4 = string t4 and ('a : non_null_value) t4;; [%%expect{| -type s4 = string t4 -and ('a : non_null_value) t4 +Line 1, characters 10-16: +1 | type s4 = string t4 + ^^^^^^ +Error: This type string should be an instance of type ('a : non_null_value) + The layout of string is value, because + it is the primitive value type string. + But the layout of string must be a sublayout of non_null_value, because + of the annotation on 'a in the declaration of the type t4. |}];; type s4 = t_non_null_value t4 @@ -538,7 +546,7 @@ Line 3, characters 12-21: 3 | type t7' = (int * int) t7;; ^^^^^^^^^ Error: This type int * int should be an instance of type ('a : immediate) - The layout of int * int is non_null_value, because + The layout of int * int is value, because it's a tuple type. But the layout of int * int must be a sublayout of immediate, because of the definition of t7 at line 1, characters 0-37. @@ -693,15 +701,15 @@ module M9_4 = struct | ({vur_void = _},i) -> i end;; [%%expect {| -Line 4, characters 7-21: +Line 4, characters 8-16: 4 | | ({vur_void = _},i) -> i - ^^^^^^^^^^^^^^ -Error: This pattern matches values of type void_unboxed_record - but a pattern was expected which matches values of type ('a : value) + ^^^^^^^^ +Error: The record field vur_void belongs to the type void_unboxed_record + but is mixed here with fields of type ('a : value) The layout of void_unboxed_record is void, because of the definition of t_void at line 6, characters 0-19. But the layout of void_unboxed_record must be a sublayout of value, because - it's the type of a tuple element. + it's a boxed record type. |}];; module M9_5 = struct @@ -812,8 +820,8 @@ Error: Signature mismatch: is not included in val x : string The type ('a : immediate) is not compatible with the type string - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of x at line 8, characters 10-26. |}];; @@ -853,8 +861,8 @@ Error: Signature mismatch: val x : string The type 'a t = ('a : immediate) is not compatible with the type string - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of x at line 8, characters 10-26. |}] @@ -1941,7 +1949,7 @@ Line 2, characters 19-31: 2 | let f35 : 'a t35 = fun () -> () ^^^^^^^^^^^^ Error: - The layout of 'a -> 'b is non_null_value, because + The layout of 'a -> 'b is value, because it's a function type. But the layout of 'a -> 'b must be a sublayout of immediate, because of the definition of t35 at line 1, characters 0-30. diff --git a/ocaml/testsuite/tests/typing-layouts/error_message_attr.ml b/ocaml/testsuite/tests/typing-layouts/error_message_attr.ml index 9a155a6e80c..b644f78a1f2 100644 --- a/ocaml/testsuite/tests/typing-layouts/error_message_attr.ml +++ b/ocaml/testsuite/tests/typing-layouts/error_message_attr.ml @@ -232,8 +232,8 @@ Line 1, characters 22-23: Error: This expression has type string but an expression was expected of type ('a : immediate) custom message - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the annotation on the wildcard _ at line 1, characters 26-41. |}] diff --git a/ocaml/testsuite/tests/typing-layouts/modules_alpha.ml b/ocaml/testsuite/tests/typing-layouts/modules_alpha.ml index c70cf249294..80ae739a146 100644 --- a/ocaml/testsuite/tests/typing-layouts/modules_alpha.ml +++ b/ocaml/testsuite/tests/typing-layouts/modules_alpha.ml @@ -166,8 +166,8 @@ Line 5, characters 25-30: ^^^^^ Error: This expression has type string but an expression was expected of type ('a : immediate) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of t at line 2, characters 2-25. |}] @@ -346,7 +346,7 @@ Line 1, characters 11-15: 1 | type t4' = M4.s t4_void;; ^^^^ Error: This type M4.s should be an instance of type ('a : void) - The layout of M4.s is non_null_value, because + The layout of M4.s is value, because of the definition of s at line 2, characters 2-21. But the layout of M4.s must be a sublayout of void, because of the definition of t4_void at line 8, characters 0-24. @@ -409,8 +409,8 @@ Line 14, characters 17-23: ^^^^^^ Error: This expression has type string but an expression was expected of type ('a : immediate) - The layout of string is non_null_value, because - it is the primitive non-null value type string. + The layout of string is value, because + it is the primitive value type string. But the layout of string must be a sublayout of immediate, because of the definition of f at line 3, characters 2-20. |}] @@ -425,8 +425,8 @@ module type S3_2 = sig type t : immediate end Line 5, characters 30-46: 5 | module type S3_2' = S3_2 with type t := string;; ^^^^^^^^^^^^^^^^ -Error: The layout of type string is non_null_value, because - it is the primitive non-null value type string. +Error: The layout of type string is value, because + it is the primitive value type string. But the layout of type string must be a sublayout of immediate, because of the definition of t at line 2, characters 2-20. |}] @@ -499,8 +499,8 @@ Error: In this `with' constraint, the new definition of t type t = string is not included in type t : immediate - The layout of the first is non_null_value, because - it is the primitive non-null value type string. + The layout of the first is value, because + it is the primitive value type string. But the layout of the first must be a sublayout of immediate, because of the definition of t at line 2, characters 2-20. |}];; diff --git a/ocaml/typing/ctype.ml b/ocaml/typing/ctype.ml index 52178b3ec1b..8464221de29 100644 --- a/ocaml/typing/ctype.ml +++ b/ocaml/typing/ctype.ml @@ -1515,7 +1515,7 @@ let copy_sep ~copy_scope ~fixed ~(visited : type_expr TypeHash.t) sch = if keep then (add_delayed_copy t ty; Tvar { name = None; - jkind = Jkind.non_null_value ~why:Polymorphic_variant }) + jkind = Jkind.value ~why:Polymorphic_variant }) else let more' = copy_rec ~may_share:false more in let fixed' = fixed && (is_Tvar more || is_Tunivar more) in @@ -2099,7 +2099,7 @@ let rec estimate_type_jkind env ty = end | Tvariant row -> if tvariant_not_immediate row - then Jkind (non_null_value ~why:Polymorphic_variant) + then Jkind (value ~why:Polymorphic_variant) else Jkind (immediate ~why:Immediate_polymorphic_variant) | Tvar { jkind } when get_level ty = generic_level -> (* Once a Tvar gets generalized with a jkind, it should be considered @@ -2112,15 +2112,15 @@ let rec estimate_type_jkind env ty = This, however, still allows sort variables to get instantiated. *) Jkind jkind | Tvar { jkind } -> TyVar (jkind, ty) - | Tarrow _ -> Jkind (non_null_value ~why:Arrow) - | Ttuple _ -> Jkind (non_null_value ~why:Tuple) + | Tarrow _ -> Jkind (value ~why:Arrow) + | Ttuple _ -> Jkind (value ~why:Tuple) | Tobject _ -> Jkind (value ~why:Object) | Tfield _ -> Jkind (value ~why:Tfield) | Tnil -> Jkind (value ~why:Tnil) | (Tlink _ | Tsubst _) -> assert false | Tunivar { jkind } -> Jkind jkind | Tpoly (ty, _) -> estimate_type_jkind env ty - | Tpackage _ -> Jkind (non_null_value ~why:First_class_module) + | Tpackage _ -> Jkind (value ~why:First_class_module) (**** checking jkind relationships ****) @@ -2310,7 +2310,7 @@ let check_and_update_generalized_ty_jkind ?name ~loc ty = might turn out later to be value. This is the conservative choice. *) Jkind.(Externality.le (get_externality_upper_bound jkind) External64 && match get_layout jkind with - | Some (Sort Value | Non_null_value) | None -> true + | Some (Sort Value) | None -> true | _ -> false) in if Language_extension.erasable_extensions_only () diff --git a/ocaml/typing/jkind.ml b/ocaml/typing/jkind.ml index ef95a335f26..9f0965b5ae5 100644 --- a/ocaml/typing/jkind.ml +++ b/ocaml/typing/jkind.ml @@ -74,11 +74,7 @@ module Legacy = struct | Word -> "word" | Bits32 -> "bits32" | Bits64 -> "bits64" - (* CR layouts v3.0: we hide [non_null_value] from users while - it's in [Alpha]. Remove this hack once it reaches [Stable]. *) - | Non_null_value when Language_extension.(is_at_least Layouts Alpha) -> - "non_null_value" - | Non_null_value -> "value" + | Non_null_value -> "non_null_value" let equal_const c1 c2 = match c1, c2 with @@ -288,15 +284,15 @@ module Const = struct match layout, externality_upper_bound with | Any, _ -> Any | Sort Value, Internal -> Value - | (Sort Value | Non_null_value), External64 -> Immediate64 - | (Sort Value | Non_null_value), External -> Immediate + | Sort Value, External64 -> Immediate64 + | Sort Value, External -> Immediate | Sort Void, _ -> Void | Sort Float64, _ -> Float64 | Sort Float32, _ -> Float32 | Sort Word, _ -> Word | Sort Bits32, _ -> Bits32 | Sort Bits64, _ -> Bits64 - | Non_null_value, Internal -> Non_null_value + | Non_null_value, _ -> Non_null_value (* CR layouts v2.8: do a better job here *) let to_string t = Legacy.string_of_const (to_legacy_jkind t) @@ -462,7 +458,7 @@ module Jkind_desc = struct argument. But the arguments that we expect here will have no trouble meeting the conditions. *) - let immediate = mode_crossing Non_null_value + let immediate = mode_crossing Layout.value let immediate64 = { immediate with externality_upper_bound = External64 } @@ -543,9 +539,6 @@ let value ~(why : value_creation_reason) = | V1_safety_check -> value_v1_safety_check | _ -> fresh_jkind Jkind_desc.value ~why:(Value_creation why) -let non_null_value ~(why : non_null_value_creation_reason) = - fresh_jkind Jkind_desc.non_null_value ~why:(Non_null_value_creation why) - let immediate64 ~why = fresh_jkind Jkind_desc.immediate64 ~why:(Immediate64_creation why) @@ -691,14 +684,10 @@ let of_type_decl_default ~context ~default (decl : Parsetree.type_declaration) = | None -> default, None, decl.ptype_attributes let for_boxed_record ~all_void = - if all_void - then immediate ~why:Empty_record - else non_null_value ~why:Boxed_record + if all_void then immediate ~why:Empty_record else value ~why:Boxed_record let for_boxed_variant ~all_voids = - if all_voids - then immediate ~why:Enumeration - else non_null_value ~why:Boxed_variant + if all_voids then immediate ~why:Enumeration else value ~why:Boxed_variant (******************************) (* elimination and defaulting *) @@ -938,19 +927,26 @@ end = struct | Instance_variable -> fprintf ppf "it's the type of an instance variable" | Object_field -> fprintf ppf "it's the type of an object field" | Class_field -> fprintf ppf "it's the type of a class field" + | Boxed_record -> fprintf ppf "it's a boxed record type" + | Boxed_variant -> fprintf ppf "it's a boxed variant type" + | Extensible_variant -> fprintf ppf "it's an extensible variant type" | Primitive id -> fprintf ppf "it is the primitive value type %s" (Ident.name id) | Type_argument { parent_path; position; arity } -> fprintf ppf "the %stype argument of %a has layout value" (format_position ~arity position) !printtyp_path parent_path + | Tuple -> fprintf ppf "it's a tuple type" | Row_variable -> format_with_notify_js ppf "it's a row variable" + | Polymorphic_variant -> fprintf ppf "it's a polymorphic variant type" + | Arrow -> fprintf ppf "it's a function type" | Tfield -> format_with_notify_js ppf "it's an internal Tfield type (you shouldn't see this)" | Tnil -> format_with_notify_js ppf "it's an internal Tnil type (you shouldn't see this)" + | First_class_module -> fprintf ppf "it's a first-class module type" | Separability_check -> fprintf ppf "the check that a type is definitely not `float`" | Univar -> @@ -987,28 +983,6 @@ end = struct "unknown @[(please alert the Jane Street@;\ compilers team with this message: %s)@]" s - let format_non_null_value_creation_reason ppf : - non_null_value_creation_reason -> _ = function - (* CR layouts v3.0: we hide [non_null_value] from users while - it's in [Alpha], but we need to display it in this case. - Remove this hack once [non_null_value] reaches [Stable]. *) - | Primitive id when Language_extension.(is_at_least Layouts Alpha) -> - fprintf ppf "it is the primitive non-null value type %s" (Ident.name id) - | Primitive id -> - fprintf ppf "it is the primitive value type %s" (Ident.name id) - | Extensible_variant -> fprintf ppf "it's an extensible variant type" - | Boxed_variant -> fprintf ppf "it's a boxed variant type" - | Boxed_record -> fprintf ppf "it's a boxed record type" - | Tuple -> fprintf ppf "it's a tuple type" - | Polymorphic_variant -> fprintf ppf "it's a polymorphic variant type" - | Arrow -> fprintf ppf "it's a function type" - | First_class_module -> fprintf ppf "it's a first-class module type" - | Type_argument { parent_path; position; arity } -> - fprintf ppf "the %stype argument of %a has layout %s" - (format_position ~arity position) - !printtyp_path parent_path - (Legacy.string_of_const Non_null_value) - let format_float64_creation_reason ppf : float64_creation_reason -> _ = function | Primitive id -> @@ -1043,8 +1017,6 @@ end = struct format_immediate64_creation_reason ppf immediate64 | Void_creation _ -> . | Value_creation value -> format_value_creation_reason ppf value - | Non_null_value_creation non_null_value -> - format_non_null_value_creation_reason ppf non_null_value | Float64_creation float -> format_float64_creation_reason ppf float | Float32_creation float -> format_float32_creation_reason ppf float | Word_creation word -> format_word_creation_reason ppf word @@ -1185,19 +1157,6 @@ module Violation = struct then let connective = match t.violation, get l2 with - (* CR layouts v3.0: we hide [non_null_value] from users while - it's in [Alpha], but we need to display it in this case. - Remove this hack once [non_null_value] reaches [Stable]. *) - | Not_a_subjkind _, Const ({ layout = Non_null_value; _ } as c) -> ( - (* We only show [non_null_value] if: - 1. The layout on the left is know to be [value] - 2. The layout on the right is [non_null_value] AND - not immediate/immediate64 - *) - match get l1, Const.to_legacy_jkind c with - | Const { layout = Sort Value; _ }, Non_null_value -> - dprintf "be a sublayout of non_null_value" - | _, _ -> dprintf "be a sublayout of %a" format l2) | Not_a_subjkind _, Const _ -> dprintf "be a sublayout of %a" format l2 | No_intersection _, Const _ -> dprintf "overlap with %a" format l2 | _, Var _ -> dprintf "be representable" @@ -1377,13 +1336,20 @@ module Debug_printers = struct | Instance_variable -> fprintf ppf "Instance_variable" | Object_field -> fprintf ppf "Object_field" | Class_field -> fprintf ppf "Class_field" + | Boxed_record -> fprintf ppf "Boxed_record" + | Boxed_variant -> fprintf ppf "Boxed_variant" + | Extensible_variant -> fprintf ppf "Extensible_variant" | Primitive id -> fprintf ppf "Primitive %s" (Ident.unique_name id) | Type_argument { parent_path; position; arity } -> fprintf ppf "Type_argument (pos %d, arity %d) of %a" position arity !printtyp_path parent_path + | Tuple -> fprintf ppf "Tuple" | Row_variable -> fprintf ppf "Row_variable" + | Polymorphic_variant -> fprintf ppf "Polymorphic_variant" + | Arrow -> fprintf ppf "Arrow" | Tfield -> fprintf ppf "Tfield" | Tnil -> fprintf ppf "Tnil" + | First_class_module -> fprintf ppf "First_class_module" | Separability_check -> fprintf ppf "Separability_check" | Univar -> fprintf ppf "Univar" | Polymorphic_variant_field -> fprintf ppf "Polymorphic_variant_field" @@ -1400,20 +1366,6 @@ module Debug_printers = struct | Recmod_fun_arg -> fprintf ppf "Recmod_fun_arg" | Unknown s -> fprintf ppf "Unknown %s" s - let non_null_value_creation_reason ppf : non_null_value_creation_reason -> _ = - function - | Primitive id -> fprintf ppf "Primitive %s" (Ident.unique_name id) - | Extensible_variant -> fprintf ppf "Extensible_variant" - | Boxed_variant -> fprintf ppf "Boxed_variant" - | Boxed_record -> fprintf ppf "Boxed_record" - | Tuple -> fprintf ppf "Tuple" - | Polymorphic_variant -> fprintf ppf "Polymorphic_variant" - | Arrow -> fprintf ppf "Arrow" - | First_class_module -> fprintf ppf "First_class_module" - | Type_argument { parent_path; position; arity } -> - fprintf ppf "Type_argument (pos %d, arity %d) of %a" position arity - !printtyp_path parent_path - let float64_creation_reason ppf : float64_creation_reason -> _ = function | Primitive id -> fprintf ppf "Primitive %s" (Ident.unique_name id) @@ -1442,9 +1394,6 @@ module Debug_printers = struct immediate64 | Value_creation value -> fprintf ppf "Value_creation %a" value_creation_reason value - | Non_null_value_creation non_null_value -> - fprintf ppf "Non_null_value_creation %a" non_null_value_creation_reason - non_null_value | Void_creation _ -> . | Float64_creation float -> fprintf ppf "Float64_creation %a" float64_creation_reason float @@ -1513,14 +1462,6 @@ let report_error ~loc = function Location.errorf ~loc "@[The appropriate layouts extension is not enabled.@;%t@]" hint | true -> - let layout_name = - match jkind with - (* CR layouts v3.0: we hide [non_null_value] from users while - it's in [Alpha], but we need to display it in this case. - Remove this hack once [non_null_value] reaches [Stable]. *) - | Non_null_value -> "non_null_value" - | _ -> Legacy.string_of_const jkind - in Location.errorf ~loc (* CR layouts errors: use the context to produce a better error message. When RAE tried this, some types got printed like [t/2], but the @@ -1528,7 +1469,8 @@ let report_error ~loc = function "@[Layout %s is more experimental than allowed by the enabled \ layouts extension.@;\ %t@]" - layout_name hint) + (Legacy.string_of_const jkind) + hint) let () = Location.register_error_of_exn (function diff --git a/ocaml/typing/jkind.mli b/ocaml/typing/jkind.mli index f96f1b5787e..0c4bac57b56 100644 --- a/ocaml/typing/jkind.mli +++ b/ocaml/typing/jkind.mli @@ -148,12 +148,9 @@ val any : why:any_creation_reason -> t (** Value of types of this jkind are not retained at all at runtime *) val void : why:void_creation_reason -> t -(** This is the jkind of normal ocaml values and null pointers. *) +(** This is the jkind of normal ocaml values *) val value : why:value_creation_reason -> t -(** This is the jkind of normal ocaml values. They have sort Value. *) -val non_null_value : why:non_null_value_creation_reason -> t - (** Values of types of this jkind are immediate on 64-bit platforms; on other platforms, we know nothing other than that it's a value. *) val immediate64 : why:immediate64_creation_reason -> t diff --git a/ocaml/typing/jkind_intf.ml b/ocaml/typing/jkind_intf.ml index 07d7154dbfb..97045622463 100644 --- a/ocaml/typing/jkind_intf.ml +++ b/ocaml/typing/jkind_intf.ml @@ -178,6 +178,9 @@ module History = struct | Instance_variable | Object_field | Class_field + | Boxed_record + | Boxed_variant + | Extensible_variant | Primitive of Ident.t | Type_argument of { parent_path : Path.t; @@ -185,9 +188,13 @@ module History = struct arity : int } (* [position] is 1-indexed *) + | Tuple | Row_variable + | Polymorphic_variant + | Arrow | Tfield | Tnil + | First_class_module | Separability_check | Univar | Polymorphic_variant_field @@ -204,22 +211,6 @@ module History = struct | Recmod_fun_arg | Unknown of string (* CR layouts: get rid of these *) - type non_null_value_creation_reason = - | Extensible_variant - | Primitive of Ident.t - | Boxed_variant - | Boxed_record - | Tuple - | Polymorphic_variant - | Arrow - | First_class_module - | Type_argument of - { parent_path : Path.t; - position : int; - arity : int - } - (* [position] is 1-indexed *) - type immediate_creation_reason = | Empty_record | Enumeration @@ -258,7 +249,6 @@ module History = struct | Annotated of annotation_context * Location.t | Missing_cmi of Path.t | Value_creation of value_creation_reason - | Non_null_value_creation of non_null_value_creation_reason | Immediate_creation of immediate_creation_reason | Immediate64_creation of immediate64_creation_reason | Void_creation of void_creation_reason diff --git a/ocaml/typing/predef.ml b/ocaml/typing/predef.ml index 3398249b0c9..6e10a918a47 100644 --- a/ocaml/typing/predef.ml +++ b/ocaml/typing/predef.ml @@ -55,7 +55,6 @@ and ident_unboxed_float32 = ident_create "float32#" and ident_unboxed_nativeint = ident_create "nativeint#" and ident_unboxed_int32 = ident_create "int32#" and ident_unboxed_int64 = ident_create "int64#" -and ident_or_null = ident_create "or_null" and ident_int8x16 = ident_create "int8x16" and ident_int16x8 = ident_create "int16x8" @@ -185,8 +184,6 @@ and ident_nil = ident_create "[]" and ident_cons = ident_create "::" and ident_none = ident_create "None" and ident_some = ident_create "Some" -and ident_null = ident_create "Null" -and ident_this = ident_create "This" let predef_jkind_annotation const = Option.map @@ -212,13 +209,10 @@ let option_argument_jkind = Jkind.value ~why:( let list_argument_jkind = Jkind.value ~why:( Type_argument {parent_path = path_list; position = 1; arity = 1}) -let or_null_argument_jkind = Jkind.non_null_value ~why:( - Type_argument {parent_path = path_option; position = 1; arity = 1}) - let mk_add_type add_type ?manifest type_ident ?(kind=Type_abstract Abstract_def) - ?(jkind=Jkind.non_null_value ~why:(Primitive type_ident)) + ?(jkind=Jkind.value ~why:(Primitive type_ident)) (* [jkind_annotation] is just used for printing. It's best to provide it if the jkind is not implied by the kind of the type, as then the type, if printed, will be clearer. @@ -251,7 +245,7 @@ let build_initial_env add_type add_extension empty_env = let add_type = mk_add_type add_type and add_type1 type_ident ?(kind=fun _ -> Type_abstract Abstract_def) - ?(jkind=Jkind.non_null_value ~why:(Primitive type_ident)) + ?(jkind=Jkind.value ~why:(Primitive type_ident)) (* See the comment on the [jkind_annotation] argument to [mk_add_type] *) ?jkind_annotation @@ -286,7 +280,7 @@ let build_initial_env add_type add_extension empty_env = let add_extension id args jkinds = Array.iter (fun jkind -> match Jkind.get jkind with - | Const (Value | Non_null_value) -> () + | Const Value -> () | _ -> Misc.fatal_error "sanity check failed: non-value jkind in predef extension \ @@ -327,10 +321,9 @@ let build_initial_env add_type add_extension empty_env = ~jkind_annotation:Immediate |> add_type ident_exn ~kind:Type_open - ~jkind:(Jkind.non_null_value ~why:Extensible_variant) + ~jkind:(Jkind.value ~why:Extensible_variant) |> add_type ident_extension_constructor - (* CR layouts v3: [float] should be non-null. *) - |> add_type ident_float ~jkind:(Jkind.value ~why:(Primitive ident_float)) + |> add_type ident_float |> add_type ident_floatarray |> add_type ident_int ~jkind:(Jkind.immediate ~why:(Primitive ident_int)) ~jkind_annotation:Immediate @@ -339,7 +332,6 @@ let build_initial_env add_type add_extension empty_env = |> add_type1 ident_lazy_t ~variance:Variance.covariant ~separability:Separability.Ind - ~jkind:(Jkind.value ~why:(Primitive ident_lazy_t)) |> add_type1 ident_list ~variance:Variance.covariant ~separability:Separability.Ind @@ -350,10 +342,10 @@ let build_initial_env add_type add_extension empty_env = [| Constructor_uniform_value, [| |]; Constructor_uniform_value, [| list_argument_jkind; - Jkind.non_null_value ~why:Boxed_variant; + Jkind.value ~why:Boxed_variant; |]; |] ) - ~jkind:(Jkind.non_null_value ~why:Boxed_variant) + ~jkind:(Jkind.value ~why:Boxed_variant) |> add_type ident_nativeint |> add_type1 ident_option ~variance:Variance.covariant @@ -363,7 +355,7 @@ let build_initial_env add_type add_extension empty_env = [| Constructor_uniform_value, [| |]; Constructor_uniform_value, [| option_argument_jkind |]; |]) - ~jkind:(Jkind.non_null_value ~why:Boxed_variant) + ~jkind:(Jkind.value ~why:Boxed_variant) |> add_type ident_lexing_position ~kind:( let lbl (field, field_type, jkind) = @@ -379,9 +371,9 @@ let build_initial_env add_type add_extension empty_env = ld_uid=Uid.of_predef_id id; } in - let immediate = Jkind.immediate ~why:(Primitive ident_int) in + let immediate = Jkind.value ~why:(Primitive ident_int) in let labels = List.map lbl [ - ("pos_fname", type_string, Jkind.non_null_value ~why:(Primitive ident_string)); + ("pos_fname", type_string, Jkind.value ~why:(Primitive ident_string)); ("pos_lnum", type_int, immediate); ("pos_bol", type_int, immediate); ("pos_cnum", type_int, immediate) ] @@ -391,7 +383,7 @@ let build_initial_env add_type add_extension empty_env = (Record_boxed (List.map (fun label -> label.ld_jkind) labels |> Array.of_list)) ) ) - ~jkind:(Jkind.non_null_value ~why:Boxed_record) + ~jkind:(Jkind.value ~why:Boxed_record) |> add_type ident_string |> add_type ident_unboxed_float ~jkind:(Jkind.float64 ~why:(Primitive ident_unboxed_float)) @@ -405,18 +397,6 @@ let build_initial_env add_type add_extension empty_env = |> add_type ident_unboxed_int64 ~jkind:(Jkind.add_mode_crossing (Jkind.bits64 ~why:(Primitive ident_unboxed_int64))) ~jkind_annotation:Bits64 - |> add_type1 ident_or_null - ~variance:Variance.covariant - (* CR layouts v3: Right now, since [float] can't be used in [or_null], - it is always separable. Revisit this once we finish the design. *) - ~separability:Separability.Ind - ~kind:(fun tvar -> - variant [cstr ident_null []; cstr ident_this [tvar, Unrestricted]] - [| Constructor_uniform_value, [| |]; - Constructor_uniform_value, [| or_null_argument_jkind |]; - |]) - ~jkind:(Jkind.value ~why:(Primitive ident_or_null)) - ~param_jkind:or_null_argument_jkind |> add_type ident_bytes |> add_type ident_unit ~kind:(variant @@ -426,25 +406,25 @@ let build_initial_env add_type add_extension empty_env = (* Predefined exceptions - alphabetical order *) |> add_extension ident_assert_failure [newgenty (Ttuple[None, type_string; None, type_int; None, type_int])] - [| Jkind.non_null_value ~why:Tuple |] + [| Jkind.value ~why:Tuple |] |> add_extension ident_division_by_zero [] [||] |> add_extension ident_end_of_file [] [||] |> add_extension ident_failure [type_string] - [| Jkind.non_null_value ~why:(Primitive ident_string) |] + [| Jkind.value ~why:(Primitive ident_string) |] |> add_extension ident_invalid_argument [type_string] - [| Jkind.non_null_value ~why:(Primitive ident_string) |] + [| Jkind.value ~why:(Primitive ident_string) |] |> add_extension ident_match_failure [newgenty (Ttuple[None, type_string; None, type_int; None, type_int])] - [| Jkind.non_null_value ~why:Tuple |] + [| Jkind.value ~why:Tuple |] |> add_extension ident_not_found [] [||] |> add_extension ident_out_of_memory [] [||] |> add_extension ident_stack_overflow [] [||] |> add_extension ident_sys_blocked_io [] [||] |> add_extension ident_sys_error [type_string] - [| Jkind.non_null_value ~why:(Primitive ident_string) |] + [| Jkind.value ~why:(Primitive ident_string) |] |> add_extension ident_undefined_recursive_module [newgenty (Ttuple[None, type_string; None, type_int; None, type_int])] - [| Jkind.non_null_value ~why:Tuple |] + [| Jkind.value ~why:Tuple |] let add_simd_extension_types add_type env = let add_type = mk_add_type add_type in diff --git a/ocaml/typing/typecore.ml b/ocaml/typing/typecore.ml index 822ac7368c4..4e36ac41588 100644 --- a/ocaml/typing/typecore.ml +++ b/ocaml/typing/typecore.ml @@ -2669,9 +2669,7 @@ and type_pat_aux let ty = generic_instance expected_ty in Some (p0, p, is_principal expected_ty), ty | Maybe_a_record_type -> - (* We can't assume that the jkind of a record type is [non_null_value] - because of unboxed records. *) - None, newvar (Jkind.any ~why:Dummy_jkind) + None, newvar (Jkind.value ~why:Boxed_record) | Not_a_record_type -> let error = Wrong_expected_kind(Record, Pattern, expected_ty) in raise (Error (loc, !env, error)) diff --git a/ocaml/typing/typedecl.ml b/ocaml/typing/typedecl.ml index 20ab7d69785..b6818016a61 100644 --- a/ocaml/typing/typedecl.ml +++ b/ocaml/typing/typedecl.ml @@ -809,7 +809,7 @@ let transl_declaration env sdecl (id, uid) = Constructor_uniform_value, jkinds) (Array.of_list cstrs) ), - Jkind.non_null_value ~why:Boxed_variant + Jkind.value ~why:Boxed_variant in Ttype_variant tcstrs, Type_variant (cstrs, rep), jkind | Ptype_record lbls -> @@ -823,11 +823,11 @@ let transl_declaration env sdecl (id, uid) = Record_unboxed, any else Record_boxed (Array.make (List.length lbls) any), - Jkind.non_null_value ~why:Boxed_record + Jkind.value ~why:Boxed_record in Ttype_record lbls, Type_record(lbls', rep), jkind | Ptype_open -> - Ttype_open, Type_open, Jkind.non_null_value ~why:Extensible_variant + Ttype_open, Type_open, Jkind.value ~why:Extensible_variant in let jkind = (* - If there's an annotation, we use that. It's checked against @@ -1171,7 +1171,7 @@ let update_constructor_arguments_jkinds env loc cd_args jkinds = let lbls, all_void = update_label_jkinds env loc lbls None ~is_inlined:true in - jkinds.(0) <- Jkind.non_null_value ~why:Boxed_record; + jkinds.(0) <- Jkind.value ~why:Boxed_record; Types.Cstr_record lbls, all_void let assert_mixed_product_support = @@ -1573,7 +1573,7 @@ let update_decl_jkind env dpath decl = let new_decl, new_jkind = match decl.type_kind with | Type_abstract _ -> decl, decl.type_jkind | Type_open -> - let type_jkind = Jkind.non_null_value ~why:Extensible_variant in + let type_jkind = Jkind.value ~why:Extensible_variant in { decl with type_jkind }, type_jkind | Type_record (lbls, rep) -> let lbls, rep, type_jkind = update_record_kind decl.type_loc lbls rep in diff --git a/testsuite/tests/lib-extensions/alpha_exports.ml b/testsuite/tests/lib-extensions/alpha_exports.ml index b82ce88331d..c283c905c35 100644 --- a/testsuite/tests/lib-extensions/alpha_exports.ml +++ b/testsuite/tests/lib-extensions/alpha_exports.ml @@ -9,6 +9,3 @@ *) open Stdlib_alpha - -(* Test that [Or_null] is exported. *) -type ('a : non_null_value) t = 'a Or_null.t