X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaSync.ml;h=fe2726a0a6e24a6cf2be949afea364635c06a779;hb=5b32b7905bc78c11e353efd68137b8eb7b6ac73b;hp=3d9d74dccb76ce526869a13404e786b2fa53ea33;hpb=b12aa2f7dc56d9915603339e9a1e1ba23d834b4a;p=helm.git diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml index 3d9d74dcc..fe2726a0a 100644 --- a/helm/matita/matitaSync.ml +++ b/helm/matita/matitaSync.ml @@ -106,6 +106,7 @@ let paths_and_uris_of_obj uri status = 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 univgraphuri = UriManager.univgraphuri_of_uri uri in let innertypesfilename = Str.replace_first (Str.regexp "^cic:") "" (UriManager.string_of_uri innertypesuri) ^ ".xml.gz" in let innertypespath = basedir ^ "/" ^ innertypesfilename in @@ -115,9 +116,13 @@ let paths_and_uris_of_obj uri status = let xmlbodyfilename = Str.replace_first (Str.regexp "^cic:/") "" (UriManager.string_of_uri uri) ^ ".body.xml.gz" in let xmlbodypath = basedir ^ "/" ^ xmlbodyfilename in - xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri + let xmlunivgraphfilename = Str.replace_first (Str.regexp "^cic:/") "" + (UriManager.string_of_uri univgraphuri) ^ ".xml.gz" in + let xmlunivgraphpath = basedir ^ "/" ^ xmlunivgraphfilename in + xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri, + xmlunivgraphpath, univgraphuri -let save_object_to_disk status uri obj = +let save_object_to_disk status uri obj ugraph univlist = let ensure_path_exists path = let dir = Filename.dirname path in MatitaMisc.mkdir dir @@ -129,7 +134,8 @@ let save_object_to_disk status uri obj = Cic2Xml.print_object uri ?ids_to_inner_sorts:None ~ask_dtd_to_the_getter:false annobj in - let xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri = + let xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri, + xmlunivgraphpath, univgraphuri = paths_and_uris_of_obj uri status in let path_scheme_of path = "file://" ^ path in @@ -137,9 +143,11 @@ let save_object_to_disk status uri obj = (List.map Filename.dirname [innertypespath; xmlpath]); (* now write to disk *) ensure_path_exists xmlpath; - Xml.pp ~gzip:true xml (Some 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) :: + (uri,xmlpath) :: (innertypesuri,innertypespath) :: + (univgraphuri,xmlunivgraphpath) :: (* now the optional body, both write and register *) (match bodyxml,bodyuri with None,None -> [] @@ -170,10 +178,12 @@ let add_obj uri obj status = command_error (sprintf "%s already defined" suri) else begin typecheck_obj uri obj; (* 1 *) + let _, ugraph, univlist = + CicEnvironment.get_cooked_obj_with_univlist CicUniv.empty_ugraph uri in try index_obj ~dbd ~uri; (* 2 must be in the env *) try - let new_stuff = save_object_to_disk status uri obj in (* 3 *) + let new_stuff=save_object_to_disk status uri obj ugraph univlist in(*3*) try MatitaLog.message (sprintf "%s defined" suri); let status = add_aliases_for_object status suri obj in @@ -187,7 +197,7 @@ let add_obj uri obj status = raise exc with exc -> CicEnvironment.remove_obj uri; (* -1 *) - raise exc + raise exc end let add_obj = @@ -279,9 +289,10 @@ let time_travel ~present ~past = let remove ~verbose uri = let derived_uris_of_uri uri = UriManager.innertypesuri_of_uri uri :: + UriManager.univgraphuri_of_uri uri :: (match UriManager.bodyuri_of_uri uri with | None -> [] - | Some u -> [u]) + | Some u -> [u]) in let to_remove = uri ::