diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml
index dc5fd62a47..5a430bb170 100644
--- a/analysis/src/CompletionFrontEnd.ml
+++ b/analysis/src/CompletionFrontEnd.ml
@@ -263,13 +263,17 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
pexp_attributes;
};
args =
- [(_, lhs); (_, {pexp_desc = Pexp_apply {funct = d; args; partial}})];
+ [
+ (_, _, lhs);
+ (_, _, {pexp_desc = Pexp_apply {funct = d; args; partial}});
+ ];
} ->
(* Transform away pipe with apply call *)
exprToContextPath
{
pexp_desc =
- Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial};
+ Pexp_apply
+ {funct = d; args = (Nolabel, Location.none, lhs) :: args; partial};
pexp_loc;
pexp_attributes;
}
@@ -278,7 +282,8 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
args =
[
- (_, lhs); (_, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
+ (_, _, lhs);
+ (_, _, {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes});
];
partial;
} ->
@@ -289,7 +294,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
Pexp_apply
{
funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes};
- args = [(Nolabel, lhs)];
+ args = [(Nolabel, Location.none, lhs)];
partial;
};
pexp_loc;
@@ -298,7 +303,8 @@ let rec exprToContextPathInner (e : Parsetree.expression) =
| Pexp_apply {funct = e1; args} -> (
match exprToContextPath e1 with
| None -> None
- | Some contexPath -> Some (CPApply (contexPath, args |> List.map fst)))
+ | Some contexPath ->
+ Some (CPApply (contexPath, args |> List.map (fun (l, _, _) -> l))))
| Pexp_tuple exprs ->
let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in
if List.length exprs = List.length exprsAsContextPaths then
@@ -329,7 +335,7 @@ let completePipeChain (exp : Parsetree.expression) =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
- args = [_; (_, {pexp_desc = Pexp_apply {funct = d}})];
+ args = [_; (_, _, {pexp_desc = Pexp_apply {funct = d}})];
} ->
exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, d.pexp_loc))
(* When the left side of the pipe we're completing is an identifier application.
@@ -337,7 +343,7 @@ let completePipeChain (exp : Parsetree.expression) =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
- args = [_; (_, {pexp_desc = Pexp_ident _; pexp_loc})];
+ args = [_; (_, _, {pexp_desc = Pexp_ident _; pexp_loc})];
} ->
exprToContextPath exp |> Option.map (fun ctxPath -> (ctxPath, pexp_loc))
| _ -> None
@@ -1116,8 +1122,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
funct = {pexp_desc = Pexp_ident {txt = Lident "->"; loc = opLoc}};
args =
[
- (_, lhs);
- (_, {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}});
+ (_, _, lhs);
+ ( _,
+ _,
+ {pexp_desc = Pexp_extension _; pexp_loc = {loc_ghost = true}} );
];
}
when opLoc |> Loc.hasPos ~pos:posBeforeCursor ->
@@ -1294,8 +1302,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
args =
[
- (_, lhs);
- (_, {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}});
+ (_, _, lhs);
+ ( _,
+ _,
+ {pexp_desc = Pexp_ident {txt = Longident.Lident id; loc}} );
];
}
when loc |> Loc.hasPos ~pos:posBeforeCursor ->
@@ -1304,7 +1314,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Lident "->"; loc = opLoc}};
- args = [(_, lhs); _];
+ args = [(_, _, lhs); _];
}
when Loc.end_ opLoc = posCursor ->
if Debug.verbose () then print_endline "[expr_iter] Case foo->";
@@ -1312,7 +1322,8 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Lident "->"}};
- args = [_; (_, {pexp_desc = Pexp_apply {funct = funExpr; args}})];
+ args =
+ [_; (_, _, {pexp_desc = Pexp_apply {funct = funExpr; args}})];
}
when (* Normally named arg completion fires when the cursor is right after the expression.
E.g in foo(~<---there
diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml
index b68c06ad1a..6261939bfe 100644
--- a/analysis/src/CompletionJsx.ml
+++ b/analysis/src/CompletionJsx.ml
@@ -465,20 +465,22 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args =
in
let rec processProps ~acc args =
match args with
- | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
+ | (Asttypes.Labelled "children", _, {Parsetree.pexp_loc}) :: _ ->
{
compName;
props = List.rev acc;
childrenStart =
(if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc));
}
- | ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> (
+ | ((Labelled s | Optional s), lbl_loc, (eProp : Parsetree.expression))
+ :: rest -> (
let namedArgLoc =
eProp.pexp_attributes
|> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc")
in
match namedArgLoc with
| Some ({loc}, _) ->
+ assert (loc = lbl_loc);
processProps
~acc:
({
diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml
index b1215e154d..609acc1fdb 100644
--- a/analysis/src/SemanticTokens.ml
+++ b/analysis/src/SemanticTokens.ml
@@ -266,7 +266,7 @@ let command ~debug ~emitter ~path =
let posOfGreatherthanAfterProps =
let rec loop = function
- | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ ->
+ | (Asttypes.Labelled "children", _, {Parsetree.pexp_loc}) :: _ ->
Loc.start pexp_loc
| _ :: args -> loop args
| [] -> (* should not happen *) (-1, -1)
@@ -297,7 +297,7 @@ let command ~debug ~emitter ~path =
emitter (* ... <-- *)
|> emitJsxTag ~debug ~name:">" ~pos:posOfFinalGreatherthan));
- args |> List.iter (fun (_lbl, arg) -> iterator.expr iterator arg)
+ args |> List.iter (fun (_lbl, _, arg) -> iterator.expr iterator arg)
| Pexp_apply
{
funct =
diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml
index 59675f1811..7e2d9994da 100644
--- a/analysis/src/SharedTypes.ml
+++ b/analysis/src/SharedTypes.ml
@@ -898,7 +898,9 @@ type arg = {label: label; exp: Parsetree.expression}
let extractExpApplyArgs ~args =
let rec processArgs ~acc args =
match args with
- | (((Asttypes.Labelled s | Optional s) as label), (e : Parsetree.expression))
+ | ( ((Asttypes.Labelled s | Optional s) as label),
+ _,
+ (e : Parsetree.expression) )
:: rest -> (
let namedArgLoc =
e.pexp_attributes
@@ -919,7 +921,7 @@ let extractExpApplyArgs ~args =
in
processArgs ~acc:({label = Some labelled; exp = e} :: acc) rest
| None -> processArgs ~acc rest)
- | (Asttypes.Nolabel, (e : Parsetree.expression)) :: rest ->
+ | (Asttypes.Nolabel, _, (e : Parsetree.expression)) :: rest ->
if e.pexp_loc.loc_ghost then processArgs ~acc rest
else processArgs ~acc:({label = None; exp = e} :: acc) rest
| [] -> List.rev acc
diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml
index 0b7b91b5b5..a564d97257 100644
--- a/analysis/src/SignatureHelp.ml
+++ b/analysis/src/SignatureHelp.ml
@@ -371,6 +371,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads =
[
_;
( _,
+ _,
{
pexp_desc =
Pexp_apply
diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml
index 3942aae2fe..08812e7854 100644
--- a/analysis/src/TypeUtils.ml
+++ b/analysis/src/TypeUtils.ml
@@ -941,7 +941,11 @@ module Codegen = struct
let mkFailWithExp () =
Ast_helper.Exp.apply
(Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none})
- [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))]
+ [
+ ( Nolabel,
+ Location.none,
+ Ast_helper.Exp.constant (Pconst_string ("TODO", None)) );
+ ]
let mkConstructPat ?payload name =
Ast_helper.Pat.construct
diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml
index 837f7df744..7fa504e83e 100644
--- a/analysis/src/Xform.ml
+++ b/analysis/src/Xform.ml
@@ -95,7 +95,7 @@ module IfThenElse = struct
Pexp_ident
{txt = Longident.Lident (("==" | "!=") as op)};
};
- args = [(Nolabel, arg1); (Nolabel, arg2)];
+ args = [(Nolabel, _, arg1); (Nolabel, _, arg2)];
};
},
e1,
diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml
index bfbafd80c0..6cf54e9984 100644
--- a/compiler/frontend/ast_compatible.ml
+++ b/compiler/frontend/ast_compatible.ml
@@ -42,7 +42,8 @@ let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression)
Pexp_apply
{
funct = fn;
- args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x));
+ args =
+ Ext_list.map args (fun x -> (Asttypes.Nolabel, Location.none, x));
partial = false;
};
}
@@ -52,7 +53,8 @@ let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression =
pexp_loc = loc;
pexp_attributes = attrs;
pexp_desc =
- Pexp_apply {funct = fn; args = [(Nolabel, arg1)]; partial = false};
+ Pexp_apply
+ {funct = fn; args = [(Nolabel, Location.none, arg1)]; partial = false};
}
let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
@@ -61,7 +63,12 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression =
pexp_attributes = attrs;
pexp_desc =
Pexp_apply
- {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]; partial = false};
+ {
+ funct = fn;
+ args =
+ [(Nolabel, Location.none, arg1); (Nolabel, Location.none, arg2)];
+ partial = false;
+ };
}
let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
@@ -72,7 +79,12 @@ let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression =
Pexp_apply
{
funct = fn;
- args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)];
+ args =
+ [
+ (Nolabel, Location.none, arg1);
+ (Nolabel, Location.none, arg2);
+ (Nolabel, Location.none, arg3);
+ ];
partial = false;
};
}
@@ -118,7 +130,9 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
Pexp_apply
{
funct = fn;
- args = Ext_list.map args (fun (l, a) -> (Asttypes.Labelled l, a));
+ args =
+ Ext_list.map args (fun (l, a) ->
+ (Asttypes.Labelled l, Location.none, a));
partial = false;
};
}
@@ -167,4 +181,4 @@ type object_field = Parsetree.object_field
let object_field l attrs ty = Parsetree.Otag (l, attrs, ty)
-type args = (Asttypes.arg_label * Parsetree.expression) list
+type args = (Asttypes.arg_label * Location.t * Parsetree.expression) list
diff --git a/compiler/frontend/ast_compatible.mli b/compiler/frontend/ast_compatible.mli
index 63201f9ef8..238ff6606b 100644
--- a/compiler/frontend/ast_compatible.mli
+++ b/compiler/frontend/ast_compatible.mli
@@ -137,4 +137,4 @@ type object_field = Parsetree.object_field
val object_field :
Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field
-type args = (Asttypes.arg_label * Parsetree.expression) list
+type args = (Asttypes.arg_label * Location.t * Parsetree.expression) list
diff --git a/compiler/frontend/ast_exp_apply.ml b/compiler/frontend/ast_exp_apply.ml
index fb5b500db9..2ab795d149 100644
--- a/compiler/frontend/ast_exp_apply.ml
+++ b/compiler/frontend/ast_exp_apply.ml
@@ -45,7 +45,7 @@ let bound (e : exp) (cb : exp -> _) =
let default_expr_mapper = Bs_ast_mapper.default_mapper.expr
let check_and_discard (args : Ast_compatible.args) =
- Ext_list.map args (fun (label, x) ->
+ Ext_list.map args (fun (label, _, x) ->
Bs_syntaxerr.err_if_label x.pexp_loc label;
x)
@@ -92,7 +92,8 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
Bs_ast_invariant.warn_discarded_unused_attributes fn1.pexp_attributes;
{
pexp_desc =
- Pexp_apply {funct = fn1; args = (Nolabel, a) :: args; partial};
+ Pexp_apply
+ {funct = fn1; args = (Nolabel, Location.none, a) :: args; partial};
pexp_loc = e.pexp_loc;
pexp_attributes = e.pexp_attributes @ f.pexp_attributes;
}
@@ -116,7 +117,9 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
Pexp_apply
{
funct = fn;
- args = (Nolabel, bounded_obj_arg) :: args;
+ args =
+ (Nolabel, Location.none, bounded_obj_arg)
+ :: args;
partial = false;
};
pexp_attributes = [];
@@ -170,7 +173,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp =
let arg = self.expr self arg in
let fn = Exp.send ~loc obj {txt = name ^ Literals.setter_suffix; loc} in
Exp.constraint_ ~loc
- (Exp.apply ~loc fn [(Nolabel, arg)])
+ (Exp.apply ~loc fn [(Nolabel, Location.none, arg)])
(Ast_literal.type_unit ~loc ())
in
match obj.pexp_desc with
diff --git a/compiler/frontend/ast_exp_extension.ml b/compiler/frontend/ast_exp_extension.ml
index 47405da03d..3843136bee 100644
--- a/compiler/frontend/ast_exp_extension.ml
+++ b/compiler/frontend/ast_exp_extension.ml
@@ -46,6 +46,7 @@ let handle_extension e (self : Bs_ast_mapper.mapper)
(Exp.ident ~loc {txt = Longident.parse "Js.Exn.raiseError"; loc})
[
( Nolabel,
+ Location.none,
Exp.constant ~loc
(Pconst_string
( (pretext
diff --git a/compiler/frontend/ast_uncurry_gen.ml b/compiler/frontend/ast_uncurry_gen.ml
index 70e4e2d550..3eeb871108 100644
--- a/compiler/frontend/ast_uncurry_gen.ml
+++ b/compiler/frontend/ast_uncurry_gen.ml
@@ -58,6 +58,7 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label
args =
[
( Nolabel,
+ Location.none,
Exp.constraint_ ~loc
(Exp.record ~loc
[
diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml
index f08b78b55f..b56b34288f 100644
--- a/compiler/frontend/bs_ast_mapper.ml
+++ b/compiler/frontend/bs_ast_mapper.ml
@@ -71,7 +71,7 @@ type mapper = {
let id x = x
let map_fst f (x, y) = (f x, y)
-let map_snd f (x, y) = (x, f y)
+let map_3rd f (x, y, z) = (x, y, f z)
let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
let map_opt f = function
@@ -327,7 +327,7 @@ module E = struct
(sub.pat sub p) (sub.expr sub e)
| Pexp_apply {funct = e; args = l; partial} ->
apply ~loc ~attrs ~partial (sub.expr sub e)
- (List.map (map_snd (sub.expr sub)) l)
+ (List.map (map_3rd (sub.expr sub)) l)
| Pexp_match (e, pel) ->
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
diff --git a/compiler/ml/ast_async.ml b/compiler/ml/ast_async.ml
index d5494ebfba..1fbc106998 100644
--- a/compiler/ml/ast_async.ml
+++ b/compiler/ml/ast_async.ml
@@ -11,7 +11,7 @@ let add_promise_type ?(loc = Location.none) ~async
Ast_helper.Exp.ident ~loc
{txt = Ldot (Lident Primitive_modules.promise, "unsafe_async"); loc}
in
- Ast_helper.Exp.apply ~loc unsafe_async [(Nolabel, result)]
+ Ast_helper.Exp.apply ~loc unsafe_async [(Nolabel, Location.none, result)]
else result
let rec add_promise_to_result ~loc (e : Parsetree.expression) =
diff --git a/compiler/ml/ast_await.ml b/compiler/ml/ast_await.ml
index 9fd1b9081b..53c6e985f1 100644
--- a/compiler/ml/ast_await.ml
+++ b/compiler/ml/ast_await.ml
@@ -7,7 +7,7 @@ let create_await_expression (e : Parsetree.expression) =
Ast_helper.Exp.ident ~loc
{txt = Ldot (Lident Primitive_modules.promise, "unsafe_await"); loc}
in
- Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)]
+ Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, Location.none, e)]
(* Transform `@res.await M` to unpack(@res.await Js.import(module(M: __M0__))) *)
let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr)
@@ -30,6 +30,7 @@ let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr)
})
[
( Nolabel,
+ Location.none,
Exp.constraint_ ~loc:e.pmod_loc
(Exp.pack ~loc:e.pmod_loc
{
diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli
index 226c9eb145..5555212885 100644
--- a/compiler/ml/ast_helper.mli
+++ b/compiler/ml/ast_helper.mli
@@ -152,7 +152,7 @@ module Exp : sig
?attrs:attrs ->
?partial:bool ->
expression ->
- (arg_label * expression) list ->
+ (arg_label * Location.t * expression) list ->
expression
val match_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
val try_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression
diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml
index 6e232a5619..8f2c38f283 100644
--- a/compiler/ml/ast_iterator.ml
+++ b/compiler/ml/ast_iterator.ml
@@ -62,7 +62,7 @@ type iterator = {
tree. *)
let iter_fst f (x, _) = f x
-let iter_snd f (_, y) = f y
+let iter_snd f (_, _, y) = f y
let iter_tuple f1 f2 (x, y) =
f1 x;
f2 y
diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml
index cc0e32bebe..50ba0e067b 100644
--- a/compiler/ml/ast_mapper.ml
+++ b/compiler/ml/ast_mapper.ml
@@ -63,7 +63,7 @@ type mapper = {
let id x = x
let map_fst f (x, y) = (f x, y)
-let map_snd f (x, y) = (x, f y)
+let map_3rd f (x, y, z) = (x, y, f z)
let map_tuple f1 f2 (x, y) = (f1 x, f2 y)
let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z)
let map_opt f = function
@@ -290,7 +290,7 @@ module E = struct
(sub.pat sub p) (sub.expr sub e)
| Pexp_apply {funct = e; args = l; partial} ->
apply ~loc ~attrs ~partial (sub.expr sub e)
- (List.map (map_snd (sub.expr sub)) l)
+ (List.map (map_3rd (sub.expr sub)) l)
| Pexp_match (e, pel) ->
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml
index f36bea1f0d..2d82689cd6 100644
--- a/compiler/ml/ast_mapper_from0.ml
+++ b/compiler/ml/ast_mapper_from0.ml
@@ -349,7 +349,7 @@ module E = struct
in
let partial, attrs = process_partial_app_attribute attrs in
apply ~loc ~attrs ~partial (sub.expr sub e)
- (List.map (map_snd (sub.expr sub)) l)
+ (List.map (fun (lbl, e) -> (lbl, Location.none, sub.expr sub e)) l)
| Pexp_match (e, pel) ->
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml
index 99a84e776e..0486c7f6b0 100644
--- a/compiler/ml/ast_mapper_to0.ml
+++ b/compiler/ml/ast_mapper_to0.ml
@@ -325,22 +325,22 @@ module E = struct
let e =
match (e.pexp_desc, args) with
| ( Pexp_ident ({txt = Longident.Lident "->"} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "|."}}
| ( Pexp_ident ({txt = Longident.Lident "++"} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "^"}}
| ( Pexp_ident ({txt = Longident.Lident "!="} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "<>"}}
| ( Pexp_ident ({txt = Longident.Lident "!=="} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "!="}}
| ( Pexp_ident ({txt = Longident.Lident "==="} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "=="}}
| ( Pexp_ident ({txt = Longident.Lident "=="} as lid),
- [(Nolabel, _); (Nolabel, _)] ) ->
+ [(Nolabel, _, _); (Nolabel, _, _)] ) ->
{e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "="}}
| _ -> e
in
@@ -349,7 +349,7 @@ module E = struct
else []
in
apply ~loc ~attrs (sub.expr sub e)
- (List.map (map_snd (sub.expr sub)) args)
+ (List.map (fun (lbl, _, e) -> (lbl, sub.expr sub e)) args)
| Pexp_match (e, pel) ->
match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
| Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel)
diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml
index 81e8d24cd0..6d700cde17 100644
--- a/compiler/ml/btype.ml
+++ b/compiler/ml/btype.ml
@@ -605,11 +605,11 @@ let prefixed_label_name = function
| Labelled s -> "~" ^ s
| Optional s -> "?" ^ s
-type sargs = (Asttypes.arg_label * Parsetree.expression) list
+type sargs = (Asttypes.arg_label * Location.t * Parsetree.expression) list
let rec extract_label_aux hd l = function
| [] -> None
- | ((l', t) as p) :: ls ->
+ | ((l', _, t) as p) :: ls ->
if label_name l' = l then Some (l', t, List.rev_append hd ls)
else extract_label_aux (p :: hd) l ls
@@ -620,7 +620,7 @@ let extract_label l (ls : sargs) :
let rec label_assoc x (args : sargs) =
match args with
| [] -> false
- | (a, _) :: l -> Asttypes.same_arg_label a x || label_assoc x l
+ | (a, _, _) :: l -> Asttypes.same_arg_label a x || label_assoc x l
(**********************************)
(* Utilities for backtracking *)
diff --git a/compiler/ml/btype.mli b/compiler/ml/btype.mli
index ef099af22b..4715f01727 100644
--- a/compiler/ml/btype.mli
+++ b/compiler/ml/btype.mli
@@ -186,7 +186,7 @@ val label_name : arg_label -> label
(* Returns the label name with first character '?' or '~' as appropriate. *)
val prefixed_label_name : arg_label -> label
-type sargs = (arg_label * Parsetree.expression) list
+type sargs = (arg_label * Location.t * Parsetree.expression) list
val extract_label :
label -> sargs -> (arg_label * Parsetree.expression * sargs) option
diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml
index f33454d448..ef5e5491fd 100644
--- a/compiler/ml/depend.ml
+++ b/compiler/ml/depend.ml
@@ -223,7 +223,7 @@ let rec add_expr bv exp =
add_expr (add_pattern bv p) e
| Pexp_apply {funct = e; args = el} ->
add_expr bv e;
- List.iter (fun (_, e) -> add_expr bv e) el
+ List.iter (fun (_, _, e) -> add_expr bv e) el
| Pexp_match (e, pel) ->
add_expr bv e;
add_cases bv pel
diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml
index be253d016a..d68b8bc801 100644
--- a/compiler/ml/parsetree.ml
+++ b/compiler/ml/parsetree.ml
@@ -251,7 +251,7 @@ and expression_desc =
*)
| Pexp_apply of {
funct: expression;
- args: (arg_label * expression) list;
+ args: (arg_label * Location.t * expression) list;
partial: bool;
}
(* E0 ~l1:E1 ... ~ln:En
diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml
index ca6ae8d64e..00fefaa603 100644
--- a/compiler/ml/pprintast.ml
+++ b/compiler/ml/pprintast.ml
@@ -523,7 +523,7 @@ and sugar_expr ctxt f e =
funct = {pexp_desc = Pexp_ident {txt = id; _}; pexp_attributes = []; _};
args;
}
- when List.for_all (fun (lab, _) -> lab = Nolabel) args -> (
+ when List.for_all (fun (lab, _, _) -> lab = Nolabel) args -> (
let print_indexop a path_prefix assign left right print_index indices
rem_args =
let print_path ppf = function
@@ -544,7 +544,7 @@ and sugar_expr ctxt f e =
true
| _ -> false
in
- match (id, List.map snd args) with
+ match (id, List.map (fun (_, _, e) -> e) args) with
| Lident "!", [e] ->
pp f "@[!%a@]" (simple_expr ctxt) e;
true
@@ -636,7 +636,7 @@ and expression ctxt f x =
match view_fixity_of_exp e with
| `Infix s -> (
match l with
- | [((Nolabel, _) as arg1); ((Nolabel, _) as arg2)] ->
+ | [((Nolabel, _, _) as arg1); ((Nolabel, _, _) as arg2)] ->
(* FIXME associativity label_x_expression_param *)
pp f "@[<2>%a@;%s@;%a@]"
(label_x_expression_param reset_ctxt)
@@ -655,13 +655,13 @@ and expression ctxt f x =
match l with
(* See #7200: avoid turning (~- 1) into (- 1) which is
parsed as an int literal *)
- | [(_, {pexp_desc = Pexp_constant _})] -> false
+ | [(_, _, {pexp_desc = Pexp_constant _})] -> false
| _ -> true
then String.sub s 1 (String.length s - 1)
else s
in
match l with
- | [(Nolabel, x)] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
+ | [(Nolabel, _, x)] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x
| _ ->
pp f "@[<2>%a %a@]" (simple_expr ctxt) e
(list (label_x_expression_param ctxt))
@@ -1273,7 +1273,7 @@ and case_list ctxt f l : unit =
in
list aux f l ~sep:""
-and label_x_expression_param ctxt f (l, e) =
+and label_x_expression_param ctxt f (l, _, e) =
let simple_name =
match e with
| {pexp_desc = Pexp_ident {txt = Lident l; _}; pexp_attributes = []} ->
diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml
index 56d0037d22..3ee7c68330 100644
--- a/compiler/ml/printast.ml
+++ b/compiler/ml/printast.ml
@@ -655,7 +655,7 @@ and longident_x_expression i ppf (li, e, opt) =
line i ppf "%a%s\n" fmt_longident_loc li (if opt then "?" else "");
expression (i + 1) ppf e
-and label_x_expression i ppf (l, e) =
+and label_x_expression i ppf (l, _loc, e) =
line i ppf "\n";
arg_label i ppf l;
expression (i + 1) ppf e
diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml
index a0e4e42200..7fbba2c47f 100644
--- a/compiler/ml/typecore.ml
+++ b/compiler/ml/typecore.ml
@@ -141,7 +141,7 @@ let iter_expression f e =
expr e
| Pexp_apply {funct = e; args = lel} ->
expr e;
- List.iter (fun (_, e) -> expr e) lel
+ List.iter (fun (_, _, e) -> expr e) lel
| Pexp_let (_, pel, e) ->
expr e;
List.iter binding pel
@@ -3368,7 +3368,7 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression)
| Texp_ident (path, _, _) -> (
let entry = Hashtbl.find_opt Unified_ops.index_by_path (Path.name path) in
match (entry, sargs) with
- | Some {form = Unary; specialization}, [(lhs_label, lhs_expr)] ->
+ | Some {form = Unary; specialization}, [(lhs_label, _, lhs_expr)] ->
let lhs = type_exp env lhs_expr in
let lhs_type = expand_head env lhs.exp_type in
let result_type =
@@ -3394,7 +3394,7 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression)
let targs = [(lhs_label, Some lhs)] in
Some (targs, result_type)
| ( Some {form = Binary; specialization},
- [(lhs_label, lhs_expr); (rhs_label, rhs_expr)] ) ->
+ [(lhs_label, _, lhs_expr); (rhs_label, _, rhs_expr)] ) ->
let lhs = type_exp env lhs_expr in
let lhs_type = expand_head env lhs.exp_type in
let rhs = type_exp env rhs_expr in
@@ -3549,12 +3549,12 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) :
omitted t2 []
| _ -> collect_args ()
else collect_args ()
- | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
+ | [(Nolabel, _, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
when total_app && omitted = [] && args <> []
&& List.length args = List.length !ignored ->
(* foo(. ) treated as empty application if all args are optional (hence ignored) *)
type_unknown_args max_arity ~args ~top_arity:None omitted ty_fun []
- | (l1, sarg1) :: sargl ->
+ | (l1, _, sarg1) :: sargl ->
let ty1, ty2 =
let ty_fun = expand_head env ty_fun in
let arity_ok = List.length args < max_arity in
@@ -3649,7 +3649,7 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) :
let top_arity = if total_app then Some max_arity else None in
match sargs with
(* Special case for ignore: avoid discarding warning *)
- | [(Nolabel, sarg)] when is_ignore ~env ~arity:top_arity funct ->
+ | [(Nolabel, _, sarg)] when is_ignore ~env ~arity:top_arity funct ->
let ty_arg, ty_res =
filter_arrow ~env ~arity:top_arity (instance env funct.exp_type) Nolabel
in
diff --git a/compiler/syntax/src/jsx_common.ml b/compiler/syntax/src/jsx_common.ml
index 20f0c61413..f73995dcf1 100644
--- a/compiler/syntax/src/jsx_common.ml
+++ b/compiler/syntax/src/jsx_common.ml
@@ -59,5 +59,5 @@ let async_component ~async expr =
loc = Location.none;
txt = Ldot (Lident "JsxPPXReactSupport", "asyncComponent");
})
- [(Nolabel, expr)]
+ [(Nolabel, Location.none, expr)]
else expr
diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml
index d2a2307508..6e0a53a78e 100644
--- a/compiler/syntax/src/jsx_v4.ml
+++ b/compiler/syntax/src/jsx_v4.ml
@@ -95,9 +95,10 @@ let extract_children ?(remove_last_position_unit = false) ~loc
let rec allButLast_ lst acc =
match lst with
| [] -> []
- | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] ->
+ | [(Nolabel, _, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})]
+ ->
acc
- | (Nolabel, {pexp_loc}) :: _rest ->
+ | (Nolabel, _, {pexp_loc}) :: _rest ->
Jsx_common.raise_error ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
| arg :: rest -> allButLast_ rest (arg :: acc)
@@ -105,14 +106,14 @@ let extract_children ?(remove_last_position_unit = false) ~loc
let all_but_last lst = allButLast_ lst [] |> List.rev in
match
List.partition
- (fun (label, _) -> label = labelled "children")
+ (fun (label, _, _) -> label = labelled "children")
props_and_children
with
| [], props ->
(* no children provided? Place a placeholder list *)
( Exp.construct {loc = Location.none; txt = Lident "[]"} None,
if remove_last_position_unit then all_but_last props else props )
- | [(_, children_expr)], props ->
+ | [(_, _, children_expr)], props ->
( children_expr,
if remove_last_position_unit then all_but_last props else props )
| _ ->
@@ -192,14 +193,15 @@ let record_from_props ~loc ~remove_key call_arguments =
let rec remove_last_position_unit_aux props acc =
match props with
| [] -> acc
- | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, _)]
- ->
+ | [
+ (Nolabel, _, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, _);
+ ] ->
acc
- | (Nolabel, {pexp_loc}, _) :: _rest ->
+ | (Nolabel, _, {pexp_loc}, _) :: _rest ->
Jsx_common.raise_error ~loc:pexp_loc
"JSX: found non-labelled argument before the last position"
- | ((Labelled txt, {pexp_loc}, _) as prop) :: rest
- | ((Optional txt, {pexp_loc}, _) as prop) :: rest ->
+ | ((Labelled txt, _, {pexp_loc}, _) as prop) :: rest
+ | ((Optional txt, _, {pexp_loc}, _) as prop) :: rest ->
if txt = spread_props_label then
match acc with
| [] -> remove_last_position_unit_aux rest (prop :: acc)
@@ -212,23 +214,23 @@ let record_from_props ~loc ~remove_key call_arguments =
let props, props_to_spread =
remove_last_position_unit_aux call_arguments []
|> List.rev
- |> List.partition (fun (label, _, _) -> label <> labelled "_spreadProps")
+ |> List.partition (fun (label, _, _, _) -> label <> labelled "_spreadProps")
in
let props =
if remove_key then
props
- |> List.filter (fun (arg_label, _, _) -> "key" <> get_label arg_label)
+ |> List.filter (fun (arg_label, _, _, _) -> "key" <> get_label arg_label)
else props
in
- let process_prop (arg_label, ({pexp_loc} as pexpr), optional) =
+ let process_prop (arg_label, _, ({pexp_loc} as pexpr), optional) =
(* In case filed label is "key" only then change expression to option *)
let id = get_label arg_label in
({txt = Lident id; loc = pexp_loc}, pexpr, optional || is_optional arg_label)
in
let fields = props |> List.map process_prop in
let spread_fields =
- props_to_spread |> List.map (fun (_, expression, _) -> expression)
+ props_to_spread |> List.map (fun (_, _, expression, _) -> expression)
in
match (fields, spread_fields) with
| [], [spread_props] | [], spread_props :: _ -> spread_props
@@ -388,15 +390,15 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
let children_expr = transform_children_if_list_upper ~mapper children in
let recursively_transformed_args_for_make =
args_for_make
- |> List.map (fun (label, expression) ->
- (label, mapper.expr mapper expression, false))
+ |> List.map (fun (label, loc, expression) ->
+ (label, loc, mapper.expr mapper expression, false))
in
let children_arg = ref None in
let args =
recursively_transformed_args_for_make
@
match children_expr with
- | Exact children -> [(labelled "children", children, false)]
+ | Exact children -> [(labelled "children", Location.none, children, false)]
| ListLiteral {pexp_desc = Pexp_array list} when list = [] -> []
| ListLiteral expression -> (
(* this is a hack to support react components that introspect into their children *)
@@ -405,15 +407,17 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
| "automatic" ->
[
( labelled "children",
+ Location.none,
Exp.apply
(Exp.ident
{txt = module_access_name config "array"; loc = Location.none})
- [(Nolabel, expression)],
+ [(Nolabel, Location.none, expression)],
false );
]
| _ ->
[
( labelled "children",
+ Location.none,
Exp.ident {loc = Location.none; txt = Ldot (Lident "React", "null")},
false );
])
@@ -441,8 +445,9 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
in
let key_prop =
args
- |> List.filter_map (fun (arg_label, e, _opt) ->
- if "key" = get_label arg_label then Some (arg_label, e) else None)
+ |> List.filter_map (fun (arg_label, _, e, _opt) ->
+ if "key" = get_label arg_label then Some (arg_label, Location.none, e)
+ else None)
in
let make_i_d =
Exp.ident ~loc:call_expr_loc
@@ -456,20 +461,21 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
| None, key :: _ ->
( Exp.ident
{loc = Location.none; txt = module_access_name config "jsxKeyed"},
- [key; (nolabel, unit_expr ~loc:Location.none)] )
+ [key; (nolabel, Location.none, unit_expr ~loc:Location.none)] )
| None, [] ->
( Exp.ident {loc = Location.none; txt = module_access_name config "jsx"},
[] )
| Some _, key :: _ ->
( Exp.ident
{loc = Location.none; txt = module_access_name config "jsxsKeyed"},
- [key; (nolabel, unit_expr ~loc:Location.none)] )
+ [key; (nolabel, Location.none, unit_expr ~loc:Location.none)] )
| Some _, [] ->
( Exp.ident {loc = Location.none; txt = module_access_name config "jsxs"},
[] )
in
Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr
- ([(nolabel, make_i_d); (nolabel, props)] @ key_and_unit)
+ ([(nolabel, Location.none, make_i_d); (nolabel, Location.none, props)]
+ @ key_and_unit)
| _ -> (
match (!children_arg, key_prop) with
| None, key :: _ ->
@@ -479,12 +485,16 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
loc = Location.none;
txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey");
})
- [key; (nolabel, make_i_d); (nolabel, props)]
+ [
+ key;
+ (nolabel, Location.none, make_i_d);
+ (nolabel, Location.none, props);
+ ]
| None, [] ->
Exp.apply ~loc:jsx_expr_loc ~attrs
(Exp.ident
{loc = Location.none; txt = Ldot (Lident "React", "createElement")})
- [(nolabel, make_i_d); (nolabel, props)]
+ [(nolabel, Location.none, make_i_d); (nolabel, Location.none, props)]
| Some children, key :: _ ->
Exp.apply ~loc:jsx_expr_loc ~attrs
(Exp.ident
@@ -493,7 +503,12 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
txt =
Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey");
})
- [key; (nolabel, make_i_d); (nolabel, props); (nolabel, children)]
+ [
+ key;
+ (nolabel, Location.none, make_i_d);
+ (nolabel, Location.none, props);
+ (nolabel, Location.none, children);
+ ]
| Some children, [] ->
Exp.apply ~loc:jsx_expr_loc ~attrs
(Exp.ident
@@ -501,7 +516,11 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc
loc = Location.none;
txt = Ldot (Lident "React", "createElementVariadic");
})
- [(nolabel, make_i_d); (nolabel, props); (nolabel, children)])
+ [
+ (nolabel, Location.none, make_i_d);
+ (nolabel, Location.none, props);
+ (nolabel, Location.none, children);
+ ])
let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
call_arguments id =
@@ -523,8 +542,8 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
let children_expr = transform_children_if_list_upper ~mapper children in
let recursively_transformed_args_for_make =
args_for_make
- |> List.map (fun (label, expression) ->
- (label, mapper.expr mapper expression, false))
+ |> List.map (fun (label, loc, expression) ->
+ (label, loc, mapper.expr mapper expression, false))
in
let children_arg = ref None in
let args =
@@ -534,13 +553,14 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
| Exact children ->
[
( labelled "children",
+ Location.none,
Exp.apply
(Exp.ident
{
txt = Ldot (element_binding, "someElement");
loc = Location.none;
})
- [(Nolabel, children)],
+ [(Nolabel, Location.none, children)],
true );
]
| ListLiteral {pexp_desc = Pexp_array list} when list = [] -> []
@@ -549,10 +569,11 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
children_arg := Some expression;
[
( labelled "children",
+ Location.none,
Exp.apply
(Exp.ident
{txt = module_access_name config "array"; loc = Location.none})
- [(Nolabel, expression)],
+ [(Nolabel, Location.none, expression)],
false );
]
in
@@ -567,28 +588,34 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
in
let key_prop =
args
- |> List.filter_map (fun (arg_label, e, _opt) ->
- if "key" = get_label arg_label then Some (arg_label, e) else None)
+ |> List.filter_map (fun (arg_label, _, e, _opt) ->
+ if "key" = get_label arg_label then
+ Some (arg_label, Location.none, e)
+ else None)
in
let jsx_expr, key_and_unit =
match (!children_arg, key_prop) with
| None, key :: _ ->
( Exp.ident
{loc = Location.none; txt = Ldot (element_binding, "jsxKeyed")},
- [key; (nolabel, unit_expr ~loc:Location.none)] )
+ [key; (nolabel, Location.none, unit_expr ~loc:Location.none)] )
| None, [] ->
( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsx")},
[] )
| Some _, key :: _ ->
( Exp.ident
{loc = Location.none; txt = Ldot (element_binding, "jsxsKeyed")},
- [key; (nolabel, unit_expr ~loc:Location.none)] )
+ [key; (nolabel, Location.none, unit_expr ~loc:Location.none)] )
| Some _, [] ->
( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsxs")},
[] )
in
Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr
- ([(nolabel, component_name_expr); (nolabel, props)] @ key_and_unit)
+ ([
+ (nolabel, Location.none, component_name_expr);
+ (nolabel, Location.none, props);
+ ]
+ @ key_and_unit)
| _ ->
let children, non_children_props =
extract_children ~loc:jsx_expr_loc call_arguments
@@ -614,22 +641,22 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs
| [_justTheUnitArgumentAtEnd] ->
[
(* "div" *)
- (nolabel, component_name_expr);
+ (nolabel, Location.none, component_name_expr);
(* [|moreCreateElementCallsHere|] *)
- (nolabel, children_expr);
+ (nolabel, Location.none, children_expr);
]
| non_empty_props ->
let props_record =
record_from_props ~loc:Location.none ~remove_key:false
- (non_empty_props |> List.map (fun (l, e) -> (l, e, false)))
+ (non_empty_props |> List.map (fun (l, loc, e) -> (l, loc, e, false)))
in
[
(* "div" *)
- (nolabel, component_name_expr);
+ (nolabel, Location.none, component_name_expr);
(* ReactDOM.domProps(~className=blabla, ~foo=bar, ()) *)
- (labelled "props", props_record);
+ (labelled "props", Location.none, props_record);
(* [|moreCreateElementCallsHere|] *)
- (nolabel, children_expr);
+ (nolabel, Location.none, children_expr);
]
in
Exp.apply ~loc:jsx_expr_loc ~attrs
@@ -791,8 +818,9 @@ let modified_binding_old binding =
(* here's where we spelunk! *)
spelunk_for_fun_expression return_expression
(* let make = React.forwardRef((~prop) => ...) *)
- | {pexp_desc = Pexp_apply {args = [(Nolabel, inner_function_expression)]}}
- ->
+ | {
+ pexp_desc = Pexp_apply {args = [(Nolabel, _, inner_function_expression)]};
+ } ->
spelunk_for_fun_expression inner_function_expression
| {
pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression);
@@ -870,12 +898,15 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding =
| {
pexp_desc =
Pexp_apply
- {funct = wrapper_expression; args = [(Nolabel, internal_expression)]};
+ {
+ funct = wrapper_expression;
+ args = [(Nolabel, _, internal_expression)];
+ };
} ->
let () = has_application := true in
let _, _, exp = spelunk_for_fun_expression internal_expression in
let has_forward_ref = is_forward_ref wrapper_expression in
- ( (fun exp -> Exp.apply wrapper_expression [(nolabel, exp)]),
+ ( (fun exp -> Exp.apply wrapper_expression [(nolabel, Location.none, exp)]),
has_forward_ref,
exp )
| {pexp_desc = Pexp_sequence (wrapper_expression, internal_expression)} ->
@@ -972,10 +1003,19 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
(match rec_flag with
| Recursive -> internal_fn_name
| Nonrecursive -> fn_name)))
- ([(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))]
+ ([
+ ( Nolabel,
+ Location.none,
+ Exp.ident (Location.mknoloc @@ Lident "props") );
+ ]
@
match has_forward_ref with
- | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))]
+ | true ->
+ [
+ ( Nolabel,
+ Location.none,
+ Exp.ident (Location.mknoloc @@ Lident "ref") );
+ ]
| false -> [])
in
let make_props_pattern = function
@@ -1191,7 +1231,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
match binding.pvb_expr with
| {
pexp_desc =
- Pexp_apply {funct = wrapper_expr; args = [(Nolabel, func_expr)]};
+ Pexp_apply {funct = wrapper_expr; args = [(Nolabel, _, func_expr)]};
}
when is_forward_ref wrapper_expr ->
(* Case when using React.forwardRef *)
@@ -1239,7 +1279,9 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding =
| Nonrecursive -> fn_name);
loc;
})
- [(Nolabel, Exp.ident {txt = Lident "props"; loc})]))
+ [
+ (Nolabel, Location.none, Exp.ident {txt = Lident "props"; loc});
+ ]))
in
let wrapper_expr = Ast_uncurried.uncurried_fun ~arity:1 wrapper_expr in
@@ -1561,7 +1603,7 @@ let expr ~config mapper expression =
Exp.apply
(Exp.ident
{txt = module_access_name config "array"; loc = Location.none})
- [(Nolabel, expr)]
+ [(Nolabel, Location.none, expr)]
in
let count_of_children = function
| {pexp_desc = Pexp_array children} -> List.length children
@@ -1583,12 +1625,12 @@ let expr ~config mapper expression =
| "classic" | _ -> empty_record ~loc:Location.none)
in
let args =
- (nolabel, fragment)
- :: (nolabel, transform_children_to_props children_expr)
+ (nolabel, Location.none, fragment)
+ :: (nolabel, Location.none, transform_children_to_props children_expr)
::
(match config.mode with
| "classic" when count_of_children children_expr > 1 ->
- [(nolabel, children_expr)]
+ [(nolabel, Location.none, children_expr)]
| _ -> [])
in
Exp.apply
diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml
index 767558b77b..192919ea2e 100644
--- a/compiler/syntax/src/res_ast_debugger.ml
+++ b/compiler/syntax/src/res_ast_debugger.ml
@@ -573,7 +573,7 @@ module SexpAst = struct
expression expr;
Sexp.list
(map_empty
- ~f:(fun (arg_lbl, expr) ->
+ ~f:(fun (arg_lbl, _, expr) ->
Sexp.list [arg_label arg_lbl; expression expr])
args);
]
diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml
index 8aa4997e3c..27d50ddf9e 100644
--- a/compiler/syntax/src/res_comments_table.ml
+++ b/compiler/syntax/src/res_comments_table.ml
@@ -1320,7 +1320,7 @@ and walk_expression expr t comments =
Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!");
};
};
- args = [(Nolabel, arg_expr)];
+ args = [(Nolabel, _, arg_expr)];
} ->
let before, inside, after = partition_by_loc comments arg_expr.pexp_loc in
attach t.leading arg_expr.pexp_loc before;
@@ -1342,7 +1342,7 @@ and walk_expression expr t comments =
| "<>" );
};
};
- args = [(Nolabel, operand1); (Nolabel, operand2)];
+ args = [(Nolabel, _, operand1); (Nolabel, _, operand2)];
} ->
let before, inside, after = partition_by_loc comments operand1.pexp_loc in
attach t.leading operand1.pexp_loc before;
@@ -1362,7 +1362,7 @@ and walk_expression expr t comments =
{
pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")};
};
- args = [(Nolabel, parent_expr); (Nolabel, member_expr)];
+ args = [(Nolabel, _, parent_expr); (Nolabel, _, member_expr)];
} ->
walk_list [Expression parent_expr; Expression member_expr] t comments
| Pexp_apply
@@ -1373,9 +1373,9 @@ and walk_expression expr t comments =
};
args =
[
- (Nolabel, parent_expr);
- (Nolabel, member_expr);
- (Nolabel, target_expr);
+ (Nolabel, _, parent_expr);
+ (Nolabel, _, member_expr);
+ (Nolabel, _, target_expr);
];
} ->
walk_list
@@ -1389,7 +1389,7 @@ and walk_expression expr t comments =
Pexp_ident
{txt = Longident.Ldot (Lident "Primitive_dict", "make")};
};
- args = [(Nolabel, key_values)];
+ args = [(Nolabel, _, key_values)];
}
when Res_parsetree_viewer.is_tuple_array key_values ->
walk_list [Expression key_values] t comments
@@ -1410,7 +1410,7 @@ and walk_expression expr t comments =
if ParsetreeViewer.is_jsx_expression expr then (
let props =
arguments
- |> List.filter (fun (label, _) ->
+ |> List.filter (fun (label, _, _) ->
match label with
| Asttypes.Labelled "children" -> false
| Asttypes.Nolabel -> false
@@ -1418,13 +1418,13 @@ and walk_expression expr t comments =
in
let maybe_children =
arguments
- |> List.find_opt (fun (label, _) ->
+ |> List.find_opt (fun (label, _, _) ->
label = Asttypes.Labelled "children")
in
match maybe_children with
(* There is no need to deal with this situation as the children cannot be NONE *)
| None -> ()
- | Some (_, children) ->
+ | Some (_, _, children) ->
let leading, inside, _ = partition_by_loc after children.pexp_loc in
if props = [] then
(* All comments inside a tag are trailing comments of the tag if there are no props
@@ -1438,14 +1438,16 @@ and walk_expression expr t comments =
in
attach t.trailing call_expr.pexp_loc after_expr
else
- walk_list (props |> List.map (fun (_, e) -> ExprArgument e)) t leading;
+ walk_list
+ (props |> List.map (fun (_, _, e) -> ExprArgument e))
+ t leading;
walk_expression children t inside)
else
let after_expr, rest =
partition_adjacent_trailing call_expr.pexp_loc after
in
attach t.trailing call_expr.pexp_loc after_expr;
- walk_list (arguments |> List.map (fun (_, e) -> ExprArgument e)) t rest
+ walk_list (arguments |> List.map (fun (_, _, e) -> ExprArgument e)) t rest
| Pexp_fun _ | Pexp_newtype _ -> (
let _, parameters, return_expr = fun_expr expr in
let comments =
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
index 9fccfe49e4..c75df1d56c 100644
--- a/compiler/syntax/src/res_core.ml
+++ b/compiler/syntax/src/res_core.ml
@@ -166,7 +166,11 @@ let tagged_template_literal_attr =
let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr [])
-type argument = {label: Asttypes.arg_label; expr: Parsetree.expression}
+type argument = {
+ label: Asttypes.arg_label;
+ lbl_loc: Location.t;
+ expr: Parsetree.expression;
+}
type type_parameter = {
attrs: Ast_helper.attrs;
@@ -427,14 +431,14 @@ let make_unary_expr start_pos token_end token operand =
~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end)
(Ast_helper.Exp.ident ~loc:token_loc
(Location.mkloc (Longident.Lident operator) token_loc))
- [(Nolabel, operand)]
+ [(Nolabel, Location.none, operand)]
| Token.Bang, _ ->
let token_loc = mk_loc start_pos token_end in
Ast_helper.Exp.apply
~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end)
(Ast_helper.Exp.ident ~loc:token_loc
(Location.mkloc (Longident.Lident "not") token_loc))
- [(Nolabel, operand)]
+ [(Nolabel, Location.none, operand)]
| _ -> operand
let make_list_expression loc seq ext_opt =
@@ -522,13 +526,13 @@ let wrap_type_annotation ~loc newtypes core_type body =
let process_underscore_application args =
let exp_question = ref None in
let hidden_var = "__x" in
- let check_arg ((lab, exp) as arg) =
+ let check_arg ((lab, _, exp) as arg) =
match exp.Parsetree.pexp_desc with
| Pexp_ident ({txt = Lident "_"} as id) ->
let new_id = Location.mkloc (Longident.Lident hidden_var) id.loc in
let new_exp = Ast_helper.Exp.mk (Pexp_ident new_id) ~loc:exp.pexp_loc in
exp_question := Some new_exp;
- (lab, new_exp)
+ (lab, Location.none, new_exp)
| _ -> arg
in
let args = List.map check_arg args in
@@ -2033,7 +2037,7 @@ and parse_bracket_access p expr start_pos =
Ast_helper.Exp.apply ~loc
(Ast_helper.Exp.ident ~loc:operator_loc
(Location.mkloc (Longident.Lident "#=") operator_loc))
- [(Nolabel, e); (Nolabel, rhs_expr)]
+ [(Nolabel, Location.none, e); (Nolabel, Location.none, rhs_expr)]
| _ -> e)
| _ -> (
let access_expr = parse_constrained_or_coerced_expr p in
@@ -2060,7 +2064,11 @@ and parse_bracket_access p expr start_pos =
let array_set =
Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos)
(Ast_helper.Exp.ident ~loc:array_loc array_set)
- [(Nolabel, expr); (Nolabel, access_expr); (Nolabel, rhs_expr)]
+ [
+ (Nolabel, Location.none, expr);
+ (Nolabel, Location.none, access_expr);
+ (Nolabel, Location.none, rhs_expr);
+ ]
in
Parser.eat_breadcrumb p;
array_set
@@ -2070,7 +2078,9 @@ and parse_bracket_access p expr start_pos =
Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos)
(Ast_helper.Exp.ident ~loc:array_loc
(Location.mkloc (Longident.Ldot (Lident "Array", "get")) array_loc))
- [(Nolabel, expr); (Nolabel, access_expr)]
+ [
+ (Nolabel, Location.none, expr); (Nolabel, Location.none, access_expr);
+ ]
in
parse_primary_expr ~operand:e p)
@@ -2248,13 +2258,18 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec =
b with
pexp_desc =
Pexp_apply
- {funct = fun_expr; args = args @ [(Nolabel, a)]; partial};
+ {
+ funct = fun_expr;
+ args = args @ [(Nolabel, Location.none, a)];
+ partial;
+ };
}
- | BarGreater, _ -> Ast_helper.Exp.apply ~loc b [(Nolabel, a)]
+ | BarGreater, _ ->
+ Ast_helper.Exp.apply ~loc b [(Nolabel, Location.none, a)]
| _ ->
Ast_helper.Exp.apply ~loc
(make_infix_operator p token start_pos end_pos)
- [(Nolabel, a); (Nolabel, b)]
+ [(Nolabel, Location.none, a); (Nolabel, Location.none, b)]
in
Parser.eat_breadcrumb p;
loop expr)
@@ -2346,7 +2361,10 @@ and parse_template_expr ?prefix p =
Ast_helper.Exp.apply
~attrs:[tagged_template_literal_attr]
~loc:lident_loc.loc ident
- [(Nolabel, strings_array); (Nolabel, values_array)]
+ [
+ (Nolabel, Location.none, strings_array);
+ (Nolabel, Location.none, values_array);
+ ]
in
let hidden_operator =
@@ -2356,7 +2374,7 @@ and parse_template_expr ?prefix p =
let concat (e1 : Parsetree.expression) (e2 : Parsetree.expression) =
let loc = mk_loc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in
Ast_helper.Exp.apply ~attrs:[template_literal_attr] ~loc hidden_operator
- [(Nolabel, e1); (Nolabel, e2)]
+ [(Nolabel, Location.none, e1); (Nolabel, Location.none, e2)]
in
let gen_interpolated_string () =
let subparts =
@@ -2705,8 +2723,9 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p =
[
jsx_props;
[
- (Asttypes.Labelled "children", children);
+ (Asttypes.Labelled "children", Location.none, children);
( Asttypes.Nolabel,
+ Location.none,
Ast_helper.Exp.construct
(Location.mknoloc (Longident.Lident "()"))
None );
@@ -2775,6 +2794,7 @@ and parse_jsx_prop p =
if optional then
Some
( Asttypes.Optional name,
+ loc,
Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc
(Location.mkloc (Longident.Lident name) loc) )
else
@@ -2791,7 +2811,7 @@ and parse_jsx_prop p =
let label =
if optional then Asttypes.Optional name else Asttypes.Labelled name
in
- Some (label, attr_expr)
+ Some (label, loc, attr_expr)
| _ ->
let attr_expr =
Ast_helper.Exp.ident ~loc ~attrs:[prop_loc_attr]
@@ -2800,7 +2820,7 @@ and parse_jsx_prop p =
let label =
if optional then Asttypes.Optional name else Asttypes.Labelled name
in
- Some (label, attr_expr))
+ Some (label, loc, attr_expr))
(* {...props} *)
| Lbrace -> (
Scanner.pop_mode p.scanner Jsx;
@@ -2823,7 +2843,7 @@ and parse_jsx_prop p =
| Rbrace ->
Parser.next p;
Scanner.set_jsx_mode p.scanner;
- Some (label, attr_expr)
+ Some (label, loc, attr_expr)
| _ -> None)
| _ -> None)
| _ -> None
@@ -3628,7 +3648,8 @@ and parse_argument p : argument option =
(Location.mknoloc (Longident.Lident "()"))
None
in
- Some {label = Asttypes.Nolabel; expr = unit_expr}
+ Some
+ {label = Asttypes.Nolabel; lbl_loc = Location.none; expr = unit_expr}
| _ -> parse_argument2 p)
| _ -> parse_argument2 p
else None
@@ -3642,7 +3663,7 @@ and parse_argument2 p : argument option =
let expr =
Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc)
in
- Some {label = Nolabel; expr}
+ Some {label = Nolabel; lbl_loc = Location.none; expr}
| Tilde -> (
Parser.next p;
(* TODO: nesting of pattern matches not intuitive for error recovery *)
@@ -3662,7 +3683,7 @@ and parse_argument2 p : argument option =
match p.Parser.token with
| Question ->
Parser.next p;
- Some {label = Optional ident; expr = ident_expr}
+ Some {label = Optional ident; lbl_loc = loc; expr = ident_expr}
| Equal ->
Parser.next p;
let label =
@@ -3683,7 +3704,7 @@ and parse_argument2 p : argument option =
let expr = parse_constrained_or_coerced_expr p in
{expr with pexp_attributes = prop_loc_attr :: expr.pexp_attributes}
in
- Some {label; expr}
+ Some {label; lbl_loc = loc; expr}
| Colon ->
Parser.next p;
let typ = parse_typ_expr p in
@@ -3691,12 +3712,23 @@ and parse_argument2 p : argument option =
let expr =
Ast_helper.Exp.constraint_ ~attrs:[prop_loc_attr] ~loc ident_expr typ
in
- Some {label = Labelled ident; expr}
- | _ -> Some {label = Labelled ident; expr = ident_expr})
+ Some {label = Labelled ident; lbl_loc = loc; expr}
+ | _ -> Some {label = Labelled ident; lbl_loc = loc; expr = ident_expr})
| t ->
Parser.err p (Diagnostics.lident t);
- Some {label = Nolabel; expr = Recover.default_expr ()})
- | _ -> Some {label = Nolabel; expr = parse_constrained_or_coerced_expr p}
+ Some
+ {
+ label = Nolabel;
+ lbl_loc = Location.none;
+ expr = Recover.default_expr ();
+ })
+ | _ ->
+ Some
+ {
+ label = Nolabel;
+ lbl_loc = Location.none;
+ expr = parse_constrained_or_coerced_expr p;
+ }
and parse_call_expr p fun_expr =
Parser.expect Lparen p;
@@ -3722,6 +3754,7 @@ and parse_call_expr p fun_expr =
[
{
label = Nolabel;
+ lbl_loc = Location.none;
expr =
Ast_helper.Exp.construct ~loc
(Location.mkloc (Longident.Lident "()") loc)
@@ -3733,9 +3766,11 @@ and parse_call_expr p fun_expr =
let loc = {fun_expr.pexp_loc with loc_end = p.prev_end_pos} in
let args =
match args with
- | {label = lbl; expr} :: args ->
- let group (grp, acc) {label = lbl; expr} = ((lbl, expr) :: grp, acc) in
- let grp, acc = List.fold_left group ([(lbl, expr)], []) args in
+ | {label = lbl; lbl_loc; expr} :: args ->
+ let group (grp, acc) {label = lbl; lbl_loc; expr} =
+ ((lbl, lbl_loc, expr) :: grp, acc)
+ in
+ let grp, acc = List.fold_left group ([(lbl, lbl_loc, expr)], []) args in
List.rev (List.rev grp :: acc)
| [] -> []
in
@@ -3924,7 +3959,7 @@ and parse_list_expr ~start_pos p =
(Longident.Ldot
(Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany"))
loc))
- [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)]
+ [(Asttypes.Nolabel, Location.none, Ast_helper.Exp.array ~loc list_exprs)]
and parse_dict_expr ~start_pos p =
let rows =
@@ -3953,7 +3988,11 @@ and parse_dict_expr ~start_pos p =
(Location.mkloc
(Longident.Ldot (Longident.Lident Primitive_modules.dict, "make"))
loc))
- [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc key_value_pairs)]
+ [
+ ( Asttypes.Nolabel,
+ Location.none,
+ Ast_helper.Exp.array ~loc key_value_pairs );
+ ]
and parse_array_exp p =
let start_pos = p.Parser.start_pos in
@@ -4008,7 +4047,7 @@ and parse_array_exp p =
(Longident.Ldot
(Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany"))
loc))
- [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)]
+ [(Asttypes.Nolabel, Location.none, Ast_helper.Exp.array ~loc list_exprs)]
(* TODO: check attributes in the case of poly type vars,
* might be context dependend: parseFieldDeclaration (see ocaml) *)
diff --git a/compiler/syntax/src/res_parens.ml b/compiler/syntax/src/res_parens.ml
index d9f76fca29..908caf58d1 100644
--- a/compiler/syntax/src/res_parens.ml
+++ b/compiler/syntax/src/res_parens.ml
@@ -159,7 +159,7 @@ let rhs_binary_expr_operand parent_operator rhs =
pexp_desc =
Pexp_ident {txt = Longident.Lident operator; loc = operator_loc};
};
- args = [(_, _left); (_, _right)];
+ args = [(_, _, _left); (_, _, _right)];
}
when ParsetreeViewer.is_binary_operator operator
&& not (operator_loc.loc_ghost && operator = "++") ->
@@ -177,7 +177,7 @@ let flatten_operand_rhs parent_operator rhs =
pexp_desc =
Pexp_ident {txt = Longident.Lident operator; loc = operator_loc};
};
- args = [(_, _left); (_, _right)];
+ args = [(_, _, _left); (_, _, _right)];
}
when ParsetreeViewer.is_binary_operator operator
&& not (operator_loc.loc_ghost && operator = "++") ->
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
index 3260786cee..d4fcad2d01 100644
--- a/compiler/syntax/src/res_parsetree_viewer.ml
+++ b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -123,9 +123,11 @@ let rewrite_underscore_apply expr =
(fun arg ->
match arg with
| ( lbl,
+ loc,
({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)}
as arg_expr) ) ->
( lbl,
+ loc,
{
arg_expr with
pexp_desc = Pexp_ident {lid with txt = Longident.Lident "_"};
@@ -287,7 +289,7 @@ let is_unary_expression expr =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
- args = [(Nolabel, _arg)];
+ args = [(Nolabel, _loc, _arg)];
}
when is_unary_operator operator ->
true
@@ -311,7 +313,7 @@ let is_binary_expression expr =
pexp_desc =
Pexp_ident {txt = Longident.Lident operator; loc = operator_loc};
};
- args = [(Nolabel, _operand1); (Nolabel, _operand2)];
+ args = [(Nolabel, _, _operand1); (Nolabel, _, _operand2)];
}
when is_binary_operator operator
&& not (operator_loc.loc_ghost && operator = "++")
@@ -386,7 +388,7 @@ let is_array_access expr =
Pexp_ident
{txt = Longident.Ldot (Longident.Lident "Array", "get")};
};
- args = [(Nolabel, _parentExpr); (Nolabel, _memberExpr)];
+ args = [(Nolabel, _, _parentExpr); (Nolabel, _, _memberExpr)];
} ->
true
| _ -> false
@@ -518,7 +520,7 @@ let should_indent_binary_expr expr =
Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}};
- args = [(Nolabel, _lhs); (Nolabel, _rhs)];
+ args = [(Nolabel, _, _lhs); (Nolabel, _, _rhs)];
};
}
when is_binary_operator sub_operator ->
@@ -531,7 +533,7 @@ let should_indent_binary_expr expr =
Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
- args = [(Nolabel, lhs); (Nolabel, _rhs)];
+ args = [(Nolabel, _, lhs); (Nolabel, _, _)];
};
}
when is_binary_operator operator ->
@@ -644,7 +646,7 @@ let is_template_literal expr =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}};
- args = [(Nolabel, _); (Nolabel, _)];
+ args = [(Nolabel, _, _); (Nolabel, _, _)];
}
when has_template_literal_attr expr.pexp_attributes ->
true
@@ -715,7 +717,7 @@ let is_single_pipe_expr expr =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}};
- args = [(Nolabel, _operand1); (Nolabel, _operand2)];
+ args = [(Nolabel, _, _operand1); (Nolabel, _, _operand2)];
} ->
true
| _ -> false
@@ -724,7 +726,7 @@ let is_single_pipe_expr expr =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}};
- args = [(Nolabel, operand1); (Nolabel, _operand2)];
+ args = [(Nolabel, _, operand1); (Nolabel, _, _operand2)];
}
when not (is_pipe_expr operand1) ->
true
diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml
index 9b4e4c358b..0d3a3d5569 100644
--- a/compiler/syntax/src/res_printer.ml
+++ b/compiler/syntax/src/res_printer.ml
@@ -3150,11 +3150,11 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl =
| extension ->
print_extension ~state ~at_module_lvl:false extension cmt_tbl)
| Pexp_apply
- {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]}
+ {funct = e; args = [(Nolabel, _, {pexp_desc = Pexp_array sub_lists})]}
when ParsetreeViewer.is_spread_belt_array_concat e ->
print_belt_array_concat_apply ~state sub_lists cmt_tbl
| Pexp_apply
- {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]}
+ {funct = e; args = [(Nolabel, _, {pexp_desc = Pexp_array sub_lists})]}
when ParsetreeViewer.is_spread_belt_list_concat e ->
print_belt_list_concat_apply ~state sub_lists cmt_tbl
| Pexp_apply {funct = call_expr; args} ->
@@ -3558,7 +3558,7 @@ and print_template_literal ~state expr cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}};
- args = [(Nolabel, arg1); (Nolabel, arg2)];
+ args = [(Nolabel, _, arg1); (Nolabel, _, arg2)];
} ->
let lhs = walk_expr arg1 in
let rhs = walk_expr arg2 in
@@ -3589,8 +3589,8 @@ and print_tagged_template_literal ~state call_expr args cmt_tbl =
let strings_list, values_list =
match args with
| [
- (_, {Parsetree.pexp_desc = Pexp_array strings});
- (_, {Parsetree.pexp_desc = Pexp_array values});
+ (_, _, {Parsetree.pexp_desc = Pexp_array strings});
+ (_, _, {Parsetree.pexp_desc = Pexp_array values});
] ->
(strings, values)
| _ -> assert false
@@ -3647,7 +3647,7 @@ and print_unary_expression ~state expr cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
- args = [(Nolabel, operand)];
+ args = [(Nolabel, _, operand)];
} ->
let printed_operand =
let doc = print_expression_with_comments ~state operand cmt_tbl in
@@ -3685,7 +3685,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl =
Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
- args = [(_, left); (_, right)];
+ args = [(_, _, left); (_, _, right)];
};
} ->
if
@@ -3792,7 +3792,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"; loc}};
- args = [(Nolabel, _); (Nolabel, _)];
+ args = [(Nolabel, _, _); (Nolabel, _, _)];
}
when loc.loc_ghost ->
let doc = print_template_literal ~state expr cmt_tbl in
@@ -3806,7 +3806,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}};
- args = [(Nolabel, lhs); (Nolabel, rhs)];
+ args = [(Nolabel, _, lhs); (Nolabel, _, rhs)];
} ->
let rhs_doc = print_expression_with_comments ~state rhs cmt_tbl in
let lhs_doc = print_expression_with_comments ~state lhs cmt_tbl in
@@ -3847,7 +3847,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl =
{
pexp_desc = Pexp_ident {txt = Longident.Lident (("->" | "|>") as op)};
};
- args = [(Nolabel, lhs); (Nolabel, rhs)];
+ args = [(Nolabel, _, lhs); (Nolabel, _, rhs)];
}
when not
(ParsetreeViewer.is_binary_expression lhs
@@ -3873,7 +3873,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}};
- args = [(Nolabel, lhs); (Nolabel, rhs)];
+ args = [(Nolabel, _, lhs); (Nolabel, _, rhs)];
} ->
let is_multiline =
lhs.pexp_loc.loc_start.pos_lnum < rhs.pexp_loc.loc_start.pos_lnum
@@ -4045,7 +4045,7 @@ and print_pexp_apply ~state expr cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}};
- args = [(Nolabel, parent_expr); (Nolabel, member_expr)];
+ args = [(Nolabel, _, parent_expr); (Nolabel, _, member_expr)];
} ->
let parent_doc =
let doc = print_expression_with_comments ~state parent_expr cmt_tbl in
@@ -4077,7 +4077,7 @@ and print_pexp_apply ~state expr cmt_tbl =
| Pexp_apply
{
funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}};
- args = [(Nolabel, lhs); (Nolabel, rhs)];
+ args = [(Nolabel, _, lhs); (Nolabel, _, rhs)];
} -> (
let rhs_doc =
let doc = print_expression_with_comments ~state rhs cmt_tbl in
@@ -4114,7 +4114,7 @@ and print_pexp_apply ~state expr cmt_tbl =
Pexp_ident
{txt = Longident.Ldot (Lident "Primitive_dict", "make")};
};
- args = [(Nolabel, key_values)];
+ args = [(Nolabel, _, key_values)];
}
when Res_parsetree_viewer.is_tuple_array key_values ->
Doc.concat
@@ -4129,7 +4129,7 @@ and print_pexp_apply ~state expr cmt_tbl =
{
pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")};
};
- args = [(Nolabel, parent_expr); (Nolabel, member_expr)];
+ args = [(Nolabel, _, parent_expr); (Nolabel, _, member_expr)];
}
when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr)
->
@@ -4176,9 +4176,9 @@ and print_pexp_apply ~state expr cmt_tbl =
};
args =
[
- (Nolabel, parent_expr);
- (Nolabel, member_expr);
- (Nolabel, target_expr);
+ (Nolabel, _, parent_expr);
+ (Nolabel, _, member_expr);
+ (Nolabel, _, target_expr);
];
} ->
let member =
@@ -4250,7 +4250,8 @@ and print_pexp_apply ~state expr cmt_tbl =
| Pexp_apply {funct = call_expr; args; partial} ->
let args =
List.map
- (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewrite_underscore_apply arg))
+ (fun (lbl, _, arg) ->
+ (lbl, ParsetreeViewer.rewrite_underscore_apply arg))
args
in
let attrs = expr.pexp_attributes in
@@ -4509,8 +4510,9 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option =
match args with
| [] -> (Doc.nil, None)
| [
- (Asttypes.Labelled "children", children);
+ (Asttypes.Labelled "children", _, children);
( Asttypes.Nolabel,
+ _,
{
Parsetree.pexp_desc =
Pexp_construct ({txt = Longident.Lident "()"}, None);
@@ -4518,10 +4520,11 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option =
] ->
let doc = if is_self_closing children then Doc.line else Doc.nil in
(doc, Some children)
- | ((_, expr) as last_prop)
+ | ((_, lbl_loc, expr) as last_prop)
:: [
- (Asttypes.Labelled "children", children);
+ (Asttypes.Labelled "children", _, children);
( Asttypes.Nolabel,
+ _,
{
Parsetree.pexp_desc =
Pexp_construct ({txt = Longident.Lident "()"}, None);
@@ -4530,6 +4533,7 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option =
let loc =
match expr.Parsetree.pexp_attributes with
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs ->
+ let _ = assert (loc = lbl_loc) in
{loc with loc_end = expr.pexp_loc.loc_end}
| _ -> expr.pexp_loc
in
@@ -4563,12 +4567,14 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option =
and print_jsx_prop ~state arg cmt_tbl =
match arg with
| ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl),
+ lbl_loc,
{
Parsetree.pexp_attributes =
[({Location.txt = "res.namedArgLoc"; loc = arg_loc}, _)];
pexp_desc = Pexp_ident {txt = Longident.Lident ident};
} )
when lbl_txt = ident (* jsx punning *) -> (
+ let () = assert (arg_loc = lbl_loc) in
match lbl with
| Nolabel -> Doc.nil
| Labelled _lbl -> print_comments (print_ident_like ident) cmt_tbl arg_loc
@@ -4576,6 +4582,7 @@ and print_jsx_prop ~state arg cmt_tbl =
let doc = Doc.concat [Doc.question; print_ident_like ident] in
print_comments doc cmt_tbl arg_loc)
| ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl),
+ _,
{
Parsetree.pexp_attributes = [];
pexp_desc = Pexp_ident {txt = Longident.Lident ident};
@@ -4585,13 +4592,14 @@ and print_jsx_prop ~state arg cmt_tbl =
| Nolabel -> Doc.nil
| Labelled _lbl -> print_ident_like ident
| Optional _lbl -> Doc.concat [Doc.question; print_ident_like ident])
- | Asttypes.Labelled "_spreadProps", expr ->
+ | Asttypes.Labelled "_spreadProps", _, expr ->
let doc = print_expression_with_comments ~state expr cmt_tbl in
Doc.concat [Doc.lbrace; Doc.dotdotdot; doc; Doc.rbrace]
- | lbl, expr ->
+ | lbl, lbl_loc, expr ->
let arg_loc, expr =
match expr.pexp_attributes with
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs ->
+ assert (loc = lbl_loc);
(loc, {expr with pexp_attributes = attrs})
| _ -> (Location.none, expr)
in