diff options
Diffstat (limited to 'stdlib/format.ml')
-rw-r--r-- | stdlib/format.ml | 32 |
1 files changed, 21 insertions, 11 deletions
diff --git a/stdlib/format.ml b/stdlib/format.ml index 7f9b959a2..55674d179 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -1058,6 +1058,17 @@ and set_tags = pp_set_tags std_formatter ;; + (**************************************************************) + +let compute_tag output tag_acc = + let buf = Buffer.create 16 in + let ppf = formatter_of_buffer buf in + let () = output ppf tag_acc in + let () = pp_print_flush ppf () in + let len = Buffer.length buf in + if len < 2 then Buffer.contents buf + else Buffer.sub buf 1 (len - 2) + (************************************************************** Defining continuations to be passed as arguments of @@ -1070,7 +1081,6 @@ open CamlinternalFormat (* Interpret a formatting entity on a formatter. *) let output_formatting_lit ppf fmting_lit = match fmting_lit with - | Open_box (_, bty, indent) -> pp_open_box_gen ppf indent bty | Close_box -> pp_close_box ppf () | Close_tag -> pp_close_tag ppf () | Break (_, width, offset) -> pp_print_break ppf width offset @@ -1098,11 +1108,11 @@ let rec output_acc ppf acc = match acc with output_formatting_lit ppf f; | Acc_formatting_gen (p, Acc_open_tag acc') -> output_acc ppf p; - let buf' = Buffer.create 16 in - let ppf' = formatter_of_buffer buf' in - output_acc ppf' acc'; - pp_print_flush ppf' (); - pp_open_tag ppf (Buffer.contents buf'); + pp_open_tag ppf (compute_tag output_acc acc') + | Acc_formatting_gen (p, Acc_open_box acc') -> + let () = output_acc ppf p in + let (indent, bty) = open_box_of_string (compute_tag output_acc acc') in + pp_open_box_gen ppf indent bty | Acc_string (p, s) -> output_acc ppf p; pp_print_string ppf s; | Acc_char (p, c) -> output_acc ppf p; pp_print_char ppf c; | Acc_delay (p, f) -> output_acc ppf p; f ppf; @@ -1129,11 +1139,11 @@ let rec strput_acc ppf acc = match acc with output_formatting_lit ppf f; | Acc_formatting_gen (p, Acc_open_tag acc') -> strput_acc ppf p; - let buf' = Buffer.create 16 in - let ppf' = formatter_of_buffer buf' in - strput_acc ppf' acc'; - pp_print_flush ppf' (); - pp_open_tag ppf (Buffer.contents buf'); + pp_open_tag ppf (compute_tag strput_acc acc') + | Acc_formatting_gen (p, Acc_open_box acc') -> + let () = strput_acc ppf p in + let (indent, bty) = open_box_of_string (compute_tag strput_acc acc') in + pp_open_box_gen ppf indent bty | Acc_string (p, s) -> strput_acc ppf p; pp_print_string ppf s; | Acc_char (p, c) -> strput_acc ppf p; pp_print_char ppf c; | Acc_delay (p, f) -> strput_acc ppf p; pp_print_string ppf (f ()); |