let rec print ppf =
  let comma ... in 
  function
  | `String s -> ...
  | ...

let report_errorf fmt =
  Error_occurred.set ();
  Location.errorf fmt

module FormatVersion = struct
  let format_char ppf chr =
    match chr with
    | ('\"' | '\\') as c ->
      Format.fprintf ppf "\\%c" c
    | '\n' ->
      Format.fprintf ppf "\\%c" 'n'
    | '\t' ->
      Format.fprintf ppf "\\%c" 't'
    | '\r' ->
      Format.fprintf ppf "\\%c" 'r'
    | '\b' ->
      Format.fprintf ppf "\\%c" 'b'
    | '\x00' .. '\x1F' | '\x7F' as c ->
      Format.fprintf ppf "\\u%04X" (Char.code c)
    | c -> Format.fprintf ppf "%c" c
             
  let format_string ppf s = String.iter (format_char ppf) s
end

module BufferVersion = struct
  let escape_string str =
    let buf = Buffer.create (String.length str * 5 / 4) in
    for i = 0 to String.length str - 1 do
      match str.[i] with
      | '\\' -> Buffer.add_string buf {|\\|}
      | '\"' -> Buffer.add_string buf {|\"|}
      | '\n' -> Buffer.add_string buf {|\n|}
      | '\t' -> Buffer.add_string buf {|\t|}
      | '\r' -> Buffer.add_string buf {|\r|}
      | '\b' -> Buffer.add_string buf {|\b|}
      | '\x00' .. '\x1F' | '\x7F' as c ->
        Printf.bprintf buf "\\u%04X" (Char.code c)
      | c -> Buffer.add_char buf c
    done;
    Buffer.contents buf

  let format_string ppf s =
    Format.fprintf ppf "%s" (escape_string s)
end

module BufferVersionOpt = struct
  let escape_string str =
    let buf = Buffer.create (String.length str * 5 / 4) in
    let first_unescaped = ref 0 in
    let no_escape i =
      if i < !first_unescaped then
        first_unescaped := i
    in
    let escape i =
      let first = !first_unescaped in
      if i < first then ()
      else begin
        Buffer.add_substring buf str first (i - first); (* i is excluded *)
        first_unescaped := max_int;
      end
    in
    for i = 0 to String.length str - 1 do
      match str.[i] with
      | '\\' -> escape i; Buffer.add_string buf {|\\|}
      | '\"' -> escape i; Buffer.add_string buf {|\"|}
      | '\n' -> escape i; Buffer.add_string buf {|\n|}
      | '\t' -> escape i; Buffer.add_string buf {|\t|}
      | '\r' -> escape i; Buffer.add_string buf {|\r|}
      | '\b' -> escape i; Buffer.add_string buf {|\b|}
      | '\x00' .. '\x1F' | '\x7F' as c ->
        escape i;
        Printf.bprintf buf "\\u%04X" (Char.code c)
      | c -> no_escape i
    done;
    escape (String.length str);
    Buffer.contents buf

  let format_string ppf s =
    Format.fprintf ppf "%s" (escape_string s)
end

module FormatVersionOpt = struct
  let format_string ppf str =
    let first_unescaped = ref 0 in
    let no_escape i =
      if i < !first_unescaped then
        first_unescaped := i
    in
    let escape i =
      let first = !first_unescaped in
      if i < first then ()
      else begin
        Format.pp_print_string ppf
          (String.sub str first (i - first)); (* i is excluded *)
        first_unescaped := max_int;
      end
    in
    for i = 0 to String.length str - 1 do
      match str.[i] with
      | '\\' -> escape i; Format.pp_print_string ppf {|\\|}
      | '\"' -> escape i; Format.pp_print_string ppf {|\"|}
      | '\n' -> escape i; Format.pp_print_string ppf {|\n|}
      | '\t' -> escape i; Format.pp_print_string ppf {|\t|}
      | '\r' -> escape i; Format.pp_print_string ppf {|\r|}
      | '\b' -> escape i; Format.pp_print_string ppf {|\b|}
      | '\x00' .. '\x1F' | '\x7F' as c ->
        escape i;
        Format.fprintf ppf "\\u%04X" (Char.code c)
      | c -> no_escape i
    done;
    escape (String.length str)
end

let test_ok format_string =
  let ppf = Format.str_formatter in
  let input, expected_output =
    "01'2\\34\"\n5\t6\r\b7\x1A8 9",
   {|01'2\\34\"\n5\t6\r\b7\u001A8 9|} in
  format_string ppf input;
  let result = Format.flush_str_formatter () in
  result = expected_output
  || (Printf.eprintf "\"%s\"%!" result; false)

let small_input = {|
  let format_char ppf chr =
    match chr with
    | ('\"' | '\\') as c ->
      Format.fprintf ppf "\\%c" c
    | '\n' ->
      Format.fprintf ppf "\\%c" 'n'
    | '\t' ->
      Format.fprintf ppf "\\%c" 't'
    | '\r' ->
      Format.fprintf ppf "\\%c" 'r'
    | '\b' ->
      Format.fprintf ppf "\\%c" 'b'
    | '\x00' .. '\x1F' | '\x7F' as c ->
      Format.fprintf ppf "\\u%04X" (Char.code c)
    | c -> Format.fprintf ppf "%c" c
             
  let format_string ppf s = String.iter (format_char ppf) s
|}

let large_input = String.concat "\n\n" (List.init 100 (fun _ -> small_input))

let test_perf format_string =
  let null = open_out Filename.null in
  Fun.protect ~finally:(fun () -> close_out null) @@ fun () ->
  let ppf = Format.formatter_of_out_channel null in
  for i = 1 to 1_000 do
    format_string ppf large_input
  done

let versions = [
  "Format", FormatVersion.format_string;
  "Buffer", BufferVersion.format_string;
  "BufferOpt", BufferVersionOpt.format_string;
  "FormatOpt", FormatVersionOpt.format_string;
]

let () =
  versions |> List.iter @@ fun (name, f) ->
  Printf.printf "testing %s: %!" name;
  Printf.printf "%s\n%!"
    (if test_ok f then "ok" else "fail")

let () =
  let usage_error () =
    prerr_endline
      "command-line argument expected: 'Format' or 'Buffer' or 'BufferOpt'.";
    exit 2 in
  match Sys.argv.(1) with
  | exception _ -> usage_error ()
  | v ->
  match List.assoc v versions with
  | exception Not_found -> usage_error ()
  | f ->
  test_perf f