X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Focaml%2Fextlib%2FhExtlib.ml;h=99e6609ec27efed198c8ba68bfa34f0f6b069199;hb=9d4a3a25b327bb2c15bd0cff116ba6698b1a4335;hp=a76a5c76e8252dcb7eb734a7ca4a55122a2971d8;hpb=80269a92dc40205efaad3f5d49cd02b779fed285;p=helm.git diff --git a/helm/ocaml/extlib/hExtlib.ml b/helm/ocaml/extlib/hExtlib.ml index a76a5c76e..99e6609ec 100644 --- a/helm/ocaml/extlib/hExtlib.ml +++ b/helm/ocaml/extlib/hExtlib.ml @@ -134,6 +134,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 +282,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 = @@ -282,3 +313,20 @@ let finally at_end f arg = at_end (); res +(** {2 Localized exceptions } *) + +exception Localized of Token.flocation * exn + +let loc_of_floc = function + | { Lexing.pos_cnum = loc_begin }, { Lexing.pos_cnum = loc_end } -> + (loc_begin, loc_end) + +let raise_localized_exception ~offset floc exn = + let (x, y) = loc_of_floc floc in + let x = offset + x in + let y = offset + y in + let flocb,floce = floc in + let floc = + { flocb with Lexing.pos_cnum = x }, { floce with Lexing.pos_cnum = y } + in + raise (Localized (floc, exn))