7 files changed, 2844 insertions, 5 deletions
diff --git a/stdlib/.depend b/stdlib/.depend
index e7492ebf5..58a49f1cd 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -5,6 +5,7 @@ buffer.cmi :
 bytes.cmi :
 bytesLabels.cmi :
 callback.cmi :
+camlinternalFormat.cmi :
 camlinternalLazy.cmi :
 camlinternalMod.cmi : obj.cmi
 camlinternalOO.cmi : obj.cmi
@@ -61,6 +62,8 @@ bytesLabels.cmo : bytes.cmi bytesLabels.cmi
 bytesLabels.cmx : bytes.cmx bytesLabels.cmi
 callback.cmo : obj.cmi callback.cmi
 callback.cmx : obj.cmx callback.cmi
+camlinternalFormat.cmo : camlinternalFormat.cmi char.cmi string.cmi
+camlinternalFormat.cmx : camlinternalFormat.cmi char.cmx string.cmx
 camlinternalLazy.cmo : obj.cmi camlinternalLazy.cmi
 camlinternalLazy.cmx : obj.cmx camlinternalLazy.cmi
 camlinternalMod.cmo : obj.cmi camlinternalOO.cmi array.cmi \
diff --git a/stdlib/Compflags b/stdlib/Compflags
index 9610b726c..1a66d1591 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -18,7 +18,9 @@ case $1 in
   camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
   buffer.cmx|buffer.p.cmx) echo ' -inline 3';;
                            # make sure add_char is inlined (PR#5872)
-  buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
+  buffer.cm[io]) echo ' -w A';;
+  camlinternalFormat.cm[io]) echo ' -w a';;
+  printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
   scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
   *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';;
   *) echo ' ';;
diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared
index 65248cd10..61f40fe1f 100755
--- a/stdlib/Makefile.shared
+++ b/stdlib/Makefile.shared
@@ -28,7 +28,7 @@ OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \
   lexing.cmo parsing.cmo \
   set.cmo map.cmo stack.cmo queue.cmo \
   camlinternalLazy.cmo lazy.cmo stream.cmo \
-  buffer.cmo printf.cmo \
+  buffer.cmo camlinternalFormat.cmo printf.cmo \
   arg.cmo printexc.cmo gc.cmo \
   digest.cmo random.cmo hashtbl.cmo format.cmo scanf.cmo callback.cmo \
   camlinternalOO.cmo oo.cmo camlinternalMod.cmo \
diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml
new file mode 100644
index 000000000..5c704fb8a
--- /dev/null
+++ b/stdlib/camlinternalFormat.ml
@@ -0,0 +1,2021 @@
+open CamlinternalFormatBasics
+
+(******************************************************************************)
+                                 (* Types *)
+
+(* 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 *)
+  | End_of_acc
+
+(* List of heterogeneous values. *)
+(* Used to accumulate scanf callback arguments. *)
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+(* Existential Black Boxes. *)
+(* Used to abstract some existential type parameters. *)
+
+(* GADT type associating a padding and an fmtty. *)
+(* See the type_padding function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb = Padding_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padding_fmtty_ebb
+
+(* GADT type associating a padding, a precision and an fmtty. *)
+(* See the type_padprec function. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb = Padprec_fmtty_EBB :
+     ('x, 'y) padding * ('y, 'z) precision * ('z, 'b, 'c, 'd, 'e, 'f) fmtty ->
+     ('x, 'b, 'c, 'd, 'e, 'f) padprec_fmtty_ebb
+
+(* GADT type associating a padding and an fmt. *)
+(* 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 ->
+     ('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 ->
+     ('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 ->
+     ('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 ->
+     ('b, 'c, 'e, 'f) fmt_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 ->
+     ('a, 'b, 'c, 'd, 'e, 'f) fmtty_fmt_ebb
+
+(* Abstract all fmtty type parameters. *)
+(* Used to compare format types. *)
+type fmtty_ebb = Fmtty_EBB : ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> fmtty_ebb
+
+(* Abstract all padding type parameters. *)
+(* Used to compare paddings. *)
+type padding_ebb = Padding_EBB : ('a, 'b) padding -> padding_ebb
+
+(* Abstract all precision type parameters. *)
+(* Used to compare precisions. *)
+type precision_ebb = Precision_EBB : ('a, 'b) precision -> precision_ebb
+
+(******************************************************************************)
+                               (* Constants *)
+
+(* Default precision for float printing. *)
+let default_float_precision = 6
+
+(******************************************************************************)
+                               (* Externals *)
+
+external format_float: string -> float -> string
+  = "caml_format_float"
+external format_int: string -> int -> string
+  = "caml_format_int"
+external format_int32: string -> int32 -> string
+  = "caml_int32_format"
+external format_nativeint: string -> nativeint -> string
+  = "caml_nativeint_format"
+external format_int64: string -> int64 -> string
+  = "caml_int64_format"
+
+(******************************************************************************)
+                     (* Tools to pretty-print formats *)
+
+(* Type of extensible character buffers. *)
+type buffer = {
+  mutable ind : int;
+  mutable str : string;
+}
+
+(* Create a fresh buffer. *)
+let buffer_create init_size = { ind = 0; str = String.create init_size }
+
+(* Check size of the buffer and grow it if needed. *)
+let buffer_check_size buf overhead =
+  let len = String.length buf.str in
+  let min_len = buf.ind + overhead in
+  if min_len > len then (
+    let new_len = max (len * 2) min_len in
+    let new_str = String.create new_len in
+    String.blit buf.str 0 new_str 0 len;
+    buf.str <- new_str;
+  )
+
+(* Add the character `c' to the buffer `buf'. *)
+let buffer_add_char buf c =
+  buffer_check_size buf 1;
+  buf.str.[buf.ind] <- c;
+  buf.ind <- buf.ind + 1
+
+(* Add the string `s' to the buffer `buf'. *)
+let buffer_add_string buf s =
+  let str_len = String.length s in
+  buffer_check_size buf str_len;
+  String.blit s 0 buf.str buf.ind str_len;
+  buf.ind <- buf.ind + str_len
+
+(* Get the content of the buffer. *)
+let buffer_contents buf =
+  let str = String.create buf.ind in
+  String.blit buf.str 0 str 0 buf.ind;
+  str
+
+(***)
+
+(* Convert an integer conversion to char. *)
+let char_of_iconv iconv = match iconv with
+  | Int_d | Int_pd | Int_sd -> 'd' | Int_i | Int_pi | Int_si -> 'i'
+  | Int_x | Int_Cx -> 'x' | Int_X | Int_CX -> 'X' | Int_o | Int_Co -> 'o'
+  | Int_u -> 'u'
+
+(* Convert a float conversion to char. *)
+let char_of_fconv fconv = match fconv with
+  | Float_f | Float_pf | Float_sf -> 'f' | Float_e | Float_pe | Float_se -> 'e'
+  | Float_E | Float_pE | Float_sE -> 'E' | Float_g | Float_pg | Float_sg -> 'g'
+  | Float_G | Float_pG | Float_sG -> 'G' | Float_F -> 'F'
+
+(* Convert a scanning counter to char. *)
+let char_of_counter counter = match counter with
+  | Line_counter  -> 'l'
+  | Char_counter  -> 'n'
+  | Token_counter -> 'N'
+
+(***)
+
+(* Print a char_set in a buffer with the OCaml format lexical convention. *)
+let bprint_char_set buf char_set =
+  let rec print_start set =
+    if is_in_char_set set ']' &&
+      (not (is_in_char_set set '\\') || not (is_in_char_set set '^'))
+    then buffer_add_char buf ']';
+    print_out set 1;
+    if is_in_char_set set '-' &&
+      (not (is_in_char_set set ',') || not (is_in_char_set set '.'))
+    then buffer_add_char buf '-';
+  and print_out set i =
+    if i < 256 then
+      if is_in_char_set set (char_of_int i) then print_first set i
+      else print_out set (i + 1)
+  and print_first set i =
+    match char_of_int i with
+    | '\255' -> print_char buf 255;
+    | ']' | '-' -> print_out set (i + 1);
+    | _ -> print_second set (i + 1);
+  and print_second set i =
+    if is_in_char_set set (char_of_int i) then
+      match char_of_int i with
+      | '\255' ->
+        print_char buf 254;
+        print_char buf 255;
+      | ']' | '-' when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_out set (i + 1);
+      | _ when not (is_in_char_set set (char_of_int (i + 1))) ->
+        print_char buf (i - 1);
+        print_char buf i;
+        print_out set (i + 2);
+      | _ ->
+        print_in set (i - 1) (i + 2);
+    else (
+      print_char buf (i - 1);
+      print_out set (i + 1);
+    )
+  and print_in set i j =
+    if j = 256 || not (is_in_char_set set (char_of_int j)) then (
+      print_char buf i;
+      print_char buf (int_of_char '-');
+      print_char buf (j - 1);
+      if j < 256 then print_out set (j + 1);
+    ) else
+      print_in set i (j + 1);
+  and print_char buf i = match char_of_int i with
+    | '%' -> buffer_add_char buf '%'; buffer_add_char buf '%';
+    | '@' -> buffer_add_char buf '%'; buffer_add_char buf '@';
+    | c   -> buffer_add_char buf c;
+  in
+  buffer_add_char buf '[';
+  print_start (
+    if is_in_char_set char_set '\000'
+    then ( buffer_add_char buf '^'; rev_char_set char_set )
+    else char_set
+  );
+  buffer_add_char buf ']'
+
+(***)
+
+(* Print a padty in a buffer with the format-like syntax. *)
+let bprint_padty buf padty = match padty with
+  | Left  -> buffer_add_char buf '-'
+  | Right -> ()
+  | Zeros -> buffer_add_char buf '0'
+
+(* Print the '_' of an ignored flag if needed. *)
+let bprint_ignored_flag buf ign_flag =
+  if ign_flag then buffer_add_char buf '_'
+
+(***)
+
+let bprint_pad_opt buf pad_opt = match pad_opt with
+  | None -> ()
+  | Some width -> buffer_add_string buf (string_of_int width)
+
+(***)
+
+(* Print padding in a buffer with the format-like syntax. *)
+let bprint_padding : type a b . buffer -> (a, b) padding -> unit =
+fun buf pad -> match pad with
+  | No_padding -> ()
+  | Lit_padding (padty, n) ->
+    bprint_padty buf padty;
+    buffer_add_string buf (string_of_int n);
+  | Arg_padding padty ->
+    bprint_padty buf padty;
+    buffer_add_char buf '*'
+
+(* Print precision in a buffer with the format-like syntax. *)
+let bprint_precision : type a b . buffer -> (a, b) precision -> unit =
+  fun buf prec -> match prec with
+  | No_precision -> ()
+  | Lit_precision n ->
+    buffer_add_char buf '.';
+    buffer_add_string buf (string_of_int n);
+  | Arg_precision ->
+    buffer_add_string buf ".*"
+
+(***)
+
+(* Print the optionnal '+', ' ' or '#' associated to an int conversion. *)
+let bprint_iconv_flag buf iconv = match iconv with
+  | Int_pd | Int_pi -> buffer_add_char buf '+'
+  | Int_sd | Int_si -> buffer_add_char buf ' '
+  | Int_Cx | Int_CX | Int_Co -> buffer_add_char buf '#'
+  | Int_d | Int_i | Int_x | Int_X | Int_o | Int_u -> ()
+
+(* Print an complete int format in a buffer (ex: "%3.*d"). *)
+let bprint_int_fmt buf ign_flag iconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(* Print a complete int32, nativeint or int64 format in a buffer. *)
+let bprint_altint_fmt buf ign_flag iconv pad prec c =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_iconv_flag buf iconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf c;
+  buffer_add_char buf (char_of_iconv iconv)
+
+(***)
+
+(* Print the optionnal '+' associated to a float conversion. *)
+let bprint_fconv_flag buf fconv = match fconv with
+  | Float_pf | Float_pe | Float_pE | Float_pg | Float_pG ->
+    buffer_add_char buf '+'
+  | Float_sf | Float_se | Float_sE | Float_sg | Float_sG ->
+    buffer_add_char buf ' '
+  | Float_f | Float_e | Float_E | Float_g | Float_G | Float_F ->
+    ()
+
+(* Print a complete float format in a buffer (ex: "%+*.3f"). *)
+let bprint_float_fmt buf ign_flag fconv pad prec =
+  buffer_add_char buf '%';
+  bprint_ignored_flag buf ign_flag;
+  bprint_fconv_flag buf fconv;
+  bprint_padding buf pad;
+  bprint_precision buf prec;
+  buffer_add_char buf (char_of_fconv fconv)
+
+(* Compute the literal string representation of a formatting. *)
+(* Also used by Printf and Scanf where formatting is not interpreted. *)
+let string_of_formatting formatting = match formatting with
+  | Open_box (str, _, _) -> str
+  | Close_box            -> "@]"
+  | Open_tag (str, _)    -> str
+  | Close_tag            -> "@}"
+  | Break (str, _, _)    -> str
+  | FFlush               -> "@?"
+  | Force_newline        -> "@\n"
+  | Flush_newline        -> "@."
+  | Magic_size (str, _)  -> str
+  | Escaped_at           -> "@@"
+  | Escaped_percent      -> "@%"
+  | Scan_indic c ->
+    let str = String.create 2 in
+    str.[0] <- '@'; str.[1] <- c;
+    str
+
+(***)
+
+(* Print a literal char in a buffer, escape '%' by "%%". *)
+let bprint_char_literal buf chr = match chr with
+  | '%' -> buffer_add_string buf "%%"
+  | _ -> buffer_add_char buf chr
+
+(* Print a literal string in a buffer, escape all '%' by "%%". *)
+let bprint_string_literal buf str =
+  for i = 0 to String.length str - 1 do
+    bprint_char_literal buf str.[i]
+  done
+
+(******************************************************************************)
+                          (* Format pretty-printing *)
+
+(* Print a complete format type (an fmtty) in a buffer. *)
+let rec bprint_fmtty : type a b c d e f .
+    buffer -> (a, b, c, d, e, f) fmtty -> unit =
+fun buf fmtty -> match fmtty with
+  | Char_ty rest      -> buffer_add_string buf "%c";  bprint_fmtty buf rest;
+  | String_ty rest    -> buffer_add_string buf "%s";  bprint_fmtty buf rest;
+  | Int_ty rest       -> buffer_add_string buf "%i";  bprint_fmtty buf rest;
+  | Int32_ty rest     -> buffer_add_string buf "%li"; bprint_fmtty buf rest;
+  | Nativeint_ty rest -> buffer_add_string buf "%ni"; bprint_fmtty buf rest;
+  | Int64_ty rest     -> buffer_add_string buf "%Li"; bprint_fmtty buf rest;
+  | Float_ty rest     -> buffer_add_string buf "%f";  bprint_fmtty buf rest;
+  | Bool_ty rest      -> buffer_add_string buf "%B";  bprint_fmtty buf rest;
+  | Alpha_ty rest     -> buffer_add_string buf "%a";  bprint_fmtty buf rest;
+  | Theta_ty rest     -> buffer_add_string buf "%t";  bprint_fmtty buf rest;
+  | Reader_ty rest    -> buffer_add_string buf "%r";  bprint_fmtty buf rest;
+
+  | Ignored_reader_ty rest ->
+    buffer_add_string buf "%_r";
+    bprint_fmtty buf rest;
+
+  | Format_arg_ty (sub_fmtty, rest) ->
+    buffer_add_string buf "%{"; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%}"; bprint_fmtty buf rest;
+  | Format_subst_ty (_, sub_fmtty, rest) ->
+    buffer_add_string buf "%("; bprint_fmtty buf sub_fmtty;
+    buffer_add_string buf "%)"; bprint_fmtty buf rest;
+
+  | End_of_fmtty -> ()
+
+(***)
+
+(* Print a complete format in a buffer. *)
+let bprint_fmt buf fmt =
+  let rec fmtiter : type a b c d e f .
+      (a, b, c, d, e, f) fmt -> bool -> unit =
+  fun fmt ign_flag -> match fmt with
+    | String (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 's';
+      fmtiter rest false;
+    | Caml_string (pad, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_padding buf pad; buffer_add_char buf 'S';
+      fmtiter rest false;
+
+    | Int (iconv, pad, prec, rest) ->
+      bprint_int_fmt buf ign_flag iconv pad prec;
+      fmtiter rest false;
+    | Int32 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'l';
+      fmtiter rest false;
+    | Nativeint (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'n';
+      fmtiter rest false;
+    | Int64 (iconv, pad, prec, rest) ->
+      bprint_altint_fmt buf ign_flag iconv pad prec 'L';
+      fmtiter rest false;
+    | Float (fconv, pad, prec, rest) ->
+      bprint_float_fmt buf ign_flag fconv pad prec;
+      fmtiter rest false;
+
+    | Char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'c'; fmtiter rest false;
+    | Caml_char rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'C'; fmtiter rest false;
+    | Bool rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'B'; fmtiter rest false;
+    | Alpha rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'a'; fmtiter rest false;
+    | Theta rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 't'; fmtiter rest false;
+    | Reader rest ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf 'r'; fmtiter rest false;
+    | Flush rest ->
+      buffer_add_string buf "%!";
+      fmtiter rest ign_flag;
+
+    | String_literal (str, rest) ->
+      bprint_string_literal buf str;
+      fmtiter rest ign_flag;
+    | Char_literal (chr, rest) ->
+      bprint_char_literal buf chr;
+      fmtiter rest ign_flag;
+
+    | Format_arg (pad_opt, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '{';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf '}';
+      fmtiter rest false;
+    | Format_subst (pad_opt, _, fmtty, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf pad_opt; buffer_add_char buf '(';
+      bprint_fmtty buf fmtty; buffer_add_char buf '%'; buffer_add_char buf ')';
+      fmtiter rest false;
+
+    | Scan_char_set (width_opt, char_set, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      bprint_pad_opt buf width_opt; bprint_char_set buf char_set;
+      fmtiter rest false;
+    | Scan_get_counter (counter, rest) ->
+      buffer_add_char buf '%'; bprint_ignored_flag buf ign_flag;
+      buffer_add_char buf (char_of_counter counter);
+      fmtiter rest false;
+    | Ignored_param (ign, rest) ->
+      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);
+      fmtiter rest ign_flag;
+
+    | End_of_format -> ()
+
+  in fmtiter fmt false
+
+(***)
+
+(* Convert a format to string. *)
+let string_of_fmt fmt =
+  let buf = buffer_create 16 in
+  bprint_fmt buf fmt;
+  buffer_contents buf
+
+(******************************************************************************)
+                          (* Type extraction *)
+
+(* 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 =
+fun fmtty -> match fmtty with
+  | String (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+  | Caml_string (pad, rest) ->
+    fmtty_of_padding_fmtty pad (String_ty (fmtty_of_fmt rest))
+
+  | Int (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int32 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int32_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Nativeint (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Nativeint_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Int64 (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Int64_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+  | Float (_, pad, prec, rest) ->
+    let ty_rest = fmtty_of_fmt rest in
+    let prec_ty = fmtty_of_precision_fmtty prec (Float_ty ty_rest) in
+    fmtty_of_padding_fmtty pad prec_ty
+
+  | Char rest                  -> Char_ty (fmtty_of_fmt rest)
+  | Caml_char rest             -> Char_ty (fmtty_of_fmt rest)
+  | Bool rest                  -> Bool_ty (fmtty_of_fmt rest)
+  | Alpha rest                 -> Alpha_ty (fmtty_of_fmt rest)
+  | Theta rest                 -> Theta_ty (fmtty_of_fmt rest)
+  | Reader rest                -> Reader_ty (fmtty_of_fmt rest)
+
+  | Format_arg (_, ty, rest) ->
+    Format_arg_ty (ty, fmtty_of_fmt rest)
+  | Format_subst (_, rnu, ty, rest) ->
+    Format_subst_ty (rnu, ty, fmtty_of_fmt rest)
+
+  | Flush rest                 -> fmtty_of_fmt rest
+  | String_literal (_, rest)   -> fmtty_of_fmt rest
+  | Char_literal (_, rest)     -> fmtty_of_fmt rest
+
+  | 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
+
+  | End_of_format              -> End_of_fmtty
+
+(* Extract the fmtty of an ignored parameter followed by the rest of
+   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 ->
+    (a, b, c, d, e, f) fmtty =
+fun ign fmt -> match ign with
+  | Ignored_char                    -> fmtty_of_fmt fmt
+  | Ignored_caml_char               -> fmtty_of_fmt fmt
+  | Ignored_string _                -> fmtty_of_fmt fmt
+  | Ignored_caml_string _           -> fmtty_of_fmt fmt
+  | Ignored_int (_, _)              -> fmtty_of_fmt fmt
+  | Ignored_int32 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_nativeint (_, _)        -> fmtty_of_fmt fmt
+  | Ignored_int64 (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_float (_, _)            -> fmtty_of_fmt fmt
+  | Ignored_bool                    -> fmtty_of_fmt fmt
+  | Ignored_format_arg _            -> fmtty_of_fmt fmt
+  | Ignored_format_subst (_, fmtty) -> concat_fmtty fmtty (fmtty_of_fmt fmt)
+  | Ignored_reader                  -> Ignored_reader_ty (fmtty_of_fmt fmt)
+  | Ignored_scan_char_set _         -> fmtty_of_fmt fmt
+
+(* Add an Int_ty node if padding is taken as an extra argument (ex: "%*s"). *)
+and fmtty_of_padding_fmtty : type x a b c d e f .
+    (x, a) padding -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun pad fmtty -> match pad with
+    | No_padding    -> fmtty
+    | Lit_padding _ -> fmtty
+    | Arg_padding _ -> Int_ty fmtty
+
+(* Add an Int_ty node if precision is taken as an extra argument (ex: "%.*f").*)
+and fmtty_of_precision_fmtty : type x a b c d e f .
+    (x, a) precision -> (a, b, c, d, e, f) fmtty -> (x, b, c, d, e, f) fmtty =
+  fun prec fmtty -> match prec with
+    | No_precision    -> fmtty
+    | Lit_precision _ -> fmtty
+    | Arg_precision   -> Int_ty fmtty
+
+(******************************************************************************)
+                            (* Format typing *)
+
+(* Exception raised by type_XXX when a typing error occurs. *)
+exception Type_mismatch
+
+(* Type a padding. *)
+(* Take an Int_ty from the fmtty if the integer should be kept as argument. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padding : type a b c d e f x y .
+    (x, y) padding -> (a, b, c, d, e, f) fmtty ->
+      (a, b, c, d, e, f) padding_fmtty_ebb =
+fun pad fmtty -> match pad, fmtty with
+  | No_padding, _ -> Padding_fmtty_EBB (No_padding, fmtty)
+  | Lit_padding (padty, w), _ -> Padding_fmtty_EBB (Lit_padding (padty,w),fmtty)
+  | Arg_padding padty, Int_ty rest -> Padding_fmtty_EBB (Arg_padding padty,rest)
+  | _ -> raise Type_mismatch
+
+(* Convert a (upadding, uprecision) to a (padding, precision). *)
+(* Take one or two Int_ty from the fmtty if needed. *)
+(* Raise Type_mismatch in case of type mismatch. *)
+let type_padprec : type a b c d e f x y z .
+  (x, y) padding -> (y, z) precision -> (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) padprec_fmtty_ebb =
+fun pad prec fmtty -> match prec, type_padding pad fmtty with
+  | No_precision, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, No_precision, rest)
+  | Lit_precision p, Padding_fmtty_EBB (pad, rest) ->
+    Padprec_fmtty_EBB (pad, Lit_precision p, rest)
+  | Arg_precision, Padding_fmtty_EBB (pad, Int_ty rest) ->
+    Padprec_fmtty_EBB (pad, Arg_precision, rest)
+  | _, Padding_fmtty_EBB (_, _) -> raise Type_mismatch
+
+(* Type a format according to an fmtty. *)
+(* 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 x t u v a b c d e f .
+    (x, b, c, t, u, v) CamlinternalFormatBasics.fmt ->
+    (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) CamlinternalFormatBasics.fmt =
+fun fmt fmtty -> match fmt, fmtty with
+  | Char fmt_rest, Char_ty fmtty_rest ->
+    Char (type_format fmt_rest fmtty_rest)
+  | Caml_char fmt_rest, Char_ty fmtty_rest ->
+    Caml_char (type_format fmt_rest fmtty_rest)
+  | 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)
+    | 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)
+    | 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)
+    | 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)
+    | 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)
+    | 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)
+    | 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)
+    | 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)
+
+  | 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)
+  | Format_subst (pad_opt, _, sub_fmtty, fmt_rest),
+    Format_subst_ty (rnu', sub_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub_fmtty <> Fmtty_EBB sub_fmtty' then raise Type_mismatch;
+    Format_subst (pad_opt, rnu', sub_fmtty', type_format fmt_rest fmtty_rest)
+
+  (* Printf and Format specific constructors: *)
+  | Alpha fmt_rest, Alpha_ty fmtty_rest ->
+    Alpha (type_format fmt_rest fmtty_rest)
+  | Theta fmt_rest, Theta_ty fmtty_rest ->
+    Theta (type_format fmt_rest fmtty_rest)
+
+  (* Format specific constructors: *)
+  | Formatting (formatting, fmt_rest), _ ->
+    Formatting (formatting, type_format fmt_rest fmtty)
+
+  (* Scanf specific constructors: *)
+  | Reader fmt_rest, Reader_ty fmtty_rest ->
+    Reader (type_format fmt_rest fmtty_rest)
+  | 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)
+  | 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
+
+  | End_of_format, End_of_fmtty -> End_of_format
+
+  | _ -> raise Type_mismatch
+
+(* Type and Ignored_param node according to an fmtty. *)
+and type_ignored_param : type p q x t u v a b c d e f .
+    (x, b, c, t, q, p) ignored ->
+    (p, b, c, q, u, v) CamlinternalFormatBasics.fmt ->
+    (a, b, c, d, e, f) fmtty ->
+    (a, b, c, d, e, f) CamlinternalFormatBasics.fmt =
+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_format_arg (pad_opt, sub_fmtty) ->
+    let ignored = Ignored_format_arg (pad_opt, sub_fmtty) in
+    Ignored_param (ignored, type_format fmt fmtty)
+  | Ignored_format_subst (pad_opt, sub_fmtty) ->
+    let Fmtty_fmt_EBB (sub_fmtty', fmt') =
+      type_ignored_format_substitution sub_fmtty fmt fmtty in
+    Ignored_param (Ignored_format_subst (pad_opt, sub_fmtty'), fmt')
+  | Ignored_reader ->
+    match fmtty with
+    | Ignored_reader_ty fmtty_rest ->
+      Ignored_param (Ignored_reader, type_format fmt fmtty_rest)
+    | _ -> raise Type_mismatch
+
+(* Typing of the complex case: "%_(...%)". *)
+and type_ignored_format_substitution : type w z p s t u a b c d e f .
+    (w, b, c, z, s, p) fmtty ->
+    (p, b, c, s, t, u) CamlinternalFormatBasics.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 ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Char_ty sub_fmtty_rest', fmt')
+  | String_ty sub_fmtty_rest, String_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (String_ty sub_fmtty_rest', fmt')
+  | Int_ty sub_fmtty_rest, Int_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int_ty sub_fmtty_rest', fmt')
+  | Int32_ty sub_fmtty_rest, Int32_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int32_ty sub_fmtty_rest', fmt')
+  | Nativeint_ty sub_fmtty_rest, Nativeint_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Nativeint_ty sub_fmtty_rest', fmt')
+  | Int64_ty sub_fmtty_rest, Int64_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Int64_ty sub_fmtty_rest', fmt')
+  | Float_ty sub_fmtty_rest, Float_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Float_ty sub_fmtty_rest', fmt')
+  | Bool_ty sub_fmtty_rest, Bool_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Bool_ty sub_fmtty_rest', fmt')
+  | Alpha_ty sub_fmtty_rest, Alpha_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Alpha_ty sub_fmtty_rest', fmt')
+  | Theta_ty sub_fmtty_rest, Theta_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Theta_ty sub_fmtty_rest', fmt')
+  | Reader_ty sub_fmtty_rest, Reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Reader_ty sub_fmtty_rest', fmt')
+  | Ignored_reader_ty sub_fmtty_rest, Ignored_reader_ty fmtty_rest ->
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Ignored_reader_ty sub_fmtty_rest', fmt')
+
+  | Format_arg_ty (sub2_fmtty, sub_fmtty_rest),
+    Format_arg_ty (sub2_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub2_fmtty <> Fmtty_EBB sub2_fmtty' then raise Type_mismatch;
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Format_arg_ty (sub2_fmtty', sub_fmtty_rest'), fmt')
+  | Format_subst_ty (_, sub2_fmtty, sub_fmtty_rest),
+    Format_subst_ty (rnu', sub2_fmtty', fmtty_rest) ->
+    if Fmtty_EBB sub2_fmtty <> Fmtty_EBB sub2_fmtty' then raise Type_mismatch;
+    let Fmtty_fmt_EBB (sub_fmtty_rest', fmt') =
+      type_ignored_format_substitution sub_fmtty_rest fmt fmtty_rest in
+    Fmtty_fmt_EBB (Format_subst_ty (rnu', sub2_fmtty', sub_fmtty_rest'),fmt')
+
+  | End_of_fmtty, fmtty ->
+    Fmtty_fmt_EBB (End_of_fmtty, type_format fmt fmtty)
+
+  | _ -> raise Type_mismatch
+
+(******************************************************************************)
+                             (* Printing tools *)
+
+(* Add padding spaces arround a string. *)
+let fix_padding padty width str =
+  let len = String.length str in
+  if width <= len then str else
+    let res = String.make width (if padty = Zeros then '0' else ' ') in
+    begin match padty with
+    | Left  -> String.blit str 0 res 0 len
+    | Right -> String.blit str 0 res (width - len) len
+    | Zeros when len > 0 && (str.[0] = '+' || str.[0] = '-') ->
+      res.[0] <- str.[0];
+      String.blit str 1 res (width - len + 1) (len - 1)
+    | Zeros when len > 1 && str.[0] = '0' && (str.[1] = 'x' || str.[1] = 'X') ->
+      res.[1] <- str.[1];
+      String.blit str 2 res (width - len + 2) (len - 2)
+    | Zeros ->
+      String.blit str 0 res (width - len) len
+    end;
+    res
+
+(* Add '0' padding to int, int32, nativeint or int64 string representation. *)
+let fix_int_precision prec str =
+  let len = String.length str in
+  if prec <= len then str else
+    let res = String.make prec '0' in
+    begin match str.[0] with
+    | ('+' | '-' | ' ') as c ->
+      res.[0] <- c;
+      String.blit str 1 res (prec - len + 1) (len - 1);
+    | '0' when len > 1 && (str.[1] = 'x' || str.[1] = 'X') ->
+      res.[1] <- str.[1];
+      String.blit str 2 res (prec - len + 2) (len - 2);
+    | '0' .. '9' ->
+      String.blit str 0 res (prec - len) len;
+    | _ ->
+      assert false
+    end;
+    res
+
+(* Escape a string according to the OCaml lexing convention. *)
+let string_to_caml_string str =
+  let esc = String.escaped str in
+  let len = String.length esc in
+  let res = String.create (len + 2) in
+  res.[0] <- '"'; String.blit esc 0 res 1 len; res.[len + 1] <- '"';
+  res
+
+(* Generate the format_int first argument from an int_conv. *)
+let format_of_iconv iconv = match iconv with
+  | Int_d -> "%d" | Int_pd -> "%+d" | Int_sd -> "% d"
+  | Int_i -> "%i" | Int_pi -> "%+i" | Int_si -> "% i"
+  | Int_x -> "%x" | Int_Cx -> "%#x"
+  | Int_X -> "%X" | Int_CX -> "%#X"
+  | Int_o -> "%o" | Int_Co -> "%#o"
+  | Int_u -> "%u"
+
+(* Generate the format_int32, format_nativeint and format_int64 first argument
+   from an int_conv. *)
+let format_of_aconv iconv c =
+  let fix i fmt = fmt.[i] <- c; fmt in
+  match iconv with
+  | Int_d -> fix 1 "% d" | Int_pd -> fix 2 "%+ d" | Int_sd -> fix 2 "%  d"
+  | Int_i -> fix 1 "% i" | Int_pi -> fix 2 "%+ i" | Int_si -> fix 2 "%  i"
+  | Int_x -> fix 1 "% x" | Int_Cx -> fix 2 "%# x"
+  | Int_X -> fix 1 "% X" | Int_CX -> fix 2 "%# X"
+  | Int_o -> fix 1 "% o" | Int_Co -> fix 2 "%# o"
+  | Int_u -> fix 1 "% u"
+
+(* Generate the format_float first argument form a float_conv. *)
+let format_of_fconv fconv prec =
+  let symb = if fconv = Float_F then 'g' else char_of_fconv fconv in
+  let buf = buffer_create 16 in
+  buffer_add_char buf '%';
+  bprint_fconv_flag buf fconv;
+  buffer_add_char buf '.';
+  buffer_add_string buf (string_of_int prec);
+  buffer_add_char buf symb;
+  buffer_contents buf
+
+(* Convert an integer to a string according to a conversion. *)
+let convert_int iconv n = format_int (format_of_iconv iconv) n
+let convert_int32 iconv n = format_int32 (format_of_aconv iconv 'l') n
+let convert_nativeint iconv n = format_nativeint (format_of_aconv iconv 'n') n
+let convert_int64 iconv n = format_int64 (format_of_aconv iconv 'L') n
+
+(* Convert a float to string. *)
+(* Fix special case of "OCaml float format". *)
+let convert_float fconv prec x =
+  let str = format_float (format_of_fconv fconv prec) x in
+  if fconv <> Float_F then str else
+    let len = String.length str in
+    let rec is_valid i =
+      if i = len then false else
+        match str.[i] with
+        | '.' | 'e' | 'E' -> true
+        | _ -> is_valid (i + 1)
+    in
+    match classify_float x with
+    | FP_normal | FP_subnormal | FP_zero when not (is_valid 0) -> str ^ "."
+    | FP_infinite | FP_nan | FP_normal | FP_subnormal | FP_zero -> str
+
+(* Convert a char to a string according to the OCaml lexical convention. *)
+let format_caml_char c =
+  let esc = Char.escaped c in
+  let len = String.length esc in
+  let res = String.create (len + 2) in
+  res.[0] <- '\''; String.blit esc 0 res 1 len; res.[len+1] <- '\'';
+  res
+
+(* Convert a format type to string *)
+let string_of_fmtty fmtty =
+  let buf = buffer_create 16 in
+  bprint_fmtty buf fmtty;
+  buffer_contents buf
+
+(******************************************************************************)
+                        (* Generic printing function *)
+
+(* Make a generic printing function. *)
+(* Used to generate Printf and Format printing functions. *)
+(* Parameters:
+     k: a continuation finally applied to the output stream and the accumulator.
+     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 =
+fun k o acc fmt -> match fmt with
+  | Char rest ->
+    fun c ->
+      let new_acc = Acc_char (acc, c) in
+      make_printf k o new_acc rest
+  | Caml_char rest ->
+    fun c ->
+      let new_acc = Acc_string (acc, format_caml_char c) in
+      make_printf k o new_acc rest
+  | String (pad, rest) ->
+    make_string_padding k o acc rest pad (fun str -> str)
+  | Caml_string (pad, rest) ->
+    make_string_padding k o acc rest pad string_to_caml_string
+  | Int (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int iconv
+  | Int32 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int32 iconv
+  | Nativeint (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_nativeint iconv
+  | Int64 (iconv, pad, prec, rest) ->
+    make_int_padding_precision k o acc rest pad prec convert_int64 iconv
+  | Float (fconv, pad, prec, rest) ->
+    make_float_padding_precision k o acc rest pad prec fconv
+  | Bool rest ->
+    fun b -> make_printf k o (Acc_string (acc, string_of_bool b)) rest
+  | Alpha rest ->
+    fun f x -> make_printf k o (Acc_delay (acc, fun o -> f o x)) rest
+  | Theta rest ->
+    fun f -> make_printf k o (Acc_delay (acc, f)) rest
+  | Reader _ ->
+    (* This case is impossible, by typing of formats. *)
+    (* Indeed, since printf and co. take a format4 as argument, the 'd and 'e
+       type parameters of fmt are obviously equals. The Reader is the
+       only constructor which touch 'd and 'e type parameters of the format
+       type, it adds an (->) to the 'd parameters. Consequently, a format4
+       cannot contain a Reader node, except in the sub-format associated to
+       an %{...%}. It's not a problem because make_printf do not call
+       itself recursively on the sub-format associated to %{...%}. *)
+    assert false
+  | Flush rest ->
+    make_printf k o (Acc_flush acc) rest
+
+  | String_literal (str, rest) ->
+    make_printf k o (Acc_string (acc, str)) rest
+  | Char_literal (chr, rest) ->
+    make_printf k o (Acc_char (acc, chr)) rest
+
+  | Format_arg (_, _, rest) ->
+    (* Use the following code to obtain the old (curious?) semantics. *)
+    (*fun _ -> make_printf k o (Acc_string (acc, string_of_fmtty fmtty)) rest*)
+    fun (_, str) -> make_printf k o (Acc_string (acc, str)) rest
+  | Format_subst (_, _, fmtty, rest) ->
+    (* Call to type_format can't failed (raise Type_mismatch). *)
+    fun (fmt, _) -> make_printf k o acc
+      CamlinternalFormatBasics.(concat_fmt (type_format fmt fmtty) rest)
+
+  | Scan_char_set (_, _, rest) ->
+    let new_acc = Acc_invalid_arg (acc, "Printf: bad conversion %[") in
+    fun _ -> make_printf k o new_acc rest
+  | Scan_get_counter (_, rest) ->
+    (* This case should be refused for Printf. *)
+    (* Accepted for backward compatibility. *)
+    (* Interpret %l, %n and %L as %d. *)
+    fun n ->
+      let new_acc = Acc_string (acc, format_int "%d" n) in
+      make_printf k o new_acc rest
+  | Ignored_param (ign, rest) ->
+    make_ignored_param k o acc ign rest
+
+  | Formatting (fmting, rest) ->
+    make_printf k o (Acc_formatting (acc, fmting)) rest
+
+  | 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 .
+    (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 =
+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
+  | Ignored_string _                -> make_invalid_arg k o acc fmt
+  | Ignored_caml_string _           -> make_invalid_arg k o acc fmt
+  | Ignored_int (_, _)              -> make_invalid_arg k o acc fmt
+  | Ignored_int32 (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_nativeint (_, _)        -> make_invalid_arg k o acc fmt
+  | Ignored_int64 (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_float (_, _)            -> make_invalid_arg k o acc fmt
+  | Ignored_bool                    -> make_invalid_arg k o acc fmt
+  | Ignored_format_arg _            -> make_invalid_arg k o acc fmt
+  | Ignored_format_subst (_, fmtty) -> make_from_fmtty k o acc fmtty fmt
+  | Ignored_reader                  -> assert false
+  | Ignored_scan_char_set _         -> make_invalid_arg k o acc fmt
+
+(* Special case of printf "%_(". *)
+and make_from_fmtty : type x y a b c 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 =
+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
+  | Int_ty rest             -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Int32_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Nativeint_ty rest       -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Int64_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Float_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Bool_ty rest            -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Alpha_ty rest           -> fun _ _ -> make_from_fmtty k o acc rest fmt
+  | Theta_ty rest           -> fun _ -> make_from_fmtty k o acc rest fmt
+  | Reader_ty _             -> assert false
+  | Ignored_reader_ty _     -> assert false
+  | Format_arg_ty (_, rest) -> fun _ -> make_from_fmtty k o acc rest fmt
+  | End_of_fmtty            -> make_invalid_arg k o acc fmt
+  | Format_subst_ty (_, ty, rest) ->
+    fun _ -> make_from_fmtty k o acc (concat_fmtty ty rest) fmt
+
+(* 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 .
+    (b -> (b, c) acc -> f) -> b -> (b, c) acc ->
+    (a, b, c, c, c, f) CamlinternalFormatBasics.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 ->
+    (x, z -> a) padding -> (z -> string) -> x =
+  fun k o acc fmt pad trans -> match pad with
+  | No_padding ->
+    fun x ->
+      let new_acc = Acc_string (acc, trans x) in
+      make_printf k o new_acc fmt
+  | Lit_padding (padty, width) ->
+    fun x ->
+      let new_acc = Acc_string (acc, fix_padding padty width (trans x)) in
+      make_printf k o new_acc fmt
+  | Arg_padding padty ->
+    fun w x ->
+      let new_acc = Acc_string (acc, fix_padding padty w (trans x)) in
+      make_printf k o new_acc fmt
+
+(* 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 ->
+    (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
+  | No_padding, No_precision ->
+    fun x ->
+      let str = trans iconv x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = fix_int_precision p (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = fix_padding padty w (trans iconv x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (fix_int_precision p (trans iconv x)) in
+      make_printf k o (Acc_string (acc, str)) fmt
+
+(* 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 ->
+    (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 ->
+    fun x ->
+      let str = convert_float fconv default_float_precision x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Lit_precision p ->
+    fun x ->
+      let str = convert_float fconv p x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | No_padding, Arg_precision ->
+    fun p x ->
+      let str = convert_float fconv p x in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), No_precision ->
+    fun x ->
+      let str = convert_float fconv default_float_precision x in
+      let str' = fix_padding padty w str in
+      make_printf k o (Acc_string (acc, str')) fmt
+  | Lit_padding (padty, w), Lit_precision p ->
+    fun x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Lit_padding (padty, w), Arg_precision ->
+    fun p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, No_precision ->
+    fun w x ->
+      let str = convert_float fconv default_float_precision x in
+      let str' = fix_padding padty w str in
+      make_printf k o (Acc_string (acc, str')) fmt
+  | Arg_padding padty, Lit_precision p ->
+    fun w x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+  | Arg_padding padty, Arg_precision ->
+    fun w p x ->
+      let str = fix_padding padty w (convert_float fconv p x) in
+      make_printf k o (Acc_string (acc, str)) fmt
+
+(******************************************************************************)
+                          (* Continuations for make_printf *)
+
+(* Recursively output an "accumulator" containing a reversed list of
+   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
+    output_acc o p;
+    output_string o s;
+  | 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
+  | Acc_flush p              -> output_acc o p; flush o
+  | Acc_invalid_arg (p, msg) -> output_acc o p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   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
+    bufput_acc b p;
+    Buffer.add_string b s;
+  | 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
+  | Acc_flush p              -> bufput_acc b p;
+  | Acc_invalid_arg (p, msg) -> bufput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(* Recursively output an "accumulator" containing a reversed list of
+   printing entities (string, char, flus, ...) in a buffer. *)
+(* 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
+    strput_acc b p;
+    Buffer.add_string b s;
+  | 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 ())
+  | Acc_flush p              -> strput_acc b p;
+  | Acc_invalid_arg (p, msg) -> strput_acc b p; invalid_arg msg;
+  | End_of_acc               -> ()
+
+(******************************************************************************)
+                          (* Error managment *)
+
+(* Raise a Failure with a pretty-printed error message. *)
+(* Since it uses "compiled formats", it can't be implemented in bootstrap
+   mode. *)
+let failwith_message _ =
+  failwith
+    "CamlinternalFormat failure \
+     (error messages not implemented at bootstrap time)"
+
+(******************************************************************************)
+                            (* Parsing tools *)
+
+(* 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 ->
+      (_, _, _, _, _) padding_fmt_ebb =
+fun pad fmt -> match pad with
+  | No_padding         -> Padding_fmt_EBB (No_padding, fmt)
+  | Lit_padding (s, w) -> Padding_fmt_EBB (Lit_padding (s, w), fmt)
+  | Arg_padding s      -> Padding_fmt_EBB (Arg_padding s, fmt)
+
+(* 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 ->
+      (_, _, _, _, _) precision_fmt_ebb =
+fun prec fmt -> match prec with
+  | No_precision    -> Precision_fmt_EBB (No_precision, fmt)
+  | Lit_precision p -> Precision_fmt_EBB (Lit_precision p, fmt)
+  | Arg_precision   -> Precision_fmt_EBB (Arg_precision, fmt)
+
+(* Create a padprec_fmt_ebb forma a padding, a precision and a format. *)
+(* Copy the padding and the precision to disjoin type parameters of arguments
+   and result. *)
+let make_padprec_fmt_ebb : type x y z t .
+    (x, y) padding -> (z, t) precision ->
+    (_, _, _, _, _, _) CamlinternalFormatBasics.fmt ->
+    (_, _, _, _, _) padprec_fmt_ebb =
+fun pad prec fmt ->
+  let Precision_fmt_EBB (prec, fmt') = make_precision_fmt_ebb prec fmt in
+  match pad with
+  | No_padding         -> Padprec_fmt_EBB (No_padding, prec, fmt')
+  | Lit_padding (s, w) -> Padprec_fmt_EBB (Lit_padding (s, w), prec, fmt')
+  | Arg_padding s      -> Padprec_fmt_EBB (Arg_padding s, prec, fmt')
+
+(******************************************************************************)
+                             (* Format parsing *)
+
+(* Parse a string representing a format and create a fmt_ebb. *)
+(* Raise an Failure exception in case of invalid format. *)
+let fmt_ebb_of_string str =
+  (* Parameters naming convention:                                    *)
+  (*   - lit_start: start of the literal sequence.                    *)
+  (*   - str_ind: current index in the string.                        *)
+  (*   - end_ind: end of the current (sub-)format.                    *)
+  (*   - pct_ind: index of the '%' in the current micro-format.       *)
+  (*   - zero:  is the '0' flag defined in the current micro-format.  *)
+  (*   - minus: is the '-' flag defined in the current micro-format.  *)
+  (*   - plus:  is the '+' flag defined in the current micro-format.  *)
+  (*   - sharp: is the '#' flag defined in the current micro-format.  *)
+  (*   - space: is the ' ' flag defined in the current micro-format.  *)
+  (*   - ign:   is the '_' flag defined in the current micro-format.  *)
+  (*   - pad: padding of the current micro-format.                    *)
+  (*   - prec: precision of the current micro-format.                 *)
+  (*   - symb: char representing the conversion ('c', 's', 'd', ...). *)
+  (*   - char_set: set of characters as bitmap (see scanf %[...]).    *)
+
+  (* Raise a Failure with a friendly error message. *)
+  (* Used when the end of the format (or the current sub-format) was encoutered
+      unexpectedly. *)
+  let unexpected_end_of_format end_ind =
+    failwith_message
+      "invalid format %S: at character number %d, unexpected end of format"
+      str end_ind;
+
+  (* Raise Failure with a friendly error message about an option dependencie
+     problem. *)
+  and invalid_format_without str_ind c s =
+    failwith_message
+      "invalid format %S: at character number %d, '%c' without %s"
+      str str_ind c s
+
+  (* Raise Failure with a friendly error message about an unexpected
+     character. *)
+  and expected_character str_ind expected read =
+    failwith_message
+     "invalid format %S: at character number %d, %s expected, read %C"
+      str str_ind expected read in
+
+  (* Parse the string from beg_ind (included) to end_ind (excluded). *)
+  let rec parse : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun beg_ind end_ind -> parse_literal beg_ind beg_ind end_ind
+
+  (* Read literal characters up to '%' or '@' special characters. *)
+  and parse_literal : type e f . int -> int -> int -> (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind end_ind ->
+    if str_ind = end_ind then add_literal lit_start str_ind End_of_format else
+      match str.[str_ind] with
+      | '%' ->
+        let Fmt_EBB fmt_rest = parse_flags str_ind end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | '@' ->
+        let Fmt_EBB fmt_rest = parse_after_at (str_ind + 1) end_ind in
+        add_literal lit_start str_ind fmt_rest
+      | _ ->
+        parse_literal lit_start (str_ind + 1) end_ind
+
+  and parse_flags : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun pct_ind end_ind ->
+    let zero = ref false and minus = ref false and plus = ref false
+    and sharp = ref false and space = ref false and ign = ref false in
+    let set_flag str_ind flag =
+      if !flag then
+        failwith_message
+          "invalid format %S: at character number %d, duplicate flag %C"
+          str str_ind str.[str_ind];
+      flag := true
+    in
+    let rec read_flags str_ind =
+      if str_ind = end_ind then unexpected_end_of_format end_ind;
+      begin match str.[str_ind] with
+      | '0' -> set_flag str_ind zero;  read_flags (str_ind + 1)
+      | '-' -> set_flag str_ind minus; read_flags (str_ind + 1)
+      | '+' -> set_flag str_ind plus;  read_flags (str_ind + 1)
+      | '#' -> set_flag str_ind sharp; read_flags (str_ind + 1)
+      | ' ' -> set_flag str_ind space; read_flags (str_ind + 1)
+      | '_' -> set_flag str_ind ign;   read_flags (str_ind + 1)
+      | _ ->
+        parse_padding pct_ind str_ind end_ind
+          !zero !minus !plus !sharp !space !ign
+      end
+    in
+    read_flags (pct_ind + 1)
+
+  (* Try to read a digital or a '*' padding. *)
+  and parse_padding : type e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> bool -> bool ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind zero minus plus sharp space ign ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let padty = match zero, minus with
+      | false, false -> Right
+      | false, true  -> Left
+      |  true, false -> Zeros
+      |  true, true  -> incompatible_flag pct_ind str_ind '-' "0" in
+    match str.[str_ind] with
+    | '0' .. '9' ->
+      let new_ind, width = parse_positive str_ind end_ind 0 in
+      parse_after_padding pct_ind new_ind end_ind plus sharp space ign
+        (Lit_padding (padty, width))
+    | '*' ->
+      parse_after_padding pct_ind (str_ind + 1) end_ind plus sharp space ign
+        (Arg_padding padty)
+    | _ ->
+      match padty with
+      | Left  -> invalid_format_without (str_ind - 1) '-' "padding"
+      | Zeros -> invalid_format_without (str_ind - 1) '0' "padding"
+      | Right ->
+        parse_after_padding pct_ind str_ind end_ind plus sharp space ign
+          No_padding
+
+  (* Is precision defined? *)
+  and parse_after_padding : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '.' ->
+      parse_precision pct_ind (str_ind + 1) end_ind plus sharp space ign pad
+    | symb ->
+      parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad
+        No_precision symb
+
+  (* Read the digital or '*' precision. *)
+  and parse_precision : type x e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' ->
+      let new_ind, prec = parse_positive str_ind end_ind 0 in
+      parse_conversion pct_ind (new_ind + 1) end_ind plus sharp space ign pad
+        (Lit_precision prec) str.[new_ind]
+    | '*' ->
+      parse_after_precision pct_ind (str_ind + 1) end_ind plus sharp space ign
+        pad Arg_precision
+    | _ ->
+      invalid_format_without (str_ind - 1) '.' "precision"
+
+  (* Try to read the conversion. *)
+  and parse_after_precision : type x z e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, _) padding ->
+        (z, _) precision -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad prec ->
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    parse_conversion pct_ind (str_ind + 1) end_ind plus sharp space ign pad prec
+      str.[str_ind]
+
+  (* Case analysis on conversion. *)
+  and parse_conversion : type x y z t e f .
+      int -> int -> int -> bool -> bool -> bool -> bool -> (x, y) padding ->
+        (z, t) precision -> char -> (_, _, e, f) fmt_ebb =
+  fun pct_ind str_ind end_ind plus sharp space ign pad prec symb ->
+    (* Flags used to check option usages/compatibilities. *)
+    let plus_used  = ref false and sharp_used = ref false
+    and space_used = ref false and ign_used   = ref false
+    and pad_used   = ref false and prec_used  = ref false in
+
+    (* Access to options, update flags. *)
+    let get_plus  () = plus_used  := true; plus
+    and get_sharp () = sharp_used := true; sharp
+    and get_space () = space_used := true; space
+    and get_ign   () = ign_used   := true; ign
+    and get_pad   () = pad_used   := true; pad
+    and get_prec  () = prec_used  := true; prec in
+
+    (* Check that padty <> Zeros. *)
+    let check_no_0 symb = match get_pad () with
+      | No_padding -> ()
+      | Lit_padding ((Left | Right), _) -> ()
+      | Arg_padding (Left | Right) -> ()
+      | Lit_padding (Zeros, _) -> incompatible_flag pct_ind str_ind symb "0"
+      | Arg_padding Zeros -> incompatible_flag pct_ind str_ind symb "0"
+    in
+
+    (* Get padding as an int option (see "%_", "%{", "%(" and "%["). *)
+    let get_pad_opt c = match get_pad () with
+      | No_padding -> None
+      | Lit_padding (Right, width) -> Some width
+      | Lit_padding (Zeros, _) -> incompatible_flag pct_ind str_ind c "'0'"
+      | Lit_padding (Left, _)  -> incompatible_flag pct_ind str_ind c "'-'"
+      | Arg_padding _          -> incompatible_flag pct_ind str_ind c "'*'"
+    in
+
+    (* Get precision as an int option (see "%_f"). *)
+    let get_prec_opt () = match get_prec () with
+      | No_precision       -> None
+      | Lit_precision ndec -> Some ndec
+      | Arg_precision      -> incompatible_flag pct_ind str_ind '_' "'*'"
+    in
+
+    let fmt_result = match symb with
+    | ',' ->
+      parse str_ind end_ind
+    | 'c' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_char, fmt_rest))
+      else Fmt_EBB (Char fmt_rest)
+    | 'C' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_caml_char,fmt_rest))
+      else Fmt_EBB (Caml_char fmt_rest)
+    | 's' ->
+      check_no_0 symb;
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_string (get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb (get_pad ()) fmt_rest in
+        Fmt_EBB (String (pad', fmt_rest'))
+    | 'S' ->
+      check_no_0 symb;
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_caml_string (get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padding_fmt_EBB (pad', fmt_rest') =
+          make_padding_fmt_ebb (get_pad ()) fmt_rest in
+        Fmt_EBB (Caml_string (pad', fmt_rest'))
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' ->
+      let iconv = compute_int_conv pct_ind str_ind (get_plus ()) (get_sharp ())
+        (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_int (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int (iconv, pad', prec', fmt_rest'))
+    | 'N' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Scan_get_counter (Token_counter, fmt_rest))
+    | 'l' | 'n' | 'L' when str_ind=end_ind || not (is_int_base str.[str_ind]) ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Scan_get_counter (counter_of_char symb, fmt_rest))
+    | 'l' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int32 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int32 (iconv, pad', prec', fmt_rest'))
+    | 'n' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ())
+          (get_sharp ()) (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_nativeint (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Nativeint (iconv, pad', prec', fmt_rest'))
+    | 'L' ->
+      let iconv =
+        compute_int_conv pct_ind (str_ind + 1) (get_plus ()) (get_sharp ())
+          (get_space ()) str.[str_ind] in
+      let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+      if get_ign () then
+        let ignored = Ignored_int64 (iconv, get_pad_opt '_') in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Int64 (iconv, pad', prec', fmt_rest'))
+    | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' ->
+      let fconv = compute_float_conv pct_ind str_ind (get_plus ())
+        (get_space ()) symb in
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then
+        let ignored = Ignored_float (get_pad_opt '_', get_prec_opt ()) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        let Padprec_fmt_EBB (pad', prec', fmt_rest') =
+          make_padprec_fmt_ebb (get_pad ()) (get_prec ()) fmt_rest in
+        Fmt_EBB (Float (fconv, pad', prec', fmt_rest'))
+    | 'b' | 'B' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_bool, fmt_rest))
+      else Fmt_EBB (Bool fmt_rest)
+    | 'a' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Alpha fmt_rest)
+    | 't' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Theta fmt_rest)
+    | 'r' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      if get_ign () then Fmt_EBB (Ignored_param (Ignored_reader, fmt_rest))
+      else Fmt_EBB (Reader fmt_rest)
+    | '!' ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Flush fmt_rest)
+    | ('%' | '@') as c ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Char_literal (c, fmt_rest))
+    | '{' ->
+      let sub_end = search_subformat_end str_ind end_ind '}' in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        let ignored = Ignored_format_arg (get_pad_opt '_', sub_fmtty) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Format_arg (get_pad_opt '{', sub_fmtty, fmt_rest))
+    | '(' ->
+      let sub_end = search_subformat_end str_ind end_ind ')' in
+      let Fmt_EBB fmt_rest = parse (sub_end + 2) end_ind in
+      let Fmt_EBB sub_fmt = parse str_ind sub_end in
+      let sub_fmtty = fmtty_of_fmt sub_fmt in
+      if get_ign () then
+        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 '(',
+                                  reader_nb_unifier_of_fmtty sub_fmtty,
+                                  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
+      if get_ign () then
+        let ignored = Ignored_scan_char_set (get_pad_opt '_', char_set) in
+        Fmt_EBB (Ignored_param (ignored, fmt_rest))
+      else
+        Fmt_EBB (Scan_char_set (get_pad_opt '[', char_set, fmt_rest))
+    | '-' | '+' | '#' | ' ' | '_' ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         flag %C is only allowed after the '%%', before padding and precision"
+        str pct_ind symb
+    | _ ->
+      failwith_message
+        "invalid format %S: at character number %d, \
+         invalid conversion \"%%%c\"" str (str_ind - 1) symb
+    in
+    (* Check for unused options, which are consequently incompatibles. *)
+    if not !plus_used && plus then
+      incompatible_flag pct_ind str_ind symb "'+'";
+    if not !sharp_used && sharp then
+      incompatible_flag pct_ind str_ind symb "'#'";
+    if not !space_used && space then
+      incompatible_flag pct_ind str_ind symb "' '";
+    if not !ign_used && ign then
+      incompatible_flag pct_ind str_ind symb "'_'";
+    if not !pad_used  && Padding_EBB pad <> Padding_EBB No_padding then
+      incompatible_flag pct_ind str_ind symb "`padding'";
+    if not !prec_used && Precision_EBB prec <> Precision_EBB No_precision then
+      incompatible_flag pct_ind str_ind (if ign then '_' else symb)
+        "`precision'";
+    if ign && plus then incompatible_flag pct_ind str_ind '_' "'+'";
+    fmt_result
+
+  (* Parse formatting informations (after '@'). *)
+  and parse_after_at : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    if str_ind = end_ind then Fmt_EBB (Char_literal ('@', End_of_format))
+    else
+      match str.[str_ind] with
+      | '[' ->
+        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))
+      | '{' ->
+        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))
+      | ',' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting (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))
+      | ';' ->
+        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))
+      | '\n' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting (Force_newline, fmt_rest))
+      | '.' ->
+        let Fmt_EBB fmt_rest = parse (str_ind + 1) end_ind in
+        Fmt_EBB (Formatting (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))
+      | '%' 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))
+      | '%' ->
+        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))
+
+  (* Try to read the optionnal <...> after "@[". *)
+  and parse_open_box : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    let next_ind, box_ty, indent =
+      try
+        if str_ind = end_ind then raise Not_found;
+        match str.[str_ind] with
+        | '<' -> (
+          let str_ind_1 = parse_spaces (str_ind + 1) end_ind in
+          let i = ref str_ind_1 in
+          while !i < end_ind && str.[!i] >= 'a' && str.[!i] <= 'z' do
+            incr i;
+          done;
+          let box_ty = match String.sub str str_ind_1 (!i - str_ind_1) with
+            | ""    -> Pp_box
+            | "h"   -> Pp_hbox
+            | "v"   -> Pp_vbox
+            | "hv"  -> Pp_hvbox
+            | "hov" -> Pp_hovbox
+            | _     -> raise Not_found
+          in
+          let str_ind_3 = parse_spaces !i end_ind in
+          match str.[str_ind_3] with
+          | '0' .. '9' | '-' ->
+            let str_ind_4, indent = parse_integer str_ind_3 end_ind in
+            let str_ind_5 = parse_spaces str_ind_4 end_ind in
+            if str.[str_ind_5] <> '>' then raise Not_found;
+            str_ind_5 + 1, box_ty, indent
+          | '>' ->
+            str_ind_3 + 1, box_ty, 0
+          | _ ->
+            raise Not_found
+        )
+        | _ -> raise Not_found
+      with Not_found | Failure _ ->
+        str_ind, Pp_box, 0
+    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))
+
+  (* 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 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 =
+      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
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' -> (
+          let str_ind_2, width = parse_integer str_ind_1 end_ind in
+            let str_ind_3 = parse_spaces str_ind_2 end_ind in
+            match str.[str_ind_3] with
+              | '>' ->
+                let s = String.sub str (str_ind-2) (str_ind_3-str_ind+3) in
+                str_ind_3 + 1, Break (s, width, 0)
+              | '0' .. '9' | '-' ->
+                let str_ind_4, offset = parse_integer str_ind_3 end_ind in
+                let str_ind_5 = parse_spaces str_ind_4 end_ind in
+                if str.[str_ind_5] <> '>' then raise Not_found;
+                let s = String.sub str (str_ind-2) (str_ind_5-str_ind+3) in
+                str_ind_5 + 1, Break (s, width, offset)
+              | _ -> raise Not_found
+        )
+        | _ -> raise Not_found
+      with Not_found | Failure _ ->
+        str_ind, Break ("@;", 1, 0)
+    in
+    let Fmt_EBB fmt_rest = parse next_ind end_ind in
+    Fmt_EBB (Formatting (formatting, fmt_rest))
+
+  (* Parse the size in a <n>. *)
+  and parse_magic_size : type e f . int -> int -> (_, _, e, f) fmt_ebb =
+  fun str_ind end_ind ->
+    match
+      try
+        let str_ind_1 = parse_spaces str_ind end_ind in
+        match str.[str_ind_1] with
+        | '0' .. '9' | '-' ->
+          let str_ind_2, size = parse_integer str_ind_1 end_ind in
+          let str_ind_3 = parse_spaces str_ind_2 end_ind in
+          if str.[str_ind_3] <> '>' then raise Not_found;
+          let s = String.sub str (str_ind - 2) (str_ind_3 - str_ind + 3) in
+          Some (str_ind_3 + 1, Magic_size (s, size))
+        | _ -> None
+      with Not_found | Failure _ ->
+        None
+    with
+    | Some (next_ind, formatting) ->
+      let Fmt_EBB fmt_rest = parse next_ind end_ind in
+      Fmt_EBB (Formatting (formatting, fmt_rest))
+    | None ->
+      let Fmt_EBB fmt_rest = parse str_ind end_ind in
+      Fmt_EBB (Formatting (Scan_indic '<', fmt_rest))
+
+  (* Parse and construct a char set. *)
+  and parse_char_set str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    let char_set = create_char_set () in
+    match str.[str_ind] with
+    | '^' ->
+      let next_ind = parse_char_set_start (str_ind + 1) end_ind char_set in
+      next_ind, rev_char_set char_set
+    | _ -> parse_char_set_start str_ind end_ind char_set, char_set
+
+  (* Parse the first character of a char set. *)
+  and parse_char_set_start str_ind end_ind char_set =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    parse_char_set_after_char (str_ind + 1) end_ind char_set str.[str_ind];
+
+  (* Parse the content of a char set until the first ']'. *)
+  and parse_char_set_content str_ind end_ind char_set =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | ']' ->
+      str_ind + 1
+    | '-' ->
+      add_in_char_set char_set '-';
+      parse_char_set_content (str_ind + 1) end_ind char_set;
+    | c ->
+      parse_char_set_after_char (str_ind + 1) end_ind char_set c;
+
+  (* Test for range in char set. *)
+  and parse_char_set_after_char str_ind end_ind char_set c =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | ']' ->
+      add_in_char_set char_set c;
+      str_ind + 1
+    | '-' ->
+      parse_char_set_after_minus (str_ind + 1) end_ind char_set c
+    | c' ->
+      add_in_char_set char_set c;
+      parse_char_set_after_char (str_ind + 1) end_ind char_set c'
+
+  (* Manage range in char set (except if the '-' the last char before ']') *)
+  and parse_char_set_after_minus str_ind end_ind char_set c =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | ']' ->
+      add_in_char_set char_set c;
+      add_in_char_set char_set '-';
+      str_ind + 1
+    | c' ->
+      for i = int_of_char c to int_of_char c' do
+        add_in_char_set char_set (char_of_int i);
+      done;
+      parse_char_set_content (str_ind + 1) end_ind char_set
+
+  (* Consume all next spaces, raise an Failure if end_ind is reached. *)
+  and parse_spaces str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    if str.[str_ind] = ' ' then parse_spaces (str_ind + 1) end_ind else str_ind
+
+  (* Read a positive integer from the string, raise a Failure if end_ind is
+     reached. *)
+  and parse_positive str_ind end_ind acc =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' as c ->
+      let new_acc = acc * 10 + (int_of_char c - int_of_char '0') in
+      if new_acc > Sys.max_string_length then
+        failwith_message
+          "invalid format %S: integer %d is greater than the limit %d"
+          str new_acc Sys.max_string_length
+      else
+        parse_positive (str_ind + 1) end_ind new_acc
+    | _ -> str_ind, acc
+
+  (* Read a positive or negative integer from the string, raise a Failure
+     if end_ind is reached. *)
+  and parse_integer str_ind end_ind =
+    if str_ind = end_ind then unexpected_end_of_format end_ind;
+    match str.[str_ind] with
+    | '0' .. '9' -> parse_positive str_ind end_ind 0
+    | '-' -> (
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      match str.[str_ind + 1] with
+      | '0' .. '9' ->
+        let next_ind, n = parse_positive (str_ind + 1) end_ind 0 in
+        next_ind, -n
+      | c ->
+        expected_character (str_ind + 1) "digit" c
+    )
+    | _ -> assert false
+
+  (* 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 ->
+      (_, _, e, f) fmt_ebb =
+  fun lit_start str_ind fmt -> match str_ind - lit_start with
+    | 0    -> Fmt_EBB fmt
+    | 1    -> Fmt_EBB (Char_literal (str.[lit_start], fmt))
+    | size -> Fmt_EBB (String_literal (String.sub str lit_start size, fmt))
+
+  (* Search the end of the current sub-format
+     (i.e. the corresponding "%}" or "%)") *)
+  and search_subformat_end str_ind end_ind c =
+    if str_ind = end_ind then
+      failwith_message
+        "invalid format %S: unclosed sub-format, \
+         expected \"%%%c\" at character number %d" str c end_ind;
+    match str.[str_ind] with
+    | '%' ->
+      if str_ind + 1 = end_ind then unexpected_end_of_format end_ind;
+      if str.[str_ind + 1] = c then (* End of format found *) str_ind else
+        begin match str.[str_ind + 1] with
+        | '_' ->
+          (* Search for "%_(" or "%_{". *)
+          if str_ind + 2 = end_ind then unexpected_end_of_format end_ind;
+          begin match str.[str_ind + 2] with
+          | '{' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind '}' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | '(' ->
+            let sub_end = search_subformat_end (str_ind + 3) end_ind ')' in
+            search_subformat_end (sub_end + 2) end_ind c
+          | _ -> search_subformat_end (str_ind + 3) end_ind c
+          end
+        | '{' ->
+          (* %{...%} sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind '}' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '(' ->
+          (* %(...%) sub-format found. *)
+          let sub_end = search_subformat_end (str_ind + 2) end_ind ')' in
+          search_subformat_end (sub_end + 2) end_ind c
+        | '}' ->
+          (* Error: %(...%}. *)
+          expected_character (str_ind + 1) "character ')'" '}';
+        | ')' ->
+          (* Error: %{...%). *)
+          expected_character (str_ind + 1) "character '}'" ')';
+        | _ ->
+          search_subformat_end (str_ind + 2) end_ind c
+        end
+    | _ -> search_subformat_end (str_ind + 1) end_ind c
+
+  (* Check if symb is a valid int conversion after "%l", "%n" or "%L" *)
+  and is_int_base symb = match symb with
+    | 'd' | 'i' | 'x' | 'X' | 'o' | 'u' -> true
+    | _ -> false
+
+  (* Convert a char (l, n or L) to its associated counter. *)
+  and counter_of_char symb = match symb with
+    | 'l' -> Line_counter  | 'n' -> Char_counter
+    | 'L' -> Token_counter | _ -> assert false
+
+  (* Convert (plus, symb) to its associated int_conv. *)
+  and compute_int_conv pct_ind str_ind plus sharp space symb =
+    match plus, sharp, space, symb with
+    | false, false, false, 'd' -> Int_d  |  true, false, false, 'd' -> Int_pd
+    | false, false,  true, 'd' -> Int_sd | false, false, false, 'i' -> Int_i
+    |  true, false, false, 'i' -> Int_pi | false, false,  true, 'i' -> Int_si
+    | false, false, false, 'x' -> Int_x  | false,  true, false, 'x' -> Int_Cx
+    | false, false, false, 'X' -> Int_X  | false,  true, false, 'X' -> Int_CX
+    | false, false, false, 'o' -> Int_o  | false,  true, false, 'o' -> Int_Co
+    | false, false, false, 'u' -> Int_u
+    | true, _, true, _         -> incompatible_flag pct_ind str_ind ' ' "'+'"
+    | true, _, _, _            -> incompatible_flag pct_ind str_ind symb "'+'"
+    | _, true, _, _            -> incompatible_flag pct_ind str_ind symb "'#'"
+    | _, _, true, _            -> incompatible_flag pct_ind str_ind symb "' '"
+    | false, false, false, _   -> assert false
+
+  (* Convert (plus, symb) to its associated float_conv. *)
+  and compute_float_conv pct_ind str_ind plus space symb =
+  match plus, space, symb with
+    | false, false, 'f' -> Float_f  |  true, false, 'f' -> Float_pf
+    | false,  true, 'f' -> Float_sf | false, false, 'e' -> Float_e
+    |  true, false, 'e' -> Float_pe | false,  true, 'e' -> Float_se
+    | false, false, 'E' -> Float_E  |  true, false, 'E' -> Float_pE
+    | false,  true, 'E' -> Float_sE | false, false, 'g' -> Float_g
+    |  true, false, 'g' -> Float_pg | false,  true, 'g' -> Float_sg
+    | false, false, 'G' -> Float_G  |  true, false, 'G' -> Float_pG
+    | false,  true, 'G' -> Float_sG | false, false, 'F' -> Float_F
+    |  true,  true, _ -> incompatible_flag pct_ind str_ind ' ' "'+'"
+    |  true, false, _ -> incompatible_flag pct_ind str_ind symb "'+'"
+    | false,  true, _ -> incompatible_flag pct_ind str_ind symb "' '"
+    | false, false, _ -> assert false
+
+  (* Raise a Failure with a firendly error message about incompatible options.*)
+  and incompatible_flag : type a . int -> int -> char -> string -> a =
+    fun pct_ind str_ind symb option ->
+      let subfmt = String.sub str pct_ind (str_ind - pct_ind) in
+      failwith_message
+        "invalid format %S: at character number %d, \
+         %s is incompatible with '%c' in sub-format %S"
+        str pct_ind option symb subfmt;
+
+  in parse 0 (String.length str)
+
+(******************************************************************************)
+                  (* Guarded string to format conversions *)
+
+(* Convert a string to a format according to an fmtty. *)
+(* Raise a Failure with an error message in case of type mismatch. *)
+let format_of_string_fmtty str fmtty =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try (type_format fmt fmtty, str) with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S"
+      str (string_of_fmtty fmtty)
+
+(* Convert a string to a format compatible with an other format. *)
+(* Raise a Failure with an error message in case of type mismatch. *)
+let format_of_string_format str (fmt', str') =
+  let Fmt_EBB fmt = fmt_ebb_of_string str in
+  try (type_format fmt (fmtty_of_fmt fmt'), str) with Type_mismatch ->
+    failwith_message
+      "bad input: format type mismatch between %S and %S" str str'
diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli
new file mode 100644
index 000000000..1066b5f08
--- /dev/null
+++ b/stdlib/camlinternalFormat.mli
@@ -0,0 +1,53 @@
+(* No comments, OCaml stdlib internal use only. *)
+
+open CamlinternalFormatBasics
+
+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
+  | End_of_acc
+
+type ('a, 'b) heter_list =
+  | Cons : 'c * ('a, 'b) heter_list -> ('c -> 'a, 'b) heter_list
+  | Nil : ('b, 'b) heter_list
+
+type ('b, 'c, 'e, 'f) fmt_ebb = Fmt_EBB :
+     ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt ->
+     ('b, 'c, 'e, 'f) fmt_ebb
+
+val make_printf :
+  ('b -> ('b, 'c) acc -> 'd) -> 'b -> ('b, 'c) acc ->
+  ('a, 'b, 'c, 'c, 'c, 'd) CamlinternalFormatBasics.fmt -> 'a
+
+val output_acc : out_channel -> (out_channel, unit) acc -> unit
+val bufput_acc : Buffer.t -> (Buffer.t, unit) acc -> unit
+val strput_acc : Buffer.t -> (unit, string) acc -> unit
+
+val type_format :
+  ('x, 'b, 'c, 't, 'u, 'v) CamlinternalFormatBasics.fmt ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt
+
+val fmt_ebb_of_string : string -> ('b, 'c, 'e, 'f) fmt_ebb
+
+val format_of_string_fmtty :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6
+
+val format_of_string_format :
+  string ->
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6 ->
+  ('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_fmtty :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmtty -> string
+val string_of_fmt :
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.fmt -> string
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 83b1fcf7e..e56688f0d 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -222,7 +222,10 @@ let string_of_int n =
   format_int "%d" n
 
 external int_of_string : string -> int = "caml_int_of_string"
-external string_get : string -> int -> char = "%string_safe_get"
+module String = struct
+  external get : string -> int -> char = "%string_safe_get"
+  external set : string -> int -> char -> unit = "%string_safe_set"
+end
 
 let valid_float_lexem s =
   let l = string_length s in
@@ -447,8 +450,523 @@ module LargeFile =
   end
 
 (* Formats *)
-type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
+module CamlinternalFormatBasics = struct
+(* 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).               *)
+  | Right  (* Text is right justified (no '-' option).           *)
+  | Zeros  (* Text is right justified by zeros (see '0' option). *)
+
+(***)
+
+(* Integer conversion. *)
+type int_conv =
+  | Int_d | Int_pd | Int_sd        (*  %d | %+d | % d  *)
+  | Int_i | Int_pi | Int_si        (*  %i | %+i | % i  *)
+  | Int_x | Int_Cx                 (*  %x | %#x        *)
+  | Int_X | Int_CX                 (*  %X | %#X        *)
+  | Int_o | Int_Co                 (*  %o | %#o        *)
+  | Int_u                          (*  %u              *)
+
+(* Float conversion. *)
+type float_conv =
+  | Float_f | Float_pf | Float_sf  (*  %f | %+f | % f  *)
+  | Float_e | Float_pe | Float_se  (*  %e | %+e | % e  *)
+  | Float_E | Float_pE | Float_sE  (*  %E | %+E | % E  *)
+  | Float_g | Float_pg | Float_sg  (*  %g | %+g | % g  *)
+  | Float_G | Float_pG | Float_sG  (*  %G | %+G | % G  *)
+  | Float_F                        (*  %F              *)
+
+(***)
+
+(* Char sets (see %[...]) are bitmaps implemented as 32-char strings. *)
+type char_set = string
+
+(***)
+
+(* Counter used in Scanf. *)
+type counter =
+  | Line_counter     (*  %l      *)
+  | Char_counter     (*  %n      *)
+  | Token_counter    (*  %N, %L  *)
+
+(***)
+
+(* Padding of strings and numbers. *)
+type ('a, 'b) padding =
+  (* No padding (ex: "%d") *)
+  | No_padding  : ('a, 'a) padding
+  (* Literal padding (ex: "%8d") *)
+  | Lit_padding : padty * int -> ('a, 'a) padding
+  (* Padding as extra argument (ex: "%*d") *)
+  | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+(* Precision of floats and '0'-padding of integers. *)
+type ('a, 'b) precision =
+  (* No precision (ex: "%f") *)
+  | No_precision : ('a, 'a) precision
+  (* Literal precision (ex: "%.3f") *)
+  | Lit_precision : int -> ('a, 'a) precision
+  (* Precision as extra argument (ex: "%.*f") *)
+  | Arg_precision : (int -> 'a, 'a) precision
+
+(***)
+
+(* Type used in Format_subst_ty and Format_subst constructors as "a proof"
+   of '->' number equality between two ('d, 'e) relations. *)
+(* See the scanf implementation of "%(...%)". *)
+(* Not meaningfull for Printf and Format since "%r" is Scanf specific. *)
+type ('d1, 'e1, 'd2, 'e2) reader_nb_unifier =
+  | Zero_reader :
+      ('d1, 'd1, 'd2, 'd2) reader_nb_unifier
+  | Succ_reader :
+      ('d1, 'e1, 'd2, 'e2) reader_nb_unifier ->
+        ('x -> 'd1, 'e1, 'x -> 'd2, 'e2) reader_nb_unifier
+
+(***)
+
+(* List of format type elements. *)
+(* In particular used to represent %(...%) and %{...%} contents. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+  | Char_ty :                                                 (* %c  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | String_ty :                                               (* %s  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Int_ty :                                                  (* %d  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Int32_ty :                                                (* %ld *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (int32 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Nativeint_ty :                                            (* %nd *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (nativeint -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Int64_ty :                                                (* %Ld *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (int64 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Float_ty :                                                (* %f  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (float -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Bool_ty :                                                 (* %B  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+
+  | Format_arg_ty :                                           (* %{...%} *)
+      ('x, 'b, 'c, 'q, 'r, 'u) fmtty *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (('x, 'b, 'c, 'q, 'r, 'u) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Format_subst_ty :                                         (* %(...%) *)
+      ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+      ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+      ('u, 'b, 'c, 'q1, 'e1, 'f) fmtty ->
+        (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmtty
+
+  (* Printf and Format specific constructors. *)
+  | Alpha_ty :                                                (* %a  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+  | Theta_ty :                                                (* %t  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+
+  (* Scanf specific constructor. *)
+  | Reader_ty :                                               (* %r  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmtty
+  | Ignored_reader_ty :                                       (* %_r  *)
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmtty
+
+  | End_of_fmtty :
+        ('f, 'b, 'c, 'd, 'd, 'f) fmtty
+
+(***)
+
+(* 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
+
+  | 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 :                                             (* %{...%} *)
+      int option * ('x, 'b, 'c, 'q, 'r, 'u) fmtty *
+      ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+        (('x, 'b, 'c, 'q, 'r, 'u) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+  | Format_subst :                                           (* %(...%) *)
+      int option * ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+      ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+      ('u, 'b, 'c, 'q1, 'e1, 'f) fmt ->
+        (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, '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
+
+  (* 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 :                                          (* %[...] *)
+      int 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 :
+        ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+(***)
+
+(* Type for ignored parameters (see "%_"). *)
+and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+  | Ignored_char :                                           (* %_c *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_char :                                      (* %_C *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_string :                                         (* %_s *)
+      int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_caml_string :                                    (* %_S *)
+      int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int :                                            (* %_d *)
+      int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int32 :                                          (* %_ld *)
+      int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_nativeint :                                      (* %_nd *)
+      int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_int64 :                                          (* %_Ld *)
+      int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_float :                                          (* %_f *)
+      int option * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_bool :                                           (* %_B *)
+      ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_arg :                                     (* %_{...%} *)
+      int option * ('x, 'b, 'c, 'y, 'z, 't) fmtty ->
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+  | Ignored_format_subst :                                   (* %_(...%) *)
+      int option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+        ('a, 'b, 'c, 'd, 'e, 'f) ignored
+  | Ignored_reader :                                         (* %_r *)
+      ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+  | Ignored_scan_char_set :                                  (* %_[...] *)
+      int option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+and ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+(******************************************************************************)
+                         (* Format type concatenation *)
+
+(* Concatenate two format types. *)
+(* Used by:
+   * reader_nb_unifier_of_fmtty to count readers in an fmtty,
+   * Scanf.take_fmtty_format_readers to extract readers inside %(...%),
+   * CamlinternalFormat.fmtty_of_ignored_format to extract format type. *)
+let rec concat_fmtty : type a b c d e f g h .
+    (a, b, c, d, e, f) fmtty ->
+    (f, b, c, e, g, h) fmtty ->
+    (a, b, c, d, g, h) fmtty =
+fun fmtty1 fmtty2 -> match fmtty1 with
+  | Char_ty rest ->
+    Char_ty (concat_fmtty rest fmtty2)
+  | String_ty rest ->
+    String_ty (concat_fmtty rest fmtty2)
+  | Int_ty rest ->
+    Int_ty (concat_fmtty rest fmtty2)
+  | Int32_ty rest ->
+    Int32_ty (concat_fmtty rest fmtty2)
+  | Nativeint_ty rest ->
+    Nativeint_ty (concat_fmtty rest fmtty2)
+  | Int64_ty rest ->
+    Int64_ty (concat_fmtty rest fmtty2)
+  | Float_ty rest ->
+    Float_ty (concat_fmtty rest fmtty2)
+  | Bool_ty rest ->
+    Bool_ty (concat_fmtty rest fmtty2)
+  | Alpha_ty rest ->
+    Alpha_ty (concat_fmtty rest fmtty2)
+  | Theta_ty rest ->
+    Theta_ty (concat_fmtty rest fmtty2)
+  | Reader_ty rest ->
+    Reader_ty (concat_fmtty rest fmtty2)
+  | Ignored_reader_ty rest ->
+    Ignored_reader_ty (concat_fmtty rest fmtty2)
+  | Format_arg_ty (ty, rest) ->
+    Format_arg_ty (ty, concat_fmtty rest fmtty2)
+  | Format_subst_ty (rnu, ty, rest) ->
+    Format_subst_ty (rnu, ty, concat_fmtty rest fmtty2)
+  | End_of_fmtty -> fmtty2
+
+(******************************************************************************)
+                           (* Format concatenation *)
+
+(* Concatenate two formats. *)
+let rec concat_fmt : type a b c d e f g h .
+    (a, b, c, d, e, f) fmt ->
+    (f, b, c, e, g, h) fmt ->
+    (a, b, c, d, g, h) fmt =
+fun fmt1 fmt2 -> match fmt1 with
+  | String (pad, rest) ->
+    String (pad, concat_fmt rest fmt2)
+  | Caml_string (pad, rest) ->
+    Caml_string (pad, concat_fmt rest fmt2)
+
+  | Int (iconv, pad, prec, rest) ->
+    Int (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int32 (iconv, pad, prec, rest) ->
+    Int32 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Nativeint (iconv, pad, prec, rest) ->
+    Nativeint (iconv, pad, prec, concat_fmt rest fmt2)
+  | Int64 (iconv, pad, prec, rest) ->
+    Int64 (iconv, pad, prec, concat_fmt rest fmt2)
+  | Float (fconv, pad, prec, rest) ->
+    Float (fconv, pad, prec, concat_fmt rest fmt2)
+
+  | Char (rest) ->
+    Char (concat_fmt rest fmt2)
+  | Caml_char rest ->
+    Caml_char (concat_fmt rest fmt2)
+  | Bool rest ->
+    Bool (concat_fmt rest fmt2)
+  | Alpha rest ->
+    Alpha (concat_fmt rest fmt2)
+  | Theta rest ->
+    Theta (concat_fmt rest fmt2)
+  | Reader rest ->
+    Reader (concat_fmt rest fmt2)
+  | Flush rest ->
+    Flush (concat_fmt rest fmt2)
+
+  | String_literal (str, rest) ->
+    String_literal (str, concat_fmt rest fmt2)
+  | Char_literal (chr, rest) ->
+    Char_literal   (chr, concat_fmt rest fmt2)
+
+  | Format_arg (pad, fmtty, rest) ->
+    Format_arg   (pad, fmtty, concat_fmt rest fmt2)
+  | Format_subst (pad, rnu, fmtty, rest) ->
+    Format_subst (pad, rnu, fmtty, concat_fmt rest fmt2)
+
+  | Scan_char_set (width_opt, char_set, rest) ->
+    Scan_char_set (width_opt, char_set, concat_fmt rest fmt2)
+  | Scan_get_counter (counter, rest) ->
+    Scan_get_counter (counter, concat_fmt rest fmt2)
+  | Ignored_param (ign, rest) ->
+    Ignored_param (ign, concat_fmt rest fmt2)
+
+  | Formatting (fmting, rest) ->
+    Formatting (fmting, concat_fmt rest fmt2)
+
+  | End_of_format ->
+    fmt2
+
+(******************************************************************************)
+           (* Tools to manipulate scanning set of chars (see %[...]) *)
+
+(* Create a fresh empty char set. *)
+let create_char_set () =
+  let str = string_create 32 in
+  for i = 0 to 31 do str.[i] <- '\000' done;
+  str
+
+(* Return true if a `c' is in `char_set'. *)
+let is_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  (int_of_char char_set.[str_ind] land mask) <> 0
+
+(* Add a char in a char set. *)
+let add_in_char_set char_set c =
+  let ind = int_of_char c in
+  let str_ind = ind lsr 3 and mask = 1 lsl (ind land 0b111) in
+  char_set.[str_ind] <- char_of_int (int_of_char char_set.[str_ind] lor mask)
+
+(* Compute the complement of a char set. *)
+(* Return a fresh string, do not modify its argument. *)
+let rev_char_set char_set =
+  let char_set' = create_char_set () in
+  for i = 0 to 31 do
+    char_set'.[i] <- char_of_int (int_of_char char_set.[i] lxor 0xFF);
+  done;
+  char_set'
+
+(******************************************************************************)
+                             (* Reader count *)
+
+(* Count the number of "%r" (Reader_ty) and "%_r" (Ignored_reader_ty)
+   in an fmtty. *)
+let rec reader_nb_unifier_of_fmtty : type a b c d e f .
+    (a, b, c, d, e, f) fmtty -> (d, e, d, e) reader_nb_unifier =
+fun fmtty -> match fmtty with
+  | Char_ty rest            -> reader_nb_unifier_of_fmtty rest
+  | String_ty rest          -> reader_nb_unifier_of_fmtty rest
+  | Int_ty rest             -> reader_nb_unifier_of_fmtty rest
+  | Int32_ty rest           -> reader_nb_unifier_of_fmtty rest
+  | Nativeint_ty rest       -> reader_nb_unifier_of_fmtty rest
+  | Int64_ty rest           -> reader_nb_unifier_of_fmtty rest
+  | Float_ty rest           -> reader_nb_unifier_of_fmtty rest
+  | Bool_ty rest            -> reader_nb_unifier_of_fmtty rest
+  | Alpha_ty rest           -> reader_nb_unifier_of_fmtty rest
+  | Theta_ty rest           -> reader_nb_unifier_of_fmtty rest
+  | Reader_ty rest          -> Succ_reader (reader_nb_unifier_of_fmtty rest)
+  | Ignored_reader_ty rest  -> Succ_reader (reader_nb_unifier_of_fmtty rest)
+  | Format_arg_ty (_, rest) -> reader_nb_unifier_of_fmtty rest
+  | Format_subst_ty(_,sub_fmtty,rest) ->
+    reader_nb_unifier_of_fmtty (concat_fmtty sub_fmtty rest)
+  | End_of_fmtty -> Zero_reader
+
+(******************************************************************************)
+                         (* Ignored param conversion *)
+
+(* GADT used to abstract an existential type parameter. *)
+(* See param_format_of_ignored_format. *)
+type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+    ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+    ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+(* Compute a padding associated to an int option (see "%_42d"). *)
+let pad_of_pad_opt pad_opt = match pad_opt with
+  | None -> No_padding
+  | Some width -> Lit_padding (Right, width)
+
+(* Compute a precision associated to an int option (see "%_.42f"). *)
+let prec_of_prec_opt prec_opt = match prec_opt with
+  | None -> No_precision
+  | Some ndec -> Lit_precision ndec
+
+(* Turn an ignored param into its equivalent not-ignored format node. *)
+(* Used for format pretty-printing and Scanf. *)
+let param_format_of_ignored_format : type a b c d e f x y .
+    (a, b, c, d, y, x) ignored -> (x, b, c, y, e, f) fmt ->
+      (a, b, c, d, e, f) param_format_ebb =
+fun ign fmt -> match ign with
+  | Ignored_char ->
+    Param_format_EBB (Char fmt)
+  | Ignored_caml_char ->
+    Param_format_EBB (Caml_char fmt)
+  | Ignored_string pad_opt ->
+    Param_format_EBB (String (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_caml_string pad_opt ->
+    Param_format_EBB (Caml_string (pad_of_pad_opt pad_opt, fmt))
+  | Ignored_int (iconv, pad_opt) ->
+    Param_format_EBB (Int (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int32 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int32 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_nativeint (iconv, pad_opt) ->
+    Param_format_EBB
+      (Nativeint (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_int64 (iconv, pad_opt) ->
+    Param_format_EBB
+      (Int64 (iconv, pad_of_pad_opt pad_opt, No_precision, fmt))
+  | Ignored_float (pad_opt, prec_opt) ->
+    Param_format_EBB
+      (Float (Float_f, pad_of_pad_opt pad_opt, prec_of_prec_opt prec_opt, fmt))
+  | Ignored_bool ->
+    Param_format_EBB (Bool fmt)
+  | Ignored_format_arg (pad_opt, fmtty) ->
+    Param_format_EBB (Format_arg (pad_opt, fmtty, fmt))
+  | Ignored_format_subst (pad_opt, fmtty) ->
+    Param_format_EBB
+      (Format_subst (pad_opt, reader_nb_unifier_of_fmtty fmtty, fmtty, fmt))
+  | Ignored_reader ->
+    Param_format_EBB (Reader fmt)
+  | Ignored_scan_char_set (width_opt, char_set) ->
+    Param_format_EBB (Scan_char_set (width_opt, char_set, fmt))
+end
+
+(*type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6*)
+
+(* Aliases of format6 with restricted parameters. *)
+(* Usefull for Printf and Format functions. *)
+type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
 
 external format_of_string :
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index fae87ba12..fb927b9be 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -966,8 +966,246 @@ external decr : int ref -> unit = "%decr"
   {!Printf} and {!Format}.
 *)
 
+module CamlinternalFormatBasics : sig
+  (* 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 =
+    | Int_d | Int_pd | Int_sd | Int_i | Int_pi | Int_si
+    | Int_x | Int_Cx | Int_X | Int_CX | Int_o | Int_Co | Int_u
+
+  type float_conv =
+    | Float_f | Float_pf | Float_sf | Float_e | Float_pe | Float_se
+    | Float_E | Float_pE | Float_sE | Float_g | Float_pg | Float_sg
+    | Float_G | Float_pG | Float_sG | Float_F
+
+  type char_set = string
+
+  type counter = Line_counter | Char_counter | Token_counter
+
+  type ('a, 'b) padding =
+    | No_padding  : ('a, 'a) padding
+    | Lit_padding : padty * int -> ('a, 'a) padding
+    | Arg_padding : padty -> (int -> 'a, 'a) padding
+
+  type ('a, 'b) precision =
+    | No_precision : ('a, 'a) precision
+    | Lit_precision : int -> ('a, 'a) precision
+    | Arg_precision : (int -> 'a, 'a) precision
+
+  type ('d1, 'e1, 'd2, 'e2) reader_nb_unifier =
+    | Zero_reader :
+        ('d1, 'd1, 'd2, 'd2) reader_nb_unifier
+    | Succ_reader :
+        ('d1, 'e1, 'd2, 'e2) reader_nb_unifier ->
+          ('x -> 'd1, 'e1, 'x -> 'd2, 'e2) reader_nb_unifier
+
+  type ('a, 'b, 'c, 'd, 'e, 'f) fmtty =
+    | Char_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | String_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Int_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (int -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Int32_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (int32 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Nativeint_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (nativeint -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Int64_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (int64 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Float_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (float -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Bool_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (bool -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Format_arg_ty :
+        ('x, 'b, 'c, 'q, 'r, 'u) fmtty * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (('x, 'b, 'c, 'q, 'r, 'u) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Format_subst_ty :
+        ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+        ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+        ('u, 'b, 'c, 'q1, 'e1, 'f) fmtty ->
+          (('x, 'b, 'c, 'd2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmtty
+    | Alpha_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Theta_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmtty
+    | Reader_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmtty
+    | Ignored_reader_ty :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          ('a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmtty
+    | End_of_fmtty :
+          ('f, 'b, 'c, 'd, 'd, 'f) fmtty
+
+  and ('a, 'b, 'c, 'd, 'e, 'f) fmt =
+    | Char :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Caml_char :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (char -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | String :
+        ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Caml_string :
+        ('x, string -> 'a) padding * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Int :
+        int_conv * ('x, 'y) padding * ('y, int -> 'a) precision *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Int32 :
+        int_conv * ('x, 'y) padding * ('y, int32 -> 'a) precision *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Nativeint :
+        int_conv * ('x, 'y) padding * ('y, nativeint -> 'a) precision *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Int64 :
+        int_conv * ('x, 'y) padding * ('y, int64 -> 'a) precision *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Float :
+        float_conv * ('x, 'y) padding * ('y, float -> 'a) precision *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x, 'b, 'c, 'd, 'e, 'f) fmt
+    | Bool :
+        ('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 :
+        string * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Char_literal :
+        char * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Format_arg :
+        int option * ('x, 'b, 'c, 'q, 'r, 'u) fmtty *
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (('x, 'b, 'c, 'q, 'r, 'u) format6 -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Format_subst :
+        int option * ('d1, 'q1, 'd2, 'q2) reader_nb_unifier *
+        ('x, 'b, 'c, 'd1, 'q1, 'u) fmtty *
+        ('u, 'b, 'c, 'q1, 'e1, 'f) fmt ->
+          (('x,'b,'c,'d2, 'q2, 'u) format6 -> 'x, 'b, 'c, 'd1, 'e1, 'f) fmt
+    | Alpha :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (('b -> 'x -> 'c) -> 'x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Theta :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (('b -> 'c) -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Formatting :
+        formatting * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Reader :
+        ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          ('x -> 'a, 'b, 'c, ('b -> 'x) -> 'd, 'e, 'f) fmt
+    | Scan_char_set :
+        int option * char_set * ('a, 'b, 'c, 'd, 'e, 'f) fmt ->
+          (string -> 'a, 'b, 'c, 'd, 'e, 'f) fmt
+    | Scan_get_counter :
+        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 :
+          ('f, 'b, 'c, 'e, 'e, 'f) fmt
+
+  and ('a, 'b, 'c, 'd, 'e, 'f) ignored =
+    | Ignored_char :
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_caml_char :
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_string :
+        int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_caml_string :
+        int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_int :
+        int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_int32 :
+        int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_nativeint :
+        int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_int64 :
+        int_conv * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_float :
+        int option * int option -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_bool :
+        ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_format_arg :
+        int option * ('x, 'b, 'c, 'y, 'z, 't) fmtty ->
+          ('a, 'b, 'c, 'd, 'd, 'a) ignored
+    | Ignored_format_subst :
+        int option * ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+          ('a, 'b, 'c, 'd, 'e, 'f) ignored
+    | Ignored_reader :
+        ('a, 'b, 'c, ('b -> 'x) -> 'd, 'd, 'a) ignored
+    | Ignored_scan_char_set :
+        int option * char_set -> ('a, 'b, 'c, 'd, 'd, 'a) ignored
+
+  and ('a, 'b, 'c, 'd, 'e, 'f) format6 = ('a, 'b, 'c, 'd, 'e, 'f) fmt * string
+
+  val concat_fmtty :
+      ('a, 'b, 'c, 'd, 'e, 'f) fmtty ->
+      ('f, 'b, 'c, 'e, 'g, 'h) fmtty ->
+      ('a, 'b, 'c, 'd, 'g, 'h) 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
+
+  val create_char_set : unit -> string
+  val is_in_char_set : string -> char -> bool
+  val add_in_char_set : string -> char -> unit
+  val rev_char_set : string -> string
+
+  val reader_nb_unifier_of_fmtty :
+     ('a, 'b, 'c, 'd, 'e, 'f) fmtty -> ('d, 'e, 'd, 'e) reader_nb_unifier
+
+  type ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb = Param_format_EBB :
+       ('x -> 'a, 'b, 'c, 'd, 'e, 'f) fmt ->
+       ('a, 'b, 'c, 'd, 'e, 'f) param_format_ebb
+
+  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
+end
+
 (** Format strings have a general and highly polymorphic type
-    [('a, 'b, 'c, 'd, 'e, 'f) format6]. Type [format6] is built in.
+    [('a, 'b, 'c, 'd, 'e, 'f) format6].
     The two simplified types, [format] and [format4] below are
     included for backward compatibility with earlier releases of
     OCaml.
@@ -1006,6 +1244,10 @@ external decr : int ref -> unit = "%decr"
       for the [scanf]-style functions, it is typically the result type of the
       receiver function.
 *)
+
+(*type ('a, 'b, 'c, 'd, 'e, 'f) format6 =
+  ('a, 'b, 'c, 'd, 'e, 'f) CamlinternalFormatBasics.format6*)
+
 type ('a, 'b, 'c, 'd) format4 = ('a, 'b, 'c, 'c, 'c, 'd) format6
 
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4