From dd7b67be6821f73f5463b471f998b5ae94c9013f Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Thu, 5 Dec 2024 17:48:48 +0100 Subject: [PATCH 1/2] Lib_ppx_profiler: Add the possibility to make a ppx opt in for a driver When a ppx attribute has the field `driver_ids = [...]`, it will only be enabled when TEZOS_PPX_PROFILER contains a list of driver_ids and one of these driver ids is in `driver_ids`. Otherwise, the ppx attribute is not preprocessed --- src/lib_ppx_profiler/error.ml | 23 +++++++ src/lib_ppx_profiler/error.mli | 2 + src/lib_ppx_profiler/handled_drivers.ml | 34 +++++++++++ src/lib_ppx_profiler/handled_drivers.mli | 28 +++++++++ src/lib_ppx_profiler/key.ml | 1 + src/lib_ppx_profiler/key.mli | 8 +++ src/lib_ppx_profiler/ppx_profiler.ml | 73 +++++++++++++++------- src/lib_ppx_profiler/rewriter.ml | 77 ++++++++++++++++++++---- src/lib_ppx_profiler/rewriter.mli | 10 ++- 9 files changed, 218 insertions(+), 38 deletions(-) create mode 100644 src/lib_ppx_profiler/handled_drivers.ml create mode 100644 src/lib_ppx_profiler/handled_drivers.mli diff --git a/src/lib_ppx_profiler/error.ml b/src/lib_ppx_profiler/error.ml index 7e42c39b02a4..10dd04cee64b 100644 --- a/src/lib_ppx_profiler/error.ml +++ b/src/lib_ppx_profiler/error.ml @@ -14,7 +14,9 @@ type error = | Invalid_record of Key.t | Invalid_span of Key.t | Invalid_stop of Key.t + | Invalid_list_of_driver_ids of Ppxlib.expression list | Improper_field of (Longident.t Location.loc * Ppxlib.expression) + | Improper_list_field of (Longident.t Location.loc * Ppxlib.expression) | Improper_let_binding of Ppxlib.expression | Improper_record of (Ppxlib.Ast.longident_loc * Ppxlib.expression) list | Malformed_attribute of Ppxlib.expression @@ -95,6 +97,19 @@ let error loc err = Found: @[%a@]@." Key.pp key ) + | Invalid_list_of_driver_ids expr_list -> + ( "Invalid list of modules.", + Format.asprintf + "@[It looks like you tried to provide a list of opt-in \ + drivers through the `driver_ids` field but no drivers could be \ + parsed out of it. A list of opt-in drivers should be a list of \ + modules or idents like `[Opentelemetry; prometheus]@,\ + Found: { @[%a@] }@." + Format.( + pp_print_list + ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@,") + Ppxlib.Pprintast.expression) + expr_list ) | Improper_record record -> ( "Improper record.", Format.asprintf @@ -104,6 +119,7 @@ let error loc err = - the verbosity@,\ - the profiler_module@,\ - the metadata@,\ + - the opt-in drivers_ids@,\ Found: { @[%a@] }@." Format.( pp_print_list @@ -117,9 +133,16 @@ let error loc err = - the verbosity@,\ - the profiler_module@,\ - the metadata@,\ + - the opt-in drivers_ids@,\ Found: @[%a@]@." pp_field field ) + | Improper_list_field field -> + ( "Improper list field.", + Format.asprintf + "@[Expecting a list field@,Found: @[%a@]@." + pp_field + field ) | Improper_let_binding expr -> ( "Improper let binding expression.", Format.asprintf diff --git a/src/lib_ppx_profiler/error.mli b/src/lib_ppx_profiler/error.mli index c486e2df0f64..51596153e737 100644 --- a/src/lib_ppx_profiler/error.mli +++ b/src/lib_ppx_profiler/error.mli @@ -14,7 +14,9 @@ type error = | Invalid_record of Key.t | Invalid_span of Key.t | Invalid_stop of Key.t + | Invalid_list_of_driver_ids of Ppxlib.expression list | Improper_field of (Longident.t Location.loc * Ppxlib.expression) + | Improper_list_field of (Longident.t Location.loc * Ppxlib.expression) | Improper_let_binding of Ppxlib.expression | Improper_record of (Ppxlib.Ast.longident_loc * Ppxlib.expression) list | Malformed_attribute of Ppxlib.expression diff --git a/src/lib_ppx_profiler/handled_drivers.ml b/src/lib_ppx_profiler/handled_drivers.ml new file mode 100644 index 000000000000..3a9f3663b2a5 --- /dev/null +++ b/src/lib_ppx_profiler/handled_drivers.ml @@ -0,0 +1,34 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +module Driver_kind = struct + type t = OpenTelemetry | Prometheus | Text | Json + + let of_string s = + match String.lowercase_ascii s with + | "opentelemetry" -> OpenTelemetry + | "prometheus" -> Prometheus + | "text" -> Text + | "json" -> Json + | s -> failwith (Printf.sprintf "'%s' is not a known driver kind" s) +end + +type t = Driver_kind.t list + +let empty = [] + +let is_empty t = t = [] + +let of_list = Fun.id + +let of_string s = + String.split_on_char ';' s |> List.map String.trim + |> List.map Driver_kind.of_string + +let mem driver (t : t) = List.mem driver t + +let exists = List.exists diff --git a/src/lib_ppx_profiler/handled_drivers.mli b/src/lib_ppx_profiler/handled_drivers.mli new file mode 100644 index 000000000000..54e9142267ea --- /dev/null +++ b/src/lib_ppx_profiler/handled_drivers.mli @@ -0,0 +1,28 @@ +(*****************************************************************************) +(* *) +(* SPDX-License-Identifier: MIT *) +(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) +(* *) +(*****************************************************************************) + +(** A [Driver_kind] represents an enabled driver by `TEZOS_PPX_PROFILER` *) +module Driver_kind : sig + type t = OpenTelemetry | Prometheus | Text | Json + + val of_string : string -> t +end + +(** [Handled_drivers.t] gathers all the enabled drivers *) +type t + +val empty : t + +val is_empty : t -> bool + +val of_list : Driver_kind.t list -> t + +val of_string : string -> t + +val mem : Driver_kind.t -> t -> bool + +val exists : (Driver_kind.t -> bool) -> t -> bool diff --git a/src/lib_ppx_profiler/key.ml b/src/lib_ppx_profiler/key.ml index df0e1455f553..12ef7eb7177f 100644 --- a/src/lib_ppx_profiler/key.ml +++ b/src/lib_ppx_profiler/key.ml @@ -18,6 +18,7 @@ type t = { profiler_module : string option; metadata : Ppxlib.expression option; content : content; + driver_ids : Handled_drivers.t; } let[@inline] content {content; _} = content diff --git a/src/lib_ppx_profiler/key.mli b/src/lib_ppx_profiler/key.mli index 0725c7ab1e95..584a5415ff0d 100644 --- a/src/lib_ppx_profiler/key.mli +++ b/src/lib_ppx_profiler/key.mli @@ -18,6 +18,14 @@ type t = { profiler_module : string option; metadata : Ppxlib.expression option; content : content; + driver_ids : Handled_drivers.t; + (* Field used to decide if this attribute should be preprocessed or not + based on the driver ids provided in the `TEZOS_PPX_PROFILER` env var. + This is an opt-out field meaning that if the field is not provided + the attribute will always be preprocessed when the ppx engine is + enabled but if the field is provided it will only be preprocessed if + one of the ids is also present in the drivers enabled by the env var. + *) } val get_verbosity : Ppxlib.Location.t -> t -> Ppxlib.expression option diff --git a/src/lib_ppx_profiler/ppx_profiler.ml b/src/lib_ppx_profiler/ppx_profiler.ml index 0d032a8c28de..fd19b708d1ea 100644 --- a/src/lib_ppx_profiler/ppx_profiler.ml +++ b/src/lib_ppx_profiler/ppx_profiler.ml @@ -7,36 +7,63 @@ (** Checks that this ppx should be handled at compile time. - To use it at compile time, do [TEZOS_PPX_PROFILER=... make] *) + To use it at compile time, do [TEZOS_PPX_PROFILER=... make] + + You can provide a dummy value or a list of drivers: + - dummy value: + + `[@profiler. ...]` with no `driver_ids` provided + will be preprocessed + + `[@profiler. {driver_ids=[list of driver_id]}...]` + will not be preprocessed + - `[list of driver ids]` + + `[@profiler. ...]` with no `driver_ids` provided + will be preprocessed + + `[@profiler. {driver_ids=[list of driver_id]}...]` + will be preprocessed if their `driver_ids` list has a non empty + intersection with the provided list *) let make_ppx_profiler () = match Sys.getenv_opt "TEZOS_PPX_PROFILER" with - | Some "" | None -> false - | _ -> true + | Some "" | None -> None + | Some s -> ( + match Handled_drivers.of_string s with + | drivers -> Some drivers + | exception Failure exn -> + Format.eprintf + "@[TEZOS_PPX_PROFILER was enabled with the following error:@,\ + %s.@,\ + - Ppx attributes containing a non-empty `driver_ids` field won't \ + be preprocessed@,\ + - Other ppx attributes will be preprocessed@." + exn ; + Some Handled_drivers.empty) (** [mapper] inherits from Ast_traverse.map because we want to take a parsetree and return a new parsetree that have been rewritten or not by this ppx *) let mapper = - if make_ppx_profiler () then - object - inherit Ppxlib.Ast_traverse.map as super + match make_ppx_profiler () with + | Some handled_drivers -> + object + inherit Ppxlib.Ast_traverse.map as super - method! expression e = - let detected_rewriters = - (* The list of attributes is reverted to make sure that we preprocess - them from left to right *) - Rewriter.extract_rewriters (List.rev e.pexp_attributes) - in - (* Remove the handled attributes that have been transformed in rewriters *) - Expression.remove_attributes e - (* Transform the expression with the help of the list of rewriters *) - |> Expression.rewrite detected_rewriters - (* Gives the hand back to Ast_travers.map to keep iterating *) - |> super#expression - end - else - object - inherit Ppxlib.Ast_traverse.map - end + method! expression e = + let detected_rewriters = + (* The list of attributes is reverted to make sure that we preprocess + them from left to right *) + Rewriter.extract_rewriters + handled_drivers + (List.rev e.pexp_attributes) + in + (* Remove the handled attributes that have been transformed in rewriters *) + Expression.remove_attributes e + (* Transform the expression with the help of the list of rewriters *) + |> Expression.rewrite detected_rewriters + (* Gives the hand back to Ast_traverse.map to keep iterating *) + |> super#expression + end + | None -> + object + inherit Ppxlib.Ast_traverse.map + end let () = Ppxlib.Driver.register_transformation "ppx_profiler" ~impl:mapper#structure diff --git a/src/lib_ppx_profiler/rewriter.ml b/src/lib_ppx_profiler/rewriter.ml index 2381cc06ebd4..311a2a004894 100644 --- a/src/lib_ppx_profiler/rewriter.ml +++ b/src/lib_ppx_profiler/rewriter.ml @@ -42,17 +42,17 @@ let aggregate_s key location = let custom key location = match Key.content key with - | Key.Apply _ -> Custom + | Key.Apply _ | Key.Ident _ -> Custom | _ -> Error.error location (Error.Invalid_custom key) let custom_f key location = match Key.content key with - | Key.Apply _ -> Custom_f + | Key.Apply _ | Key.Ident _ -> Custom_f | _ -> Error.error location (Error.Invalid_custom key) let custom_s key location = match Key.content key with - | Key.Apply _ -> Custom_s + | Key.Apply _ | Key.Ident _ -> Custom_s | _ -> Error.error location (Error.Invalid_custom key) let mark key location = @@ -166,7 +166,7 @@ let get_action_maker loc attribute = else None (** Transforms a rewriter in an OCaml function call: - - [@profiler.aggregate_s ...] will create a proper + - [@profiler.aggregate_s ...] will create a proper Parsetree Lident representing Profiler.aggregate_s *) let to_fully_qualified_lident_expr t loc = let lident = @@ -218,7 +218,10 @@ let extract_content_from_structure loc structure = (* [@ppx ["label1"; "label2"; ...]] *) match extract_list expr with | Some labels -> Key.List labels - | None -> Error.error loc Error.(Malformed_attribute structure)) + | None -> + (* This branch corresponds to the fact that the value + associated to the field is not a list, which is an error *) + Error.error loc Error.(Malformed_attribute structure)) let exists_field field string = let Ppxlib.{txt; _}, _ = field in @@ -229,6 +232,19 @@ let extract_field_from_record record string = | field -> Some field | exception Not_found -> None +(** [extract_list_from_record _ record field] checks that [field] exists + and that the associated value is a list. + If [field] is not present, returns [None] *) +let extract_list_from_record loc record string = + Option.bind (extract_field_from_record record string) @@ function + | (_, [%expr [%e? expr]]) as field -> ( + match extract_list expr with + | Some labels -> Some labels + | None -> + (* This branch corresponds to the fact that the value + associated to the field is not a list, which is an error *) + Error.error loc Error.(Improper_list_field field)) + (** [extract_enum_from_record _ record field] checks that [field] exists and that the associated value is an enum. If [field] is not present, returns [None] *) @@ -246,7 +262,27 @@ let extract_from_record loc record = expression associated to it as is *) Option.map snd (extract_field_from_record record "metadata") in - (verbosity, profiler_module, metadata) + let driver_ids = + (* Transforms a list of constructs (that all have an associated + labels) into a list of DriverKind.t *) + (match extract_list_from_record loc record "driver_ids" with + | None -> [] + | Some expr_list -> + List.map + (function + | Ppxlib. + { + pexp_desc = + ( Pexp_construct ({txt = Lident ident; _}, None) + | Pexp_ident {txt = Lident ident; _} ); + _; + } -> + Handled_drivers.Driver_kind.of_string ident + | _ -> Error.error loc Error.(Invalid_list_of_driver_ids expr_list)) + expr_list) + |> Handled_drivers.of_list + in + (verbosity, profiler_module, metadata, driver_ids) let extract_key_from_payload loc payload = match payload with @@ -263,17 +299,19 @@ let extract_key_from_payload loc payload = }]]; ] -> (* [@ppx {} ...] *) - let verbosity, profiler_module, metadata = + let verbosity, profiler_module, metadata, driver_ids = extract_from_record loc record in (match (verbosity, profiler_module, metadata) with - | None, None, None -> Error.error loc Error.(Improper_record record) + | None, None, None when Handled_drivers.is_empty driver_ids -> + Error.error loc Error.(Improper_record record) | _ -> ()) ; Key. { verbosity; profiler_module; metadata; + driver_ids; content = extract_content_from_structure loc structure; } | Ppxlib.PStr [[%stri [%e? structure]]] -> @@ -283,6 +321,7 @@ let extract_key_from_payload loc payload = verbosity = None; profiler_module = None; metadata = None; + driver_ids = Handled_drivers.empty; content = extract_content_from_structure loc structure; } | Ppxlib.PStr [] -> @@ -292,18 +331,32 @@ let extract_key_from_payload loc payload = verbosity = None; profiler_module = None; metadata = None; + driver_ids = Handled_drivers.empty; content = Key.Empty; } | _ -> Error.error loc Invalid_payload -let of_attribute ({Ppxlib.attr_payload; attr_loc; _} as attribute) = +let of_attribute handled_drivers + ({Ppxlib.attr_payload; attr_loc; _} as attribute) = match Ppxlib_helper.get_attribute_name attribute |> get_action_maker attr_loc with | Some action_maker -> let key = extract_key_from_payload attr_loc attr_payload in - let action = action_maker key attr_loc in - Some {key; location = attr_loc; action} + if + (* Preprocess this attribute if: + - the driver_ids was not provided + - one of the driver_ids provided is enabled by `TEZOS_PPX_PROFILER` + *) + Handled_drivers.is_empty key.driver_ids + || Handled_drivers.exists + (fun driver_id -> Handled_drivers.mem driver_id handled_drivers) + key.driver_ids + then + let action = action_maker key attr_loc in + Some {key; location = attr_loc; action} + else None | None -> None -let extract_rewriters = List.filter_map of_attribute +let extract_rewriters handled_drivers = + List.filter_map (of_attribute handled_drivers) diff --git a/src/lib_ppx_profiler/rewriter.mli b/src/lib_ppx_profiler/rewriter.mli index 446e64e92cba..0117e2c9cb6b 100644 --- a/src/lib_ppx_profiler/rewriter.mli +++ b/src/lib_ppx_profiler/rewriter.mli @@ -47,6 +47,10 @@ val to_fully_qualified_lident_expr : val get_location : t -> Ppxlib.location -(** [extract_rewriters attributes] inspects the given list of [attributes] - and returns the rewriters that are handled by this ppx. *) -val extract_rewriters : Ppxlib.attribute list -> t list +(** [extract_rewriters handled_drivers attributes] inspects the given list + of [attributes] and returns the rewriters that are handled by this ppx. + + If an [attribute] has a [driver_ids] field that is not enabled by + `TEZOS_PPX_PROFILER`, the attribute is removed from the list of attributes + but will not be preprocessed *) +val extract_rewriters : Handled_drivers.t -> Ppxlib.attribute list -> t list -- GitLab From c5a8dc9c640be078adf840fb6c70228b89f6fb09 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Fri, 6 Dec 2024 16:15:55 +0100 Subject: [PATCH 2/2] Ppx_profiler: Add documentation for TEZOS_PPX_PROFILER and the new driver_ids field --- docs/developer/ppx_profiler.rst | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/docs/developer/ppx_profiler.rst b/docs/developer/ppx_profiler.rst index 572841b8adeb..5e8fcf778546 100644 --- a/docs/developer/ppx_profiler.rst +++ b/docs/developer/ppx_profiler.rst @@ -40,9 +40,10 @@ used by devs hence the use of a PPX that is controlled by an environment variabl .. code-block:: OCaml - TEZOS_PPX_PROFILER= make + TEZOS_PPX_PROFILER= make -Will preprocess the code before compiling (It should be noted that this is temporary and the content of this environment variable will be parsed and used in a near future to allow finer control over what PPX should be activated or not). +Will preprocess the code before compiling. The ``value`` field is described +:ref:`enabled-drivers`. This will allow to preprocess @@ -213,6 +214,7 @@ The payload is made of two parts, the first one being optional: | verbosity = (Notice | Info | Debug) | profiler_module = module_ident | metadata = <(string * string) list> + | driver_ids = <(Prometheus | OpenTelemetry | Text | Json) list> args ::= | | | ident | empty @@ -232,6 +234,23 @@ will be preprocessed as Prof.span_f ~verbosity:Debug ("label", []) @@ g x ... +.. _enabled-drivers: + +Enabled drivers +^^^^^^^^^^^^^^^ + +When enabling the ppx with ``TEZOS_PPX_PROFILER=``, ``value`` can have +two possible types: + +- A dummy one, all attributes will be preprocessed except the ones with a + non-empty ``driver_ids`` field +- A list of driver ids like ``prometheus; opentelemetry`` that will allow to + preprocess attributes: + + - with an empty ``driver_ids`` field + - with a ``driver_ids`` field where one of the driver ids is also present in + ``value`` + Adding functionalities ---------------------- -- GitLab