X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaSync.ml;h=b54c67790c46ea4618cd964062ea16a8c6cf8e85;hb=915c3e1993cad4dcadefe7e6886e6cb8feefae8b;hp=76ec992beedb7eea566de178a5e73d8167a20dd8;hpb=29a3bd5d160f31873236c93a008a9e4fd31c305e;p=helm.git diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml index 76ec992be..b54c67790 100644 --- a/helm/matita/matitaSync.ml +++ b/helm/matita/matitaSync.ml @@ -34,7 +34,16 @@ let alias_diff ~from status = if not (Map.mem domain_item from.aliases) then Map.add domain_item codomain_item acc else - acc) + begin + try + let description1 = fst(Map.find domain_item from.aliases) in + let description2 = fst(Map.find domain_item status.aliases) in + if description1 <> description2 then + Map.add domain_item codomain_item acc + else + acc + with Not_found -> acc + end) status.aliases Map.empty let set_proof_aliases status aliases = @@ -83,7 +92,7 @@ let add_aliases_for_object status suri = | Cic.CurrentProof _ -> assert false let paths_and_uris_of_obj uri status = - let basedir = get_string_option status "basedir" in + let basedir = get_string_option status "basedir" ^ "/xml" in let innertypesuri = UriManager.innertypesuri_of_uri uri in let bodyuri = UriManager.bodyuri_of_uri uri in let innertypesfilename = Str.replace_first (Str.regexp "^cic:") "" @@ -123,12 +132,9 @@ let save_object_to_disk status uri obj = (List.map Filename.dirname [innertypespath; xmlpath]); (* now write to disk *) ensure_path_exists innertypespath; - Xml.pp ~gzip:true xmlinnertypes (Some innertypespath) ; + Xml.pp ~gzip:true xmlinnertypes (Some innertypespath); ensure_path_exists xmlpath; Xml.pp ~gzip:true xml (Some xmlpath) ; - (* now register to the getter *) - Http_getter.register' innertypesuri (path_scheme_of innertypespath); - Http_getter.register' uri (path_scheme_of xmlpath); (* we return a list of uri,path we registered/created *) (uri,xmlpath) :: (innertypesuri,innertypespath) :: (* now the optional body, both write and register *) @@ -136,15 +142,10 @@ let save_object_to_disk status uri obj = None,None -> [] | Some bodyxml,Some bodyuri-> ensure_path_exists xmlbodypath; - Xml.pp ~gzip:true bodyxml (Some xmlbodypath) ; - Http_getter.register' bodyuri (path_scheme_of xmlbodypath); - [bodyuri,xmlbodypath] + Xml.pp ~gzip:true bodyxml (Some xmlbodypath); + [bodyuri, xmlbodypath] | _-> assert false) -let remove_object_from_disk uri path = - Sys.remove path; - Http_getter.unregister' uri - let add_obj uri obj status = let dbd = MatitaDb.instance () in let suri = UriManager.string_of_uri uri in @@ -192,7 +193,7 @@ let time_travel ~present ~past = * something.ind and something.ind#xpointer ... (ask Enrico :-) *) let debug_list = ref [] in List.iter (fun (uri,p) -> - remove_object_from_disk uri p; + MatitaMisc.safe_remove p; remove_coercion uri; (try CicEnvironment.remove_obj uri @@ -230,11 +231,9 @@ let time_travel ~present ~past = MatitaLog.debug "l2:"; List.iter MatitaLog.debug l2 - -let remove uri = +let remove ~verbose uri = let derived_uris_of_uri uri = UriManager.innertypesuri_of_uri uri :: - UriManager.annuri_of_uri uri :: (match UriManager.bodyuri_of_uri uri with | None -> [] | Some u -> [u]) @@ -247,16 +246,10 @@ let remove uri = List.iter (fun uri -> (try - let path = - let path = Http_getter.resolve' (UriManager.strip_xpointer uri) in - assert (String.sub path 0 7 = "file://"); - String.sub path 7 (String.length path - 7) - in - remove_object_from_disk uri path; - with - Http_getter_types.Key_not_found _ -> Http_getter.unregister' uri); + if verbose then + MatitaLog.debug ("Removing: " ^ UriManager.string_of_uri uri); + MatitaMisc.safe_remove (Http_getter.resolve' uri) + with Http_getter_types.Key_not_found _ -> ()); remove_coercion uri; - ignore(MatitaDb.remove_uri uri)) + ignore (MatitaDb.remove_uri uri)) to_remove - -