X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fextlib%2FhExtlib.ml;h=15a459cdc0f1243c44d0017e6e1bffab0f5c0506;hb=c9476a5e112e223c2e0707658229b47c00ca7b5f;hp=6afae34a79fd240f3be640bb209240330579a29c;hpb=bc504bdaca501cd4d33f3240e01855988bc15b79;p=helm.git diff --git a/helm/ocaml/extlib/hExtlib.ml b/helm/ocaml/extlib/hExtlib.ml index 6afae34a7..15a459cdc 100644 --- a/helm/ocaml/extlib/hExtlib.ml +++ b/helm/ocaml/extlib/hExtlib.ml @@ -23,6 +23,7 @@ * http://cs.unibo.it/helm/. *) +(* $Id$ *) (** PROFILING *) @@ -134,6 +135,16 @@ let list_concat ?(sep = []) = | hd :: tl -> aux ([sep; hd] @ acc) tl in aux [] + +let rec list_findopt f l = + let rec aux = function + | [] -> None + | x::tl -> + (match f x with + | None -> aux tl + | Some _ as rc -> rc) + in + aux l (** {2 File predicates} *) @@ -272,6 +283,27 @@ let find ?(test = fun _ -> true) path = in aux [] [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 + +let safe_rmdir d = try Unix.rmdir d with Unix.Unix_error _ -> () + +let rec rmdir_descend d = + if is_dir_empty d then + begin + safe_rmdir d; + rmdir_descend (Filename.dirname d) + end + + (** {2 Exception handling} *) let finally at_end f arg = @@ -290,6 +322,16 @@ let loc_of_floc = function | { Lexing.pos_cnum = loc_begin }, { Lexing.pos_cnum = loc_end } -> (loc_begin, loc_end) +let floc_of_loc (loc_begin, loc_end) = + let floc_begin = + { Lexing.pos_fname = ""; Lexing.pos_lnum = -1; Lexing.pos_bol = -1; + Lexing.pos_cnum = loc_begin } + in + let floc_end = { floc_begin with Lexing.pos_cnum = loc_end } in + (floc_begin, floc_end) + +let dummy_floc = floc_of_loc (-1, -1) + let raise_localized_exception ~offset floc exn = let (x, y) = loc_of_floc floc in let x = offset + x in