PR#6418: fix format regression on "@{<..%d..%s..>" (Benoît Vaugon)

To be able to compile this patch, you should temporarily apply the
following patch to bootstrap the format type change:

> diff -Naur old/typing/typecore.ml new/typing/typecore.ml
> --- old/typing/typecore.ml	2014-06-06 03:37:03.240926150 +0200
> +++ new/typing/typecore.ml	2014-06-06 03:37:24.696926699 +0200
> @@ -2956,7 +2956,7 @@
>          | Theta rest ->
>            mk_constr "Theta" [ mk_fmt rest ]
>          | Formatting (fmting, rest) ->
> -          mk_constr "Formatting" [ mk_formatting fmting; mk_fmt rest ]
> +          mk_constr "Formatting_lit" [ mk_formatting fmting; mk_fmt rest ]
>          | Reader rest ->
>            mk_constr "Reader" [ mk_fmt rest ]
>          | Scan_char_set (width_opt, char_set, rest) ->

Bootstrap process:

  make core
  apply the patch above
  make core
  make promote-cross
  make partialclean
  revert the patch above, apply the commit
  make partialclean
  make core
  make coreboot

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

6 files changed, 531 insertions, 396 deletions

diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
index 1d23d8b6c..2a7e3aeba 100644
--- a/stdlib/camlinternalFormat.ml
+++ b/stdlib/camlinternalFormat.ml
@@ -113,15 +113,19 @@ fun ign fmt -> match ign with
 (******************************************************************************)
                                  (* Types *)
 
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+
 (* Reversed list of printing atoms. *)
 (* Used to accumulate printf arguments. *)
-type ('b, 'c) acc =
-  | Acc_formatting  of ('b, 'c) acc * formatting(* Special formatting (box)   *)
-  | Acc_string      of ('b, 'c) acc * string    (* Literal or generated string*)
-  | Acc_char        of ('b, 'c) acc * char      (* Literal or generated char  *)
-  | Acc_delay       of ('b, 'c) acc * ('b -> 'c)(* Delayed printing (%a, %t)  *)
-  | Acc_flush       of ('b, 'c) acc             (* Flush                      *)
-  | Acc_invalid_arg of ('b, 'c) acc * string    (* Raise Invalid_argument msg *)
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit(* Special fmtting (box) *)
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen (* Special fmtting (box) *)
+  | Acc_string         of ('b, 'c) acc * string        (* Literal or generated string*)
+  | Acc_char           of ('b, 'c) acc * char          (* Literal or generated char  *)
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)    (* Delayed printing (%a, %t)  *)
+  | Acc_flush          of ('b, 'c) acc                 (* Flush                      *)
+  | Acc_invalid_arg    of ('b, 'c) acc * string        (* Raise Invalid_argument msg *)
   | End_of_acc
 
 (* List of heterogeneous values. *)
@@ -149,34 +153,41 @@ type ('a, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb = Padprec_fmtty_EBB :
 (* See make_padding_fmt_ebb and parse_format functions. *)
 type ('a, 'b, 'c, 'e, 'f) padding_fmt_ebb = Padding_fmt_EBB :
      (_, 'x -> 'a) padding *
-     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
      ('x, 'b, 'c, 'e, 'f) padding_fmt_ebb
 
 (* GADT type associating a precision and an fmt. *)
 (* See make_precision_fmt_ebb and parse_format functions. *)
 type ('a, 'b, 'c, 'e, 'f) precision_fmt_ebb = Precision_fmt_EBB :
      (_, 'x -> 'a) precision *
-     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
      ('x, 'b, 'c, 'e, 'f) precision_fmt_ebb
 
 (* GADT type associating a padding, a precision and an fmt. *)
 (* See make_padprec_fmt_ebb and parse_format functions. *)
 type ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb = Padprec_fmt_EBB :
      ('x, 'y) padding * ('y, 'p -> 'a) precision *
-     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
      ('p, 'b, 'c, 'e, 'f) padprec_fmt_ebb
 
 (* Abstract the 'a and 'd parameters of an fmt. *)
 (* Output type of the format parsing function. *)
 type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
-     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
      ('b, 'c, 'e, 'f) fmt_ebb
 
 (* GADT type associating an fmtty and an fmt. *)
+(* See the type_format_gen function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb = Fmt_fmtty_EBB :
+     ('a, 'b, 'c, 'd, 'y, 'x) fmt *
+     ('x, 'b, 'c, 'y, 'e, 'f) fmtty ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmt_fmtty_ebb
+
+(* GADT type associating an fmtty and an fmt. *)
 (* See the type_ignored_format_substitution function. *)
 type ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb = Fmtty_fmt_EBB :
      ('a, 'b, 'c, 'd, 'y, 'x) fmtty *
-     ('x, 'b, 'c, 'y, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('x, 'b, 'c, 'y, 'e, 'f) fmt_fmtty_ebb ->
      ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb
 
 (* Abstract all fmtty type parameters. *)
@@ -421,12 +432,11 @@ let bprint_float_fmt buf ign_flag fconv pad prec =
   bprint_precision buf prec;
   buffer_add_char buf (char_of_fconv fconv)
 
-(* Compute the literal string representation of a formatting. *)
+(* Compute the literal string representation of a formatting_lit. *)
 (* Also used by Printf and Scanf where formatting is not interpreted. *)
-let string_of_formatting formatting = match formatting with
+let string_of_formatting_lit formatting_lit = match formatting_lit with
   | Open_box (str, _, _) -> str
   | Close_box            -> "@]"
-  | Open_tag (str, _)    -> str
   | Close_tag            -> "@}"
   | Break (str, _, _)    -> str
   | FFlush               -> "@?"
@@ -437,6 +447,13 @@ let string_of_formatting formatting = match formatting with
   | Escaped_percent      -> "@%"
   | Scan_indic c -> "@" ^ (String.make 1 c)
 
+(* Compute the literal string representation of a formatting. *)
+(* Also used by Printf and Scanf where formatting is not interpreted. *)
+let string_of_formatting_gen : type a b c d e f .
+    (a, b, c, d, e, f) formatting_gen -> string =
+  fun formatting_gen -> match formatting_gen with
+  | Open_tag (Format (_, str)) -> str
+
 (***)
 
 (* Print a literal char in a buffer, escape '%' by "%%". *)
@@ -566,8 +583,11 @@ let bprint_fmt buf fmt =
       let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in
       fmtiter fmt' true;
 
-    | Formatting (fmting, rest) ->
-      bprint_string_literal buf (string_of_formatting fmting);
+    | Formatting_lit (fmting_lit, rest) ->
+      bprint_string_literal buf (string_of_formatting_lit fmting_lit);
+      fmtiter rest ign_flag;
+    | Formatting_gen (fmting_gen, rest) ->
+      bprint_string_literal buf (string_of_formatting_gen fmting_gen);
       fmtiter rest ign_flag;
 
     | End_of_format -> ()
@@ -777,10 +797,15 @@ and trans : type
   | End_of_fmtty, _ -> assert false
   | _, End_of_fmtty -> assert false
 
+let rec fmtty_of_formatting_gen : type a b c d e f .
+  (a, b, c, d, e, f) formatting_gen ->
+    (a, b, c, d, e, f) fmtty =
+fun formatting_gen -> match formatting_gen with
+  | Open_tag (Format (fmt, _)) -> fmtty_of_fmt fmt
 
 (* Extract the type representation (an fmtty) of a format. *)
-let rec fmtty_of_fmt : type a b c d e f .
-  (a, b, c, d, e, f) CamlinternalFormatBasics.fmt -> (a, b, c, d, e, f) fmtty =
+and fmtty_of_fmt : type a b c d e f .
+  (a, b, c, d, e, f) fmt -> (a, b, c, d, e, f) fmtty =
 fun fmtty -> match fmtty with
   | String (pad, rest) ->
     fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
@@ -827,7 +852,9 @@ fun fmtty -> match fmtty with
   | Scan_char_set (_, _, rest) -> String_ty (fmtty_of_fmt rest)
   | Scan_get_counter (_, rest) -> Int_ty (fmtty_of_fmt rest)
   | Ignored_param (ign, rest)  -> fmtty_of_ignored_format ign rest
-  | Formatting (_, rest)       -> fmtty_of_fmt rest
+  | Formatting_lit (_, rest)   -> fmtty_of_fmt rest
+  | Formatting_gen (fmting_gen, rest)  ->
+    concat_fmtty (fmtty_of_formatting_gen fmting_gen) (fmtty_of_fmt rest)
 
   | End_of_format              -> End_of_fmtty
 
@@ -835,7 +862,7 @@ fun fmtty -> match fmtty with
    the format. *)
 and fmtty_of_ignored_format : type x y a b c d e f .
     (a, b, c, d, y, x) ignored ->
-    (x, b, c, y, e, f) CamlinternalFormatBasics.fmt ->
+    (x, b, c, y, e, f) fmt ->
     (a, b, c, d, e, f) fmtty =
 fun ign fmt -> match ign with
   | Ignored_char                    -> fmtty_of_fmt fmt
@@ -907,142 +934,192 @@ fun pad prec fmtty -> match prec, type_padding pad fmtty with
 (* If typing succeed, generate a copy of the format with the same
     type parameters as the fmtty. *)
 (* Raise a Failure with an error message in case of type mismatch. *)
-
 let rec type_format :
   type a1 b1 c1 d1 e1 f1
        a2 b2 c2 d2 e2 f2  .
      (a1, b1, c1, d1, e1, f1) fmt
   -> (a2, b2, c2, d2, e2, f2) fmtty
   -> (a2, b2, c2, d2, e2, f2) fmt
+= fun fmt fmtty -> match type_format_gen fmt fmtty with
+  | Fmt_fmtty_EBB (fmt', End_of_fmtty) -> fmt'
+  | _ -> raise Type_mismatch
+
+and type_format_gen :
+  type a1 b1 c1 d1 e1 f1
+       a2 b2 c2 d2 e2 f2  .
+     (a1, b1, c1, d1, e1, f1) fmt
+  -> (a2, b2, c2, d2, e2, f2) fmtty
+  -> (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
 = fun fmt fmtty -> match fmt, fmtty with
   | Char fmt_rest, Char_ty fmtty_rest ->
-    Char (type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char fmt', fmtty')
   | Caml_char fmt_rest, Char_ty fmtty_rest ->
-    Caml_char (type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Caml_char fmt', fmtty')
   | String (pad, fmt_rest), _ -> (
     match type_padding pad fmtty with
     | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
-      String (pad, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (String (pad, fmt'), fmtty')
     | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
   )
   | Caml_string (pad, fmt_rest), _ -> (
     match type_padding pad fmtty with
     | Padding_fmtty_EBB (pad, String_ty fmtty_rest) ->
-      Caml_string (pad, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Caml_string (pad, fmt'), fmtty')
     | Padding_fmtty_EBB (_, _) -> raise Type_mismatch
   )
   | Int (iconv, pad, prec, fmt_rest), _ -> (
     match type_padprec pad prec fmtty with
     | Padprec_fmtty_EBB (pad, prec, Int_ty fmtty_rest) ->
-      Int (iconv, pad, prec, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int (iconv, pad, prec, fmt'), fmtty')
     | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
   )
   | Int32 (iconv, pad, prec, fmt_rest), _ -> (
     match type_padprec pad prec fmtty with
     | Padprec_fmtty_EBB (pad, prec, Int32_ty fmtty_rest) ->
-      Int32 (iconv, pad, prec, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int32 (iconv, pad, prec, fmt'), fmtty')
     | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
   )
   | Nativeint (iconv, pad, prec, fmt_rest), _ -> (
     match type_padprec pad prec fmtty with
     | Padprec_fmtty_EBB (pad, prec, Nativeint_ty fmtty_rest) ->
-      Nativeint (iconv, pad, prec, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Nativeint (iconv, pad, prec, fmt'), fmtty')
     | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
   )
   | Int64 (iconv, pad, prec, fmt_rest), _ -> (
     match type_padprec pad prec fmtty with
     | Padprec_fmtty_EBB (pad, prec, Int64_ty fmtty_rest) ->
-      Int64 (iconv, pad, prec, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Int64 (iconv, pad, prec, fmt'), fmtty')
     | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
   )
   | Float (fconv, pad, prec, fmt_rest), _ -> (
     match type_padprec pad prec fmtty with
     | Padprec_fmtty_EBB (pad, prec, Float_ty fmtty_rest) ->
-      Float (fconv, pad, prec, type_format fmt_rest fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+      Fmt_fmtty_EBB (Float (fconv, pad, prec, fmt'), fmtty')
     | Padprec_fmtty_EBB (_, _, _) -> raise Type_mismatch
   )
   | Bool fmt_rest, Bool_ty fmtty_rest ->
-    Bool (type_format fmt_rest fmtty_rest)
-  | Flush fmt_rest, _ ->
-    Flush (type_format fmt_rest fmtty)
-
-  | String_literal (str, fmt_rest), _ ->
-    String_literal (str, type_format fmt_rest fmtty)
-  | Char_literal (chr, fmt_rest), _ ->
-    Char_literal (chr, type_format fmt_rest fmtty)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Bool fmt', fmtty')
+  | Flush fmt_rest, fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Flush fmt', fmtty')
+
+  | String_literal (str, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (String_literal (str, fmt'), fmtty')
+  | Char_literal (chr, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Char_literal (chr, fmt'), fmtty')
 
   | Format_arg (pad_opt, sub_fmtty, fmt_rest),
     Format_arg_ty (sub_fmtty', fmtty_rest) ->
     if Fmtty_EBB sub_fmtty <> Fmtty_EBB sub_fmtty' then raise Type_mismatch;
-    Format_arg (pad_opt, sub_fmtty', type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Format_arg (pad_opt, sub_fmtty', fmt'), fmtty')
   | Format_subst (pad_opt, sub_fmtty, fmt_rest),
     Format_subst_ty (sub_fmtty1, _sub_fmtty2, fmtty_rest) ->
     if Fmtty_EBB (erase_rel sub_fmtty) <> Fmtty_EBB (erase_rel sub_fmtty1) then
       raise Type_mismatch;
-    Format_subst (pad_opt, sub_fmtty1, type_format fmt_rest (erase_rel fmtty_rest))
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest (erase_rel fmtty_rest) in
+    Fmt_fmtty_EBB (Format_subst (pad_opt, sub_fmtty1, fmt'), fmtty')
   (* Printf and Format specific constructors: *)
   | Alpha fmt_rest, Alpha_ty fmtty_rest ->
-    Alpha (type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Alpha fmt', fmtty')
   | Theta fmt_rest, Theta_ty fmtty_rest ->
-    Theta (type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Theta fmt', fmtty')
 
   (* Format specific constructors: *)
-  | Formatting (formatting, fmt_rest), _ ->
-    Formatting (formatting, type_format fmt_rest fmtty)
+  | Formatting_lit (formatting_lit, fmt_rest), fmtty_rest ->
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Formatting_lit (formatting_lit, fmt'), fmtty')
+  | Formatting_gen (formatting_gen, fmt_rest), fmtty_rest ->
+    type_formatting_gen formatting_gen fmt_rest fmtty_rest
 
   (* Scanf specific constructors: *)
   | Reader fmt_rest, Reader_ty fmtty_rest ->
-    Reader (type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Reader fmt', fmtty')
   | Scan_char_set (width_opt, char_set, fmt_rest), String_ty fmtty_rest ->
-    Scan_char_set
-      (width_opt, char_set, type_format fmt_rest fmtty_rest)
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_char_set (width_opt, char_set, fmt'), fmtty')
   | Scan_get_counter (counter, fmt_rest), Int_ty fmtty_rest ->
-    Scan_get_counter (counter, type_format fmt_rest fmtty_rest)
-  | Ignored_param (ign, rest), _ ->
-    type_ignored_param ign rest fmtty
+    let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt_rest fmtty_rest in
+    Fmt_fmtty_EBB (Scan_get_counter (counter, fmt'), fmtty')
+  | Ignored_param (ign, rest), fmtty_rest ->
+    type_ignored_param ign rest fmtty_rest
 
-  | End_of_format, End_of_fmtty -> End_of_format
+  | End_of_format, fmtty_rest -> Fmt_fmtty_EBB (End_of_format, fmtty_rest)
 
   | _ -> raise Type_mismatch
 
+and type_formatting_gen : type a1 a3 b1 b3 c1 c3 d1 d3 e1 e2 e3 f1 f2 f3 .
+    (a1, b1, c1, d1, e1, f1) formatting_gen ->
+    (f1, b1, c1, e1, e2, f2) fmt ->
+    (a3, b3, c3, d3, e3, f3) fmtty ->
+    (a3, b3, c3, d3, e3, f3) fmt_fmtty_ebb =
+fun formatting_gen fmt0 fmtty0 -> match formatting_gen with
+  | Open_tag (Format (fmt1, str)) ->
+    let Fmt_fmtty_EBB (fmt2, fmtty2) = type_format_gen fmt1 fmtty0 in
+    let Fmt_fmtty_EBB (fmt3, fmtty3) = type_format_gen fmt0 fmtty2 in
+    Fmt_fmtty_EBB (Formatting_gen (Open_tag (Format (fmt2, str)), fmt3), fmtty3)
+
 (* Type an Ignored_param node according to an fmtty. *)
 and type_ignored_param : type p q x y z t u v a b c d e f .
     (x, y, z, t, q, p) ignored ->
-    (p, y, z, q, u, v) CamlinternalFormatBasics.fmt ->
+    (p, y, z, q, u, v) fmt ->
     (a, b, c, d, e, f) fmtty ->
-    (a, b, c, d, e, f) CamlinternalFormatBasics.fmt =
+    (a, b, c, d, e, f) fmt_fmtty_ebb =
 fun ign fmt fmtty -> match ign with
-  | Ignored_char            as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_caml_char       as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_string _        as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_caml_string _   as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_int _           as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_int32 _         as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_nativeint _     as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_int64 _         as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_float _         as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_bool            as ign'-> Ignored_param (ign',type_format fmt fmtty)
-  | Ignored_scan_char_set _ as ign'-> Ignored_param (ign',type_format fmt fmtty)
+  | Ignored_char               as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_char          as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_string _           as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_caml_string _      as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int _              as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int32 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_nativeint _        as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_int64 _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_float _            as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_bool               as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_char_set _    as ign' -> type_ignored_param_one ign' fmt fmtty
+  | Ignored_scan_get_counter _ as ign' -> type_ignored_param_one ign' fmt fmtty
   | Ignored_format_arg (pad_opt, sub_fmtty) ->
-    let ignored = Ignored_format_arg (pad_opt, sub_fmtty) in
-    Ignored_param (ignored, type_format fmt fmtty)
+    type_ignored_param_one (Ignored_format_arg (pad_opt, sub_fmtty)) fmt fmtty
   | Ignored_format_subst (pad_opt, sub_fmtty) ->
-    let Fmtty_fmt_EBB (sub_fmtty', fmt') =
+    let Fmtty_fmt_EBB (sub_fmtty', Fmt_fmtty_EBB (fmt', fmtty')) =
       type_ignored_format_substitution sub_fmtty fmt fmtty in
-    Ignored_param (Ignored_format_subst (pad_opt, erase_rel (symm sub_fmtty')), fmt')
-  | Ignored_reader ->
-    begin match fmtty with
+    Fmt_fmtty_EBB (Ignored_param (Ignored_format_subst (pad_opt, sub_fmtty'), fmt'), fmtty')
+  | Ignored_reader -> (
+    match fmtty with
     | Ignored_reader_ty fmtty_rest ->
-      Ignored_param (Ignored_reader, type_format fmt fmtty_rest)
+      let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty_rest in
+      Fmt_fmtty_EBB (Ignored_param (Ignored_reader, fmt'), fmtty')
     | _ -> raise Type_mismatch
-    end
-  | Ignored_scan_get_counter _ as ign' ->
-    Ignored_param (ign', type_format fmt fmtty)
+  )
+
+and type_ignored_param_one : type a1 a2 b1 b2 c1 c2 d1 d2 e1 e2 f1 f2 .
+    (a2, b2, c2, d2, d2, a2) ignored ->
+    (a1, b1, c1, d1, e1, f1) fmt ->
+    (a2, b2, c2, d2, e2, f2) fmtty ->
+    (a2, b2, c2, d2, e2, f2) fmt_fmtty_ebb
+= fun ign fmt fmtty ->
+  let Fmt_fmtty_EBB (fmt', fmtty') = type_format_gen fmt fmtty in
+  Fmt_fmtty_EBB (Ignored_param (ign, fmt'), fmtty')
 
 (* Typing of the complex case: "%_(...%)". *)
 and type_ignored_format_substitution : type w x y z p s t u a b c d e f .
     (w, x, y, z, s, p) fmtty ->
-    (p, x, y, s, t, u) CamlinternalFormatBasics.fmt ->
+    (p, x, y, s, t, u) fmt ->
     (a, b, c, d, e, f) fmtty -> (a, b, c, d, e, f) fmtty_fmt_ebb =
 fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
   | Char_ty sub_fmtty_rest, Char_ty fmtty_rest ->
@@ -1113,11 +1190,9 @@ fun sub_fmtty fmt fmtty -> match sub_fmtty, fmtty with
       type_ignored_format_substitution (erase_rel sub_fmtty_rest) fmt fmtty_rest in
     Fmtty_fmt_EBB (Format_subst_ty (sub1_fmtty', sub2_fmtty', symm sub_fmtty_rest'), fmt')
   | End_of_fmtty, fmtty ->
-    Fmtty_fmt_EBB (End_of_fmtty, type_format fmt fmtty)
-
+    Fmtty_fmt_EBB (End_of_fmtty, type_format_gen fmt fmtty)
   | _ -> raise Type_mismatch
 
-
 (* This implementation of `recast` is a bit disappointing. The
    invariant provided by the type are very strong: the input format's
    type is in relation to the output type's as witnessed by the
@@ -1275,9 +1350,9 @@ let string_of_fmtty fmtty =
      o: the output stream (see k, %a and %t).
      acc: rev list of printing entities (string, char, flush, formatting, ...).
      fmt: the format. *)
-let rec make_printf : type a b c d .
-    (b -> (b, c) acc -> d) -> b -> (b, c) acc ->
-    (a, b, c, c, c, d) CamlinternalFormatBasics.fmt -> a =
+let rec make_printf : type a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt -> a =
 fun k o acc fmt -> match fmt with
   | Char rest ->
     fun c ->
@@ -1347,18 +1422,22 @@ fun k o acc fmt -> match fmt with
   | Ignored_param (ign, rest) ->
     make_ignored_param k o acc ign rest
 
-  | Formatting (fmting, rest) ->
-    make_printf k o (Acc_formatting (acc, fmting)) rest
+  | Formatting_lit (fmting_lit, rest) ->
+    make_printf k o (Acc_formatting_lit (acc, fmting_lit)) rest
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    let k' koc kacc =
+      make_printf k koc (Acc_formatting_gen (acc, Acc_open_tag kacc)) rest in
+    make_printf k' o End_of_acc fmt'
 
   | End_of_format ->
     k o acc
 
 (* Delay the error (Invalid_argument "Printf: bad conversion %_"). *)
 (* Generate functions to take remaining arguments (after the "%_"). *)
-and make_ignored_param : type x y a b c f .
+and make_ignored_param : type x y a b c d e f .
     (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
-    (a, b, c, c, y, x) CamlinternalFormatBasics.ignored ->
-    (x, b, c, y, c, f) CamlinternalFormatBasics.fmt -> a =
+    (a, b, c, d, y, x) ignored ->
+    (x, b, c, y, e, f) fmt -> a =
 fun k o acc ign fmt -> match ign with
   | Ignored_char                    -> make_invalid_arg k o acc fmt
   | Ignored_caml_char               -> make_invalid_arg k o acc fmt
@@ -1378,10 +1457,10 @@ fun k o acc ign fmt -> match ign with
 
 
 (* Special case of printf "%_(". *)
-and make_from_fmtty : type x y a b c f .
+and make_from_fmtty : type x y a b c d e f .
     (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
-    (a, b, c, c, y, x) CamlinternalFormatBasics.fmtty ->
-    (x, b, c, y, c, f) CamlinternalFormatBasics.fmt -> a =
+    (a, b, c, d, y, x) fmtty ->
+    (x, b, c, y, e, f) fmt -> a =
 fun k o acc fmtty fmt -> match fmtty with
   | Char_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
   | String_ty rest          -> fun _ -> make_from_fmtty k o acc rest fmt
@@ -1403,16 +1482,16 @@ fun k o acc fmtty fmt -> match fmtty with
 
 (* Insert an Acc_invalid_arg in the accumulator and continue to generate
    closures to get the remaining arguments. *)
-and make_invalid_arg : type a b c f .
+and make_invalid_arg : type a b c d e f .
     (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
-    (a, b, c, c, c, f) CamlinternalFormatBasics.fmt -> a =
+    (a, b, c, d, e, f) fmt -> a =
 fun k o acc fmt ->
   make_printf k o (Acc_invalid_arg (acc, "Printf: bad conversion %_")) fmt
 
 (* Fix padding, take it as an extra integer argument if needed. *)
-and make_string_padding : type x z a b c d .
-    (b -> (b, c) acc -> d) -> b -> (b, c) acc ->
-    (a, b, c, c, c, d) CamlinternalFormatBasics.fmt ->
+and make_string_padding : type x z a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
     (x, z -> a) padding -> (z -> string) -> x =
   fun k o acc fmt pad trans -> match pad with
   | No_padding ->
@@ -1430,9 +1509,9 @@ and make_string_padding : type x z a b c d .
 
 (* Fix padding and precision for int, int32, nativeint or int64. *)
 (* Take one or two extra integer arguments if needed. *)
-and make_int_padding_precision : type x y z a b c d .
-    (b -> (b, c) acc -> d) -> b -> (b, c) acc ->
-    (a, b, c, c, c, d) CamlinternalFormatBasics.fmt ->
+and make_int_padding_precision : type x y z a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
     (x, y) padding -> (y, z -> a) precision -> (int_conv -> z -> string) ->
     int_conv -> x =
   fun k o acc fmt pad prec trans iconv -> match pad, prec with
@@ -1475,9 +1554,9 @@ and make_int_padding_precision : type x y z a b c d .
 
 (* Convert a float, fix padding and precision if needed. *)
 (* Take the float argument and one or two extra integer arguments if needed. *)
-and make_float_padding_precision : type x y a b c d .
-    (b -> (b, c) acc -> d) -> b -> (b, c) acc ->
-    (a, b, c, c, c, d) CamlinternalFormatBasics.fmt ->
+and make_float_padding_precision : type x y a b c d e f .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, d, e, f) fmt ->
     (x, y) padding -> (y, float -> a) precision -> float_conv -> x =
   fun k o acc fmt pad prec fconv -> match pad, prec with
   | No_padding, No_precision ->
@@ -1526,10 +1605,15 @@ and make_float_padding_precision : type x y a b c d .
    printing entities (string, char, flus, ...) in an output_stream. *)
 (* Used as a continuation of make_printf. *)
 let rec output_acc o acc = match acc with
-  | Acc_formatting (p, fmting) ->
-    let s = string_of_formatting fmting in
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
     output_acc o p;
     output_string o s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    output_acc o p;
+    output_string o "@{<";
+    output_acc o acc';
+    output_char o '>';
   | Acc_string (p, s)        -> output_acc o p; output_string o s
   | Acc_char (p, c)          -> output_acc o p; output_char o c
   | Acc_delay (p, f)         -> output_acc o p; f o
@@ -1541,10 +1625,15 @@ let rec output_acc o acc = match acc with
    printing entities (string, char, flus, ...) in a buffer. *)
 (* Used as a continuation of make_printf. *)
 let rec bufput_acc b acc = match acc with
-  | Acc_formatting (p, fmting) ->
-    let s = string_of_formatting fmting in
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
     bufput_acc b p;
     Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    bufput_acc b p;
+    Buffer.add_string b "@{<";
+    bufput_acc b acc';
+    Buffer.add_char b '>';
   | Acc_string (p, s)        -> bufput_acc b p; Buffer.add_string b s
   | Acc_char (p, c)          -> bufput_acc b p; Buffer.add_char b c
   | Acc_delay (p, f)         -> bufput_acc b p; f b
@@ -1557,10 +1646,15 @@ let rec bufput_acc b acc = match acc with
 (* Differ from bufput_acc by the interpretation of %a and %t. *)
 (* Used as a continuation of make_printf. *)
 let rec strput_acc b acc = match acc with
-  | Acc_formatting (p, fmting) ->
-    let s = string_of_formatting fmting in
+  | Acc_formatting_lit (p, fmting_lit) ->
+    let s = string_of_formatting_lit fmting_lit in
     strput_acc b p;
     Buffer.add_string b s;
+  | Acc_formatting_gen (p, Acc_open_tag acc') ->
+    strput_acc b p;
+    Buffer.add_string b "@{<";
+    strput_acc b acc';
+    Buffer.add_char b '>';
   | Acc_string (p, s)        -> strput_acc b p; Buffer.add_string b s
   | Acc_char (p, c)          -> strput_acc b p; Buffer.add_char b c
   | Acc_delay (p, f)         -> strput_acc b p; Buffer.add_string b (f ())
@@ -1583,7 +1677,7 @@ let failwith_message (Format (fmt, _)) =
 (* Create a padding_fmt_ebb from a padding and a format. *)
 (* Copy the padding to disjoin the type parameters of argument and result. *)
 let make_padding_fmt_ebb : type x y .
-    (x, y) padding -> (_, _, _, _, _, _) CamlinternalFormatBasics.fmt ->
+    (x, y) padding -> (_, _, _, _, _, _) fmt ->
       (_, _, _, _, _) padding_fmt_ebb =
 fun pad fmt -> match pad with
   | No_padding         -> Padding_fmt_EBB (No_padding, fmt)
@@ -1593,7 +1687,7 @@ fun pad fmt -> match pad with
 (* Create a precision_fmt_ebb from a precision and a format. *)
 (* Copy the precision to disjoin the type parameters of argument and result. *)
 let make_precision_fmt_ebb : type x y .
-    (x, y) precision -> (_, _, _, _, _, _) CamlinternalFormatBasics.fmt ->
+    (x, y) precision -> (_, _, _, _, _, _) fmt ->
       (_, _, _, _, _) precision_fmt_ebb =
 fun prec fmt -> match prec with
   | No_precision    -> Precision_fmt_EBB (No_precision, fmt)
@@ -1605,7 +1699,7 @@ fun prec fmt -> match prec with
    and result. *)
 let make_padprec_fmt_ebb : type x y z t .
     (x, y) padding -> (z, t) precision ->
-    (_, _, _, _, _, _) CamlinternalFormatBasics.fmt ->
+    (_, _, _, _, _, _) fmt ->
     (_, _, _, _, _) padprec_fmt_ebb =
 fun pad prec fmt ->
   let Precision_fmt_EBB (prec, fmt') = make_precision_fmt_ebb prec fmt in
@@ -2004,9 +2098,7 @@ let fmt_ebb_of_string str =
         let ignored = Ignored_format_subst (get_pad_opt '_', sub_fmtty) in
         Fmt_EBB (Ignored_param (ignored, fmt_rest))
       else
-        Fmt_EBB (Format_subst (get_pad_opt '(',
-                               sub_fmtty,
-                               fmt_rest))
+        Fmt_EBB (Format_subst (get_pad_opt '(', sub_fmtty, fmt_rest))
     | '[' ->
       let next_ind, char_set = parse_char_set str_ind end_ind in
       let Fmt_EBB fmt_rest = parse next_ind end_ind in
@@ -2065,43 +2157,43 @@ let fmt_ebb_of_string str =
         parse_open_box (str_ind + 1) end_ind
       | ']' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Close_box, fmt_rest))
+        Fmt_EBB (Formatting_lit (Close_box, fmt_rest))
       | '{' ->
         parse_open_tag (str_ind + 1) end_ind
       | '}' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Close_tag, fmt_rest))
+        Fmt_EBB (Formatting_lit (Close_tag, fmt_rest))
       | ',' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Break ("@,", 0, 0), fmt_rest))
+        Fmt_EBB (Formatting_lit (Break ("@,", 0, 0), fmt_rest))
       | ' ' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Break ("@ ", 1, 0), fmt_rest))
+        Fmt_EBB (Formatting_lit (Break ("@ ", 1, 0), fmt_rest))
       | ';' ->
         parse_good_break (str_ind + 1) end_ind
       | '?' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (FFlush, fmt_rest))
+        Fmt_EBB (Formatting_lit (FFlush, fmt_rest))
       | '\n' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Force_newline, fmt_rest))
+        Fmt_EBB (Formatting_lit (Force_newline, fmt_rest))
       | '.' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Flush_newline, fmt_rest))
+        Fmt_EBB (Formatting_lit (Flush_newline, fmt_rest))
       | '<' ->
         parse_magic_size (str_ind + 1) end_ind
       | '@' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Escaped_at, fmt_rest))
+        Fmt_EBB (Formatting_lit (Escaped_at, fmt_rest))
       | '%' when str_ind + 1 < end_ind && str.[str_ind + 1] = '%' ->
         let Fmt_EBB fmt_rest = parse (str_ind + 2) end_ind in
-        Fmt_EBB (Formatting (Escaped_percent, fmt_rest))
+        Fmt_EBB (Formatting_lit (Escaped_percent, fmt_rest))
       | '%' ->
         let Fmt_EBB fmt_rest = parse str_ind end_ind in
         Fmt_EBB (Char_literal ('@', fmt_rest))
       | c ->
         let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
-        Fmt_EBB (Formatting (Scan_indic c, fmt_rest))
+        Fmt_EBB (Formatting_lit (Scan_indic c, fmt_rest))
 
   (* Try to read the optionnal <...> after "@[". *)
   and parse_open_box : type e f . int -> int -> (_, _, e, f) fmt_ebb =
@@ -2143,31 +2235,31 @@ let fmt_ebb_of_string str =
     in
     let s = String.sub str (str_ind - 2) (next_ind - str_ind + 2) in
     let Fmt_EBB fmt_rest = parse next_ind end_ind in
-    Fmt_EBB (Formatting (Open_box (s, box_ty, indent), fmt_rest))
+    Fmt_EBB (Formatting_lit (Open_box (s, box_ty, indent), fmt_rest))
 
   (* Try to read the optionnal <name> after "@{". *)
   and parse_open_tag : type e f . int -> int -> (_, _, e, f) fmt_ebb =
   fun str_ind end_ind ->
-    let next_ind, lit, name =
-      try
-        if str_ind = end_ind then raise Not_found;
-        match str.[str_ind] with
-        | '<' ->
-          let ind = String.index_from str (str_ind + 1) '>' in
-          if ind >= end_ind then raise Not_found;
-          let lit = String.sub str (str_ind - 1) (ind - str_ind + 2) in
-          let name = String.sub str (str_ind + 1) (ind - str_ind - 1) in
-          ind + 1, lit, name
-        | _ -> raise Not_found
-      with Not_found -> str_ind, "@{", ""
-    in
-    let Fmt_EBB fmt_rest = parse next_ind end_ind in
-    Fmt_EBB (Formatting (Open_tag (lit, name), fmt_rest))
+    try
+      if str_ind = end_ind then raise Not_found;
+      match str.[str_ind] with
+      | '<' ->
+        let ind = String.index_from str (str_ind + 1) '>' in
+        if ind >= end_ind then raise Not_found;
+        let as_str = String.sub str (str_ind + 1) (ind - str_ind - 1) in
+        let Fmt_EBB fmt_rest = parse (ind + 1) end_ind in
+        let Fmt_EBB sub_fmt = parse (str_ind + 1) ind in
+        Fmt_EBB (Formatting_gen (Open_tag (Format (sub_fmt, as_str)), fmt_rest))
+      | _ ->
+        raise Not_found
+    with Not_found ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Formatting_gen (Open_tag (Format (End_of_format, "")), fmt_rest))
 
   (* Try to read the optionnal <width offset> after "@;". *)
   and parse_good_break : type e f . int -> int -> (_, _, e, f) fmt_ebb =
   fun str_ind end_ind ->
-    let next_ind, formatting =
+    let next_ind, formatting_lit =
       try
         if str_ind = end_ind || str.[str_ind] <> '<' then raise Not_found; 
         let str_ind_1 = parse_spaces (str_ind + 1) end_ind in
@@ -2192,7 +2284,7 @@ let fmt_ebb_of_string str =
         str_ind, Break ("@;", 1, 0)
     in
     let Fmt_EBB fmt_rest = parse next_ind end_ind in
-    Fmt_EBB (Formatting (formatting, fmt_rest))
+    Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
 
   (* Parse the size in a <n>. *)
   and parse_magic_size : type e f . int -> int -> (_, _, e, f) fmt_ebb =
@@ -2211,12 +2303,12 @@ let fmt_ebb_of_string str =
       with Not_found | Failure _ ->
         None
     with
-    | Some (next_ind, formatting) ->
+    | Some (next_ind, formatting_lit) ->
       let Fmt_EBB fmt_rest = parse next_ind end_ind in
-      Fmt_EBB (Formatting (formatting, fmt_rest))
+      Fmt_EBB (Formatting_lit (formatting_lit, fmt_rest))
     | None ->
       let Fmt_EBB fmt_rest = parse str_ind end_ind in
-      Fmt_EBB (Formatting (Scan_indic '<', fmt_rest))
+      Fmt_EBB (Formatting_lit (Scan_indic '<', fmt_rest))
 
   (* Parse and construct a char set. *)
   and parse_char_set str_ind end_ind =
@@ -2342,7 +2434,7 @@ let fmt_ebb_of_string str =
 
   (* Add a literal to a format from a literal character sub-sequence. *)
   and add_literal : type a d e f .
-      int -> int -> (a, _, _, d, e, f) CamlinternalFormatBasics.fmt ->
+      int -> int -> (a, _, _, d, e, f) fmt ->
       (_, _, e, f) fmt_ebb =
   fun lit_start str_ind fmt -> match str_ind - lit_start with
     | 0    -> Fmt_EBB fmt
diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli
index b23d800f2..df4c0c0e7 100644
--- a/stdlib/camlinternalFormat.mli
+++ b/stdlib/camlinternalFormat.mli
@@ -18,13 +18,17 @@ val param_format_of_ignored_format :
   ('a, 'b, 'c, 'd, 'y, 'x) ignored -> ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
   ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
 
-type ('b, 'c) acc =
-  | Acc_formatting  of ('b, 'c) acc * formatting
-  | Acc_string      of ('b, 'c) acc * string
-  | Acc_char        of ('b, 'c) acc * char
-  | Acc_delay       of ('b, 'c) acc * ('b -> 'c)
-  | Acc_flush       of ('b, 'c) acc
-  | Acc_invalid_arg of ('b, 'c) acc * string
+type ('b, 'c) acc_formatting_gen =
+  | Acc_open_tag of ('b, 'c) acc
+
+and ('b, 'c) acc =
+  | Acc_formatting_lit of ('b, 'c) acc * formatting_lit
+  | Acc_formatting_gen of ('b, 'c) acc * ('b, 'c) acc_formatting_gen
+  | Acc_string         of ('b, 'c) acc * string
+  | Acc_char           of ('b, 'c) acc * char
+  | Acc_delay          of ('b, 'c) acc * ('b -> 'c)
+  | Acc_flush          of ('b, 'c) acc
+  | Acc_invalid_arg    of ('b, 'c) acc * string
   | End_of_acc
 
 type ('a, 'b) heter_list =
@@ -61,7 +65,9 @@ val format_of_string_format :
   ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
 
 val char_of_iconv : CamlinternalFormatBasics.int_conv -> char
-val string_of_formatting : CamlinternalFormatBasics.formatting -> string
+val string_of_formatting_lit : CamlinternalFormatBasics.formatting_lit -> string
+val string_of_formatting_gen :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.formatting_gen -> string
 
 val string_of_fmtty :
   ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
diff --git a/stdlib/camlinternalFormatBasics.ml b/stdlib/camlinternalFormatBasics.ml
index 76f3a4acc..47e661fe4 100644
--- a/stdlib/camlinternalFormatBasics.ml
+++ b/stdlib/camlinternalFormatBasics.ml
@@ -1,33 +1,3 @@
-(* Type of a block used by the Format pretty-printer. *)
-type block_type =
-  | Pp_hbox   (* Horizontal block no line breaking *)
-  | Pp_vbox   (* Vertical block each break leads to a new line *)
-  | Pp_hvbox  (* Horizontal-vertical block: same as vbox, except if this block
-                 is small enough to fit on a single line *)
-  | Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
-                 only when necessary to print the content of the block *)
-  | Pp_box    (* Horizontal or Indent block: breaks lead to new line
-                 only when necessary to print the content of the block, or
-                 when it leads to a new indentation of the current line *)
-  | Pp_fits   (* Internal usage: when a block fits on a single line *)
-
-(* Formatting element used by the Format pretty-printter. *)
-type formatting =
-  | Open_box of string * block_type * int   (* @[   *)
-  | Close_box                               (* @]   *)
-  | Open_tag of string * string             (* @{   *)
-  | Close_tag                               (* @}   *)
-  | Break of string * int * int             (* @, | @  | @; | @;<> *)
-  | FFlush                                  (* @?   *)
-  | Force_newline                           (* @\n  *)
-  | Flush_newline                           (* @.   *)
-  | Magic_size of string * int              (* @<n> *)
-  | Escaped_at                              (* @@   *)
-  | Escaped_percent                         (* @%%  *)
-  | Scan_indic of char                      (* @X   *)
-
-(***)
-
 (* Padding position. *)
 type padty =
   | Left   (* Text is left justified ('-' option).               *)
@@ -226,9 +196,43 @@ does assume that the two input have exactly the same term structure
 Format_subst_ty constructor).
 *)
 
+(* Type of a block used by the Format pretty-printer. *)
+type block_type =
+  | Pp_hbox   (* Horizontal block no line breaking *)
+  | Pp_vbox   (* Vertical block each break leads to a new line *)
+  | Pp_hvbox  (* Horizontal-vertical block: same as vbox, except if this block
+                 is small enough to fit on a single line *)
+  | Pp_hovbox (* Horizontal or Vertical block: breaks lead to new line
+                 only when necessary to print the content of the block *)
+  | Pp_box    (* Horizontal or Indent block: breaks lead to new line
+                 only when necessary to print the content of the block, or
+                 when it leads to a new indentation of the current line *)
+  | Pp_fits   (* Internal usage: when a block fits on a single line *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type formatting_lit =
+  | Open_box of string * block_type * int               (* @[   *)
+  | Close_box                                           (* @]   *)
+  | Close_tag                                           (* @}   *)
+  | Break of string * int * int          (* @, | @  | @; | @;<> *)
+  | FFlush                                              (* @?   *)
+  | Force_newline                                       (* @\n  *)
+  | Flush_newline                                       (* @.   *)
+  | Magic_size of string * int                          (* @<n> *)
+  | Escaped_at                                          (* @@   *)
+  | Escaped_percent                                     (* @%%  *)
+  | Scan_indic of char                                  (* @X   *)
+
+(* Formatting element used by the Format pretty-printter. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->      (* @{   *)
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+(***)
+
 (* List of format type elements. *)
 (* In particular used to represent %(...%) and %{...%} contents. *)
-type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
      ('a, 'b, 'c, 'd, 'e, 'f,
       'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
 and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
@@ -388,9 +392,12 @@ and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
         (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
 
   (* Format specific constructor: *)
-  | Formatting :                                             (* @_ *)
-      formatting * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+  | Formatting_lit :                                         (* @_ *)
+      formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
         ('a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Formatting_gen :                                             (* @_ *)
+      ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+      ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
 
   (* Scanf specific constructors: *)
   | Reader :                                                 (* %r *)
@@ -597,8 +604,10 @@ fun fmt1 fmt2 -> match fmt1 with
   | Ignored_param (ign, rest) ->
     Ignored_param (ign, concat_fmt rest fmt2)
 
-  | Formatting (fmting, rest) ->
-    Formatting (fmting, concat_fmt rest fmt2)
+  | Formatting_lit (fmting_lit, rest) ->
+    Formatting_lit (fmting_lit, concat_fmt rest fmt2)
+  | Formatting_gen (fmting_gen, rest) ->
+    Formatting_gen (fmting_gen, concat_fmt rest fmt2)
 
   | End_of_format ->
     fmt2
diff --git a/stdlib/camlinternalFormatBasics.mli b/stdlib/camlinternalFormatBasics.mli
index e45f6bc1f..850bf6bc6 100644
--- a/stdlib/camlinternalFormatBasics.mli
+++ b/stdlib/camlinternalFormatBasics.mli
@@ -1,21 +1,5 @@
 (* No comments, OCaml stdlib internal use only. *)
 
-type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
-
-type formatting =
-  | Open_box of string * block_type * int
-  | Close_box
-  | Open_tag of string * string
-  | Close_tag
-  | Break of string * int * int
-  | FFlush
-  | Force_newline
-  | Flush_newline
-  | Magic_size of string * int
-  | Escaped_at
-  | Escaped_percent
-  | Scan_indic of char
-
 type padty = Left | Right | Zeros
 
 type int_conv =
@@ -45,184 +29,206 @@ type ('a, 'b) precision =
 
 type prec_option = int option
 
-type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+type block_type = Pp_hbox | Pp_vbox | Pp_hvbox | Pp_hovbox | Pp_box | Pp_fits
+
+type formatting_lit =
+  | Open_box of string * block_type * int
+  | Close_box
+  | Close_tag
+  | Break of string * int * int
+  | FFlush
+  | Force_newline
+  | Flush_newline
+  | Magic_size of string * int
+  | Escaped_at
+  | Escaped_percent
+  | Scan_indic of char
+
+type ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen =
+  | Open_tag : ('a, 'b, 'c, 'd, 'e, 'f) format6 ->
+    ('a, 'b, 'c, 'd, 'e, 'f) formatting_gen
+
+and ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
     ('a, 'b, 'c, 'd, 'e, 'f,
      'a, 'b, 'c, 'd, 'e, 'f) fmtty_rel
 and ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
-  | Char_ty :                                                 (* %c  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | String_ty :                                               (* %s  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Int_ty :                                                  (* %d  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Int32_ty :                                                (* %ld *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Nativeint_ty :                                            (* %nd *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Int64_ty :                                                (* %Ld *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Float_ty :                                                (* %f  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Bool_ty :                                                 (* %B  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Format_arg_ty :                                           (* %{...%} *)
-      ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Format_subst_ty :                                         (* %(...%) *)
-      ('g, 'h, 'i, 'j, 'k, 'l,
-       'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
-      ('g, 'h, 'i, 'j, 'k, 'l,
-       'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
-           ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel =
+| Char_ty :                                                 (* %c  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (char -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     char -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| String_ty :                                               (* %s  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (string -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     string -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int_ty :                                                  (* %d  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int32_ty :                                                (* %ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int32 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int32 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Nativeint_ty :                                            (* %nd *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (nativeint -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     nativeint -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Int64_ty :                                                (* %Ld *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (int64 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     int64 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Float_ty :                                                (* %f  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (float -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     float -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Bool_ty :                                                 (* %B  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (bool -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     bool -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_arg_ty :                                           (* %{...%} *)
+    ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Format_subst_ty :                                         (* %(...%) *)
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g1, 'b1, 'c1, 'j1, 'd1, 'a1) fmtty_rel *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel *
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+     ('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
 
-           (* Printf and Format specific constructors. *)
-  | Alpha_ty :                                                (* %a  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
-  | Theta_ty :                                                (* %t  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-           ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+(* Printf and Format specific constructors. *)
+| Alpha_ty :                                                (* %a  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'x -> 'c1) -> 'x -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'x -> 'c2) -> 'x -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
+| Theta_ty :                                                (* %t  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    (('b1 -> 'c1) -> 'a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     ('b2 -> 'c2) -> 'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel
 
-           (* Scanf specific constructor. *)
-  | Reader_ty :                                               (* %r  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
-           'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
-  | Ignored_reader_ty :                                       (* %_r  *)
-      ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-       'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-         ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
-           'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+(* Scanf specific constructor. *)
+| Reader_ty :                                               (* %r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('x -> 'a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'x -> 'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
+| Ignored_reader_ty :                                       (* %_r  *)
+    ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+    ('a1, 'b1, 'c1, ('b1 -> 'x) -> 'd1, 'e1, 'f1,
+     'a2, 'b2, 'c2, ('b2 -> 'x) -> 'd2, 'e2, 'f2) fmtty_rel
 
-  | End_of_fmtty :
-      ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
-       'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
+| End_of_fmtty :
+    ('f1, 'b1, 'c1, 'd1, 'd1, 'f1,
+     'f2, 'b2, 'c2, 'd2, 'd2, 'f2) fmtty_rel
 
-(***)
+(**)
 
-(* List of format elements. *)
+(** List of format elements. *)
 and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
-  | Char :                                                   (* %c *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Caml_char :                                              (* %C *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | String :                                                 (* %s *)
-      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Caml_string :                                            (* %S *)
-      ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Int :                                                    (* %[dixXuo] *)
-      int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Int32 :                                                  (* %l[dixXuo] *)
-      int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Nativeint :                                              (* %n[dixXuo] *)
-      int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Int64 :                                                  (* %L[dixXuo] *)
-      int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Float :                                                  (* %[feEgGF] *)
-      float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x, 'b, 'c, 'd, 'e, 'f) fmt
-  | Bool :                                                   (* %[bB] *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Flush :                                                  (* %! *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Char :                                                   (* %c *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_char :                                              (* %C *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| String :                                                 (* %s *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Caml_string :                                            (* %S *)
+    ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int :                                                    (* %[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int32 :                                                  (* %l[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Nativeint :                                              (* %n[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Int64 :                                                  (* %L[dixXuo] *)
+    int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Float :                                                  (* %[feEgGF] *)
+    float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x, 'b, 'c, 'd, 'e, 'f) fmt
+| Bool :                                                   (* %[bB] *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Flush :                                                  (* %! *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
 
-  | String_literal :                                         (* abc *)
-      string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Char_literal :                                           (* x *)
-      char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| String_literal :                                         (* abc *)
+    string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Char_literal :                                           (* x *)
+    char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
 
-  | Format_arg :                                             (* %{...%} *)
-      pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Format_subst :                                           (* %(...%) *)
-      pad_option *
-      ('g, 'h, 'i, 'j, 'k, 'l,
-       'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
+| Format_arg :                                             (* %{...%} *)
+    pad_option * ('g, 'h, 'i, 'j, 'k, 'l) fmtty *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Format_subst :                                           (* %(...%) *)
+    pad_option *
+    ('g, 'h, 'i, 'j, 'k, 'l,
+     'g2, 'b, 'c, 'j2, 'd, 'a) fmtty_rel *
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    (('g, 'h, 'i, 'j, 'k, 'l) format6 -> 'g2, 'b, 'c, 'j2, 'e, 'f) fmt
 
-          (* Printf and Format specific constructor. *)
-  | Alpha :                                                  (* %a *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Theta :                                                  (* %t *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+(* Printf and Format specific constructor. *)
+| Alpha :                                                  (* %a *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Theta :                                                  (* %t *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
 
-          (* Format specific constructor: *)
-  | Formatting :                                             (* @_ *)
-      formatting * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+(* Format specific constructor: *)
+| Formatting_lit :                                         (* @_ *)
+    formatting_lit * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
+| Formatting_gen :                                             (* @_ *)
+    ('a1, 'b, 'c, 'd1, 'e1, 'f1) formatting_gen *
+    ('f1, 'b, 'c, 'e1, 'e2, 'f2) fmt -> ('a1, 'b, 'c, 'd1, 'e2, 'f2) fmt
 
-          (* Scanf specific constructors: *)
-  | Reader :                                                 (* %r *)
-      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
-  | Scan_char_set :                                          (* %[...] *)
-      pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Scan_get_counter :                                       (* %[nlNL] *)
-      counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-        (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
-  | Ignored_param :                                          (* %_ *)
-      ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
-        ('a, 'b, 'c, 'd, 'e, 'f) fmt
+(* Scanf specific constructors: *)
+| Reader :                                                 (* %r *)
+    ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+| Scan_char_set :                                          (* %[...] *)
+    pad_option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Scan_get_counter :                                       (* %[nlNL] *)
+    counter * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+      (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+| Ignored_param :                                          (* %_ *)
+    ('a, 'b, 'c, 'd, 'y, 'x) ignored * ('x, 'b, 'c, 'y, 'e, 'f) fmt ->
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt
 
-  | End_of_format :
+| End_of_format :
       ('f, 'b, 'c, 'e, 'e, 'f) fmt
 
 and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
@@ -260,21 +266,21 @@ and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
       counter -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
 
 and ('a, 'b, 'c, 'd, 'e, 'f) format6 =
-    Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+  Format of ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
 
 val concat_fmtty :
-    ('g1, 'b1, 'c1, 'j1, 'd1, 'a1,
-     'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel ->
-       ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
-        'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
-          ('g1, 'b1, 'c1, 'j1, 'e1, 'f1,
-           'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
+  ('g1, 'b1, 'c1, 'j1, 'd1, 'a1,
+   'g2, 'b2, 'c2, 'j2, 'd2, 'a2) fmtty_rel ->
+  ('a1, 'b1, 'c1, 'd1, 'e1, 'f1,
+   'a2, 'b2, 'c2, 'd2, 'e2, 'f2) fmtty_rel ->
+  ('g1, 'b1, 'c1, 'j1, 'e1, 'f1,
+   'g2, 'b2, 'c2, 'j2, 'e2, 'f2) fmtty_rel
 
 val erase_rel :
-    ('a, 'b, 'c, 'd, 'e, 'f,
-     'g, 'h, 'i, 'j, 'k, 'l) fmtty_rel -> ('a, 'b, 'c, 'd, 'e, 'f) fmtty
+  ('a, 'b, 'c, 'd, 'e, 'f,
+   'g, 'h, 'i, 'j, 'k, 'l) fmtty_rel -> ('a, 'b, 'c, 'd, 'e, 'f) fmtty
 
 val concat_fmt :
     ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
-      ('f, 'b, 'c, 'e, 'g, 'h) fmt ->
-        ('a, 'b, 'c, 'd, 'g, 'h) fmt
+    ('f, 'b, 'c, 'e, 'g, 'h) fmt ->
+    ('a, 'b, 'c, 'd, 'g, 'h) fmt
diff --git a/stdlib/format.ml b/stdlib/format.ml
index cca3217b1..7f9b959a2 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -1069,10 +1069,9 @@ open CamlinternalFormatBasics
 open CamlinternalFormat
 
 (* Interpret a formatting entity on a formatter. *)
-let output_formatting ppf fmting = match fmting with
+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 ()
-  | Open_tag (_, name)        -> pp_open_tag ppf name
   | Close_tag                 -> pp_close_tag ppf ()
   | Break (_, width, offset)  -> pp_print_break ppf width offset
   | FFlush                    -> pp_print_flush ppf ()
@@ -1088,13 +1087,22 @@ let output_formatting ppf fmting = match fmting with
 (* Differ from Printf.output_acc by the interpretation of formatting. *)
 (* Used as a continuation of CamlinternalFormat.make_printf. *)
 let rec output_acc ppf acc = match acc with
-  | Acc_string (Acc_formatting (p, Magic_size (_, size)), s) ->
+  | Acc_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
     output_acc ppf p;
     pp_print_as_size ppf (size_of_int size) s;
-  | Acc_char (Acc_formatting (p, Magic_size (_, size)), c) ->
+  | Acc_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
     output_acc ppf p;
     pp_print_as_size ppf (size_of_int size) (String.make 1 c);
-  | Acc_formatting (p, f)    -> output_acc ppf p; output_formatting ppf f;
+  | Acc_formatting_lit (p, f) ->
+    output_acc ppf p;
+    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');
   | 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;
@@ -1107,16 +1115,25 @@ let rec output_acc ppf acc = match acc with
 (* Differ from Printf.bufput_acc by the interpretation of formatting. *)
 (* Used as a continuation of CamlinternalFormat.make_printf. *)
 let rec strput_acc ppf acc = match acc with
-  | Acc_string (Acc_formatting (p, Magic_size (_, size)), s) ->
+  | Acc_string (Acc_formatting_lit (p, Magic_size (_, size)), s) ->
     strput_acc ppf p;
     pp_print_as_size ppf (size_of_int size) s;
-  | Acc_char (Acc_formatting (p, Magic_size (_, size)), c) ->
+  | Acc_char (Acc_formatting_lit (p, Magic_size (_, size)), c) ->
     strput_acc ppf p;
     pp_print_as_size ppf (size_of_int size) (String.make 1 c);
-  | Acc_delay (Acc_formatting (p, Magic_size (_, size)), f) ->
+  | Acc_delay (Acc_formatting_lit (p, Magic_size (_, size)), f) ->
     strput_acc ppf p;
     pp_print_as_size ppf (size_of_int size) (f ());
-  | Acc_formatting (p, f)    -> strput_acc ppf p; output_formatting ppf f;
+  | Acc_formatting_lit (p, f) ->
+    strput_acc ppf p;
+    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');
   | 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 ());
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index 2c0e69b8f..b9592ae2b 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -992,9 +992,9 @@ let width_of_pad_opt pad_opt = match pad_opt with
   | None -> max_int
   | Some width -> width
 
-let stopper_of_formatting fmting =
+let stopper_of_formatting_lit fmting =
   if fmting = Escaped_percent then '%', "" else
-    let str = string_of_formatting fmting in
+    let str = string_of_formatting_lit fmting in
     let stp = str.[1] in
     let sub_str = String.sub str 2 (String.length str - 2) in
     stp, sub_str
@@ -1033,7 +1033,9 @@ fun k fmt -> match fmt with
   | Scan_char_set (_, _, rest)       -> take_format_readers k rest
   | Scan_get_counter (_, rest)       -> take_format_readers k rest
 
-  | Formatting (_, rest)             -> take_format_readers k rest
+  | Formatting_lit (_, rest)         -> take_format_readers k rest
+  | Formatting_gen (Open_tag (Format (fmt, _)), rest) -> take_format_readers k (concat_fmt fmt rest)
+
 
   | Format_arg (_, _, rest)          -> take_format_readers k rest
   | Format_subst (_, fmtty, rest)    -> take_fmtty_format_readers k (erase_rel (symm fmtty)) rest
@@ -1115,8 +1117,8 @@ fun ib fmt readers -> match fmt with
     let c = token_char ib in
     Cons (c, make_scanf ib rest readers)
 
-  | String (pad, Formatting (fmting, rest)) ->
-    let stp, str = stopper_of_formatting fmting in
+  | String (pad, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
     let scan width _ ib = scan_string (Some stp) width ib in
     let str_rest = String_literal (str, rest) in
     pad_prec_scanf ib str_rest readers pad No_precision scan token_string
@@ -1207,8 +1209,8 @@ fun ib fmt readers -> match fmt with
     Cons (Format (fmt, s),
           make_scanf ib (concat_fmt fmt' rest) readers)
 
-  | Scan_char_set (width_opt, char_set, Formatting (fmting, rest)) ->
-    let stp, str = stopper_of_formatting fmting in
+  | Scan_char_set (width_opt, char_set, Formatting_lit (fmting_lit, rest)) ->
+    let stp, str = stopper_of_formatting_lit fmting_lit in
     let width = width_of_pad_opt width_opt in
     let _ = scan_chars_in_char_set char_set (Some stp) width ib in
     let s = token_string ib in
@@ -1223,9 +1225,12 @@ fun ib fmt readers -> match fmt with
     let count = get_counter ib counter in
     Cons (count, make_scanf ib rest readers)
 
-  | Formatting (formatting, rest) ->
-    String.iter (check_char ib) (string_of_formatting formatting);
+  | Formatting_lit (formatting_lit, rest) ->
+    String.iter (check_char ib) (string_of_formatting_lit formatting_lit);
     make_scanf ib rest readers
+  | Formatting_gen (Open_tag (Format (fmt', _)), rest) ->
+    check_char ib '@'; check_char ib '{'; check_char ib '<';
+    make_scanf ib (concat_fmt fmt' (Char_literal ('<', rest))) readers
 
   | Ignored_param (ign, rest) ->
     let Param_format_EBB fmt' = param_format_of_ignored_format ign rest in