mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
use S-expressions in CCKTree.print, much much easier
This commit is contained in:
parent
1be3bcf766
commit
0c49d30d85
2 changed files with 25 additions and 44 deletions
|
|
@ -184,52 +184,33 @@ let find ?pset f t =
|
||||||
(** {2 Pretty-printing} *)
|
(** {2 Pretty-printing} *)
|
||||||
|
|
||||||
let print pp_x fmt t =
|
let print pp_x fmt t =
|
||||||
let out_funs = Format.pp_get_formatter_out_functions fmt () in
|
|
||||||
let print_bar fmt () = Format.pp_print_string fmt "| " in
|
|
||||||
let print_bars n fmt () =
|
|
||||||
for _i = 0 to n-1 do print_bar fmt () done
|
|
||||||
in
|
|
||||||
let print_node ~last fmt () =
|
|
||||||
if last
|
|
||||||
then Format.pp_print_string fmt "└──"
|
|
||||||
else Format.pp_print_string fmt "├──"
|
|
||||||
in
|
|
||||||
(* special printer for Format, handling indentation and all *)
|
|
||||||
let pp_functions =
|
|
||||||
{out_funs with
|
|
||||||
Format.out_spaces=(fun n -> print_bars n fmt ())
|
|
||||||
}
|
|
||||||
in
|
|
||||||
let set_printer () =
|
|
||||||
Format.pp_set_formatter_out_functions fmt pp_functions
|
|
||||||
in
|
|
||||||
(* at depth [lvl] *)
|
(* at depth [lvl] *)
|
||||||
let rec pp ~last lvl t = match t with
|
let rec pp fmt t = match t with
|
||||||
| `Nil -> ()
|
| `Nil -> ()
|
||||||
| `Node (x, children) ->
|
| `Node (x, children) ->
|
||||||
if lvl>0 then (
|
let children = filter children in
|
||||||
print_bars (lvl-1) fmt ();
|
match children with
|
||||||
print_node ~last fmt ()
|
| [] -> pp_x fmt x
|
||||||
);
|
| _::_ ->
|
||||||
pp_x fmt x;
|
Format.fprintf fmt "@[<v2>(@[<hov0>%a@]%a)@]"
|
||||||
Format.pp_print_newline fmt ();
|
pp_x x pp_children children
|
||||||
(* remove empty children *)
|
and filter l =
|
||||||
let children = List.fold_left
|
let l = List.fold_left
|
||||||
(fun acc c -> match c() with
|
(fun acc c -> match c() with
|
||||||
| `Nil -> acc
|
| `Nil -> acc
|
||||||
| `Node _ as sub -> sub :: acc
|
| `Node _ as sub -> sub :: acc
|
||||||
) [] children
|
) [] l
|
||||||
in
|
in
|
||||||
let children = List.rev children in
|
List.rev l
|
||||||
let n = List.length children in
|
and pp_children fmt children =
|
||||||
List.iteri
|
(* remove empty children *)
|
||||||
(fun i c ->
|
List.iter
|
||||||
pp ~last:(i+1=n) (lvl+1) c
|
(fun c ->
|
||||||
) children
|
Format.fprintf fmt "@,";
|
||||||
|
pp fmt c
|
||||||
|
) children
|
||||||
in
|
in
|
||||||
set_printer ();
|
pp fmt (t ());
|
||||||
pp ~last:false 0 (t ());
|
|
||||||
Format.pp_set_formatter_out_functions fmt out_funs; (* restore *)
|
|
||||||
()
|
()
|
||||||
|
|
||||||
(** {2 Pretty printing in the DOT (graphviz) format} *)
|
(** {2 Pretty printing in the DOT (graphviz) format} *)
|
||||||
|
|
|
||||||
|
|
@ -116,8 +116,8 @@ Example (tree of calls for naive Fibonacci function):
|
||||||
*)
|
*)
|
||||||
|
|
||||||
val print : 'a formatter -> 'a t formatter
|
val print : 'a formatter -> 'a t formatter
|
||||||
(** A pretty-printer using indentation to render the tree. Empty nodes
|
(** A pretty-printer using S-expressions and boxes to render the tree.
|
||||||
are not rendered; sharing is ignored.
|
Empty nodes are not rendered; sharing is ignored.
|
||||||
@since NEXT_RELEASE *)
|
@since NEXT_RELEASE *)
|
||||||
|
|
||||||
(** {2 Pretty printing in the DOT (graphviz) format} *)
|
(** {2 Pretty printing in the DOT (graphviz) format} *)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue