Skip to content

Commit 3662194

Browse files
patricoferrispatricoferris
committed
Reconstruct Longident locations
When migrating from 503 to 504, we try to reconstruct the locations of the segments of long identifiers. Signed-off-by: Patrick Ferris <patrick@sirref.org>
1 parent 56b0211 commit 3662194

File tree

3 files changed

+86
-47
lines changed

3 files changed

+86
-47
lines changed

‎astlib/migrate_503_504.ml‎

Lines changed: 76 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -28,19 +28,23 @@ and copy_directive_argument :
2828
Ast_503.Parsetree.directive_argument -> Ast_504.Parsetree.directive_argument
2929
=
3030
fun { Ast_503.Parsetree.pdira_desc; Ast_503.Parsetree.pdira_loc } ->
31+
let loc = copy_location pdira_loc in
3132
{
32-
Ast_504.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc;
33-
Ast_504.Parsetree.pdira_loc = copy_location pdira_loc;
33+
Ast_504.Parsetree.pdira_desc =
34+
copy_directive_argument_desc_with_loc ~loc pdira_desc;
35+
Ast_504.Parsetree.pdira_loc = loc;
3436
}
3537

36-
and copy_directive_argument_desc :
38+
and copy_directive_argument_desc_with_loc :
39+
loc:Location.t ->
3740
Ast_503.Parsetree.directive_argument_desc ->
38-
Ast_504.Parsetree.directive_argument_desc = function
41+
Ast_504.Parsetree.directive_argument_desc =
42+
fun ~loc -> function
3943
| Ast_503.Parsetree.Pdir_string x0 -> Ast_504.Parsetree.Pdir_string x0
4044
| Ast_503.Parsetree.Pdir_int (x0, x1) ->
4145
Ast_504.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1)
4246
| Ast_503.Parsetree.Pdir_ident x0 ->
43-
Ast_504.Parsetree.Pdir_ident (copy_Longident_t x0)
47+
Ast_504.Parsetree.Pdir_ident (copy_Longident_t ~loc x0)
4448
| Ast_503.Parsetree.Pdir_bool x0 -> Ast_504.Parsetree.Pdir_bool x0
4549

4650
and copy_expression :
@@ -70,7 +74,7 @@ and copy_expression_desc_with_loc :
7074
fun ~loc desc ->
7175
match desc with
7276
| Ast_503.Parsetree.Pexp_ident x0 ->
73-
Ast_504.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0)
77+
Ast_504.Parsetree.Pexp_ident (copy_loc (copy_Longident_t ~loc) x0)
7478
| Ast_503.Parsetree.Pexp_constant x0 ->
7579
let loc = { loc with loc_ghost = true } in
7680
let constant = { (copy_constant x0) with pconst_loc = loc } in
@@ -100,7 +104,7 @@ and copy_expression_desc_with_loc :
100104
(List.map (fun v -> (None, copy_expression v)) x0)
101105
| Ast_503.Parsetree.Pexp_construct (x0, x1) ->
102106
Ast_504.Parsetree.Pexp_construct
103-
(copy_loc copy_Longident_t x0, Option.map copy_expression x1)
107+
(copy_loc (copy_Longident_t ~loc) x0, Option.map copy_expression x1)
104108
| Ast_503.Parsetree.Pexp_variant (x0, x1) ->
105109
Ast_504.Parsetree.Pexp_variant
106110
(copy_label x0, Option.map copy_expression x1)
@@ -109,15 +113,18 @@ and copy_expression_desc_with_loc :
109113
( List.map
110114
(fun x ->
111115
let x0, x1 = x in
112-
(copy_loc copy_Longident_t x0, copy_expression x1))
116+
( copy_loc (copy_Longident_t ~loc:x0.Location.loc) x0,
117+
copy_expression x1 ))
113118
x0,
114119
Option.map copy_expression x1 )
115120
| Ast_503.Parsetree.Pexp_field (x0, x1) ->
116121
Ast_504.Parsetree.Pexp_field
117-
(copy_expression x0, copy_loc copy_Longident_t x1)
122+
(copy_expression x0, copy_loc (copy_Longident_t ~loc:x1.loc) x1)
118123
| Ast_503.Parsetree.Pexp_setfield (x0, x1, x2) ->
119124
Ast_504.Parsetree.Pexp_setfield
120-
(copy_expression x0, copy_loc copy_Longident_t x1, copy_expression x2)
125+
( copy_expression x0,
126+
copy_loc (copy_Longident_t ~loc:x1.loc) x1,
127+
copy_expression x2 )
121128
| Ast_503.Parsetree.Pexp_array x0 ->
122129
Ast_504.Parsetree.Pexp_array (List.map copy_expression x0)
123130
| Ast_503.Parsetree.Pexp_ifthenelse (x0, x1, x2) ->
@@ -142,7 +149,7 @@ and copy_expression_desc_with_loc :
142149
| Ast_503.Parsetree.Pexp_send (x0, x1) ->
143150
Ast_504.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1)
144151
| Ast_503.Parsetree.Pexp_new x0 ->
145-
Ast_504.Parsetree.Pexp_new (copy_loc copy_Longident_t x0)
152+
Ast_504.Parsetree.Pexp_new (copy_loc (copy_Longident_t ~loc:x0.loc) x0)
146153
| Ast_503.Parsetree.Pexp_setinstvar (x0, x1) ->
147154
Ast_504.Parsetree.Pexp_setinstvar
148155
(copy_loc copy_label x0, copy_expression x1)
@@ -320,7 +327,7 @@ and copy_pattern_desc_with_loc :
320327
(List.map (fun v -> (None, copy_pattern v)) x0, Closed)
321328
| Ast_503.Parsetree.Ppat_construct (x0, x1) ->
322329
Ast_504.Parsetree.Ppat_construct
323-
( copy_loc copy_Longident_t x0,
330+
( copy_loc (copy_Longident_t ~loc:x0.loc) x0,
324331
Option.map
325332
(fun x ->
326333
let x0, x1 = x in
@@ -333,7 +340,8 @@ and copy_pattern_desc_with_loc :
333340
( List.map
334341
(fun x ->
335342
let x0, x1 = x in
336-
(copy_loc copy_Longident_t x0, copy_pattern x1))
343+
( copy_loc (copy_Longident_t ~loc:x0.Location.loc) x0,
344+
copy_pattern x1 ))
337345
x0,
338346
copy_closed_flag x1 )
339347
| Ast_503.Parsetree.Ppat_array x0 ->
@@ -343,7 +351,8 @@ and copy_pattern_desc_with_loc :
343351
| Ast_503.Parsetree.Ppat_constraint (x0, x1) ->
344352
Ast_504.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1)
345353
| Ast_503.Parsetree.Ppat_type x0 ->
346-
Ast_504.Parsetree.Ppat_type (copy_loc copy_Longident_t x0)
354+
Ast_504.Parsetree.Ppat_type
355+
(copy_loc (copy_Longident_t ~loc:x0.Location.loc) x0)
347356
| Ast_503.Parsetree.Ppat_lazy x0 ->
348357
Ast_504.Parsetree.Ppat_lazy (copy_pattern x0)
349358
| Ast_503.Parsetree.Ppat_unpack x0 ->
@@ -358,7 +367,8 @@ and copy_pattern_desc_with_loc :
358367
| Ast_503.Parsetree.Ppat_extension x0 ->
359368
Ast_504.Parsetree.Ppat_extension (copy_extension x0)
360369
| Ast_503.Parsetree.Ppat_open (x0, x1) ->
361-
Ast_504.Parsetree.Ppat_open (copy_loc copy_Longident_t x0, copy_pattern x1)
370+
Ast_504.Parsetree.Ppat_open
371+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_pattern x1)
362372
| Ast_503.Parsetree.Ppat_effect (x0, x1) ->
363373
Ast_504.Parsetree.Ppat_effect (copy_pattern x0, copy_pattern x1)
364374

@@ -411,13 +421,13 @@ and copy_core_type_desc :
411421
(List.map (fun v -> (None, copy_core_type v)) x0)
412422
| Ast_503.Parsetree.Ptyp_constr (x0, x1) ->
413423
Ast_504.Parsetree.Ptyp_constr
414-
(copy_loc copy_Longident_t x0, List.map copy_core_type x1)
424+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, List.map copy_core_type x1)
415425
| Ast_503.Parsetree.Ptyp_object (x0, x1) ->
416426
Ast_504.Parsetree.Ptyp_object
417427
(List.map copy_object_field x0, copy_closed_flag x1)
418428
| Ast_503.Parsetree.Ptyp_class (x0, x1) ->
419429
Ast_504.Parsetree.Ptyp_class
420-
(copy_loc copy_Longident_t x0, List.map copy_core_type x1)
430+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, List.map copy_core_type x1)
421431
| Ast_503.Parsetree.Ptyp_alias (x0, x1) ->
422432
Ast_504.Parsetree.Ptyp_alias (copy_core_type x0, copy_loc (fun x -> x) x1)
423433
| Ast_503.Parsetree.Ptyp_variant (x0, x1, x2) ->
@@ -432,7 +442,7 @@ and copy_core_type_desc :
432442
Ast_504.Parsetree.Ptyp_package (copy_package_type x0)
433443
| Ast_503.Parsetree.Ptyp_open (x0, ty) ->
434444
Ast_504.Parsetree.Ptyp_open
435-
(copy_loc copy_Longident_t x0, copy_core_type ty)
445+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_core_type ty)
436446
| Ast_503.Parsetree.Ptyp_extension x0 ->
437447
Ast_504.Parsetree.Ptyp_extension (copy_extension x0)
438448

@@ -441,12 +451,13 @@ and copy_package_type :
441451
fun x ->
442452
let x0, x1 = x in
443453
{
444-
ppt_path = copy_loc copy_Longident_t x0;
454+
ppt_path = copy_loc (copy_Longident_t ~loc:x0.loc) x0;
445455
ppt_cstrs =
446456
List.map
447457
(fun x ->
448458
let x0, x1 = x in
449-
(copy_loc copy_Longident_t x0, copy_core_type x1))
459+
( copy_loc (copy_Longident_t ~loc:x0.Location.loc) x0,
460+
copy_core_type x1 ))
450461
x1;
451462
ppt_loc = Location.none;
452463
ppt_attrs = [];
@@ -588,7 +599,7 @@ and copy_class_expr_desc :
588599
function
589600
| Ast_503.Parsetree.Pcl_constr (x0, x1) ->
590601
Ast_504.Parsetree.Pcl_constr
591-
(copy_loc copy_Longident_t x0, List.map copy_core_type x1)
602+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, List.map copy_core_type x1)
592603
| Ast_503.Parsetree.Pcl_structure x0 ->
593604
Ast_504.Parsetree.Pcl_structure (copy_class_structure x0)
594605
| Ast_503.Parsetree.Pcl_fun (x0, x1, x2, x3) ->
@@ -708,7 +719,7 @@ and copy_module_expr_desc :
708719
Ast_503.Parsetree.module_expr_desc -> Ast_504.Parsetree.module_expr_desc =
709720
function
710721
| Ast_503.Parsetree.Pmod_ident x0 ->
711-
Ast_504.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0)
722+
Ast_504.Parsetree.Pmod_ident (copy_loc (copy_Longident_t ~loc:x0.loc) x0)
712723
| Ast_503.Parsetree.Pmod_structure x0 ->
713724
Ast_504.Parsetree.Pmod_structure (copy_structure x0)
714725
| Ast_503.Parsetree.Pmod_functor (x0, x1) ->
@@ -751,7 +762,7 @@ and copy_module_type_desc :
751762
Ast_503.Parsetree.module_type_desc -> Ast_504.Parsetree.module_type_desc =
752763
function
753764
| Ast_503.Parsetree.Pmty_ident x0 ->
754-
Ast_504.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0)
765+
Ast_504.Parsetree.Pmty_ident (copy_loc (copy_Longident_t ~loc:x0.loc) x0)
755766
| Ast_503.Parsetree.Pmty_signature x0 ->
756767
Ast_504.Parsetree.Pmty_signature (copy_signature x0)
757768
| Ast_503.Parsetree.Pmty_functor (x0, x1) ->
@@ -765,29 +776,31 @@ and copy_module_type_desc :
765776
| Ast_503.Parsetree.Pmty_extension x0 ->
766777
Ast_504.Parsetree.Pmty_extension (copy_extension x0)
767778
| Ast_503.Parsetree.Pmty_alias x0 ->
768-
Ast_504.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0)
779+
Ast_504.Parsetree.Pmty_alias (copy_loc (copy_Longident_t ~loc:x0.loc) x0)
769780

770781
and copy_with_constraint :
771782
Ast_503.Parsetree.with_constraint -> Ast_504.Parsetree.with_constraint =
772783
function
773784
| Ast_503.Parsetree.Pwith_type (x0, x1) ->
774785
Ast_504.Parsetree.Pwith_type
775-
(copy_loc copy_Longident_t x0, copy_type_declaration x1)
786+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_type_declaration x1)
776787
| Ast_503.Parsetree.Pwith_module (x0, x1) ->
777788
Ast_504.Parsetree.Pwith_module
778-
(copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1)
789+
( copy_loc (copy_Longident_t ~loc:x0.loc) x0,
790+
copy_loc (copy_Longident_t ~loc:x1.loc) x1 )
779791
| Ast_503.Parsetree.Pwith_modtype (x0, x1) ->
780792
Ast_504.Parsetree.Pwith_modtype
781-
(copy_loc copy_Longident_t x0, copy_module_type x1)
793+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_module_type x1)
782794
| Ast_503.Parsetree.Pwith_modtypesubst (x0, x1) ->
783795
Ast_504.Parsetree.Pwith_modtypesubst
784-
(copy_loc copy_Longident_t x0, copy_module_type x1)
796+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_module_type x1)
785797
| Ast_503.Parsetree.Pwith_typesubst (x0, x1) ->
786798
Ast_504.Parsetree.Pwith_typesubst
787-
(copy_loc copy_Longident_t x0, copy_type_declaration x1)
799+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, copy_type_declaration x1)
788800
| Ast_503.Parsetree.Pwith_modsubst (x0, x1) ->
789801
Ast_504.Parsetree.Pwith_modsubst
790-
(copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1)
802+
( copy_loc (copy_Longident_t ~loc:x0.loc) x0,
803+
copy_loc (copy_Longident_t ~loc:x1.loc) x1 )
791804

792805
and copy_signature : Ast_503.Parsetree.signature -> Ast_504.Parsetree.signature
793806
=
@@ -866,7 +879,7 @@ and copy_class_type_desc :
866879
function
867880
| Ast_503.Parsetree.Pcty_constr (x0, x1) ->
868881
Ast_504.Parsetree.Pcty_constr
869-
(copy_loc copy_Longident_t x0, List.map copy_core_type x1)
882+
(copy_loc (copy_Longident_t ~loc:x0.loc) x0, List.map copy_core_type x1)
870883
| Ast_503.Parsetree.Pcty_signature x0 ->
871884
Ast_504.Parsetree.Pcty_signature (copy_class_signature x0)
872885
| Ast_503.Parsetree.Pcty_arrow (x0, x1, x2) ->
@@ -991,7 +1004,8 @@ and copy_include_infos :
9911004

9921005
and copy_open_description :
9931006
Ast_503.Parsetree.open_description -> Ast_504.Parsetree.open_description =
994-
fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x
1007+
fun x ->
1008+
copy_open_infos (fun x -> copy_loc (copy_Longident_t ~loc:x.Location.loc) x) x
9951009

9961010
and copy_open_infos :
9971011
'f0 'g0.
@@ -1044,7 +1058,8 @@ and copy_module_substitution :
10441058
} ->
10451059
{
10461060
Ast_504.Parsetree.pms_name = copy_loc (fun x -> x) pms_name;
1047-
Ast_504.Parsetree.pms_manifest = copy_loc copy_Longident_t pms_manifest;
1061+
Ast_504.Parsetree.pms_manifest =
1062+
copy_loc (copy_Longident_t ~loc:pms_manifest.loc) pms_manifest;
10481063
Ast_504.Parsetree.pms_attributes = copy_attributes pms_attributes;
10491064
Ast_504.Parsetree.pms_loc = copy_location pms_loc;
10501065
}
@@ -1091,7 +1106,8 @@ and copy_type_extension :
10911106
Ast_503.Parsetree.ptyext_attributes;
10921107
} ->
10931108
{
1094-
Ast_504.Parsetree.ptyext_path = copy_loc copy_Longident_t ptyext_path;
1109+
Ast_504.Parsetree.ptyext_path =
1110+
copy_loc (copy_Longident_t ~loc:ptyext_path.loc) ptyext_path;
10951111
Ast_504.Parsetree.ptyext_params =
10961112
List.map
10971113
(fun x ->
@@ -1132,7 +1148,7 @@ and copy_extension_constructor_kind :
11321148
copy_constructor_arguments x1,
11331149
Option.map copy_core_type x2 )
11341150
| Ast_503.Parsetree.Pext_rebind x0 ->
1135-
Ast_504.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0)
1151+
Ast_504.Parsetree.Pext_rebind (copy_loc (copy_Longident_t ~loc:x0.loc) x0)
11361152

11371153
and copy_type_declaration :
11381154
Ast_503.Parsetree.type_declaration -> Ast_504.Parsetree.type_declaration =
@@ -1303,15 +1319,34 @@ and copy_constant : Ast_503.Parsetree.constant -> Ast_504.Parsetree.constant =
13031319
in
13041320
{ pconst_desc; pconst_loc = copy_location c.pconst_loc }
13051321

1306-
and copy_Longident_t : Longident.t -> Ast_504.Longident.t = function
1322+
and copy_Longident_t : loc:Location.t -> Longident.t -> Ast_504.Longident.t =
1323+
fun ~loc -> function
13071324
| Longident.Lident x0 -> Ast_504.Longident.Lident x0
13081325
| Longident.Ldot (x0, x1) ->
1309-
Ast_504.Longident.Ldot
1310-
( { txt = copy_Longident_t x0; loc = Location.none },
1311-
{ txt = x1; loc = Location.none } )
1326+
(* In 504, all long identifiers gained locations for their constituent parts.
1327+
Here, we do a best effort reconstruction of those locations *)
1328+
let end_len = Stdlib.String.length x1 in
1329+
if loc.loc_end.pos_cnum - end_len < 0 then
1330+
Ast_504.Longident.Ldot
1331+
({ txt = copy_Longident_t ~loc x0; loc }, { txt = x1; loc })
1332+
else
1333+
(* Where the end segment is e.g. the [.t] in [A.B.C.t]. *)
1334+
let end_end = loc.loc_end in
1335+
let end_start =
1336+
{ loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - end_len }
1337+
in
1338+
let end_loc = { loc with loc_start = end_start; loc_end = end_end } in
1339+
1340+
let dot_end =
1341+
{ loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - end_len - 1 }
1342+
in
1343+
let dot_loc = { loc with loc_end = dot_end } in
1344+
Ast_504.Longident.Ldot
1345+
( { txt = copy_Longident_t ~loc:dot_loc x0; loc = dot_loc },
1346+
{ txt = x1; loc = end_loc } )
13121347
| Longident.Lapply (x0, x1) ->
1313-
let x0 = Location.{ txt = copy_Longident_t x0; loc = Location.none } in
1314-
let x1 = Location.{ txt = copy_Longident_t x1; loc = Location.none } in
1348+
let x0 = Location.{ txt = copy_Longident_t ~loc x0; loc } in
1349+
let x1 = Location.{ txt = copy_Longident_t ~loc x1; loc } in
13151350
Ast_504.Longident.Lapply (x0, x1)
13161351

13171352
and copy_loc :

‎test/504_migrations/longident-locs/dune‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
(executable
22
(name driver)
33
(enabled_if
4-
(>= %{ocaml_version} "5.3"))
4+
(>= %{ocaml_version} "5.4"))
55
(libraries ppxlib ocaml-compiler-libs.common compiler-libs.common))
66

77
(cram
88
(enabled_if
9-
(>= %{ocaml_version} "5.3"))
9+
(>= %{ocaml_version} "5.4"))
1010
(deps driver.exe))

‎test/504_migrations/longident-locs/run.t‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,15 @@ regardless of ppxlib's internal AST version.
55
If we run the driver on the following source file:
66

77
$ cat > test.ml << EOF
8-
> let () = NonExistingModule.foo ()
8+
> let () = NonExistingModule.foo ()
99
> EOF
1010

1111
then the non-existing module should have a sensible error location.
1212

1313
$ ocamlc -ppx "./driver.exe --as-ppx" test.ml test.ml.pp
14-
File "_none_", line 1:
14+
File "test.ml", line 1, characters 9-26:
15+
1 | let () = NonExistingModule.foo ()
16+
^^^^^^^^^^^^^^^^^
1517
Error: Unbound module NonExistingModule
1618
[2]
1719

@@ -22,7 +24,9 @@ Another longident usage:
2224
> EOF
2325

2426
$ ocamlc -ppx "./driver.exe --as-ppx" test.ml test.ml.pp
25-
File "_none_", line 1:
27+
File "test.ml", line 1, characters 10-20:
28+
1 | let t = { ThisModule.age = 43 }
29+
^^^^^^^^^^
2630
Error: Unbound module ThisModule
2731
[2]
28-
32+

0 commit comments

Comments
 (0)