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.

Sign up for GitHub

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

Jump to bottom

Update trunk AST #407

Merged
merged 4 commits into from
Apr 3, 2023
Merged

Update trunk AST #407

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
c13967e
Update trunk AST
shym Mar 27, 2023
6b9893e
Add migration from 501 to 500
panglesd Mar 28, 2023
8b264bb
Migration 500 to 501
panglesd Mar 28, 2023
4d9b427
Binary AST reader: use latest possible AST version
pitag-ha Mar 29, 2023
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
7 changes: 6 additions & 1 deletion ast/versions.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -587,5 +587,10 @@ module Find_version = struct
else
loop tail
in
loop all_versions
(* Traverse the versions from last to first:
if the magic numbers aren't unique among versions,
we want the latest version with a magic number match.
The situation in mind is trunk support. *)
let all_versions_top_down = List.rev all_versions in
loop all_versions_top_down
end
7 changes: 7 additions & 0 deletions astlib/ast_501.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1031,10 +1031,17 @@ module Parsetree = struct
| Pstr_attribute of attribute (** [[\@\@\@id]] *)
| Pstr_extension of extension * attributes (** [[%%id]] *)

and poly_constraint (*IF_CURRENT = Parsetree.poly_constraint *) =
{
locally_abstract_univars:string loc list;
typ:core_type;
}

and value_binding (*IF_CURRENT = Parsetree.value_binding *) =
{
pvb_pat: pattern;
pvb_expr: expression;
pvb_constraint: poly_constraint option;
pvb_attributes: attributes;
pvb_loc: Location.t;
}
Expand Down
106 changes: 106 additions & 0 deletions astlib/migrate_500_501.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -223,9 +223,115 @@ and copy_value_binding :
Ast_500.Parsetree.pvb_attributes;
Ast_500.Parsetree.pvb_loc;
} ->
(* Copied from OCaml 5.0 Ast_helper *)
let varify_constructors var_names t =
let check_variable vl loc v =
if List.mem v vl then raise Syntaxerr.(Error (Variable_in_scope (loc, v)))
in
let var_names = List.map (fun v -> v.Location.txt) var_names in
let rec loop t =
let desc =
match t.Ast_500.Parsetree.ptyp_desc with
| Ast_500.Parsetree.Ptyp_any -> Ast_500.Parsetree.Ptyp_any
| Ptyp_var x ->
check_variable var_names t.ptyp_loc x;
Ptyp_var x
| Ptyp_arrow (label, core_type, core_type') ->
Ptyp_arrow (label, loop core_type, loop core_type')
| Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
| Ptyp_constr ({ txt = Longident.Lident s }, [])
when List.mem s var_names ->
Ptyp_var s
| Ptyp_constr (longident, lst) ->
Ptyp_constr (longident, List.map loop lst)
| Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o)
| Ptyp_class (longident, lst) ->
Ptyp_class (longident, List.map loop lst)
| Ptyp_alias (core_type, string) ->
check_variable var_names t.ptyp_loc string;
Ptyp_alias (loop core_type, string)
| Ptyp_variant (row_field_list, flag, lbl_lst_option) ->
Ptyp_variant
(List.map loop_row_field row_field_list, flag, lbl_lst_option)
| Ptyp_poly (string_lst, core_type) ->
List.iter
(fun v -> check_variable var_names t.ptyp_loc v.Location.txt)
string_lst;
Ptyp_poly (string_lst, loop core_type)
| Ptyp_package (longident, lst) ->
Ptyp_package
(longident, List.map (fun (n, typ) -> (n, loop typ)) lst)
| Ptyp_extension (s, arg) -> Ptyp_extension (s, arg)
in
{ t with ptyp_desc = desc }
and loop_row_field field =
let prf_desc =
match field.prf_desc with
| Ast_500.Parsetree.Rtag (label, flag, lst) ->
Ast_500.Parsetree.Rtag (label, flag, List.map loop lst)
| Rinherit t -> Rinherit (loop t)
in
{ field with prf_desc }
and loop_object_field field =
let pof_desc =
match field.pof_desc with
| Ast_500.Parsetree.Otag (label, t) ->
Ast_500.Parsetree.Otag (label, loop t)
| Oinherit t -> Oinherit (loop t)
in
{ field with pof_desc }
in
loop t
in
(* Match the form of the expr and pattern to decide the value of
[pvb_constraint]. Adapted from OCaml 5.0 PPrinter. *)
let tyvars_str tyvars = List.map (fun v -> v.Location.txt) tyvars in
let is_desugared_gadt p e =
let gadt_pattern =
match p with
| {
Ast_500.Parsetree.ppat_desc =
Ppat_constraint
( ({ ppat_desc = Ppat_var _ } as pat),
{ ptyp_desc = Ptyp_poly (args_tyvars, rt) } );
ppat_attributes = [];
} ->
Some (pat, args_tyvars, rt)
| _ -> None
in
let rec gadt_exp tyvars e =
match e with
| {
Ast_500.Parsetree.pexp_desc = Pexp_newtype (tyvar, e);
pexp_attributes = [];
} ->
gadt_exp (tyvar :: tyvars) e
| { pexp_desc = Pexp_constraint (e, ct); pexp_attributes = [] } ->
Some (List.rev tyvars, e, ct)
| _ -> None
in
let gadt_exp = gadt_exp [] e in
match (gadt_pattern, gadt_exp) with
| Some (p, pt_tyvars, pt_ct), Some (e_tyvars, e, e_ct)
when tyvars_str pt_tyvars = tyvars_str e_tyvars ->
let ety = varify_constructors e_tyvars e_ct in
if ety = pt_ct then Some (p, pt_tyvars, e_ct, e) else None
| _ -> None
in
let pvb_pat, pvb_expr, pvb_constraint =
match is_desugared_gadt pvb_pat pvb_expr with
| Some (p, ty_vars, typ, e) ->
let typ = copy_core_type typ in
let pvb_constraint =
Some { Ast_501.Parsetree.locally_abstract_univars = ty_vars; typ }
in
(p, e, pvb_constraint)
| None -> (pvb_pat, pvb_expr, None)
in
{
Ast_501.Parsetree.pvb_pat = copy_pattern pvb_pat;
Ast_501.Parsetree.pvb_expr = copy_expression pvb_expr;
Ast_501.Parsetree.pvb_constraint = None;
Ast_501.Parsetree.pvb_attributes = copy_attributes pvb_attributes;
Ast_501.Parsetree.pvb_loc = copy_location pvb_loc;
}
Expand Down
43 changes: 41 additions & 2 deletions astlib/migrate_501_500.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -220,12 +220,51 @@ and copy_value_binding :
fun {
Ast_501.Parsetree.pvb_pat;
Ast_501.Parsetree.pvb_expr;
Ast_501.Parsetree.pvb_constraint;
Ast_501.Parsetree.pvb_attributes;
Ast_501.Parsetree.pvb_loc;
} ->
let pvb_pat = copy_pattern pvb_pat and pvb_expr = copy_expression pvb_expr in
let pvb_pat, pvb_expr =
match pvb_constraint with
| None -> (pvb_pat, pvb_expr)
| Some { locally_abstract_univars; typ } ->
let typ = copy_core_type typ in
let typ_poly =
{
typ with
ptyp_attributes = [];
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why do you remove the attributes here and everywhere else? Are they duplicated, and you're de-duplicating them?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is because my code is misleading... I hesitated writing it like this and probably should not, but the result was shorter... (very bad reason)

I'm actually creating a new node, with the same location value as typ. I'm modifying all other fields (attributes and desc), and as you can see, ptyp is used in desc: so the attributes are just in the original node.

Now that I checked, it seems that some of the locations in the crafted nodes should be "ghosted" to make the test "parsing with 5.1 then migrating to 5.0 == parsing with 5.0" pass. But not all of them...

If there is a convenient way to test this, and get a diff, that would be great!

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Cool, thanks for explaining!

About the locations: to make sure that the migrated parsetree fulfills the two location invariants "non-ghost children are nested" and "non-ghost siblings are disjoint and ordered", you could run a trivial ppxlib driver with -perform_locations_check. With "trivial" driver I mean one with no PPXs linked. However, I think that those two invariants should be fulfilled here anyways. You'll know better than me! I don't think we have more location checks than that.

If there is a convenient way to test this, and get a diff, that would be great!

You might already have thought about the following, but just in case: The following should work I think. You could write a few-liner program using Ppxlib, which parses a file and pprints its ast. Then, to get the "parsing with 5.1 then migrating to 5.0" AST, you can compile that with OCaml trunk and this Ppxlib branch. And for the "parsing with 5.0", you can compile it with OCaml 5.0 and the main Ppxlib branch. Btw, if we want to take more time at some point, it would also be valuable to make a CI job out of this!

(About the "parsing with 5.1 then migrating to 5.0" part: When pprinting an AST, Ppxlib pprints the AST in its Ppxlib version, i.e. currently 5.0/4.14. In my opinion, that's not an ideal choice of ours, but that's a different topic...Also, in this particular situation it comes in nice.)

ptyp_desc =
Ast_500.Parsetree.Ptyp_poly (locally_abstract_univars, typ);
}
in
let pvb_pat =
{
pvb_pat with
ppat_attributes = [];
ppat_desc = Ast_500.Parsetree.Ppat_constraint (pvb_pat, typ_poly);
}
and pvb_expr =
List.fold_left
(fun expr var ->
{
expr with
pexp_attributes = [];
Ast_500.Parsetree.pexp_desc =
Ast_500.Parsetree.Pexp_newtype (var, expr);
})
{
pvb_expr with
pexp_attributes = [];
pexp_desc = Pexp_constraint (pvb_expr, typ);
}
(List.rev locally_abstract_univars)
in
(pvb_pat, pvb_expr)
in
{
Ast_500.Parsetree.pvb_pat = copy_pattern pvb_pat;
Ast_500.Parsetree.pvb_expr = copy_expression pvb_expr;
Ast_500.Parsetree.pvb_pat;
Ast_500.Parsetree.pvb_expr;
Ast_500.Parsetree.pvb_attributes = copy_attributes pvb_attributes;
Ast_500.Parsetree.pvb_loc = copy_location pvb_loc;
}
Expand Down