309

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

33 files changed, 1281 insertions, 808 deletions

diff --git a/README.win32 b/README.win32
index 87b9448a01..7263035e9a 100644
--- a/README.win32
+++ b/README.win32
@@ -168,6 +168,12 @@ The native-code compiler (ocamlopt), as well as static linking of
 Caml bytecode with C code (ocamlc -custom), require 
 the Cygwin development tools, available at
         http://sources.redhat.com/cygwin/
+You will need to install at least the following Cygwin packages:
+binutils, gcc-core, gcc-mingw-core, mingw-runtime, w32-api.
+
+Do *not* install the Mingw/MSYS development tools from www.mingw.org:
+these are not compatible with this Caml port (@responsefile not
+recognized on the command line).
 
 The LablTk GUI requires Tcl/Tk 8.3.  Windows binaries are
 available from http://prdownloads.sourceforge.net/tcl/tcl832.exe.
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 6ba575b4df..96b3f4fa16 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -301,7 +301,7 @@ let bigarray_set arr arg newval =
 %token LOC
 %token REPLY
 %token SPAWN
-%token NULLP
+
 
 /* Precedences and associativities.
 
@@ -810,8 +810,6 @@ let_pattern:
 expr:
     simple_expr %prec below_SHARP
       { $1 }
-  | NULLP LPAREN RPAREN
-      { mkexp(Pexp_null) }
   | simple_expr simple_labeled_expr_list
       { mkexp(Pexp_apply($1, List.rev $2)) }
   | LET rec_flag let_bindings IN seq_expr
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index b3d7f1cba1..aa1566722c 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -159,8 +159,10 @@ and type_declaration =
 
 and type_kind =
     Ptype_abstract
-  | Ptype_variant of (string * core_type list) list * private_flag
-  | Ptype_record of (string * mutable_flag * core_type) list * private_flag
+  | Ptype_variant of (string * core_type list * Location.t) list * private_flag
+  | Ptype_record of
+      (string * mutable_flag * core_type * Location.t) list * private_flag
+  | Ptype_private
 
 and exception_declaration = core_type list
 
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 165e9eef7a..9e5617f8a0 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -389,10 +389,12 @@ and type_kind i ppf x =
       line i ppf "Ptype_abstract\n"
   | Ptype_variant (l, priv) ->
       line i ppf "Ptype_variant %a\n" fmt_private_flag priv;
-      list (i+1) string_x_core_type_list ppf l;
+      list (i+1) string_x_core_type_list_x_location ppf l;
   | Ptype_record (l, priv) ->
       line i ppf "Ptype_record %a\n" fmt_private_flag priv;
-      list (i+1) string_x_mutable_flag_x_core_type ppf l;
+      list (i+1) string_x_mutable_flag_x_core_type_x_location ppf l;
+  | Ptype_private ->
+      line i ppf "Ptype_private\n"
 
 and exception_declaration i ppf x = list i core_type ppf x
 
@@ -691,11 +693,11 @@ and core_type_x_core_type_x_location i ppf (ct1, ct2, l) =
   core_type (i+1) ppf ct1;
   core_type (i+1) ppf ct2;
 
-and string_x_core_type_list i ppf (s, l) =
+and string_x_core_type_list_x_location i ppf (s, l, loc) =
   string i ppf s;
   list (i+1) core_type ppf l;
 
-and string_x_mutable_flag_x_core_type i ppf (s, mf, ct) =
+and string_x_mutable_flag_x_core_type_x_location i ppf (s, mf, ct, loc) =
   line i ppf "\"%s\" %a\n" s fmt_mutable_flag mf;
   core_type (i+1) ppf ct;
 
diff --git a/stdlib/.depend b/stdlib/.depend
index 2423d4d2b9..ba9daffa1b 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -1,3 +1,4 @@
+camlinternalMod.cmi: obj.cmi 
 camlinternalOO.cmi: obj.cmi 
 format.cmi: buffer.cmi 
 genlex.cmi: stream.cmi 
@@ -9,14 +10,16 @@ random.cmi: nativeint.cmi int64.cmi int32.cmi
 weak.cmi: hashtbl.cmi 
 arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi 
 arg.cmx: sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx arg.cmi 
-arrayLabels.cmo: array.cmi arrayLabels.cmi 
-arrayLabels.cmx: array.cmx arrayLabels.cmi 
 array.cmo: array.cmi 
 array.cmx: array.cmi 
+arrayLabels.cmo: array.cmi arrayLabels.cmi 
+arrayLabels.cmx: array.cmx arrayLabels.cmi 
 buffer.cmo: sys.cmi string.cmi buffer.cmi 
 buffer.cmx: sys.cmx string.cmx buffer.cmi 
 callback.cmo: obj.cmi callback.cmi 
 callback.cmx: obj.cmx callback.cmi 
+camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi 
+camlinternalMod.cmx: obj.cmx camlinternalOO.cmx array.cmx camlinternalMod.cmi 
 camlinternalOO.cmo: sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \
     array.cmi camlinternalOO.cmi 
 camlinternalOO.cmx: sys.cmx string.cmx obj.cmx map.cmx list.cmx char.cmx \
@@ -47,10 +50,10 @@ lazy.cmo: obj.cmi lazy.cmi
 lazy.cmx: obj.cmx lazy.cmi 
 lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi 
 lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi 
-listLabels.cmo: list.cmi listLabels.cmi 
-listLabels.cmx: list.cmx listLabels.cmi 
 list.cmo: list.cmi 
 list.cmx: list.cmi 
+listLabels.cmo: list.cmi listLabels.cmi 
+listLabels.cmx: list.cmx listLabels.cmi 
 map.cmo: map.cmi 
 map.cmx: map.cmi 
 marshal.cmo: string.cmi marshal.cmi 
@@ -91,10 +94,10 @@ stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi
 stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi 
 stream.cmo: string.cmi obj.cmi list.cmi stream.cmi 
 stream.cmx: string.cmx obj.cmx list.cmx stream.cmi 
-stringLabels.cmo: string.cmi stringLabels.cmi 
-stringLabels.cmx: string.cmx stringLabels.cmi 
 string.cmo: pervasives.cmi list.cmi char.cmi string.cmi 
 string.cmx: pervasives.cmx list.cmx char.cmx string.cmi 
+stringLabels.cmo: string.cmi stringLabels.cmi 
+stringLabels.cmx: string.cmx stringLabels.cmi 
 sys.cmo: sys.cmi 
 sys.cmx: sys.cmi 
 weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi 
diff --git a/stdlib/Compflags b/stdlib/Compflags
index 697f38dcab..862a1c4e1e 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -18,6 +18,7 @@ case $1 in
   pervasives.cm[iox]|pervasives.p.cmx) echo ' -nopervasives';;
   camlinternalOO.cmi) echo ' -nopervasives';;
   camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';;
+  scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
   arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
   listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';;
   stringLabels.cm[ox]|stringLabels.p.cmx) echo ' -nolabels';;
diff --git a/stdlib/Makefile b/stdlib/Makefile
index cf2127f6cf..8817d56901 100644
--- a/stdlib/Makefile
+++ b/stdlib/Makefile
@@ -32,7 +32,8 @@ OTHERS=array.cmo list.cmo char.cmo string.cmo sys.cmo \
   set.cmo map.cmo stack.cmo queue.cmo stream.cmo buffer.cmo \
   printf.cmo format.cmo scanf.cmo \
   arg.cmo printexc.cmo gc.cmo \
-  digest.cmo random.cmo callback.cmo camlinternalOO.cmo oo.cmo \
+  digest.cmo random.cmo callback.cmo \
+  camlinternalOO.cmo oo.cmo camlinternalMod.cmo \
   genlex.cmo weak.cmo \
   lazy.cmo filename.cmo complex.cmo \
   arrayLabels.cmo listLabels.cmo stringLabels.cmo moreLabels.cmo stdLabels.cmo
diff --git a/stdlib/StdlibModules b/stdlib/StdlibModules
index 7b068c4577..f9fec2d962 100644
--- a/stdlib/StdlibModules
+++ b/stdlib/StdlibModules
@@ -8,6 +8,7 @@ STDLIB_MODULES=\
   arrayLabels \
   buffer \
   callback \
+  camlinternalMod \
   camlinternalOO \
   char \
   complex \
diff --git a/stdlib/array.ml b/stdlib/array.ml
index 0b021918fe..4eb0cadf22 100644
--- a/stdlib/array.ml
+++ b/stdlib/array.ml
@@ -29,7 +29,7 @@ let init l f =
    for i = 1 to pred l do
      unsafe_set res i (f i)
    done;
-   res 
+   res
 
 let make_matrix sx sy init =
   let res = create sx [||] in
@@ -54,8 +54,8 @@ let append a1 a2 =
   let l1 = length a1 and l2 = length a2 in
   if l1 = 0 && l2 = 0 then [||] else begin
     let r = create (l1 + l2) (unsafe_get (if l1 > 0 then a1 else a2) 0) in
-    for i = 0 to l1 - 1 do unsafe_set r i (unsafe_get a1 i) done;  
-    for i = 0 to l2 - 1 do unsafe_set r (i + l1) (unsafe_get a2 i) done;  
+    for i = 0 to l1 - 1 do unsafe_set r i (unsafe_get a1 i) done;
+    for i = 0 to l2 - 1 do unsafe_set r (i + l1) (unsafe_get a2 i) done;
     r
   end
 
@@ -67,7 +67,7 @@ let concat_aux init al =
   let res = create (size 0 al) init in
   let rec fill pos = function
     | [] -> ()
-    | h::t -> 
+    | h::t ->
         for i = 0 to length h - 1 do
           unsafe_set res (pos + i) (unsafe_get h i);
         done;
diff --git a/stdlib/array.mli b/stdlib/array.mli
index 4712d8bf60..579ab4ac51 100644
--- a/stdlib/array.mli
+++ b/stdlib/array.mli
@@ -34,7 +34,7 @@ external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
 
    Raise [Invalid_argument "index out of bounds"]
    if [n] is outside the range 0 to [Array.length a - 1]. *)
-        
+
 external make : int -> 'a -> 'a array = "caml_make_vect"
 (** [Array.make n x] returns a fresh array of length [n],
    initialized with [x].
diff --git a/stdlib/camlinternalMod.ml b/stdlib/camlinternalMod.ml
index f41aef7b63..46281c0f3d 100644
--- a/stdlib/camlinternalMod.ml
+++ b/stdlib/camlinternalMod.ml
@@ -57,4 +57,4 @@ let rec update_mod shape o n =
       assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
       for i = 0 to Array.length comps - 1 do
         update_mod comps.(i) (Obj.field o i) (Obj.field n i)
-      done
+      done      
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index fff08b49f5..693c1cf3b7 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -120,7 +120,10 @@ let dummy_table =
 
 let table_count = ref 0
 
-let null_item : item = Obj.obj (Obj.field (Obj.repr 0n) 1)
+(* dummy_met should be a pointer, so use an atom *)
+let dummy_met : item = obj (Obj.new_block 0 0)
+(* if debugging is needed, this could be a good idea: *)
+(* let dummy_met () = failwith "Undefined method" *)
 
 let rec fit_size n =
   if n <= 2 then n else
@@ -129,7 +132,7 @@ let rec fit_size n =
 let new_table pub_labels =
   incr table_count;
   let len = Array.length pub_labels in
-  let methods = Array.create (len*2+2) null_item in
+  let methods = Array.create (len*2+2) dummy_met in
   methods.(0) <- magic len;
   methods.(1) <- magic (fit_size len * Sys.word_size / 8 - 1);
   for i = 0 to len - 1 do methods.(i*2+3) <- magic pub_labels.(i) done;
@@ -145,7 +148,7 @@ let new_table pub_labels =
 let resize array new_size =
   let old_size = Array.length array.methods in
   if new_size > old_size then begin
-    let new_buck = Array.create new_size null_item in
+    let new_buck = Array.create new_size dummy_met in
     Array.blit array.methods 0 new_buck 0 old_size;
     array.methods <- new_buck
  end
@@ -256,12 +259,19 @@ let new_variable table name =
   table.vars <- Vars.add name index table.vars;
   index
 
-let new_variables table names =
-  let index = new_variable table names.(0) in
-  for i = 1 to Array.length names - 1 do
-    ignore (new_variable table names.(i))
+let to_array arr =
+  if arr = Obj.magic 0 then [||] else arr
+
+let new_methods_variables table meths vals =
+  let meths = to_array meths in
+  let nmeths = Array.length meths and nvals = Array.length vals in
+  let index = new_variable table vals.(0) in
+  let res = Array.create (nmeths + 1) index in
+  for i = 1 to nvals - 1 do ignore (new_variable table vals.(i)) done;
+  for i = 0 to nmeths - 1 do
+    res.(i+1) <- get_method_label table meths.(i)
   done;
-  index
+  res
 
 let get_variable table name =
   Vars.find name table.vars
@@ -305,7 +315,9 @@ let inherits cla vals virt_meths concr_meths (_, super, _, env) top =
   let init =
     if top then super cla env else Obj.repr (super cla) in
   widen cla;
-  init
+  (init, Array.map (get_variable cla) (to_array vals),
+   Array.map (fun nm -> get_method cla (get_method_label cla nm))
+     (to_array concr_meths))
 
 let make_class pub_meths class_init =
   let table = create_table pub_meths in
@@ -322,6 +334,10 @@ let make_class_store pub_meths class_init init_table =
   init_table.class_init <- class_init;
   init_table.env_init <- env_init
 
+let dummy_class loc =
+  let undef = fun _ -> raise (Undefined_recursive_module loc) in
+  (Obj.magic undef, undef, undef, Obj.repr 0)
+
 (**** Objects ****)
 
 let create_object table =
@@ -437,14 +453,14 @@ let app_const_env f x e n =
 let app_env_const f e n x =
   ret (fun obj ->
     f (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) n) x)
-let meth_app_const n x = ret (fun obj -> (sendself obj n) x)
+let meth_app_const n x = ret (fun obj -> (sendself obj n : _ -> _) x)
 let meth_app_var n m =
-  ret (fun obj -> (sendself obj n) (Array.unsafe_get obj m))
+  ret (fun obj -> (sendself obj n : _ -> _) (Array.unsafe_get obj m))
 let meth_app_env n e m =
-  ret (fun obj -> (sendself obj n)
+  ret (fun obj -> (sendself obj n : _ -> _)
       (Array.unsafe_get (Obj.magic (Array.unsafe_get obj e) : obj) m))
 let meth_app_meth n m =
-  ret (fun obj -> (sendself obj n) (sendself obj m))
+  ret (fun obj -> (sendself obj n : _ -> _) (sendself obj m))
 let send_const m x c =
   ret (fun obj -> sendcache x m (Array.unsafe_get obj 0) c)
 let send_var m n c =
diff --git a/stdlib/camlinternalOO.mli b/stdlib/camlinternalOO.mli
index 8b6c980f6a..51b84871a4 100644
--- a/stdlib/camlinternalOO.mli
+++ b/stdlib/camlinternalOO.mli
@@ -29,7 +29,8 @@ type closure
 val public_method_label : string -> tag
 val new_method : table -> label
 val new_variable : table -> string -> int
-val new_variables : table -> string array -> int
+val new_methods_variables :
+    table -> string array -> string array -> label array
 val get_variable : table -> string -> int
 val get_variables : table -> string array -> int array
 val get_method_label : table -> string -> label
@@ -45,13 +46,17 @@ val create_table : string array -> table
 val init_class : table -> unit
 val inherits :
     table -> string array -> string array -> string array ->
-    (t * (table -> obj -> Obj.t) * t * obj) -> bool -> Obj.t
+    (t * (table -> obj -> Obj.t) * t * obj) -> bool ->
+    (Obj.t * int array * closure array)
 val make_class :
     string array -> (table -> Obj.t -> t) ->
     (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
 type init_table
 val make_class_store :
     string array -> (table -> t) -> init_table -> unit
+val dummy_class :
+    string * int * int ->
+    (t * (table -> Obj.t -> t) * (Obj.t -> t) * Obj.t)
 
 (** {6 Objects} *)
 
diff --git a/stdlib/filename.ml b/stdlib/filename.ml
index afe19611ad..e655e10ca1 100644
--- a/stdlib/filename.ml
+++ b/stdlib/filename.ml
@@ -169,24 +169,20 @@ let temp_file_name prefix suffix =
 
 let temp_file prefix suffix =
   let rec try_name counter =
-    if counter >= 1000 then
-      invalid_arg "Filename.temp_file: temp dir nonexistent or full";
     let name = temp_file_name prefix suffix in
     try
       close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600);
       name
-    with Sys_error _ ->
-      try_name (counter + 1)
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
   in try_name 0
 
 let open_temp_file ?(mode = [Open_text]) prefix suffix =
   let rec try_name counter =
-    if counter >= 1000 then
-      invalid_arg "Filename.open_temp_file: temp dir nonexistent or full";
     let name = temp_file_name prefix suffix in
     try
       (name,
        open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name)
-    with Sys_error _ ->
-      try_name (counter + 1)
+    with Sys_error _ as e ->
+      if counter >= 1000 then raise e else try_name (counter + 1)
   in try_name 0
diff --git a/stdlib/format.ml b/stdlib/format.ml
index 0c345137d1..8c0ef2edad 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -19,6 +19,11 @@
 
  **************************************************************)
 
+type size;;
+
+external size_of_int : int -> size = "%identity";;
+external int_of_size : size -> int = "%identity";;
+
 (* Tokens are one of the following : *)
 
 type pp_token =
@@ -58,7 +63,9 @@ and tblock = Pp_tbox of int list ref  (* Tabulation box *)
    elements are tuples (size, token, length), where
    size is set when the size of the block is known
    len is the declared length of the token. *)
-type pp_queue_elem = {mutable elem_size : int; token : pp_token; length : int};;
+type pp_queue_elem = {
+  mutable elem_size : size; token : pp_token; length : int
+};;
 
 (* Scan stack:
    each element is (left_total, queue element) where left_total
@@ -187,20 +194,23 @@ let pp_clear_queue state =
 (* Pp_infinity: large value for default tokens size.
 
    Pp_infinity is documented as being greater than 1e10; to avoid
-   confusion about the word ``greater'' we shoose pp_infinity greater
-   than 1e10 + 1; for correct handling of tests in the algorithm
-   pp_infinity must be even one more than that; let's stand on the
+   confusion about the word ``greater'', we choose pp_infinity greater
+   than 1e10 + 1; for correct handling of tests in the algorithm,
+   pp_infinity must be even one more than 1e10 + 1; let's stand on the
    safe side by choosing 1.e10+10.
 
    Pp_infinity could probably be 1073741823 that is 2^30 - 1, that is
-   the minimal upper bound of integers; now that max_int is defined,
-   could also be defined as max_int - 1.
-
-   We must carefully double-check all the integer arithmetic
-   operations that involve pp_infinity before setting pp_infinity to
-   something around max_int: otherwise any overflow would wreck havoc
-   the pretty-printing algorithm's invariants.
-   Is it worth the burden ? *)
+   the minimal upper bound for integers; now that max_int is defined,
+   this limit could also be defined as max_int - 1.
+
+   However, before setting pp_infinity to something around max_int, we
+   must carefully double-check all the integer arithmetic operations
+   that involve pp_infinity, since any overflow would wreck havoc the
+   pretty-printing algorithm's invariants. Given that this arithmetic
+   correctness check is difficult and error prone and given that 1e10
+   + 1 is in practice large enough, there is no need to attempt to set
+   pp_infinity to the theoretically maximum limit. Is it not worth the
+   burden ! *)
 
 let pp_infinity = 1000000010;;
 
@@ -246,7 +256,7 @@ let pp_skip_token state =
     match take_queue state.pp_queue with
     {elem_size = size; length = len} ->
        state.pp_left_total <- state.pp_left_total - len;
-       state.pp_space_left <- state.pp_space_left + size;;
+       state.pp_space_left <- state.pp_space_left + int_of_size size;;
 
 (**************************************************************
 
@@ -376,6 +386,7 @@ let rec advance_left state =
     try
      match peek_queue state.pp_queue with
       {elem_size = size; token = tok; length = len} ->
+       let size = int_of_size size in
        if not
         (size < 0 &&
          (state.pp_right_total - state.pp_left_total < state.pp_space_left))
@@ -390,17 +401,24 @@ let rec advance_left state =
 let enqueue_advance state tok = pp_enqueue state tok; advance_left state;;
 
 (* To enqueue a string : try to advance. *)
-let enqueue_string_as state n s =
-    enqueue_advance state {elem_size = n; token = Pp_text s; length = n};;
+let make_queue_elem size tok len =
+ {elem_size = size; token = tok; length = len};;
+
+let enqueue_string_as state size s =
+  let len = int_of_size size in
+  enqueue_advance state (make_queue_elem size (Pp_text s) len);;
 
-let enqueue_string state s = enqueue_string_as state (String.length s) s;;
+let enqueue_string state s =
+  let len = String.length s in
+  enqueue_string_as state (size_of_int len) s;;
 
 (* Routines for scan stack
    determine sizes of blocks. *)
 
 (* The scan_stack is never empty. *)
 let scan_stack_bottom =
-    [Scan_elem (-1, {elem_size = (-1); token = Pp_text ""; length = 0})];;
+  let q_elem = make_queue_elem (size_of_int (-1)) (Pp_text "") 0 in
+  [Scan_elem (-1, q_elem)];;
 
 (* Set size of blocks on scan stack:
    if ty = true then size of break is set else size of block is set;
@@ -413,21 +431,23 @@ let clear_scan_stack state = state.pp_scan_stack <- scan_stack_bottom;;
    since scan_push is used on breaks and opening of boxes. *)
 let set_size state ty =
     match state.pp_scan_stack with
-    | Scan_elem (left_tot,
-                 ({elem_size = size; token = tok} as queue_elem)) :: t ->
+    | Scan_elem
+        (left_tot,
+         ({elem_size = size; token = tok} as queue_elem)) :: t ->
+       let size = int_of_size size in
        (* test if scan stack contains any data that is not obsolete. *)
        if left_tot < state.pp_left_total then clear_scan_stack state else
         begin match tok with
         | Pp_break (_, _) | Pp_tbreak (_, _) ->
            if ty then
             begin
-             queue_elem.elem_size <- state.pp_right_total + size;
+             queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
              state.pp_scan_stack <- t
             end
         | Pp_begin (_, _) ->
            if not ty then
             begin
-             queue_elem.elem_size <- state.pp_right_total + size;
+             queue_elem.elem_size <- size_of_int (state.pp_right_total + size);
              state.pp_scan_stack <- t
             end
         | _ -> () (* scan_push is only used for breaks and boxes. *)
@@ -447,9 +467,12 @@ let scan_push state b tok =
 let pp_open_box_gen state indent br_ty =
     state.pp_curr_depth <- state.pp_curr_depth + 1;
     if state.pp_curr_depth < state.pp_max_boxes then
-      (scan_push state false
-        {elem_size = (- state.pp_right_total);
-         token = Pp_begin (indent, br_ty); length = 0}) else
+      let elem =
+        make_queue_elem
+          (size_of_int (- state.pp_right_total))
+          (Pp_begin (indent, br_ty))
+          0 in
+      scan_push state false elem else
     if state.pp_curr_depth = state.pp_max_boxes
     then enqueue_string state state.pp_ellipsis;;
 
@@ -462,7 +485,8 @@ let pp_close_box state () =
      begin
       if state.pp_curr_depth < state.pp_max_boxes then
        begin
-        pp_enqueue state {elem_size = 0; token = Pp_end; length = 0};
+        pp_enqueue state
+          {elem_size = size_of_int 0; token = Pp_end; length = 0};
         set_size state true; set_size state false
        end;
       state.pp_curr_depth <- state.pp_curr_depth - 1;
@@ -475,12 +499,13 @@ let pp_open_tag state tag_name =
       state.pp_print_open_tag tag_name end;
     if state.pp_mark_tags then
       pp_enqueue state
-        {elem_size = 0; token = Pp_open_tag tag_name; length = 0};;
+        {elem_size = size_of_int 0; token = Pp_open_tag tag_name; length = 0};;
 
 (* Close a tag, popping it from the tag stack. *)
 let pp_close_tag state () =
     if state.pp_mark_tags then
-      pp_enqueue state {elem_size = 0; token = Pp_close_tag; length = 0};
+      pp_enqueue state
+        {elem_size = size_of_int 0; token = Pp_close_tag; length = 0};
     if state.pp_print_tags then
       begin match state.pp_tag_stack with
       | tag_name :: tags ->
@@ -543,11 +568,15 @@ let pp_flush_queue state b =
  **************************************************************)
 
 (* To format a string. *)
-let pp_print_as state n s =
+let pp_print_as_size state size s =
   if state.pp_curr_depth < state.pp_max_boxes
-  then enqueue_string_as state n s;;
+  then enqueue_string_as state size s;;
 
-let pp_print_string state s = pp_print_as state (String.length s) s;;
+let pp_print_as state isize s =
+  pp_print_as_size state (size_of_int isize) s;;
+
+let pp_print_string state s =
+  pp_print_as state (String.length s) s;;
 
 (* To format an integer. *)
 let pp_print_int state i = pp_print_string state (string_of_int i);;
@@ -560,7 +589,9 @@ let pp_print_bool state b = pp_print_string state (string_of_bool b);;
 
 (* To format a char. *)
 let pp_print_char state c =
-  let s = String.create 1 in s.[0] <- c; pp_print_as state 1 s;;
+  let s = String.create 1 in
+  s.[0] <- c;
+  pp_print_as state 1 s;;
 
 (* Opening boxes. *)
 let pp_open_hbox state () = pp_open_box_gen state 0 Pp_hbox
@@ -580,12 +611,12 @@ and pp_print_flush state () =
 (* To get a newline when one does not want to close the current block. *)
 let pp_force_newline state () =
   if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state {elem_size = 0; token = Pp_newline; length = 0};;
+    enqueue_advance state (make_queue_elem (size_of_int 0) Pp_newline 0);;
 
 (* To format something if the line has just been broken. *)
 let pp_print_if_newline state () =
   if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state {elem_size = 0; token = Pp_if_newline; length = 0};;
+    enqueue_advance state (make_queue_elem (size_of_int 0) Pp_if_newline 0);;
 
 (* Breaks: indicate where a block may be broken.
    If line is broken then offset is added to the indentation of the current
@@ -593,9 +624,12 @@ let pp_print_if_newline state () =
    To do (?) : add a maximum width and offset value. *)
 let pp_print_break state width offset =
   if state.pp_curr_depth < state.pp_max_boxes then
-    scan_push state true
-     {elem_size = (- state.pp_right_total); token = Pp_break (width, offset);
-      length = width};;
+    let elem =
+      make_queue_elem
+        (size_of_int (- state.pp_right_total))
+        (Pp_break (width, offset))
+        width in
+    scan_push state true elem;;
 
 let pp_print_space state () = pp_print_break state 1 0
 and pp_print_cut state () = pp_print_break state 0 0;;
@@ -604,29 +638,35 @@ and pp_print_cut state () = pp_print_break state 0 0;;
 let pp_open_tbox state () =
   state.pp_curr_depth <- state.pp_curr_depth + 1;
   if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state
-      {elem_size = 0;
-       token = Pp_tbegin (Pp_tbox (ref [])); length = 0};;
+    let elem =
+      make_queue_elem (size_of_int 0) (Pp_tbegin (Pp_tbox (ref []))) 0 in
+    enqueue_advance state elem;;
 
 (* Close a tabulation block. *)
 let pp_close_tbox state () =
   if state.pp_curr_depth > 1 then begin
    if state.pp_curr_depth < state.pp_max_boxes then
-    enqueue_advance state {elem_size = 0; token = Pp_tend; length = 0};
-   state.pp_curr_depth <- state.pp_curr_depth - 1 end;;
+     let elem = make_queue_elem (size_of_int 0) Pp_tend 0 in
+     enqueue_advance state elem;
+     state.pp_curr_depth <- state.pp_curr_depth - 1 end;;
 
 (* Print a tabulation break. *)
 let pp_print_tbreak state width offset =
   if state.pp_curr_depth < state.pp_max_boxes then
-    scan_push state true
-     {elem_size = (- state.pp_right_total); token = Pp_tbreak (width, offset);
-      length = width};;
+    let elem =
+      make_queue_elem
+        (size_of_int (- state.pp_right_total))
+        (Pp_tbreak (width, offset))
+        width in
+    scan_push state true elem;;
 
 let pp_print_tab state () = pp_print_tbreak state 0 0;;
 
 let pp_set_tab state () =
-  if state.pp_curr_depth < state.pp_max_boxes
-  then enqueue_advance state {elem_size = 0; token = Pp_stab; length=0};;
+  if state.pp_curr_depth < state.pp_max_boxes then
+    let elem =
+      make_queue_elem (size_of_int 0) Pp_stab 0 in
+    enqueue_advance state elem;;
 
 (**************************************************************
 
@@ -716,7 +756,7 @@ let pp_make_formatter f g h i =
  (* The initial state of the formatter contains a dummy box. *)
  let pp_q = make_queue () in
  let sys_tok =
-     {elem_size = (- 1); token = Pp_begin (0, Pp_hovbox); length = 0} in
+   make_queue_elem (size_of_int (-1)) (Pp_begin (0, Pp_hovbox)) 0 in
  add_queue sys_tok pp_q;
  let sys_scan_stack =
      (Scan_elem (1, sys_tok)) :: scan_stack_bottom in
@@ -771,10 +811,8 @@ let make_formatter f g =
 let formatter_of_out_channel oc =
   make_formatter (output oc) (fun () -> flush oc);;
 
-let unit_out ppf = ();;
-
 let formatter_of_buffer b =
-  make_formatter (Buffer.add_substring b) unit_out;;
+  make_formatter (Buffer.add_substring b) ignore;;
 
 let stdbuf = Buffer.create 512;;
 
@@ -882,7 +920,7 @@ let giving_up mess fmt i =
    then " (" ^ String.make 1 fmt.[i] ^ ")."
    else String.make 1 '.');;
 
-(* When an invalid format deserve a special error explanation. *)
+(* When an invalid format deserves a special error explanation. *)
 let format_invalid_arg mess fmt i = invalid_arg (giving_up mess fmt i);;
 
 (* Standard invalid format. *)
@@ -894,8 +932,10 @@ let invalid_integer fmt i =
 
 (* Finding an integer out of a sub-string of the format. *)
 let format_int_of_string fmt i s =
-  try int_of_string s with
-  | Failure s -> invalid_integer fmt i;;
+  let sz =
+    try int_of_string s with
+    | Failure s -> invalid_integer fmt i in
+  size_of_int sz;;
 
 (* Getting strings out of buffers. *)
 let get_buffer_out b =
@@ -923,6 +963,8 @@ let implode_rev s0 = function
   | [] -> s0
   | l -> String.concat "" (List.rev (s0 :: l));;
 
+external format_to_string : ('a, 'b, 'c, 'd) format4 -> string = "%identity";;
+
 (* [fprintf_out] is the printf-like function generator: given the
    - [str] flag that tells if we are printing into a string,
    - the [out] function that has to be called at the end of formatting,
@@ -931,201 +973,216 @@ let implode_rev s0 = function
    according to the format.
    Regular [fprintf]-like functions of this module are obtained via partial
    applications of [fprintf_out]. *)
-let fprintf_out str out ppf format =
-  let format = string_of_format format in
-  let limit = String.length format in
-
-  let print_as = ref None in
-
-  let pp_print_as_char c =
-      match !print_as with
-      | None -> pp_print_char ppf c
-      | Some size ->
-         pp_print_as ppf size (String.make 1 c);
-         print_as := None
-  and pp_print_as_string s =
-      match !print_as with
-      | None -> pp_print_string ppf s
-      | Some size ->
-         pp_print_as ppf size s;
-         print_as := None in
-
-  let rec doprn i =
-    if i >= limit then
-      Obj.magic (out ppf)
-    else
-      match format.[i] with
-      | '%' ->
-          Printf.scan_format format i cont_s cont_a cont_t cont_f
-      | '@' ->
+let mkprintf str get_out =
+  let rec kprintf k fmt =
+    let fmt = format_to_string fmt in
+    let len = String.length fmt in
+
+    let kpr fmt v =
+      let ppf = get_out fmt in
+      let print_as = ref None in
+      let pp_print_as_char c =
+          match !print_as with
+          | None -> pp_print_char ppf c
+          | Some size ->
+             pp_print_as_size ppf size (String.make 1 c);
+             print_as := None
+      and pp_print_as_string s =
+          match !print_as with
+          | None -> pp_print_string ppf s
+          | Some size ->
+             pp_print_as_size ppf size s;
+             print_as := None in
+
+      let rec doprn n i =
+        if i >= len then Obj.magic (k ppf) else
+        match fmt.[i] with
+        | '%' ->
+            Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+        | '@' ->
+            let i = succ i in
+            if i >= len then invalid_format fmt i else
+            begin match fmt.[i] with
+            | '[' ->
+               do_pp_open_box ppf n (succ i)
+            | ']' ->
+               pp_close_box ppf ();
+               doprn n (succ i)
+            | '{' ->
+               do_pp_open_tag ppf n (succ i)
+            | '}' ->
+               pp_close_tag ppf ();
+               doprn n (succ i)
+            | ' ' ->
+               pp_print_space ppf ();
+               doprn n (succ i)
+            | ',' ->
+               pp_print_cut ppf ();
+               doprn n (succ i)
+            | '?' ->
+               pp_print_flush ppf ();
+               doprn n (succ i)
+            | '.' ->
+               pp_print_newline ppf ();
+               doprn n (succ i)
+            | '\n' ->
+               pp_force_newline ppf ();
+               doprn n (succ i)
+            | ';' ->
+               do_pp_break ppf n (succ i)
+            | '<' ->
+               let got_size size n i =
+                 print_as := Some size;
+                 doprn n (skip_gt i) in
+               get_int n (succ i) got_size
+            | '@' as c ->
+               pp_print_as_char c;
+               doprn n (succ i)
+            | c -> invalid_format fmt i
+            end
+        | c ->
+           pp_print_as_char c;
+           doprn n (succ i)
+
+      and cont_s n s i =
+        pp_print_as_string s; doprn n i
+      and cont_a n printer arg i =
+        if str then
+          pp_print_as_string ((Obj.magic printer : unit -> _ -> string) () arg)
+        else
+          printer ppf arg;
+        doprn n i
+      and cont_t n printer i =
+        if str then
+          pp_print_as_string ((Obj.magic printer : unit -> string) ())
+        else
+          printer ppf;
+        doprn n i
+      and cont_f n i =
+        pp_print_flush ppf (); doprn n i
+
+      and cont_m n sfmt i =
+        kprintf (Obj.magic (fun _ -> doprn n i)) sfmt
+
+      and get_int n i c =
+       if i >= len then invalid_integer fmt i else
+       match fmt.[i] with
+       | ' ' -> get_int n (succ i) c
+       | '%' ->
+          let cont_s n s i = c (format_int_of_string fmt i s) n i
+          and cont_a n printer arg i = invalid_integer fmt i
+          and cont_t n printer i = invalid_integer fmt i
+          and cont_f n i = invalid_integer fmt i
+          and cont_m n sfmt i = invalid_integer fmt i in
+          Printf.scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+       | _ ->
+          let rec get j =
+           if j >= len then invalid_integer fmt j else
+           match fmt.[j] with
+           | '0' .. '9' | '-' -> get (succ j)
+           | _ ->
+             let size =
+             if j = i then size_of_int 0 else
+                format_int_of_string fmt j (String.sub fmt i (j - i)) in
+             c size n j in
+          get i
+
+      and skip_gt i =
+       if i >= len then invalid_format fmt i else
+       match fmt.[i] with
+       | ' ' -> skip_gt (succ i)
+       | '>' -> succ i
+       | _ -> invalid_format fmt i
+
+      and get_box_kind i =
+       if i >= len then Pp_box, i else
+       match fmt.[i] with
+       | 'h' ->
           let i = succ i in
-          if i >= limit then invalid_format format i else
-          begin match format.[i] with
-          | '[' ->
-              do_pp_open_box ppf (succ i)
-          | ']' ->
-              pp_close_box ppf ();
-              doprn (succ i)
-          | '{' ->
-              do_pp_open_tag ppf (succ i)
-          | '}' ->
-              pp_close_tag ppf ();
-              doprn (succ i)
-          | ' ' ->
-              pp_print_space ppf ();
-              doprn (succ i)
-          | ',' ->
-              pp_print_cut ppf ();
-              doprn (succ i)
-          | '?' ->
-              pp_print_flush ppf ();
-              doprn (succ i)
-          | '.' ->
-              pp_print_newline ppf ();
-              doprn (succ i)
-          | '\n' ->
-              pp_force_newline ppf ();
-              doprn (succ i)
-          | ';' ->
-              do_pp_break ppf (succ i)
-          | '<' ->
-              let got_size size i =
-                print_as := Some size;
-                doprn (skip_gt i) in
-              get_int (succ i) got_size
-          | '@' as c ->
-              pp_print_as_char c;
-              doprn (succ i)
-          | c -> invalid_format format i
+          if i >= len then Pp_hbox, i else
+          begin match fmt.[i] with
+          | 'o' ->
+             let i = succ i in
+             if i >= len then format_invalid_arg "bad box format" fmt i else
+             begin match fmt.[i] with
+             | 'v' -> Pp_hovbox, succ i
+             | c ->
+                format_invalid_arg
+                  ("bad box name ho" ^ String.make 1 c) fmt i end
+          | 'v' -> Pp_hvbox, succ i
+          | c -> Pp_hbox, i
           end
-      | c ->
-         pp_print_as_char c;
-         doprn (succ i)
-
-  and cont_s s i =
-    pp_print_as_string s; doprn i
-  and cont_a printer arg i =
-    if str then
-      pp_print_as_string ((Obj.magic printer) () arg)
-    else
-      printer ppf arg;
-    doprn i
-  and cont_t printer i =
-    if str then
-      pp_print_as_string ((Obj.magic printer) ())
-    else
-      printer ppf;
-    doprn i
-  and cont_f i =
-    pp_print_flush ppf (); doprn i
-
-  and get_int i c =
-   if i >= limit then invalid_integer format i else
-   match format.[i] with
-   | ' ' -> get_int (succ i) c
-   | '%' ->
-      let cont_s s i = c (format_int_of_string format i s) i
-      and cont_a printer arg i = invalid_integer format i
-      and cont_t printer i = invalid_integer format i
-      and cont_f i = invalid_integer format i in
-      Printf.scan_format format i cont_s cont_a cont_t cont_f
-   | _ ->
-      let rec get j =
-       if j >= limit then invalid_integer format j else
-       match format.[j] with
-       | '0' .. '9' | '-' -> get (succ j)
-       | _ ->
-         if j = i then c 0 j else
-         c (format_int_of_string format j (String.sub format i (j - i))) j in
-      get i
-
-  and skip_gt i =
-   if i >= limit then invalid_format format i else
-   match format.[i] with
-   | ' ' -> skip_gt (succ i)
-   | '>' -> succ i
-   | _ -> invalid_format format i
-
-  and get_box_kind i =
-   if i >= limit then Pp_box, i else
-   match format.[i] with
-   | 'h' ->
-      let i = succ i in
-      if i >= limit then Pp_hbox, i else
-      begin match format.[i] with
-      | 'o' ->
-         let i = succ i in
-         if i >= limit then format_invalid_arg "bad box format" format i else
-         begin match format.[i] with
-         | 'v' -> Pp_hovbox, succ i
-         | c ->
-            format_invalid_arg
-              ("bad box name ho" ^ String.make 1 c) format i end
-      | 'v' -> Pp_hvbox, succ i
-      | c -> Pp_hbox, i
-      end
-   | 'b' -> Pp_box, succ i
-   | 'v' -> Pp_vbox, succ i
-   | _ -> Pp_box, i
-
-  and get_tag_name i c =
-   let rec get accu i j =
-    if j >= limit
-    then c (implode_rev (String.sub format i (j - i)) accu) j else
-    match format.[j] with
-    | '>' -> c (implode_rev (String.sub format i (j - i)) accu) j
-    | '%' ->
-       let s0 = String.sub format i (j - i) in
-       let cont_s s i = get (s :: s0 :: accu) i i
-       and cont_a printer arg i =
-         let s =
-           if str then (Obj.magic printer) () arg else exstring printer arg in
-         get (s :: s0 :: accu) i i
-       and cont_t printer i =
-         let s =
-           if str then (Obj.magic printer) ()
-           else exstring (fun ppf () -> printer ppf) () in
-         get (s :: s0 :: accu) i i
-       and cont_f i =
-         format_invalid_arg "bad tag name specification" format i in
-       Printf.scan_format format j cont_s cont_a cont_t cont_f
-    | c -> get accu i (succ j) in
-   get [] i i
-
-  and do_pp_break ppf i =
-   if i >= limit then begin pp_print_space ppf (); doprn i end else
-   match format.[i] with
-   | '<' ->
-       let rec got_nspaces nspaces i =
-         get_int i (got_offset nspaces)
-       and got_offset nspaces offset i =
-         pp_print_break ppf nspaces offset;
-         doprn (skip_gt i) in
-       get_int (succ i) got_nspaces
-   | c -> pp_print_space ppf (); doprn i
-
-  and do_pp_open_box ppf i =
-   if i >= limit then begin pp_open_box_gen ppf 0 Pp_box; doprn i end else
-   match format.[i] with
-   | '<' ->
-     let kind, i = get_box_kind (succ i) in
-     let got_size size i =
-       pp_open_box_gen ppf size kind;
-       doprn (skip_gt i) in
-     get_int i got_size
-   | c -> pp_open_box_gen ppf 0 Pp_box; doprn i
-
-  and do_pp_open_tag ppf i =
-   if i >= limit then begin pp_open_tag ppf ""; doprn i end else
-   match format.[i] with
-   | '<' ->
-     let got_name tag_name i =
-       pp_open_tag ppf tag_name;
-       doprn (skip_gt i) in
-     get_tag_name (succ i) got_name
-   | c -> pp_open_tag ppf ""; doprn i in
-
-  doprn 0;;
+       | 'b' -> Pp_box, succ i
+       | 'v' -> Pp_vbox, succ i
+       | _ -> Pp_box, i
+
+      and get_tag_name n i c =
+       let rec get accu n i j =
+        if j >= len
+        then c (implode_rev (String.sub fmt i (j - i)) accu) n j else
+        match fmt.[j] with
+        | '>' -> c (implode_rev (String.sub fmt i (j - i)) accu) n j
+        | '%' ->
+          let s0 = String.sub fmt i (j - i) in
+          let cont_s n s i = get (s :: s0 :: accu) n i i
+          and cont_a n printer arg i =
+            let s =
+              if str
+              then (Obj.magic printer : unit -> _ -> string) () arg
+              else exstring printer arg in
+            get (s :: s0 :: accu) n i i
+          and cont_t n printer i =
+            let s =
+              if str
+              then (Obj.magic printer : unit -> string) ()
+              else exstring (fun ppf () -> printer ppf) () in
+            get (s :: s0 :: accu) n i i
+          and cont_f n i =
+            format_invalid_arg "bad tag name specification" fmt i
+          and cont_m n sfmt i =
+            format_invalid_arg "bad tag name specification" fmt i in
+          Printf.scan_format fmt v n j cont_s cont_a cont_t cont_f cont_m
+        | c -> get accu n i (succ j) in
+       get [] n i i
+
+      and do_pp_break ppf n i =
+       if i >= len then begin pp_print_space ppf (); doprn n i end else
+       match fmt.[i] with
+       | '<' ->
+          let rec got_nspaces nspaces n i =
+            get_int n i (got_offset nspaces)
+          and got_offset nspaces offset n i =
+            pp_print_break ppf (int_of_size nspaces) (int_of_size offset);
+            doprn n (skip_gt i) in
+          get_int n (succ i) got_nspaces
+       | c -> pp_print_space ppf (); doprn n i
+
+      and do_pp_open_box ppf n i =
+       if i >= len then begin pp_open_box_gen ppf 0 Pp_box; doprn n i end else
+       match fmt.[i] with
+       | '<' ->
+          let kind, i = get_box_kind (succ i) in
+          let got_size size n i =
+            pp_open_box_gen ppf (int_of_size size) kind;
+            doprn n (skip_gt i) in
+          get_int n i got_size
+       | c -> pp_open_box_gen ppf 0 Pp_box; doprn n i
+
+      and do_pp_open_tag ppf n i =
+       if i >= len then begin pp_open_tag ppf ""; doprn n i end else
+       match fmt.[i] with
+       | '<' ->
+          let got_name tag_name n i =
+            pp_open_tag ppf tag_name;
+            doprn n (skip_gt i) in
+          get_tag_name n (succ i) got_name
+       | c -> pp_open_tag ppf ""; doprn n i in
+
+      doprn (Printf.index_of_int 0) 0 in
+
+   Printf.kapr kpr fmt in
+
+  kprintf;;
 
 (**************************************************************
 
@@ -1133,22 +1190,24 @@ let fprintf_out str out ppf format =
 
  **************************************************************)
 
-let kfprintf k = fprintf_out false k;;
-let fprintf ppf = kfprintf unit_out ppf;;
-let printf f = fprintf std_formatter f;;
-let eprintf f = fprintf err_formatter f;;
+let kfprintf k ppf = mkprintf false (fun _ -> ppf) k;;
 
-let bprintf b =
- let ppf = formatter_of_buffer b in
- kfprintf (fun ppf -> pp_flush_queue ppf false) ppf;;
+let fprintf ppf = kfprintf ignore ppf;;
+let printf fmt = fprintf std_formatter fmt;;
+let eprintf fmt = fprintf err_formatter fmt;;
 
-let ksprintf k =
- let b = Buffer.create 512 in
- let ppf = formatter_of_buffer b in
- fprintf_out true (fun ppf -> k (string_out b ppf)) ppf;;
+let kbprintf k b =
+  mkprintf false (fun _ -> formatter_of_buffer b) k;;
 
-let sprintf f = ksprintf (fun s -> s) f;;
+let bprintf b = kbprintf ignore b;;
+
+let ksprintf k =
+  let b = Buffer.create 512 in
+  let k ppf = k (string_out b ppf) in
+  mkprintf true (fun _ -> formatter_of_buffer b) k;;
 
 let kprintf = ksprintf;;
 
+let sprintf fmt = ksprintf (fun s -> s) fmt;;
+
 at_exit print_flush;;
diff --git a/stdlib/format.mli b/stdlib/format.mli
index 09f9badf18..1810061435 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -20,8 +20,9 @@
    at specified break hints, and indents lines according to the box
    structure.
 
-   For a gentle introduction to the basics of prety-printing using
-   [Format], read the FAQ at [http://caml.inria.fr/FAQ/format-eng.html]. 
+   For a gentle introduction to the basics of pretty-printing using
+   [Format], read
+   {{:http://caml.inria.fr/resources/doc/guides/format.html}http://caml.inria.fr/resources/doc/guides/format.html}.
 
    Warning: the material output by the following functions is delayed
    in the pretty-printer queue in order to compute the proper line
@@ -41,7 +42,7 @@
    provided by this module. This style is more basic but more verbose
    than the [fprintf] concise formats.
 
-   For instance, the sequence 
+   For instance, the sequence
    [open_box 0; print_string "x ="; print_space (); print_int 1; close_box ()]
    that prints [x = 1] within a pretty-printing box, can be
    abbreviated as [printf "@[%s@ %i@]" "x =" 1], or even shorter
@@ -116,14 +117,14 @@ val print_bool : bool -> unit;;
 
 val print_space : unit -> unit;;
 (** [print_space ()] is used to separate items (typically to print
-   a space between two words). 
+   a space between two words).
    It indicates that the line may be split at this
    point. It either prints one space or splits the line.
    It is equivalent to [print_break 1 0]. *)
 
 val print_cut : unit -> unit;;
 (** [print_cut ()] is used to mark a good break position.
-   It indicates that the line may be split at this 
+   It indicates that the line may be split at this
    point. It either prints nothing or splits the line.
    This allows line splitting at the current
    point, without printing spaces or adding indentation.
@@ -134,7 +135,7 @@ val print_break : int -> int -> unit;;
    [print_break nspaces offset] indicates that the line may
    be split (a newline character is printed) at this point,
    if the contents of the current box does not fit on the
-   current line. 
+   current line.
    If the line is split at that point, [offset] is added to
    the current indentation. If the line is not split,
    [nspaces] spaces are printed. *)
@@ -569,7 +570,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
    - [@\[]: open a pretty-printing box. The type and offset of the
      box may be optionally specified with the following syntax:
      the [<] character, followed by an optional box type indication,
-     then an optional integer offset, and the closing [>] character. 
+     then an optional integer offset, and the closing [>] character.
      Box type is one of [h], [v], [hv], [b], or [hov],
      which stand respectively for an horizontal box, a vertical box,
      an ``horizontal-vertical'' box, or an ``horizontal or
@@ -586,7 +587,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
    - [@\n]: force a newline, as with [force_newline ()].
    - [@;]: output a good break as with [print_break]. The
      [nspaces] and [offset] parameters of the break may be
-     optionally specified with the following syntax: 
+     optionally specified with the following syntax:
      the [<] character, followed by an integer [nspaces] value,
      then an integer offset, and a closing [>] character.
      If no parameters are provided, the good break defaults to a
@@ -612,7 +613,7 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
    - [@\}]: close the most recently opened tag.
    - [@@]: print a plain [@] character.
 
-   Example: [printf "@[%s@ %d@]" "x =" 1] is equivalent to 
+   Example: [printf "@[%s@ %d@]" "x =" 1] is equivalent to
    [open_box (); print_string "x ="; print_space (); print_int 1; close_box ()].
    It prints [x = 1] within a pretty-printing box.
 *)
@@ -659,4 +660,4 @@ val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
    passes it to the first argument. *)
 
 val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
-(** A deprecated synonym for ksprintf. *)
+(** A deprecated synonym for [ksprintf]. *)
diff --git a/stdlib/gc.mli b/stdlib/gc.mli
index bafa8ed9f7..c02695d4ae 100644
--- a/stdlib/gc.mli
+++ b/stdlib/gc.mli
@@ -127,7 +127,10 @@ type control =
        relevant to the byte-code runtime, as the native code runtime
        uses the operating system's stack.  Default: 256k. *) 
 }
-(** The GC parameters are given as a [control] record. *)
+(** The GC parameters are given as a [control] record.  Note that
+    these parameters can also be initialised by setting the
+    OCAMLRUNPARAM environment variable.  See the documentation of
+    ocamlrun. *)
 
 external stat : unit -> stat = "caml_gc_stat"
 (** Return the current values of the memory management counters in a
diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli
index 5713889185..1bf175ad1f 100644
--- a/stdlib/hashtbl.mli
+++ b/stdlib/hashtbl.mli
@@ -15,7 +15,7 @@
 
 (** Hash tables and hash functions.
 
-   Hash tables are hashed association tables, with in-place modification. 
+   Hash tables are hashed association tables, with in-place modification.
 *)
 
 
@@ -93,9 +93,9 @@ val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c
 
 
 val length : ('a, 'b) t -> int
-(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. 
-   Multiple bindings are counted multiply, so [Hashtbl.length] 
-   gives the number of times [Hashtbl.iter] calls it first argument. *)
+(** [Hashtbl.length tbl] returns the number of bindings in [tbl].
+   Multiple bindings are counted multiply, so [Hashtbl.length]
+   gives the number of times [Hashtbl.iter] calls its first argument. *)
 
 
 (** {6 Functorial interface} *)
@@ -158,7 +158,7 @@ module Make (H : HashedType) : S with type key = H.t
 val hash : 'a -> int
 (** [Hashtbl.hash x] associates a positive integer to any value of
    any type. It is guaranteed that
-   if [x = y] or [Pervasives.compare x y = 0], then [hash x = hash y]. 
+   if [x = y] or [Pervasives.compare x y = 0], then [hash x = hash y].
    Moreover, [hash] always terminates, even on cyclic
    structures. *)
 
@@ -175,4 +175,3 @@ external hash_param : int -> int -> 'a -> int = "caml_hash_univ_param" "noalloc"
    value, and therefore collisions are less likely to happen.
    However, hashing takes longer. The parameters [m] and [n]
    govern the tradeoff between accuracy and speed. *)
-
diff --git a/stdlib/int32.mli b/stdlib/int32.mli
index d96d771e8a..3408d0e9ff 100644
--- a/stdlib/int32.mli
+++ b/stdlib/int32.mli
@@ -48,14 +48,13 @@ external mul : int32 -> int32 -> int32 = "%int32_mul"
 (** Multiplication. *)
 
 external div : int32 -> int32 -> int32 = "%int32_div"
-(** Integer division.  Raise [Division_by_zero] if the second 
+(** Integer division.  Raise [Division_by_zero] if the second
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Pervasives.(/)}. *)
 
 external rem : int32 -> int32 -> int32 = "%int32_mod"
 (** Integer remainder.  If [y] is not zero, the result
-   of [Int32.rem x y] satisfies the following properties:
-   [Int32.zero <= Int32.rem x y < Int32.abs y] and
+   of [Int32.rem x y] satisfies the following property:
    [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)].
    If [y = 0], [Int32.rem x y] raises [Division_by_zero]. *)
 
@@ -104,7 +103,8 @@ external shift_right_logical : int32 -> int -> int32 = "%int32_lsr"
    The result is unspecified if [y < 0] or [y >= 32]. *)
 
 external of_int : int -> int32 = "%int32_of_int"
-(** Convert the given integer (type [int]) to a 32-bit integer (type [int32]). *)
+(** Convert the given integer (type [int]) to a 32-bit integer
+    (type [int32]). *)
 
 external to_int : int32 -> int = "%int32_to_int"
 (** Convert the given 32-bit integer (type [int32]) to an
diff --git a/stdlib/int64.mli b/stdlib/int64.mli
index bedfe2c23f..da5f5de1b7 100644
--- a/stdlib/int64.mli
+++ b/stdlib/int64.mli
@@ -19,12 +19,12 @@
    signed 64-bit integers.  Unlike the built-in [int] type,
    the type [int64] is guaranteed to be exactly 64-bit wide on all
    platforms.  All arithmetic operations over [int64] are taken
-   modulo 2{^64} 
+   modulo 2{^64}
 
    Performance notice: values of type [int64] occupy more memory
    space than values of type [int], and arithmetic operations on
    [int64] are generally slower than those on [int].  Use [int64]
-   only when the application requires exact 64-bit arithmetic. 
+   only when the application requires exact 64-bit arithmetic.
 *)
 
 val zero : int64
@@ -49,14 +49,13 @@ external mul : int64 -> int64 -> int64 = "%int64_mul"
 (** Multiplication. *)
 
 external div : int64 -> int64 -> int64 = "%int64_div"
-(** Integer division.  Raise [Division_by_zero] if the second 
+(** Integer division.  Raise [Division_by_zero] if the second
    argument is zero.  This division rounds the real quotient of
    its arguments towards zero, as specified for {!Pervasives.(/)}. *)
 
 external rem : int64 -> int64 -> int64 = "%int64_mod"
 (** Integer remainder.  If [y] is not zero, the result
-   of [Int64.rem x y] satisfies the following properties:
-   [Int64.zero <= Int64.rem x y < Int64.abs y] and
+   of [Int64.rem x y] satisfies the following property:
    [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)].
    If [y = 0], [Int64.rem x y] raises [Division_by_zero]. *)
 
@@ -104,7 +103,8 @@ external shift_right_logical : int64 -> int -> int64 = "%int64_lsr"
    The result is unspecified if [y < 0] or [y >= 64]. *)
 
 external of_int : int -> int64 = "%int64_of_int"
-(** Convert the given integer (type [int]) to a 64-bit integer (type [int64]). *)
+(** Convert the given integer (type [int]) to a 64-bit integer
+    (type [int64]). *)
 
 external to_int : int64 -> int = "%int64_to_int"
 (** Convert the given 64-bit integer (type [int64]) to an
diff --git a/stdlib/list.mli b/stdlib/list.mli
index 14241232da..8e2da4caf7 100644
--- a/stdlib/list.mli
+++ b/stdlib/list.mli
@@ -109,8 +109,8 @@ val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
    different lengths.  Not tail-recursive. *)
 
 val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-(** [List.rev_map2 f l] gives the same result as
-   {!List.rev}[ (]{!List.map2}[ f l)], but is tail-recursive and
+(** [List.rev_map2 f l1 l2] gives the same result as
+   {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and
    more efficient. *)
 
 val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a
diff --git a/stdlib/map.ml b/stdlib/map.ml
index 81b3396f33..b64fd7479b 100644
--- a/stdlib/map.ml
+++ b/stdlib/map.ml
@@ -90,7 +90,7 @@ module Make(Ord: OrderedType) = struct
     let rec add x data = function
         Empty ->
           Node(Empty, x, data, Empty, 1)
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Ord.compare x v in
           if c = 0 then
             Node(l, x, data, r, h)
@@ -135,7 +135,7 @@ module Make(Ord: OrderedType) = struct
     let rec remove x = function
         Empty ->
           Empty
-      | Node(l, v, d, r, h) as t ->
+      | Node(l, v, d, r, h) ->
           let c = Ord.compare x v in
           if c = 0 then
             merge l r
@@ -161,7 +161,7 @@ module Make(Ord: OrderedType) = struct
       match m with
         Empty -> accu
       | Node(l, v, d, r, _) ->
-          fold f l (f v d (fold f r accu))
+          fold f r (f v d (fold f l accu))
 
     type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration
 
diff --git a/stdlib/obj.mli b/stdlib/obj.mli
index 68479c2892..0136d29ce5 100644
--- a/stdlib/obj.mli
+++ b/stdlib/obj.mli
@@ -15,7 +15,7 @@
 
 (** Operations on internal representations of values.
 
-   Not for the casual user. 
+   Not for the casual user.
 *)
 
 type t
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 7cdfe9325e..5a7fdbbccc 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -401,16 +401,16 @@ external decr: int ref -> unit = "%decr"
 type ('a, 'b, 'c) format = ('a, 'b, 'c, 'c) format4
 external format_of_string :
  ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4 = "%identity"
-external string_of_format_sys :
+external format_to_string :
  ('a, 'b, 'c, 'd) format4 -> string = "%identity"
 external string_to_format : string -> ('a, 'b, 'c, 'd) format4 = "%identity"
 
 let (( ^^ ) : ('a, 'b, 'c, 'd) format4 -> ('d, 'b, 'c, 'e) format4 ->
               ('a, 'b, 'c, 'e) format4) = fun fmt1 fmt2 ->
-  string_to_format (string_of_format_sys fmt1 ^ string_of_format_sys fmt2);;
+  string_to_format (format_to_string fmt1 ^ format_to_string fmt2);;
 
-let string_of_format f =
-  let s = string_of_format_sys f in
+let string_of_format fmt =
+  let s = format_to_string fmt in
   let l = string_length s in
   let r = string_create l in
   string_blit s 0 r 0 l;
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index 6bcc2afc30..1e7814403e 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -570,7 +570,8 @@ val open_out_bin : string -> out_channel
    mode, this function behaves like {!Pervasives.open_out}. *)
 
 val open_out_gen : open_flag list -> int -> string -> out_channel
-(** Open the named file for writing, as above. The extra argument [mode]
+(** [open_out_gen mode perm filename] opens the named file for writing,
+   as described above. The extra argument [mode]
    specify the opening mode. The extra argument [perm] specifies
    the file permissions, in case the file must be created.
    {!Pervasives.open_out} and {!Pervasives.open_out_bin} are special
@@ -670,7 +671,8 @@ val open_in_bin : string -> in_channel
    mode, this function behaves like {!Pervasives.open_in}. *)
 
 val open_in_gen : open_flag list -> int -> string -> in_channel
-(** Open the named file for reading, as above. The extra arguments
+(** [open_in mode perm filename] opens the named file for reading,
+   as described above. The extra arguments
    [mode] and [perm] specify the opening mode and file permissions.
    {!Pervasives.open_in} and {!Pervasives.open_in_bin} are special
    cases of this function. *)
diff --git a/stdlib/printf.ml b/stdlib/printf.ml
index f29d2b431b..43859d5912 100644
--- a/stdlib/printf.ml
+++ b/stdlib/printf.ml
@@ -2,7 +2,7 @@
 (*                                                                     *)
 (*                           Objective Caml                            *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*  Xavier Leroy and Pierre Weis, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
@@ -20,23 +20,39 @@ external format_nativeint: string -> nativeint -> string
 external format_int64: string -> int64 -> string = "caml_int64_format"
 external format_float: string -> float -> string = "caml_format_float"
 
-let bad_format fmt pos =
+external format_to_string: ('a, 'b, 'c, 'd) format4 -> string = "%identity"
+
+type index;;
+
+external index_of_int : int -> index = "%identity";;
+external int_of_index : index -> int = "%identity";;
+
+let succ_index index = index_of_int (succ (int_of_index index));;
+(* Litteral position are One-based (hence pred p instead of p). *)
+let index_of_litteral_position p = index_of_int (pred p);;
+
+let bad_conversion fmt i c =
+  invalid_arg
+    ("printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
+     string_of_int i ^ " in format string ``" ^ fmt ^ "''");;
+
+let incomplete_format fmt =
   invalid_arg
-    ("printf: bad format " ^ String.sub fmt pos (String.length fmt - pos))
+    ("printf: premature end of format string ``" ^ fmt ^ "''");;
 
 (* Parses a format to return the specified length and the padding direction. *)
-let parse_format format =
+let parse_format fmt =
   let rec parse neg i =
-    if i >= String.length format then (0, neg) else
-    match String.unsafe_get format i with
+    if i >= String.length fmt then (0, neg) else
+    match String.unsafe_get fmt i with
     | '1'..'9' ->
-        (int_of_string (String.sub format i (String.length format - i - 1)),
+        (int_of_string (String.sub fmt i (String.length fmt - i - 1)),
          neg)
     | '-' ->
         parse true (succ i)
     | _ ->
         parse neg (succ i) in
-  try parse false 1 with Failure _ -> bad_format format 0
+  try parse false 1 with Failure _ -> bad_conversion fmt 0 's'
 
 (* Pad a (sub) string into a blank string of length [p],
    on the right if [neg] is true, on the left otherwise. *)
@@ -51,42 +67,224 @@ let pad_string pad_char p neg s i len =
 
 (* Format a string given a %s format, e.g. %40s or %-20s.
    To do: ignore other flags (#, +, etc)? *)
-let format_string format s =
-  let (p, neg) = parse_format format in
+let format_string fmt s =
+  let (p, neg) = parse_format fmt in
   pad_string ' ' p neg s 0 (String.length s)
 
 (* Extract a %format from [fmt] between [start] and [stop] inclusive.
-   '*' in the format are replaced by integers taken from the [widths] list.
-   The function is somewhat optimized for the "no *" case. *)
-
+   '*' in the format are replaced by integers taken from the [widths] list. *)
 let extract_format fmt start stop widths =
-  match widths with
-  | [] -> String.sub fmt start (stop - start + 1)
-  | _  ->
-      let b = Buffer.create (stop - start + 10) in
-      let rec fill_format i w =
-        if i > stop then Buffer.contents b else
-          match (String.unsafe_get fmt i, w) with
-          | ('*', h :: t) ->
-              Buffer.add_string b (string_of_int h); fill_format (succ i) t
-          | ('*', []) ->
-              bad_format fmt start (* should not happen *)
-          | (c, _) ->
-              Buffer.add_char b c; fill_format (succ i) w
-      in fill_format start (List.rev widths)
+  let skip_positional_spec start =
+    match String.unsafe_get fmt start with
+    | '0'..'9' ->
+      let rec skip_int_litteral i =
+        match String.unsafe_get fmt i with
+        | '0'..'9' -> skip_int_litteral (succ i)
+        | '$' -> succ i
+        | _ -> start in
+      skip_int_litteral (succ start)
+    | _ -> start in
+  let start = skip_positional_spec (succ start) in
+  let b = Buffer.create (stop - start + 10) in
+  Buffer.add_char b '%';
+  let rec fill_format i widths =
+    if i <= stop then
+      match (String.unsafe_get fmt i, widths) with
+      | ('*', h :: t) ->
+        Buffer.add_string b (string_of_int h);
+        let i = skip_positional_spec (succ i) in
+        fill_format i t
+      | ('*', []) ->
+        assert false (* should not happen *)
+      | (c, _) ->
+        Buffer.add_char b c; fill_format (succ i) widths in
+  fill_format start (List.rev widths);
+  Buffer.contents b;;
 
 let format_int_with_conv conv fmt i =
    match conv with
    | 'n' | 'N' -> fmt.[String.length fmt - 1] <- 'u'; format_int fmt i
    | _ -> format_int fmt i
 
+(* Returns the position of the last character of the meta format
+   string, starting from position [i], inside a given format [fmt].
+   According to the character [conv], the meta format string is
+   enclosed by the delimitors %{ and %} (when [conv = '{']) or %( and
+   %) (when [conv = '(']). Hence, [sub_format] returns the index of
+   the character ')' or '}' that ends the meta format, according to
+   the character [conv]. *)
+let sub_format incomplete_format bad_conversion conv fmt i =
+  let len = String.length fmt in
+  let rec sub_fmt c i =
+    let close = if c = '(' then ')' else '}' in
+    let rec sub j =
+       if j >= len then incomplete_format fmt else
+       match fmt.[j] with
+       | '%' -> sub_sub (succ j)
+       | _ -> sub (succ j)
+    and sub_sub j =
+       if j >= len then incomplete_format fmt else
+       match fmt.[j] with
+       | '(' | '{' as c ->
+         let j = sub_fmt c (succ j) in sub (succ j)
+       | ')' | '}' as c ->
+         if c = close then j else bad_conversion fmt i c
+       | _ -> sub (succ j) in
+    sub i in
+  sub_fmt conv i;;
+
+let sub_format_for_printf = sub_format incomplete_format bad_conversion;;
+
+let iter_format_args fmt add_conv add_char =
+  let len = String.length fmt in
+  let rec scan_flags skip i =
+    if i >= len then incomplete_format fmt else
+    match String.unsafe_get fmt i with
+    | '*' -> scan_flags skip (add_conv skip i 'i')
+    | '$' -> scan_flags skip (succ i)
+    | '#' | '-' | ' ' | '+' -> scan_flags skip (succ i)
+    | '_' -> scan_flags true (succ i)
+    | '0'..'9'
+    | '.' -> scan_flags skip (succ i)
+    | _ -> scan_conv skip i
+  and scan_conv skip i =
+    if i >= len then incomplete_format fmt else
+    match String.unsafe_get fmt i with
+    | '%' | '!' -> succ i
+    | 's' | 'S' | '[' -> add_conv skip i 's'
+    | 'c' | 'C' -> add_conv skip i 'c'
+    | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' -> add_conv skip i 'i'
+    | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' -> add_conv skip i 'f'
+    | 'B' | 'b' -> add_conv skip i 'B'
+    | 'a' | 't' as conv -> add_conv skip i conv
+    | 'l' | 'n' | 'L' as conv ->
+        let j = succ i in
+        if j >= len then add_conv skip i 'i' else begin
+          match fmt.[j] with
+          | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
+            add_char skip (add_conv skip i conv) 'i'
+          | c -> add_conv skip i 'i' end
+    | '{' | '(' as conv -> add_conv skip i conv
+    | '}' | ')' as conv -> add_conv skip i conv
+    | conv -> bad_conversion fmt i conv in
+  let lim = len - 1 in
+  let rec loop i =
+    if i < lim then
+     if fmt.[i] = '%' then loop (scan_flags false (succ i)) else
+     loop (succ i) in
+  loop 0;;
+
+(* Returns a string that summarizes the typing information that a given
+   format string contains.
+   It also checks the well-formedness of the format string.
+   For instance, [summarize_format_type "A number %d\n"] is "%i". *)
+let summarize_format_type fmt =
+  let len = String.length fmt in
+  let b = Buffer.create len in
+  let add i c = Buffer.add_char b c; succ i in
+  let add_char skip i c =
+    if skip then succ i else add i c
+  and add_conv skip i c =
+    if skip then Buffer.add_string b "%_" else Buffer.add_char b '%';
+    add i c in
+  iter_format_args fmt add_conv add_char;
+  Buffer.contents b;;
+
+(* Computes the number of arguments of a format (including flag
+   arguments if any). *)
+let nargs_of_format_type fmt =
+  let num_args = ref 0
+  and skip_args = ref 0 in
+  let add_conv skip i c =
+    let incr_args n = if c = 'a' then n := !n + 2 else n := !n + 1 in
+    if skip then incr_args skip_args else incr_args num_args;
+    succ i
+  and add_char skip i c = succ i in
+  iter_format_args fmt add_conv add_char;
+  !skip_args + !num_args;;
+
+let list_iter_i f l =
+  let rec loop i = function
+  | [] -> ()
+  | x :: xs -> f i x; loop (succ i) xs in
+  loop 0 l;;
+
+(* ``Abstracting'' version of kprintf: returns a (curried) function that
+   will print when totally applied.
+   Note: in the following, we are careful not to be badly caught
+   by the compiler optimizations on the representation of arrays. *)
+let kapr kpr fmt =
+  match nargs_of_format_type fmt with
+  | 0 -> kpr fmt [||]
+  | 1 -> Obj.magic (fun x ->
+      let a = Array.make 1 (Obj.repr 0) in
+      a.(0) <- x;
+      kpr fmt a)
+  | 2 -> Obj.magic (fun x y ->
+      let a = Array.make 2 (Obj.repr 0) in
+      a.(0) <- x; a.(1) <- y;
+      kpr fmt a)
+  | 3 -> Obj.magic (fun x y z ->
+      let a = Array.make 3 (Obj.repr 0) in
+      a.(0) <- x; a.(1) <- y; a.(2) <- z;
+      kpr fmt a)
+  | 4 -> Obj.magic (fun x y z t ->
+      let a = Array.make 4 (Obj.repr 0) in
+      a.(0) <- x; a.(1) <- y; a.(2) <- z;
+      a.(3) <- t;
+      kpr fmt a)
+  | 5 -> Obj.magic (fun x y z t u ->
+      let a = Array.make 5 (Obj.repr 0) in
+      a.(0) <- x; a.(1) <- y; a.(2) <- z;
+      a.(3) <- t; a.(4) <- u;
+      kpr fmt a)
+  | 6 -> Obj.magic (fun x y z t u v ->
+      let a = Array.make 6 (Obj.repr 0) in
+      a.(0) <- x; a.(1) <- y; a.(2) <- z;
+      a.(3) <- t; a.(4) <- u; a.(5) <- v;
+      kpr fmt a)
+  | nargs ->
+    let rec loop i args =
+      if i >= nargs then
+        let a = Array.make nargs (Obj.repr 0) in
+        list_iter_i (fun i arg -> a.(nargs - i - 1) <- arg) args;
+        kpr fmt a
+      else Obj.magic (fun x -> loop (succ i) (x :: args)) in
+    loop 0 [];;
+
+(* To scan a positional parameter specification. *)
+let scan_positional_spec fmt k n i =
+  match String.unsafe_get fmt i with
+  | '0'..'9' as d ->
+    let rec get_int_litteral accu i =
+      match String.unsafe_get fmt i with
+      | '0'..'9' as d ->
+        get_int_litteral (10 * accu + (int_of_char d - 48)) (succ i)
+      | '$' ->
+        k (Some (index_of_litteral_position accu)) None (succ i)
+      | _ -> k None (Some accu) i in
+    get_int_litteral (int_of_char d - 48) (succ i)
+  | _ -> k None None i;;
+
+(* To scan a positional parameter. *)
+let scan_positional fmt scan_flags n i =
+  let got_positional p w i =
+    match p, w with
+    | None, None -> scan_flags n [] i
+    | Some p, None -> scan_flags p [] i
+    | None, Some w -> scan_flags n [w] i
+    | _, _ -> assert false in
+  scan_positional_spec fmt got_positional n i;;
+
 (* Decode a %format and act on it.
    [fmt] is the printf format style, and [pos] points to a [%] character.
    After consuming the appropriate number of arguments and formatting
-   them, one of the three continuations is called:
+   them, one of the five continuations is called:
    [cont_s] for outputting a string (args: string, next pos)
    [cont_a] for performing a %a action (args: fn, arg, next pos)
    [cont_t] for performing a %t action (args: fn, next pos)
+   [cont_f] for performing a flush action 
+   [cont_m] for performing a %( action (args: sfmt, next pos)
    "next pos" is the position in [fmt] of the first character following
    the %format in [fmt]. *)
 
@@ -94,151 +292,169 @@ let format_int_with_conv conv fmt i =
    to detect the end of the format, we use [String.unsafe_get] and
    rely on the fact that we'll get a "nul" character if we access
    one past the end of the string.  These "nul" characters are then
-   caught by the [_ -> bad_format] clauses below.
+   caught by the [_ -> bad_conversion] clauses below.
    Don't do this at home, kids. *)
+let scan_format fmt args n pos cont_s cont_a cont_t cont_f cont_m =
+
+  let get_arg args n = Obj.magic args.(int_of_index n) in
 
-let scan_format fmt pos cont_s cont_a cont_t cont_f =
-  let rec scan_flags widths i =
+  let rec scan_flags n widths i =
     match String.unsafe_get fmt i with
     | '*' ->
-        Obj.magic(fun w -> scan_flags (w :: widths) (succ i))
-    | '0'..'9' | '.' | '#' | '-' | ' ' | '+' -> scan_flags widths (succ i)
-    | _ -> scan_conv widths i
-  and scan_conv widths i =
+      let got_positional p w i =
+        match p, w with
+        | None, None ->
+          let (width : int) = get_arg args n in
+          scan_flags (succ_index n) (width :: widths) i
+        | Some p, None ->
+          let (width : int) = get_arg args p in
+          scan_flags n (width :: widths) i
+        | _, _ -> assert false in
+      scan_positional_spec fmt got_positional n (succ i)
+    | '0'..'9'
+    | '.' | '#' | '-' | ' ' | '+' -> scan_flags n widths (succ i)
+    | _ -> scan_conv n widths i
+
+  and scan_conv n widths i =
     match String.unsafe_get fmt i with
     | '%' ->
-        cont_s "%" (succ i)
+      cont_s n "%" (succ i)
     | 's' | 'S' as conv ->
-        Obj.magic (fun (s: string) ->
-          let s = if conv = 's' then s else "\"" ^ String.escaped s ^ "\"" in
-          if i = succ pos (* optimize for common case %s *)
-          then cont_s s (succ i)
-          else cont_s (format_string (extract_format fmt pos i widths) s)
-                      (succ i))
+      let (x : string) = get_arg args n in
+      let x = if conv = 's' then x else "\"" ^ String.escaped x ^ "\"" in
+      let s =
+        (* optimize for common case %s *)
+        if i = succ pos then x else
+        format_string (extract_format fmt pos i widths) x in
+      cont_s (succ_index n) s (succ i)
     | 'c' | 'C' as conv ->
-        Obj.magic (fun (c: char) ->
-          if conv = 'c'
-          then cont_s (String.make 1 c) (succ i)
-          else cont_s ("'" ^ Char.escaped c ^ "'") (succ i))
+      let (x : char) = get_arg args n in
+      let s =
+        if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in
+      cont_s (succ_index n) s (succ i)
     | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' | 'N' as conv ->
-        Obj.magic(fun (n: int) ->
-          cont_s (format_int_with_conv conv
-                    (extract_format fmt pos i widths) n)
-                 (succ i))
+      let (x : int) = get_arg args n in
+      let s = format_int_with_conv conv (extract_format fmt pos i widths) x in
+      cont_s (succ_index n) s (succ i)
     | 'f' | 'e' | 'E' | 'g' | 'G' | 'F' as conv ->
-        Obj.magic(fun (f: float) ->
-          let s =
-            if conv = 'F' then string_of_float f else
-            format_float (extract_format fmt pos i widths) f in
-          cont_s s (succ i))
+      let (x : float) = get_arg args n in
+      let s =
+        if conv = 'F' then string_of_float x else
+        format_float (extract_format fmt pos i widths) x in
+      cont_s (succ_index n) s (succ i)
     | 'B' | 'b' ->
-        Obj.magic(fun (b: bool) ->
-          cont_s (string_of_bool b) (succ i))
+      let (x : bool) = get_arg args n in
+      cont_s (succ_index n) (string_of_bool x) (succ i)
     | 'a' ->
-        Obj.magic (fun printer arg ->
-          cont_a printer arg (succ i))
+      let printer = get_arg args n in
+      let n = succ_index n in
+      let arg = get_arg args n in
+      cont_a (succ_index n) printer arg (succ i)
     | 't' ->
-        Obj.magic (fun printer ->
-          cont_t printer (succ i))
-    | 'l' ->
-        begin match String.unsafe_get fmt (succ i) with
-        | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
-            Obj.magic(fun (n: int32) ->
-              cont_s (format_int32 (extract_format fmt pos (succ i) widths) n)
-                     (i + 2))
-        | _ ->
-            bad_format fmt pos
-        end
-    | 'n' ->
-        begin match String.unsafe_get fmt (succ i) with
-        | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
-            Obj.magic(fun (n: nativeint) ->
-              cont_s (format_nativeint
-                        (extract_format fmt pos (succ i) widths)
-                        n)
-                     (i + 2))
-        | _ ->
-            Obj.magic(fun (n: int) ->
-              cont_s (format_int_with_conv 'n'
-                        (extract_format fmt pos i widths)
-                        n)
-                     (succ i))
-        end
-    | 'L' ->
-        begin match String.unsafe_get fmt (succ i) with
-        | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
-            Obj.magic(fun (n: int64) ->
-              cont_s (format_int64 (extract_format fmt pos (succ i) widths) n)
-                     (i + 2))
-        | _ ->
-            bad_format fmt pos
-        end
-    | '!' ->
-        Obj.magic (cont_f (succ i))
-    | _ ->
-        bad_format fmt pos
-  in scan_flags [] (pos + 1)
+      let printer = get_arg args n in
+      cont_t (succ_index n) printer (succ i)
+    | 'l' | 'n' | 'L' as conv ->
+      begin match String.unsafe_get fmt (succ i) with
+      | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
+        let s =
+          match conv with
+          | 'l' ->
+            let (x : int32) = get_arg args n in
+            format_int32 (extract_format fmt pos (succ i) widths) x
+          | 'n' ->
+            let (x : nativeint) = get_arg args n in
+            format_nativeint (extract_format fmt pos (succ i) widths) x
+          | _ ->
+            let (x : int64) = get_arg args n in
+            format_int64 (extract_format fmt pos (succ i) widths) x in
+        cont_s (succ_index n) s (i + 2)
+      | _ ->
+        let (x : int) = get_arg args n in
+        cont_s
+          (succ_index n)
+          (format_int_with_conv 'n' (extract_format fmt pos i widths) x)
+          (succ i)
+      end
+    | '!' -> cont_f n (succ i)
+    | '{' | '(' as conv (* ')' '}' *)->
+      let (xf : ('a, 'b, 'c, 'd) format4) = get_arg args n in
+      let i = succ i in
+      let j = sub_format_for_printf conv fmt i + 1 in
+      if conv = '{' (* '}' *) then
+        (* Just print the format argument as a specification. *)
+        cont_s
+          (succ_index n)
+          (summarize_format_type (format_to_string xf)) j else
+        (* Use the format argument instead of the format specification. *)
+        cont_m (succ_index n) xf j
+    | ')' ->
+      cont_s n "" (succ i)
+    | conv ->
+      bad_conversion fmt i conv in
 
-(* Application to [fprintf], etc.  See also [Format.*printf]. *)
+  scan_positional fmt scan_flags n (succ pos);;
 
-let fprintf chan fmt =
-  let fmt = string_of_format fmt in
-  let len = String.length fmt in
-  let rec doprn i =
-    if i >= len then Obj.magic () else
-    match String.unsafe_get fmt i with
-    | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f
-    |  c  -> output_char chan c; doprn (succ i)
-  and cont_s s i =
-    output_string chan s; doprn i
-  and cont_a printer arg i =
-    printer chan arg; doprn i
-  and cont_t printer i =
-    printer chan; doprn i
-  and cont_f i =
-    flush chan; doprn i
-  in doprn 0
+let mkprintf str get_out outc outs flush =
+  let rec kprintf k fmt =
+    let fmt = format_to_string fmt in
+    let len = String.length fmt in
+
+    let kpr fmt v =
+      let out = get_out fmt in
+      let rec doprn n i =
+        if i >= len then Obj.magic (k out) else
+        match String.unsafe_get fmt i with
+        | '%' -> scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+        |  c  -> outc out c; doprn n (succ i)
+      and cont_s n s i =
+        outs out s; doprn n i
+      and cont_a n printer arg i =
+        if str then
+          outs out ((Obj.magic printer : unit -> _ -> string) () arg)
+        else
+          printer out arg;
+        doprn n i
+      and cont_t n printer i =
+        if str then
+          outs out ((Obj.magic printer : unit -> string) ())
+        else
+          printer out;
+        doprn n i
+      and cont_f n i =
+        flush out; doprn n i
+      and cont_m n sfmt i =
+        kprintf (Obj.magic (fun _ -> doprn n i)) sfmt in
+
+      doprn (index_of_int 0) 0 in
+
+    kapr kpr fmt in
+
+  kprintf;;
 
+let kfprintf k oc =
+  mkprintf false (fun _ -> oc) output_char output_string flush k
+let fprintf oc = kfprintf ignore oc
 let printf fmt = fprintf stdout fmt
 let eprintf fmt = fprintf stderr fmt
 
-let kprintf kont fmt =
-  let fmt = string_of_format fmt in
-  let len = String.length fmt in
-  let dest = Buffer.create (len + 16) in
-  let rec doprn i =
-    if i >= len then begin
-      let res = Buffer.contents dest in
-      Buffer.clear dest;  (* just in case kprintf is partially applied *)
-      Obj.magic (kont res)
-    end else
-    match String.unsafe_get fmt i with
-    | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f
-    |  c  -> Buffer.add_char dest c; doprn (succ i)
-  and cont_s s i =
-    Buffer.add_string dest s; doprn i
-  and cont_a printer arg i =
-    Buffer.add_string dest (printer () arg); doprn i
-  and cont_t printer i =
-    Buffer.add_string dest (printer ()); doprn i
-  and cont_f i = doprn i
-  in doprn 0
-
-let sprintf fmt = kprintf (fun x -> x) fmt;;
-
-let bprintf dest fmt =
-  let fmt = string_of_format fmt in
-  let len = String.length fmt in
-  let rec doprn i =
-    if i >= len then Obj.magic () else
-    match String.unsafe_get fmt i with
-    | '%' -> scan_format fmt i cont_s cont_a cont_t cont_f
-    |  c  -> Buffer.add_char dest c; doprn (succ i)
-  and cont_s s i =
-    Buffer.add_string dest s; doprn i
-  and cont_a printer arg i =
-    printer dest arg; doprn i
-  and cont_t printer i =
-    printer dest; doprn i
-  and cont_f i = doprn i
-  in doprn 0
+let kbprintf k b =
+  mkprintf false (fun _ -> b) Buffer.add_char Buffer.add_string ignore k
+let bprintf b = kbprintf ignore b
+
+let get_buff fmt =
+  let len = 2 * String.length fmt in
+  Buffer.create len;;
+
+let get_contents b =
+  let s = Buffer.contents b in
+  Buffer.clear b;
+  s;;
+
+let get_cont k b = k (get_contents b);;
+
+let ksprintf k =
+  mkprintf true get_buff Buffer.add_char Buffer.add_string ignore (get_cont k);;
+
+let kprintf = ksprintf;;
+
+let sprintf fmt = ksprintf (fun s -> s) fmt;;
diff --git a/stdlib/printf.mli b/stdlib/printf.mli
index 87fa010ea7..ecf15a2b5b 100644
--- a/stdlib/printf.mli
+++ b/stdlib/printf.mli
@@ -2,7 +2,7 @@
 (*                                                                     *)
 (*                           Objective Caml                            *)
 (*                                                                     *)
-(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*  Xavier Leroy and Pierre Weis, projet Cristal, INRIA Rocquencourt   *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
 (*  en Automatique.  All rights reserved.  This file is distributed    *)
@@ -17,18 +17,24 @@
 
 val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
 (** [fprintf outchan format arg1 ... argN] formats the arguments
-   [arg1] to [argN] according to the format string [format],
-   and outputs the resulting string on the channel [outchan].
-   
+   [arg1] to [argN] according to the format string [format], and
+   outputs the resulting string on the channel [outchan].
+
    The format is a character string which contains two types of
-   objects:  plain  characters, which are simply copied to the
-   output channel, and conversion specifications, each of which
-   causes  conversion and printing of one argument.
-   
-   Conversion specifications consist in the [%] character, followed
-   by optional flags and field widths, followed by one or two conversion
-   character. The conversion characters and their meanings are:
-   - [d], [i], [n], or [N]: convert an integer argument to signed decimal.
+   objects: plain characters, which are simply copied to the output
+   channel, and conversion specifications, each of which causes
+   conversion and printing of arguments.
+
+   Conversion specifications have the following form:
+
+   [% \[positional specifier\] \[flags\] \[width\] \[.precision\] type]
+
+   In short, a conversion specification consists in the [%] character,
+   followed by optional modifiers and a type which is made of one or
+   two characters. The types and their meanings are:
+
+   - [d], [i], [n], [l], [L], or [N]: convert an integer argument to
+     signed decimal.
    - [u]: convert an integer argument to unsigned decimal.
    - [x]: convert an integer argument to unsigned hexadecimal,
      using lowercase letters.
@@ -41,8 +47,8 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
    - [C]: insert a character argument in Caml syntax (single quotes, escapes).
    - [f]: convert a floating-point argument to decimal notation,
      in the style [dddd.ddd].
-   - [F]: convert a floating-point argument in Caml syntax ([dddd.ddd]
-     with a mandatory [.]).
+   - [F]: convert a floating-point argument to Caml syntax ([dddd.]
+     or [dddd.ddd] or [d.ddd e+-dd]).
    - [e] or [E]: convert a floating-point argument to decimal notation,
      in the style [d.ddd e+-dd] (mantissa and exponent).
    - [g] or [G]: convert a floating-point argument to decimal notation,
@@ -56,43 +62,50 @@ val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
      the format specified by the second letter.
    - [Ld], [Li], [Lu], [Lx], [LX], [Lo]: convert an [int64] argument to
      the format specified by the second letter.
-   - [a]: user-defined printer. Takes two arguments and apply the first
-     one to [outchan] (the current output channel) and to the second
-     argument. The first argument must therefore have type
+   - [a]: user-defined printer. Takes two arguments and apply the
+     first one to [outchan] (the current output channel) and to the
+     second argument. The first argument must therefore have type
      [out_channel -> 'b -> unit] and the second ['b].
-     The output produced by the function is therefore inserted
-     in the output of [fprintf] at the current point.
+     The output produced by the function is inserted in the output of
+     [fprintf] at the current point.
    - [t]: same as [%a], but takes only one argument (with type
      [out_channel -> unit]) and apply it to [outchan].
+   - [\{ fmt %\}]: convert a format string argument. The argument must
+     have the same type as the internal format string [fmt].
+   - [\( fmt %\)]: format string substitution. Takes a format string
+     argument and substitutes it to the internal format string [fmt]
+     to print following arguments. The argument must have the same
+     type as [fmt].
    - [!]: take no argument and flush the output.
    - [%]: take no argument and output one [%] character.
 
-   The optional flags include:
+   The optional [positional specifier] consists of an integer followed
+   by a [$]; the integer indicates which argument to use, the first
+   argument being denoted by 1.
+
+   The optional [flags] are:
    - [-]: left-justify the output (default is right justification).
    - [0]: for numerical conversions, pad with zeroes instead of spaces.
    - [+]: for numerical conversions, prefix number with a [+] sign if positive.
    - space: for numerical conversions, prefix number with a space if positive.
    - [#]: request an alternate formatting style for numbers.
 
-   The field widths are composed of an optional integer literal
-   indicating the minimal width of the result, possibly followed by
-   a dot [.] and another integer literal indicating how many digits
-   follow the decimal point in the [%f], [%e], and [%E] conversions.
-   For instance, [%6d] prints an integer, prefixing it with spaces to
-   fill at least 6 characters; and [%.4f] prints a float with 4
-   fractional digits.  Each or both of the integer literals can also be
-   specified as a [*], in which case an extra integer argument is taken
-   to specify the corresponding width or precision.
-   
-   Warning: if too few arguments are provided,
-   for instance because the [printf] function is partially
-   applied, the format is immediately printed up to
-   the conversion of the first missing argument; printing
-   will then resume when the missing arguments are provided.
-   For example, [List.iter (printf "x=%d y=%d " 1) [2;3]]
-   prints [x=1 y=2 3] instead of the expected
-   [x=1 y=2 x=1 y=3].  To get the expected behavior, do
-   [List.iter (fun y -> printf "x=%d y=%d " 1 y) [2;3]]. *)
+   The optional [width] is an integer indicating the minimal
+   width of the result. For instance, [%6d] prints an integer,
+   prefixing it with spaces to fill at least 6 characters.
+
+   The optional [precision] is a dot [.] followed by an integer
+   indicating how many digits follow the decimal point in the [%f],
+   [%e], and [%E] conversions. For instance, [%.4f] prints a [float] with
+   4 fractional digits.
+
+   The integer in a [width] or [precision] can also be specified as
+   [*], in which case an extra integer argument is taken to specify
+   the corresponding [width] or [precision]. This integer argument
+   precedes immediately the argument to print, unless an optional
+   [positional specifier] is given to indicates which argument to
+   use. For instance, [%.*3$f] prints a [float] with as many fractional
+   digits as the value of the third argument. *)
 
 val printf : ('a, out_channel, unit) format -> 'a
 (** Same as {!Printf.fprintf}, but output on [stdout]. *)
@@ -110,15 +123,34 @@ val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
    append the formatted arguments to the given extensible buffer
    (see module {!Buffer}). *)
 
-val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
-(** [kprintf k format arguments] is the same as [sprintf format arguments],
-    except that the resulting string is passed as argument to [k]; the
-    result of [k] is then returned as the result of [kprintf]. *)
+val kfprintf : (out_channel -> 'a) -> out_channel ->
+              ('b, out_channel, unit, 'a) format4 -> 'b;;
+(** Same as [fprintf], but instead of returning immediately,
+   passes the out channel to its first argument at the end of printing. *)
+
+val ksprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
+(** Same as [sprintf] above, but instead of returning the string,
+   passes it to the first argument. *)
+
+val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b;;
+(** A deprecated synonym for [ksprintf]. *)
 
 (**/**)
 
 (* For system use only.  Don't call directly. *)
+type index;;
+
+external index_of_int : int -> index = "%identity";;
+
+val scan_format : string -> 'a array -> index -> int ->
+  (index -> string -> int -> 'b) ->
+  (index -> 'c -> 'd -> int -> 'b) ->
+  (index -> 'e -> int -> 'b) ->
+  (index -> int -> 'b) ->
+  (index -> ('h, 'i, 'j, 'k) format4 -> int -> 'b) -> 'b
 
-val scan_format :
-  string -> int -> (string -> int -> 'a) -> ('b -> 'c -> int -> 'a) ->
-    ('e -> int -> 'a) -> (int -> 'a) -> 'a
+val sub_format :
+  (string -> int) -> (string -> int -> char -> int) ->
+  char -> string -> int -> int
+val summarize_format_type : string -> string
+val kapr : (string -> Obj.t array -> 'a) -> string -> 'a
diff --git a/stdlib/queue.ml b/stdlib/queue.ml
index 096d7141d6..9e21686a13 100644
--- a/stdlib/queue.ml
+++ b/stdlib/queue.ml
@@ -24,7 +24,7 @@ exception Empty
 type 'a cell = {
     content: 'a;
     mutable next: 'a cell
-  } 
+  }
 
 (* A queue is a reference to either nothing or some cell of a cyclic
    list. By convention, that cell is to be viewed as the last cell in
@@ -42,12 +42,12 @@ type 'a cell = {
 type 'a t = {
     mutable length: int;
     mutable tail: 'a cell
-  } 
+  }
 
 let create () = {
   length = 0;
   tail = Obj.magic None
-} 
+}
 
 let clear q =
   q.length <- 0;
@@ -84,17 +84,15 @@ let top =
   peek
 
 let take q =
-  if q.length = 0 then
-    raise Empty
+  if q.length = 0 then raise Empty;
+  q.length <- q.length - 1;
+  let tail = q.tail in
+  let head = tail.next in
+  if head == tail then
+    q.tail <- Obj.magic None
   else
-    q.length <- q.length - 1;
-    let tail = q.tail in
-    let head = tail.next in
-    if head == tail then
-      q.tail <- Obj.magic None
-    else
-      tail.next <- head.next;
-    head.content
+    tail.next <- head.next;
+  head.content
 
 let pop =
   take
@@ -121,7 +119,7 @@ let copy q =
     {
       length = q.length;
       tail = tail'
-    } 
+    }
 
 let is_empty q =
   q.length = 0
@@ -165,4 +163,3 @@ let transfer q1 q2 =
     end;
     q2.length <- q2.length + length1;
     q2.tail <- tail1
-
diff --git a/stdlib/scanf.ml b/stdlib/scanf.ml
index cb0291b205..5070e30baf 100644
--- a/stdlib/scanf.ml
+++ b/stdlib/scanf.ml
@@ -21,75 +21,83 @@ module type SCANNING = sig
 type scanbuf;;
 
 val stdib : scanbuf;;
-(** The scanning buffer reading from [stdin].
+(* The scanning buffer reading from [stdin].
     [stdib] is equivalent to [Scanning.from_channel stdin]. *)
 
-val next_char : scanbuf -> unit;;
-(** [Scanning.next_char scanbuf] advance the scanning buffer for
+val next_char : scanbuf -> char;;
+(* [Scanning.next_char ib] advance the scanning buffer for
     one character.
     If no more character can be read, sets a end of file condition and
     returns '\000'. *)
 
+val invalidate_current_char : scanbuf -> unit;;
+(* [Scanning.invalidate_current_char ib] mark the current_char as already
+    scanned. *)
+
 val peek_char : scanbuf -> char;;
-(** [Scanning.peek_char scanbuf] returns the current char available in
-    the buffer. *)
-
-val cautious_peek_char : scanbuf -> char;;
-(** [Scanning.cautious_peek_char scanbuf] returns the current char
-    available in the buffer or tries to read one if none has ever been
-    read. 
-    If no character can be read, sets a end of file condition and
+(* [Scanning.peek_char ib] returns the current char available in
+    the buffer or read one if necessary (when the current character is
+    already scanned).
+    If no character can be read, sets an end of file condition and
     returns '\000'. *)
 
 val checked_peek_char : scanbuf -> char;;
-(** Same as above but always returns a valid char or fails:
+(* Same as above but always returns a valid char or fails:
     instead of returning a null char when the reading method of the
     input buffer has reached an end of file, the function raises exception
     [End_of_file]. *)
 
 val store_char : scanbuf -> char -> int -> int;;
-(** [Scanning.store_char scanbuf c lim] adds [c] to the token buffer
+(* [Scanning.store_char ib c lim] adds [c] to the token buffer
     of the scanning buffer. It also advances the scanning buffer for one
     character and returns [lim - 1], indicating the new limit
     for the length of the current token. *)
 
-val skip_char : scanbuf -> char -> int -> int;;
-(** [Scanning.skip_char scanbuf c lim] is similar to [store_char] but
-    it ignores (does not store in the token buffer) the character [c]. *)
+val skip_char : scanbuf -> int -> int;;
+(* [Scanning.skip_char ib lim] ignores the current character. *)
+
+val ignore_char : scanbuf -> int -> int;;
+(* [Scanning.ignore_char ib lim] ignores the current character and
+   decrements the limit. *)
 
 val token : scanbuf -> string;;
-(** [Scanning.token scanbuf] returns the string stored into the token
+(* [Scanning.token ib] returns the string stored into the token
     buffer of the scanning buffer: it returns the token matched by the
     format. *)
 
 val reset_token : scanbuf -> unit;;
-(** [Scanning.reset_token scanbuf] resets the token buffer of
+(* [Scanning.reset_token ib] resets the token buffer of
     the given scanning buffer. *)
 
 val char_count : scanbuf -> int;;
-(** [Scanning.char_count scanbuf] returns the number of characters
+(* [Scanning.char_count ib] returns the number of characters
     read so far from the given buffer. *)
 
 val line_count : scanbuf -> int;;
-(** [Scanning.line_count scanbuf] returns the number of new line
+(* [Scanning.line_count ib] returns the number of new line
     characters read so far from the given buffer. *)
 
 val token_count : scanbuf -> int;;
-(** [Scanning.token_count scanbuf] returns the number of tokens read
-    so far from [scanbuf]. *)
+(* [Scanning.token_count ib] returns the number of tokens read
+    so far from [ib]. *)
 
 val eof : scanbuf -> bool;;
-(** [Scanning.eof scanbuf] returns the current value of the end of input
-    condition of the given buffer, no validity test is performed. *)
+(* [Scanning.eof ib] returns the end of input condition
+    of the given buffer. *)
 
 val end_of_input : scanbuf -> bool;;
-(** [Scanning.end_of_input scanbuf] tests the end of input condition
-    of the given buffer. *)
+(* [Scanning.end_of_input ib] tests the end of input condition
+    of the given buffer (if no char has ever been read, an attempt to
+    read one is performed). *)
 
 val beginning_of_input : scanbuf -> bool;;
-(** [Scanning.beginning_of_input scanbuf] tests the beginning of input
+(* [Scanning.beginning_of_input ib] tests the beginning of input
     condition of the given buffer. *)
 
+val name_of_input : scanbuf -> string;;
+(* [Scanning.name_of_input ib] returns the name of the character
+    source for input buffer [ib]. *)
+
 val from_string : string -> scanbuf;;
 val from_channel : in_channel -> scanbuf;;
 val from_file : string -> scanbuf;;
@@ -105,8 +113,8 @@ type file_name = string;;
 
 type scanbuf = {
   mutable eof : bool;
-  mutable bof : bool;
-  mutable cur_char : char;
+  mutable current_char : char;
+  mutable current_char_is_valid : bool;
   mutable char_count : int;
   mutable line_count : int;
   mutable token_count : int;
@@ -115,44 +123,51 @@ type scanbuf = {
   file_name : file_name;
 };;
 
+let null_char = '\000';;
+
 (* Reads a new character from input buffer.  Next_char never fails,
    even in case of end of input: it then simply sets the end of file
    condition. *)
 let next_char ib =
   try
-   let c = ib.get_next_char () in
-   ib.cur_char <- c;
-   ib.char_count <- ib.char_count + 1;
-   if c == '\n' then ib.line_count <- ib.line_count + 1
-  with End_of_file ->
-   ib.cur_char <- '\000';
-   ib.eof <- true;;
-
-let cautious_peek_char ib =
-  if ib.bof then begin
-    next_char ib;
-    if ib.char_count > 0 then ib.bof <- false end;
-  ib.cur_char;;
-
-(* Returns a valid current char for the input buffer.  In particular
+    let c = ib.get_next_char () in
+    ib.current_char <- c;
+    ib.current_char_is_valid <- true;
+    ib.char_count <- ib.char_count + 1;
+    if c == '\n' then ib.line_count <- ib.line_count + 1;
+    c with
+  | End_of_file ->
+    let c = null_char in
+    ib.current_char <- c;
+    ib.current_char_is_valid <- false;
+    ib.eof <- true;
+    c;;
+
+let peek_char ib =
+  if ib.current_char_is_valid then ib.current_char else next_char ib;;
+
+(* Returns a valid current char for the input buffer. In particular
    no irrelevant null character (as set by [next_char] in case of end
    of input) is returned, since [End_of_file] is raised when
    [next_char] sets the end of file condition while trying to read a
    new character. *)
 let checked_peek_char ib =
-  let c = cautious_peek_char ib in
+  let c = peek_char ib in
   if ib.eof then raise End_of_file;
   c;;
 
-let peek_char ib = ib.cur_char;;
-let eof ib = ib.eof;;
-let beginning_of_input ib = ib.bof;;
 let end_of_input ib =
-  let c = cautious_peek_char ib in
+  ignore (peek_char ib);
   ib.eof;;
+
+let eof ib = ib.eof;;
+
+let beginning_of_input ib = ib.char_count = 0;;
+let name_of_input ib = ib.file_name;;
 let char_count ib = ib.char_count;;
 let line_count ib = ib.line_count;;
 let reset_token ib = Buffer.reset ib.tokbuf;;
+let invalidate_current_char ib = ib.current_char_is_valid <- false;;
 
 let token ib =
   let tokbuf = ib.tokbuf in
@@ -163,21 +178,22 @@ let token ib =
 
 let token_count ib = ib.token_count;;
 
+let skip_char ib max =
+  invalidate_current_char ib;
+  max;;
+
+let ignore_char ib max = skip_char ib (max - 1);;
+
 let store_char ib c max =
   Buffer.add_char ib.tokbuf c;
-  next_char ib;
-  max - 1;;
-
-let skip_char ib c max =
-  next_char ib;
-  max - 1;;
+  ignore_char ib max;;
 
 let default_token_buffer_size = 1024;;
 
 let create fname next = {
   eof = false;
-  bof = true;
-  cur_char = '\000';
+  current_char = '\000';
+  current_char_is_valid = false;
   char_count = 0;
   line_count = 0;
   token_count = 0;
@@ -194,9 +210,9 @@ let from_string s =
     let c = s.[!i] in
     incr i;
     c in
-  create "string" next;;
+  create "string input" next;;
 
-let from_function = create "function";;
+let from_function = create "function input";;
 
 (* Perform bufferized input to improve efficiency. *)
 let file_buffer_size = ref 1024;;
@@ -223,14 +239,14 @@ let from_input_channel fname ic =
   let next () = input_char ic in
   create fname next;;
 
-let from_channel = from_input_channel "in_channel";;
+let from_channel = from_input_channel "input channel";;
 
+(* The scanning buffer reading from [stdin].*)
 let stdib = from_input_channel "stdin" stdin;;
-(** The scanning buffer reading from [stdin].*)
 
 end;;
 
-(** Formatted input functions. *)
+(* Formatted input functions. *)
 
 (* Reporting errors. *)
 exception Scan_failure of string;;
@@ -244,31 +260,54 @@ let bad_input_escape c =
 let scanf_bad_input ib = function
   | Scan_failure s | Failure s ->
       let i = Scanning.char_count ib in
-      bad_input (Printf.sprintf "scanf: bad input at char number %i: %S" i s)
+      bad_input (Printf.sprintf "scanf: bad input at char number %i: %s" i s)
   | x -> raise x;;
 
-let bad_format fmt i fc =
+let bad_conversion fmt i c =
   invalid_arg
     (Printf.sprintf
-       "scanf: bad conversion %%%c, at char number %i in format %S" fc i fmt);;
+       "scanf: bad conversion %%%c, at char number %i \
+        in format string ``%s''" c i fmt);;
+
+let incomplete_format fmt =
+  invalid_arg
+    (Printf.sprintf "scanf: premature end of format string ``%s''" fmt);;
 
 let bad_float () = bad_input "no dot or exponent part found in float token";;
 
-(* Checking that the current char is indeed one of range, then skip it. *)
-let check_char_in range ib =
-  if range <> [] && not (Scanning.end_of_input ib) then
-  let ci = Scanning.checked_peek_char ib in
-  if List.memq ci range then Scanning.next_char ib else
-  let sr = String.concat "" (List.map (String.make 1) range) in
-  bad_input
-    (Printf.sprintf "looking for one of range %S, found %C" sr ci);;
+let format_mismatch_err fmt1 fmt2 =
+  Printf.sprintf "format read %S does not match specification %S" fmt1 fmt2;;
+
+let format_mismatch fmt1 fmt2 ib =
+  scanf_bad_input ib (Scan_failure (format_mismatch_err fmt1 fmt2));;
+
+(* Checking that 2 format string are type compatible. *)
+let compatible_format_type fmt1 fmt2 =
+  Printf.summarize_format_type fmt1 = Printf.summarize_format_type fmt2;;
 
-(* Checking that [c] is indeed in the input, then skip it. *)
+(* Checking that [c] is indeed in the input, then skips it.
+   In this case, the character c has been explicitely specified in the
+   format as being mandatory in the input; hence we should fail with
+   End_of_file in case of end_of_input.
+   That's why we use checked_peek_char here. *)
 let check_char ib c =
   let ci = Scanning.checked_peek_char ib in
-  if ci != c
-  then bad_input (Printf.sprintf "looking for %C, found %C" c ci)
-  else Scanning.next_char ib;;
+  if ci != c then
+    bad_input (Printf.sprintf "looking for %C, found %C" c ci) else
+  Scanning.invalidate_current_char ib;;
+
+(* Checks that the current char is indeed one of the stopper characters,
+   then skips it.
+   Be careful that if ib has no more character this procedure should
+   just do nothing (since %s@c defaults to the entire rest of the
+   buffer, when no character c can be found in the input). *)
+let ignore_stoppers stps ib =
+  if stps <> [] && not (Scanning.eof ib) then
+  let ci = Scanning.peek_char ib in
+  if List.memq ci stps then Scanning.invalidate_current_char ib else
+  let sr = String.concat "" (List.map (String.make 1) stps) in
+  bad_input
+    (Printf.sprintf "looking for one of range %S, found %C" sr ci);;
 
 (* Extracting tokens from ouput token buffer. *)
 
@@ -328,69 +367,69 @@ let token_int64 conv ib = int64_of_string (token_int_literal conv ib);;
    scanning function). *)
 
 (* The decimal case is treated especially for optimization purposes. *)
-let scan_decimal_digits max ib =
-  let rec loop inside max =
-    if max = 0 || Scanning.eof ib then max else
-    match Scanning.cautious_peek_char ib with
-    | '0' .. '9' as c ->
-        let max = Scanning.store_char ib c max in
-        loop true max
-    | '_' as c when inside ->
-       let max = Scanning.skip_char ib c max in
-       loop true max
-    | c -> max in
-  loop false max;;
-
-(* To scan numbers from other bases, we use a predicate argument to
-   scan_digits. *)
-let scan_digits digitp max ib =
-  let rec loop inside max =
-    if max = 0 || Scanning.eof ib then max else
-    match Scanning.cautious_peek_char ib with
+let rec scan_decimal_digits max ib =
+  if max = 0 then max else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then max else
+  match c with
+  | '0' .. '9' as c ->
+     let max = Scanning.store_char ib c max in
+     scan_decimal_digits max ib
+  | '_' ->
+     let max = Scanning.ignore_char ib max in
+     scan_decimal_digits max ib
+  | _ -> max;;
+
+let scan_decimal_digits_plus max ib =
+  let c = Scanning.checked_peek_char ib in
+  match c with
+  | '0' .. '9' ->
+    let max = Scanning.store_char ib c max in
+    scan_decimal_digits max ib
+  | c -> bad_input_char c;;
+
+let scan_digits_plus digitp max ib =
+  (* To scan numbers from other bases, we use a predicate argument to
+     scan_digits. *)
+  let rec scan_digits max =
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
+    match c with
     | c when digitp c ->
        let max = Scanning.store_char ib c max in
-       loop true max
-    | '_' as c when inside ->
-       let max = Scanning.skip_char ib c max in
-       loop true max
+       scan_digits max
+    | '_' ->
+       let max = Scanning.ignore_char ib max in
+       scan_digits max
     | _ -> max in
-  loop false max;;
 
-let scan_digits_plus digitp max ib =
   let c = Scanning.checked_peek_char ib in
   if digitp c then
     let max = Scanning.store_char ib c max in
-    scan_digits digitp max ib
+    scan_digits max
   else bad_input_char c;;
 
 let is_binary_digit = function
   | '0' .. '1' -> true
   | _ -> false;;
 
-let scan_binary_digits = scan_digits is_binary_digit;;
 let scan_binary_int = scan_digits_plus is_binary_digit;;
 
 let is_octal_digit = function
   | '0' .. '7' -> true
   | _ -> false;;
 
-let scan_octal_digits = scan_digits is_octal_digit;;
 let scan_octal_int = scan_digits_plus is_octal_digit;;
 
 let is_hexa_digit = function
   | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true
   | _ -> false;;
 
-let scan_hexadecimal_digits = scan_digits is_hexa_digit;;
 let scan_hexadecimal_int = scan_digits_plus is_hexa_digit;;
 
 (* Scan a decimal integer. *)
-let scan_unsigned_decimal_int max ib =
-  match Scanning.checked_peek_char ib with
-  | '0' .. '9' as c ->
-      let max = Scanning.store_char ib c max in
-      scan_decimal_digits max ib
-  | c -> bad_input_char c;;
+let scan_unsigned_decimal_int = scan_decimal_digits_plus;;
 
 let scan_sign max ib =
   let c = Scanning.checked_peek_char ib in
@@ -411,12 +450,13 @@ let scan_unsigned_int max ib =
   match Scanning.checked_peek_char ib with
   | '0' as c ->
       let max = Scanning.store_char ib c max in
-      if max = 0 || Scanning.eof ib then max else
+      if max = 0 then max else
       let c = Scanning.peek_char ib in
+      if Scanning.eof ib then max else
       begin match c with
-      | 'x' | 'X' -> scan_hexadecimal_digits (Scanning.store_char ib c max) ib
-      | 'o' -> scan_octal_digits (Scanning.store_char ib c max) ib
-      | 'b' -> scan_binary_digits (Scanning.store_char ib c max) ib
+      | 'x' | 'X' -> scan_hexadecimal_int (Scanning.store_char ib c max) ib
+      | 'o' -> scan_octal_int (Scanning.store_char ib c max) ib
+      | 'b' -> scan_binary_int (Scanning.store_char ib c max) ib
       | c -> scan_decimal_digits max ib end
   | c -> scan_unsigned_decimal_int max ib;;
 
@@ -437,31 +477,37 @@ let scan_int_conv conv max ib =
 (* Scanning floating point numbers. *)
 (* Fractional part is optional and can be reduced to 0 digits. *)
 let scan_frac_part max ib =
-  if max = 0 || Scanning.eof ib then max else
-  scan_decimal_digits max ib;;
+  if max = 0 then max else
+  let c = Scanning.peek_char ib in
+  if Scanning.eof ib then max else
+  match c with
+  | '0' .. '9' as c ->
+    scan_decimal_digits (Scanning.store_char ib c max) ib
+  | _ -> max;;
 
 (* Exp part is optional and can be reduced to 0 digits. *)
 let scan_exp_part max ib =
-  if max = 0 || Scanning.eof ib then max else
+  if max = 0 then max else
   let c = Scanning.peek_char ib in
+  if Scanning.eof ib then max else
   match c with
   | 'e' | 'E' as c ->
      scan_optionally_signed_decimal_int (Scanning.store_char ib c max) ib
   | _ -> max;;
 
-(* An optional sign followed by a possibly empty sequence of decimal digits. *)
-let scan_optionally_signed_decimal_digits max ib =
+(* Scan the integer part of a floating point number, (not using the
+   Caml lexical convention since the integer part can be empty):
+   an optional sign, followed by a possibly empty sequence of decimal
+   digits (e.g. -.1). *)
+let scan_int_part max ib =
   let max = scan_sign max ib in
   scan_decimal_digits max ib;;
 
-(* Scan the integer part of a floating point number, (not using the
-   Caml lexical convention since the integer part can be empty). *)
-let scan_int_part = scan_optionally_signed_decimal_digits;;
-
 let scan_float max ib =
   let max = scan_int_part max ib in
-  if max = 0 || Scanning.eof ib then max else
+  if max = 0 then max else
   let c = Scanning.peek_char ib in
+  if Scanning.eof ib then max else
   match c with
   | '.' ->
      let max = Scanning.store_char ib c max in
@@ -471,8 +517,9 @@ let scan_float max ib =
 
 let scan_Float max ib =
   let max = scan_optionally_signed_decimal_int max ib in
-  if max = 0 || Scanning.eof ib then bad_float () else
+  if max = 0 then bad_float () else
   let c = Scanning.peek_char ib in
+  if Scanning.eof ib then bad_float () else
   match c with
   | '.' ->
      let max = Scanning.store_char ib c max in
@@ -487,17 +534,16 @@ let scan_Float max ib =
    characters has been read.*)
 let scan_string stp max ib =
   let rec loop max =
-    if max = 0 || Scanning.end_of_input ib then max else
-    let c = Scanning.checked_peek_char ib in
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if stp == [] then
       match c with
       | ' ' | '\t' | '\n' | '\r' -> max
       | c -> loop (Scanning.store_char ib c max) else
-    if List.mem c stp then max else
+    if List.memq c stp then Scanning.skip_char ib max else
     loop (Scanning.store_char ib c max) in
-  let max = loop max in
-  check_char_in stp ib;
-  max;;
+  loop max;;
 
 (* Scan a char: peek strictly one character in the input, whatsoever. *)
 let scan_char max ib =
@@ -526,15 +572,15 @@ let char_for_decimal_code c0 c1 c2 =
 (* Called when encountering '\\' as starter of a char.
    Stops before the corresponding '\''. *)
 let scan_backslash_char max ib =
-  if max = 0 || Scanning.eof ib then bad_input "a char" else
+  if max = 0 then bad_input "a char" else
   let c = Scanning.peek_char ib in
+  if Scanning.eof ib then bad_input "a char" else
   match c with
   | '\\' | '\'' | '"' | 'n' | 't' | 'b' | 'r' (* '"' helping Emacs *) ->
      Scanning.store_char ib (char_for_backslash c) max
   | '0' .. '9' as c ->
      let get_digit () =
-       Scanning.next_char ib;
-       let c = Scanning.peek_char ib in
+       let c = Scanning.next_char ib in
        match c with
        | '0' .. '9' as c -> c
        | c -> bad_input_escape c in
@@ -546,49 +592,53 @@ let scan_backslash_char max ib =
 
 let scan_Char max ib =
   let rec loop s max =
-   if max = 0 || Scanning.eof ib then bad_input "a char" else
+   if max = 0 then bad_input "a char" else
    let c = Scanning.checked_peek_char ib in
+   if Scanning.eof ib then bad_input "a char" else
    match c, s with
-   | '\'', 3 -> Scanning.next_char ib; loop 2 (max - 1)
-   | '\'', 1 -> Scanning.next_char ib; max - 1
-   | '\\', 2 -> Scanning.next_char ib;
-                loop 1 (scan_backslash_char (max - 1) ib)
+   | '\'', 3 -> loop 2 (Scanning.ignore_char ib max)
+   | '\'', 1 -> Scanning.ignore_char ib max
+   | '\\', 2 -> loop 1 (scan_backslash_char (Scanning.ignore_char ib max) ib)
    | c, 2 -> loop 1 (Scanning.store_char ib c max)
    | c, _ -> bad_input_escape c in
   loop 3 max;;
 
 let scan_String max ib =
   let rec loop s max =
-    if max = 0 || Scanning.eof ib then bad_input "a string" else
+    if max = 0 then bad_input "a string" else
     let c = Scanning.checked_peek_char ib in
+    if Scanning.eof ib then bad_input "a string" else
     match c, s with
     | '"', true (* '"' helping Emacs *) ->
-       Scanning.next_char ib; loop false (max - 1)
+       loop false (Scanning.ignore_char ib max)
     | '"', false (* '"' helping Emacs *) ->
-       Scanning.next_char ib; max - 1
+       Scanning.ignore_char ib max
     | '\\', false ->
-       Scanning.next_char ib; skip_spaces true (max - 1)
+       skip_spaces true (Scanning.ignore_char ib max)
     | c, false -> loop false (Scanning.store_char ib c max)
     | c, _ -> bad_input_char c
   and skip_spaces s max =
-    if max = 0 || Scanning.eof ib then bad_input "a string" else
+    if max = 0 then bad_input "a string" else
     let c = Scanning.checked_peek_char ib in
+    if Scanning.eof ib then bad_input "a string" else
     match c, s with
     | '\n', true
     | ' ', false ->
-       Scanning.next_char ib; skip_spaces false (max - 1)
+       skip_spaces false (Scanning.ignore_char ib max)
     | '\\', false -> loop false max
     | c, false -> loop false (Scanning.store_char ib c max)
     | _, _ -> loop false (scan_backslash_char (max - 1) ib) in
   loop true max;;
 
 let scan_bool max ib =
-  if max < 4 || Scanning.eof ib then bad_input "a boolean" else
+  if max < 4 then bad_input "a boolean" else
+  let c = Scanning.checked_peek_char ib in
+  if Scanning.eof ib then bad_input "a boolean" else
   let m =
-    match Scanning.checked_peek_char ib with
+    match c with
     | 't' -> 4
     | 'f' -> 5
-    | _ -> 0 in
+    | _ -> bad_input "a boolean" in
   scan_string [] (min max m) ib;;
 
 (* Reading char sets in %[...] conversions. *)
@@ -601,18 +651,18 @@ let read_char_set fmt i =
   let lim = String.length fmt - 1 in
 
   let rec find_in_set j =
-    if j > lim then bad_format fmt j fmt.[lim - 1] else
+    if j > lim then incomplete_format fmt else
     match fmt.[j] with
     | ']' -> j
     | c -> find_in_set (j + 1)
 
   and find_set i =
-    if i > lim then bad_format fmt i fmt.[lim - 1] else
+    if i > lim then incomplete_format fmt else
     match fmt.[i] with
     | ']' -> find_in_set (i + 1)
     | c -> find_in_set i in
 
-  if i > lim then bad_format fmt i fmt.[lim - 1] else
+  if i > lim then incomplete_format fmt else
   match fmt.[i] with
   | '^' ->
      let i = i + 1 in
@@ -656,16 +706,18 @@ let get_char_in_range r c = get_bit_of_range r (int_of_char c);;
 
 let bit_not b = (lnot b) land 1;;
 
-(* Build the bit vector corresponding to a char set read in the format. *)
-let make_bv bit set =
+(* Build the bit vector corresponding to the set of characters
+   that belongs to the string argument [set].
+   (In the Scanf module [set] is always a sub-string of the format). *)
+let make_char_bit_vect bit set =
   let r = make_range (bit_not bit) in
   let lim = String.length set - 1 in
   let rec loop bit rp i =
     if i <= lim then
     match set.[i] with
     | '-' when rp ->
-       (* if i = 0 then rp is false (since the initial call is loop bit false 0)
-          hence i >= 1 and the following is safe. *)
+       (* if i = 0 then rp is false (since the initial call is
+          loop bit false 0). Hence i >= 1 and the following is safe. *)
        let c1 = set.[i - 1] in
        let i = i + 1 in
        if i > lim then loop bit false (i - 1) else
@@ -681,7 +733,7 @@ let make_bv bit set =
 
 (* Compute the predicate on chars corresponding to a char set. *)
 let make_pred bit set stp =
-  let r = make_bv bit set in
+  let r = make_char_bit_vect bit set in
   List.iter
     (fun c -> set_bit_of_range r (int_of_char c) (bit_not bit)) stp;
   (fun c -> get_char_in_range r c);;
@@ -739,46 +791,54 @@ let find_setp stp char_set =
 
 let scan_chars_in_char_set stp char_set max ib =
   let rec loop_pos1 cp1 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c == cp1
     then loop_pos1 cp1 (Scanning.store_char ib c max)
     else max
   and loop_pos2 cp1 cp2 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c == cp1 || c == cp2
     then loop_pos2 cp1 cp2 (Scanning.store_char ib c max)
     else max
   and loop_pos3 cp1 cp2 cp3 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c == cp1 || c == cp2 || c == cp3
     then loop_pos3 cp1 cp2 cp3 (Scanning.store_char ib c max)
     else max
   and loop_neg1 cp1 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c != cp1
     then loop_neg1 cp1 (Scanning.store_char ib c max)
     else max
   and loop_neg2 cp1 cp2 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c != cp1 && c != cp2
     then loop_neg2 cp1 cp2 (Scanning.store_char ib c max)
     else max
   and loop_neg3 cp1 cp2 cp3 max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
     if c != cp1 && c != cp2 && c != cp3
     then loop_neg3 cp1 cp2 cp3 (Scanning.store_char ib c max)
     else max
   and loop setp max =
-    let c = Scanning.cautious_peek_char ib in
-    if max = 0 || Scanning.end_of_input ib then max else
-    if setp c == 1 then loop setp (Scanning.store_char ib c max) else
-    max in
+    if max = 0 then max else
+    let c = Scanning.peek_char ib in
+    if Scanning.eof ib then max else
+    if setp c == 1
+    then loop setp (Scanning.store_char ib c max)
+    else max in
 
   let max =
     match char_set with
@@ -796,7 +856,7 @@ let scan_chars_in_char_set stp char_set max ib =
         | 2 -> loop_neg2 set.[0] set.[1] max
         | 3 when set.[1] != '-' -> loop_neg3 set.[0] set.[1] set.[2] max
         | n -> loop (find_setp stp char_set) max end in
-  check_char_in stp ib;
+  ignore_stoppers stp ib;
   max;;
 
 let get_count t ib =
@@ -805,14 +865,19 @@ let get_count t ib =
   | 'n' -> Scanning.char_count ib
   | _ -> Scanning.token_count ib;;
 
-let skip_whites ib =
-  let rec loop = function
-  | ' ' | '\t' | '\n' | '\r' ->
-     Scanning.next_char ib;
-     if not (Scanning.eof ib) then loop (Scanning.peek_char ib)
-  | _ -> () in
-  if not (Scanning.eof ib) then
-  loop (Scanning.cautious_peek_char ib);;
+let rec skip_whites ib =
+  let c = Scanning.peek_char ib in
+  if not (Scanning.eof ib) then begin
+    match c with
+    | ' ' | '\t' | '\n' | '\r' ->
+      Scanning.invalidate_current_char ib; skip_whites ib
+    | _ -> ()
+  end;;
+
+external format_to_string :
+ ('a, 'b, 'c, 'd) format4 -> string = "%identity";;
+external string_to_format :
+ string -> ('a, 'b, 'c, 'd) format4 = "%identity";;
 
 (* The [kscanf] main scanning function.
    It takes as arguments:
@@ -834,7 +899,7 @@ let skip_whites ib =
    aborts and applies the scanning buffer and a string that explains
    the error to the error handling function [ef] (the error continuation). *)
 let kscanf ib ef fmt f =
-  let fmt = string_of_format fmt in
+  let fmt = format_to_string fmt in
   let lim = String.length fmt - 1 in
 
   let return v = Obj.magic v () in
@@ -847,11 +912,11 @@ let kscanf ib ef fmt f =
     match fmt.[i] with
     | ' ' -> skip_whites ib; scan_fmt f (i + 1)
     | '%' ->
-        if i > lim then bad_format fmt i '%' else
+        if i > lim then incomplete_format fmt else
         scan_conversion false max_int f (i + 1)
-    | '@' as t ->
+    | '@' ->
         let i = i + 1 in
-        if i > lim then bad_format fmt (i - 1) t else begin
+        if i > lim then incomplete_format fmt else begin
         check_char ib fmt.[i];
         scan_fmt f (i + 1) end
     | c -> check_char ib c; scan_fmt f (i + 1)
@@ -859,60 +924,60 @@ let kscanf ib ef fmt f =
   and scan_conversion skip max f i =
     let stack = if skip then no_stack else stack in
     match fmt.[i] with
-    | '%' as c ->
-        check_char ib c; scan_fmt f (i + 1)
+    | '%' as conv ->
+        check_char ib conv; scan_fmt f (i + 1)
     | 'c' when max = 0 ->
         let c = Scanning.checked_peek_char ib in
         scan_fmt (stack f c) (i + 1)
     | 'c' | 'C' as conv ->
-        if max <> 1 && max <> max_int then bad_format fmt i conv else
-        let x =
+        if max <> 1 && max <> max_int then bad_conversion fmt i conv else
+        let _x =
           if conv = 'c' then scan_char max ib else scan_Char max ib in
         scan_fmt (stack f (token_char ib)) (i + 1)
     | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-        let x = scan_int_conv conv max ib in
+        let _x = scan_int_conv conv max ib in
         scan_fmt (stack f (token_int conv ib)) (i + 1)
     | 'f' | 'g' | 'G' | 'e' | 'E' ->
-        let x = scan_float max ib in
+        let _x = scan_float max ib in
         scan_fmt (stack f (token_float ib)) (i + 1)
     | 'F' ->
-        let x = scan_Float max ib in
+        let _x = scan_Float max ib in
         scan_fmt (stack f (token_float ib)) (i + 1)
     | 's' ->
         let i, stp = scan_fmt_stoppers (i + 1) in
-        let x = scan_string stp max ib in
+        let _x = scan_string stp max ib in
         scan_fmt (stack f (token_string ib)) (i + 1)
     | '[' ->
         let i, char_set = read_char_set fmt (i + 1) in
         let i, stp = scan_fmt_stoppers (i + 1) in
-        let x = scan_chars_in_char_set stp char_set max ib in
+        let _x = scan_chars_in_char_set stp char_set max ib in
         scan_fmt (stack f (token_string ib)) (i + 1)
     | 'S' ->
-        let x = scan_String max ib in
+        let _x = scan_String max ib in
         scan_fmt (stack f (token_string ib)) (i + 1)
     | 'B' | 'b' ->
-        let x = scan_bool max ib in
+        let _x = scan_bool max ib in
         scan_fmt (stack f (token_bool ib)) (i + 1)
-    | 'l' | 'n' | 'L' as t ->
+    | 'l' | 'n' | 'L' as conv ->
         let i = i + 1 in
-        if i > lim then scan_fmt (stack f (get_count t ib)) i else begin
+        if i > lim then scan_fmt (stack f (get_count conv ib)) i else begin
         match fmt.[i] with
         | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' as conv ->
-            let x = scan_int_conv conv max ib in
-            begin match t with
+            let _x = scan_int_conv conv max ib in
+            begin match conv with
             | 'l' -> scan_fmt (stack f (token_int32 conv ib)) (i + 1)
-            | 'L' -> scan_fmt (stack f (token_int64 conv ib)) (i + 1)
-            | _ -> scan_fmt (stack f (token_nativeint conv ib)) (i + 1) end
-        | c -> scan_fmt (stack f (get_count t ib)) i end
-    | 'N' as t ->
-        scan_fmt (stack f (get_count t ib)) (i + 1)
-    | '!' as c ->
+            | 'n' -> scan_fmt (stack f (token_nativeint conv ib)) (i + 1)
+            | _ -> scan_fmt (stack f (token_int64 conv ib)) (i + 1) end
+        | c -> scan_fmt (stack f (get_count conv ib)) i end
+    | 'N' as conv ->
+        scan_fmt (stack f (get_count conv ib)) (i + 1)
+    | '!' ->
         if Scanning.end_of_input ib then scan_fmt f (i + 1)
         else bad_input "end of input not found"
     | '_' ->
-        if i > lim then bad_format fmt i fmt.[lim - 1] else
+        if i > lim then incomplete_format fmt else
         scan_conversion true max f (i + 1)
-    | '0' .. '9' as c ->
+    | '0' .. '9' as conv ->
         let rec read_width accu i =
           if i > lim then accu, i else
           match fmt.[i] with
@@ -920,16 +985,32 @@ let kscanf ib ef fmt f =
              let accu = 10 * accu + int_value_of_char c in
              read_width accu (i + 1)
           | _ -> accu, i in
-        let max, i = read_width (int_value_of_char c) (i + 1) in
-        if i > lim then bad_format fmt i fmt.[lim - 1] else
-        scan_conversion skip max f i
-    | c -> bad_format fmt i c
+        let max, i = read_width (int_value_of_char conv) (i + 1) in
+        if i > lim then incomplete_format fmt else begin
+        match fmt.[i] with
+        | '.' ->
+          let p, i = read_width 0 (i + 1) in
+          scan_conversion skip (max + p + 1) f i
+        | _ -> scan_conversion skip max f i end
+    | '(' | '{' as conv ->
+        let i = succ i in
+        let j =
+          Printf.sub_format incomplete_format bad_conversion conv fmt i + 1 in
+        let mf = String.sub fmt i (j - i - 2) in
+        let _x = scan_String max ib in
+        let rf = token_string ib in
+        if not (compatible_format_type mf rf)
+          then format_mismatch rf mf ib else 
+        if conv = '{' then scan_fmt (stack f rf) j else
+        let nf = scan_fmt (Obj.magic rf) 0 in
+        scan_fmt (stack f nf) j
+    | c -> bad_conversion fmt i c
 
   and scan_fmt_stoppers i =
     if i > lim then i - 1, [] else
     match fmt.[i] with
     | '@' when i < lim -> let i = i + 1 in i, [fmt.[i]]
-    | '@' as c when i = lim -> bad_format fmt i c
+    | '@' when i = lim -> incomplete_format fmt
     | _ -> i - 1, [] in
 
   Scanning.reset_token ib;
@@ -947,3 +1028,16 @@ let fscanf ic = bscanf (Scanning.from_channel ic);;
 let sscanf s = bscanf (Scanning.from_string s);;
 
 let scanf fmt = bscanf Scanning.stdib fmt;;
+
+let bscanf_format ib fmt2 f =
+  let fmt1 = ignore (scan_String max_int ib); token_string ib in
+  let fmt2 = format_to_string fmt2 in
+  if compatible_format_type fmt1 fmt2
+  then let fresh_fmt = String.copy fmt1 in f (string_to_format fresh_fmt)
+  else format_mismatch fmt1 fmt2 ib;;
+
+let sscanf_format s fmt =
+  let fmt = format_to_string fmt in
+  if compatible_format_type s fmt
+  then let fresh_fmt = String.copy s in string_to_format fresh_fmt
+  else bad_input (format_mismatch_err s fmt);;
diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli
index 03cc2d6251..4f830e67c9 100644
--- a/stdlib/scanf.mli
+++ b/stdlib/scanf.mli
@@ -54,17 +54,21 @@ val from_function : (unit -> char) -> scanbuf;;
     an end-of-input condition by raising the exception [End_of_file]. *)
 
 val from_channel : in_channel -> scanbuf;;
-(** [Scanning.from_channel inchan] returns a scanning buffer which reads
-    one character at a time from the input channel [inchan], starting at the
+(** [Scanning.from_channel ic] returns a scanning buffer which reads
+    one character at a time from the input channel [ic], starting at the
     current reading position. *)
 
 val end_of_input : scanbuf -> bool;;
-(** [Scanning.end_of_input scanbuf] tests the end of input condition
+(** [Scanning.end_of_input ib] tests the end-of-input condition
     of the given buffer. *)
 val beginning_of_input : scanbuf -> bool;;
-(** [Scanning.beginning_of_input scanbuf] tests the beginning of input
+(** [Scanning.beginning_of_input ib] tests the beginning of input
     condition of the given buffer. *)
 
+val name_of_input : scanbuf -> string;;
+(** [Scanning.file_name_of_input ib] returns the name of the character
+    source for the input buffer [ib]. *)
+
 end;;
 
 exception Scan_failure of string;;
@@ -73,21 +77,14 @@ exception Scan_failure of string;;
 
 val bscanf :
   Scanning.scanbuf -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
-(** [bscanf ib format f] reads tokens from the scanning buffer [ib] according
-   to the format string [format], converts these tokens to values, and
+(** [bscanf ib fmt f] reads tokens from the scanning buffer [ib] according
+   to the format string [fmt], converts these tokens to values, and
    applies the function [f] to these values.
    The result of this application of [f] is the result of the whole construct.
 
    For instance, if [p] is the function [fun s i -> i + 1], then
    [Scanf.sscanf "x = 1" "%s = %i" p] returns [2].
 
-   Raise [Scanf.Scan_failure] if the given input does not match the format.
-
-   Raise [Failure] if a conversion to a number is not possible.
-
-   Raise [End_of_file] if the end of input is encountered while scanning
-   and the input matches the given format so far.
-
    The format is a character string which contains three types of
    objects:
    - plain characters, which are simply matched with the
@@ -113,7 +110,11 @@ val bscanf :
    - [u]: reads an unsigned decimal integer.
    - [x] or [X]: reads an unsigned hexadecimal integer.
    - [o]: reads an unsigned octal integer.
-   - [s]: reads a string argument (by default strings end with a space).
+   - [s]: reads a string argument that spreads as much as possible,
+     until the next white space, the next scanning indication, or the
+     end-of-input is reached. Hence, this conversion always succeeds:
+     it returns an empty string if the bounding condition holds
+     when the scan begins.
    - [S]: reads a delimited string argument (delimiters and special
      escaped characters follow the lexical conventions of Caml).
    - [c]: reads a single character. To test the current input character
@@ -139,17 +140,28 @@ val bscanf :
      the format specified by the second letter.
    - [\[ range \]]: reads characters that matches one of the characters
      mentioned in the range of characters [range] (or not mentioned in
-     it, if the range starts with [^]). Returns a [string] that can be
-     empty, if no character in the input matches the range. Hence,
-     [\[0-9\]] returns a string representing a decimal number or an empty
-     string if no decimal digit is found.
+     it, if the range starts with [^]). Reads a [string] that can be
+     empty, if no character in the input matches the range. The set of
+     characters from [c1] to [c2] (inclusively) is denoted by [c1-c2].
+     Hence, [%\[0-9\]] returns a string representing a decimal number
+     or an empty string if no decimal digit is found; similarly,
+     [%\[\\048-\\057\\065-\\070\]] returns a string of hexadecimal digits.
      If a closing bracket appears in a range, it must occur as the
      first character of the range (or just after the [^] in case of
      range negation); hence [\[\]\]] matches a [\]] character and
      [\[^\]\]] matches any character that is not [\]].
+   - [\{ fmt %\}]: reads a format string argument to the format
+     specified by the internal format [fmt]. The format string to be
+     read must have the same type as the internal format [fmt].
+     For instance, "%\{%i%\}" reads any format string that can read a value of
+     type [int]; hence [Scanf.sscanf "fmt:\\\"number is %u\\\"" "fmt:%\{%i%\}"]
+     succeeds and returns the format string ["number is %u"].
+   - [\( fmt %\)]: scanning format substitution.
+     Reads a format string to replace [fmt]. The format string read
+     must have the same type as [fmt].
    - [l]: applies [f] to the number of lines read so far.
    - [n]: applies [f] to the number of characters read so far.
-   - [N]: applies [f] to the number of tokens read so far.
+   - [N] or [L]: applies [f] to the number of tokens read so far.
    - [!]: matches the end of input condition.
    - [%]: matches one [%] character in the input.
 
@@ -160,18 +172,30 @@ val bscanf :
    The field widths are composed of an optional integer literal
    indicating the maximal width of the token to read.
    For instance, [%6d] reads an integer, having at most 6 decimal digits;
-   and [%4f] reads a float with at most 4 characters.
+   [%4f] reads a float with at most 4 characters; and [%8\[\\000-\\255\]]
+   returns the next 8 characters (or all the characters still available,
+   if less than 8 characters are available in the input).
 
-   Scanning indications appear just after the string conversions [s] and
-   [\[ range \]] to delimit the end of the token. A scanning
+   Scanning indications appear just after the string conversions [s]
+   and [\[ range \]] to delimit the end of the token. A scanning
    indication is introduced by a [@] character, followed by some
    constant character [c]. It means that the string token should end
    just before the next matching [c] (which is skipped). If no [c]
    character is encountered, the string token spreads as much as
    possible. For instance, ["%s@\t"] reads a string up to the next
-   tabulation character. If a scanning indication [\@c] does not
-   follow a string conversion, it is ignored and treated as a plain
-   [c] character.
+   tabulation character or to the end of input. If a scanning
+   indication [\@c] does not follow a string conversion, it is treated
+   as a plain [c] character.
+
+   Raise [Scanf.Scan_failure] if the given input does not match the format.
+
+   Raise [Failure] if a conversion to a number is not possible.
+
+   Raise [End_of_file] if the end of input is encountered while some
+   more characters are needed to read the current conversion
+   specification (this means in particular that scanning a [%s]
+   conversion never raises exception [End_of_file]: if the end of
+   input is reached the conversion succeeds and simply returns [""]).
 
    Notes:
 
@@ -182,7 +206,7 @@ val bscanf :
    scanned by [!Scanf.bscanf], it is wise to use printing functions
    from [Format] (or, if you need to use functions from [Printf],
    banish or carefully double check the format strings that contain
-   ['@'] characters).
+   ['\@'] characters).
 
    - in addition to relevant digits, ['_'] characters may appear
    inside numbers (this is reminiscent to the usual Caml
@@ -193,7 +217,7 @@ val bscanf :
    analysis and parsing. If it appears not expressive enough for your
    needs, several alternative exists: regular expressions (module
    [Str]), stream parsers, [ocamllex]-generated lexers,
-   [ocamlyacc]-generated parsers. 
+   [ocamlyacc]-generated parsers.
 *)
 
 val fscanf : in_channel -> ('a, Scanning.scanbuf, 'b) format -> 'a -> 'b;;
@@ -230,3 +254,16 @@ val kscanf :
   some conversion fails, the scanning function aborts and applies the
   error handling function [ef] to the scanning buffer and the
   exception that aborted the scanning process. *)
+
+val bscanf_format :
+  Scanning.scanbuf -> ('a, 'b, 'c, 'd) format4 ->
+    (('a, 'b, 'c, 'd) format4 -> 'e) -> 'e;;
+(** [bscanf_format ib fmt f] reads a [format] argument to the format
+  specified by the second argument. The [format] argument read in
+  buffer [ib] must have the same type as [fmt]. *)
+
+val sscanf_format :
+  string -> ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4;;
+(** [sscanf_format ib fmt f] reads a [format] argument to the format
+  specified by the second argument and returns it. The [format]
+  argument read in string [s] must have the same type as [fmt]. *)
diff --git a/stdlib/set.mli b/stdlib/set.mli
index 69b0895f1e..851a9ef51c 100644
--- a/stdlib/set.mli
+++ b/stdlib/set.mli
@@ -20,10 +20,10 @@
    are purely applicative (no side-effects).
    The implementation uses balanced binary trees, and is therefore
    reasonably efficient: insertion and membership take time
-   logarithmic in the size of the set, for instance. 
+   logarithmic in the size of the set, for instance.
 *)
 
-module type OrderedType = 
+module type OrderedType =
   sig
     type t
       (** The type of the set elements. *)
@@ -103,7 +103,7 @@ module type S =
     val exists: (elt -> bool) -> t -> bool
     (** [exists p s] checks if at least one element of
        the set satisfies the predicate [p]. *)
-        
+
     val filter: (elt -> bool) -> t -> t
     (** [filter p s] returns the set of all elements in [s]
        that satisfy predicate [p]. *)
diff --git a/stdlib/sys.ml b/stdlib/sys.ml
index 579ec2cde5..6492c68bce 100644
--- a/stdlib/sys.ml
+++ b/stdlib/sys.ml
@@ -78,4 +78,4 @@ let catch_break on =
 
 (* OCaml version string, must be in the format described in sys.mli. *)
 
-let ocaml_version = "3.08.3";;
+let ocaml_version = "3.09+dev35 (2005-09-30)";;
diff --git a/stdlib/sys.mli b/stdlib/sys.mli
index 9c829b1660..920dc98573 100644
--- a/stdlib/sys.mli
+++ b/stdlib/sys.mli
@@ -81,7 +81,9 @@ val max_string_length : int
 (** Maximum length of a string. *)
 
 val max_array_length : int
-(** Maximum length of an array. *)
+(** Maximum length of a normal array.  The maximum length of a float
+    array is [max_array_length/2] on 32-bit machines and
+    [max_array_length] on 64-bit machines. *)
 
 
 (** {6 Signal handling} *)
@@ -89,7 +91,7 @@ val max_array_length : int
 
 type signal_behavior =
     Signal_default
-  | Signal_ignore 
+  | Signal_ignore
   | Signal_handle of (int -> unit)
 (** What to do when receiving a signal:
    - [Signal_default]: take the default behavior