From c5c72e0a50165176eb98f34c893437d0adbfd217 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:06:22 -0400
Subject: [PATCH 01/18] move cbor tests

---
 {src/cbor/tests => tests/cbor}/appendix_a.json | 0
 {src/cbor/tests => tests/cbor}/dune            | 0
 {src/cbor/tests => tests/cbor}/t_appendix_a.ml | 0
 3 files changed, 0 insertions(+), 0 deletions(-)
 rename {src/cbor/tests => tests/cbor}/appendix_a.json (100%)
 rename {src/cbor/tests => tests/cbor}/dune (100%)
 rename {src/cbor/tests => tests/cbor}/t_appendix_a.ml (100%)

diff --git a/src/cbor/tests/appendix_a.json b/tests/cbor/appendix_a.json
similarity index 100%
rename from src/cbor/tests/appendix_a.json
rename to tests/cbor/appendix_a.json
diff --git a/src/cbor/tests/dune b/tests/cbor/dune
similarity index 100%
rename from src/cbor/tests/dune
rename to tests/cbor/dune
diff --git a/src/cbor/tests/t_appendix_a.ml b/tests/cbor/t_appendix_a.ml
similarity index 100%
rename from src/cbor/tests/t_appendix_a.ml
rename to tests/cbor/t_appendix_a.ml

From aa6b40342e6a5b48d91d6b4ab99137c6eb236c26 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:06:31 -0400
Subject: [PATCH 02/18] update ocamlformat

---
 .ocamlformat | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.ocamlformat b/.ocamlformat
index c9862378..f820496c 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,4 +1,4 @@
-version = 0.22.4
+version = 0.24.1
 profile=conventional
 margin=80
 if-then-else=k-r

From 03c25cb18fad4fa92286c589f92e46a4a5bd64b1 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:06:47 -0400
Subject: [PATCH 03/18] wip: add `Containers_pp` sub-library

this implements Wadler's pretty printers, albeit in a more eager way.
---
 src/pp/containers_pp.ml  | 310 +++++++++++++++++++++++++++++++++++++++
 src/pp/containers_pp.mli | 143 ++++++++++++++++++
 src/pp/dune              |   7 +
 3 files changed, 460 insertions(+)
 create mode 100644 src/pp/containers_pp.ml
 create mode 100644 src/pp/containers_pp.mli
 create mode 100644 src/pp/dune

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
new file mode 100644
index 00000000..57f73135
--- /dev/null
+++ b/src/pp/containers_pp.ml
@@ -0,0 +1,310 @@
+type t = {
+  view: view;  (** Document view *)
+  wfl: int;  (** Width if flattened *)
+}
+
+and view =
+  | Nil
+  | Newline
+  | Nest of int * t
+  | Append of t * t
+  | Char of char
+  | Text of string
+  | Text_sub of string * int * int
+  | Group of t
+  | Fill of { sep: t; l: t list }
+
+let nil : t = { view = Nil; wfl = 0 }
+let newline : t = { view = Newline; wfl = 1 }
+let nl = newline
+
+let char c =
+  if c = '\n' then
+    nl
+  else
+    { view = Char c; wfl = 1 }
+
+let nest i x : t =
+  match x.view with
+  | _ when i <= 0 -> x
+  | Nil -> nil
+  | _ -> { view = Nest (i, x); wfl = x.wfl }
+
+let append a b : t =
+  match a.view, b.view with
+  | Nil, _ -> b
+  | _, Nil -> a
+  | _ -> { view = Append (a, b); wfl = a.wfl + b.wfl }
+
+let group d : t =
+  match d.view with
+  | Nil -> nil
+  | Group _ -> d
+  | _ -> { view = Group d; wfl = d.wfl }
+
+let ( ^ ) = append
+let text_sub_ s i len : t = { view = Text_sub (s, i, len); wfl = len }
+
+(* Turn [str], which contains some newlines, into a document.
+   We make a concatenation of
+   each line's content followed by a newline.
+   Then we group the result so that it remains in a unified block. *)
+let split_text_ (str : string) : t =
+  let cur = ref nil in
+  let i = ref 0 in
+  let len = String.length str in
+  while !i < len do
+    match String.index_from str !i '\n' with
+    | exception Not_found ->
+      (* last chunk *)
+      if !i + 1 < len then cur := !cur ^ text_sub_ str !i (len - 1 - !i);
+      i := len
+    | j ->
+      cur := !cur ^ text_sub_ str !i (j - 1 - !i) ^ nl;
+      i := j + 1
+  done;
+  group !cur
+
+let text (str : string) : t =
+  if str = "" then
+    nil
+  else if String.contains str '\n' then
+    split_text_ str
+  else
+    { view = Text str; wfl = String.length str }
+
+let textpf fmt = Printf.ksprintf text fmt
+let textf fmt = Format.kasprintf text fmt
+
+module B = Buffer
+
+module Flatten = struct
+  let to_buffer buf (self : t) : unit =
+    let rec loop (d : t) =
+      match d.view with
+      | Nil -> ()
+      | Char c -> B.add_char buf c
+      | Newline -> B.add_char buf ' '
+      | Nest (_, x) -> loop x
+      | Append (x, y) ->
+        loop x;
+        loop y
+      | Text s -> B.add_string buf s
+      | Text_sub (s, i, len) -> B.add_substring buf s i len
+      | Group x -> loop x
+      | Fill { sep; l } ->
+        List.iteri
+          (fun i x ->
+            if i > 0 then loop sep;
+            loop x)
+          l
+    in
+    loop self
+
+  let to_string self : string =
+    let buf = Buffer.create 32 in
+    to_buffer buf self;
+    Buffer.contents buf
+end
+
+module Pretty = struct
+  type st = { buf: Buffer.t; width: int }
+
+  (** Add [i] spaces of indentation. *)
+  let add_indent (st : st) (i : int) =
+    for _i = 1 to i do
+      B.add_char st.buf ' '
+    done
+
+  let rec pp_flatten (st : st) (self : t) : int =
+    match self.view with
+    | Nil -> 0
+    | Char c ->
+      B.add_char st.buf c;
+      1
+    | Newline ->
+      B.add_char st.buf ' ';
+      1
+    | Nest (_i, x) -> pp_flatten st x
+    | Append (x, y) ->
+      let n = pp_flatten st x in
+      n + pp_flatten st y
+    | Text s ->
+      B.add_string st.buf s;
+      String.length s
+    | Text_sub (s, i, len) ->
+      B.add_substring st.buf s i len;
+      len
+    | Group x -> pp_flatten st x
+    | Fill { sep; l } ->
+      (* print separated by spaces *)
+      let n = ref 0 in
+      List.iteri
+        (fun i x ->
+          if i > 0 then n := !n + pp_flatten st sep;
+          n := !n + pp_flatten st x)
+        l;
+      !n
+
+  (** Does [x] fit in the current line when flattened, given that [k] chars
+          are already on the line? *)
+  let[@inline] fits_flattened st k x = x.wfl <= st.width - k
+
+  let pp_newline st i =
+    B.add_char st.buf '\n';
+    add_indent st i
+
+  (** Print [self] into the buffer.
+      @param k how many chars are already printed on the current line
+  *)
+  let rec pp_rec (st : st) (k : int) (stack : (int * t) list) : unit =
+    match stack with
+    | [] -> ()
+    | (i, d) :: stack_tl ->
+      pp_rec_top st ~k ~i d (fun k -> pp_rec st k stack_tl)
+
+  (** Print [d] at indentation [i], with [k] chars already printed
+        on the current line, then calls [kont] with the
+        new [k]. *)
+  and pp_rec_top st ~k ~i d (kont : int -> unit) : unit =
+    match d.view with
+    | Nil -> kont k
+    | Char c ->
+      B.add_char st.buf c;
+      kont (k + 1)
+    | Newline ->
+      pp_newline st i;
+      kont i
+    | Nest (j, x) -> pp_rec_top st ~k ~i:(i + j) x kont
+    | Append (x, y) ->
+      (* print [x], then print [y] *)
+      pp_rec_top st ~k ~i x (fun k -> pp_rec_top st ~k ~i y kont)
+    | Text s ->
+      B.add_string st.buf s;
+      kont (k + String.length s)
+    | Text_sub (s, i, len) ->
+      B.add_substring st.buf s i len;
+      kont (k + len)
+    | Group x ->
+      if fits_flattened st k x then (
+        (* print flattened *)
+        let w_x = pp_flatten st x in
+        assert (w_x = x.wfl);
+        kont (k + w_x)
+      ) else
+        pp_rec_top st ~k ~i x kont
+    | Fill { sep; l } -> pp_fill st ~k ~i sep l kont
+
+  and pp_fill st ~k ~i sep l (kont : int -> unit) : unit =
+    (* [k] is the current offset in the line *)
+    let rec loop idx k l =
+      match l with
+      | x :: tl ->
+        if fits_flattened st k x then (
+          (* all flattened *)
+          let w_sep =
+            if idx = 0 then
+              0
+            else
+              pp_flatten st sep
+          in
+          let w_x = pp_flatten st x in
+          assert (w_x = x.wfl);
+          loop (idx + 1) (k + w_x + w_sep) tl
+        ) else (
+          (* print, followed by a newline and resume filling with [k=i] *)
+          let pp_and_continue k =
+            pp_rec_top st ~k ~i x (fun k -> loop (idx + 1) k tl)
+          in
+          if idx > 0 then
+            (* separator, then item *)
+            pp_rec_top st ~k ~i sep pp_and_continue
+          else
+            pp_and_continue k
+        )
+      | [] -> kont k
+    in
+    loop 0 k l
+
+  let to_buffer ~width (buf : Buffer.t) (self : t) : unit =
+    let st = { buf; width } in
+    pp_rec st 0 [ 0, self ]
+
+  let to_string ~width (self : t) : string =
+    let buf = Buffer.create 32 in
+    to_buffer ~width buf self;
+    Buffer.contents buf
+
+  let to_format ~width out self : unit =
+    (* TODO: more efficient implementation *)
+    CCFormat.string_lines out (to_string ~width self)
+end
+
+let pp = Pretty.to_format ~width:80
+
+(* helpers *)
+
+let sp = char ' '
+
+module Infix = struct
+  let ( ^ ) = append
+  let[@inline] ( ^+ ) x y = x ^ sp ^ y
+  let[@inline] ( ^/ ) x y = x ^ nl ^ y
+end
+
+include Infix
+
+let true_ = text "true"
+let false_ = text "false"
+
+let bool b =
+  if b then
+    true_
+  else
+    false_
+
+let int x : t = text (string_of_int x)
+let float x : t = text (string_of_float x)
+let float_hex x : t = textpf "%h" x
+
+let append_l ?(sep = nil) l =
+  let rec loop = function
+    | [] -> nil
+    | [ x ] -> x
+    | x :: tl -> x ^ sep ^ loop tl
+  in
+  loop l
+
+let append_sp l = append_l ~sep:sp l
+let append_nl l = append_l ~sep:nl l
+
+let fill sep = function
+  | [] -> nil
+  | [ x ] -> x
+  | l ->
+    (* flattened: just like concat *)
+    let wfl =
+      List.fold_left (fun wfl x -> wfl + x.wfl) 0 l
+      + ((List.length l - 1) * sep.wfl)
+    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
+    | [ x ] -> f x
+    | x :: tl -> f x ^ sep ^ loop tl
+  in
+  loop l
+
+let bracket l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
+let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
+let sexp_apply a l : t = sexp_l (text a :: l)
+
+module Dump = struct
+  let list l : t =
+    let sep = char ';' ^ nl in
+    group (char '[' ^ nest 1 (fill sep l) ^ char ']')
+end
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
new file mode 100644
index 00000000..30d86aee
--- /dev/null
+++ b/src/pp/containers_pp.mli
@@ -0,0 +1,143 @@
+(** Pretty printing of documents.
+
+    A document is a structured tree of text with
+    formatting instructions.
+
+    It can be rendered into a string ("pretty printed"),
+    see {!Pretty}.
+
+    This follows Wadler's paper "A prettier printer", but with
+    some changes in the rendering part because we can't rely on lazyness
+    to make the algebraic implementation efficient.
+*)
+
+(** {2 Core} *)
+
+type t
+(** The type of documents *)
+
+val nil : t
+(** Empty document *)
+
+val char : char -> t
+(** Single char. *)
+
+val text : string -> t
+(** Text. The string will be split on ['\n']. *)
+
+val textpf : ('a, unit, string, t) format4 -> 'a
+(** Text, with a {!Printf}-compatible format.
+
+    For example, [textpf "%d-%d" 4 2] is like [text "4-2"]. *)
+
+val textf : ('a, Format.formatter, unit, t) format4 -> 'a
+(** Text, with a {!Format}-compatible format.
+
+    Note that this will bake-in any formatting done by {!Format}.
+    Newlines introduced by format will become hard newlines
+    in the resulting document. *)
+
+val nest : int -> t -> t
+(** Increase indentation by [n]. *)
+
+val group : t -> t
+(** Group the documents inside this.
+
+    Newlines immediately inside this group will either
+    render as new lines or as spaces, depending on the width available. *)
+
+val append : t -> t -> t
+(** Concatenation. *)
+
+val newline : t
+(** A line break. *)
+
+val nl : t
+(** Alias for {!newline} *)
+
+(* TODO:
+val ext : pre:(unit -> string) -> post:(unit -> string) -> t -> t
+(** Extension. This is a custom-rendered document.
+    TODO: customize how long it is?
+    TODO: generic output, not [unit -> string]
+ *)
+ *)
+
+(** {2 Pretty print and rendering} *)
+
+(** Pretty-printing.
+
+    These functions are parametrized by a width,
+    and will try to fit the result within this width. *)
+module Pretty : sig
+  val to_string : width:int -> t -> string
+  (** Render to a string. *)
+
+  val to_buffer : width:int -> Buffer.t -> t -> unit
+  (** Render to a buffer. *)
+
+  val to_format : width:int -> Format.formatter -> t -> unit
+end
+
+(** Trivial printing, on a single line.
+
+    This is generally ugly, but it's simple and fast when we do not
+    care about looks. *)
+module Flatten : sig
+  val to_buffer : Buffer.t -> t -> unit
+  val to_string : t -> string
+end
+
+val pp : Format.formatter -> t -> unit
+
+(** {2 Convenience functions *)
+
+module Infix : sig
+  val ( ^ ) : t -> t -> t
+  (** Alias of {!append}. *)
+
+  val ( ^+ ) : t -> t -> t
+  (** [x ^+ y] is [x ^ text " " ^ y] *)
+
+  val ( ^/ ) : t -> t -> t
+  (** [x ^/ y] is [x ^ newline ^ y] *)
+end
+
+include module type of Infix
+
+val sp : t
+(** A single space *)
+
+val append_l : ?sep:t -> t list -> t
+(** [append_l ?sep l] is the concatenation of elements of
+    [l], separated by [sep] (default [nil]) *)
+
+val append_sp : t list -> t
+(** [append_sp l] is the concatenation of elements of [l], separated by [' '] *)
+
+val append_nl : t list -> t
+(** Same as {!append_l} with [sep=nl] *)
+
+val bool : bool -> t
+val int : int -> t
+val float : float -> t
+val float_hex : float -> t
+
+val of_list : ?sep:t -> ('a -> t) -> 'a list -> t
+(** [of_list f l] maps each element of [l] to a document
+    and concatenates them.
+    @param sep separator inserted between elements (default [nil]) *)
+
+val bracket : string -> t -> string -> t
+(** [bracket l d r] groups [d], indented, between brackets [l] and [r] *)
+
+val sexp_apply : string -> t list -> t
+(** [sexp_apply a l] is the S-expr ["(text a …l)"], pretty-printed *)
+
+val sexp_l : t list -> t
+(** [sexp_l [l1;…ln]] is the S-expr ["(l1 l2…ln)"], pretty-printed *)
+
+(** Printers that correspond closely to OCaml's syntax. *)
+module Dump : sig
+  val list : t list -> t
+end
diff --git a/src/pp/dune b/src/pp/dune
new file mode 100644
index 00000000..2220457c
--- /dev/null
+++ b/src/pp/dune
@@ -0,0 +1,7 @@
+
+(library
+  (name containers_pp)
+  (public_name containers.pp)
+  (synopsis "Pretty printer for Containers")
+  (flags :standard)
+  (libraries containers))

From cea844fddeab2c65db3b676feefa626d192e7649 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:07:15 -0400
Subject: [PATCH 04/18] add tests for Pp

---
 tests/core/dune    |  3 ++-
 tests/core/t.ml    |  1 +
 tests/core/t_pp.ml | 41 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 44 insertions(+), 1 deletion(-)
 create mode 100644 tests/core/t_pp.ml

diff --git a/tests/core/dune b/tests/core/dune
index e17dd3a6..89c12c06 100644
--- a/tests/core/dune
+++ b/tests/core/dune
@@ -6,5 +6,6 @@
  (preprocess
   (action
    (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
- (libraries containers containers.bencode containers.cbor containers.unix
+ (libraries containers containers.bencode containers.cbor
+            containers.unix containers.pp
    threads containers_testlib iter gen uutf csexp))
diff --git a/tests/core/t.ml b/tests/core/t.ml
index e5d27999..8508555a 100644
--- a/tests/core/t.ml
+++ b/tests/core/t.ml
@@ -1,5 +1,6 @@
 Containers_testlib.run_all ~descr:"containers"
   [
+    T_pp.get ();
     T_list.get ();
     T_array.get ();
     T_bool.get ();
diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
new file mode 100644
index 00000000..b782a942
--- /dev/null
+++ b/tests/core/t_pp.ml
@@ -0,0 +1,41 @@
+include (val Containers_testlib.make ~__FILE__ ())
+open Containers_pp
+
+let spf = Printf.sprintf
+
+let () =
+  eq "hello world" (Flatten.to_string @@ text "hello" ^ newline ^ text "world")
+
+let () =
+  eq ~name:"l1" ~printer:(spf "%S") "[0; 1; 2; 3;\n 4; 5; 6; 7;\n 8; 9]"
+    (let d = Dump.list (List.init 10 int) in
+     Pretty.to_string ~width:10 d)
+
+let () =
+  eq ~name:"l2" ~printer:(spf "%S")
+    "[[0; 1; 2; 3;\n\
+    \  4; 5];\n\
+    \ [1; 2; 3; 4;\n\
+    \  5; 6];\n\
+    \ [2; 3; 4; 5;\n\
+    \  6; 7];\n\
+    \ [3; 4; 5; 6;\n\
+    \  7; 8];\n\
+    \ [4; 5; 6; 7;\n\
+    \  8; 9];\n\
+    \ [5; 6; 7; 8;\n\
+    \  9; 10]]"
+    (let d =
+       Dump.list
+         (List.init 6 (fun i ->
+              Dump.list (List.init 6 (fun j -> int @@ (i + j)))))
+     in
+     Pretty.to_string ~width:10 d)
+
+let () =
+  eq ~name:"s1" ~printer:(spf "%S") "(foo\n bar\n baaz\n (g 42 10))"
+    (let d =
+       sexp_apply "foo"
+         [ text "bar"; text "baaz"; sexp_apply "g" [ int 42; int 10 ] ]
+     in
+     Pretty.to_string ~width:10 d)

From d36c57459e331ba5d386bad92e9077c0388fb621 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:20:41 -0400
Subject: [PATCH 05/18] feat(Pp): add `wrap` for extension nodes

---
 src/pp/containers_pp.ml  | 52 ++++++++++++++++++++++++++++++++++++++--
 src/pp/containers_pp.mli | 43 +++++++++++++++++++++++++++------
 tests/core/t_pp.ml       | 19 +++++++++++++++
 3 files changed, 105 insertions(+), 9 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 57f73135..a5f06df2 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -1,3 +1,33 @@
+module B = Buffer
+
+module Ext = struct
+  module type OUT = sig
+    val char : char -> unit
+    val sub_string : string -> int -> int -> unit
+    val string : string -> unit
+    val newline : unit -> unit
+  end
+
+  type out = (module OUT)
+
+  let out_of_buf (buf : Buffer.t) : out =
+    (module struct
+      let char = B.add_char buf
+      let sub_string = B.add_substring buf
+      let string = B.add_string buf
+      let newline () = B.add_char buf '\n'
+    end)
+
+  module type S = sig
+    type t
+
+    val pre : out -> t -> unit
+    val post : out -> t -> unit
+  end
+
+  type 'a t = (module S with type t = 'a)
+end
+
 type t = {
   view: view;  (** Document view *)
   wfl: int;  (** Width if flattened *)
@@ -13,6 +43,7 @@ and view =
   | Text_sub of string * int * int
   | Group of t
   | Fill of { sep: t; l: t list }
+  | Wrap : 'a Ext.t * 'a * t -> view
 
 let nil : t = { view = Nil; wfl = 0 }
 let newline : t = { view = Newline; wfl = 1 }
@@ -42,6 +73,7 @@ let group d : t =
   | Group _ -> d
   | _ -> { view = Group d; wfl = d.wfl }
 
+let wrap ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl }
 let ( ^ ) = append
 let text_sub_ s i len : t = { view = Text_sub (s, i, len); wfl = len }
 
@@ -76,8 +108,6 @@ let text (str : string) : t =
 let textpf fmt = Printf.ksprintf text fmt
 let textf fmt = Format.kasprintf text fmt
 
-module B = Buffer
-
 module Flatten = struct
   let to_buffer buf (self : t) : unit =
     let rec loop (d : t) =
@@ -98,7 +128,13 @@ module Flatten = struct
             if i > 0 then loop sep;
             loop x)
           l
+      | Wrap ((module E), v, d) ->
+        let out = Ext.out_of_buf buf in
+        E.pre out v;
+        loop d;
+        E.post out v
     in
+
     loop self
 
   let to_string self : string =
@@ -145,6 +181,12 @@ module Pretty = struct
           n := !n + pp_flatten st x)
         l;
       !n
+    | Wrap ((module E), v, d) ->
+      let out = Ext.out_of_buf st.buf in
+      E.pre out v;
+      let n = pp_flatten st d in
+      E.post out v;
+      n
 
   (** Does [x] fit in the current line when flattened, given that [k] chars
           are already on the line? *)
@@ -194,6 +236,12 @@ module Pretty = struct
       ) else
         pp_rec_top st ~k ~i x kont
     | Fill { sep; l } -> pp_fill st ~k ~i sep l kont
+    | Wrap ((module E), v, d) ->
+      let out = Ext.out_of_buf st.buf in
+      E.pre out v;
+      pp_rec_top st ~k ~i d (fun k ->
+          E.post out v;
+          kont k)
 
   and pp_fill st ~k ~i sep l (kont : int -> unit) : unit =
     (* [k] is the current offset in the line *)
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 30d86aee..5564fa6e 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -55,13 +55,42 @@ val newline : t
 val nl : t
 (** Alias for {!newline} *)
 
-(* TODO:
-val ext : pre:(unit -> string) -> post:(unit -> string) -> t -> t
-(** Extension. This is a custom-rendered document.
-    TODO: customize how long it is?
-    TODO: generic output, not [unit -> string]
- *)
- *)
+(** Extension node.
+
+    In here, we can stuff custom printer nodes. *)
+module Ext : sig
+  module type OUT = sig
+    val char : char -> unit
+    val sub_string : string -> int -> int -> unit
+    val string : string -> unit
+    val newline : unit -> unit
+  end
+
+  type out = (module OUT)
+
+  module type S = sig
+    type t
+
+    val pre : out -> t -> unit
+    val post : out -> t -> unit
+  end
+
+  type 'a t = (module S with type t = 'a)
+end
+
+val wrap : 'a Ext.t -> 'a -> t -> t
+(** [wrap ext v d] wraps [d] with value [v].
+
+    It is a document that has the same
+    shape (and size) as [d], except that additional data will
+    be output when it is rendered.
+
+    Let [(module Ext)] be [ext], and [out]
+    be the output buffer/stream for rendering.
+
+    When this is rendered, first [Ext.pre out v] is called;
+    then [d] is printed; then [Exp.post out v] is called.
+*)
 
 (** {2 Pretty print and rendering} *)
 
diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
index b782a942..c5ce3309 100644
--- a/tests/core/t_pp.ml
+++ b/tests/core/t_pp.ml
@@ -39,3 +39,22 @@ let () =
          [ text "bar"; text "baaz"; sexp_apply "g" [ int 42; int 10 ] ]
      in
      Pretty.to_string ~width:10 d)
+
+module Ext_coucou : Ext.S with type t = unit = struct
+  type t = unit
+
+  let pre (module O : Ext.OUT) () = O.string "<coucou>"
+  let post (module O : Ext.OUT) () = O.string "</coucou>"
+end
+
+let () =
+  eq ~name:"wrap1" ~printer:(spf "%S")
+    "(foo\n bar\n <coucou>(g 42 10)</coucou>)"
+    (let d =
+       sexp_apply "foo"
+         [
+           text "bar";
+           wrap (module Ext_coucou) () (sexp_apply "g" [ int 42; int 10 ]);
+         ]
+     in
+     Pretty.to_string ~width:10 d)

From 4d77a17029a7f02cc43712b27999b992c347ce4d Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:33:01 -0400
Subject: [PATCH 06/18] Pp: expose generic output; simplify extensions

---
 src/pp/containers_pp.ml  | 119 ++++++++++++++++++++-------------------
 src/pp/containers_pp.mli |  43 ++++++++------
 tests/core/t_pp.ml       |  16 ++----
 3 files changed, 93 insertions(+), 85 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index a5f06df2..467020d7 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -1,31 +1,31 @@
 module B = Buffer
 
+module Out = struct
+  type t = {
+    char: char -> unit;
+        (** Output a single char. The char is assumed not to be ['\n']. *)
+    sub_string: string -> int -> int -> unit;
+        (** Output a string slice (optim for [string]) *)
+    string: string -> unit;  (** Output a string *)
+    raw_string: string -> unit;
+        (** Output a string that should not be modified in any way *)
+    newline: unit -> unit;  (** Output a newline *)
+  }
+
+  let of_buffer (buf : Buffer.t) : t =
+    let char = B.add_char buf in
+    let sub_string = B.add_substring buf in
+    let string = B.add_string buf in
+    let newline () = B.add_char buf '\n' in
+    let raw_string = string in
+    { char; sub_string; string; newline; raw_string }
+end
+
 module Ext = struct
-  module type OUT = sig
-    val char : char -> unit
-    val sub_string : string -> int -> int -> unit
-    val string : string -> unit
-    val newline : unit -> unit
-  end
-
-  type out = (module OUT)
-
-  let out_of_buf (buf : Buffer.t) : out =
-    (module struct
-      let char = B.add_char buf
-      let sub_string = B.add_substring buf
-      let string = B.add_string buf
-      let newline () = B.add_char buf '\n'
-    end)
-
-  module type S = sig
-    type t
-
-    val pre : out -> t -> unit
-    val post : out -> t -> unit
-  end
-
-  type 'a t = (module S with type t = 'a)
+  type 'a t = {
+    pre: Out.t -> 'a -> unit;  (** Printed before the wrapped value. *)
+    post: Out.t -> 'a -> unit;  (** Printed after the wrapped value. *)
+  }
 end
 
 type t = {
@@ -109,18 +109,18 @@ let textpf fmt = Printf.ksprintf text fmt
 let textf fmt = Format.kasprintf text fmt
 
 module Flatten = struct
-  let to_buffer buf (self : t) : unit =
+  let to_out (out : Out.t) (self : t) : unit =
     let rec loop (d : t) =
       match d.view with
       | Nil -> ()
-      | Char c -> B.add_char buf c
-      | Newline -> B.add_char buf ' '
+      | Char c -> out.char c
+      | Newline -> out.char ' '
       | Nest (_, x) -> loop x
       | Append (x, y) ->
         loop x;
         loop y
-      | Text s -> B.add_string buf s
-      | Text_sub (s, i, len) -> B.add_substring buf s i len
+      | Text s -> out.string s
+      | Text_sub (s, i, len) -> out.sub_string s i len
       | Group x -> loop x
       | Fill { sep; l } ->
         List.iteri
@@ -128,15 +128,17 @@ module Flatten = struct
             if i > 0 then loop sep;
             loop x)
           l
-      | Wrap ((module E), v, d) ->
-        let out = Ext.out_of_buf buf in
-        E.pre out v;
+      | Wrap (ext, v, d) ->
+        ext.pre out v;
         loop d;
-        E.post out v
+        ext.post out v
     in
-
     loop self
 
+  let to_buffer buf (self : t) : unit =
+    let out = Out.of_buffer buf in
+    to_out out self
+
   let to_string self : string =
     let buf = Buffer.create 32 in
     to_buffer buf self;
@@ -144,32 +146,32 @@ module Flatten = struct
 end
 
 module Pretty = struct
-  type st = { buf: Buffer.t; width: int }
+  type st = { out: Out.t; width: int }
 
   (** Add [i] spaces of indentation. *)
-  let add_indent (st : st) (i : int) =
+  let add_indent st (i : int) =
     for _i = 1 to i do
-      B.add_char st.buf ' '
+      st.out.char ' '
     done
 
   let rec pp_flatten (st : st) (self : t) : int =
     match self.view with
     | Nil -> 0
     | Char c ->
-      B.add_char st.buf c;
+      st.out.char c;
       1
     | Newline ->
-      B.add_char st.buf ' ';
+      st.out.char ' ';
       1
     | Nest (_i, x) -> pp_flatten st x
     | Append (x, y) ->
       let n = pp_flatten st x in
       n + pp_flatten st y
     | Text s ->
-      B.add_string st.buf s;
+      st.out.string s;
       String.length s
     | Text_sub (s, i, len) ->
-      B.add_substring st.buf s i len;
+      st.out.sub_string s i len;
       len
     | Group x -> pp_flatten st x
     | Fill { sep; l } ->
@@ -181,19 +183,18 @@ module Pretty = struct
           n := !n + pp_flatten st x)
         l;
       !n
-    | Wrap ((module E), v, d) ->
-      let out = Ext.out_of_buf st.buf in
-      E.pre out v;
+    | Wrap (ext, v, d) ->
+      ext.pre st.out v;
       let n = pp_flatten st d in
-      E.post out v;
+      ext.post st.out v;
       n
 
   (** Does [x] fit in the current line when flattened, given that [k] chars
           are already on the line? *)
   let[@inline] fits_flattened st k x = x.wfl <= st.width - k
 
-  let pp_newline st i =
-    B.add_char st.buf '\n';
+  let pp_newline (st : st) i =
+    st.out.char '\n';
     add_indent st i
 
   (** Print [self] into the buffer.
@@ -212,7 +213,7 @@ module Pretty = struct
     match d.view with
     | Nil -> kont k
     | Char c ->
-      B.add_char st.buf c;
+      st.out.char c;
       kont (k + 1)
     | Newline ->
       pp_newline st i;
@@ -222,10 +223,10 @@ module Pretty = struct
       (* print [x], then print [y] *)
       pp_rec_top st ~k ~i x (fun k -> pp_rec_top st ~k ~i y kont)
     | Text s ->
-      B.add_string st.buf s;
+      st.out.string s;
       kont (k + String.length s)
     | Text_sub (s, i, len) ->
-      B.add_substring st.buf s i len;
+      st.out.sub_string s i len;
       kont (k + len)
     | Group x ->
       if fits_flattened st k x then (
@@ -236,11 +237,10 @@ module Pretty = struct
       ) else
         pp_rec_top st ~k ~i x kont
     | Fill { sep; l } -> pp_fill st ~k ~i sep l kont
-    | Wrap ((module E), v, d) ->
-      let out = Ext.out_of_buf st.buf in
-      E.pre out v;
+    | Wrap (ext, v, d) ->
+      ext.pre st.out v;
       pp_rec_top st ~k ~i d (fun k ->
-          E.post out v;
+          ext.post st.out v;
           kont k)
 
   and pp_fill st ~k ~i sep l (kont : int -> unit) : unit =
@@ -274,17 +274,20 @@ module Pretty = struct
     in
     loop 0 k l
 
-  let to_buffer ~width (buf : Buffer.t) (self : t) : unit =
-    let st = { buf; width } in
+  let to_out ~width out (self : t) : unit =
+    let st = { out; width } in
     pp_rec st 0 [ 0, self ]
 
+  let to_buffer ~width (buf : Buffer.t) (self : t) : unit =
+    to_out ~width (Out.of_buffer buf) self
+
   let to_string ~width (self : t) : string =
     let buf = Buffer.create 32 in
     to_buffer ~width buf self;
     Buffer.contents buf
 
   let to_format ~width out self : unit =
-    (* TODO: more efficient implementation *)
+    (* TODO: more efficient implementation based on out *)
     CCFormat.string_lines out (to_string ~width self)
 end
 
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 5564fa6e..5e29c968 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -55,27 +55,32 @@ val newline : t
 val nl : t
 (** Alias for {!newline} *)
 
+(** Arbitrary output.
+
+    This is used for user-provided output. *)
+module Out : sig
+  type t = {
+    char: char -> unit;
+        (** Output a single char. The char is assumed not to be ['\n']. *)
+    sub_string: string -> int -> int -> unit;
+        (** Output a string slice (optim for [string]) *)
+    string: string -> unit;  (** Output a string *)
+    raw_string: string -> unit;
+        (** Output a string that should not be modified in any way *)
+    newline: unit -> unit;  (** Output a newline *)
+  }
+
+  val of_buffer : Buffer.t -> t
+end
+
 (** Extension node.
 
     In here, we can stuff custom printer nodes. *)
 module Ext : sig
-  module type OUT = sig
-    val char : char -> unit
-    val sub_string : string -> int -> int -> unit
-    val string : string -> unit
-    val newline : unit -> unit
-  end
-
-  type out = (module OUT)
-
-  module type S = sig
-    type t
-
-    val pre : out -> t -> unit
-    val post : out -> t -> unit
-  end
-
-  type 'a t = (module S with type t = 'a)
+  type 'a t = {
+    pre: Out.t -> 'a -> unit;  (** Printed before the wrapped value. *)
+    post: Out.t -> 'a -> unit;  (** Printed after the wrapped value. *)
+  }
 end
 
 val wrap : 'a Ext.t -> 'a -> t -> t
@@ -99,6 +104,9 @@ val wrap : 'a Ext.t -> 'a -> t -> t
     These functions are parametrized by a width,
     and will try to fit the result within this width. *)
 module Pretty : sig
+  val to_out : width:int -> Out.t -> t -> unit
+  (** Render to an arbitrary output. *)
+
   val to_string : width:int -> t -> string
   (** Render to a string. *)
 
@@ -113,6 +121,7 @@ end
     This is generally ugly, but it's simple and fast when we do not
     care about looks. *)
 module Flatten : sig
+  val to_out : Out.t -> t -> unit
   val to_buffer : Buffer.t -> t -> unit
   val to_string : t -> string
 end
diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
index c5ce3309..958c8190 100644
--- a/tests/core/t_pp.ml
+++ b/tests/core/t_pp.ml
@@ -40,21 +40,17 @@ let () =
      in
      Pretty.to_string ~width:10 d)
 
-module Ext_coucou : Ext.S with type t = unit = struct
-  type t = unit
-
-  let pre (module O : Ext.OUT) () = O.string "<coucou>"
-  let post (module O : Ext.OUT) () = O.string "</coucou>"
-end
+let ext_coucou =
+  {
+    Ext.pre = (fun out () -> out.string "<coucou>");
+    post = (fun out () -> out.string "</coucou>");
+  }
 
 let () =
   eq ~name:"wrap1" ~printer:(spf "%S")
     "(foo\n bar\n <coucou>(g 42 10)</coucou>)"
     (let d =
        sexp_apply "foo"
-         [
-           text "bar";
-           wrap (module Ext_coucou) () (sexp_apply "g" [ int 42; int 10 ]);
-         ]
+         [ text "bar"; wrap ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ]
      in
      Pretty.to_string ~width:10 d)

From 91a2ecee4add936a6ff68a430620a473b09b8a83 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 30 Mar 2023 23:42:21 -0400
Subject: [PATCH 07/18] Pp: rename wrap to ext; more doc, more combinators

---
 src/pp/containers_pp.ml  | 17 ++++++++++++++++-
 src/pp/containers_pp.mli | 31 ++++++++++++++++++++++---------
 src/pp/dune              |  2 +-
 tests/core/t_pp.ml       |  2 +-
 4 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 467020d7..36a78bbc 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -73,7 +73,7 @@ let group d : t =
   | Group _ -> d
   | _ -> { view = Group d; wfl = d.wfl }
 
-let wrap ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl }
+let ext ext v d : t = { view = Wrap (ext, v, d); wfl = d.wfl }
 let ( ^ ) = append
 let text_sub_ s i len : t = { view = Text_sub (s, i, len); wfl = len }
 
@@ -317,6 +317,7 @@ let bool b =
 let int x : t = text (string_of_int x)
 let float x : t = text (string_of_float x)
 let float_hex x : t = textpf "%h" x
+let text_quoted s : t = text (Printf.sprintf "%S" s)
 
 let append_l ?(sep = nil) l =
   let rec loop = function
@@ -350,6 +351,20 @@ let of_list ?(sep = nil) f l =
   in
   loop l
 
+let of_seq ?(sep = nil) f seq : t =
+  let rec loop first seq =
+    match seq () with
+    | Seq.Nil -> nil
+    | Seq.Cons (x, tl) ->
+      let x = f x in
+      (if first then
+        x
+      else
+        sep ^ x)
+      ^ loop false tl
+  in
+  loop true seq
+
 let bracket l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
 let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
 let sexp_apply a l : t = sexp_l (text a :: l)
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 5e29c968..1501fcbc 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -55,6 +55,8 @@ val newline : t
 val nl : t
 (** Alias for {!newline} *)
 
+(** {2 Output device} *)
+
 (** Arbitrary output.
 
     This is used for user-provided output. *)
@@ -73,9 +75,14 @@ module Out : sig
   val of_buffer : Buffer.t -> t
 end
 
+(** {2 Extensibility} *)
+
 (** Extension node.
 
-    In here, we can stuff custom printer nodes. *)
+    Custom nodes can be used to add user-defined behavior to
+    the rendered output. For example, documents
+    might be annotated with ANSI-terminal colors, or
+    with HTML tags. *)
 module Ext : sig
   type 'a t = {
     pre: Out.t -> 'a -> unit;  (** Printed before the wrapped value. *)
@@ -83,18 +90,17 @@ module Ext : sig
   }
 end
 
-val wrap : 'a Ext.t -> 'a -> t -> t
-(** [wrap ext v d] wraps [d] with value [v].
+val ext : 'a Ext.t -> 'a -> t -> t
+(** [ext e v d] wraps [d] with value [v].
 
     It is a document that has the same
     shape (and size) as [d], except that additional data will
-    be output when it is rendered.
+    be output when it is rendered using extension [e].
 
-    Let [(module Ext)] be [ext], and [out]
-    be the output buffer/stream for rendering.
+    When this is rendered, first [e.pre out v] is called;
+    then [d] is printed; then [e.post out v] is called.
+    Here [out] is the output buffer/stream for rendering.
 
-    When this is rendered, first [Ext.pre out v] is called;
-    then [d] is printed; then [Exp.post out v] is called.
 *)
 
 (** {2 Pretty print and rendering} *)
@@ -127,8 +133,9 @@ module Flatten : sig
 end
 
 val pp : Format.formatter -> t -> unit
+(** Pretty-print, using {!Pretty} and an unspecified margin. *)
 
-(** {2 Convenience functions *)
+(** {2 Convenience functions} *)
 
 module Infix : sig
   val ( ^ ) : t -> t -> t
@@ -161,11 +168,17 @@ val int : int -> t
 val float : float -> t
 val float_hex : float -> t
 
+val text_quoted : string -> t
+(** [text_quoted s] is [text (spf "%S" s)] *)
+
 val of_list : ?sep:t -> ('a -> t) -> 'a list -> t
 (** [of_list f l] maps each element of [l] to a document
     and concatenates them.
     @param sep separator inserted between elements (default [nil]) *)
 
+val of_seq : ?sep:t -> ('a -> t) -> 'a Seq.t -> t
+(** Same as {!of_list} but with sequences. *)
+
 val bracket : string -> t -> string -> t
 (** [bracket l d r] groups [d], indented, between brackets [l] and [r] *)
 
diff --git a/src/pp/dune b/src/pp/dune
index 2220457c..fbf9d1fb 100644
--- a/src/pp/dune
+++ b/src/pp/dune
@@ -4,4 +4,4 @@
   (public_name containers.pp)
   (synopsis "Pretty printer for Containers")
   (flags :standard)
-  (libraries containers))
+  (libraries containers seq))
diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
index 958c8190..ca4f2f86 100644
--- a/tests/core/t_pp.ml
+++ b/tests/core/t_pp.ml
@@ -51,6 +51,6 @@ let () =
     "(foo\n bar\n <coucou>(g 42 10)</coucou>)"
     (let d =
        sexp_apply "foo"
-         [ text "bar"; wrap ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ]
+         [ text "bar"; ext ext_coucou () (sexp_apply "g" [ int 42; int 10 ]) ]
      in
      Pretty.to_string ~width:10 d)

From 94640e9efe49e062ceb544941a47293f41ffff0c Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 31 Mar 2023 22:42:18 -0400
Subject: [PATCH 08/18] comment

---
 src/pp/containers_pp.ml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 36a78bbc..5b8a68ed 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -287,7 +287,9 @@ module Pretty = struct
     Buffer.contents buf
 
   let to_format ~width out self : unit =
-    (* TODO: more efficient implementation based on out *)
+    (* TODO: more efficient implementation based on:
+      open a vbox; make custom out that directly emit Format.pp_foo calls;
+      render to this out. *)
     CCFormat.string_lines out (to_string ~width self)
 end
 

From 679534597d7cd07369a65b357e3c9415ca7fe91c Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 31 Mar 2023 22:45:24 -0400
Subject: [PATCH 09/18] fix(pp): slicing needs attention

---
 src/pp/containers_pp.ml | 8 ++++----
 tests/core/t_pp.ml      | 5 +++++
 2 files changed, 9 insertions(+), 4 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 5b8a68ed..51da3717 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -89,10 +89,10 @@ let split_text_ (str : string) : t =
     match String.index_from str !i '\n' with
     | exception Not_found ->
       (* last chunk *)
-      if !i + 1 < len then cur := !cur ^ text_sub_ str !i (len - 1 - !i);
+      if !i + 1 < len then cur := !cur ^ text_sub_ str !i (len - !i);
       i := len
     | j ->
-      cur := !cur ^ text_sub_ str !i (j - 1 - !i) ^ nl;
+      cur := !cur ^ text_sub_ str !i (j - !i) ^ nl;
       i := j + 1
   done;
   group !cur
@@ -288,8 +288,8 @@ module Pretty = struct
 
   let to_format ~width out self : unit =
     (* TODO: more efficient implementation based on:
-      open a vbox; make custom out that directly emit Format.pp_foo calls;
-      render to this out. *)
+       open a vbox; make custom out that directly emit Format.pp_foo calls;
+       render to this out. *)
     CCFormat.string_lines out (to_string ~width self)
 end
 
diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
index ca4f2f86..0769acfd 100644
--- a/tests/core/t_pp.ml
+++ b/tests/core/t_pp.ml
@@ -6,6 +6,11 @@ let spf = Printf.sprintf
 let () =
   eq "hello world" (Flatten.to_string @@ text "hello" ^ newline ^ text "world")
 
+let () =
+  eq ~name:"split text" ~printer:(spf "%S") "let rec f x =\n x+2\n"
+    (let d = text "let rec f x =\n x+2\n" in
+     Pretty.to_string ~width:15 d)
+
 let () =
   eq ~name:"l1" ~printer:(spf "%S") "[0; 1; 2; 3;\n 4; 5; 6; 7;\n 8; 9]"
     (let d = Dump.list (List.init 10 int) in

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 10/18] 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

From ae7b1aef4817d1686b85e6b1e9714a262876ab98 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 1 Apr 2023 00:31:18 -0400
Subject: [PATCH 11/18] compat

---
 tests/core/t_pp.ml | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests/core/t_pp.ml b/tests/core/t_pp.ml
index 0769acfd..747cde5a 100644
--- a/tests/core/t_pp.ml
+++ b/tests/core/t_pp.ml
@@ -13,7 +13,7 @@ let () =
 
 let () =
   eq ~name:"l1" ~printer:(spf "%S") "[0; 1; 2; 3;\n 4; 5; 6; 7;\n 8; 9]"
-    (let d = Dump.list (List.init 10 int) in
+    (let d = Dump.list (CCList.init 10 int) in
      Pretty.to_string ~width:10 d)
 
 let () =
@@ -32,8 +32,8 @@ let () =
     \  9; 10]]"
     (let d =
        Dump.list
-         (List.init 6 (fun i ->
-              Dump.list (List.init 6 (fun j -> int @@ (i + j)))))
+         (CCList.init 6 (fun i ->
+              Dump.list (CCList.init 6 (fun j -> int @@ (i + j)))))
      in
      Pretty.to_string ~width:10 d)
 

From 58596a9bd51a997aaa0a72d8284698d028d54302 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 1 Apr 2023 20:07:51 -0400
Subject: [PATCH 12/18] chore: makefile

---
 Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 9120f4c0..f77578bd 100644
--- a/Makefile
+++ b/Makefile
@@ -30,7 +30,7 @@ update_next_tag:
 	sed -i "s/NEXT_VERSION/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
 	sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli)
 
-WATCH?=@src/all @tests/runtest
+WATCH?=@src/check @tests/runtest
 watch:
 	@dune build $(WATCH) -w
 

From 1ed81107df65341a4f59c457ee72261b948b9ec3 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 1 Apr 2023 20:07:59 -0400
Subject: [PATCH 13/18] pp: expose fill and and fill_map

---
 src/pp/containers_pp.ml  | 2 ++
 src/pp/containers_pp.mli | 9 +++++++++
 2 files changed, 11 insertions(+)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 1543a4c7..6a6f41f1 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -358,6 +358,8 @@ 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 1726b0bb..06edd052 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -55,6 +55,12 @@ val newline : t
 val nl : t
 (** Alias for {!newline} *)
 
+val fill : t -> t list -> t
+(** [fill sep l] resembles [group (append_l ~sep l)], except it tries
+    to put as many items of [l] as possible on each line.
+
+    In terms of {!Format}, this is like the hov box. *)
+
 (** {2 Output device} *)
 
 (** Arbitrary output.
@@ -167,6 +173,9 @@ val append_sp : t list -> t
 val append_nl : t list -> t
 (** Same as {!append_l} with [sep=nl] *)
 
+val fill_map : t -> ('a -> t) -> 'a list -> t
+(** [fill_map sep f l] is [fill sep (List.map f l)] *)
+
 val bool : bool -> t
 val int : int -> t
 val float : float -> t

From 785932861b3a0a49c168d2c57e9eba70f7f3ae03 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 1 Apr 2023 20:21:59 -0400
Subject: [PATCH 14/18] helpers for pp

---
 src/pp/containers_pp.ml  | 10 ++++++----
 src/pp/containers_pp.mli | 32 ++++++++++++++++++++++++++++----
 2 files changed, 34 insertions(+), 8 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 6a6f41f1..56dc9cdb 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -7,8 +7,6 @@ module Out = struct
     sub_string: string -> int -> int -> unit;
         (** Output a string slice (optim for [string]) *)
     string: string -> unit;  (** Output a string *)
-    raw_string: string -> unit;
-        (** Output a string that should not be modified in any way *)
     newline: unit -> unit;  (** Output a newline *)
   }
 
@@ -17,8 +15,12 @@ module Out = struct
     let sub_string = B.add_substring buf in
     let string = B.add_string buf in
     let newline () = B.add_char buf '\n' in
-    let raw_string = string in
-    { char; sub_string; string; newline; raw_string }
+    { char; sub_string; string; newline }
+
+  let[@inline] char self c = self.char c
+  let[@inline] string self s = self.string s
+  let[@inline] sub_string self s i len = self.sub_string s i len
+  let[@inline] newline self = self.newline ()
 end
 
 module Ext = struct
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 06edd052..ffc76fad 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -9,6 +9,25 @@
     This follows Wadler's paper "A prettier printer", but with
     some changes in the rendering part because we can't rely on lazyness
     to make the algebraic implementation efficient.
+
+    Some general considerations: the type [t] is the type of documents,
+    a tree with text leaves that is pretty printed within a given width.
+
+    Layout is controlled via the combination of a few primitives:
+    - [newline] will either print a space or a newline. It is similar
+      to {!Format}'s ["@ "] in that sense. A big difference with [Format]
+      is that by default [newline] is actually a newline. It only
+      becomes a space if it's in a [group] small enough to fit
+      in the remainder of the current line.
+    - [group d] tries to write [d] on a single line if there's room.
+      If not, it has no effect.
+    - [nest n d] increases the indentation level inside [d]. Any newline
+      that is rendered as a new line is indented by [n] more spaces (which
+      are cumulative with surrounding [nest] calls).
+    - [append a b] (or [a ^ b]) just prints [a] followed by [b].
+    - [fill d] is a bit like [group] but it will try to cram
+      as much as possible on each line. It is not all-or-nothing
+      like [group].
 *)
 
 (** {2 Core} *)
@@ -23,7 +42,8 @@ val char : char -> t
 (** Single char. *)
 
 val text : string -> t
-(** Text. The string will be split on ['\n']. *)
+(** Text. The string will be split on ['\n'], which are replaced
+    by {!newline}. *)
 
 val textpf : ('a, unit, string, t) format4 -> 'a
 (** Text, with a {!Printf}-compatible format.
@@ -38,7 +58,9 @@ val textf : ('a, Format.formatter, unit, t) format4 -> 'a
     in the resulting document. *)
 
 val nest : int -> t -> t
-(** Increase indentation by [n]. *)
+(** [nest n d] increases indentation by [n] inside [d].
+    If current indentation is [m], then every newline inside [d]
+    will be followed by [n + m] leading spaces. *)
 
 val group : t -> t
 (** Group the documents inside this.
@@ -73,12 +95,14 @@ module Out : sig
     sub_string: string -> int -> int -> unit;
         (** Output a string slice (optim for [string]) *)
     string: string -> unit;  (** Output a string *)
-    raw_string: string -> unit;
-        (** Output a string that should not be modified in any way *)
     newline: unit -> unit;  (** Output a newline *)
   }
 
   val of_buffer : Buffer.t -> t
+  val char : t -> char -> unit
+  val string : t -> string -> unit
+  val sub_string : t -> string -> int -> int -> unit
+  val newline : t -> unit
 end
 
 (** {2 Extensibility} *)

From c1d980048dd319ab456aa3401f4feb6d596b872a Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sat, 1 Apr 2023 20:24:53 -0400
Subject: [PATCH 15/18] more doc

---
 src/pp/containers_pp.mli | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index ffc76fad..bed504d6 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -118,6 +118,11 @@ module Ext : sig
     pre: Out.t -> 'a -> unit;  (** Printed before the wrapped value. *)
     post: Out.t -> 'a -> unit;  (** Printed after the wrapped value. *)
   }
+  (**  An extension is a custom document node. It takes a value of type ['a],
+      and a document [d], and can output what it wants based
+      on the custom value before and after [d] is printed.
+
+      The extension is considered to have width [0]. *)
 end
 
 val ext : 'a Ext.t -> 'a -> t -> t

From adaecf470e7a3bca06fcf053a1556e92f8bcb434 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 7 Apr 2023 10:51:44 -0400
Subject: [PATCH 16/18] pp: add zero-width text; add `bracket2` combinator

---
 src/pp/containers_pp.ml  | 23 +++++++++++++++++------
 src/pp/containers_pp.mli |  8 +++++++-
 2 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index 56dc9cdb..d600909c 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -43,6 +43,7 @@ and view =
   | Char of char
   | Text of string
   | Text_sub of string * int * int
+  | Text_zero_width of string
   | Group of t
   | Fill of { sep: t; l: t list }
   | Wrap : 'a Ext.t * 'a * t -> view
@@ -56,6 +57,7 @@ let rec debug out (self : t) : unit =
   | 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_zero_width s -> Format.fprintf out "(zw %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 } ->
@@ -112,7 +114,7 @@ let split_text_ (str : string) : t =
       cur := !cur ^ text_sub_ str !i (j - !i) ^ nl;
       i := j + 1
   done;
-  group !cur
+  !cur
 
 let text (str : string) : t =
   if str = "" then
@@ -136,7 +138,7 @@ module Flatten = struct
       | Append (x, y) ->
         loop x;
         loop y
-      | Text s -> out.string s
+      | Text s | Text_zero_width s -> out.string s
       | Text_sub (s, i, len) -> out.sub_string s i len
       | Group x -> loop x
       | Fill { sep; l } ->
@@ -187,6 +189,9 @@ module Pretty = struct
     | Text s ->
       st.out.string s;
       String.length s
+    | Text_zero_width s ->
+      st.out.string s;
+      0
     | Text_sub (s, i, len) ->
       st.out.sub_string s i len;
       len
@@ -242,6 +247,9 @@ module Pretty = struct
     | Text s ->
       st.out.string s;
       kont (k + String.length s)
+    | Text_zero_width s ->
+      st.out.string s;
+      kont k
     | Text_sub (s, i, len) ->
       st.out.sub_string s i len;
       kont (k + len)
@@ -304,9 +312,7 @@ module Pretty = struct
     Buffer.contents buf
 
   let to_format ~width out self : unit =
-    (* TODO: more efficient implementation based on:
-       open a vbox; make custom out that directly emit Format.pp_foo calls;
-       render to this out. *)
+    (* TODO: more efficient implementation based on out *)
     CCFormat.string_lines out (to_string ~width self)
 end
 
@@ -338,6 +344,8 @@ let float x : t = text (string_of_float x)
 let float_hex x : t = textpf "%h" x
 let text_quoted s : t = text (Printf.sprintf "%S" s)
 
+let text_zero_width s : t = { view = Text_zero_width s; wfl = 0 }
+
 let append_l ?(sep = nil) l =
   let rec loop = function
     | [] -> nil
@@ -384,7 +392,10 @@ let of_seq ?(sep = nil) f seq : t =
   in
   loop true seq
 
-let bracket l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
+let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r)
+
+let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
+
 let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
 let sexp_apply a l : t = sexp_l (text a :: l)
 
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index bed504d6..c483dd1e 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -213,6 +213,9 @@ val float_hex : float -> t
 val text_quoted : string -> t
 (** [text_quoted s] is [text (spf "%S" s)] *)
 
+val text_zero_width : string -> t
+(** Text but we assume it takes no space on screen. *)
+
 val of_list : ?sep:t -> ('a -> t) -> 'a list -> t
 (** [of_list f l] maps each element of [l] to a document
     and concatenates them.
@@ -222,7 +225,10 @@ val of_seq : ?sep:t -> ('a -> t) -> 'a Seq.t -> t
 (** Same as {!of_list} but with sequences. *)
 
 val bracket : string -> t -> string -> t
-(** [bracket l d r] groups [d], indented, between brackets [l] and [r] *)
+(** [bracket l d r] groups [d], between brackets [l] and [r] *)
+
+val bracket2 : string -> t -> string -> t
+(** [bracket2 l d r] groups [d], indented by 2, between brackets [l] and [r] *)
 
 val sexp_apply : string -> t list -> t
 (** [sexp_apply a l] is the S-expr ["(text a …l)"], pretty-printed *)

From c2952e0ce6617cf4e20bc464646e92588eca4b90 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 7 Apr 2023 10:52:22 -0400
Subject: [PATCH 17/18] pp: add Term_color extension

---
 src/pp/containers_pp.ml  | 80 ++++++++++++++++++++++++++++++++++++++++
 src/pp/containers_pp.mli | 26 +++++++++++++
 2 files changed, 106 insertions(+)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index d600909c..b79c1f05 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -404,3 +404,83 @@ module Dump = struct
     let sep = char ';' ^ nl in
     group (char '[' ^ nest 1 (fill sep l) ^ char ']')
 end
+
+module Term_color = struct
+  type color =
+    [ `Black
+    | `Red
+    | `Yellow
+    | `Green
+    | `Blue
+    | `Magenta
+    | `Cyan
+    | `White
+    ]
+
+  type style =
+    [ `FG of color (* foreground *)
+    | `BG of color (* background *)
+    | `Bold
+    | `Reset
+    | `Underline
+    ]
+
+  open struct
+    let int_of_color_ = function
+      | `Black -> 0
+      | `Red -> 1
+      | `Green -> 2
+      | `Yellow -> 3
+      | `Blue -> 4
+      | `Magenta -> 5
+      | `Cyan -> 6
+      | `White -> 7
+
+    let code_of_style : style -> int = function
+      | `FG c -> 30 + int_of_color_ c
+      | `BG c -> 40 + int_of_color_ c
+      | `Bold -> 1
+      | `Reset -> 0
+      | `Underline -> 4
+
+    let spf = Printf.sprintf
+
+    let string_of_style a = spf "\x1b[%dm" (code_of_style a)
+
+    let reset = string_of_style `Reset
+
+    let string_of_style_list = function
+      | [] -> reset
+      | [ a ] -> string_of_style a
+      | [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
+      | [ a; b; c ] ->
+        spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b)
+          (code_of_style c)
+      | l ->
+        let buf = Buffer.create 32 in
+        let pp_num c =
+          Buffer.add_string buf (string_of_int (code_of_style c))
+        in
+        Buffer.add_string buf "\x1b[";
+        List.iteri
+          (fun i c ->
+            if i > 0 then Buffer.add_char buf ';';
+            pp_num c)
+          l;
+        Buffer.add_string buf "m";
+        Buffer.contents buf
+
+    (* TODO: handle nested styles *)
+    let ext_style_ : style list Ext.t =
+      {
+        pre = (fun out l -> Out.string out (string_of_style_list l));
+        post = (fun out _l -> Out.string out reset);
+      }
+  end
+
+  (** Set the foreground color. *)
+  let color (c : color) (d : t) : t = ext ext_style_ [ `FG c ] d
+
+  (** Set a full style for this document. *)
+  let style_l (l : style list) (d : t) : t = ext ext_style_ l d
+end
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index c483dd1e..8b7e5c3f 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -240,3 +240,29 @@ val sexp_l : t list -> t
 module Dump : sig
   val list : t list -> t
 end
+
+(** Simple colors in terminals *)
+module Term_color : sig
+  type color =
+    [ `Black
+    | `Blue
+    | `Cyan
+    | `Green
+    | `Magenta
+    | `Red
+    | `White
+    | `Yellow
+    ]
+
+  type style =
+    [ `BG of color
+    | `Bold
+    | `FG of color
+    | `Reset
+    | `Underline
+    ]
+
+  val color : color -> t -> t
+
+  val style_l : style list -> t -> t
+end

From 74e3a9e875863ffd2476c864e61e2e39c185fbdb Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Fri, 7 Apr 2023 11:05:52 -0400
Subject: [PATCH 18/18] compat, reformat

---
 src/pp/containers_pp.ml  | 105 ++++++++++++++++-----------------------
 src/pp/containers_pp.mli |  19 +------
 2 files changed, 45 insertions(+), 79 deletions(-)

diff --git a/src/pp/containers_pp.ml b/src/pp/containers_pp.ml
index b79c1f05..f10a8f1e 100644
--- a/src/pp/containers_pp.ml
+++ b/src/pp/containers_pp.ml
@@ -343,7 +343,6 @@ let int x : t = text (string_of_int x)
 let float x : t = text (string_of_float x)
 let float_hex x : t = textpf "%h" x
 let text_quoted s : t = text (Printf.sprintf "%S" s)
-
 let text_zero_width s : t = { view = Text_zero_width s; wfl = 0 }
 
 let append_l ?(sep = nil) l =
@@ -393,9 +392,7 @@ let of_seq ?(sep = nil) f seq : t =
   loop true seq
 
 let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r)
-
 let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
-
 let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
 let sexp_apply a l : t = sexp_l (text a :: l)
 
@@ -407,76 +404,60 @@ end
 
 module Term_color = struct
   type color =
-    [ `Black
-    | `Red
-    | `Yellow
-    | `Green
-    | `Blue
-    | `Magenta
-    | `Cyan
-    | `White
-    ]
+    [ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ]
 
   type style =
     [ `FG of color (* foreground *)
     | `BG of color (* background *)
     | `Bold
     | `Reset
-    | `Underline
-    ]
+    | `Underline ]
 
-  open struct
-    let int_of_color_ = function
-      | `Black -> 0
-      | `Red -> 1
-      | `Green -> 2
-      | `Yellow -> 3
-      | `Blue -> 4
-      | `Magenta -> 5
-      | `Cyan -> 6
-      | `White -> 7
+  let int_of_color_ = function
+    | `Black -> 0
+    | `Red -> 1
+    | `Green -> 2
+    | `Yellow -> 3
+    | `Blue -> 4
+    | `Magenta -> 5
+    | `Cyan -> 6
+    | `White -> 7
 
-    let code_of_style : style -> int = function
-      | `FG c -> 30 + int_of_color_ c
-      | `BG c -> 40 + int_of_color_ c
-      | `Bold -> 1
-      | `Reset -> 0
-      | `Underline -> 4
+  let code_of_style : style -> int = function
+    | `FG c -> 30 + int_of_color_ c
+    | `BG c -> 40 + int_of_color_ c
+    | `Bold -> 1
+    | `Reset -> 0
+    | `Underline -> 4
 
-    let spf = Printf.sprintf
+  let spf = Printf.sprintf
+  let string_of_style a = spf "\x1b[%dm" (code_of_style a)
+  let reset = string_of_style `Reset
 
-    let string_of_style a = spf "\x1b[%dm" (code_of_style a)
+  let string_of_style_list = function
+    | [] -> reset
+    | [ a ] -> string_of_style a
+    | [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
+    | [ a; b; c ] ->
+      spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b) (code_of_style c)
+    | l ->
+      let buf = Buffer.create 32 in
+      let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
+      Buffer.add_string buf "\x1b[";
+      List.iteri
+        (fun i c ->
+          if i > 0 then Buffer.add_char buf ';';
+          pp_num c)
+        l;
+      Buffer.add_string buf "m";
+      Buffer.contents buf
 
-    let reset = string_of_style `Reset
-
-    let string_of_style_list = function
-      | [] -> reset
-      | [ a ] -> string_of_style a
-      | [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
-      | [ a; b; c ] ->
-        spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b)
-          (code_of_style c)
-      | l ->
-        let buf = Buffer.create 32 in
-        let pp_num c =
-          Buffer.add_string buf (string_of_int (code_of_style c))
-        in
-        Buffer.add_string buf "\x1b[";
-        List.iteri
-          (fun i c ->
-            if i > 0 then Buffer.add_char buf ';';
-            pp_num c)
-          l;
-        Buffer.add_string buf "m";
-        Buffer.contents buf
-
-    (* TODO: handle nested styles *)
-    let ext_style_ : style list Ext.t =
-      {
-        pre = (fun out l -> Out.string out (string_of_style_list l));
-        post = (fun out _l -> Out.string out reset);
-      }
-  end
+  (* TODO: handle nested styles *)
+  let ext_style_ : style list Ext.t =
+    {
+      pre = (fun out l -> Out.string out (string_of_style_list l));
+      post = (fun out _l -> Out.string out reset);
+    }
 
   (** Set the foreground color. *)
   let color (c : color) (d : t) : t = ext ext_style_ [ `FG c ] d
diff --git a/src/pp/containers_pp.mli b/src/pp/containers_pp.mli
index 8b7e5c3f..9c669fad 100644
--- a/src/pp/containers_pp.mli
+++ b/src/pp/containers_pp.mli
@@ -244,25 +244,10 @@ end
 (** Simple colors in terminals *)
 module Term_color : sig
   type color =
-    [ `Black
-    | `Blue
-    | `Cyan
-    | `Green
-    | `Magenta
-    | `Red
-    | `White
-    | `Yellow
-    ]
+    [ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ]
 
-  type style =
-    [ `BG of color
-    | `Bold
-    | `FG of color
-    | `Reset
-    | `Underline
-    ]
+  type style = [ `BG of color | `Bold | `FG of color | `Reset | `Underline ]
 
   val color : color -> t -> t
-
   val style_l : style list -> t -> t
 end