X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fmatita%2FmatitaSync.ml;h=5dc3e2d248743311a92a2a7a584b6110833b11ba;hb=6e9833ff8664143f8916caf98f0818322e7ff9a1;hp=4d549fadefe449220a0341fed35b0f115a2f3f86;hpb=2534f543cfce5f39b0445e593df5810ba2cbf5ad;p=helm.git diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml index 4d549fade..5dc3e2d24 100644 --- a/helm/matita/matitaSync.ml +++ b/helm/matita/matitaSync.ml @@ -30,22 +30,22 @@ open MatitaTypes let alias_diff ~from status = let module Map = DisambiguateTypes.Environment in Map.fold - (fun domain_item codomain_item acc -> - if not (Map.mem domain_item from.aliases) then - Map.add domain_item codomain_item acc - else - 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) + (fun domain_item (description1,_ as codomain_item) acc -> + try + let description2,_ = Map.find domain_item from.aliases in + if description1 <> description2 then + Map.add domain_item codomain_item acc + else + acc + with + Not_found -> + Map.add domain_item codomain_item acc) status.aliases Map.empty +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 set_proof_aliases status aliases = let new_status = { status with aliases = aliases } in let diff = alias_diff ~from:status new_status in @@ -110,6 +110,11 @@ let paths_and_uris_of_obj uri status = let xmlbodypath = basedir ^ "/" ^ xmlbodyfilename in xmlpath, xmlbodypath, innertypespath, bodyuri, innertypesuri +let acic_object_of_cic_object = + let profiler = CicUtil.profile "add_obj.save_object_to_disk.acic_object_of_cic_object" in + fun ~eta_fix obj -> + profiler.CicUtil.profile (Cic2acic.acic_object_of_cic_object ~eta_fix) obj + let save_object_to_disk status uri obj = let ensure_path_exists path = let dir = Filename.dirname path in @@ -117,7 +122,7 @@ let save_object_to_disk status uri obj = in (* generate annobj, ids_to_inner_sorts and ids_to_inner_types *) let annobj,_,_,ids_to_inner_sorts,ids_to_inner_types,_,_ = - Cic2acic.acic_object_of_cic_object ~eta_fix:false obj + acic_object_of_cic_object ~eta_fix:false obj in (* prepare XML *) let xml, bodyxml = @@ -150,15 +155,29 @@ let save_object_to_disk status uri obj = [bodyuri, xmlbodypath] | _-> 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 index_obj = + let profiler = CicUtil.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 -> + profiler.CicUtil.profile (save_object_to_disk status uri) obj + let add_obj uri obj status = let dbd = MatitaDb.instance () in let suri = UriManager.string_of_uri uri in if CicEnvironment.in_library uri then command_error (sprintf "%s already defined" suri) else begin - CicTypeChecker.typecheck_obj uri obj; (* 1 *) + typecheck_obj uri obj; (* 1 *) try - MetadataDb.index_obj ~dbd ~uri; (* 2 must be in the env *) + index_obj ~dbd ~uri; (* 2 must be in the env *) try let new_stuff = save_object_to_disk status uri obj in (* 3 *) try