X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaSync.ml;h=cbf305261eb3fbdcba374c23e4b8721192fec41d;hb=6fa89cef6aa8fc1774db065a9fcfc47867579054;hp=95dab03607493fb3f56e8ddccecaadefb92cf755;hpb=37daa227f906a30b6d142e03f7589961476ce50d;p=helm.git diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml index 95dab0360..cbf305261 100644 --- a/helm/matita/matitaSync.ml +++ b/helm/matita/matitaSync.ml @@ -43,10 +43,22 @@ let alias_diff ~from status = status.aliases [] let alias_diff = - let profiler = CicUtil.profile "alias_diff (conteggiato anche in include)" in - fun ~from status -> profiler.CicUtil.profile (alias_diff ~from) status + let profiler = HExtlib.profile "alias_diff (conteggiato anche in include)" in + fun ~from status -> profiler.HExtlib.profile (alias_diff ~from) status let set_proof_aliases status new_aliases = + let commands_of_aliases = + List.map + (fun alias -> GrafiteAst.Alias (DisambiguateTypes.dummy_floc, alias)) + in + let deps_of_aliases = + HExtlib.filter_map + (function + | GrafiteAst.Ident_alias (_, suri) -> + let buri = UriManager.buri_of_uri (UriManager.uri_of_string suri) in + Some (GrafiteAst.Dependency buri) + | _ -> None) + in let aliases = List.fold_left (fun acc (d,c) -> DisambiguateTypes.Environment.add d c acc) status.aliases new_aliases in @@ -59,12 +71,15 @@ let set_proof_aliases status new_aliases = if new_aliases = [] then new_status else - add_moo_content - (DisambiguatePp.commands_of_domain_and_codomain_items_list new_aliases) - new_status + let aliases = + DisambiguatePp.aliases_of_domain_and_codomain_items_list new_aliases + in + let status = add_moo_content (commands_of_aliases aliases) new_status in + let status = add_moo_metadata (deps_of_aliases aliases) status in + status (** given a uri and a type list (the contructors types) builds a list of pairs - * (name,uri) that is used to generate authomatic aliases **) + * (name,uri) that is used to generate automatic aliases **) let extract_alias types uri = fst(List.fold_left ( fun (acc,i) (name, _, _, cl) -> @@ -125,7 +140,7 @@ let paths_and_uris_of_obj uri status = let save_object_to_disk status uri obj ugraph univlist = let ensure_path_exists path = let dir = Filename.dirname path in - MatitaMisc.mkdir dir + HExtlib.mkdir dir in (* generate annobj, ids_to_inner_sorts and ids_to_inner_types *) let annobj = Cic2acic.plain_acic_object_of_cic_object obj in @@ -139,14 +154,13 @@ let save_object_to_disk status uri obj ugraph univlist = paths_and_uris_of_obj uri status in let path_scheme_of path = "file://" ^ path in - List.iter MatitaMisc.mkdir - (List.map Filename.dirname [innertypespath; xmlpath]); + List.iter HExtlib.mkdir (List.map Filename.dirname [xmlpath]); (* now write to disk *) ensure_path_exists xmlpath; Xml.pp ~gzip:true xml (Some xmlpath); CicUniv.write_xml_of_ugraph xmlunivgraphpath ugraph univlist; (* we return a list of uri,path we registered/created *) - (uri,xmlpath) :: (innertypesuri,innertypespath) :: + (uri,xmlpath) :: (univgraphuri,xmlunivgraphpath) :: (* now the optional body, both write and register *) (match bodyxml,bodyuri with @@ -158,18 +172,13 @@ let save_object_to_disk status uri obj ugraph univlist = | _-> assert false) let typecheck_obj = - let profiler = CicUtil.profile "add_obj.typecheck_obj" in - fun uri obj -> profiler.CicUtil.profile (CicTypeChecker.typecheck_obj uri) obj + let profiler = HExtlib.profile "add_obj.typecheck_obj" in + fun uri obj -> profiler.HExtlib.profile (CicTypeChecker.typecheck_obj uri) obj let index_obj = - let profiler = CicUtil.profile "add_obj.index_obj" in + let profiler = HExtlib.profile "add_obj.index_obj" in fun ~dbd ~uri -> - profiler.CicUtil.profile (fun uri -> MetadataDb.index_obj ~dbd ~uri) uri - -let save_object_to_disk = - let profiler = CicUtil.profile "add_obj.save_object_to_disk" in - fun status uri obj ugraph univlist -> - profiler.CicUtil.profile (save_object_to_disk status uri obj ugraph) univlist + profiler.HExtlib.profile (fun uri -> MetadataDb.index_obj ~dbd ~uri) uri let add_obj uri obj status = let dbd = MatitaDb.instance () in @@ -201,8 +210,8 @@ let add_obj uri obj status = end let add_obj = - let profiler = CicUtil.profile "add_obj" in - fun uri obj status -> profiler.CicUtil.profile (add_obj uri obj) status + let profiler = HExtlib.profile "add_obj" in + fun uri obj status -> profiler.HExtlib.profile (add_obj uri obj) status module OrderedUri = struct @@ -312,7 +321,9 @@ let remove ?(verbose=false) uri = MatitaLog.debug ("Removing: " ^ baseuri ^ "/*"); last_baseuri := baseuri end; - MatitaMisc.safe_remove (Http_getter.resolve' uri) + let file = Http_getter.resolve' uri in + MatitaMisc.safe_remove file; + MatitaMisc.rmdir_descend (Filename.dirname file) with Http_getter_types.Key_not_found _ -> ()); remove_coercion uri; ignore (MatitaDb.remove_uri uri);