Improved IO

diff -Nur ocaml-extlib-read-only.orig/extlib/IO.ml ocaml-extlib-read-only/extlib/IO.ml
--- ocaml-extlib-read-only.orig/extlib/IO.ml	2008-08-28 14:33:26.000000000 +0200
+++ ocaml-extlib-read-only/extlib/IO.ml	2008-08-28 14:30:47.000000000 +0200
@@ -1,6 +1,7 @@
 (*
  * IO - Abstract input/output
  * Copyright (C) 2003 Nicolas Cannasse
+ *               2008 David Teller (contributor)
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -18,6 +19,9 @@
  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  *)
 
+open ExtString
+
+
 type input = {
 	mutable in_read : unit -> char;
 	mutable in_input : string -> int -> int -> int;
@@ -35,8 +39,21 @@
 exception Input_closed
 exception Output_closed
 
-(* -------------------------------------------------------------- *)
-(* API *)
+(**
+   {6 Exception management}
+*)
+(** [apply_enum f x] applies [f] to [x] and converts exceptions
+    [No_more_input] and [Input_closed] to [Enum.No_more_elements]*)
+let apply_enum f x =
+  try f x
+  with No_more_input 
+    |  Input_closed  -> raise Enum.No_more_elements
+
+
+(**
+   {6 API}
+*)
+
 
 let default_close = (fun () -> ())
 
@@ -145,9 +162,6 @@
 	if p + l > sl || p < 0 || l < 0 then invalid_arg "IO.output";
 	o.out_output s p l
 
-let printf o fmt =
-	Printf.kprintf (fun s -> nwrite o s) fmt
-
 let flush o = o.out_flush()
 
 let close_out o =
@@ -211,8 +225,10 @@
 		out_flush = o.out_flush;
 	} , (fun () -> !p)
 
-(* -------------------------------------------------------------- *)
-(* Standard IO *)
+(**
+   {6 Standard IO}
+*)
+
 
 let input_string s =
 	let pos = ref 0 in
@@ -248,6 +264,13 @@
 		out_flush = (fun () -> ());
 	}
 
+let output_buffer buf =
+  {
+    out_write = Buffer.add_char buf;
+    out_output= (fun s p l -> Buffer.add_substring buf s p l; l);
+    out_close = (fun () -> Buffer.contents buf);
+    out_flush = (fun () -> ());
+  }
 let input_channel ch =
 	{
 		in_read = (fun () ->
@@ -316,6 +339,19 @@
 		);
 		out_flush = (fun () -> ());
 	}
+let comb (a,b) =
+  create_out ~write:(fun c -> 
+		       write a c;
+		       write b c)
+    ~output:(fun s i j ->
+	       let _ = output a s i j in
+		 output b s i j)
+    ~flush:(fun () ->
+	      flush a;
+	      flush b)
+    ~close:(fun () ->
+	      let _ = close_out a in
+	      close_out b)
 
 let pipe() =
 	let input = ref "" in
@@ -362,8 +398,10 @@
 
 external cast_output : 'a output -> unit output = "%identity"
 
-(* -------------------------------------------------------------- *)
-(* BINARY APIs *)
+(**
+   {6 Binary APIs}
+*)
+
 
 exception Overflow of string
 
@@ -375,7 +413,7 @@
 		c - 256
 	else
 		c
-
+  
 let read_string i =
 	let b = Buffer.create 8 in
 	let rec loop() =
@@ -467,6 +505,9 @@
 let read_double ch =
 	Int64.float_of_bits (read_i64 ch)
 
+let read_float ch =
+	Int32.float_of_bits (read_real_i32 ch)
+
 let write_byte o n =
 	(* doesn't test bounds of n in order to keep semantics of Pervasives.output_byte *)
 	write o (Char.unsafe_chr (n land 0xFF))
@@ -512,8 +553,12 @@
 let write_double ch f =
 	write_i64 ch (Int64.bits_of_float f)
 
-(* -------------------------------------------------------------- *)
-(* Big Endians *)
+let write_float ch f =
+        write_real_i32 ch (Int32.bits_of_float f)
+
+(**
+   {6 Big Endians}
+*)
 
 module BigEndian = struct
 
@@ -565,6 +610,9 @@
 let read_double ch =
 	Int64.float_of_bits (read_i64 ch)
 
+let read_float ch =
+	Int32.float_of_bits (read_real_i32 ch)
+
 let write_ui16 ch n =
 	if n < 0 || n > 0xFFFF then raise (Overflow "write_ui16");
 	write_byte ch (n lsr 8);
@@ -598,10 +646,59 @@
 let write_double ch f =
 	write_i64 ch (Int64.bits_of_float f)
 
+let write_float ch f =
+	write_real_i32 ch (Int32.bits_of_float f)
+
+let ui16s_of input     = Enum.from (fun () -> apply_enum read_ui16 input)
+
+let i16s_of input      = Enum.from (fun () -> apply_enum read_i16 input)
+
+let i32s_of input      = Enum.from (fun () -> apply_enum read_i32 input)
+
+let real_i32s_of input = Enum.from (fun () -> apply_enum read_real_i32 input)
+
+let i64s_of input      = Enum.from (fun () -> apply_enum read_i64 input)
+
+let doubles_of input   = Enum.from (fun () -> apply_enum read_double input)
+
+let floats_of input    = Enum.from (fun () -> apply_enum read_float input)
+
+let write_byte_enum output enum =
+  Enum.iter (write_byte output) enum
+
+let write_ui16_enum output enum =
+  Enum.iter (write_ui16 output) enum
+
+let write_i16_enum output enum =
+  Enum.iter (write_i16 output) enum
+
+let write_i32_enum output enum =
+  Enum.iter (write_i32 output) enum
+
+let write_real_i32_enum output enum =
+  Enum.iter (write_real_i32 output) enum
+
+let write_i64_enum output enum =
+  Enum.iter (write_i64 output) enum
+
+let write_double_enum output enum =
+  Enum.iter (write_double output) enum
+
+let write_float_enum output enum =
+  Enum.iter (write_float output) enum
+
+let write_string_enum output enum =
+  Enum.iter (write_string output) enum
+
+let write_line_enum output enum =
+  Enum.iter (write_line output) enum
+
+
 end
 
-(* -------------------------------------------------------------- *)
-(* Bits API *)
+(**
+   {6 Bits API}
+*)
 
 type 'a bc = {
 	ch : 'a;
@@ -676,8 +773,10 @@
 let flush_bits b =
 	if b.nbits > 0 then write_bits b (8 - b.nbits) 0
 
-(* -------------------------------------------------------------- *)
-(* Generic IO *)
+(**
+   {6 Generic IO}
+*)
+
 
 class in_channel ch =
   object
@@ -767,3 +866,696 @@
 		~output
 		~flush:ch#flush
 		~close:ch#close_out
+(**
+   {6 Enumerations}
+*)
+
+let bytes_of input        = Enum.from (fun () -> apply_enum read_byte input)
+
+let signed_bytes_of input = Enum.from (fun () -> apply_enum read_signed_byte input)
+
+let ui16s_of input        = Enum.from (fun () -> apply_enum read_ui16 input)
+
+let i16s_of input         = Enum.from (fun () -> apply_enum read_i16 input)
+
+let i32s_of input         = Enum.from (fun () -> apply_enum read_i32 input)
+
+let real_i32s_of input    = Enum.from (fun () -> apply_enum read_real_i32 input)
+
+let i64s_of input         = Enum.from (fun () -> apply_enum read_i64 input)
+
+let doubles_of input      = Enum.from (fun () -> apply_enum read_double input)
+
+let floats_of input       = Enum.from (fun () -> apply_enum read_float input)
+
+let strings_of input      = Enum.from (fun () -> apply_enum read_string input)
+
+let lines_of input        = Enum.from (fun () -> apply_enum read_line input)
+
+
+let buffer_size = 1024
+
+let chars_of the_input = Enum.concat (Enum.from (fun () -> 
+   apply_enum (fun source -> String.enum (nread source buffer_size)) the_input))
+
+let bits_of in_bits = Enum.from (fun () -> apply_enum read_bits in_bits 1)
+
+let write_byte_enum output enum =
+  Enum.iter (write_byte output) enum
+
+let write_ui16_enum output enum =
+  Enum.iter (write_ui16 output) enum
+
+let write_i16_enum output enum =
+  Enum.iter (write_i16 output) enum
+
+let write_i32_enum output enum =
+  Enum.iter (write_i32 output) enum
+
+let write_real_i32_enum output enum =
+  Enum.iter (write_real_i32 output) enum
+
+let write_i64_enum output enum =
+  Enum.iter (write_i64 output) enum
+
+let write_double_enum output enum =
+  Enum.iter (write_double output) enum
+
+let write_float_enum output enum =
+  Enum.iter (write_float output) enum
+
+let write_string_enum output enum =
+  Enum.iter (write_string output) enum
+
+let write_line_enum output enum =
+  Enum.iter (write_line output) enum
+
+let write_bits_enum ~nbits output enum =
+  Enum.iter (write_bits ~nbits output) enum
+
+(**
+   {6 Standard IO}
+*)
+
+
+let stdin = input_channel Pervasives.stdin
+let stdout= output_channel Pervasives.stdout
+let stderr= output_channel Pervasives.stderr
+let stdnull= create_out
+  ~write:ignore 
+  ~output:(fun _ _ l -> l)
+  ~flush:ignore
+  ~close:ignore
+
+(**
+   {6 Printf}
+
+   A reimplementation of Printf (with a few additional functions) based
+   on [output].    We provide an internal signature to limit the dangers
+   of {!Obj.magic}.
+
+   {b Note} this module is inlined because of circular dependencies (themselves
+   caused by the legacy definition of a function {!printf} in module {!IO}).
+*)
+
+module Printf :
+sig
+  val printf: ('b, 'a output, unit) format -> 'b
+    (**The usual [printf] function, prints to
+       [stdout].*)
+
+  val eprintf: ('b, 'a output, unit) format -> 'b
+    (**The usual [eprintf] function, prints to
+       [stderr].*)
+
+  val sprintf:  ('a, unit, string) format -> 'a
+    (** As [fprintf] but outputs are replaced with
+	strings. In particular, any function called with 
+	[%a] should have type [unit -> string].*)
+
+  val sprintf2: ('a, 'b output, unit, string) format4 -> 'a
+    (**As [printf] but produces a string instead
+       of printing to the output. By opposition to
+       [sprintf], only the result is changed with
+       respect to [printf], not the inner workings.*)
+
+
+  val fprintf: 'a output -> ('b, 'a output, unit) format -> 'b
+    (**General printf, prints to any output.*)
+
+  val ifprintf: _        -> ('b, 'a output, unit) format -> 'b
+    (**As [fprintf] but doesn't actually print anything.
+       Sometimes useful for debugging.*)
+
+  val bprintf: Buffer.t  -> ('a, Buffer.t, unit) format -> 'a
+    (**As [fprintf], but with buffers instead of outputs.*)
+
+  val bprintf2: Buffer.t  -> ('b, 'a output, unit) format -> 'b
+    (**As [printf] but writes to a buffer instead
+       of printing to the output. By opposition to
+       [bprintf], only the result is changed with
+       respect to [printf], not the inner workings.*)
+
+  val kfprintf : ('a output -> 'b) -> 'a output -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (**Same as [fprintf], but instead of returning immediately, passes the [output] 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 ksprintf2: (string -> 'b) -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (** Same as [sprintf2] above, but instead of returning the string,
+	passes it to the first argument. *)
+
+  val kbprintf : (Buffer.t -> 'a) ->
+       Buffer.t -> ('b, Buffer.t, unit, 'a) format4 -> 'b
+    (** Same as [bprintf], but instead of returning immediately,
+	passes the buffer to its first argument at the end of printing. *)
+  val kbprintf2 : (Buffer.t -> 'b) ->  Buffer.t -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (** Same as [bprintf2], but instead of returning immediately,
+	passes the buffer to its first argument at the end of printing.*)
+
+  val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
+
+  val mkprintf: ('a output -> 'b) -> 'a output -> ('c, 'a output, unit, 'b) format4 -> 'c
+end
+=
+struct
+external format_float: string -> float -> string
+  = "caml_format_float"
+external format_int: string -> int -> string
+  = "caml_format_int"
+external format_int32: string -> int32 -> string
+  = "caml_int32_format"
+external format_nativeint: string -> nativeint -> string
+  = "caml_nativeint_format"
+external format_int64: string -> int64 -> string
+  = "caml_int64_format"
+
+module Sformat = struct
+
+  type index;;
+
+  external unsafe_index_of_int : int -> index = "%identity";;
+  let index_of_int i =
+    if i >= 0 then unsafe_index_of_int i
+    else failwith ("index_of_int: negative argument " ^ string_of_int i);;
+  external int_of_index : index -> int = "%identity";;
+
+  let add_int_index i idx = index_of_int (i + int_of_index idx);;
+  let succ_index = add_int_index 1;;
+
+  external length : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int
+    = "%string_length";;
+  external get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
+    = "%string_safe_get";;
+  external unsafe_get : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> int -> char
+    = "%string_unsafe_get";;
+  external unsafe_to_string : ('a, 'b, 'c, 'd, 'e, 'f) format6 -> string
+    = "%identity";;
+  let sub fmt idx len =
+    String.sub (unsafe_to_string fmt) (int_of_index idx) len;;
+  let to_string fmt = sub fmt (unsafe_index_of_int 0) (length fmt);;
+
+end;;
+
+let bad_conversion sfmt i c =
+  invalid_arg
+    ("printf: bad conversion %" ^ String.make 1 c ^ ", at char number " ^
+     string_of_int i ^ " in format string ``" ^ sfmt ^ "''");;
+
+let bad_conversion_format fmt i c =
+  bad_conversion (Sformat.to_string fmt) i c;;
+
+let incomplete_format fmt =
+  invalid_arg
+    ("printf: premature end of format string ``" ^
+     Sformat.to_string fmt ^ "''");;
+
+(* Parses a string conversion to return the specified length and the padding direction. *)
+let parse_string_conversion sfmt =
+  let rec parse neg i =
+    if i >= String.length sfmt then (0, neg) else
+    match String.unsafe_get sfmt i with
+    | '1'..'9' ->
+      (int_of_string
+         (String.sub sfmt i (String.length sfmt - i - 1)),
+       neg)
+    | '-' -> parse true (succ i)
+    | _   -> parse neg  (succ i) in
+  try parse false 1 with Failure _ -> bad_conversion sfmt 0 's'
+
+(* Pad a (sub) string into a blank string of length [p],
+   on the right if [neg] is true, on the left otherwise. *)
+let pad_string pad_char p neg s i len =
+  if p = len && i = 0 then s else
+  if p <= len then String.sub s i len else
+  let res = String.make p pad_char in
+  if neg
+  then String.blit s i res 0 len
+  else String.blit s i res (p - len) len;
+  res
+
+(* Format a string given a %s format, e.g. %40s or %-20s.
+   To do: ignore other flags (#, +, etc)? *)
+let format_string sfmt s =
+  let (p, neg) = parse_string_conversion sfmt in
+  pad_string ' ' p neg s 0 (String.length s);;
+
+(* Extract a format string out of [fmt] between [start] and [stop] inclusive.
+   '*' in the format are replaced by integers taken from the [widths] list.
+   extract_format returns a string. *)
+let extract_format fmt start stop widths =
+  let start = 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 (Sformat.unsafe_get fmt i, widths) with
+      | ('*', h :: t) ->
+        Buffer.add_string b (string_of_int h);
+        let i = 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 extract_format_int conv fmt start stop widths =
+   let sfmt = extract_format fmt start stop widths in
+   match conv with
+   | 'n' | 'N' ->
+     sfmt.[String.length sfmt - 1] <- 'u';
+     sfmt
+   | _ -> sfmt;;
+
+(* Returns the position of the next character following 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 following the [')'] or ['}'] that ends the meta format,
+   according to the character [conv]. *)
+let sub_format incomplete_format bad_conversion_format conv fmt i =
+  let len = Sformat.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 Sformat.get fmt j with
+       | '%' -> sub_sub (succ j)
+       | _ -> sub (succ j)
+    and sub_sub j =
+       if j >= len then incomplete_format fmt else
+       match Sformat.get fmt j with
+       | '(' | '{' as c ->
+         let j = sub_fmt c (succ j) in sub (succ j)
+       | '}' | ')' as c ->
+         if c = close then succ j else bad_conversion_format fmt i c
+       | _ -> sub (succ j) in
+    sub i in
+  sub_fmt conv i;;
+
+let sub_format_for_printf conv =
+  sub_format incomplete_format bad_conversion_format conv;;
+
+let iter_on_format_args fmt add_conv add_char =
+
+  let lim = Sformat.length fmt - 1 in
+
+  let rec scan_flags skip i =
+    if i > lim then incomplete_format fmt else
+    match Sformat.unsafe_get fmt i with
+    | '*' -> scan_flags skip (add_conv skip i '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 > lim then incomplete_format fmt else
+    match Sformat.unsafe_get fmt i with
+    | '%' | '!' -> succ i
+    | 's' | 'S' | '[' -> add_conv skip i 's'
+    | 'c' | 'C' -> add_conv skip i 'c'
+    | 'd' | 'i' |'o' | 'u' | 'x' | 'X' | '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' | 'r' | 't' as conv -> add_conv skip i conv
+    | 'l' | 'n' | 'L' as conv ->
+      let j = succ i in
+      if j > lim then add_conv skip i 'i' else begin
+        match Sformat.get fmt j with
+        | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
+          add_char (add_conv skip i conv) 'i'
+        | c -> add_conv skip i 'i' end
+    | '{' as conv ->
+      (* Just get a regular argument, skipping the specification. *)
+      let i = add_conv skip i conv in
+      (* To go on, find the index of the next char after the meta format. *)
+      let j = sub_format_for_printf conv fmt i in
+      (* Add the meta specification to the summary anyway. *)
+      let rec loop i =
+        if i < j - 2 then loop (add_char i (Sformat.get fmt i)) in
+      loop i;
+      (* Go on, starting at the closing brace to properly close the meta
+         specification in the summary. *)
+      scan_conv skip (j - 1)
+    | '(' as conv ->
+      (* Use the static format argument specification instead of
+         the runtime format argument value: they must have the same type
+         anyway. *)
+      scan_fmt (add_conv skip i conv)
+    | '}' | ')' as conv -> add_conv skip i conv
+    | conv -> bad_conversion_format fmt i conv
+
+  and scan_fmt i =
+    if i < lim then
+     if Sformat.get fmt i = '%'
+     then scan_fmt (scan_flags false (succ i))
+     else scan_fmt (succ i)
+    else i in
+
+  ignore (scan_fmt 0);;
+
+(* Returns a string that summarizes the typing information that a given
+   format string contains.
+   For instance, [summarize_format_type "A number %d\n"] is "%i".
+   It also checks the well-formedness of the format string. *)
+let summarize_format_type fmt =
+  let len = Sformat.length fmt in
+  let b = Buffer.create len in
+  let add_char i c = Buffer.add_char b c; succ i in
+  let add_conv skip i c =
+    if skip then Buffer.add_string b "%_" else Buffer.add_char b '%';
+    add_char i c in
+  iter_on_format_args fmt add_conv add_char;
+  Buffer.contents b;;
+
+module Ac = struct
+  type ac = {
+    mutable ac_rglr : int;
+    mutable ac_skip : int;
+    mutable ac_rdrs : int;
+  }
+end;;
+
+open Ac;;
+
+(* Computes the number of arguments of a format (including flag
+   arguments if any). *)
+let ac_of_format fmt =
+  let ac = { ac_rglr = 0; ac_skip = 0; ac_rdrs = 0; } in
+  let incr_ac skip c =
+    let inc = if c = 'a' then 2 else 1 in
+    if c = 'r' then ac.ac_rdrs <- ac.ac_rdrs + 1;
+    if skip
+    then ac.ac_skip <- ac.ac_skip + inc
+    else ac.ac_rglr <- ac.ac_rglr + inc in
+  let add_conv skip i c =
+    (* Just finishing a meta format: no additional argument to record. *)
+    if c <> ')' && c <> '}' then incr_ac skip c;
+    succ i
+  and add_char i c = succ i in
+
+  iter_on_format_args fmt add_conv add_char;
+  ac;;
+
+let count_arguments_of_format fmt =
+  let ac = ac_of_format fmt in
+  ac.ac_rglr + ac.ac_skip + ac.ac_rdrs;;
+
+let list_iter_i f l =
+  let rec loop i = function
+  | [] -> ()
+  | [x] -> f i x (* Tail calling [f] *)
+  | 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 count_arguments_of_format 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 [];;
+
+(* Get the index of the next argument to printf. *)
+let next_index n = Sformat.succ_index n;;
+
+(* Decode a format string and act on it.
+   [fmt] is the printf format string, and [pos] points to a [%] character.
+   After consuming the appropriate number of arguments and formatting
+   them, one of the five continuations is called:
+   [cont_s] for outputting a string (args: arg num, string, next pos)
+   [cont_a] for performing a %a action (args: arg num, fn, arg, next pos)
+   [cont_t] for performing a %t action (args: arg num, fn, next pos)
+   [cont_f] for performing a flush action (args: arg num, next pos)
+   [cont_m] for performing a %( action (args: arg num, sfmt, next pos)
+
+   "arg num" is the index in array args of the next argument to printf.
+   "next pos" is the position in [fmt] of the first character following
+   the %conversion specification in [fmt]. *)
+
+(* Note: here, rather than test explicitly against [Sformat.length fmt]
+   to detect the end of the format, we use [Sformat.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_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 n =
+    Obj.magic (args.(Sformat.int_of_index n)) in
+
+  let rec scan_flags n widths i =
+    match Sformat.unsafe_get fmt i with
+    | '*' ->
+      let (width : int) = get_arg n in
+      scan_flags (next_index n) (width :: widths) (succ i)
+    | '0'..'9'
+    | '.' | '#' | '-' | ' ' | '+' -> scan_flags n widths (succ i)
+    | _ -> scan_conv n widths i
+
+  and scan_conv n widths i =
+    match Sformat.unsafe_get fmt i with
+    | '%' ->
+      cont_s n "%" (succ i)
+    | 's' | 'S' as conv ->
+      let (x : string) = get_arg 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 (next_index n) s (succ i)
+    | 'c' | 'C' as conv ->
+      let (x : char) = get_arg n in
+      let s =
+        if conv = 'c' then String.make 1 x else "'" ^ Char.escaped x ^ "'" in
+      cont_s (next_index n) s (succ i)
+    | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' | 'N' as conv ->
+      let (x : int) = get_arg n in
+      let s =
+        format_int (extract_format_int conv fmt pos i widths) x in
+      cont_s (next_index n) s (succ i)
+    | 'f' | 'e' | 'E' | 'g' | 'G' ->
+      let (x : float) = get_arg n in
+      let s = format_float (extract_format fmt pos i widths) x in
+      cont_s (next_index n) s (succ i)
+    | 'F' ->
+      let (x : float) = get_arg n in
+      cont_s (next_index n) (string_of_float x) (succ i)
+    | 'B' | 'b' ->
+      let (x : bool) = get_arg n in
+      cont_s (next_index n) (string_of_bool x) (succ i)
+    | 'a' ->
+      let printer = get_arg n in
+      let n = Sformat.succ_index n in
+      let arg = get_arg n in
+      cont_a (next_index n) printer arg (succ i)
+    | 't' ->
+      let printer = get_arg n in
+      cont_t (next_index n) printer (succ i)
+    | 'l' | 'n' | 'L' as conv ->
+      begin match Sformat.unsafe_get fmt (succ i) with
+      | 'd' | 'i' | 'o' | 'u' | 'x' | 'X' ->
+        let i = succ i in
+        let s =
+          match conv with
+          | 'l' ->
+            let (x : int32) = get_arg n in
+            format_int32 (extract_format fmt pos i widths) x
+          | 'n' ->
+            let (x : nativeint) = get_arg n in
+            format_nativeint (extract_format fmt pos i widths) x
+          | _ ->
+            let (x : int64) = get_arg n in
+            format_int64 (extract_format fmt pos i widths) x in
+        cont_s (next_index n) s (succ i)
+      | _ ->
+        let (x : int) = get_arg n in
+        let s = format_int (extract_format_int 'n' fmt pos i widths) x in
+        cont_s (next_index n) s (succ i)
+      end
+    | '!' -> cont_f n (succ i)
+    | '{' | '(' as conv (* ')' '}' *) ->
+      let (xf : ('a, 'b, 'c, 'd, 'e, 'f) format6) = get_arg n in
+      let i = succ i in
+      let j = sub_format_for_printf conv fmt i in
+      if conv = '{' (* '}' *) then
+        (* Just print the format argument as a specification. *)
+        cont_s
+          (next_index n)
+          (summarize_format_type xf)
+          j else
+        (* Use the format argument instead of the format specification. *)
+        cont_m (next_index n) xf j
+    | (* '(' *) ')' ->
+      cont_s n "" (succ i)
+    | conv ->
+      bad_conversion_format fmt i conv in
+
+  scan_flags n [] (succ pos);;
+
+(*Trimmed-down version of the legacy lib's [mkprintf]. Most of the generality
+  is lifted to [output] rather than [mkprintf] itself.*)
+let mkprintf k out fmt =
+
+  let rec pr k n fmt v =
+
+    let len = Sformat.length fmt in
+
+    let rec doprn n i =
+       if i >= len then Obj.magic (k out)
+       else             match Sformat.unsafe_get fmt i with
+	 | '%' -> scan_format fmt v n i cont_s cont_a cont_t cont_f cont_m
+	 |  c  -> write out c; doprn n (succ i)
+    and cont_s n s i =
+      nwrite out s; 
+      doprn n i
+    and cont_a n printer arg i =
+      printer out arg;
+      doprn n i
+    and cont_t n printer i =
+      printer out;
+      doprn n i
+    and cont_f n i =
+      flush out; 
+      doprn n i
+    and cont_m n xf i =
+      let m = Sformat.add_int_index (count_arguments_of_format xf) n in
+	pr (Obj.magic (fun _ -> doprn m i)) n xf v
+
+    in doprn n 0 
+  in let kpr = pr k (Sformat.index_of_int 0) in
+    kapr kpr fmt;;
+
+let fprintf out fmt = mkprintf ignore out fmt
+let printf      fmt = fprintf stdout fmt
+let eprintf     fmt = fprintf stderr fmt
+let ifprintf _  fmt = fprintf stdnull fmt
+let ksprintf2 k fmt =
+  let out = output_string () in
+    mkprintf (fun out -> k (close_out out)) out fmt
+let kbprintf2 k buf fmt =
+  let out = output_buffer buf in
+    mkprintf (fun out -> k buf) out fmt
+let sprintf2 fmt = ksprintf2 (Std.identity) fmt
+let bprintf2 buf fmt = kbprintf2 ignore buf fmt
+(**
+   Other possible implementation of [sprintf2],
+   left as example:
+
+[
+let sprintf2    fmt = 
+  let out = output_string () in
+    mkprintf (fun out -> close_out out) out fmt
+]
+*)
+(**
+   Other possible implementation of [bprintf2],
+   left as example:
+[
+let bprintf2 buf fmt = 
+  let out = output_buffer buf in
+    mkprintf ignore out fmt
+]*)
+
+let kfprintf        = mkprintf
+let bprintf         = Printf.bprintf
+let sprintf         = Printf.sprintf
+let ksprintf        = Printf.ksprintf
+let kbprintf        = Printf.kbprintf
+let kprintf         = Printf.kprintf
+end
+
+let printf = Printf.fprintf
+
+(**
+   {6 Utilities}
+*)
+
+let make_list_printer (p:('a output -> 'b -> unit)) 
+                      (a:string)
+		      (b:string)
+		      (s:string)
+		      (out:'a output)
+		      (l:'b list) = 
+  let rec aux out l = match l with
+  | []    -> ()
+  | [h]   -> p out h
+  | h::t  -> printf out "%a%s%a" p h s aux t
+  in printf out "%s%a%s" a aux l b
+
+
+
+(*
+  (**Commented out until changes to [Enum] and [ExtChar] are accepted.*)
+let tab_out n out =
+  let spaces   = String.make n ' ' in
+  create_out 
+    ~write: (fun c     -> 
+	       printf stderr "Attempting to write %C\n" c;
+	       out.out_write c;
+	       if Char.is_newline c then (
+		 printf stderr "Adding %S\n" spaces;
+		 nwrite out spaces)
+	    )
+    ~output:(fun s p l -> (*Replace each newline within the segment with newline^spaces*)
+	       printf stderr "Attempting to output %S\n" s;
+	       let length = String.length s                 in
+	       let buffer = Buffer.create (String.length s) in
+		 for i = p to min (length - 1) l do
+		   let c = String.unsafe_get s i in
+		     Buffer.add_char buffer c;
+		     if Char.is_newline c then
+		       Buffer.add_string buffer spaces
+		 done;
+		 let s' = Buffer.contents buffer                  in
+		 let _  = printf stderr "Replacing with %S\n" s' in
+		 output out s' 0 (String.length s'))
+    ~flush:out.out_flush
+    ~close:out.out_close
+
+let lmargin n p out x =
+  p (tab_out n out) x*)
+
+let combine = comb
diff -Nur ocaml-extlib-read-only.orig/extlib/IO.mli ocaml-extlib-read-only/extlib/IO.mli
--- ocaml-extlib-read-only.orig/extlib/IO.mli	2008-08-28 14:33:26.000000000 +0200
+++ ocaml-extlib-read-only/extlib/IO.mli	2008-08-28 14:30:47.000000000 +0200
@@ -1,6 +1,8 @@
 (* 
  * IO - Abstract input/output
  * Copyright (C) 2003 Nicolas Cannasse
+ *               2008 David Teller (contributor)
+ *               2008 Philippe Strauss (contributor)
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -43,6 +45,19 @@
 exception Output_closed
 (** This exception is raised when reading on a closed output. *)
 
+(** {6 Standard inputs/outputs} *)
+val stdin : input
+(** Standard input, as per Unix/Windows conventions (by default, keyboard).*)
+
+val stdout: unit output
+(** Standard output, as per Unix/Windows conventions (by default, console).*)
+
+val stderr: unit output
+(** Standard error output, as per Unix/Windows conventions.*)
+
+val stdnull: unit output
+(** An output which discards everything written to it.*)
+
 (** {6 Standard API} *)
 
 val read : input -> char
@@ -100,7 +115,10 @@
 (** Close the output and return its accumulator data.
   It can no longer be written. *)
 
-(** {6 Creation of IO Inputs/Outputs} *)
+(** {6 Creation of IO Inputs/Outputs} 
+
+    To open a file for reading/writing, see {!File.open_file_in}
+    and {!File.open_file_out}*)
 
 val input_string : string -> input
 (** Create an input that will read from a string. *)
@@ -109,11 +127,11 @@
 (** Create an output that will write into a string in an efficient way.
   When closed, the output returns all the data written into it. *)
 
-val input_channel : in_channel -> input
-(** Create an input that will read from a channel. *)
-
-val output_channel : out_channel -> unit output
-(** Create an output that will write into a channel. *) 
+val output_buffer : Buffer.t -> string output
+(** Create an output that will append its results at the end of a buffer
+    in an efficient way. Closing  returns the whole contents of the buffer
+    -- the buffer remains usable.*)
+    
 
 val input_enum : char Enum.t -> input
 (** Create an input that will read from an [enum]. *)
@@ -122,6 +140,10 @@
 (** Create an output that will write into an [enum]. The 
   final enum is returned when the output is closed. *)
 
+val combine : ('a output * 'a output) -> 'a output
+(** [combine (a,b)] creates a new [output] [c] such that
+    writing to [c] will actually write to both [a] and [b] *)
+
 val create_in :
   read:(unit -> char) ->
   input:(string -> int -> int -> int) -> close:(unit -> unit) -> input
@@ -133,10 +155,16 @@
   flush:(unit -> unit) -> close:(unit -> 'a) -> 'a output
 (** Fully create an output by giving all the needed functions. *)
 
-(** {6 Utilities} *)
+(*val tab_out : int -> 'a output -> 'a output
+(** Create an output shifted to the right by a number of white spaces.
+
+    [tab_out n out] produces a new output for writing into [out], in
+    which every new line starts with [n] white spaces.
+    Raises [Invalid_argument] if [n] < 0.*)*)
+
 
-val printf : 'a output -> ('b, unit, string, unit) format4 -> 'b
-(** The printf function works for any output. *)
+
+(** {6 Utilities} *)
 
 val read_all : input -> string
 (** read all the contents of the input until [No_more_input] is raised. *)
@@ -157,6 +185,8 @@
 (** You can safely transform any output to an unit output in a safe way 
   by using this function. *)
 
+
+
 (** {6 Binary files API}
 
 	Here is some API useful for working with binary files, in particular
@@ -190,6 +220,9 @@
 val read_i64 : input -> int64
 (** Read a signed 64-bit integer as an OCaml int64. *)
 
+val read_float : input -> float
+(** Read an IEEE single precision floating point value. *)
+
 val read_double : input -> float
 (** Read an IEEE double precision floating point value. *)
 
@@ -220,6 +253,9 @@
 val write_double : 'a output -> float -> unit
 (** Write an IEEE double precision floating point value. *)
 
+val write_float : 'a output -> float -> unit
+(** Write an IEEE single precision floating point value. *)
+
 val write_string : 'a output -> string -> unit
 (** Write a string and append an null character. *)
 
@@ -237,16 +273,35 @@
 	val read_real_i32 : input -> int32
 	val read_i64 : input -> int64
 	val read_double : input -> float
-	
+	val read_float: input -> float
 	val write_ui16 : 'a output -> int -> unit
 	val write_i16 : 'a output -> int -> unit
 	val write_i32 : 'a output -> int -> unit
 	val write_real_i32 : 'a output -> int32 -> unit
 	val write_i64 : 'a output -> int64 -> unit
 	val write_double : 'a output -> float -> unit
+	val write_float  : 'a output -> float -> unit
+
+	val ui16s_of : input -> int Enum.t
+	val i16s_of : input -> int Enum.t
+	val i32s_of : input -> int Enum.t
+	val real_i32s_of : input -> int32 Enum.t
+	val i64s_of : input -> int64 Enum.t
+	val doubles_of : input -> float Enum.t
+
+	val write_byte_enum : 'a output -> int Enum.t -> unit
+	val write_ui16_enum : 'a output -> int Enum.t -> unit
+	val write_i16_enum : 'a output -> int Enum.t -> unit
+	val write_i32_enum : 'a output -> int Enum.t -> unit
+	val write_real_i32_enum : 'a output -> int32 Enum.t -> unit
+	val write_i64_enum : 'a output -> int64 Enum.t -> unit
+	val write_double_enum : 'a output -> float Enum.t -> unit
+	val write_string_enum : 'a output -> string Enum.t -> unit
+	val write_line_enum : 'a output -> string Enum.t -> unit
 
 end
 
+
 (** {6 Bits API}
 
 	This enable you to read and write from an IO bit-by-bit or several bits
@@ -277,6 +332,17 @@
 val drop_bits : in_bits -> unit
 (** Drop up to 7 buffered bits and restart to next input character. *)
 
+(**
+   {6 For compatibility purposes}
+*)
+val input_channel : in_channel -> input
+(** Create an input that will read from a channel. *)
+
+val output_channel : out_channel -> unit output
+(** Create an output that will write into a channel. *) 
+
+
+
 (** {6 Generic IO Object Wrappers}
 
 	Theses OO Wrappers have been written to provide easy support of ExtLib
@@ -319,3 +385,226 @@
 val from_out_channel : #out_channel -> unit output
 val from_in_chars : #in_chars -> input
 val from_out_chars : #out_chars -> unit output
+
+(** {6 Enumeration API}*)
+
+val bytes_of : input -> int Enum.t
+(** Read an enumeration of unsigned 8-bit integers. *)
+
+val signed_bytes_of : input -> int Enum.t
+(** Read an enumeration of signed 8-bit integers. *)
+
+val ui16s_of : input -> int Enum.t
+(** Read an enumeration of unsigned 16-bit words. *)
+
+val i16s_of : input -> int Enum.t
+(** Read an enumartion of signed 16-bit words. *)
+
+val i32s_of : input -> int Enum.t
+(** Read an enumeration of signed 32-bit integers. Raise [Overflow] if the
+  read integer cannot be represented as a Caml 31-bit integer. *)
+
+val real_i32s_of : input -> int32 Enum.t
+(** Read an enumeration of signed 32-bit integers as OCaml [int32]s. *)
+
+val i64s_of : input -> int64 Enum.t
+(** Read an enumeration of signed 64-bit integers as OCaml [int64]s. *)
+
+val doubles_of : input -> float Enum.t
+(** Read an enumeration of IEEE double precision floating point values. *)
+
+val strings_of : input -> string Enum.t
+(** Read an enumeration of null-terminated strings. *)
+
+val lines_of : input -> string Enum.t
+(** Read an enumeration of LF or CRLF terminated strings. *)
+
+val chars_of : input -> char Enum.t
+(** Read an enumeration of Latin-1 characters. 
+
+    {b Note} Usually faster than calling [read] several times.*)
+
+val bits_of : in_bits -> int Enum.t
+(** Read an enumeration of bits *)
+
+val write_byte_enum : 'a output -> int Enum.t -> unit
+(** Write an enumeration of unsigned 8-bit bytes. *)
+
+val write_ui16_enum : 'a output -> int Enum.t -> unit
+(** Write an enumeration of unsigned 16-bit words. *)
+
+val write_i16_enum : 'a output -> int Enum.t -> unit
+(** Write an enumeration of signed 16-bit words. *)
+
+val write_i32_enum : 'a output -> int Enum.t -> unit
+(** Write an enumeration of signed 32-bit integers. *) 
+
+val write_real_i32_enum : 'a output -> int32 Enum.t -> unit
+(** Write an enumeration of OCaml int32s. *)
+
+val write_i64_enum : 'a output -> int64 Enum.t -> unit
+(** Write an enumeration of OCaml int64s. *)
+
+val write_double_enum : 'a output -> float Enum.t -> unit
+(** Write an enumeration of IEEE double precision floating point value. *)
+
+val write_string_enum : 'a output -> string Enum.t -> unit
+(** Write an enumeration of strings, appending null characters. *)
+
+val write_line_enum : 'a output -> string Enum.t -> unit
+(** Write an enumeration of lines, appending a LF (it might be converted
+    to CRLF on some systems depending on the underlying IO). *)
+
+val write_bits_enum : nbits:int -> out_bits -> int Enum.t -> unit
+(** Write an enumeration of bits*)
+
+(** {6 Printing} *)
+
+(** / *)
+val printf : 'a output -> ('b, 'a output, unit) format -> 'b
+(** A [fprintf]-style unparser. For more information
+    about printing, see the documentation of {!Printf}.
+
+    Obsoleted because of name clash: that's a [fprintf],
+    not a [printf].*)
+(** / *)
+(**
+   Usual [printf]-style functions, adapted for working with
+   [output]
+*)
+module Printf : sig
+  (** {6 Common functions}*)
+
+  val printf: ('b, 'a output, unit) format -> 'b
+    (**The usual [printf] function, prints to
+       [stdout].*)
+
+  val eprintf: ('b, 'a output, unit) format -> 'b
+    (**The usual [eprintf] function, prints to
+       [stderr].*)
+
+  val sprintf:  ('a, unit, string) format -> 'a
+    (** As [fprintf] but outputs are replaced with
+	strings. In particular, any function called with 
+	[%a] should have type [unit -> string].*)
+
+  val sprintf2: ('a, 'b output, unit, string) format4 -> 'a
+    (**As [printf] but produces a string instead
+       of printing to the output. By opposition to
+       [sprintf], only the result is changed with
+       respect to [printf], not the inner workings.*)
+
+  (** {6 General functions}*)
+  val fprintf: 'a output -> ('b, 'a output, unit) format -> 'b
+    (**General printf, prints to any output.*)
+
+  val ifprintf: _        -> ('b, 'a output, unit) format -> 'b
+    (**As [fprintf] but doesn't actually print anything.
+       Sometimes useful for debugging.*)
+
+  val bprintf: Buffer.t  -> ('a, Buffer.t, unit) format -> 'a
+    (**As [fprintf], but with buffers instead of outputs.
+       In particular, any unparser called with [%a] should
+       write to a buffer rather than to an output*)
+
+  val bprintf2: Buffer.t  -> ('b, 'a output, unit) format -> 'b
+    (**As [printf] but writes to a buffer instead
+       of printing to the output. By opposition to
+       [bprintf], only the result is changed with
+       respect to [printf], not the inner workings.*)
+
+  (**{6 Functions with continuations}*)
+    
+  val kfprintf : ('a output -> 'b) -> 'a output -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (**Same as [fprintf], but instead of returning immediately, passes the [output] 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 ksprintf2: (string -> 'b) -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (** Same as [sprintf2] above, but instead of returning the string,
+	passes it to the first argument. *)
+
+  val kbprintf : (Buffer.t -> 'a) ->
+       Buffer.t -> ('b, Buffer.t, unit, 'a) format4 -> 'b
+    (** Same as [bprintf], but instead of returning immediately,
+	passes the buffer to its first argument at the end of printing. *)
+  val kbprintf2 : (Buffer.t -> 'b) ->  Buffer.t -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (** Same as [bprintf2], but instead of returning immediately,
+	passes the buffer to its first argument at the end of printing.*)
+
+    (**/**)
+  val kprintf : (string -> 'a) -> ('b, unit, string, 'a) format4 -> 'b
+    (** A deprecated synonym for [ksprintf]. *)
+    (**/**)
+
+    (**
+       {6 About formats}
+
+       Only read this if you intend to toy  with [mkprintf].
+
+      
+       {7 Format4}
+       [('a, 'b, 'c, 'd) format4] = is the type of arguments for
+       [printf]-style functions such that
+       - ['a] is the type of arguments, with a return type of ['d]
+         {ul
+         {- if your format looks like ["%s"], ['a] is [string -> 'd]}
+         {- if your format looks like ["%s%s"], ['a] is [string -> string -> 'd]}
+         {- ...}
+         }
+       - ['b] is the type of the first argument given to unparsers
+         (i.e. functions introduced with [%a] or [%t])
+         {ul
+         {- if your unparsers take a [unit] argument, ['b] should be 
+            [unit]}
+         {- if your unparsers take a [string output], ['b] should be 
+            [string output]}
+         {- ...}
+         }
+       - ['c] is the {b final} return type of unparsers
+         {ul
+         {- if you have an unparser introduced with [%t] and its result
+            has type [unit], ['c] should be [unit]
+         {- if you have an unparser introduced with [%a] and its type is
+            [string output -> string -> unit], ['c] should be [unit]}
+         {- ...}
+         }
+       - ['d] is the final return value of the function once all
+         arguments have been applied.
+
+       {7 Format}
+       [('a, 'b, c) format] is just a shortcut for [('a, 'b, 'c, 'd) format4].
+
+       {7 Important}
+       Note that [Obj.magic] is involved behind this, so be careful.
+    *)
+
+  val mkprintf: ('a output -> 'b) -> 'a output -> ('c, 'a output, unit, 'b) format4 -> 'c
+    (**Generic builder for [printf]-style functions.
+
+      [mkprintf k] builds a [fprintf]-style function which calls [k] upon the
+       channel once the evaluation of all arguments is complete.
+
+      Obj.magic is involved, {b Here Be Dragons}.
+*)
+end
+
+val make_list_printer: ('a output -> 'b -> unit) -> string -> string -> string -> ('a output -> 'b list -> unit)
+(** Make a list printer
+
+    [make_list_printer printer start_symbol end_symbol separator] creates a printer for
+    lists, which prints [start_symbol] at the beginning of the list, [end_symbol] at
+    the end, uses [printer] for each element of the contents and separates these
+    elements with [separator]
+*)
+
+(*val lmargin : int -> ('b output -> 'a -> unit) -> 'b output -> 'a -> unit
+(** [lmargin n p] behaves as [p], with the exception that every new line from this
+    point will be shifted to the right by [n] white spaces*)*)
+
+
+(**/**)
+val comb : ('a output * 'a output) -> 'a output
+(** Old name of [combine]*)
diff -Nur ocaml-extlib-read-only.orig/extlib/.svn/entries ocaml-extlib-read-only/extlib/.svn/entries
--- ocaml-extlib-read-only.orig/extlib/.svn/entries	2008-08-28 14:33:26.000000000 +0200
+++ ocaml-extlib-read-only/extlib/.svn/entries	2008-08-28 14:08:56.000000000 +0200
@@ -32,7 +32,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 99ee33dfaca5b476b251612af369253d
 2007-12-28T20:23:32.408536Z
 361
@@ -44,7 +44,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 35a8275bb8888c83d5c07899aa7cd718
 2007-12-28T20:23:32.408536Z
 361
@@ -56,7 +56,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 cd6f16b4f39c9c8e28377a9ed6f38d2c
 2004-07-26T19:11:14.000000Z
 231
@@ -68,7 +68,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 87f07e547cd66bfac4928e074ccc808d
 2007-12-28T20:23:32.408536Z
 361
@@ -80,7 +80,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 337baf3ae6550941e5e9c8b6c0f9373c
 2007-12-28T20:23:32.408536Z
 361
@@ -92,7 +92,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 890ecca9fa4a02cbfce25324827463b4
 2007-12-28T20:23:32.408536Z
 361
@@ -104,7 +104,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 3726001556e37089a57cce789671b045
 2007-12-28T20:23:32.408536Z
 361
@@ -116,7 +116,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 c6b23c4d7f4d327a4f04f6f4280816c1
 2006-03-07T11:07:22.000000Z
 346
@@ -128,7 +128,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 295efb5994c0045f0b2db8342ce742f1
 2005-05-07T08:51:04.000000Z
 317
@@ -140,7 +140,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 c722b2a6827a7fe53dbb2f607ef94125
 2007-04-08T17:23:41.000000Z
 351
@@ -152,7 +152,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 28f666c5cb1d03a34e7306f1cf44103c
 2005-02-08T10:04:19.000000Z
 308
@@ -164,7 +164,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 ef9e13836bc4ac05ac3170d9c8de592c
 2005-12-06T20:47:38.000000Z
 342
@@ -176,7 +176,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 2164faa5f23827a771429c96303cea51
 2008-04-23T12:03:57.089785Z
 380
@@ -188,7 +188,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 593d007dd9f2c22e6bd0bbea2d0d4bbf
 2004-09-20T14:09:33.000000Z
 257
@@ -200,7 +200,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 68e1fb912a508c90d5ce62578ece4a11
 2005-05-19T08:01:04.000000Z
 321
@@ -212,7 +212,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 08d15fdba87860e6879ace4101846003
 2006-02-20T16:04:42.000000Z
 344
@@ -224,7 +224,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 8e050d62b1bc6a3f6fdab6c0fb0b662d
 2004-05-06T09:44:41.000000Z
 199
@@ -236,7 +236,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 1236bbeadb622950524e504d01e75143
 2004-05-06T09:44:41.000000Z
 199
@@ -248,7 +248,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 364041e3fdd415c7d7d7fd4502b27b8e
 2007-12-28T20:23:32.408536Z
 361
@@ -260,7 +260,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 b6ff2f96d0de2d3001c304d13eb6135b
 2004-05-06T09:44:41.000000Z
 199
@@ -272,7 +272,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 6f609ef2adc95047b9c2cd07050394a0
 2005-05-07T08:51:04.000000Z
 317
@@ -284,7 +284,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 24766e36ac2fc85bdf70256e819e076a
 2004-10-26T06:58:20.000000Z
 262
@@ -296,7 +296,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 898b8daad72357979be000180f6b9a52
 2004-05-06T09:44:41.000000Z
 199
@@ -308,7 +308,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 d5c84916a0118eefacae63f44ba285ff
 2005-11-24T15:20:07.000000Z
 331
@@ -320,7 +320,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 bf250921a42c0cc75c2cb97758e8cdfb
 2005-02-17T23:51:06.000000Z
 312
@@ -332,7 +332,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 4150da91e7254bc321bb206ef240f881
 2004-05-06T09:44:41.000000Z
 199
@@ -344,7 +344,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 d7e7a3956a079c9dc0c63eb965d60231
 2006-03-06T20:53:18.000000Z
 345
@@ -356,7 +356,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 d4d740323afde7f715e0a65f280f1f03
 2007-11-27T19:46:53.000000Z
 352
@@ -368,7 +368,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 2cb67f54588406f885ca9d1e7aa14535
 2004-05-06T09:44:41.000000Z
 199
@@ -380,7 +380,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 b8ee9fc8e266faa70a62f2c7f1c1cce5
 2004-10-29T06:51:19.000000Z
 264
@@ -392,7 +392,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 c978a2326e4157eab96c905f0edbb2bf
 2004-05-06T09:44:41.000000Z
 199
@@ -404,7 +404,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 64b587ebdb7881dee0a8c95486b0d8b4
 2004-05-06T09:44:41.000000Z
 199
@@ -416,7 +416,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 d2b4287875082f6c7db677815efaa30a
 2008-02-02T09:32:49.231726Z
 377
@@ -428,7 +428,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 470d1ea88b0525e67b22081faebac6ab
 2005-05-19T10:48:33.000000Z
 322
@@ -440,7 +440,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 1fea2302f5132fdf00f1be95a470dd22
 2005-05-19T08:01:04.000000Z
 321
@@ -452,7 +452,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 e3c145db93ca187a345a825d8a771102
 2004-07-18T18:55:03.000000Z
 227
@@ -464,7 +464,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 b0e5cce623c9edfe7be9dcfa5345feda
 2004-05-06T09:44:41.000000Z
 199
@@ -476,7 +476,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 e175f675b4803db7f7c00f0e2173545b
 2006-10-11T16:24:42.000000Z
 348
@@ -488,7 +488,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 18eee13484de3553fe50c1a18c676459
 2004-05-06T09:44:41.000000Z
 199
@@ -500,7 +500,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 56fb3575c3cdb1c6b1b347a3280f1f6f
 2006-03-06T20:53:18.000000Z
 345
@@ -512,7 +512,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 abc642714df74739f43a3bf7b397f5fb
 2004-12-22T07:59:46.000000Z
 273
@@ -524,7 +524,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 4e700f79a816a7e85c755977da4a6b0e
 2004-05-06T09:44:41.000000Z
 199
@@ -536,7 +536,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 f32671fc0fa94dcc7afdf04ebe195e90
 2004-05-22T07:03:36.000000Z
 203
@@ -548,7 +548,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 95aba1b949f632b25fa7adb23b85f434
 2008-04-23T12:03:57.089785Z
 380
@@ -560,7 +560,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 1d9d64297b26eb729f95dc1fd3d43586
 2007-12-25T11:32:35.000000Z
 355
@@ -572,7 +572,7 @@
 
 
 
-2008-08-28T12:33:26.000000Z
+2008-08-28T12:08:56.000000Z
 63b9e3f062ed924f877f47bb73a0e7a9
 2005-12-07T13:47:19.000000Z
 343
Binary files ocaml-extlib-read-only.orig/test/mktest.cmi and ocaml-extlib-read-only/test/mktest.cmi differ
Binary files ocaml-extlib-read-only.orig/test/mktest.cmo and ocaml-extlib-read-only/test/mktest.cmo differ
diff -Nur ocaml-extlib-read-only.orig/test/.svn/entries ocaml-extlib-read-only/test/.svn/entries
--- ocaml-extlib-read-only.orig/test/.svn/entries	2008-08-28 14:33:24.000000000 +0200
+++ ocaml-extlib-read-only/test/.svn/entries	2008-08-28 14:08:54.000000000 +0200
@@ -32,7 +32,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 02f4ced36486a952b32f40a1318d1241
 2005-11-25T10:22:19.000000Z
 341
@@ -44,7 +44,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 76da4f9021b2620a91978c15c58ec90c
 2004-12-23T22:18:45.000000Z
 285
@@ -56,7 +56,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 7a65ec4cd15861fbddfd3752e01a566b
 2007-12-30T19:53:02.568798Z
 375
@@ -68,7 +68,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 4045f1e0d443cf020e6e414a515e4318
 2007-04-08T11:57:44.000000Z
 349
@@ -80,7 +80,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 a8595307fa012a4f3b988f5185059e3a
 2004-12-28T12:12:17.000000Z
 302
@@ -92,7 +92,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 8d3d4b7d013a4197c7e0dc4e41b498ad
 2004-12-27T21:51:20.000000Z
 298
@@ -104,7 +104,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 f40e7d33885a0fa12a73d7f6c69892a9
 2005-03-02T19:25:44.000000Z
 315
@@ -116,7 +116,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 24c7132b9c1fee2b5070a1a880dec428
 2004-12-27T19:16:17.000000Z
 296
@@ -128,7 +128,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 8b1ef9caf456924251711880f17b3ba8
 2005-02-15T10:11:27.000000Z
 310
@@ -140,7 +140,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 95f574a8bd1756a9a410994dff4fecc9
 2005-01-15T13:10:34.000000Z
 306
@@ -152,7 +152,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 5a987c0aa0de3883ff3415978c1d6414
 2007-04-08T11:57:44.000000Z
 349
@@ -164,7 +164,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 4f74305685d74ea7eb4095d21c03977c
 2007-04-08T17:18:47.000000Z
 350
@@ -176,7 +176,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 18083c760fe60825217ff15fddbd77e7
 2004-12-21T06:30:55.000000Z
 272
@@ -188,7 +188,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 100e2fcbf5cafabc63241e8a5b67e7fd
 2007-12-25T11:29:56.000000Z
 354
@@ -203,7 +203,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 845b53b567667c6aa9ca4e1e20c41128
 2004-12-24T10:49:00.000000Z
 287
@@ -215,7 +215,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 1d9ace098b2a2b02be7908ecbeae79d0
 2007-12-30T19:53:02.568798Z
 375
@@ -227,7 +227,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 d69aceb57a22dbbe2f0e586b21cca669
 2007-12-25T12:02:18.000000Z
 357
@@ -239,7 +239,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 14aed34e8eb25c7e9fdbeae72b904b35
 2008-04-23T18:09:27.770031Z
 381
@@ -251,7 +251,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 38e25db1b067e5f5749e74c94b00be31
 2007-12-30T19:53:02.568798Z
 375
@@ -263,7 +263,7 @@
 
 
 
-2008-08-28T12:33:24.000000Z
+2008-08-28T12:08:54.000000Z
 945e851a2d06d0a92e430ac75a6ae871
 2007-11-27T19:46:53.000000Z
 352
diff -Nur ocaml-extlib-read-only.orig/test/test_dt_IO_printing001.ml ocaml-extlib-read-only/test/test_dt_IO_printing001.ml
--- ocaml-extlib-read-only.orig/test/test_dt_IO_printing001.ml	1970-01-01 01:00:00.000000000 +0100
+++ ocaml-extlib-read-only/test/test_dt_IO_printing001.ml	2008-08-28 14:24:13.000000000 +0200
@@ -0,0 +1,56 @@
+(**
+   A few tests for the new Printf-style functions
+   of module [IO.Printf].
+*)
+
+open IO
+open IO.Printf
+
+let counter = ref 0
+
+let count out r = 
+  incr r;
+  fprintf out "%i" !r
+
+let test_printf () = 
+  printf  "Counting %-*s %a %S\n" 15 "printf"  count counter "[complete]"
+
+let test_eprintf () =
+  eprintf "Counting %-*s %a %S\n" 15 "eprintf" count counter "[complete]"
+
+let test_sprintf2 () =
+  let result = sprintf2 "Counting %-*s %a %S\n" 15 "sprintf2" count counter "[complete]" in
+    assert (result = "Testing sprintf2 3 \"[complete]\"\n");
+    printf  "%s" result
+
+
+let test_bprintf2 () =
+  let buf = Buffer.create 10 in
+    bprintf2 buf "Counting %-*s %a %S\n" 15 "bprintf2" count counter "[complete]";
+    let result = Buffer.contents buf in
+    assert (result = "Testing bprintf2 4 \"[complete]\"\n");
+    printf "%s" result
+
+let test_kfprintf () =
+    kfprintf (fun out -> fprintf stdout "\n") stdout "Counting %-*s %a %S" 15 "kfprintf" count counter "[complete]"
+
+let test_ksprintf2 () =
+    ksprintf2 (fun result -> 
+		 assert (result = "Testing ksprintf2 6 \"[complete]\"\n");
+		 fprintf stdout "%s\n" result) "Counting %-*s %a %S" 15 "ksprintf2" count counter "[complete]"
+
+let test_kbprintf2 () =
+  let buf = Buffer.create 10 in
+    kbprintf2 (fun buf -> 
+		 let result = Buffer.contents buf in
+		 assert (result = "Testing kbprintf2 7 \"[complete]\"\n");
+		 fprintf stdout "%s\n" result) buf "Counting %-*s %a %S" 15 "kbprintf7" count counter "[complete]"
+
+let test () = 
+  Util.run_test ~test_name:"dt_IO.Printf.printf" test_printf;
+  Util.run_test ~test_name:"dt_IO.Printf.eprintf" test_eprintf;
+  Util.run_test ~test_name:"dt_IO.Printf.sprintf2" test_sprintf2;
+  Util.run_test ~test_name:"dt_IO.Printf.bprintf2" test_bprintf2;
+  Util.run_test ~test_name:"dt_IO.Printf.kfprintf" test_kfprintf;
+  Util.run_test ~test_name:"dt_IO.Printf.ksprintf2" test_ksprintf2;
+  Util.run_test ~test_name:"dt_IO.Printf.kbprintf2" test_kbprintf2
diff -Nur ocaml-extlib-read-only.orig/test/util/zlib-test/.svn/entries ocaml-extlib-read-only/test/util/zlib-test/.svn/entries
--- ocaml-extlib-read-only.orig/test/util/zlib-test/.svn/entries	2008-08-28 14:33:23.000000000 +0200
+++ ocaml-extlib-read-only/test/util/zlib-test/.svn/entries	2008-08-28 14:08:54.000000000 +0200
@@ -32,7 +32,7 @@
 
 
 
-2008-08-28T12:33:23.000000Z
+2008-08-28T12:08:54.000000Z
 e466f98334d72d431e31a5d313667dfa
 2007-12-25T11:55:54.000000Z
 356
@@ -45,7 +45,7 @@
 
 
 
-2008-08-28T12:33:23.000000Z
+2008-08-28T12:08:54.000000Z
 93cb00f8763621d80d39b54902fdab3b
 2007-12-25T12:04:42.000000Z
 358
@@ -57,7 +57,7 @@
 
 
 
-2008-08-28T12:33:23.000000Z
+2008-08-28T12:08:54.000000Z
 ff9873126cd57adcc14c992c7d27a733
 2007-12-25T11:55:54.000000Z
 356