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