Skip to content

Commit

Permalink
Fixed the location that [%call_pos] points at.
Browse files Browse the repository at this point in the history
[%call_pos] used to point to the location of the
entire function application.

This resulted in instances like:

```ocaml
(* f : here:[%call_pos] -> unit -> unit *)
() |> f |> f
```
where both [f]'s had the same location.

This is fixed in this commit by making [%call_pos] use the location of
the function instead of the location of the entire application.
  • Loading branch information
Enoumy committed Jul 9, 2024
1 parent c8a4dc3 commit 81c6ef9
Show file tree
Hide file tree
Showing 4 changed files with 51 additions and 6 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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. *)
Expand All @@ -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}
|}]


Expand Down Expand Up @@ -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}
|}]
Expand Down
Original file line number Diff line number Diff line change
@@ -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}
|}]
2 changes: 1 addition & 1 deletion ocaml/typing/typecore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down

0 comments on commit 81c6ef9

Please sign in to comment.