X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaDisambiguator.ml;h=22819536fe31b02ea993b8cf3dcc6185c549b5d2;hb=24320a56c9cc9e92c0a03475e529b4a54f5d4e14;hp=5a7fe0b9f45ff925fcb0ca28947f3900597c49b0;hpb=8ecc9fb74f80c2f5b3e3c70f0a625e63a48292fb;p=helm.git

diff --git a/helm/matita/matitaDisambiguator.ml b/helm/matita/matitaDisambiguator.ml
index 5a7fe0b9f..22819536f 100644
--- a/helm/matita/matitaDisambiguator.ml
+++ b/helm/matita/matitaDisambiguator.ml
@@ -73,7 +73,8 @@ let disambiguate_thing ~aliases ~universe
       aliases:DisambiguateTypes.environment ->
       universe:DisambiguateTypes.multiple_environment option ->
       'a -> 'b)
-  ~(set_aliases: DisambiguateTypes.environment -> 'b -> 'b)
+  ~(drop_aliases: 'b -> 'b)
+  ~(drop_aliases_and_clear_diff: 'b -> 'b)
   (thing: 'a)
 =
   assert (universe <> None);
@@ -96,11 +97,11 @@ let disambiguate_thing ~aliases ~universe
   in
   let set_aliases (instances,(use_mono_aliases,_,_),_) (_, user_asked as res) =
    if use_mono_aliases && not instances then
-    res
+    drop_aliases res
    else if user_asked then
-    res (* one shot aliases *)
+    drop_aliases res (* one shot aliases *)
    else
-    set_aliases aliases res
+    drop_aliases_and_clear_diff res
   in
   let rec aux =
     function
@@ -120,8 +121,34 @@ let disambiguate_thing ~aliases ~universe
     CoercDb.use_coercions := saved_use_coercions;
     raise exn
 
-let set_aliases aliases (choices, user_asked) =
-  (List.map (fun (_, a, b, c) -> aliases, a, b, c) choices),
+type disambiguator_thing =
+ { do_it :
+    'a 'b.
+    aliases:DisambiguateTypes.environment ->
+    universe:DisambiguateTypes.multiple_environment option ->
+    f:(?fresh_instances:bool ->
+       aliases:DisambiguateTypes.environment ->
+       universe:DisambiguateTypes.multiple_environment option ->
+       'a -> 'b * bool) ->
+    drop_aliases:('b * bool -> 'b * bool) ->
+    drop_aliases_and_clear_diff:('b * bool -> 'b * bool) -> 'a -> 'b * bool
+ }
+
+let disambiguate_thing =
+ let profiler = HExtlib.profile "disambiguate_thing" in
+  { do_it =
+     fun ~aliases ~universe ~f ~drop_aliases ~drop_aliases_and_clear_diff thing
+     -> profiler.HExtlib.profile
+         (disambiguate_thing ~aliases ~universe ~f ~drop_aliases
+           ~drop_aliases_and_clear_diff) thing
+  }
+
+let drop_aliases (choices, user_asked) =
+  (List.map (fun (d, a, b, c) -> d, a, b, c) choices),
+  user_asked
+
+let drop_aliases_and_clear_diff (choices, user_asked) =
+  (List.map (fun (_, a, b, c) -> [], a, b, c) choices),
   user_asked
 
 let disambiguate_term ?fresh_instances ~dbd ~context ~metasenv ?initial_ugraph
@@ -131,10 +158,11 @@ let disambiguate_term ?fresh_instances ~dbd ~context ~metasenv ?initial_ugraph
   let f =
     Disambiguator.disambiguate_term ~dbd ~context ~metasenv ?initial_ugraph
   in
-  disambiguate_thing ~aliases ~universe ~f ~set_aliases term
+  disambiguate_thing.do_it ~aliases ~universe ~f ~drop_aliases
+   ~drop_aliases_and_clear_diff term
 
 let disambiguate_obj ?fresh_instances ~dbd ~aliases ~universe ~uri obj =
   assert (fresh_instances = None);
   let f = Disambiguator.disambiguate_obj ~dbd ~uri in
-  disambiguate_thing ~aliases ~universe ~f ~set_aliases obj
-
+  disambiguate_thing.do_it ~aliases ~universe ~f ~drop_aliases
+   ~drop_aliases_and_clear_diff obj