X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Fextlib%2FhExtlib.ml;h=d4572789ad55f39795d000fd09192e839cfee02f;hb=67cf4ce16c346991c8eda71576414f5c6324ab82;hp=cf43e15a03677cff942a0ece003cc85ab0ff972b;hpb=1afc33fa6997763d76e420cfdf9956208806b95c;p=helm.git diff --git a/components/extlib/hExtlib.ml b/components/extlib/hExtlib.ml index cf43e15a0..d4572789a 100644 --- a/components/extlib/hExtlib.ml +++ b/components/extlib/hExtlib.ml @@ -27,16 +27,20 @@ (** PROFILING *) -let profiling_enabled = ComponentsConf.profiling +let profiling_enabled = false ;; (* ComponentsConf.profiling *) let something_profiled = ref false let _ = if !something_profiled then at_exit - (fun _ -> prerr_endline - (Printf.sprintf "!! %-39s %6s %9s %9s %9s" - "function" "#calls" "total" "max" "average")) + (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 @@ -67,11 +71,11 @@ let profile ?(enable = true) s = in at_exit (fun () -> - if !profiling_printings s && !total <> 0. then + if !profiling_printings s && !calls <> 0 then begin something_profiled := true; prerr_endline - (Printf.sprintf "!! %-39s %6d %9.4f %9.4f %9.4f" + (Printf.sprintf "!! %-39s %10d %9.4f %9.4f %9.4f" s !calls !total !max (!total /. (float_of_int !calls))) end); { profile = profile } @@ -131,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 +153,17 @@ let rec filter_map f = | None -> filter_map f tl | Some v -> v :: filter_map f tl) +let list_rev_map_filter f l = + let rec aux a = function + | [] -> a + | hd :: tl -> + begin match f hd with + | None -> aux a tl + | Some b -> aux (b :: a) tl + end + in + aux [] l + let list_concat ?(sep = []) = let rec aux acc = function @@ -164,6 +183,19 @@ 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 + +let list_last l = + let l = List.rev l in + try List.hd l with exn -> raise (Failure "HExtlib.list_last") +;; + (** {2 File predicates} *) let is_dir fname = @@ -306,13 +338,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 _ -> () @@ -361,3 +396,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 +