ocaml 3.09 transition

[helm.git] / helm / matita / matitaMisc.ml

diff --git a/helm/matita/matitaMisc.ml b/helm/matita/matitaMisc.ml
index 9c0c7db33338f6a40e8bc2267d96d43324027c81..e311973c9cc362c726d503839154c2efee644c0b 100644 (file)
--- a/helm/matita/matitaMisc.ml
+++ b/helm/matita/matitaMisc.ml
@@ -38,39 +38,6 @@ let baseuri_of_baseuri_decl st =
       Some buri
   | _ -> None
 
-let baseuri_of_file file = 
-  let uri = ref None in
-  let ic = open_in file in
-  let istream = Ulexing.from_utf8_channel ic in
-  (try
-    while true do
-      try 
-        let stm = GrafiteParser.parse_statement istream in
-        match baseuri_of_baseuri_decl stm with
-        | Some buri -> 
-            let u = strip_trailing_slash buri in
-            if String.length u < 5 || String.sub u 0 5 <> "cic:/" then
-              MatitaLog.error (file ^ " sets an incorrect baseuri: " ^ buri);
-            (try 
-              ignore(Http_getter.resolve u)
-            with
-            | Http_getter_types.Unresolvable_URI _ -> 
-                MatitaLog.error (file ^ " sets an unresolvable baseuri: "^buri)
-            | Http_getter_types.Key_not_found _ -> ());
-            uri := Some u;
-            raise End_of_file
-        | None -> ()
-      with
-        CicNotationParser.Parse_error _ as exn ->
-          prerr_endline ("Unable to parse: " ^ file);
-          prerr_endline (MatitaExcPp.to_string exn);
-          ()
-    done
-  with End_of_file -> close_in ic);
-  match !uri with
-  | Some uri -> uri
-  | None -> failwith ("No baseuri defined in " ^ file)
-
 let is_empty buri =
  List.for_all
   (function
@@ -80,6 +47,28 @@ let is_empty buri =
 
 let safe_remove fname = if Sys.file_exists fname then Sys.remove fname
 
+let is_dir_empty d =
+  try 
+    let od = Unix.opendir d in
+    try 
+      ignore (Unix.readdir od);
+      ignore (Unix.readdir od);
+      ignore (Unix.readdir od);
+      Unix.closedir od;
+      false
+    with End_of_file -> 
+      Unix.closedir od;
+      true
+  with Unix.Unix_error _ -> true
+
+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
 
 let absolute_path file =
   if file.[0] = '/' then file else Unix.getcwd () ^ "/" ^ file
@@ -93,14 +82,6 @@ let append_phrase_sep s =
   else
     s
 
-let empty_mathml () =
-  DomMisc.domImpl#createDocument ~namespaceURI:(Some DomMisc.mathml_ns)
-    ~qualifiedName:(Gdome.domString "math") ~doctype:None
-
-let empty_boxml () =
-  DomMisc.domImpl#createDocument ~namespaceURI:(Some DomMisc.boxml_ns) 
-    ~qualifiedName:(Gdome.domString "box") ~doctype:None
-
 exception History_failure
 
 type 'a memento = 'a array * int * int * int  (* data, hd, tl, cur *)
@@ -195,34 +176,6 @@ let singleton f =
   let instance = lazy (f ()) in
   fun () -> Lazy.force instance
 
-let get_proof_status status =
-  match status.proof_status with
-  | Incomplete_proof s -> s
-  | _ -> statement_error "no ongoing proof"
-
-let get_proof_metasenv status =
-  match status.proof_status with
-  | No_proof -> []
-  | Incomplete_proof ((_, metasenv, _, _), _) -> metasenv
-  | Proof (_, metasenv, _, _) -> metasenv
-  | Intermediate m -> m
-
-let get_proof_context status =
-  match status.proof_status with
-  | Incomplete_proof ((_, metasenv, _, _), goal) ->
-      let (_, context, _) = CicUtil.lookup_meta goal metasenv in
-      context
-  | _ -> []
- 
-let get_proof_conclusion status =
-  match status.proof_status with
-  | Incomplete_proof ((_, metasenv, _, _), goal) ->
-      let (_, _, conclusion) = CicUtil.lookup_meta goal metasenv in
-      conclusion
-  | _ -> statement_error "no ongoing proof"
- 
-let qualify status name = get_string_option status "baseuri" ^ "/" ^ name
-
 let image_path n = sprintf "%s/%s" BuildTimeConf.images_dir n
 
 let end_ma_RE = Pcre.regexp "\\.ma$"
@@ -234,17 +187,6 @@ let obj_file_of_baseuri baseuri =
  in
   path ^ ".moo"
 
-let obj_file_of_script f =
- if f = "coq.ma" then BuildTimeConf.coq_notation_script else
-  let baseuri = baseuri_of_file f in
-   obj_file_of_baseuri baseuri
-
-let rec list_uniq = function 
-  | [] -> []
-  | h::[] -> [h]
-  | h1::h2::tl when h1 = h2 -> list_uniq (h2 :: tl) 
-  | h1::tl (* when h1 <> h2 *) -> h1 :: list_uniq tl
-
 let list_tl_at ?(equality=(==)) e l =
   let rec aux =
     function