From f9f0f124e028bd6b31d49c7c824609d2291d30f4 Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Wed, 6 Nov 2024 15:36:28 +0100 Subject: [PATCH 1/2] Add Submodules with simpler APIs to Pp_ast Signed-off-by: Nathan Rebours --- CHANGES.md | 2 +- src/pp_ast.ml | 38 ++++++++++++++++++++++++++++++++++++++ src/pp_ast.mli | 20 ++++++++++++++++++++ 3 files changed, 59 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index fb20f846..04277c80 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,7 +19,7 @@ details. - Add ppxlib's AST pretty-printing utilities in `Ppxlib.Pp_ast` and a `ppxlib-pp-ast` executable in a new separate `ppxlib-tools` package - (#517, @NathanReb) + (#517, #525, #537, @NathanReb) - Change `-dparsetree` from a sexp output to a pretty printed AST, closer to what the compiler's `-dparsetree` is. diff --git a/src/pp_ast.ml b/src/pp_ast.ml index 693d89f1..40b34975 100644 --- a/src/pp_ast.ml +++ b/src/pp_ast.ml @@ -302,6 +302,44 @@ class lift_simple_val = | NoInjectivity -> Constr ("NoInjectivity", []) end +module type Conf = sig + val config : Config.t +end + +module type Configured = sig + val structure : Format.formatter -> structure -> unit + val structure_item : Format.formatter -> structure_item -> unit + val signature : Format.formatter -> signature -> unit + val signature_item : Format.formatter -> signature_item -> unit + val expression : Format.formatter -> expression -> unit + val pattern : Format.formatter -> pattern -> unit + val core_type : Format.formatter -> core_type -> unit +end + +module Make (Conf : Conf) : Configured = struct + let lsv = + let lift_simple_val = new lift_simple_val in + lift_simple_val#set_config Conf.config; + lift_simple_val + + let structure fmt str = pp_simple_val fmt (lsv#structure str) + let structure_item fmt str = pp_simple_val fmt (lsv#structure_item str) + let signature fmt str = pp_simple_val fmt (lsv#signature str) + let signature_item fmt str = pp_simple_val fmt (lsv#signature_item str) + let expression fmt str = pp_simple_val fmt (lsv#expression str) + let pattern fmt str = pp_simple_val fmt (lsv#pattern str) + let core_type fmt str = pp_simple_val fmt (lsv#core_type str) +end + +let make config = + (module Make (struct + let config = config + end) : Configured) + +module Default = Make (struct + let config = Config.default +end) + let lift_simple_val = new lift_simple_val type 'node pp = ?config:Config.t -> Format.formatter -> 'node -> unit diff --git a/src/pp_ast.mli b/src/pp_ast.mli index ab66fdb3..732846bc 100644 --- a/src/pp_ast.mli +++ b/src/pp_ast.mli @@ -60,6 +60,26 @@ module Config : sig be. *) end +module type Conf = sig + val config : Config.t +end + +module type Configured = sig + val structure : Format.formatter -> structure -> unit + val structure_item : Format.formatter -> structure_item -> unit + val signature : Format.formatter -> signature -> unit + val signature_item : Format.formatter -> signature_item -> unit + val expression : Format.formatter -> expression -> unit + val pattern : Format.formatter -> pattern -> unit + val core_type : Format.formatter -> core_type -> unit +end + +module Make (Conf : Conf) : Configured + +val make : Config.t -> (module Configured) + +module Default : Configured + type 'node pp = ?config:Config.t -> Format.formatter -> 'node -> unit val structure : structure pp From 9129e81a82b9d3ef8ee0ccc24f84e392435617da Mon Sep 17 00:00:00 2001 From: Nathan Rebours Date: Fri, 22 Nov 2024 11:14:11 +0100 Subject: [PATCH 2/2] Add configured and configurable printer types to Pp_ast Signed-off-by: Nathan Rebours --- src/pp_ast.ml | 33 ++++++++++++++++++++++----------- src/pp_ast.mli | 38 +++++++++++++++++++------------------- 2 files changed, 41 insertions(+), 30 deletions(-) diff --git a/src/pp_ast.ml b/src/pp_ast.ml index 40b34975..6292b3d8 100644 --- a/src/pp_ast.ml +++ b/src/pp_ast.ml @@ -302,21 +302,32 @@ class lift_simple_val = | NoInjectivity -> Constr ("NoInjectivity", []) end +type 'a pp = Format.formatter -> 'a -> unit +type 'a configurable = ?config:Config.t -> 'a pp +type 'a configured = 'a pp + +module type S = sig + type 'a printer + + val structure : structure printer + val structure_item : structure_item printer + val signature : signature printer + val signature_item : signature_item printer + val expression : expression printer + val pattern : pattern printer + val core_type : core_type printer +end + module type Conf = sig val config : Config.t end -module type Configured = sig - val structure : Format.formatter -> structure -> unit - val structure_item : Format.formatter -> structure_item -> unit - val signature : Format.formatter -> signature -> unit - val signature_item : Format.formatter -> signature_item -> unit - val expression : Format.formatter -> expression -> unit - val pattern : Format.formatter -> pattern -> unit - val core_type : Format.formatter -> core_type -> unit -end +module type Configured = S with type 'a printer = 'a configured +module type Configurable = S with type 'a printer = 'a configurable module Make (Conf : Conf) : Configured = struct + type 'a printer = 'a configured + let lsv = let lift_simple_val = new lift_simple_val in lift_simple_val#set_config Conf.config; @@ -340,9 +351,9 @@ module Default = Make (struct let config = Config.default end) -let lift_simple_val = new lift_simple_val +type 'a printer = 'a configurable -type 'node pp = ?config:Config.t -> Format.formatter -> 'node -> unit +let lift_simple_val = new lift_simple_val let with_config ~config ~f = let old_config = lift_simple_val#get_config () in diff --git a/src/pp_ast.mli b/src/pp_ast.mli index 732846bc..3f6ffcbf 100644 --- a/src/pp_ast.mli +++ b/src/pp_ast.mli @@ -60,32 +60,32 @@ module Config : sig be. *) end +type 'a pp = Format.formatter -> 'a -> unit +type 'a configurable = ?config:Config.t -> 'a pp +type 'a configured = 'a pp + +module type S = sig + type 'a printer + + val structure : structure printer + val structure_item : structure_item printer + val signature : signature printer + val signature_item : signature_item printer + val expression : expression printer + val pattern : pattern printer + val core_type : core_type printer +end + module type Conf = sig val config : Config.t end -module type Configured = sig - val structure : Format.formatter -> structure -> unit - val structure_item : Format.formatter -> structure_item -> unit - val signature : Format.formatter -> signature -> unit - val signature_item : Format.formatter -> signature_item -> unit - val expression : Format.formatter -> expression -> unit - val pattern : Format.formatter -> pattern -> unit - val core_type : Format.formatter -> core_type -> unit -end +module type Configured = S with type 'a printer = 'a configured +module type Configurable = S with type 'a printer = 'a configurable module Make (Conf : Conf) : Configured val make : Config.t -> (module Configured) module Default : Configured - -type 'node pp = ?config:Config.t -> Format.formatter -> 'node -> unit - -val structure : structure pp -val structure_item : structure_item pp -val signature : signature pp -val signature_item : signature_item pp -val expression : expression pp -val pattern : pattern pp -val core_type : core_type pp +include Configurable