flambda-backend: Allow non-value function args and returns (#1405)

* Change value restrictions on functions to sort restrictions

* Update tests for new reality

* Simplify and improve efficiency of defaulting code

* Review stuff

* Use a consistent name ("get") for the getter in both Sort and Layout

* bootstrap

* Fix test

Author: ccasin

boot/ocamlc

@@ -51,8 +51,16 @@ let layout_must_be_value loc layout =
 
 (* CR layouts v2: In the places where this is used, we want to allow any (the
    left of a semicolon and loop bodies).  So we want this instead of the usual
-   sanity check for value.  *)
+   sanity check for value.  But we still default to value before checking for
+   void, to allow for sort variables arising in situations like
+
+     let foo () = raise Foo; ()
+
+   When this sanity check is removed, consider whether we are still defaulting
+   appropriately.
+*)
 let layout_must_not_be_void loc layout =
+  Layout.default_to_value layout;
   match Layout.(sub layout void) with
   | Ok () ->
     let violation = Layout.(Violation.not_a_sublayout layout value) in

boot/ocamllex

@@ -45,7 +45,15 @@ exception Error of Location.t * error
 
 (* CR layouts v2: This is used as part of the "void safety check" in the case of
    [Tstr_eval], where we want to allow any sort (see comment on that case of
-   typemod).  Remove when we remove the safety check. *)
+   typemod).  Remove when we remove the safety check.
+
+   We still default to value before checking for void, to allow for sort
+   variables arising in situations like a module that is just:
+
+     exit 1;;
+
+   When this sanity check is removed, consider whether it must be replaced with
+   some defaulting. *)
 let sort_must_not_be_void loc ty sort =
   let layout = Layout.of_sort sort in
   if Layout.is_void layout then

lambda/translcore.ml

@@ -28,14 +28,17 @@ Error: Layout void is used here, but the appropriate layouts extension is not en
 |}];;
 
 
-(*************************************************)
-(* Test 1: Reject non-value function arg/returns *)
+(************************************************************)
+(* Test 1: Disallow non-representable function args/returns *)
+
+(* CR layouts v3: moved to layouts alpha.  Bring here when we have
+   non-representable layouts enabled by default. *)
 
-(* CR layouts: moved to [basics_alpha.ml].  Bring back here when non-value layouts
-   are enabled by default. *)
+(*****************************************************)
+(* Test 2: Permit representable function arg/returns *)
 
-(*********************************************)
-(* Test 2: Permit value function arg/returns *)
+(* CR layouts v3: much of this test moved to basics_alpha.  Add #float versions
+   and bring them here when #float is allowed by default. *)
 module type S = sig
   val f1 : t_value -> t_value
   val f2 : t_imm -> t_imm64

lambda/translmod.ml

@@ -24,119 +24,170 @@ type void_record = { vr_void : t_void; vr_int : int; }
 type void_unboxed_record = { vur_void : t_void; } [@@unboxed]
 |}];;
 
-(*************************************************)
-(* Test 1: Reject non-value function arg/returns *)
-
-(* CR layouts v2: the F1 and F1' errors should ideally mention that the layout
-   restriction is coming from the function type. This may be easier when we
-   switch to introducing restrictions on [fun] *)
-module F1 (X : sig val x : t_void end) = struct
-  let f () = X.x
-end;;
-[%%expect{|
-Line 2, characters 13-16:
-2 |   let f () = X.x
-                 ^^^
-Error: This expression has type t_void but an expression was expected of type
-         ('a : value)
-       t_void has layout void, which is not a sublayout of value.
-|}];;
-
-module F1 (X : sig val f : void_record -> unit end) = struct
-  let g z = X.f { vr_void = z; vr_int = 42 }
+(************************************************************)
+(* Test 1: Disallow non-representable function args/returns *)
+module type S1 = sig
+  val f : int -> t_any
 end;;
-[%%expect{|
-Line 2, characters 28-29:
-2 |   let g z = X.f { vr_void = z; vr_int = 42 }
-                                ^
-Error: This expression has type ('a : value)
-       but an expression was expected of type t_void
-       t_void has layout void, which is not a sublayout of value.
+[%%expect {|
+Line 2, characters 17-22:
+2 |   val f : int -> t_any
+                     ^^^^^
+Error: Function return types must have a representable layout.
+        t_any has layout any, which is not representable.
 |}];;
 
-module type S = sig
+module type S1 = sig
   val f : t_any -> int
 end;;
 [%%expect {|
 Line 2, characters 10-15:
 2 |   val f : t_any -> int
               ^^^^^
-Error: Function argument types must have layout value.
-        t_any has layout any, which is not a sublayout of value.
+Error: Function argument types must have a representable layout.
+        t_any has layout any, which is not representable.
+|}];;
+
+module type S1 = sig
+  type t [@@any]
+
+  type 'a s = 'a -> int constraint 'a = t
+end;;
+[%%expect{|
+Line 4, characters 35-41:
+4 |   type 'a s = 'a -> int constraint 'a = t
+                                       ^^^^^^
+Error: The type constraints are not consistent.
+       Type ('a : '_representable_layout_1) is not compatible with type t
+       t has layout any, which is not representable.
 |}]
 
-module type S = sig
-  val f : int -> t_void
+module type S1 = sig
+  type t [@@any]
+
+  type 'a s = int -> 'a constraint 'a = t
 end;;
-[%%expect {|
-Line 2, characters 17-23:
-2 |   val f : int -> t_void
-                     ^^^^^^
-Error: Function return types must have layout value.
-        t_void has layout void, which is not a sublayout of value.
+[%%expect{|
+Line 4, characters 35-41:
+4 |   type 'a s = int -> 'a constraint 'a = t
+                                       ^^^^^^
+Error: The type constraints are not consistent.
+       Type ('a : '_representable_layout_2) is not compatible with type t
+       t has layout any, which is not representable.
+|}]
+
+let f1 () : t_any = assert false;;
+[%%expect{|
+Line 1, characters 10-32:
+1 | let f1 () : t_any = assert false;;
+              ^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type t_any but an expression was expected of type
+         ('a : '_representable_layout_3)
+       t_any has layout any, which is not representable.
 |}];;
 
+let f1 (x : t_any) = ();;
+[%%expect{|
+Line 1, characters 7-18:
+1 | let f1 (x : t_any) = ();;
+           ^^^^^^^^^^^
+Error: This pattern matches values of type t_any
+       but a pattern was expected which matches values of type
+         ('a : '_representable_layout_4)
+       t_any has layout any, which is not representable.
+|}];;
+
+(*****************************************************)
+(* Test 2: Permit representable function arg/returns *)
+
+(* Presently, the typechecker will allow any representable layout as a function
+   arg or return type.  The translation to lambda rejects functions with
+   void args / returns. *)
+(* CR layouts v2: The translation to lambda should reject void but not #float *)
+(* CR layouts v2: Once we have another sort that can make it through lambda
+   (#float), add tests showing the way sort variables will be instantiated.
+
+   1) [let f x = x] roughly has type [('a : '_sort) -> ('a : '_sort)].
+      Test that you can apply it to a value or to a #float, but once you've
+      done that you can't apply it to the other.
+
+   2) If [f] has a type in the mli (and isn't used in the ml) we get the sort
+      from there.
+
+   I think that all already works, but for the lack of #float *)
+
 module type S = sig
+  val f1 : t_value -> t_value
+  val f2 : t_imm -> t_imm64
+end;;
+
+[%%expect{|
+module type S = sig val f1 : t_value -> t_value val f2 : t_imm -> t_imm64 end
+|}];;
+
+module type S2 = sig
   val f : void_unboxed_record -> int
 end
 [%%expect {|
-Line 2, characters 10-29:
-2 |   val f : void_unboxed_record -> int
-              ^^^^^^^^^^^^^^^^^^^
-Error: Function argument types must have layout value.
-        void_unboxed_record has layout void,
-          which is not a sublayout of value.
+module type S2 = sig val f : void_unboxed_record -> int end
 |}];;
 
-module type S = sig
+module type S2 = sig
   val f : int -> void_unboxed_record
 end
 [%%expect {|
-Line 2, characters 17-36:
-2 |   val f : int -> void_unboxed_record
-                     ^^^^^^^^^^^^^^^^^^^
-Error: Function return types must have layout value.
-        void_unboxed_record has layout void,
-          which is not a sublayout of value.
+module type S2 = sig val f : int -> void_unboxed_record end
 |}];;
 
-module type S = sig
+module type S2 = sig
   type t [@@void]
 
   type s = r -> int
   and r = t
 end;;
 [%%expect{|
-Line 5, characters 2-11:
-5 |   and r = t
-      ^^^^^^^^^
-Error:
-       r has layout void, which is not a sublayout of value.
+module type S2 = sig type t [@@void] type s = r -> int and r = t end
 |}]
 
+module type S2 = sig
+  val f : int -> t_void
+end;;
+[%%expect {|
+module type S2 = sig val f : int -> t_void end
+|}];;
+
 module type S = sig
   type t [@@void]
 
   type 'a s = 'a -> int constraint 'a = t
 end;;
 [%%expect{|
-Line 4, characters 35-41:
-4 |   type 'a s = 'a -> int constraint 'a = t
-                                       ^^^^^^
-Error: The type constraints are not consistent.
-       Type ('a : value) is not compatible with type t
-       t has layout void, which is not a sublayout of value.
+module type S =
+  sig type t [@@void] type 'a s = 'a -> int constraint 'a = t end
 |}]
 
-(*********************************************)
-(* Test 2: Permit value function arg/returns *)
-module type S = sig
-  val f1 : t_value -> t_value
-  val f2 : t_imm -> t_imm64
+module F2 (X : sig val x : t_void end) = struct
+  let f () = X.x
 end;;
+[%%expect{|
+Line 2, characters 8-16:
+2 |   let f () = X.x
+            ^^^^^^^^
+Error: Non-value detected in [value_kind].
+       Please report this error to the Jane Street compilers team.
+       t_void has layout void, which is not a sublayout of value.
+|}];;
 
+module F2 (X : sig val f : void_record -> unit end) = struct
+  let g z = X.f { vr_void = z; vr_int = 42 }
+end;;
 [%%expect{|
-module type S = sig val f1 : t_value -> t_value val f2 : t_imm -> t_imm64 end
+Line 2, characters 8-44:
+2 |   let g z = X.f { vr_void = z; vr_int = 42 }
+            ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Non-value detected in [value_kind].
+       Please report this error to the Jane Street compilers team.
+       t_void has layout void, which is not a sublayout of value.
 |}];;
 
 (**************************************)
@@ -318,19 +369,13 @@ let g (x : 'a void5) =
   match x with
   | Void5 x -> x;;
 [%%expect{|
-Line 3, characters 15-16:
-3 |   | Void5 x -> x;;
-                   ^
-Error: This expression has type ('a : void)
-       but an expression was expected of type ('b : value)
-       'a has layout value, which does not overlap with void.
-|}, Principal{|
-Lines 2-3, characters 2-16:
-2 | ..match x with
+Lines 1-3, characters 6-16:
+1 | ......(x : 'a void5) =
+2 |   match x with
 3 |   | Void5 x -> x..
-Error: This expression has type ('a : void)
-       but an expression was expected of type ('b : value)
-       'a has layout value, which does not overlap with void.
+Error: Non-value detected in [value_kind].
+       Please report this error to the Jane Street compilers team.
+       'a has layout void, which is not a sublayout of value.
 |}]
 
 (****************************************)

testsuite/tests/typing-layouts/basics.ml

@@ -29,14 +29,17 @@ Line 1, characters 13-21:
 Error: Layout void is used here, but the appropriate layouts extension is not enabled
 |}];;
 
-(*************************************************)
-(* Test 1: Reject non-value function arg/returns *)
+(************************************************************)
+(* Test 1: Disallow non-representable function args/returns *)
+
+(* CR layouts v3: moved to layouts alpha.  Bring here when we have
+   non-representable layouts in beta. *)
 
-(* CR layouts v2: moved to layouts alpha.  Bring here when we have a non-value
-   layout in beta. *)
+(*****************************************************)
+(* Test 2: Permit representable function arg/returns *)
 
-(*********************************************)
-(* Test 2: Permit value function arg/returns *)
+(* CR layouts v2: much of this test moved to basics_alpha.  Add #float versions
+   and bring them here. *)
 module type S = sig
   val f1 : t_value -> t_value
   val f2 : t_imm -> t_imm64

testsuite/tests/typing-layouts/basics_alpha.ml

@@ -104,7 +104,7 @@ end
 and Bar3 : sig
   type t [@@void]
 end = struct
-  type t
+  type t [@@void]
 end;;
 [%%expect {|
 Line 8, characters 9-17:

testsuite/tests/typing-layouts/basics_beta.ml

@@ -156,14 +156,15 @@ end
 and Bar3 : sig
   type t [@@void]
 end = struct
-  type t
+  type t [@@void]
 end;;
 [%%expect {|
-Line 2, characters 15-21:
-2 |   val create : Bar3.t -> unit
-                   ^^^^^^
-Error: Function argument types must have layout value.
-        Bar3.t has layout void, which is not a sublayout of value.
+Line 4, characters 13-19:
+4 |   let create _ = ()
+                 ^^^^^^
+Error: Non-value detected in [value_kind].
+       Please report this error to the Jane Street compilers team.
+       'a has layout void, which is not a sublayout of value.
 |}];;
 
 module rec Foo3 : sig
@@ -181,7 +182,7 @@ end;;
 Line 2, characters 2-31:
 2 |   type t = Bar3.t [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type Bar3/2.t has layout value, which is not a sublayout of immediate.
+Error: Type Bar3.t has layout value, which is not a sublayout of immediate.
 |}];;
 
 module rec Foo3 : sig

testsuite/tests/typing-layouts/modules.ml

@@ -175,7 +175,7 @@ end
 and Bar3 : sig
   type t [@@void]
 end = struct
-  type t
+  type t [@@void]
 end;;
 [%%expect {|
 Line 8, characters 9-17: