use S-expressions in CCKTree.print, much much easier

This commit is contained in:
Simon Cruanes 2015-02-20 17:50:33 +01:00
parent 1be3bcf766
commit 0c49d30d85
2 changed files with 25 additions and 44 deletions

View file

@ -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} *)

View file

@ -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} *)