flambda-backend: Remove exact from expected_mode (#2300)

* remove exact from expected_mode

* Kill off an Option.get

* address comments

* improve tests

* add comments

---------

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

Author: riaqn

testsuite/tests/typing-local/exclave.ml

@@ -214,6 +214,27 @@ Error: This function or one of its parameters escape their region
        when it is partially applied.
 |}]
 
+let f () =
+  exclave_ (
+    (fun x -> function | "a" -> () | _ -> ()) : (string -> string -> unit)
+  )
+[%%expect{|
+Line 3, characters 4-45:
+3 |     (fun x -> function | "a" -> () | _ -> ()) : (string -> string -> unit)
+        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This function or one of its parameters escape their region
+       when it is partially applied.
+|}]
+
+(* For nested functions, inner functions are not constrained *)
+let f () =
+  exclave_ (
+    (fun x -> fun y -> ()) : (string -> string -> unit)
+  )
+[%%expect{|
+val f : unit -> local_ (string -> (string -> unit)) = <fun>
+|}]
+
 let f : local_ string -> string =
   fun x -> exclave_ s
 [%%expect{|
@@ -222,4 +243,4 @@ Line 2, characters 11-21:
                ^^^^^^^^^^
 Error: This expression was expected to be not local, but is an exclave expression,
        which must be local.
-|}]
+|}]

testsuite/tests/typing-local/local.ml

@@ -2751,27 +2751,36 @@ Error: Signature mismatch:
 
 (* Escaping uncurried functions *)
 
-(* Valid; [local_ int -> int -> int] is [local_ int -> local_ (int -> int)] *)
-let f () = ((fun x y -> x + y) : (local_ int -> int -> int));;
+(* Valid; [local_ string -> string -> string] is [local_ string -> local_ (string -> string)] *)
+let f () = ((fun x y -> "") : (local_ string -> string -> string));;
 [%%expect{|
-val f : unit -> local_ int -> int -> int = <fun>
+val f : unit -> local_ string -> string -> string = <fun>
 |}];;
 
-(* Illegal: the return mode on (int -> int) is global. *)
-let f () = ((fun x y -> x + y) : (local_ int -> (int -> int)));;
+(* Illegal: the return mode on (string -> string) is global. *)
+let f () = ((fun x y -> "") : (local_ string -> (string -> string)));;
 [%%expect{|
-Line 1, characters 12-30:
-1 | let f () = ((fun x y -> x + y) : (local_ int -> (int -> int)));;
-                ^^^^^^^^^^^^^^^^^^
+Line 1, characters 12-27:
+1 | let f () = ((fun x y -> "") : (local_ string -> (string -> string)));;
+                ^^^^^^^^^^^^^^^
+Error: This function or one of its parameters escape their region
+       when it is partially applied.
+|}];;
+
+let f () = ((fun x -> function | y -> "") : (local_ string -> (string -> string)));;
+[%%expect{|
+Line 1, characters 12-41:
+1 | let f () = ((fun x -> function | y -> "") : (local_ string -> (string -> string)));;
+                ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 Error: This function or one of its parameters escape their region
        when it is partially applied.
 |}];;
 
 (* ok if curried *)
-let f () = ((fun x -> (fun y -> x + y) [@extension.curry])
-            : (local_ int -> (int -> int)));;
+let f () = ((fun x -> (fun y -> "") [@extension.curry])
+            : (local_ string -> (string -> string)));;
 [%%expect{|
-val f : unit -> local_ int -> (int -> int) = <fun>
+val f : unit -> local_ string -> (string -> string) = <fun>
 |}];;
 
 (* Illegal: the expected mode is global *)
@@ -2784,6 +2793,26 @@ Error: This function or one of its parameters escape their region
        when it is partially applied.
 |}];;
 
+let f () = local_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));;
+[%%expect{|
+Line 1, characters 19-60:
+1 | let f () = local_ ((fun x -> function | 0 -> x | y -> x + y) : (_ -> _));;
+                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This function or one of its parameters escape their region
+       when it is partially applied.
+|}];;
+
+(* For nested functions, inner functions are not constrained *)
+let f () = ((fun x -> fun y -> "") : (local_ string -> (string -> string)));;
+[%%expect{|
+val f : unit -> local_ string -> (string -> string) = <fun>
+|}];;
+
+let f () = local_ ((fun x -> fun y -> x + y) : (_ -> _));;
+[%%expect{|
+val f : unit -> local_ (int -> (int -> int)) = <fun>
+|}];;
+
 (* ok if curried *)
 let f () = local_ ((fun x -> (fun y -> x + y) [@extension.curry]) : (_ -> _));;
 [%%expect{|

testsuite/tests/typing-unique/unique.ml

@@ -542,25 +542,40 @@ type box = { x : int }
 type box = { x : int; }
 |}]
 
-let curry (unique_ b1 : box) (unique_ b2 : box) = b1
+let curry (unique_ b1 : box) (unique_ b2 : box) = ()
 [%%expect{|
-val curry : unique_ box -> unique_ box -> box = <fun>
+val curry : unique_ box -> unique_ box -> unit = <fun>
 |}]
 
-let curry : unique_ box -> unique_ box -> unique_ box = fun b1 b2 -> b1
+let curry : unique_ box -> unique_ box -> unit = fun b1 b2 -> ()
 [%%expect{|
-val curry : unique_ box -> unique_ box -> unique_ box = <fun>
+val curry : unique_ box -> unique_ box -> unit = <fun>
 |}]
 
-let curry : unique_ box -> (unique_ box -> unique_ box) = fun b1 b2 -> b1
+let curry : unique_ box -> (unique_ box -> unit) = fun b1 b2 -> ()
 [%%expect{|
-Line 1, characters 58-73:
-1 | let curry : unique_ box -> (unique_ box -> unique_ box) = fun b1 b2 -> b1
-                                                              ^^^^^^^^^^^^^^^
+Line 1, characters 51-66:
+1 | let curry : unique_ box -> (unique_ box -> unit) = fun b1 b2 -> ()
+                                                       ^^^^^^^^^^^^^^^
 Error: This function when partially applied returns a once value,
        but expected to be many.
 |}]
 
+let curry : unique_ box -> (unique_ box -> unit) = fun b1 -> function | b2 -> ()
+[%%expect{|
+Line 1, characters 51-80:
+1 | let curry : unique_ box -> (unique_ box -> unit) = fun b1 -> function | b2 -> ()
+                                                       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This function when partially applied returns a once value,
+       but expected to be many.
+|}]
+
+(* For nested functions, inner functions are not constrained *)
+let no_curry : unique_ box -> (unique_ box -> unit) = fun b1 -> fun b2 -> ()
+[%%expect{|
+val no_curry : unique_ box -> (unique_ box -> unit) = <fun>
+|}]
+
 (* If both type and mode are wrong, complain about type *)
 let f () =
   let id2 (x : string) = shared_id x in
@@ -615,4 +630,4 @@ Line 5, characters 16-17:
 5 |        in Node (x, x)
                     ^
 
-|}]
+|}]