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

trunk-support supports trunk #451

Merged
merged 6 commits into from
Dec 15, 2023
Merged

trunk-support supports trunk #451

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
ff95254
Preliminary support for 502 parsetree changes
panglesd Aug 1, 2023
4d6a434
Add locations for Pparam
panglesd Aug 3, 2023
a0803d9
51 -> 52 migration for Pexp_function
panglesd Sep 14, 2023
5a051d8
fix ptyp_alias
Dec 4, 2023
fe72922
Add pin-depends for CI to run
panglesd Dec 7, 2023
43a59ee
run tests with trunk
panglesd Dec 8, 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
4 changes: 2 additions & 2 deletions .github/workflows/build.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,7 @@ jobs:

- name: Install ppxlib dependencies
run: |
opam install ./ppxlib.opam --deps-only
opam install ./ppxlib.opam --deps-only --with-test

- name: Show configuration
run: |
Expand All @@ -42,4 +42,4 @@ jobs:
opam list

- name: Build the ppxlib
run: opam exec -- dune build -p ppxlib
run: opam exec -- dune test -p ppxlib
116 changes: 83 additions & 33 deletions astlib/ast_502.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ module Parsetree = struct
- [T #tconstr] when [l=[T]],
- [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]].
*)
| Ptyp_alias of core_type * string (** [T as 'a]. *)
| Ptyp_alias of core_type * string loc (** [T as 'a]. *)
| Ptyp_variant of row_field list * closed_flag * label list option
(** [Ptyp_variant([`A;`B], flag, labels)] represents:
- [[ `A|`B ]]
Expand Down Expand Up @@ -192,6 +192,7 @@ module Parsetree = struct
{!value_description}.
*)
| Ptyp_package of package_type (** [(module S)]. *)
| Ptyp_open of Longident.t loc * core_type (** [M.(T)] *)
| Ptyp_extension of extension (** [[%id]]. *)

and package_type = Longident.t loc * (Longident.t loc * core_type) list
Expand Down Expand Up @@ -322,41 +323,30 @@ module Parsetree = struct
- [let rec P1 = E1 and ... and Pn = EN in E]
when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
*)
| Pexp_function of case list (** [function P1 -> E1 | ... | Pn -> En] *)
| Pexp_fun of arg_label * expression option * pattern * expression
(** [Pexp_fun(lbl, exp0, P, E1)] represents:
- [fun P -> E1]
when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
and [exp0] is [None]
- [fun ~l:P -> E1]
when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
and [exp0] is [None]
- [fun ?l:P -> E1]
when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
and [exp0] is [None]
- [fun ?l:(P = E0) -> E1]
when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
and [exp0] is [Some E0]

Notes:
- If [E0] is provided, only
{{!Asttypes.arg_label.Optional}[Optional]} is allowed.
- [fun P1 P2 .. Pn -> E1] is represented as nested
{{!expression_desc.Pexp_fun}[Pexp_fun]}.
- [let f P = E] is represented using
{{!expression_desc.Pexp_fun}[Pexp_fun]}.
*)
| Pexp_function of
function_param list * type_constraint option * function_body
(** [Pexp_function ([P1; ...; Pn], C, body)] represents any construct
involving [fun] or [function], including:
- [fun P1 ... Pn -> E]
when [body = Pfunction_body E]
- [fun P1 ... Pn -> function p1 -> e1 | ... | pm -> em]
when [body = Pfunction_cases [ p1 -> e1; ...; pm -> em ]]
[C] represents a type constraint or coercion placed immediately before the
arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)].
A function must have parameters. [Pexp_function (params, _, body)] must
have non-empty [params] or a [Pfunction_cases _] body.
*)
| Pexp_apply of expression * (arg_label * expression) list
(** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
represents [E0 ~l1:E1 ... ~ln:En]
(** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
represents [E0 ~l1:E1 ... ~ln:En]

[li] can be
{{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument),
{{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or
{{!Asttypes.arg_label.Optional}[Optional]} (optional argument).
[li] can be
{{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument),
{{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or
{{!Asttypes.arg_label.Optional}[Optional]} (optional argument).

Invariant: [n > 0]
*)
Invariant: [n > 0]
*)
| Pexp_match of expression * case list
(** [match E0 with P1 -> E1 | ... | Pn -> En] *)
| Pexp_try of expression * case list
Expand Down Expand Up @@ -466,6 +456,66 @@ module Parsetree = struct
pbop_loc : Location.t;
}

and function_param_desc (*IF_CURRENT = Parsetree.function_param_desc *) =
| Pparam_val of arg_label * expression option * pattern
(** [Pparam_val (lbl, exp0, P)] represents the parameter:
- [P]
when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
and [exp0] is [None]
- [~l:P]
when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
and [exp0] is [None]
- [?l:P]
when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
and [exp0] is [None]
- [?l:(P = E0)]
when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
and [exp0] is [Some E0]

Note: If [E0] is provided, only
{{!Asttypes.arg_label.Optional}[Optional]} is allowed.
*)
| Pparam_newtype of string loc
(** [Pparam_newtype x] represents the parameter [(type x)].
[x] carries the location of the identifier, whereas the [pparam_loc]
on the enclosing [function_param] node is the location of the [(type x)]
as a whole.

Multiple parameters [(type a b c)] are represented as multiple
[Pparam_newtype] nodes, let's say:

{[ [ { pparam_kind = Pparam_newtype a; pparam_loc = loc1 };
{ pparam_kind = Pparam_newtype b; pparam_loc = loc2 };
{ pparam_kind = Pparam_newtype c; pparam_loc = loc3 };
]
]}

Here, the first loc [loc1] is the location of [(type a b c)], and the
subsequent locs [loc2] and [loc3] are the same as [loc1], except marked as
ghost locations. The locations on [a], [b], [c], correspond to the
variables [a], [b], and [c] in the source code.
*)

and function_param (*IF_CURRENT = Parsetree.function_param *) =
{ pparam_loc : Location.t;
pparam_desc : function_param_desc;
}

and function_body (*IF_CURRENT = Parsetree.function_body *) =
| Pfunction_body of expression
| Pfunction_cases of case list * Location.t * attributes
(** In [Pfunction_cases (_, loc, attrs)], the location extends from the
start of the [function] keyword to the end of the last case. The compiler
will only use typechecking-related attributes from [attrs], e.g. enabling
or disabling a warning.
*)
(** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)

and type_constraint (*IF_CURRENT = Parsetree.type_constraint *) =
| Pconstraint of core_type
| Pcoerce of core_type option * core_type
(** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)

(** {2 Value descriptions} *)

and value_description (*IF_CURRENT = Parsetree.value_description *) =
Expand Down
107 changes: 96 additions & 11 deletions astlib/migrate_501_502.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,18 @@ open Stdlib0
module From = Ast_501
module To = Ast_502

(** Look for a particular attribute and remove it from the list. Attributes are
used to make certain migrations round-trip. Returns [None] if the specified
attribute is not found. *)
let extract_attr name (attrs : Ast_501.Parsetree.attributes) =
let rec loop acc = function
| [] -> (false, List.rev acc)
| { Ast_501.Parsetree.attr_name = { txt; _ }; _ } :: q when txt = name ->
(true, List.rev_append acc q)
| hd :: tl -> loop (hd :: acc) tl
in
loop [] attrs

let rec copy_toplevel_phrase :
Ast_501.Parsetree.toplevel_phrase -> Ast_502.Parsetree.toplevel_phrase =
function
Expand Down Expand Up @@ -51,14 +63,15 @@ and copy_expression :
Ast_501.Parsetree.pexp_loc_stack;
Ast_501.Parsetree.pexp_attributes;
} ->
let pexp_loc = copy_location pexp_loc in
{
Ast_502.Parsetree.pexp_desc = copy_expression_desc pexp_desc;
Ast_502.Parsetree.pexp_loc = copy_location pexp_loc;
Ast_502.Parsetree.pexp_desc = copy_expression_desc pexp_loc pexp_desc;
Ast_502.Parsetree.pexp_loc;
Ast_502.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack;
Ast_502.Parsetree.pexp_attributes = copy_attributes pexp_attributes;
}

and copy_expression_desc :
and copy_expression_desc loc :
Ast_501.Parsetree.expression_desc -> Ast_502.Parsetree.expression_desc =
function
| Ast_501.Parsetree.Pexp_ident x0 ->
Expand All @@ -69,13 +82,85 @@ and copy_expression_desc :
Ast_502.Parsetree.Pexp_let
(copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2)
| Ast_501.Parsetree.Pexp_function x0 ->
Ast_502.Parsetree.Pexp_function (List.map copy_case x0)
| Ast_501.Parsetree.Pexp_fun (x0, x1, x2, x3) ->
Ast_502.Parsetree.Pexp_fun
( copy_arg_label x0,
Option.map copy_expression x1,
copy_pattern x2,
copy_expression x3 )
Ast_502.Parsetree.Pexp_function
( [],
None,
Ast_502.Parsetree.Pfunction_cases (List.map copy_case x0, loc, []) )
| Ast_501.Parsetree.Pexp_fun (arg_label, opt_default, pat, expr) ->
let take_body (e : Ast_501.Parsetree.expression) =
match e.pexp_desc with
| Ast_501.Parsetree.Pexp_function case_list ->
Ast_502.Parsetree.Pfunction_cases
( List.map copy_case case_list,
e.pexp_loc,
copy_attributes e.pexp_attributes )
| _ -> Ast_502.Parsetree.Pfunction_body (copy_expression e)
in
let rec take_arguments acc (e : Ast_501.Parsetree.expression) =
if e.pexp_attributes <> [] then
(* The attribute list is not empty, none of these nodes could have
been created by the downward migration. Except for [Pexp_fun], for
which we add a ghost attribute to help us roundtrip. *)
let _, attrs =
extract_attr "ppxlib.migration.stop_taking" e.pexp_attributes
in
( acc,
None,
Ast_502.Parsetree.Pfunction_body
(copy_expression { e with pexp_attributes = attrs }) )
else
(* These nodes are likely to have been synthetized during the
downward migration. *)
match e.pexp_desc with
| Ast_501.Parsetree.Pexp_fun (arg_label, opt_default, pat, expr) ->
take_arguments_fun acc arg_label opt_default pat expr
| Ast_501.Parsetree.Pexp_newtype (t, expr) ->
let acc =
{
Ast_502.Parsetree.pparam_loc = t.loc;
pparam_desc = Pparam_newtype t;
}
:: acc
in
take_arguments acc expr
| Ast_501.Parsetree.Pexp_constraint (exp, ct) ->
(* These two expression are represented the same on 5.1 but
differently on 5.2:
{[
let _ = fun x : (_ -> int) -> fun y -> x+y
let _ = fun x -> ((fun y -> x+y) : _ -> int)
]}
We normalize the second into the first when migrating to 5.2,
making the migration 5.2->5.1->5.2 not roundtrip but hopefully
without change in semantics. *)
let ct =
Some (Ast_502.Parsetree.Pconstraint (copy_core_type ct))
in
(acc, ct, take_body exp)
| Ast_501.Parsetree.Pexp_coerce (exp, c1, c2) ->
(* Same as above, might not roundtrip but hopefully OK. *)
let c1 = Option.map copy_core_type c1
and c2 = copy_core_type c2 in
(acc, Some (Ast_502.Parsetree.Pcoerce (c1, c2)), take_body e)
| _ -> (acc, None, take_body e)
and take_arguments_fun acc arg_label opt_default pat expr =
let acc =
let pparam_desc =
Ast_502.Parsetree.Pparam_val
( copy_arg_label arg_label,
Option.map copy_expression opt_default,
copy_pattern pat )
in
(* Best-effort location. *)
{ Ast_502.Parsetree.pparam_loc = pat.ppat_loc; pparam_desc } :: acc
in
take_arguments acc expr
in
(* The argument list returned by [take_arguments] is reversed *)
let arg_list, type_constraint, body =
take_arguments_fun [] arg_label opt_default pat expr
in
Ast_502.Parsetree.Pexp_function (List.rev arg_list, type_constraint, body)
| Ast_501.Parsetree.Pexp_apply (x0, x1) ->
Ast_502.Parsetree.Pexp_apply
( copy_expression x0,
Expand Down Expand Up @@ -355,7 +440,7 @@ and copy_core_type_desc :
Ast_502.Parsetree.Ptyp_class
(copy_loc copy_Longident_t x0, List.map copy_core_type x1)
| Ast_501.Parsetree.Ptyp_alias (x0, x1) ->
Ast_502.Parsetree.Ptyp_alias (copy_core_type x0, x1)
Ast_502.Parsetree.Ptyp_alias (copy_core_type x0, { Ast_502.Asttypes.txt = x1; loc = x0.ptyp_loc } )
| Ast_501.Parsetree.Ptyp_variant (x0, x1, x2) ->
Ast_502.Parsetree.Ptyp_variant
( List.map copy_row_field x0,
Expand Down
Loading
Loading