Remove the need for the crazy formatter hack in pp_type.

types/intervals.ml

@@ -243,7 +243,7 @@ let single = function
   | [] -> raise Not_found
   | _ -> raise Exit
 
-let print =
+let print l =
   List.map
     (fun x ppf -> match x with
        | Any ->
@@ -262,11 +262,14 @@ let print =
 	     (string_of_big_int a)
 	     (string_of_big_int b)
     )
-
+    l
 
 let ( + ) = add_big_int
 let ( * ) = mult_big_int
 
+let is_bounded l =
+  List.for_all (function Left _ | Any -> false | _ -> true) l,
+  List.for_all (function Right _ | Any -> false | _ -> true) l
 
 let add_inter i1 i2 =
   match (i1,i2) with

types/intervals.mli

@@ -50,6 +50,8 @@ val right : V.t -> t
 
 val atom : V.t -> t
 
+val is_bounded : t -> bool * bool
+
 val disjoint : t -> t -> bool
 val is_empty : t -> bool
 val contains : V.t -> t -> bool

types/types.ml

@@ -1926,6 +1926,7 @@ module Print = struct
     | Display of string
     | Regexp of nd Pretty.regexp
     | Atomic of (Format.formatter -> unit)
+    | Interval of Intervals.t
     | Pair of nd * nd
     | Char of Chars.V.t
     | Xml of [ `Tag of (Format.formatter -> unit) | `Type of nd ] * nd * nd
@@ -2072,9 +2073,10 @@ module Print = struct
 		    acc
 
   let print_ints acc tt =
-    List.fold_right (fun x acc -> (Atomic x) :: acc)
-		    (Intervals.print (VarIntervals.(leafconj (proj tt))))
-		    acc
+    let ints = VarIntervals.(leafconj (proj tt)) in
+    if Intervals.is_empty ints then acc else
+      (Interval ints) :: acc
+
 
 
   let print_atoms acc tt =
@@ -2446,7 +2448,7 @@ module Print = struct
   and assign_name_rec = function
     | Neg t -> assign_name t
     | Abs t -> assign_name t
-    | Name _ | Char _ | Atomic _ | Display _-> ()
+    | Name _ | Char _ | Atomic _ | Display _ | Interval _ -> ()
     | Regexp r -> assign_name_regexp r
     | Pair (t1,t2) -> assign_name t1; assign_name t2
     | Intersection l -> List.iter assign_name l
@@ -2510,7 +2512,7 @@ module Print = struct
   let cpar ppf ~level (pri : Level.t) =
     if Pervasives.(level < pri) then Format.fprintf ppf ")@]"
 
-  let  do_print_list empty pri op pri_op pr_e ppf l =
+  let do_print_list empty pri op pri_op pr_e ppf l =
     let rec loop l =
       match l with
         [] -> ()
@@ -2548,6 +2550,17 @@ module Print = struct
     | Char c -> Chars.V.print ppf c
     | Regexp r -> Format.fprintf ppf "@[[ %a ]@]" (do_print_regexp lv_min) r
     | Atomic a -> a ppf
+    | Interval i -> begin
+      match List.rev_map (fun x -> Atomic x) (Intervals.print i) with
+      | [ ] -> assert false
+      | [ a ] -> do_print pri ppf a
+      | lst ->
+	 opar ppf ~level:lv_alt pri;
+	if Pervasives.(lv_alt < pri) && (not (fst (Intervals.is_bounded i))) then
+	  Format.fprintf ppf " ";
+	do_print_slot_real lv_alt ppf lst;
+	cpar ppf ~level:lv_alt pri
+    end
     | Diff (a, b) ->
       opar ppf ~level:lv_diff pri;
       Format.fprintf ppf "@[%a@] \\ @[%a@]" (do_print_slot lv_ldiff) a
@@ -2695,50 +2708,6 @@ module Print = struct
     named := old_named;
     named_xml := old_named_xml
 
-  let wrap_formatter ppf =
-    let out_fun,flush_fun = Format.pp_get_formatter_output_functions ppf () in
-    let buffer = Buffer.create 16 in
-    let prev_char = "\000" in
-    let new_out_fun str start len =
-      for i = start to start + len - 1 do
-        let c = str.[i] in
-        if c == '*' && prev_char.[0] == '(' then
-          Buffer.add_char buffer ' '
-        else if c == ')' && prev_char.[0] == '*' then
-          Buffer.add_char buffer ' ';
-        prev_char.[0] <- c;
-        Buffer.add_char buffer c;
-      done;
-      let new_str = Buffer.contents buffer in
-      Buffer.clear buffer;
-      out_fun new_str 0 (String.length new_str)
-    in
-    let new_flush_fun () =
-      let new_str = Buffer.contents buffer in
-      let len = String.length new_str in
-      if len > 0 then begin
-        Buffer.clear buffer;
-        out_fun new_str 0 len;
-      end;
-      flush_fun ();
-    in
-    Format.pp_set_formatter_output_functions ppf new_out_fun new_flush_fun;
-    fun () ->
-      Format.pp_print_flush ppf ();
-      Format.pp_set_formatter_output_functions ppf out_fun flush_fun
-
-  let wrap_formatter _ = fun () -> ()
-  let pp_type ppf t =
-    let reset = wrap_formatter ppf in
-    pp_type ppf t;
-    reset ()
-
-  let pp_noname ppf t =
-    let reset = wrap_formatter ppf in
-    pp_noname ppf t;
-    reset ()
-
-
   let pp_node ppf n = pp_type ppf (descr n)
 
   let () = forward_print := pp_type