From f9d32d0af24f36584193792c79c30db8ddffb226 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 20 Feb 2015 17:24:55 +0100
Subject: [PATCH] draft of printer for CCKTree (not done yet)

---
 src/iter/CCKTree.ml  | 51 ++++++++++++++++++++++++++++++++++++++++++++
 src/iter/CCKTree.mli | 26 ++++++++++++++++++++++
 2 files changed, 77 insertions(+)

diff --git a/src/iter/CCKTree.ml b/src/iter/CCKTree.ml
index 35e8590d..cb0f47ed 100644
--- a/src/iter/CCKTree.ml
+++ b/src/iter/CCKTree.ml
@@ -181,6 +181,57 @@ let find ?pset f t =
   in
   _find_kl f (bfs ?pset t)
 
+(** {2 Pretty-printing} *)
+
+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] *)
+  let rec pp ~last lvl t = match t with
+    | `Nil -> ()
+    | `Node (x, children) ->
+      if lvl>0 then (
+        print_bars (lvl-1) fmt ();
+        print_node ~last fmt ()
+      );
+      pp_x fmt x;
+      Format.pp_print_newline fmt ();
+      (* remove empty children *)
+      let children = List.fold_left
+        (fun acc c -> match c() with
+          | `Nil -> acc
+          | `Node _ as sub -> sub :: acc
+        ) [] children
+      in
+      let children = List.rev children in
+      let n = List.length children in
+      List.iteri
+        (fun i c ->
+           pp ~last:(i+1=n) (lvl+1) c
+        ) children
+  in
+  set_printer ();
+  pp ~last:false 0 (t ());
+  Format.pp_set_formatter_out_functions fmt out_funs; (* restore *)
+  ()
+
 (** {2 Pretty printing in the DOT (graphviz) format} *)
 
 module Dot = struct
diff --git a/src/iter/CCKTree.mli b/src/iter/CCKTree.mli
index c64444f3..d63b4c01 100644
--- a/src/iter/CCKTree.mli
+++ b/src/iter/CCKTree.mli
@@ -94,6 +94,32 @@ val bfs : ?pset:'a pset -> 'a t -> 'a klist
 val find : ?pset:'a pset -> ('a -> 'b option) -> 'a t -> 'b option
 (** Look for an element that maps to [Some _] *)
 
+(** {2 Pretty-printing}
+
+Example (tree of calls for naive Fibonacci function):
+{[
+  let mk_fib n =
+    let rec fib' l r i =
+      if i=n then r else fib' r (l+r) (i+1)
+    in fib' 1 1 1;;
+
+  let rec fib n = match n with
+    | 0 | 1 -> CCKTree.singleton (`Cst n)
+    | _ -> CCKTree.node2 (`Plus (mk_fib n)) (fib (n-1)) (fib (n-2));;
+
+  let pp_node fmt = function
+    | `Cst n -> Format.fprintf fmt "%d" n
+    | `Plus n -> Format.fprintf fmt "%d" n;;
+
+  Format.printf "%a@." (CCKTree.print pp_node) (fib 8);;
+]}
+*)
+
+val print : 'a formatter -> 'a t formatter
+(** A pretty-printer using indentation to render the tree. Empty nodes
+    are not rendered; sharing is ignored.
+    @since NEXT_RELEASE *)
+
 (** {2 Pretty printing in the DOT (graphviz) format} *)
 
 module Dot : sig