Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Experiment with storing the location of function named arguments in t… #7247

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 6 additions & 2 deletions compiler/frontend/ast_compatible.ml
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,7 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp =
Pexp_fun
{
arg_label = Nolabel;
label_loc = Location.none;
default = None;
lhs = pat;
rhs = exp;
Expand Down Expand Up @@ -125,14 +126,17 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn
let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type
=
{
ptyp_desc = Ptyp_arrow {lbl = Labelled s; arg; ret; arity};
ptyp_desc =
Ptyp_arrow {lbl = Labelled s; lbl_loc = Location.none; arg; ret; arity};
ptyp_loc = loc;
ptyp_attributes = attrs;
}

let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type =
{
ptyp_desc = Ptyp_arrow {lbl = Asttypes.Optional s; arg; ret; arity};
ptyp_desc =
Ptyp_arrow
{lbl = Asttypes.Optional s; lbl_loc = Location.none; arg; ret; arity};
ptyp_loc = loc;
ptyp_attributes = attrs;
}
Expand Down
10 changes: 9 additions & 1 deletion compiler/frontend/ast_core_type.ml
Original file line number Diff line number Diff line change
Expand Up @@ -142,7 +142,15 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t =
Ext_list.fold_right new_arg_types_ty result
(fun {label; ty; attr; loc} acc ->
{
ptyp_desc = Ptyp_arrow {lbl = label; arg = ty; ret = acc; arity = None};
ptyp_desc =
Ptyp_arrow
{
lbl = label;
lbl_loc = Location.none;
arg = ty;
ret = acc;
arity = None;
};
ptyp_loc = loc;
ptyp_attributes = attr;
})
Expand Down
19 changes: 14 additions & 5 deletions compiler/frontend/bs_ast_mapper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -101,8 +101,9 @@ module T = struct
match desc with
| Ptyp_any -> any ~loc ~attrs ()
| Ptyp_var s -> var ~loc ~attrs s
| Ptyp_arrow {lbl; arg; ret; arity} ->
arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
| Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} ->
arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg)
(sub.typ sub ret)
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
| Ptyp_constr (lid, tl) ->
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
Expand Down Expand Up @@ -311,9 +312,17 @@ module E = struct
sub vbs)
(sub.expr sub e)
(* #end *)
| Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
->
fun_ ~loc ~attrs ~arity ~async lab
| Pexp_fun
{
arg_label = lab;
label_loc;
default = def;
lhs = p;
rhs = e;
arity;
async;
} ->
fun_ ~loc ~attrs ~label_loc ~arity ~async lab
(map_opt (sub.expr sub) def)
(sub.pat sub p) (sub.expr sub e)
| Pexp_apply {funct = e; args = l; partial} ->
Expand Down
14 changes: 8 additions & 6 deletions compiler/ml/ast_helper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,8 +54,8 @@ module Typ = struct

let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any
let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a)
let arrow ?loc ?attrs ~arity lbl arg ret =
mk ?loc ?attrs (Ptyp_arrow {lbl; arg; ret; arity})
let arrow ?loc ?attrs ?(label_loc = Location.none) ~arity lbl arg ret =
mk ?loc ?attrs (Ptyp_arrow {lbl; lbl_loc = label_loc; arg; ret; arity})
let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
Expand All @@ -82,8 +82,8 @@ module Typ = struct
| Ptyp_var x ->
check_variable var_names t.ptyp_loc x;
Ptyp_var x
| Ptyp_arrow {lbl = label; arg; ret; arity = a} ->
Ptyp_arrow {lbl = label; arg = loop arg; ret = loop ret; arity = a}
| Ptyp_arrow ({arg; ret} as arr) ->
Ptyp_arrow {arr with arg = loop arg; ret = loop ret}
| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
| Ptyp_constr ({txt = Longident.Lident s}, []) when List.mem s var_names
->
Expand Down Expand Up @@ -151,9 +151,11 @@ module Exp = struct
let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a)
let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a)
let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c))
let fun_ ?loc ?attrs ?(async = false) ~arity a b c d =
let fun_ ?loc ?attrs ?(async = false) ?(label_loc = Location.none) ~arity a b
c d =
mk ?loc ?attrs
(Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity; async})
(Pexp_fun
{arg_label = a; label_loc; default = b; lhs = c; rhs = d; arity; async})
let apply ?loc ?attrs ?(partial = false) funct args =
mk ?loc ?attrs (Pexp_apply {funct; args; partial})
let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b))
Expand Down
2 changes: 2 additions & 0 deletions compiler/ml/ast_helper.mli
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ module Typ : sig
val arrow :
?loc:loc ->
?attrs:attrs ->
?label_loc:loc ->
arity:arity ->
arg_label ->
core_type ->
Expand Down Expand Up @@ -139,6 +140,7 @@ module Exp : sig
?loc:loc ->
?attrs:attrs ->
?async:bool ->
?label_loc:loc ->
arity:int option ->
arg_label ->
expression option ->
Expand Down
19 changes: 14 additions & 5 deletions compiler/ml/ast_mapper.ml
Original file line number Diff line number Diff line change
Expand Up @@ -93,8 +93,9 @@ module T = struct
match desc with
| Ptyp_any -> any ~loc ~attrs ()
| Ptyp_var s -> var ~loc ~attrs s
| Ptyp_arrow {lbl; arg; ret; arity} ->
arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret)
| Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} ->
arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg)
(sub.typ sub ret)
| Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl)
| Ptyp_constr (lid, tl) ->
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
Expand Down Expand Up @@ -274,9 +275,17 @@ module E = struct
| Pexp_constant x -> constant ~loc ~attrs x
| Pexp_let (r, vbs, e) ->
let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e)
| Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async}
->
fun_ ~loc ~attrs ~arity ~async lab
| Pexp_fun
{
arg_label = lab;
label_loc;
default = def;
lhs = p;
rhs = e;
arity;
async;
} ->
fun_ ~loc ~attrs ~label_loc ~arity ~async lab
(map_opt (sub.expr sub) def)
(sub.pat sub p) (sub.expr sub e)
| Pexp_apply {funct = e; args = l; partial} ->
Expand Down
9 changes: 8 additions & 1 deletion compiler/ml/parsetree.ml
Original file line number Diff line number Diff line change
Expand Up @@ -76,7 +76,13 @@ and core_type = {
and core_type_desc =
| Ptyp_any (* _ *)
| Ptyp_var of string (* 'a *)
| Ptyp_arrow of {lbl: arg_label; arg: core_type; ret: core_type; arity: arity}
| Ptyp_arrow of {
lbl: arg_label;
lbl_loc: Location.t;
arg: core_type;
ret: core_type;
arity: arity;
}
(* T1 -> T2 Simple
~l:T1 -> T2 Labelled
?l:T1 -> T2 Optional
Expand Down Expand Up @@ -226,6 +232,7 @@ and expression_desc =
*)
| Pexp_fun of {
arg_label: arg_label;
label_loc: Location.t;
default: expression option;
lhs: pattern;
rhs: expression;
Expand Down
45 changes: 24 additions & 21 deletions compiler/syntax/src/res_comments_table.ml
Original file line number Diff line number Diff line change
Expand Up @@ -168,22 +168,23 @@ let arrow_type ct =
let rec process attrs_before acc typ =
match typ with
| {
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret};
ptyp_attributes = [];
} ->
let arg = ([], lbl, arg) in
let arg = ([], lbl, lbl_loc, arg) in
process attrs_before (arg :: acc) ret
| {
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret};
ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret};
ptyp_attributes = [({txt = "bs"}, _)] as attrs;
} ->
let arg = (attrs, lbl, arg) in
let arg = (attrs, lbl, lbl_loc, arg) in
process attrs_before (arg :: acc) ret
| {ptyp_desc = Ptyp_arrow {lbl = Nolabel}} as return_type ->
let args = List.rev acc in
(attrs_before, args, return_type)
| {ptyp_desc = Ptyp_arrow {lbl; arg; ret}; ptyp_attributes = attrs} ->
let arg = (attrs, lbl, arg) in
| {ptyp_desc = Ptyp_arrow {lbl; lbl_loc; arg; ret}; ptyp_attributes = attrs}
->
let arg = (attrs, lbl, lbl_loc, arg) in
process attrs_before (arg :: acc) ret
| typ -> (attrs_before, List.rev acc, typ)
in
Expand Down Expand Up @@ -263,19 +264,21 @@ let fun_expr expr =
Pexp_fun
{
arg_label = lbl;
label_loc;
default = default_expr;
lhs = pattern;
rhs = return_expr;
};
pexp_attributes = [];
} ->
let parameter = ([], lbl, default_expr, pattern) in
let parameter = ([], lbl, label_loc, default_expr, pattern) in
collect attrs_before (parameter :: acc) return_expr
| {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} ->
let var, return_expr = collect_new_types [string_loc] rest in
let parameter =
( attrs,
Asttypes.Nolabel,
Location.none,
None,
Ast_helper.Pat.var ~loc:string_loc.loc var )
in
Expand All @@ -285,26 +288,28 @@ let fun_expr expr =
Pexp_fun
{
arg_label = lbl;
label_loc;
default = default_expr;
lhs = pattern;
rhs = return_expr;
};
pexp_attributes = [({txt = "bs"}, _)] as attrs;
} ->
let parameter = (attrs, lbl, default_expr, pattern) in
let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
collect attrs_before (parameter :: acc) return_expr
| {
pexp_desc =
Pexp_fun
{
arg_label = (Labelled _ | Optional _) as lbl;
label_loc;
default = default_expr;
lhs = pattern;
rhs = return_expr;
};
pexp_attributes = attrs;
} ->
let parameter = (attrs, lbl, default_expr, pattern) in
let parameter = (attrs, lbl, label_loc, default_expr, pattern) in
collect attrs_before (parameter :: acc) return_expr
| expr -> (attrs_before, List.rev acc, expr)
in
Expand Down Expand Up @@ -1446,13 +1451,11 @@ and walk_expression expr t comments =
let comments =
visit_list_but_continue_with_remaining_comments ~newline_delimited:false
~walk_node:walk_expr_pararameter
~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) ->
~get_loc:(fun (_attrs, _argLbl, label_loc, expr_opt, pattern) ->
let open Parsetree in
let start_pos =
match pattern.ppat_attributes with
| ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs ->
loc.loc_start
| _ -> pattern.ppat_loc.loc_start
if label_loc <> Location.none then label_loc.loc_start
else pattern.ppat_loc.loc_start
in
match expr_opt with
| None -> {pattern.ppat_loc with loc_start = start_pos}
Expand Down Expand Up @@ -1493,7 +1496,8 @@ and walk_expression expr t comments =
attach t.trailing return_expr.pexp_loc trailing)
| _ -> ()

and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments =
and walk_expr_pararameter (_attrs, _argLbl, _label_loc, expr_opt, pattern) t
comments =
let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in
attach t.leading pattern.ppat_loc leading;
walk_pattern pattern t inside;
Expand Down Expand Up @@ -1935,15 +1939,14 @@ and walk_object_field field t comments =

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

and walk_type_parameter (_attrs, _lbl, typexpr) t comments =
and walk_type_parameter (_attrs, _lbl, _lbl_loc, typexpr) t comments =
let before_typ, inside_typ, after_typ =
partition_by_loc comments typexpr.ptyp_loc
in
Expand Down
Loading
Loading