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

diff --git a/helm/ocaml/extlib/hExtlib.ml b/helm/ocaml/extlib/hExtlib.ml
index c66236e43..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 *)
 
@@ -112,11 +113,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
@@ -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 =
@@ -282,3 +314,30 @@ 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 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
+ 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))