X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Fextlib%2FhExtlib.ml;h=3cc6c9bb5c0bc876f74d35de8868f3231a56c14e;hb=ce800b0b7acf3940cad3afc5b1d2296155affb1c;hp=93eabf2acdfa355b73d89da1da474c8dd3f2708b;hpb=5cb95a2e44f979183a8c3e39baa3b4e7cfaf8182;p=helm.git diff --git a/components/extlib/hExtlib.ml b/components/extlib/hExtlib.ml index 93eabf2ac..3cc6c9bb5 100644 --- a/components/extlib/hExtlib.ml +++ b/components/extlib/hExtlib.ml @@ -27,37 +27,60 @@ (** PROFILING *) -let profiling_enabled = ComponentsConf.profiling - -let profiling_printings = ref (fun () -> true) +let profiling_enabled = false ;; (* ComponentsConf.profiling *) + +let something_profiled = ref false + +let _ = + if !something_profiled then + at_exit + (fun _ -> + prerr_endline + (Printf.sprintf "!! %39s ---------- --------- --------- ---------" + (String.make 39 '-')); + prerr_endline + (Printf.sprintf "!! %-39s %10s %9s %9s %9s" + "function" "#calls" "total" "max" "average")) + +let profiling_printings = ref (fun _ -> true) let set_profiling_printings f = profiling_printings := f type profiler = { profile : 'a 'b. ('a -> 'b) -> 'a -> 'b } -let profile ?(enable = true) = +let profile ?(enable = true) s = if profiling_enabled && enable then - function s -> let total = ref 0.0 in + let calls = ref 0 in + let max = ref 0.0 in let profile f x = let before = Unix.gettimeofday () in try + incr calls; let res = f x in let after = Unix.gettimeofday () in - total := !total +. (after -. before); + let delta = after -. before in + total := !total +. delta; + if delta > !max then max := delta; res with exc -> let after = Unix.gettimeofday () in - total := !total +. (after -. before); + let delta = after -. before in + total := !total +. delta; + if delta > !max then max := delta; raise exc in at_exit (fun () -> - if !profiling_printings () && !total <> 0. then + if !profiling_printings s && !calls <> 0 then + begin + something_profiled := true; prerr_endline - ("!! TOTAL TIME SPENT IN " ^ s ^ ": " ^ string_of_float !total)); + (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" + s !calls !total !max (!total /. (float_of_int !calls))) + end); { profile = profile } else - function _ -> { profile = fun f x -> f x } + { profile = fun f x -> f x } (** {2 Optional values} *) @@ -112,6 +135,10 @@ let is_alphanum c = is_alpha c || is_digit c (** {2 List processing} *) +let flatten_map f l = + List.flatten (List.map f l) +;; + let rec list_uniq ?(eq=(=)) = function | [] -> [] | h::[] -> [h] @@ -145,6 +172,14 @@ let rec list_findopt f l = in aux l +let split_nth n l = + let rec aux acc n l = + match n, l with + | 0, _ -> List.rev acc, l + | n, [] -> raise (Failure "HExtlib.split_nth") + | n, hd :: tl -> aux (hd :: acc) (n - 1) tl in + aux [] n l + (** {2 File predicates} *) let is_dir fname = @@ -287,13 +322,16 @@ let find ?(test = fun _ -> true) path = let safe_remove fname = if Sys.file_exists fname then Sys.remove fname let is_dir_empty d = - let od = Unix.opendir d in - let rec aux () = - let name = Unix.readdir od in - if name <> "." && name <> ".." then false else aux () in - let res = try aux () with End_of_file -> true in - Unix.closedir od; - res + try + let od = Unix.opendir d in + let rec aux () = + let name = Unix.readdir od in + if name <> "." && name <> ".." then false else aux () in + let res = try aux () with End_of_file -> true in + Unix.closedir od; + res + with + Unix.Unix_error _ -> true (* raised by Unix.opendir, we hope :-) *) let safe_rmdir d = try Unix.rmdir d with Unix.Unix_error _ -> () @@ -342,3 +380,7 @@ let raise_localized_exception ~offset floc exn = { flocb with Lexing.pos_cnum = x }, { floce with Lexing.pos_cnum = y } in raise (Localized (floc, exn)) + +let estimate_size x = + 4 * (String.length (Marshal.to_string x [])) / 1024 +