Commit e8ecd949 authored by Kim Nguyễn's avatar Kim Nguyễn

Add a wrapper around the type printing function to prevent them from outputing...

Add a wrapper around the type printing function to prevent them from outputing illegal code (such as [(Char | (*--2)*)* ]. (which contains CDuce comments).
parent d1a25cde
...@@ -2704,6 +2704,50 @@ module Print = struct ...@@ -2704,6 +2704,50 @@ module Print = struct
named := old_named; named := old_named;
named_xml := old_named_xml 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 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 pp_node ppf n = pp_type ppf (descr n)
let () = forward_print := pp_type 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