flambda-backend: Bugfix for type_application (#746)

The modes for the function being applied were wrong in the case of a
Regional function, which can allow a heap closure to close over a
stack closure.

Author: stedolan

testsuite/tests/typing-local/local.ml

@@ -487,6 +487,27 @@ Line 3, characters 63-64:
 Error: The value a is local, so cannot be used inside a closure that might escape
 |}]
 
+(* Regression test for bug with mishandled regional function modes *)
+let bug4 : local_ (string -> foo:string -> unit) -> (string -> unit) =
+  fun f -> f ~foo:"hello"
+[%%expect{|
+Line 2, characters 11-25:
+2 |   fun f -> f ~foo:"hello"
+               ^^^^^^^^^^^^^^
+Error: This value escapes its region
+|}]
+
+let bug4' () =
+  let local_ f arg ~foo = () in
+  let local_ perm ~foo = f ~foo in
+  perm ~foo:"foo" "Optional"
+[%%expect{|
+Line 3, characters 25-31:
+3 |   let local_ perm ~foo = f ~foo in
+                             ^^^^^^
+Error: This local value escapes its region
+  Hint: Cannot return local value without an explicit "local_" annotation
+|}]
 
 (*
  * Optional arguments

typing/typecore.ml

@@ -5396,7 +5396,7 @@ and type_application env app_loc expected_mode position funct funct_mode sargs =
       in
       let ty_ret, mode_ret, args =
         collect_apply_args env funct ignore_labels ty (instance ty)
-          (Value_mode.regional_to_global_alloc funct_mode) sargs
+          (Value_mode.regional_to_local_alloc funct_mode) sargs
       in
       let partial_app = is_partial_apply args in
       let position = if partial_app then Default else position in