Skip to content

Commit 26f4de9

Browse files
cristianoccristianoc
committed
Store the label loc directly in the label, for application for now.
1 parent be89110 commit 26f4de9

37 files changed

+358
-307
lines changed

‎analysis/src/CompletionFrontEnd.ml

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -268,8 +268,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
268268
(* Transform away pipe with apply call *)
269269
exprToContextPath
270270
{
271-
pexp_desc =
272-
Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial};
271+
pexp_desc = Pexp_apply {funct = d; args = (Nolbl, lhs) :: args; partial};
273272
pexp_loc;
274273
pexp_attributes;
275274
}
@@ -289,7 +288,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
289288
Pexp_apply
290289
{
291290
funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes};
292-
args = [(Nolabel, lhs)];
291+
args = [(Nolbl, lhs)];
293292
partial;
294293
};
295294
pexp_loc;
@@ -298,7 +297,11 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
298297
| Pexp_apply {funct = e1; args} -> (
299298
match exprToContextPath e1 with
300299
| None -> None
301-
| Some contexPath -> Some (CPApply (contexPath, args |> List.map fst)))
300+
| Some contexPath ->
301+
Some
302+
(CPApply
303+
(contexPath, args |> List.map fst |> List.map Asttypes.to_arg_label))
304+
)
302305
| Pexp_tuple exprs ->
303306
let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in
304307
if List.length exprs = List.length exprsAsContextPaths then

‎analysis/src/CompletionJsx.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -465,14 +465,15 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args =
465465
in
466466
let rec processProps ~acc args =
467467
match args with
468-
| (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
468+
| (Asttypes.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ ->
469469
{
470470
compName;
471471
props = List.rev acc;
472472
childrenStart =
473473
(if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc));
474474
}
475-
| ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> (
475+
| ((Lbl {txt = s} | Opt {txt = s}), (eProp : Parsetree.expression)) :: rest
476+
-> (
476477
let namedArgLoc =
477478
eProp.pexp_attributes
478479
|> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc")

‎analysis/src/SemanticTokens.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -266,7 +266,7 @@ let command ~debug ~emitter ~path =
266266

267267
let posOfGreatherthanAfterProps =
268268
let rec loop = function
269-
| (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
269+
| (Asttypes.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ ->
270270
Loc.start pexp_loc
271271
| _ :: args -> loop args
272272
| [] -> (* should not happen *) (-1, -1)

‎analysis/src/SharedTypes.ml

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -898,7 +898,8 @@ type arg = {label: label; exp: Parsetree.expression}
898898
let extractExpApplyArgs ~args =
899899
let rec processArgs ~acc args =
900900
match args with
901-
| (((Asttypes.Labelled s | Optional s) as label), (e : Parsetree.expression))
901+
| ( ((Asttypes.Lbl {txt = s} | Opt {txt = s}) as label),
902+
(e : Parsetree.expression) )
902903
:: rest -> (
903904
let namedArgLoc =
904905
e.pexp_attributes
@@ -911,15 +912,15 @@ let extractExpApplyArgs ~args =
911912
name = s;
912913
opt =
913914
(match label with
914-
| Optional _ -> true
915+
| Opt _ -> true
915916
| _ -> false);
916917
posStart = Loc.start loc;
917918
posEnd = Loc.end_ loc;
918919
}
919920
in
920921
processArgs ~acc:({label = Some labelled; exp = e} :: acc) rest
921922
| None -> processArgs ~acc rest)
922-
| (Asttypes.Nolabel, (e : Parsetree.expression)) :: rest ->
923+
| (Nolbl, (e : Parsetree.expression)) :: rest ->
923924
if e.pexp_loc.loc_ghost then processArgs ~acc rest
924925
else processArgs ~acc:({label = None; exp = e} :: acc) rest
925926
| [] -> List.rev acc

‎analysis/src/TypeUtils.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -941,7 +941,7 @@ module Codegen = struct
941941
let mkFailWithExp () =
942942
Ast_helper.Exp.apply
943943
(Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none})
944-
[(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
944+
[(Nolbl, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
945945

946946
let mkConstructPat ?payload name =
947947
Ast_helper.Pat.construct

‎analysis/src/Xform.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ module IfThenElse = struct
9595
Pexp_ident
9696
{txt = Longident.Lident (("==" | "!=") as op)};
9797
};
98-
args = [(Nolabel, arg1); (Nolabel, arg2)];
98+
args = [(Nolbl, arg1); (Nolbl, arg2)];
9999
};
100100
},
101101
e1,

‎compiler/frontend/ast_compatible.ml

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression)
4242
Pexp_apply
4343
{
4444
funct = fn;
45-
args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x));
45+
args = Ext_list.map args (fun x -> (Asttypes.Nolbl, x));
4646
partial = false;
4747
};
4848
}
@@ -51,8 +51,7 @@ let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression =
5151
{
5252
pexp_loc = loc;
5353
pexp_attributes = attrs;
54-
pexp_desc =
55-
Pexp_apply {funct = fn; args = [(Nolabel, arg1)]; partial = false};
54+
pexp_desc = Pexp_apply {funct = fn; args = [(Nolbl, arg1)]; partial = false};
5655
}
5756

5857
let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
@@ -61,7 +60,7 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
6160
pexp_attributes = attrs;
6261
pexp_desc =
6362
Pexp_apply
64-
{funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]; partial = false};
63+
{funct = fn; args = [(Nolbl, arg1); (Nolbl, arg2)]; partial = false};
6564
}
6665

6766
let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
@@ -72,7 +71,7 @@ let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
7271
Pexp_apply
7372
{
7473
funct = fn;
75-
args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)];
74+
args = [(Nolbl, arg1); (Nolbl, arg2); (Nolbl, arg3)];
7675
partial = false;
7776
};
7877
}
@@ -118,7 +117,9 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
118117
Pexp_apply
119118
{
120119
funct = fn;
121-
args = Ext_list.map args (fun (l, a) -> (Asttypes.Labelled l, a));
120+
args =
121+
Ext_list.map args (fun (l, a) ->
122+
(Asttypes.Lbl {txt = l; loc = Location.none}, a));
122123
partial = false;
123124
};
124125
}
@@ -167,4 +168,4 @@ type object_field = Parsetree.object_field
167168

168169
let object_field l attrs ty = Parsetree.Otag (l, attrs, ty)
169170

170-
type args = (Asttypes.arg_label * Parsetree.expression) list
171+
type args = (Asttypes.arg_label_loc * Parsetree.expression) list

‎compiler/frontend/ast_compatible.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -137,4 +137,4 @@ type object_field = Parsetree.object_field
137137
val object_field :
138138
Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field
139139

140-
type args = (Asttypes.arg_label * Parsetree.expression) list
140+
type args = (Asttypes.arg_label_loc * Parsetree.expression) list

‎compiler/frontend/ast_exp_apply.ml

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -91,8 +91,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
9191
| Pexp_apply {funct = fn1; args; partial} ->
9292
Bs_ast_invariant.warn_discarded_unused_attributes fn1.pexp_attributes;
9393
{
94-
pexp_desc =
95-
Pexp_apply {funct = fn1; args = (Nolabel, a) :: args; partial};
94+
pexp_desc = Pexp_apply {funct = fn1; args = (Nolbl, a) :: args; partial};
9695
pexp_loc = e.pexp_loc;
9796
pexp_attributes = e.pexp_attributes @ f.pexp_attributes;
9897
}
@@ -116,7 +115,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
116115
Pexp_apply
117116
{
118117
funct = fn;
119-
args = (Nolabel, bounded_obj_arg) :: args;
118+
args = (Nolbl, bounded_obj_arg) :: args;
120119
partial = false;
121120
};
122121
pexp_attributes = [];
@@ -170,7 +169,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
170169
let arg = self.expr self arg in
171170
let fn = Exp.send ~loc obj {txt = name ^ Literals.setter_suffix; loc} in
172171
Exp.constraint_ ~loc
173-
(Exp.apply ~loc fn [(Nolabel, arg)])
172+
(Exp.apply ~loc fn [(Nolbl, arg)])
174173
(Ast_literal.type_unit ~loc ())
175174
in
176175
match obj.pexp_desc with

‎compiler/frontend/ast_exp_extension.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ let handle_extension e (self : Bs_ast_mapper.mapper)
4545
Exp.apply ~loc
4646
(Exp.ident ~loc {txt = Longident.parse "Js.Exn.raiseError"; loc})
4747
[
48-
( Nolabel,
48+
( Nolbl,
4949
Exp.constant ~loc
5050
(Pconst_string
5151
( (pretext

‎compiler/frontend/ast_uncurry_gen.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
5757
{loc; txt = Ldot (Ast_literal.Lid.js_oo, "unsafe_to_method")};
5858
args =
5959
[
60-
( Nolabel,
60+
( Nolbl,
6161
Exp.constraint_ ~loc
6262
(Exp.record ~loc
6363
[

‎compiler/frontend/bs_syntaxerr.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -109,5 +109,5 @@ let optional_err loc (lbl : Asttypes.arg_label) =
109109
| Optional _ -> raise (Error (loc, Optional_in_uncurried_bs_attribute))
110110
| _ -> ()
111111

112-
let err_if_label loc (lbl : Asttypes.arg_label) =
113-
if lbl <> Nolabel then raise (Error (loc, Misplaced_label_syntax))
112+
let err_if_label loc (lbl : Asttypes.arg_label_loc) =
113+
if lbl <> Nolbl then raise (Error (loc, Misplaced_label_syntax))

‎compiler/frontend/bs_syntaxerr.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,4 +56,4 @@ val err : Location.t -> error -> 'a
5656

5757
val optional_err : Location.t -> Asttypes.arg_label -> unit
5858

59-
val err_if_label : Location.t -> Asttypes.arg_label -> unit
59+
val err_if_label : Location.t -> Asttypes.arg_label_loc -> unit

‎compiler/ml/ast_async.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ let add_promise_type ?(loc = Location.none) ~async
1111
Ast_helper.Exp.ident ~loc
1212
{txt = Ldot (Lident Primitive_modules.promise, "unsafe_async"); loc}
1313
in
14-
Ast_helper.Exp.apply ~loc unsafe_async [(Nolabel, result)]
14+
Ast_helper.Exp.apply ~loc unsafe_async [(Nolbl, result)]
1515
else result
1616

1717
let rec add_promise_to_result ~loc (e : Parsetree.expression) =

‎compiler/ml/ast_await.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ let create_await_expression (e : Parsetree.expression) =
77
Ast_helper.Exp.ident ~loc
88
{txt = Ldot (Lident Primitive_modules.promise, "unsafe_await"); loc}
99
in
10-
Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)]
10+
Ast_helper.Exp.apply ~loc unsafe_await [(Nolbl, e)]
1111

1212
(* Transform `@res.await M` to unpack(@res.await Js.import(module(M: __M0__))) *)
1313
let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr)
@@ -29,7 +29,7 @@ let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr)
2929
loc = e.pmod_loc;
3030
})
3131
[
32-
( Nolabel,
32+
( Nolbl,
3333
Exp.constraint_ ~loc:e.pmod_loc
3434
(Exp.pack ~loc:e.pmod_loc
3535
{

‎compiler/ml/ast_helper.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ module Exp : sig
152152
?attrs:attrs ->
153153
?partial:bool ->
154154
expression ->
155-
(arg_label * expression) list ->
155+
(arg_label_loc * expression) list ->
156156
expression
157157
val match_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
158158
val try_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression

‎compiler/ml/ast_mapper_from0.ml

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -349,7 +349,9 @@ module E = struct
349349
in
350350
let partial, attrs = process_partial_app_attribute attrs in
351351
apply ~loc ~attrs ~partial (sub.expr sub e)
352-
(List.map (map_snd (sub.expr sub)) l)
352+
(List.map
353+
(fun (lbl, e) -> (Asttypes.to_arg_label_loc lbl, sub.expr sub e))
354+
l)
353355
| Pexp_match (e, pel) ->
354356
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
355357
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

‎compiler/ml/ast_mapper_to0.ml

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -325,22 +325,22 @@ module E = struct
325325
let e =
326326
match (e.pexp_desc, args) with
327327
| ( Pexp_ident ({txt = Longident.Lident "->"} as lid),
328-
[(Nolabel, _); (Nolabel, _)] ) ->
328+
[(Nolbl, _); (Nolbl, _)] ) ->
329329
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "|."}}
330330
| ( Pexp_ident ({txt = Longident.Lident "++"} as lid),
331-
[(Nolabel, _); (Nolabel, _)] ) ->
331+
[(Nolbl, _); (Nolbl, _)] ) ->
332332
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "^"}}
333333
| ( Pexp_ident ({txt = Longident.Lident "!="} as lid),
334-
[(Nolabel, _); (Nolabel, _)] ) ->
334+
[(Nolbl, _); (Nolbl, _)] ) ->
335335
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "<>"}}
336336
| ( Pexp_ident ({txt = Longident.Lident "!=="} as lid),
337-
[(Nolabel, _); (Nolabel, _)] ) ->
337+
[(Nolbl, _); (Nolbl, _)] ) ->
338338
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "!="}}
339339
| ( Pexp_ident ({txt = Longident.Lident "==="} as lid),
340-
[(Nolabel, _); (Nolabel, _)] ) ->
340+
[(Nolbl, _); (Nolbl, _)] ) ->
341341
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "=="}}
342342
| ( Pexp_ident ({txt = Longident.Lident "=="} as lid),
343-
[(Nolabel, _); (Nolabel, _)] ) ->
343+
[(Nolbl, _); (Nolbl, _)] ) ->
344344
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "="}}
345345
| _ -> e
346346
in
@@ -349,7 +349,9 @@ module E = struct
349349
else []
350350
in
351351
apply ~loc ~attrs (sub.expr sub e)
352-
(List.map (map_snd (sub.expr sub)) args)
352+
(List.map
353+
(fun (lbl, e) -> (Asttypes.to_arg_label lbl, sub.expr sub e))
354+
args)
353355
| Pexp_match (e, pel) ->
354356
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
355357
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)

‎compiler/ml/asttypes.ml

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -63,3 +63,31 @@ let same_arg_label (x : arg_label) y =
6363
match y with
6464
| Optional s0 -> s = s0
6565
| _ -> false)
66+
67+
type arg_label_loc =
68+
| Nolbl
69+
| Lbl of string loc (* label:T -> ... *)
70+
| Opt of string loc (* ?label:T -> ... *)
71+
72+
let to_arg_label_loc ?(loc = Location.none) lbl =
73+
match lbl with
74+
| Nolabel -> Nolbl
75+
| Labelled s -> Lbl {loc; txt = s}
76+
| Optional s -> Opt {loc; txt = s}
77+
78+
let to_arg_label = function
79+
| Nolbl -> Nolabel
80+
| Lbl {txt} -> Labelled txt
81+
| Opt {txt} -> Optional txt
82+
83+
let same_arg_label_loc (x : arg_label_loc) y =
84+
match x with
85+
| Nolbl -> y = Nolbl
86+
| Lbl {txt = s} -> (
87+
match y with
88+
| Lbl {txt = s0} -> s = s0
89+
| _ -> false)
90+
| Opt {txt = s} -> (
91+
match y with
92+
| Opt {txt = s0} -> s = s0
93+
| _ -> false)

‎compiler/ml/btype.ml

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -596,31 +596,39 @@ let is_optional = function
596596
| Optional _ -> true
597597
| _ -> false
598598

599+
let is_optional_loc = function
600+
| Opt _ -> true
601+
| _ -> false
602+
599603
let label_name = function
600604
| Nolabel -> ""
601605
| Labelled s | Optional s -> s
602606

607+
let label_loc_name = function
608+
| Nolbl -> ""
609+
| Lbl {txt} | Opt {txt} -> txt
610+
603611
let prefixed_label_name = function
604612
| Nolabel -> ""
605613
| Labelled s -> "~" ^ s
606614
| Optional s -> "?" ^ s
607615

608-
type sargs = (Asttypes.arg_label * Parsetree.expression) list
616+
type sargs = (Asttypes.arg_label_loc * Parsetree.expression) list
609617

610618
let rec extract_label_aux hd l = function
611619
| [] -> None
612620
| ((l', t) as p) :: ls ->
613-
if label_name l' = l then Some (l', t, List.rev_append hd ls)
621+
if label_loc_name l' = l then Some (l', t, List.rev_append hd ls)
614622
else extract_label_aux (p :: hd) l ls
615623

616624
let extract_label l (ls : sargs) :
617-
(arg_label * Parsetree.expression * sargs) option =
625+
(arg_label_loc * Parsetree.expression * sargs) option =
618626
extract_label_aux [] l ls
619627

620628
let rec label_assoc x (args : sargs) =
621629
match args with
622630
| [] -> false
623-
| (a, _) :: l -> Asttypes.same_arg_label a x || label_assoc x l
631+
| (a, _) :: l -> Asttypes.same_arg_label_loc a x || label_assoc x l
624632

625633
(**********************************)
626634
(* Utilities for backtracking *)

0 commit comments

Comments
 (0)