[pp] Remove special tag type and handler from Pp.

For legacy reasons, pretty printing required to provide a "tag"
interpretation function `pp_tag`. However such function was not of much
use as the backends (richpp and terminal) hooked at the `Format.tag`
level.

We thus remove this unused indirection layer and annotate expressions
with their `Format` tags.

This is a step towards moving the last bit of terminal code out of the
core system.

1 files changed, 5 insertions, 24 deletions

diff --git a/ide/richpp.ml b/ide/richpp.ml
index 515090f713..ecf1f40211 100644
--- a/ide/richpp.ml
+++ b/ide/richpp.ml
@@ -24,10 +24,6 @@ type 'a context = {
   (** Pending opened nodes *)
   mutable offset : int;
   (** Quantity of characters printed so far *)
-  mutable annotations : 'a option Int.Map.t;
-  (** Map associating annotations to indexes *)
-  mutable index : int;
-  (** Current index of annotations *)
 }
 
 (** We use Format to introduce tags inside the pretty-printed document.
@@ -38,23 +34,13 @@ type 'a context = {
     marking functions. As those functions are called when actually writing to
     the device, the resulting tree is correct.
 *)
-let rich_pp width annotate ppcmds =
+let rich_pp width ppcmds =
 
   let context = {
     stack = Leaf;
     offset = 0;
-    annotations = Int.Map.empty;
-    index = (-1);
   } in
 
-  let pp_tag obj =
-    let index = context.index + 1 in
-    let () = context.index <- index in
-    let obj = annotate obj in
-    let () = context.annotations <- Int.Map.add index obj context.annotations in
-    string_of_int index
-  in
-
   let pp_buffer = Buffer.create 180 in
 
   let push_pcdata () =
@@ -81,12 +67,8 @@ let rich_pp width annotate ppcmds =
     | Leaf -> assert false
     | Node (node, child, pos, ctx) ->
       let () = assert (String.equal tag node) in
-      let annotation =
-        try Int.Map.find (int_of_string node) context.annotations
-        with _ -> None
-      in
       let annotation = {
-        annotation = annotation;
+        annotation = Some tag;
         startpos = pos;
         endpos = context.offset;
       } in
@@ -123,7 +105,7 @@ let rich_pp width annotate ppcmds =
   (** The whole output must be a valid document. To that
       end, we nest the document inside <pp> tags. *)
   pp_open_tag ft "pp";
-  Pp.(pp_with ~pp_tag ft ppcmds);
+  Pp.(pp_with ft ppcmds);
   pp_close_tag ft ();
 
   (** Get the resulting XML tree. *)
@@ -173,14 +155,13 @@ let xml_of_rich_pp tag_of_annotation attributes_of_annotation xml =
 type richpp = xml
 
 let richpp_of_pp width pp =
-  let annotate t = Some (Ppstyle.repr t)    in
   let rec drop = function
   | PCData s -> [PCData s]
   | Element (_, annotation, cs) ->
     let cs = List.concat (List.map drop cs) in
     match annotation.annotation with
     | None -> cs
-    | Some s -> [Element (String.concat "." s, [], cs)]
+    | Some s -> [Element (s, [], cs)]
   in
-  let xml = rich_pp width annotate pp in
+  let xml = rich_pp width pp in
   Element ("_", [], drop xml)