Skip to content

Commit be89110

Browse files
cristianoccristianoc
committed
Store label location in type argument instead of attribute.
1 parent b37fc94 commit be89110

File tree

22 files changed

+112
-98
lines changed

22 files changed

+112
-98
lines changed

‎compiler/frontend/ast_compatible.ml

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -126,14 +126,17 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
126126
let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type
127127
=
128128
{
129-
ptyp_desc = Ptyp_arrow {lbl = Labelled s; arg; ret; arity};
129+
ptyp_desc =
130+
Ptyp_arrow {lbl = Labelled s; lbl_loc = Location.none; arg; ret; arity};
130131
ptyp_loc = loc;
131132
ptyp_attributes = attrs;
132133
}
133134

134135
let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type =
135136
{
136-
ptyp_desc = Ptyp_arrow {lbl = Asttypes.Optional s; arg; ret; arity};
137+
ptyp_desc =
138+
Ptyp_arrow
139+
{lbl = Asttypes.Optional s; lbl_loc = Location.none; arg; ret; arity};
137140
ptyp_loc = loc;
138141
ptyp_attributes = attrs;
139142
}

‎compiler/frontend/ast_core_type.ml

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -142,7 +142,15 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
142142
Ext_list.fold_right new_arg_types_ty result
143143
(fun {label; ty; attr; loc} acc ->
144144
{
145-
ptyp_desc = Ptyp_arrow {lbl = label; arg = ty; ret = acc; arity = None};
145+
ptyp_desc =
146+
Ptyp_arrow
147+
{
148+
lbl = label;
149+
lbl_loc = Location.none;
150+
arg = ty;
151+
ret = acc;
152+
arity = None;
153+
};
146154
ptyp_loc = loc;
147155
ptyp_attributes = attr;
148156
})

‎compiler/frontend/bs_ast_mapper.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -101,8 +101,9 @@ module T = struct
101101
match desc with
102102
| Ptyp_any -> any ~loc ~attrs ()
103103
| Ptyp_var s -> var ~loc ~attrs s
104-
| Ptyp_arrow {lbl; arg; ret; arity} ->
105-
arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
104+
| Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} ->
105+
arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg)
106+
(sub.typ sub ret)
106107
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
107108
| Ptyp_constr (lid, tl) ->
108109
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)

‎compiler/ml/ast_helper.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -54,8 +54,8 @@ module Typ = struct
5454

5555
let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
5656
let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
57-
let arrow ?loc ?attrs ~arity lbl arg ret =
58-
mk ?loc ?attrs (Ptyp_arrow {lbl; arg; ret; arity})
57+
let arrow ?loc ?attrs ?(label_loc = Location.none) ~arity lbl arg ret =
58+
mk ?loc ?attrs (Ptyp_arrow {lbl; lbl_loc = label_loc; arg; ret; arity})
5959
let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
6060
let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
6161
let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
@@ -82,8 +82,8 @@ module Typ = struct
8282
| Ptyp_var x ->
8383
check_variable var_names t.ptyp_loc x;
8484
Ptyp_var x
85-
| Ptyp_arrow {lbl = label; arg; ret; arity = a} ->
86-
Ptyp_arrow {lbl = label; arg = loop arg; ret = loop ret; arity = a}
85+
| Ptyp_arrow ({arg; ret} as arr) ->
86+
Ptyp_arrow {arr with arg = loop arg; ret = loop ret}
8787
| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
8888
| Ptyp_constr ({txt = Longident.Lident s}, []) when List.mem s var_names
8989
->

‎compiler/ml/ast_helper.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ module Typ : sig
5757
val arrow :
5858
?loc:loc ->
5959
?attrs:attrs ->
60+
?label_loc:loc ->
6061
arity:arity ->
6162
arg_label ->
6263
core_type ->

‎compiler/ml/ast_mapper.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -93,8 +93,9 @@ module T = struct
9393
match desc with
9494
| Ptyp_any -> any ~loc ~attrs ()
9595
| Ptyp_var s -> var ~loc ~attrs s
96-
| Ptyp_arrow {lbl; arg; ret; arity} ->
97-
arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
96+
| Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} ->
97+
arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg)
98+
(sub.typ sub ret)
9899
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
99100
| Ptyp_constr (lid, tl) ->
100101
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)

‎compiler/ml/parsetree.ml

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,13 @@ and core_type = {
7676
and core_type_desc =
7777
| Ptyp_any (* _ *)
7878
| Ptyp_var of string (* 'a *)
79-
| Ptyp_arrow of {lbl: arg_label; arg: core_type; ret: core_type; arity: arity}
79+
| Ptyp_arrow of {
80+
lbl: arg_label;
81+
lbl_loc: Location.t;
82+
arg: core_type;
83+
ret: core_type;
84+
arity: arity;
85+
}
8086
(* T1 -> T2 Simple
8187
~l:T1 -> T2 Labelled
8288
?l:T1 -> T2 Optional

‎compiler/syntax/src/res_comments_table.ml

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -168,22 +168,23 @@ let arrow_type ct =
168168
let rec process attrs_before acc typ =
169169
match typ with
170170
| {
171-
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
171+
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret};
172172
ptyp_attributes = [];
173173
} ->
174-
let arg = ([], lbl, arg) in
174+
let arg = ([], lbl, lbl_loc, arg) in
175175
process attrs_before (arg :: acc) ret
176176
| {
177-
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
177+
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret};
178178
ptyp_attributes = [({txt = "bs"}, _)] as attrs;
179179
} ->
180-
let arg = (attrs, lbl, arg) in
180+
let arg = (attrs, lbl, lbl_loc, arg) in
181181
process attrs_before (arg :: acc) ret
182182
| {ptyp_desc = Ptyp_arrow {lbl = Nolabel}} as return_type ->
183183
let args = List.rev acc in
184184
(attrs_before, args, return_type)
185-
| {ptyp_desc = Ptyp_arrow {lbl; arg; ret}; ptyp_attributes = attrs} ->
186-
let arg = (attrs, lbl, arg) in
185+
| {ptyp_desc = Ptyp_arrow {lbl; lbl_loc; arg; ret}; ptyp_attributes = attrs}
186+
->
187+
let arg = (attrs, lbl, lbl_loc, arg) in
187188
process attrs_before (arg :: acc) ret
188189
| typ -> (attrs_before, List.rev acc, typ)
189190
in
@@ -1938,15 +1939,14 @@ and walk_object_field field t comments =
19381939

19391940
and walk_type_parameters type_parameters t comments =
19401941
visit_list_but_continue_with_remaining_comments
1941-
~get_loc:(fun (_, _, typexpr) ->
1942-
match typexpr.Parsetree.ptyp_attributes with
1943-
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs ->
1944-
{loc with loc_end = typexpr.ptyp_loc.loc_end}
1945-
| _ -> typexpr.ptyp_loc)
1942+
~get_loc:(fun (_, _, lbl_loc, typexpr) ->
1943+
if lbl_loc <> Location.none then
1944+
{lbl_loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end}
1945+
else typexpr.ptyp_loc)
19461946
~walk_node:walk_type_parameter ~newline_delimited:false type_parameters t
19471947
comments
19481948

1949-
and walk_type_parameter (_attrs, _lbl, typexpr) t comments =
1949+
and walk_type_parameter (_attrs, _lbl, _lbl_loc, typexpr) t comments =
19501950
let before_typ, inside_typ, after_typ =
19511951
partition_by_loc comments typexpr.ptyp_loc
19521952
in

‎compiler/syntax/src/res_core.ml

Lines changed: 29 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -171,6 +171,7 @@ type argument = {label: Asttypes.arg_label; expr: Parsetree.expression}
171171
type type_parameter = {
172172
attrs: Ast_helper.attrs;
173173
label: Asttypes.arg_label;
174+
label_loc: Location.t;
174175
typ: Parsetree.core_type;
175176
start_pos: Lexing.position;
176177
}
@@ -4261,20 +4262,15 @@ and parse_type_parameter p =
42614262
| Tilde -> (
42624263
Parser.next p;
42634264
let name, loc = parse_lident p in
4264-
let lbl_loc_attr =
4265-
(Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr [])
4266-
in
42674265
Parser.expect ~grammar:Grammar.TypeExpression Colon p;
4268-
let typ =
4269-
let typ = parse_typ_expr p in
4270-
{typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes}
4271-
in
4266+
let typ = parse_typ_expr p in
42724267
match p.Parser.token with
42734268
| Equal ->
42744269
Parser.next p;
42754270
Parser.expect Question p;
4276-
Some {attrs; label = Optional name; typ; start_pos}
4277-
| _ -> Some {attrs; label = Labelled name; typ; start_pos})
4271+
Some {attrs; label = Optional name; label_loc = loc; typ; start_pos}
4272+
| _ ->
4273+
Some {attrs; label = Labelled name; label_loc = loc; typ; start_pos})
42784274
| Lident _ -> (
42794275
let name, loc = parse_lident p in
42804276
match p.token with
@@ -4292,8 +4288,9 @@ and parse_type_parameter p =
42924288
| Equal ->
42934289
Parser.next p;
42944290
Parser.expect Question p;
4295-
Some {attrs; label = Optional name; typ; start_pos}
4296-
| _ -> Some {attrs; label = Labelled name; typ; start_pos})
4291+
Some {attrs; label = Optional name; label_loc = loc; typ; start_pos}
4292+
| _ ->
4293+
Some {attrs; label = Labelled name; label_loc = loc; typ; start_pos})
42974294
| _ ->
42984295
let constr = Location.mkloc (Longident.Lident name) loc in
42994296
let args = parse_type_constructor_args ~constr_name:constr p in
@@ -4305,13 +4302,27 @@ and parse_type_parameter p =
43054302

43064303
let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in
43074304
let typ = parse_type_alias p typ in
4308-
Some {attrs = []; label = Nolabel; typ; start_pos})
4305+
Some
4306+
{
4307+
attrs = [];
4308+
label = Nolabel;
4309+
label_loc = Location.none;
4310+
typ;
4311+
start_pos;
4312+
})
43094313
| _ ->
43104314
let typ = parse_typ_expr p in
43114315
let typ_with_attributes =
43124316
{typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]}
43134317
in
4314-
Some {attrs = []; label = Nolabel; typ = typ_with_attributes; start_pos}
4318+
Some
4319+
{
4320+
attrs = [];
4321+
label = Nolabel;
4322+
label_loc = Location.none;
4323+
typ = typ_with_attributes;
4324+
start_pos;
4325+
}
43154326
else None
43164327

43174328
(* (int, ~x:string, float) *)
@@ -4324,7 +4335,7 @@ and parse_type_parameters p =
43244335
let loc = mk_loc start_pos p.prev_end_pos in
43254336
let unit_constr = Location.mkloc (Longident.Lident "unit") loc in
43264337
let typ = Ast_helper.Typ.constr unit_constr [] in
4327-
[{attrs = []; label = Nolabel; typ; start_pos}]
4338+
[{attrs = []; label = Nolabel; label_loc = Location.none; typ; start_pos}]
43284339
| _ ->
43294340
let params =
43304341
parse_comma_delimited_region ~grammar:Grammar.TypeParameters
@@ -4368,7 +4379,8 @@ and parse_es6_arrow_type ~attrs p =
43684379
let return_type_arity = 0 in
43694380
let _paramNum, typ, _arity =
43704381
List.fold_right
4371-
(fun {attrs; label = arg_lbl; typ; start_pos} (param_num, t, arity) ->
4382+
(fun {attrs; label = arg_lbl; label_loc; typ; start_pos}
4383+
(param_num, t, arity) ->
43724384
let loc = mk_loc start_pos end_pos in
43734385
let arity =
43744386
(* Workaround for ~lbl: @as(json`false`) _, which changes the arity *)
@@ -4387,7 +4399,8 @@ and parse_es6_arrow_type ~attrs p =
43874399
| _ -> arity
43884400
in
43894401
let t_arg =
4390-
Ast_helper.Typ.arrow ~loc ~attrs ~arity:None arg_lbl typ t
4402+
Ast_helper.Typ.arrow ~loc ~label_loc ~attrs ~arity:None arg_lbl typ
4403+
t
43914404
in
43924405
if param_num = 1 then
43934406
(param_num - 1, Ast_uncurried.uncurried_type ~arity t_arg, 1)

‎compiler/syntax/src/res_parsetree_viewer.ml

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,10 +11,10 @@ let arrow_type ?(max_arity = max_int) ct =
1111
when acc <> [] ->
1212
(attrs_before, List.rev acc, typ)
1313
| {
14-
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
14+
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret};
1515
ptyp_attributes = [];
1616
} ->
17-
let arg = ([], lbl, arg) in
17+
let arg = ([], lbl, lbl_loc, arg) in
1818
process attrs_before (arg :: acc) ret (arity - 1)
1919
| {
2020
ptyp_desc = Ptyp_arrow {lbl = Nolabel};
@@ -28,7 +28,8 @@ let arrow_type ?(max_arity = max_int) ct =
2828
let args = List.rev acc in
2929
(attrs_before, args, return_type)
3030
| {
31-
ptyp_desc = Ptyp_arrow {lbl = (Labelled _ | Optional _) as lbl; arg; ret};
31+
ptyp_desc =
32+
Ptyp_arrow {lbl = (Labelled _ | Optional _) as lbl; lbl_loc; arg; ret};
3233
ptyp_attributes = attrs;
3334
} ->
3435
(* Res_core.parse_es6_arrow_type has a workaround that removed an extra arity for the function if the
@@ -43,7 +44,7 @@ let arrow_type ?(max_arity = max_int) ct =
4344
arity
4445
| _ -> arity - 1
4546
in
46-
let arg = (attrs, lbl, arg) in
47+
let arg = (attrs, lbl, lbl_loc, arg) in
4748
process attrs_before (arg :: acc) ret arity
4849
| typ -> (attrs_before, List.rev acc, typ)
4950
in

‎compiler/syntax/src/res_parsetree_viewer.mli

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,11 @@ val arrow_type :
55
?max_arity:int ->
66
Parsetree.core_type ->
77
Parsetree.attributes
8-
* (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list
8+
* (Parsetree.attributes
9+
* Asttypes.arg_label
10+
* Location.t
11+
* Parsetree.core_type)
12+
list
913
* Parsetree.core_type
1014

1115
val functor_type :

‎compiler/syntax/src/res_printer.ml

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1606,7 +1606,7 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
16061606
in
16071607
match args with
16081608
| [] -> Doc.nil
1609-
| [([], Nolabel, n)] ->
1609+
| [([], Nolabel, _, n)] ->
16101610
let has_attrs_before = not (attrs_before = []) in
16111611
let attrs =
16121612
if has_attrs_before then
@@ -1931,7 +1931,7 @@ and print_object_field ~state (field : Parsetree.object_field) cmt_tbl =
19311931
(* es6 arrow type arg
19321932
* type t = (~foo: string, ~bar: float=?, unit) => unit
19331933
* i.e. ~foo: string, ~bar: float *)
1934-
and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl =
1934+
and print_type_parameter ~state (attrs, lbl, lbl_loc, typ) cmt_tbl =
19351935
(* Converting .ml code to .res requires processing uncurried attributes *)
19361936
let attrs = print_attributes ~state attrs cmt_tbl in
19371937
let label =
@@ -1947,13 +1947,13 @@ and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl =
19471947
| Asttypes.Nolabel | Labelled _ -> Doc.nil
19481948
| Optional _lbl -> Doc.text "=?"
19491949
in
1950-
let loc, typ =
1950+
let typ =
19511951
match typ.ptyp_attributes with
1952-
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs ->
1953-
( {loc with loc_end = typ.ptyp_loc.loc_end},
1954-
{typ with ptyp_attributes = attrs} )
1955-
| _ -> (typ.ptyp_loc, typ)
1952+
| ({Location.txt = "res.namedArgLoc"}, _) :: attrs ->
1953+
{typ with ptyp_attributes = attrs}
1954+
| _ -> typ
19561955
in
1956+
let loc = {lbl_loc with loc_end = typ.ptyp_loc.loc_end} in
19571957
let doc =
19581958
Doc.group
19591959
(Doc.concat

‎tests/syntax_tests/data/parsing/errors/other/expected/regionMissingComma.res.txt

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@
2323
Did you forget a `,` here?
2424

2525
external make :
26-
?style:((ReactDOMRe.Style.t)[@res.namedArgLoc ]) ->
27-
?image:((bool)[@res.namedArgLoc ]) -> React.element (a:2) =
26+
?style:ReactDOMRe.Style.t -> ?image:bool -> React.element (a:2) =
2827
"ModalContent"
2928
type nonrec 'extraInfo student =
3029
{

‎tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -39,10 +39,7 @@ module Error2 =
3939
type nonrec observation =
4040
{
4141
observed: int ;
42-
onStep:
43-
currentValue:((unit)[@res.namedArgLoc ]) ->
44-
[%rescript.typehole ] (a:1)
45-
}
42+
onStep: currentValue:unit -> [%rescript.typehole ] (a:1) }
4643
end
4744
module Error3 =
4845
struct

‎tests/syntax_tests/data/parsing/errors/typexpr/expected/garbage.res.txt

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,5 @@
88

99
I'm not sure what to parse here when looking at "?".
1010

11-
external printName :
12-
name:((unit)[@res.namedArgLoc ]) -> unit (a:1) = "printName"[@@module
13-
{js|moduleName|js}]
11+
external printName : name:unit -> unit (a:1) = "printName"[@@module
12+
{js|moduleName|js}]

‎tests/syntax_tests/data/parsing/grammar/signature/expected/external.res.txt

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,8 +2,7 @@ module type Signature =
22
sig
33
type nonrec t
44
external linkProgram :
5-
t -> program:((webGlProgram)[@res.namedArgLoc ]) -> unit (a:2) =
6-
"linkProgram"[@@send ]
5+
t -> program:webGlProgram -> unit (a:2) = "linkProgram"[@@send ]
76
external add_nat : nat -> int -> int -> int (a:3) = "add_nat_bytecode"
87
external svg : unit -> React.element (a:1) = "svg"
98
external svg : unit -> React.element (a:1) = "svg"

‎tests/syntax_tests/data/parsing/grammar/structure/expected/externalDefinition.res.txt

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,7 @@
11
external clear : t -> int -> unit (a:2) = "clear"
22
external add_nat : nat -> int (a:1) = "add_nat_bytecode"
33
external attachShader :
4-
t ->
5-
program:((webGlProgram)[@res.namedArgLoc ]) ->
6-
shader:((webGlShader)[@res.namedArgLoc ]) -> unit (a:3) =
4+
t -> program:webGlProgram -> shader:webGlShader -> unit (a:3) =
75
"attachShader"[@@send ]
86
external svg : unit -> React.element (a:1) = "svg"
97
external svg : unit -> React.element (a:1) = "svg"

0 commit comments

Comments
 (0)