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

Expand structure and signature items before applying attribute rules #279

Merged
merged 1 commit into from
Sep 14, 2021
Merged

Expand structure and signature items before applying attribute rules #279

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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: 4 additions & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,10 @@
unreleased
----------

- Expand nodes before applying derivers or other inline attributes based
transformation, allowing better interactions between extensions and
derivers (#279, @NathanReb)

0.23.0 (31/08/2021)
-------------------

Expand Down
4 changes: 4 additions & 0 deletions HISTORY.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -545,3 +545,7 @@ generates new structure or signature items based on the value of an item
with that attribute attached. This rule is applied before the item has been
transformed meaning the input of the expander function might contain "wrong"
information.
*Note that this behaviour was changed in
[#279](https://github.com/ocaml-ppx/ppxlib/pull/279) and that nodes are now
expanded before derivers and other attributes-based inline code generation rules
are applied*
190 changes: 96 additions & 94 deletions src/context_free.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -550,7 +550,6 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
method! structure base_ctxt st =
let rec with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code =
let item = super#structure_item base_ctxt item in
let extra_items =
loop (rev_concat extra_items) ~in_generated_code:true
in
Expand Down Expand Up @@ -592,60 +591,61 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
Generated_code_hook.replace hook Structure_item
item.pstr_loc (Many items);
items @ loop rest ~in_generated_code)
| Pstr_type (rf, tds) ->
let extra_items =
handle_attr_group_inline attr_str_type_decls rf tds ~loc
~base_ctxt
in
let expect_items =
handle_attr_group_inline attr_str_type_decls_expect rf tds
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_modtype mtd ->
let extra_items =
handle_attr_inline attr_str_module_type_decls mtd ~loc
~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_module_type_decls_expect mtd ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_typext te ->
let extra_items =
handle_attr_inline attr_str_type_exts te ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_type_exts_expect te ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_exception ec ->
let extra_items =
handle_attr_inline attr_str_exceptions ec ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_exceptions_expect ec ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| _ ->
let item = self#structure_item base_ctxt item in
let rest = self#structure base_ctxt rest in
item :: rest)
| _ -> (
let item = super#structure_item base_ctxt item in
match item.pstr_desc with
| Pstr_type (rf, tds) ->
let extra_items =
handle_attr_group_inline attr_str_type_decls rf tds ~loc
~base_ctxt
in
let expect_items =
handle_attr_group_inline attr_str_type_decls_expect rf tds
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_modtype mtd ->
let extra_items =
handle_attr_inline attr_str_module_type_decls mtd ~loc
~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_module_type_decls_expect mtd
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_typext te ->
let extra_items =
handle_attr_inline attr_str_type_exts te ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_type_exts_expect te ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Pstr_exception ec ->
let extra_items =
handle_attr_inline attr_str_exceptions ec ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_str_exceptions_expect ec ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| _ ->
let rest = self#structure base_ctxt rest in
item :: rest))
in
loop st ~in_generated_code:false

(*$ str_to_sig _last_text_block *)
method! signature base_ctxt sg =
let rec with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code =
let item = super#signature_item base_ctxt item in
let extra_items =
loop (rev_concat extra_items) ~in_generated_code:true
in
Expand Down Expand Up @@ -687,52 +687,54 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
Generated_code_hook.replace hook Signature_item
item.psig_loc (Many items);
items @ loop rest ~in_generated_code)
| Psig_type (rf, tds) ->
let extra_items =
handle_attr_group_inline attr_sig_type_decls rf tds ~loc
~base_ctxt
in
let expect_items =
handle_attr_group_inline attr_sig_type_decls_expect rf tds
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_modtype mtd ->
let extra_items =
handle_attr_inline attr_sig_module_type_decls mtd ~loc
~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_module_type_decls_expect mtd ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_typext te ->
let extra_items =
handle_attr_inline attr_sig_type_exts te ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_type_exts_expect te ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_exception ec ->
let extra_items =
handle_attr_inline attr_sig_exceptions ec ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_exceptions_expect ec ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| _ ->
let item = self#signature_item base_ctxt item in
let rest = self#signature base_ctxt rest in
item :: rest)
| _ -> (
let item = super#signature_item base_ctxt item in
match item.psig_desc with
| Psig_type (rf, tds) ->
let extra_items =
handle_attr_group_inline attr_sig_type_decls rf tds ~loc
~base_ctxt
in
let expect_items =
handle_attr_group_inline attr_sig_type_decls_expect rf tds
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_modtype mtd ->
let extra_items =
handle_attr_inline attr_sig_module_type_decls mtd ~loc
~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_module_type_decls_expect mtd
~loc ~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_typext te ->
let extra_items =
handle_attr_inline attr_sig_type_exts te ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_type_exts_expect te ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| Psig_exception ec ->
let extra_items =
handle_attr_inline attr_sig_exceptions ec ~loc ~base_ctxt
in
let expect_items =
handle_attr_inline attr_sig_exceptions_expect ec ~loc
~base_ctxt
in
with_extra_items item ~extra_items ~expect_items ~rest
~in_generated_code
| _ ->
let rest = self#signature base_ctxt rest in
item :: rest))
in
loop sg ~in_generated_code:false

Expand Down
11 changes: 6 additions & 5 deletions test/extensions_and_deriving/test.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,14 +128,15 @@ let () = Driver.register_transformation ~rules:[id] "id"
val id : Context_free.Rule.t = <abstr>
|}]

(* At the time of writing this test, attribute rules are applied before
expanding the node they're attached to. That seems slightly wrong as
it's likely that expander function doesn't expect to find uninterpreted
extensions in its input. *)
(* Nodes with attributes are expanded before attribute-based, inline
code generation rules are applied.
In this below, the `[[%id: int]]` is interpreted before the deriver
is applied, meaning it can't see this extension point in its expand
function argument. *)
type t = [%id: int]
[@@deriving derived]

[%%expect{|
type t = int
val derived_t : string = "uninterpreted extension in input"
val derived_t : string = "ok"
|}]