From 9d35f960338f7cbd6a95ffaa83d519fbd13bb069 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 31 Mar 2023 23:20:46 -0400
Subject: [PATCH] add Pp.debug

---
 src/pp/containers_pp.ml  | 17 +++++++++++++++--
 src/pp/containers_pp.mli |  4 ++++
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 51da3717..1543a4c7 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -45,6 +45,21 @@ and view =
   | Fill of { sep: t; l: t list }
   | Wrap : 'a Ext.t * 'a * t -> view
 
+(* debug printer *)
+let rec debug out (self : t) : unit =
+  match self.view with
+  | Nil -> Format.fprintf out "nil"
+  | Newline -> Format.fprintf out "nl"
+  | Nest (i, x) -> Format.fprintf out "(@[nest %d@ %a@])" i debug x
+  | Append (a, b) -> Format.fprintf out "@[%a ^@ %a@]" debug a debug b
+  | Char c -> Format.fprintf out "%C" c
+  | Text s -> Format.fprintf out "%S" s
+  | Text_sub (s, i, len) -> Format.fprintf out "%S" (String.sub s i len)
+  | Group d -> Format.fprintf out "(@[group@ %a@])" debug d
+  | Fill { sep = _; l } ->
+    Format.fprintf out "(@[fill@ %a@])" (Format.pp_print_list debug) l
+  | Wrap (_, _, d) -> Format.fprintf out "(@[ext@ %a@])" debug d
+
 let nil : t = { view = Nil; wfl = 0 }
 let newline : t = { view = Newline; wfl = 1 }
 let nl = newline
@@ -343,8 +358,6 @@ let fill sep = function
     in
     { view = Fill { sep; l }; wfl }
 
-let fill_map sep f l = fill sep (List.map f l)
-
 let of_list ?(sep = nil) f l =
   let rec loop = function
     | [] -> nil
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 1501fcbc..1726b0bb 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -135,6 +135,10 @@ end
 val pp : Format.formatter -> t -> unit
 (** Pretty-print, using {!Pretty} and an unspecified margin. *)
 
+val debug : Format.formatter -> t -> unit
+(** Debug printer. This prints the structure of the document,
+    it does {b not} pretty-print it. See {!pp} or {!Pretty}. *)
+
 (** {2 Convenience functions} *)
 
 module Infix : sig