flambda-backend: Change [%call_pos] to the function's start position,…

… not the application's (#2765)

This feature adjusts the position that [%call_pos] uses. The motivation is |>:

```ocaml
(* f : here:[%call_pos] -> unit -> unit *)
() |> f |> f
```

Previously, both calls to f received the same position for `~here`! Both positions were the start of `()`.

This is because the AST of the expression is roughly `((() |> f) |> f)` and since call_pos uses the location of the entire function application, both calls to f had the same starting location (despite having different ending locations.)

This is change in this commit by making [%call_pos] use the start position of the function instead of the start position of the entire application.

testsuite/tests/typing-implicit-source-positions/let_operators.ml

@@ -48,7 +48,7 @@ let _ =
 val ( >>| ) :
   call_pos:[%call_pos] -> 'a -> (lexing_position * 'a -> 'b) -> 'b = <fun>
 - : lexing_position =
-{pos_fname = ""; pos_lnum = 3; pos_bol = 1128; pos_cnum = 1130}
+{pos_fname = ""; pos_lnum = 3; pos_bol = 1128; pos_cnum = 1132}
 |}]
 
 (* TEST

testsuite/tests/typing-implicit-source-positions/object_system.ml

@@ -95,7 +95,7 @@ val c : c = <obj>
 val from_method_param : lexing_position =
   {pos_fname = ""; pos_lnum = 2; pos_bol = 2216; pos_cnum = 2258}
 val from_class_param : lexing_position =
-  {pos_fname = ""; pos_lnum = 1; pos_bol = 2197; pos_cnum = 2205}
+  {pos_fname = ""; pos_lnum = 1; pos_bol = 2197; pos_cnum = 2206}
 |}]
 
 class parent ~(call_pos : [%call_pos]) () = object
@@ -123,7 +123,7 @@ let position = (o ())#pos
 [%%expect{|
 val o : call_pos:[%call_pos] -> unit -> parent = <fun>
 val position : lexing_position =
-  {pos_fname = ""; pos_lnum = 4; pos_bol = 2964; pos_cnum = 2979}
+  {pos_fname = ""; pos_lnum = 4; pos_bol = 2964; pos_cnum = 2980}
 |}]
 
 (* Applying an call_pos argument without a label. *)
@@ -140,7 +140,7 @@ Warning 6 [labels-omitted]: label call_pos was omitted in the application of thi
 
 val o : call_pos:[%call_pos] -> unit -> parent = <fun>
 val position : lexing_position =
-  {pos_fname = ""; pos_lnum = 4; pos_bol = 3293; pos_cnum = 3308}
+  {pos_fname = ""; pos_lnum = 4; pos_bol = 3293; pos_cnum = 3309}
 |}]
 
 
@@ -216,7 +216,7 @@ let x, y = (new c ~y:pos_a ())#xy
 
 [%%expect{|
 val x : lexing_position =
-  {pos_fname = ""; pos_lnum = 1; pos_bol = 5199; pos_cnum = 5210}
+  {pos_fname = ""; pos_lnum = 1; pos_bol = 5199; pos_cnum = 5211}
 val y : lexing_position =
   {pos_fname = "a"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1}
 |}]

testsuite/tests/typing-implicit-source-positions/rev_apply_correct_location.ml

@@ -0,0 +1,45 @@
+(* TEST
+ expect;
+*)
+
+let f ~(here : [%call_pos]) x = here, x
+
+[%%expect
+  {|
+val f : here:[%call_pos] -> 'a -> lexing_position * 'a = <fun>
+|}]
+
+let result = () |> f |> f
+
+(* Importantly, these locations are different. *)
+[%%expect
+  {|
+val result : lexing_position * (lexing_position * unit) =
+  ({pos_fname = ""; pos_lnum = 1; pos_bol = 145; pos_cnum = 169},
+   ({pos_fname = ""; pos_lnum = 1; pos_bol = 145; pos_cnum = 164}, ()))
+|}]
+
+class ['a] c : here:[%call_pos] -> 'a -> object
+    method here : lexing_position * 'a
+  end = fun ~(here : [%call_pos]) a -> object
+    method here = here, a
+  end
+
+[%%expect{|
+class ['a] c :
+  here:[%call_pos] -> 'a -> object method here : lexing_position * 'a end
+|}]
+
+let obj = (() |> new c |> new c)
+
+let second_here = fst obj#here
+let first_here = fst (snd obj#here)#here
+
+
+[%%expect{|
+val obj : unit c c = <obj>
+val second_here : lexing_position =
+  {pos_fname = ""; pos_lnum = 1; pos_bol = 710; pos_cnum = 736}
+val first_here : lexing_position =
+  {pos_fname = ""; pos_lnum = 1; pos_bol = 710; pos_cnum = 727}
+|}]

typing/typecore.ml

@@ -7621,7 +7621,7 @@ and type_apply_arg env ~app_loc ~funct ~index ~position_and_mode ~partial_app (l
           let arg = type_option_none env (instance ty_arg) Location.none in
           (lbl, Arg (arg, Mode.Value.legacy, sort_arg))
       | Position _ ->
-          let arg = src_pos (Location.ghostify app_loc) [] env in
+          let arg = src_pos (Location.ghostify funct.exp_loc) [] env in
           (lbl, Arg (arg, Mode.Value.legacy, sort_arg))
       | Labelled _ | Nolabel -> assert false)
   | Omitted _ as arg -> (lbl, arg)