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 !Options.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; Logger.verbose Format.err_formatter "%fms (before: %a, after: %a)@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem; if i >= count then r else loop (i+1) in loop 1 ;; *)