module String =
struct
  include String

  let explode s sep =
    let len = length s in
    let buff = Buffer.create 40 in
    let rec loop i =
      if i >= len then
	[ Buffer.contents buff ]
      else
	let c = s.[i] in
	if c == sep then
	  let ss = Buffer.contents buff in
	  Buffer.clear buff;
	  ss :: loop (i+1)
	else begin
	  Buffer.add_char buff c;
	  loop (i+1);
	end
    in
    loop 0
end
;;

module System =
struct
  let status () =
    let pid = Unix.getpid() in
    let cin = open_in (Printf.sprintf "/proc/%i/status" pid) in
    let h = Hashtbl.create 17 in
    try
      while true do
        let s = input_line cin in
        Scanf.sscanf s "%s@: %s@\n" (fun k v ->
          Hashtbl.replace h k v)
      done;
      (* never reached *)
      h
    with
      End_of_file -> begin
        close_in cin;
        h
      end
  let get_status s = Hashtbl.find (status()) s

  let pr_mem_status fmt h =
    Format.fprintf fmt "[";
    List.iter (fun k ->
      let v = Hashtbl.find h k in
      Format.fprintf fmt "%s: %s " k v
    ) [ "VmStk"; "VmRSS"; "VmPeak" ];
    Format.fprintf fmt "]"

end

let time f ?(count=1) ?(msg="") x =
  if not !Config.verbose then f x
  else
  let rec loop i =
    Gc.compact();
    let oldmem = System.status () in
    let t1 = Unix.gettimeofday () in
    let r = f x in
    let t2 = Unix.gettimeofday () in
    let newmem = System.status () in
    let t = (1000. *. (t2 -. t1)) in
    Logger.verbose Format.err_formatter "@[%s: [" msg;
    if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i,  "  i count;
    begin
      Format.pp_open_vbox Format.err_formatter (2 + String.length msg);
      Logger.verbose
        Format.err_formatter
        "@\n| Time: %fms@\n| Memory before: %a@\n| Memory after:  %a@\n]@]@]@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
    end;
    if i >= count then r
    else loop (i+1)
  in
  loop 1
;;