From 72d000bffa4d397d1bc4bbff7a6367b9095a1377 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Mon, 16 Mar 2026 16:20:41 +0100 Subject: [PATCH] Expose bare minimum to manually order transformations This should allow users or dune itself to set the order of transformations. It will only impact transformations that define global rewritings, context free rules or other special rewritings won't be impacted by this. Signed-off-by: Nathan Rebours --- src/driver.ml | 5 ++++ src/driver.mli | 5 ++++ .../manual-transforms-order/driver_a_first.ml | 13 ++++++++++ .../manual-transforms-order/driver_b_first.ml | 13 ++++++++++ test/driver/manual-transforms-order/dune | 25 ++++++++++++++++++ .../manual-transforms-order/exp_to_a.ml | 15 +++++++++++ .../manual-transforms-order/exp_to_b.ml | 15 +++++++++++ test/driver/manual-transforms-order/run.t | 26 +++++++++++++++++++ 8 files changed, 117 insertions(+) create mode 100644 test/driver/manual-transforms-order/driver_a_first.ml create mode 100644 test/driver/manual-transforms-order/driver_b_first.ml create mode 100644 test/driver/manual-transforms-order/dune create mode 100644 test/driver/manual-transforms-order/exp_to_a.ml create mode 100644 test/driver/manual-transforms-order/exp_to_b.ml create mode 100644 test/driver/manual-transforms-order/run.t diff --git a/src/driver.ml b/src/driver.ml index 0e67702d..697e51a8 100644 --- a/src/driver.ml +++ b/src/driver.ml @@ -1604,3 +1604,8 @@ let () = Fn.id) (fun ~ctxt:_ items -> Utils.prettify_odoc_attributes#signature items); ] + +type transformation = Transform.t + +let transform_name transform = transform.Transform.name +let all_transforms = Transform.all diff --git a/src/driver.mli b/src/driver.mli index 8ba08cc7..0c04ab96 100644 --- a/src/driver.mli +++ b/src/driver.mli @@ -239,6 +239,11 @@ val pretty : unit -> bool (** If [true], code transformations should avoid generating code that is not strictly necessary, such as extra type annotations. *) +type transformation + +val transform_name : transformation -> string +val all_transforms : transformation list ref + (**/**) val map_structure : structure -> structure diff --git a/test/driver/manual-transforms-order/driver_a_first.ml b/test/driver/manual-transforms-order/driver_a_first.ml new file mode 100644 index 00000000..f9218f15 --- /dev/null +++ b/test/driver/manual-transforms-order/driver_a_first.ml @@ -0,0 +1,13 @@ +open Ppxlib + +let reorder_transforms l = + List.stable_sort + (fun t t' -> + match (Driver.transform_name t, Driver.transform_name t') with + | "exp_to_a", _ -> -1 + | _, "exp_to_a" -> 1 + | _, _ -> 0) + l + +let () = Driver.all_transforms := reorder_transforms !Driver.all_transforms +let () = Driver.standalone () diff --git a/test/driver/manual-transforms-order/driver_b_first.ml b/test/driver/manual-transforms-order/driver_b_first.ml new file mode 100644 index 00000000..7e26ef76 --- /dev/null +++ b/test/driver/manual-transforms-order/driver_b_first.ml @@ -0,0 +1,13 @@ +open Ppxlib + +let reorder_transforms l = + List.stable_sort + (fun t t' -> + match (Driver.transform_name t, Driver.transform_name t') with + | "exp_to_b", _ -> -1 + | _, "exp_to_b" -> 1 + | _, _ -> 0) + l + +let () = Driver.all_transforms := reorder_transforms !Driver.all_transforms +let () = Driver.standalone () diff --git a/test/driver/manual-transforms-order/dune b/test/driver/manual-transforms-order/dune new file mode 100644 index 00000000..d2451f32 --- /dev/null +++ b/test/driver/manual-transforms-order/dune @@ -0,0 +1,25 @@ +(library + (name exp_to_a) + (kind ppx_rewriter) + (modules exp_to_a) + (libraries ppxlib)) + +(library + (name exp_to_b) + (kind ppx_rewriter) + (modules exp_to_b) + (libraries ppxlib)) + +(executable + (name driver_a_first) + (modules driver_a_first) + (libraries ppxlib exp_to_a exp_to_b)) + +(executable + (name driver_b_first) + (modules driver_b_first) + (libraries ppxlib exp_to_a exp_to_b)) + +(cram + (package ppxlib) + (deps driver_a_first.exe driver_b_first.exe)) diff --git a/test/driver/manual-transforms-order/exp_to_a.ml b/test/driver/manual-transforms-order/exp_to_a.ml new file mode 100644 index 00000000..0cd7b2b0 --- /dev/null +++ b/test/driver/manual-transforms-order/exp_to_a.ml @@ -0,0 +1,15 @@ +open Ppxlib + +let mapper = + object + inherit Ast_traverse.map as super + + method! expression_desc ed = + match ed with + | Pexp_extension ({ txt = "exp"; loc }, PStr []) -> + Pexp_ident { txt = Lident "a"; loc } + | _ -> super#expression_desc ed + end + +let impl str = mapper#structure str +let () = Driver.register_transformation ~impl "exp_to_a" diff --git a/test/driver/manual-transforms-order/exp_to_b.ml b/test/driver/manual-transforms-order/exp_to_b.ml new file mode 100644 index 00000000..887ab3e2 --- /dev/null +++ b/test/driver/manual-transforms-order/exp_to_b.ml @@ -0,0 +1,15 @@ +open Ppxlib + +let mapper = + object + inherit Ast_traverse.map as super + + method! expression_desc ed = + match ed with + | Pexp_extension ({ txt = "exp"; loc }, PStr []) -> + Pexp_ident { txt = Lident "b"; loc } + | _ -> super#expression_desc ed + end + +let impl str = mapper#structure str +let () = Driver.register_transformation ~impl "exp_to_b" diff --git a/test/driver/manual-transforms-order/run.t b/test/driver/manual-transforms-order/run.t new file mode 100644 index 00000000..f7c85b06 --- /dev/null +++ b/test/driver/manual-transforms-order/run.t @@ -0,0 +1,26 @@ +This test is here to ensure that the very minimal API we provide to ensure +users can eventually custromize the order of global transformations (i.e. +structure -> structure and signature -> signature) does work as intended. + +For this test we have two different ppx-es: exp_to_a and exp_to_b which both +rewrite the same [%exp] into either a or b. + +We have two different drivers, both of them have both ppx-es linked but one +reorders transformations to ensure exp_to_a is first in the list and the other +that exp_to_b is first. + +If we consider the following ml file: + + $ cat > test.ml << EOF + > let x = [%exp] + > EOF + +If we run the driver with exp_to_a first: + + $ ./driver_a_first.exe test.ml + let x = a + +And the one with exp_to_b first: + + $ ./driver_b_first.exe test.ml + let x = b