flambda-backend: Allow [@unboxed] on non-value layouts (#2306)

* allow unboxed attr

* add tests with layout_poly

* upstream compatibility check

* rename to is_upstream_compatible_non_value_unbox

* better printtyp support

* better error message and more comments

* make the unboxed attr printing conditional

* Small refactoring

---------

Co-authored-by: Richard Eisenberg <[email protected]>

Author: alanechang

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

@@ -461,7 +461,8 @@ val f9_3 : unit -> int32# t_bits32_id = <fun>
    for uses the typechecker should reject.  In particular
    - if using a non-value layout in an external, you must supply separate
      bytecode and native code implementations,
-   - unboxed types can't be unboxed more.
+   - [@unboxed] is allowed on unboxed types but has no effect. Same is not
+     true for [@untagged].
 *)
 
 external f10_1 : int -> bool -> int32# = "foo";;
@@ -484,29 +485,33 @@ Error: The native code version of the primitive is mandatory
 
 external f10_6 : (int32#[@unboxed]) -> bool -> string  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 18-24:
-1 | external f10_6 : (int32#[@unboxed]) -> bool -> string  = "foo" "bar";;
-                      ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_6 : int32# -> bool -> string = "foo" "bar"
 |}];;
 
 external f10_7 : string -> (int32#[@unboxed])  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 28-34:
-1 | external f10_7 : string -> (int32#[@unboxed])  = "foo" "bar";;
-                                ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_7 : string -> int32# = "foo" "bar"
 |}];;
 
 external f10_8 : int32 -> int32#  = "foo" "bar" [@@unboxed];;
 [%%expect{|
-Line 1, characters 26-32:
-1 | external f10_8 : int32 -> int32#  = "foo" "bar" [@@unboxed];;
-                              ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_8 : (int32 [@unboxed]) -> int32# = "foo" "bar"
+|}];;
+
+external f10_9 : (int32#[@untagged]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 18-24:
+1 | external f10_9 : (int32#[@untagged]) -> bool -> string  = "foo" "bar";;
+                      ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+external f10_10 : string -> (int32#[@untagged])  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 29-35:
+1 | external f10_10 : string -> (int32#[@untagged])  = "foo" "bar";;
+                                 ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
 |}];;
 
 (*******************************************************)

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

@@ -461,7 +461,8 @@ val f9_3 : unit -> int64# t_bits64_id = <fun>
    for uses the typechecker should reject.  In particular
    - if using a non-value layout in an external, you must supply separate
      bytecode and native code implementations,
-   - unboxed types can't be unboxed more.
+   - [@unboxed] is allowed on unboxed types but has no effect. Same is not
+     true for [@untagged].
 *)
 
 external f10_1 : int -> bool -> int64# = "foo";;
@@ -484,29 +485,33 @@ Error: The native code version of the primitive is mandatory
 
 external f10_6 : (int64#[@unboxed]) -> bool -> string  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 18-24:
-1 | external f10_6 : (int64#[@unboxed]) -> bool -> string  = "foo" "bar";;
-                      ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_6 : int64# -> bool -> string = "foo" "bar"
 |}];;
 
 external f10_7 : string -> (int64#[@unboxed])  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 28-34:
-1 | external f10_7 : string -> (int64#[@unboxed])  = "foo" "bar";;
-                                ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_7 : string -> int64# = "foo" "bar"
 |}];;
 
 external f10_8 : int64 -> int64#  = "foo" "bar" [@@unboxed];;
 [%%expect{|
-Line 1, characters 26-32:
-1 | external f10_8 : int64 -> int64#  = "foo" "bar" [@@unboxed];;
-                              ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_8 : (int64 [@unboxed]) -> int64# = "foo" "bar"
+|}];;
+
+external f10_9 : (int64#[@untagged]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 18-24:
+1 | external f10_9 : (int64#[@untagged]) -> bool -> string  = "foo" "bar";;
+                      ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+external f10_10 : string -> (int64#[@untagged])  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 29-35:
+1 | external f10_10 : string -> (int64#[@untagged])  = "foo" "bar";;
+                                 ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
 |}];;
 
 (*******************************************************)

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

@@ -500,7 +500,8 @@ val f9_3 : unit -> float# t_float64_id = <fun>
      bytecode and native code implementations,
    - if using a non-value layout in an external, you may not use the old-style
      unboxed float directive, and
-   - unboxed types can't be unboxed more.
+   - [@unboxed] is allowed on unboxed types but has no effect. Same is not
+     true for [@untagged].
 *)
 
 external f10_1 : int -> bool -> float# = "foo";;
@@ -547,29 +548,33 @@ Error: Cannot use "float" in conjunction with types of non-value layouts.
 
 external f10_6 : (float#[@unboxed]) -> bool -> string  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 18-24:
-1 | external f10_6 : (float#[@unboxed]) -> bool -> string  = "foo" "bar";;
-                      ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_6 : float# -> bool -> string = "foo" "bar"
 |}];;
 
 external f10_7 : string -> (float#[@unboxed])  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 28-34:
-1 | external f10_7 : string -> (float#[@unboxed])  = "foo" "bar";;
-                                ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_7 : string -> float# = "foo" "bar"
 |}];;
 
 external f10_8 : float -> float#  = "foo" "bar" [@@unboxed];;
 [%%expect{|
-Line 1, characters 26-32:
-1 | external f10_8 : float -> float#  = "foo" "bar" [@@unboxed];;
-                              ^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_8 : (float [@unboxed]) -> float# = "foo" "bar"
+|}];;
+
+external f10_9 : (float#[@untagged]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 18-24:
+1 | external f10_9 : (float#[@untagged]) -> bool -> string  = "foo" "bar";;
+                      ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+external f10_10 : string -> (float#[@untagged])  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 29-35:
+1 | external f10_10 : string -> (float#[@untagged])  = "foo" "bar";;
+                                 ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
 |}];;
 
 (*******************************************************)

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

@@ -460,7 +460,8 @@ val f9_3 : unit -> nativeint# t_word_id = <fun>
    for uses the typechecker should reject.  In particular
    - if using a non-value layout in an external, you must supply separate
      bytecode and native code implementations,
-   - unboxed types can't be unboxed more.
+   - [@unboxed] is allowed on unboxed types but has no effect. Same is not
+     true for [@untagged].
 *)
 
 external f10_1 : int -> bool -> nativeint# = "foo";;
@@ -483,29 +484,33 @@ Error: The native code version of the primitive is mandatory
 
 external f10_6 : (nativeint#[@unboxed]) -> bool -> string  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 18-28:
-1 | external f10_6 : (nativeint#[@unboxed]) -> bool -> string  = "foo" "bar";;
-                      ^^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_6 : nativeint# -> bool -> string = "foo" "bar"
 |}];;
 
 external f10_7 : string -> (nativeint#[@unboxed])  = "foo" "bar";;
 [%%expect{|
-Line 1, characters 28-38:
-1 | external f10_7 : string -> (nativeint#[@unboxed])  = "foo" "bar";;
-                                ^^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_7 : string -> nativeint# = "foo" "bar"
 |}];;
 
 external f10_8 : nativeint -> nativeint#  = "foo" "bar" [@@unboxed];;
 [%%expect{|
-Line 1, characters 30-40:
-1 | external f10_8 : nativeint -> nativeint#  = "foo" "bar" [@@unboxed];;
-                                  ^^^^^^^^^^
-Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+external f10_8 : (nativeint [@unboxed]) -> nativeint# = "foo" "bar"
+|}];;
+
+external f10_9 : (nativeint#[@untagged]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 18-28:
+1 | external f10_9 : (nativeint#[@untagged]) -> bool -> string  = "foo" "bar";;
+                      ^^^^^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+external f10_10 : string -> (nativeint#[@untagged])  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 29-39:
+1 | external f10_10 : string -> (nativeint#[@untagged])  = "foo" "bar";;
+                                 ^^^^^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
 |}];;
 
 (*******************************************************)

testsuite/tests/typing-layouts/erasable_annot.ml

@@ -255,3 +255,140 @@ module M :
     val f_word : unit
   end
 |}];;
+
+(* Externals *)
+
+external f_1 : int -> bool -> int64# = "foo" "bar";;
+[%%expect{|
+Line 1, characters 30-36:
+1 | external f_1 : int -> bool -> int64# = "foo" "bar";;
+                                  ^^^^^^
+Error: [@unboxed] attribute must be added to external declaration
+       argument type with layout bits64. This error is produced
+       due to the use of -only-erasable-extensions.
+|}];;
+
+external f_2 : int32# -> bool -> int = "foo" "bar";;
+[%%expect{|
+Line 1, characters 15-21:
+1 | external f_2 : int32# -> bool -> int = "foo" "bar";;
+                   ^^^^^^
+Error: [@unboxed] attribute must be added to external declaration
+       argument type with layout bits32. This error is produced
+       due to the use of -only-erasable-extensions.
+|}];;
+
+external f_3 : (float#[@unboxed]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+external f_3 : (float# [@unboxed]) -> bool -> string = "foo" "bar"
+|}];;
+
+external f_4 : string -> (nativeint#[@unboxed])  = "foo" "bar";;
+[%%expect{|
+external f_4 : string -> (nativeint# [@unboxed]) = "foo" "bar"
+|}];;
+
+external f_5 : int64 -> int64#  = "foo" "bar" [@@unboxed];;
+[%%expect{|
+external f_5 : int64 -> int64# = "foo" "bar" [@@unboxed]
+|}];;
+
+external f_6 : (int32#[@untagged]) -> bool -> string  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 16-22:
+1 | external f_6 : (int32#[@untagged]) -> bool -> string  = "foo" "bar";;
+                    ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+external f_7 : string -> (int64#[@untagged])  = "foo" "bar";;
+[%%expect{|
+Line 1, characters 26-32:
+1 | external f_7 : string -> (int64#[@untagged])  = "foo" "bar";;
+                              ^^^^^^
+Error: Don't know how to untag this type. Only int can be untagged.
+|}];;
+
+(* With [@layout_poly] *)
+
+external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity"
+[%%expect{|
+external id : ('a : any). 'a -> 'a = "%identity" [@@layout_poly]
+|}];;
+
+
+external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity" [@@unboxed]
+[%%expect{|
+Line 1, characters 40-42:
+1 | external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity" [@@unboxed]
+                                            ^^
+Error: Don't know how to unbox this type.
+       Only float, int32, int64, nativeint, vector primitives, and
+       concrete unboxed types can be marked unboxed.
+|}];;
+
+
+external[@layout_poly] id : ('a : any). ('a[@unboxed]) -> 'a = "%identity"
+[%%expect{|
+Line 1, characters 41-43:
+1 | external[@layout_poly] id : ('a : any). ('a[@unboxed]) -> 'a = "%identity"
+                                             ^^
+Error: Don't know how to unbox this type.
+       Only float, int32, int64, nativeint, vector primitives, and
+       concrete unboxed types can be marked unboxed.
+|}];;
+
+(* module and abstract types *)
+module M : sig
+  type t : float64
+end = struct
+  type t = float#
+end
+
+external f_1 : M.t -> M.t = "%identity";;
+[%%expect{|
+module M : sig type t : float64 end
+Line 7, characters 15-18:
+7 | external f_1 : M.t -> M.t = "%identity";;
+                   ^^^
+Error: [@unboxed] attribute must be added to external declaration
+       argument type with layout float64. This error is produced
+       due to the use of -only-erasable-extensions.
+|}];;
+
+external f_2 : M.t -> M.t = "%identity" [@@unboxed];;
+[%%expect{|
+Line 1, characters 15-18:
+1 | external f_2 : M.t -> M.t = "%identity" [@@unboxed];;
+                   ^^^
+Error: External declaration here is not upstream compatible.
+       The only types with non-value layouts allowed are float#,
+       int32#, int64#, and nativeint#. Unknown type with layout
+       float64 encountered. This error is produced due to
+       the use of -only-erasable-extensions.
+|}];;
+
+module M2 : sig
+  type t = float#
+end = struct
+  type t = float#
+end
+
+external f_3 : M2.t -> M2.t = "%identity" [@@unboxed];;
+[%%expect{|
+module M2 : sig type t = float# end
+external f_3 : M2.t -> M2.t = "%identity" [@@unboxed]
+|}];;
+
+(* should also work with private types *)
+module M3 : sig
+  type t = private float#
+end = struct
+  type t = float#
+end
+
+external f_4 : M3.t -> M3.t = "%identity" [@@unboxed]
+[%%expect{|
+module M3 : sig type t = private float# end
+external f_4 : M3.t -> M3.t = "%identity" [@@unboxed]
+|}];;

testsuite/tests/typing-layouts/layout_poly.ml

@@ -555,7 +555,8 @@ Line 1, characters 40-42:
 1 | external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity" [@@unboxed]
                                             ^^
 Error: Don't know how to unbox this type.
-       Only float, int32, int64, nativeint, and vector primitives can be unboxed.
+       Only float, int32, int64, nativeint, vector primitives, and
+       concrete unboxed types can be marked unboxed.
 |}]
 
 external[@layout_poly] id : ('a : any). 'a -> 'a = "%identity" [@@untagged]