Skip to content

Commit

Permalink
Merge pull request #537 from NathanReb/better-pp-ast-api
Browse files Browse the repository at this point in the history
Add Submodules with simpler APIs to Pp_ast
  • Loading branch information
NathanReb authored Nov 27, 2024
2 parents 6b85aae + 9129e81 commit 0d9893b
Show file tree
Hide file tree
Showing 3 changed files with 81 additions and 12 deletions.
2 changes: 1 addition & 1 deletion CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
53 changes: 51 additions & 2 deletions src/pp_ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -302,9 +302,58 @@ class lift_simple_val =
| NoInjectivity -> Constr ("NoInjectivity", [])
end

let lift_simple_val = new lift_simple_val
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 = 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;
lift_simple_val

type 'node pp = ?config:Config.t -> Format.formatter -> 'node -> unit
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)

type 'a printer = 'a configurable

let lift_simple_val = new lift_simple_val

let with_config ~config ~f =
let old_config = lift_simple_val#get_config () in
Expand Down
38 changes: 29 additions & 9 deletions src/pp_ast.mli
Original file line number Diff line number Diff line change
Expand Up @@ -60,12 +60,32 @@ module Config : sig
be. *)
end

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
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 = 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
include Configurable

0 comments on commit 0d9893b

Please sign in to comment.