Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Expose more Pprintast functions #10618

Merged
merged 2 commits into from
Sep 13, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
3 changes: 3 additions & 0 deletions Changes
Original file line number Diff line number Diff line change
Expand Up @@ -160,6 +160,9 @@ Working version
(Nicolás Ojeda Bär, fix by Leo White, report by Alain Frisch, review by Thomas
Refis)

- #10618: Expose more Pprintast functions
(Guillaume Petiot, review by Gabriel Scherer)

### Build system:

### Bug fixes:
Expand Down
55 changes: 32 additions & 23 deletions parsing/pprintast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -865,34 +865,34 @@ and exception_declaration ctxt f x =
(extension_constructor ctxt) x.ptyexn_constructor
(item_attributes ctxt) x.ptyexn_attributes

and class_type_field ctxt f x =
match x.pctf_desc with
| Pctf_inherit (ct) ->
pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_val (s, mf, vf, ct) ->
pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_method (s, pf, vf, ct) ->
pp f "@[<2>method %a %a%s :@;%a@]%a"
private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_constraint (ct1, ct2) ->
pp f "@[<2>constraint@ %a@ =@ %a@]%a"
(core_type ctxt) ct1 (core_type ctxt) ct2
(item_attributes ctxt) x.pctf_attributes
| Pctf_attribute a -> floating_attribute ctxt f a
| Pctf_extension e ->
item_extension ctxt f e;
item_attributes ctxt f x.pctf_attributes

and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
let class_type_field f x =
match x.pctf_desc with
| Pctf_inherit (ct) ->
pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_val (s, mf, vf, ct) ->
pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_method (s, pf, vf, ct) ->
pp f "@[<2>method %a %a%s :@;%a@]%a"
private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
(item_attributes ctxt) x.pctf_attributes
| Pctf_constraint (ct1, ct2) ->
pp f "@[<2>constraint@ %a@ =@ %a@]%a"
(core_type ctxt) ct1 (core_type ctxt) ct2
(item_attributes ctxt) x.pctf_attributes
| Pctf_attribute a -> floating_attribute ctxt f a
| Pctf_extension e ->
item_extension ctxt f e;
item_attributes ctxt f x.pctf_attributes
in
pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
(fun f -> function
{ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
| ct -> pp f " (%a)" (core_type ctxt) ct) ct
(list class_type_field ~sep:"@;") l
(list (class_type_field ctxt) ~sep:"@;") l

(* call [class_signature] called by [class_signature] *)
and class_type ctxt f x =
Expand Down Expand Up @@ -1705,3 +1705,12 @@ let pattern = pattern reset_ctxt
let signature = signature reset_ctxt
let structure = structure reset_ctxt
let module_expr = module_expr reset_ctxt
let module_type = module_type reset_ctxt
let class_field = class_field reset_ctxt
let class_type_field = class_type_field reset_ctxt
let class_expr = class_expr reset_ctxt
let class_type = class_type reset_ctxt
let structure_item = structure_item reset_ctxt
let signature_item = signature_item reset_ctxt
let binding = binding reset_ctxt
let payload = payload reset_ctxt
9 changes: 9 additions & 0 deletions parsing/pprintast.mli
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,15 @@ val module_expr: Format.formatter -> Parsetree.module_expr -> unit
val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit

val class_field: Format.formatter -> Parsetree.class_field -> unit
val class_type_field: Format.formatter -> Parsetree.class_type_field -> unit
val class_expr: Format.formatter -> Parsetree.class_expr -> unit
val class_type: Format.formatter -> Parsetree.class_type -> unit
val module_type: Format.formatter -> Parsetree.module_type -> unit
val structure_item: Format.formatter -> Parsetree.structure_item -> unit
val signature_item: Format.formatter -> Parsetree.signature_item -> unit
val binding: Format.formatter -> Parsetree.value_binding -> unit
val payload: Format.formatter -> Parsetree.payload -> unit

val tyvar: Format.formatter -> string -> unit
(** Print a type variable name, taking care of the special treatment
Expand Down