all initialization code is now in the new matitaInit.ml module.

[helm.git] / helm / matita / matitaSync.ml

diff --git a/helm/matita/matitaSync.ml b/helm/matita/matitaSync.ml
index 55cb4a45c09d45c887e07c26602934283bc61679..d3ae5fdc9deee3a8ccb4f225b99c177e97bc220c 100644 (file)
--- a/helm/matita/matitaSync.ml
+++ b/helm/matita/matitaSync.ml
@@ -29,30 +29,30 @@ open MatitaTypes
 
 let alias_diff ~from status = 
   let module Map = DisambiguateTypes.Environment in
-  Map.fold_flatten
-    (fun domain_item codomain_item acc ->
-       if not (Map.mem domain_item from.aliases) then
-         Map.cons domain_item codomain_item acc
-       else
-         begin
-           try 
-             let codomain1 = Map.find domain_item from.aliases in
-             let codomain2 = Map.find domain_item status.aliases in
-             List.fold_right
-              (fun item env ->
-                let dsc = fst item in
-                if not (List.exists (fun (dsc', _) -> dsc'=dsc) codomain1) then
-                  Map.cons domain_item codomain_item env
-                else
-                  env)
-              codomain2 acc
-           with Not_found -> acc
-         end)
+  Map.fold
+    (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
+ let multi_aliases =
+  DisambiguateTypes.Environment.fold DisambiguateTypes.Environment.cons
+   diff status.multi_aliases in
+ let new_status = { new_status with multi_aliases = multi_aliases } in
  if DisambiguateTypes.Environment.is_empty diff then
    new_status
  else
@@ -150,13 +150,17 @@ 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 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 *)
       try
@@ -176,6 +180,10 @@ let add_obj uri obj status =
       CicEnvironment.remove_obj uri; (* -1 *)
       raise exc
   end
+
+let add_obj =
+ let profiler = CicUtil.profile "add_obj" in
+  fun uri obj status -> profiler.CicUtil.profile (add_obj uri obj) status
    
 module OrderedUri =
 struct