Skip to content

Commit

Permalink
Add merge visible and hidden load_path when migrating to 5.1
Browse files Browse the repository at this point in the history
Signed-off-by: Nathan Rebours <[email protected]>
  • Loading branch information
NathanReb committed Feb 21, 2024
1 parent 6143433 commit 756429e
Show file tree
Hide file tree
Showing 3 changed files with 44 additions and 24 deletions.
33 changes: 15 additions & 18 deletions astlib/migrate_501_502.ml
Original file line number Diff line number Diff line change
Expand Up @@ -17,26 +17,23 @@ let extract_attr name (attrs : Ast_501.Parsetree.attributes) =

let migrate_ppx_context_load_path expr =
let open Ast_501.Parsetree in
let visible = { expr with pexp_attributes = [] } in
let payload, other_attrs =
extract_attr "ppxlib.migration.hidden_load_path" expr.pexp_attributes
extract_attr "ppxlib.migration.load_path" expr.pexp_attributes
in
let hidden =
match payload with
| None ->
(* An empty list *)
let pexp_desc =
Pexp_construct ({ txt = Lident "[]"; loc = expr.pexp_loc }, None)
in
{ expr with pexp_desc; pexp_attributes = [] }
| Some (PStr [ { pstr_desc = Pstr_eval (expr, []); _ } ]) -> expr
| Some _ -> invalid_arg "Invalid ppxlib.migration.hidden_load_path paylaod"
in
{
expr with
pexp_attributes = other_attrs;
pexp_desc = Pexp_tuple [ visible; hidden ];
}
match payload with
| None ->
let pexp_desc =
Pexp_construct ({ txt = Lident "[]"; loc = expr.pexp_loc }, None)
in
let hidden = { expr with pexp_desc; pexp_attributes = [] } in
let visible = expr in
{
expr with
pexp_attributes = other_attrs;
pexp_desc = Pexp_tuple [ visible; hidden ];
}
| Some (PStr [ { pstr_desc = Pstr_eval (expr, []); _ } ]) -> expr
| Some _ -> invalid_arg "Invalid ppxlib.migration.load_path paylaod"

let migrate_ppx_context_fields fields =
List.map
Expand Down
33 changes: 28 additions & 5 deletions astlib/migrate_502_501.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,21 +13,44 @@ let mk_ghost_attr name =
attr_loc = Location.none;
}

let rec concat_list_lit left right =
let open Ast_502.Parsetree in
let open Ast_502.Asttypes in
match (left.pexp_desc, right.pexp_desc) with
| _, Pexp_construct ({ txt = Lident "[]"; _ }, _) -> left
| Pexp_construct ({ txt = Lident "[]"; _ }, _), _ -> right
| ( Pexp_construct
( { txt = Lident "::"; loc },
Some ({ pexp_desc = Pexp_tuple [ hd; tl ]; _ } as arg_expr) ),
_ ) ->
{
left with
pexp_desc =
Pexp_construct
( { txt = Lident "::"; loc },
Some
{
arg_expr with
pexp_desc = Pexp_tuple [ hd; concat_list_lit tl right ];
} );
}
| _ -> invalid_arg "Invalid ocaml.ppx.context's load_path"

let migrate_ppx_context_load_path expr =
let open Ast_502.Parsetree in
let loc = Location.none in
match expr.pexp_desc with
| Pexp_tuple [ visible; hidden ] ->
let hidden_attr =
let migration_attr =
{
attr_name =
{ Location.txt = "ppxlib.migration.hidden_load_path"; loc };
attr_name = { Location.txt = "ppxlib.migration.load_path"; loc };
attr_loc = loc;
attr_payload =
PStr [ { pstr_loc = loc; pstr_desc = Pstr_eval (hidden, []) } ];
PStr [ { pstr_loc = loc; pstr_desc = Pstr_eval (expr, []) } ];
}
in
{ visible with pexp_attributes = hidden_attr :: expr.pexp_attributes }
let expr' = concat_list_lit visible hidden in
{ expr' with pexp_attributes = migration_attr :: expr.pexp_attributes }
| _ -> expr

let migrate_ppx_context_fields fields =
Expand Down
2 changes: 1 addition & 1 deletion test/driver/ocaml-ppx-context-load-path-migration/run.t
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ the one above.
tool_name: "ocaml";
include_dirs: ["foo"];
hidden_include_dirs: [];
load_path: ["foo"; "bar"];
load_path: ["foo"; "bar"; "baz"];
open_modules: [];
for_package: None;
debug: true;
Expand Down

0 comments on commit 756429e

Please sign in to comment.