PR#6418: support "@[<hov %d>" in the new format implementation (Benoît Vaugon)

The bootstrap procedure, as for commit trunk@14973 (see there for
detailed build instructions), requires to first commit a temporary
patch:

> diff -Naur old/typing/typecore.ml new/typing/typecore.ml
> --- old/typing/typecore.ml        2014-06-11 18:16:24.851647309 +0200
> +++ new/typing/typecore.ml        2014-06-11 18:15:50.075646418 +0200
> @@ -2758,16 +2758,9 @@
>        let mk_int n = mk_cst (Const_int n)
>        and mk_string str = mk_cst (Const_string (str, None))
>        and mk_char chr = mk_cst (Const_char chr) in
> -      let mk_block_type bty = match bty with
> -        | Pp_hbox   -> mk_constr "Pp_hbox"   []
> -        | Pp_vbox   -> mk_constr "Pp_vbox"   []
> -        | Pp_hvbox  -> mk_constr "Pp_hvbox"  []
> -        | Pp_hovbox -> mk_constr "Pp_hovbox" []
> -        | Pp_box    -> mk_constr "Pp_box"    []
> -        | Pp_fits   -> mk_constr "Pp_fits"   [] in
>        let rec mk_formatting_lit fmting = match fmting with
> -        | Open_box (org, bty, idt) ->
> -          mk_constr "Open_box" [ mk_string org; mk_block_type bty; mk_int idt ]
> +        | Open_box _ ->
> +          assert false
>          | Close_box ->
>            mk_constr "Close_box" []
>          | Close_tag ->
> @@ -2950,6 +2943,19 @@
>            mk_constr "Alpha" [ mk_fmt rest ]
>          | Theta rest ->
>            mk_constr "Theta" [ mk_fmt rest ]
> +        | Formatting_lit (Open_box (org, _bty, _idt), rest) ->
> +          mk_constr "Formatting_gen" [
> +            mk_constr "Open_box" [
> +              mk_constr "Format" [
> +                mk_constr "String_literal" [
> +                  mk_string "<>";
> +                  mk_constr "End_of_format" [];
> +                ];
> +                mk_string "@[<>";
> +              ]
> +            ];
> +            mk_fmt rest;
> +          ]
>          | Formatting_lit (fmting, rest) ->
>            mk_constr "Formatting_lit" [ mk_formatting_lit fmting; mk_fmt rest ]
>          | Formatting_gen (fmting, rest) ->

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14984 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

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 ());