X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaSync.ml;h=4df2ab7fbec0a41d0973feebf1cbed0cfb0cc658;hb=ad0292419b0204384ff55c946a6aabb73a47c42b;hp=f42dad76927cb693cf15c8537a95d326b750103e;hpb=0599dc10a00ebfe65ca64c75d0fc82723f9191a0;p=helm.git diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml index f42dad769..4df2ab7fb 100644 --- a/helm/matita/matitaSync.ml +++ b/helm/matita/matitaSync.ml @@ -50,7 +50,7 @@ let set_proof_aliases status aliases = let new_status = {status with aliases = aliases } in let diff = alias_diff ~from:status new_status in let moo_content_rev = - CicTextualParser2.EnvironmentP3.to_string diff :: + DisambiguatePp.pp_environment diff :: status.moo_content_rev in {new_status with moo_content_rev = moo_content_rev} @@ -92,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:") "" @@ -167,44 +167,55 @@ struct let compare (u1, _) (u2, _) = UriManager.compare u1 u2 end +module OrderedId = +struct + type t = CicNotation.notation_id + let compare = Pervasives.compare +end + module UriSet = Set.Make (OrderedUri) +module IdSet = Set.Make (OrderedId) -(* returns the uri of objects that were added in the meanwhile... - * status1 ----> status2 - * assumption: objects defined in status2 are a superset of those defined in - * status1 - *) -let delta_status status1 status2 = + (** @return l2 \ l1 *) +let uri_list_diff l2 l1 = let module S = UriSet in - let diff l1 l2 = - let s1 = List.fold_left (fun set uri -> S.add uri set) S.empty l1 in - let s2 = List.fold_left (fun set uri -> S.add uri set) S.empty l2 in - let diff = S.diff s2 s1 in - S.fold (fun uri uris -> uri :: uris) diff [] - in - diff status1.objects status2.objects + let s1 = List.fold_left (fun set uri -> S.add uri set) S.empty l1 in + let s2 = List.fold_left (fun set uri -> S.add uri set) S.empty l2 in + let diff = S.diff s2 s1 in + S.fold (fun uri uris -> uri :: uris) diff [] + + (** @return l2 \ l1 *) +let id_list_diff l2 l1 = + let module S = IdSet in + let s1 = List.fold_left (fun set uri -> S.add uri set) S.empty l1 in + let s2 = List.fold_left (fun set uri -> S.add uri set) S.empty l2 in + let diff = S.diff s2 s1 in + S.fold (fun uri uris -> uri :: uris) diff [] let remove_coercion uri = CoercDb.remove_coercion (fun (_,_,u) -> UriManager.eq u uri) let time_travel ~present ~past = - let list_of_objs_to_remove = List.rev (delta_status past present) in - (* List.rev is just for the debugging code, which otherwise may list both - * something.ind and something.ind#xpointer ... (ask Enrico :-) *) + let objs_to_remove = uri_list_diff present.objects past.objects in + let notation_to_remove = + id_list_diff present.notation_ids past.notation_ids + in let debug_list = ref [] in - List.iter (fun (uri,p) -> - MatitaMisc.safe_remove p; - remove_coercion uri; - (try - CicEnvironment.remove_obj uri - with CicEnvironment.Object_not_found _ -> - MatitaLog.debug - (sprintf "time_travel removes from cache %s that is not in" - (UriManager.string_of_uri uri))); - let l = MatitaDb.remove_uri uri in - debug_list := UriManager.string_of_uri uri :: !debug_list @ l) - list_of_objs_to_remove; - + List.iter + (fun (uri,p) -> + MatitaMisc.safe_remove p; + remove_coercion uri; + (try + CicEnvironment.remove_obj uri + with CicEnvironment.Object_not_found _ -> + MatitaLog.debug + (sprintf "time_travel removes from cache %s that is not in" + (UriManager.string_of_uri uri))); + let l = MatitaDb.remove_uri uri in + debug_list := UriManager.string_of_uri uri :: !debug_list @ l) + objs_to_remove; + List.iter CicNotation.remove_notation notation_to_remove + (* (* this is debug code * idea: debug_list is the list of objects to be removed as computed from the * db, while list_of_objs_to_remove is the same list but computer from the @@ -230,6 +241,7 @@ let time_travel ~present ~past = List.iter MatitaLog.debug l1; MatitaLog.debug "l2:"; List.iter MatitaLog.debug l2 + *) let remove ~verbose uri = let derived_uris_of_uri uri =