[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.

4 files changed, 13 insertions, 35 deletions

diff --git a/lib/pp.ml b/lib/pp.ml
index 5dba0356d..53c1fb4c3 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -17,7 +17,7 @@
    \end{description}
  *)
 
-type pp_tag = string list
+type pp_tag = string
 
 type block_type =
   | Pp_hbox   of int
@@ -161,10 +161,8 @@ let rec pr_com ft s =
       Some s2 -> Format.pp_force_newline ft (); pr_com ft s2
     | None -> ()
 
-type tag_handler = pp_tag -> Format.tag
-
 (* pretty printing functions *)
-let pp_with ?pp_tag ft =
+let pp_with ft =
   let cpp_open_box = function
     | Pp_hbox n   -> Format.pp_open_hbox ft ()
     | Pp_vbox n   -> Format.pp_open_vbox ft n
@@ -182,9 +180,9 @@ let pp_with ?pp_tag ft =
     | Ppcmd_print_break(m,n)  -> pp_print_break ft m n
     | Ppcmd_force_newline     -> pp_force_newline ft ()
     | Ppcmd_comment coms      -> List.iter (pr_com ft) coms
-    | Ppcmd_tag(tag, s)       -> Option.iter (fun f -> pp_open_tag  ft (f tag)) pp_tag;
+    | Ppcmd_tag(tag, s)       -> pp_open_tag  ft tag;
                                  pp_cmd s;
-                                 Option.iter (fun _ -> pp_close_tag ft ()     ) pp_tag
+                                 pp_close_tag ft ()
   in
   try pp_cmd
   with reraise ->
@@ -197,8 +195,8 @@ let pp_with ?pp_tag ft =
    them to different windows. *)
 
 (** Output to a string formatter *)
-let string_of_ppcmds ?pp_tag c =
-  Format.fprintf Format.str_formatter "@[%a@]" (pp_with ?pp_tag) c;
+let string_of_ppcmds c =
+  Format.fprintf Format.str_formatter "@[%a@]" pp_with c;
   Format.flush_str_formatter ()
 
 (* Copy paste from Util *)
diff --git a/lib/pp.mli b/lib/pp.mli
index 12747d3a1..ff4206534 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -33,7 +33,7 @@
 (************************************************************************)
 
 (* XXX: Improve and add attributes *)
-type pp_tag = string list
+type pp_tag = string
 
 type block_type =
   | Pp_hbox   of int
@@ -165,9 +165,7 @@ val pr_loc : Loc.t -> std_ppcmds
 
 (** {6 Main renderers, to formatter and to string } *)
 
-(** FIXME: These ignore the logging settings and call [Format] directly *)
-type tag_handler = pp_tag -> Format.tag
-
 (** [msg_with fmt pp] Print [pp] to [fmt] and don't flush [fmt]  *)
-val pp_with          : ?pp_tag:tag_handler -> Format.formatter -> std_ppcmds -> unit
-val string_of_ppcmds : ?pp_tag:tag_handler -> std_ppcmds -> string
+val pp_with          : Format.formatter -> std_ppcmds -> unit
+
+val string_of_ppcmds : std_ppcmds -> string
diff --git a/lib/ppstyle.ml b/lib/ppstyle.ml
index 298e3be6b..6969c3d5c 100644
--- a/lib/ppstyle.ml
+++ b/lib/ppstyle.ml
@@ -19,27 +19,20 @@ let make ?style tag =
   let name = to_format tag                          in
   let () = assert (not (String.Map.mem name !tags)) in
   let () = tags := String.Map.add name style !tags  in
-  tag
-
-let repr t = t
+  name
 
 let get_style tag =
-  try String.Map.find (to_format tag) !tags
-  with Not_found -> assert false
-
-let get_style_format tag =
   try String.Map.find tag !tags
   with Not_found -> assert false
 
 let set_style tag st =
-  try tags := String.Map.update (to_format tag) st !tags
+  try tags := String.Map.update tag st !tags
   with Not_found -> assert false
 
 let clear_styles () =
   tags := String.Map.map (fun _ -> None) !tags
 
-let dump () =
-  List.map (fun (s,b) -> (String.split '.' s, b)) (String.Map.bindings !tags)
+let dump () = String.Map.bindings !tags
 
 let parse_config s =
   let styles = Terminal.parse s in
diff --git a/lib/ppstyle.mli b/lib/ppstyle.mli
index b9422f7cf..2690d3910 100644
--- a/lib/ppstyle.mli
+++ b/lib/ppstyle.mli
@@ -14,28 +14,17 @@
 (** This API is provisional and will likely be refined. *)
 type t = Pp.pp_tag
 
-val to_format : t -> Format.tag
-val of_format : Format.tag -> t
-
 (** Style tags *)
 
 val make : ?style:Terminal.style -> string list -> t
 (** Create a new tag with the given name. Each name must be unique. The optional
     style is taken as the default one. *)
 
-val repr : t -> string list
-(** Gives back the original name of the style tag where each string has been
-    concatenated and separated with a dot. *)
-
 (** {5 Manipulating global styles} *)
 
 val get_style : t -> Terminal.style option
-(** Get the style associated to a tag. *)
-
-val get_style_format : Format.tag -> Terminal.style option
 (** Get the style associated to a tag from a format tag. *)
 
-
 val set_style : t -> Terminal.style option -> unit
 (** Set a style associated to a tag. *)