X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaMisc.ml;h=e3aadd5b5a616d143c17dd22ab71d25f7ac06626;hb=e6b28085c97ae7b9bd3f3262b105f6b84f42b047;hp=3ed1f001c2d17f5c2b185362b71f1fd0f0e443a8;hpb=b8c0504c5602b08443cec0782670bd4a699cbc23;p=helm.git diff --git a/helm/matita/matitaMisc.ml b/helm/matita/matitaMisc.ml index 3ed1f001c..e3aadd5b5 100644 --- a/helm/matita/matitaMisc.ml +++ b/helm/matita/matitaMisc.ml @@ -114,6 +114,21 @@ let append_phrase_sep s = else s +let mkdir path = + let components = Str.split (Str.regexp "/") path in + let rec aux where = function + | [] -> () + | piece::tl -> + let path = where ^ "/" ^ piece in + (try + Unix.mkdir path 0o755 + with + | Unix.Unix_error (Unix.EEXIST,_,_) -> () + | Unix.Unix_error (e,_,_) -> raise (Failure (Unix.error_message e))); + aux path tl + in + aux "" components + let strip_trailing_blanks = let rex = Pcre.regexp "\\s*$" in fun s -> Pcre.replace ~rex s @@ -232,25 +247,6 @@ let singleton f = let instance = lazy (f ()) in fun () -> Lazy.force instance -let mkdir d = - let errmsg = sprintf "Unable to create directory \"%s\"" d in - try - let dir = "mkdir -p " ^ d in - (match Unix.system dir with - | Unix.WEXITED 0 -> () - | Unix.WEXITED n -> - MatitaLog.error ("'mkdir -p " ^ dir ^ "' failed with "^string_of_int n); - failwith errmsg - | Unix.WSIGNALED s - | Unix.WSTOPPED s -> - MatitaLog.error - ("'mkdir -p " ^ dir ^ "' signaled with " ^ string_of_int s); - failwith errmsg) - with Unix.Unix_error _ as exc -> - MatitaLog.error - ("Unix error in makigin dir " ^ (MatitaExcPp.to_string exc)); - failwith errmsg - let get_proof_status status = match status.proof_status with | Incomplete_proof s -> s @@ -270,6 +266,13 @@ let get_proof_context status = 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 get_proof_aliases status = status.aliases let qualify status name = get_string_option status "baseuri" ^ "/" ^ name @@ -288,8 +291,9 @@ let obj_file_of_baseuri baseuri = path ^ ".moo" let obj_file_of_script f = - let baseuri = baseuri_of_file f in - obj_file_of_baseuri baseuri + 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 | [] -> [] @@ -297,6 +301,15 @@ let rec list_uniq = function | 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 + | [] -> raise Not_found + | hd :: tl as l when equality hd e -> l + | hd :: tl -> aux tl + in + aux l + let debug_wrap name f = prerr_endline (sprintf "debug_wrap: ==>> %s" name); let res = f () in