Skip to content

Commit b37fc94

Browse files
committed
Experiment with storing the location of function named arguments in the AST.
1 parent 4a5c3ea commit b37fc94

File tree

20 files changed

+138
-111
lines changed

20 files changed

+138
-111
lines changed

compiler/frontend/ast_compatible.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -85,6 +85,7 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp =
8585
Pexp_fun
8686
{
8787
arg_label = Nolabel;
88+
label_loc = Location.none;
8889
default = None;
8990
lhs = pat;
9091
rhs = exp;

compiler/frontend/bs_ast_mapper.ml

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -311,9 +311,17 @@ module E = struct
311311
sub vbs)
312312
(sub.expr sub e)
313313
(* #end *)
314-
| Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
315-
->
316-
fun_ ~loc ~attrs ~arity ~async lab
314+
| Pexp_fun
315+
{
316+
arg_label = lab;
317+
label_loc;
318+
default = def;
319+
lhs = p;
320+
rhs = e;
321+
arity;
322+
async;
323+
} ->
324+
fun_ ~loc ~attrs ~label_loc ~arity ~async lab
317325
(map_opt (sub.expr sub) def)
318326
(sub.pat sub p) (sub.expr sub e)
319327
| Pexp_apply {funct = e; args = l; partial} ->

compiler/ml/ast_helper.ml

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -151,9 +151,11 @@ module Exp = struct
151151
let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
152152
let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
153153
let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
154-
let fun_ ?loc ?attrs ?(async = false) ~arity a b c d =
154+
let fun_ ?loc ?attrs ?(async = false) ?(label_loc = Location.none) ~arity a b
155+
c d =
155156
mk ?loc ?attrs
156-
(Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity; async})
157+
(Pexp_fun
158+
{arg_label = a; label_loc; default = b; lhs = c; rhs = d; arity; async})
157159
let apply ?loc ?attrs ?(partial = false) funct args =
158160
mk ?loc ?attrs (Pexp_apply {funct; args; partial})
159161
let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))

compiler/ml/ast_helper.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,7 @@ module Exp : sig
139139
?loc:loc ->
140140
?attrs:attrs ->
141141
?async:bool ->
142+
?label_loc:loc ->
142143
arity:int option ->
143144
arg_label ->
144145
expression option ->

compiler/ml/ast_mapper.ml

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -274,9 +274,17 @@ module E = struct
274274
| Pexp_constant x -> constant ~loc ~attrs x
275275
| Pexp_let (r, vbs, e) ->
276276
let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
277-
| Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
278-
->
279-
fun_ ~loc ~attrs ~arity ~async lab
277+
| Pexp_fun
278+
{
279+
arg_label = lab;
280+
label_loc;
281+
default = def;
282+
lhs = p;
283+
rhs = e;
284+
arity;
285+
async;
286+
} ->
287+
fun_ ~loc ~attrs ~label_loc ~arity ~async lab
280288
(map_opt (sub.expr sub) def)
281289
(sub.pat sub p) (sub.expr sub e)
282290
| Pexp_apply {funct = e; args = l; partial} ->

compiler/ml/parsetree.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -226,6 +226,7 @@ and expression_desc =
226226
*)
227227
| Pexp_fun of {
228228
arg_label: arg_label;
229+
label_loc: Location.t;
229230
default: expression option;
230231
lhs: pattern;
231232
rhs: expression;

compiler/syntax/src/res_comments_table.ml

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -263,19 +263,21 @@ let fun_expr expr =
263263
Pexp_fun
264264
{
265265
arg_label = lbl;
266+
label_loc;
266267
default = default_expr;
267268
lhs = pattern;
268269
rhs = return_expr;
269270
};
270271
pexp_attributes = [];
271272
} ->
272-
let parameter = ([], lbl, default_expr, pattern) in
273+
let parameter = ([], lbl, label_loc, default_expr, pattern) in
273274
collect attrs_before (parameter :: acc) return_expr
274275
| {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} ->
275276
let var, return_expr = collect_new_types [string_loc] rest in
276277
let parameter =
277278
( attrs,
278279
Asttypes.Nolabel,
280+
Location.none,
279281
None,
280282
Ast_helper.Pat.var ~loc:string_loc.loc var )
281283
in
@@ -285,26 +287,28 @@ let fun_expr expr =
285287
Pexp_fun
286288
{
287289
arg_label = lbl;
290+
label_loc;
288291
default = default_expr;
289292
lhs = pattern;
290293
rhs = return_expr;
291294
};
292295
pexp_attributes = [({txt = "bs"}, _)] as attrs;
293296
} ->
294-
let parameter = (attrs, lbl, default_expr, pattern) in
297+
let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
295298
collect attrs_before (parameter :: acc) return_expr
296299
| {
297300
pexp_desc =
298301
Pexp_fun
299302
{
300303
arg_label = (Labelled _ | Optional _) as lbl;
304+
label_loc;
301305
default = default_expr;
302306
lhs = pattern;
303307
rhs = return_expr;
304308
};
305309
pexp_attributes = attrs;
306310
} ->
307-
let parameter = (attrs, lbl, default_expr, pattern) in
311+
let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
308312
collect attrs_before (parameter :: acc) return_expr
309313
| expr -> (attrs_before, List.rev acc, expr)
310314
in
@@ -1446,13 +1450,11 @@ and walk_expression expr t comments =
14461450
let comments =
14471451
visit_list_but_continue_with_remaining_comments ~newline_delimited:false
14481452
~walk_node:walk_expr_pararameter
1449-
~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) ->
1453+
~get_loc:(fun (_attrs, _argLbl, label_loc, expr_opt, pattern) ->
14501454
let open Parsetree in
14511455
let start_pos =
1452-
match pattern.ppat_attributes with
1453-
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs ->
1454-
loc.loc_start
1455-
| _ -> pattern.ppat_loc.loc_start
1456+
if label_loc <> Location.none then label_loc.loc_start
1457+
else pattern.ppat_loc.loc_start
14561458
in
14571459
match expr_opt with
14581460
| None -> {pattern.ppat_loc with loc_start = start_pos}
@@ -1493,7 +1495,8 @@ and walk_expression expr t comments =
14931495
attach t.trailing return_expr.pexp_loc trailing)
14941496
| _ -> ()
14951497

1496-
and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments =
1498+
and walk_expr_pararameter (_attrs, _argLbl, _label_loc, expr_opt, pattern) t
1499+
comments =
14971500
let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in
14981501
attach t.leading pattern.ppat_loc leading;
14991502
walk_pattern pattern t inside;

compiler/syntax/src/res_core.ml

Lines changed: 53 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -191,6 +191,7 @@ type fundef_type_param = {
191191
type fundef_term_param = {
192192
attrs: Parsetree.attributes;
193193
p_label: Asttypes.arg_label;
194+
lbl_loc: Location.t;
194195
expr: Parsetree.expression option;
195196
pat: Parsetree.pattern;
196197
p_pos: Lexing.position;
@@ -1594,12 +1595,19 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None)
15941595
let arrow_expr =
15951596
List.fold_right
15961597
(fun parameter expr ->
1597-
let {attrs; p_label = lbl; expr = default_expr; pat; p_pos = start_pos}
1598-
=
1598+
let {
1599+
attrs;
1600+
p_label = lbl;
1601+
lbl_loc;
1602+
expr = default_expr;
1603+
pat;
1604+
p_pos = start_pos;
1605+
} =
15991606
parameter
16001607
in
16011608
let loc = mk_loc start_pos end_pos in
1602-
Ast_helper.Exp.fun_ ~loc ~attrs ~arity:None lbl default_expr pat expr)
1609+
Ast_helper.Exp.fun_ ~loc ~attrs ~label_loc:lbl_loc ~arity:None lbl
1610+
default_expr pat expr)
16031611
term_parameters body
16041612
in
16051613
let arrow_expr =
@@ -1647,21 +1655,18 @@ and parse_parameter p =
16471655
let lidents = parse_lident_list p in
16481656
Some (TypeParameter {attrs; locs = lidents; p_pos = start_pos}))
16491657
else
1650-
let attrs, lbl, pat =
1658+
let attrs, lbl, lbl_loc, pat =
16511659
match p.Parser.token with
16521660
| Tilde -> (
16531661
Parser.next p;
1654-
let lbl_name, loc = parse_lident p in
1655-
let prop_loc_attr =
1656-
(Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr [])
1657-
in
1662+
let lbl_name, lbl_loc = parse_lident p in
16581663
match p.Parser.token with
16591664
| Comma | Equal | Rparen ->
16601665
let loc = mk_loc start_pos p.prev_end_pos in
16611666
( [],
16621667
Asttypes.Labelled lbl_name,
1663-
Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc
1664-
(Location.mkloc lbl_name loc) )
1668+
lbl_loc,
1669+
Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) )
16651670
| Colon ->
16661671
let lbl_end = p.prev_end_pos in
16671672
Parser.next p;
@@ -1670,31 +1675,30 @@ and parse_parameter p =
16701675
let pat =
16711676
let pat = Ast_helper.Pat.var ~loc (Location.mkloc lbl_name loc) in
16721677
let loc = mk_loc start_pos p.prev_end_pos in
1673-
Ast_helper.Pat.constraint_ ~attrs:(prop_loc_attr :: attrs) ~loc
1674-
pat typ
1678+
Ast_helper.Pat.constraint_ ~attrs ~loc pat typ
16751679
in
1676-
([], Asttypes.Labelled lbl_name, pat)
1680+
([], Asttypes.Labelled lbl_name, lbl_loc, pat)
16771681
| As ->
16781682
Parser.next p;
16791683
let pat =
16801684
let pat = parse_constrained_pattern p in
1681-
{
1682-
pat with
1683-
ppat_attributes = (prop_loc_attr :: attrs) @ pat.ppat_attributes;
1684-
}
1685+
{pat with ppat_attributes = attrs @ pat.ppat_attributes}
16851686
in
1686-
([], Asttypes.Labelled lbl_name, pat)
1687+
([], Asttypes.Labelled lbl_name, lbl_loc, pat)
16871688
| t ->
16881689
Parser.err p (Diagnostics.unexpected t p.breadcrumbs);
16891690
let loc = mk_loc start_pos p.prev_end_pos in
16901691
( [],
16911692
Asttypes.Labelled lbl_name,
1692-
Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc
1693-
(Location.mkloc lbl_name loc) ))
1693+
lbl_loc,
1694+
Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ))
16941695
| _ ->
16951696
let pattern = parse_constrained_pattern p in
16961697
let attrs = List.concat [pattern.ppat_attributes; attrs] in
1697-
([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs})
1698+
( [],
1699+
Asttypes.Nolabel,
1700+
Location.none,
1701+
{pattern with ppat_attributes = attrs} )
16981702
in
16991703
match p.Parser.token with
17001704
| Equal -> (
@@ -1719,17 +1723,37 @@ and parse_parameter p =
17191723
Parser.next p;
17201724
Some
17211725
(TermParameter
1722-
{attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
1726+
{
1727+
attrs;
1728+
p_label = lbl;
1729+
lbl_loc;
1730+
expr = None;
1731+
pat;
1732+
p_pos = start_pos;
1733+
})
17231734
| _ ->
17241735
let expr = parse_constrained_or_coerced_expr p in
17251736
Some
17261737
(TermParameter
1727-
{attrs; p_label = lbl; expr = Some expr; pat; p_pos = start_pos})
1728-
)
1738+
{
1739+
attrs;
1740+
p_label = lbl;
1741+
lbl_loc;
1742+
expr = Some expr;
1743+
pat;
1744+
p_pos = start_pos;
1745+
}))
17291746
| _ ->
17301747
Some
17311748
(TermParameter
1732-
{attrs; p_label = lbl; expr = None; pat; p_pos = start_pos})
1749+
{
1750+
attrs;
1751+
p_label = lbl;
1752+
lbl_loc;
1753+
expr = None;
1754+
pat;
1755+
p_pos = start_pos;
1756+
})
17331757
else None
17341758

17351759
and parse_parameter_list p =
@@ -1759,6 +1783,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
17591783
{
17601784
attrs = [];
17611785
p_label = Asttypes.Nolabel;
1786+
lbl_loc = Location.none;
17621787
expr = None;
17631788
pat = unit_pattern;
17641789
p_pos = start_pos;
@@ -1773,6 +1798,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
17731798
{
17741799
attrs = [];
17751800
p_label = Asttypes.Nolabel;
1801+
lbl_loc = Location.none;
17761802
expr = None;
17771803
pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc);
17781804
p_pos = start_pos;
@@ -1786,6 +1812,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list =
17861812
{
17871813
attrs = [];
17881814
p_label = Asttypes.Nolabel;
1815+
lbl_loc = Location.none;
17891816
expr = None;
17901817
pat = Ast_helper.Pat.any ~loc ();
17911818
p_pos = start_pos;
@@ -3007,6 +3034,7 @@ and parse_braced_or_record_expr p =
30073034
{
30083035
attrs = [];
30093036
p_label = Asttypes.Nolabel;
3037+
lbl_loc = Location.none;
30103038
expr = None;
30113039
pat = Ast_helper.Pat.var ~loc:ident.loc ident;
30123040
p_pos = start_pos;

compiler/syntax/src/res_parsetree_viewer.ml

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -143,6 +143,7 @@ type fun_param_kind =
143143
| Parameter of {
144144
attrs: Parsetree.attributes;
145145
lbl: Asttypes.arg_label;
146+
lbl_loc: Location.t;
146147
default_expr: Parsetree.expression option;
147148
pat: Parsetree.pattern;
148149
}
@@ -157,6 +158,7 @@ let fun_expr expr_ =
157158
Pexp_fun
158159
{
159160
arg_label = lbl;
161+
label_loc;
160162
default = default_expr;
161163
lhs = pattern;
162164
rhs = return_expr;
@@ -165,7 +167,9 @@ let fun_expr expr_ =
165167
pexp_attributes = attrs;
166168
}
167169
when arity = None || n_fun = 0 ->
168-
let parameter = Parameter {attrs; lbl; default_expr; pat = pattern} in
170+
let parameter =
171+
Parameter {attrs; lbl; lbl_loc = label_loc; default_expr; pat = pattern}
172+
in
169173
collect_params ~n_fun:(n_fun + 1) ~params:(parameter :: params)
170174
return_expr
171175
| _ -> (async, List.rev params, expr)

compiler/syntax/src/res_parsetree_viewer.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ type fun_param_kind =
4242
| Parameter of {
4343
attrs: Parsetree.attributes;
4444
lbl: Asttypes.arg_label;
45+
lbl_loc: Location.t;
4546
default_expr: Parsetree.expression option;
4647
pat: Parsetree.pattern;
4748
}

0 commit comments

Comments
 (0)