X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fextlib%2FhExtlib.ml;h=a0f9d8d6cbb1ab0295b65035f873c724e6668d5d;hb=5dd5b3f6cd990d4d126b44c092e1df7f86c506d4;hp=c66236e43ae653228073e28de90bf9890b83fd23;hpb=c72b0d76d607482bccf12e7193a4d1a777815b91;p=helm.git

diff --git a/helm/ocaml/extlib/hExtlib.ml b/helm/ocaml/extlib/hExtlib.ml
index c66236e43..a0f9d8d6c 100644
--- a/helm/ocaml/extlib/hExtlib.ml
+++ b/helm/ocaml/extlib/hExtlib.ml
@@ -112,11 +112,11 @@ let is_alphanum c = is_alpha c || is_digit c
 
 (** {2 List processing} *)
 
-let rec list_uniq = function 
+let rec list_uniq ?(eq=(=)) = function 
   | [] -> []
   | h::[] -> [h]
-  | h1::h2::tl when h1 = h2 -> list_uniq (h2 :: tl) 
-  | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq tl
+  | h1::h2::tl when eq h1 h2 -> list_uniq ~eq (h2 :: tl) 
+  | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq ~eq tl
 
 let rec filter_map f =
   function
@@ -272,6 +272,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 +303,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))