From e8ecd9491158063195c8a3fb911343615649d0b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kim=20Nguy=E1=BB=85n?= Date: Mon, 23 Mar 2015 15:06:28 +0100 Subject: [PATCH] Add a wrapper around the type printing function to prevent them from outputing illegal code (such as [(Char | (*--2)*)* ]. (which contains CDuce comments). --- types/types.ml | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/types/types.ml b/types/types.ml index f0f3b43b..3564b732 100644 --- a/types/types.ml +++ b/types/types.ml @@ -2704,6 +2704,50 @@ 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 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 -- 2.22.0