Commit 355dbbf1 by Kim Nguyễn

Remove the need for the crazy formatter hack in pp_type.

parent 3cbad2b5
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment