X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2FautoCache.ml;h=7458e577748bd99e731f9592bbdeebceac534e80;hb=6bd49a71cfff3f29ee79da975678292861f9be0d;hp=5fb4640d71e2c8308280a64e090c0bb5a32d6494;hpb=56da33f7a668f84dd0edb335bce9f6fef9a985aa;p=helm.git

diff --git a/helm/software/components/tactics/autoCache.ml b/helm/software/components/tactics/autoCache.ml
index 5fb4640d7..7458e5777 100644
--- a/helm/software/components/tactics/autoCache.ml
+++ b/helm/software/components/tactics/autoCache.ml
@@ -31,14 +31,20 @@ type cache_elem =
   | Notfound
 type cache = (Universe.universe * ((cache_key * cache_elem) list));;
 
+let debug = false;;
+let prerr_endline s = 
+  if debug then prerr_endline s else ()
+;;
 
 let cache_empty = (Universe.empty,[]);;
 
 let get_candidates (univ,_) ty = 
-  if Universe.key ty = ty then
+(*   if Universe.key ty = ty then *)
     Universe.get_candidates univ ty
+(*
   else 
-    []
+    (prerr_endline ("skip: " ^ CicPp.ppterm (Universe.key ty)); [])
+ *)
 ;;
 
 let index (univ,cache) key term =
@@ -53,13 +59,18 @@ let cache_add_list (univ,cache) context terms_and_types =
   let univ = 
     List.fold_left
       (fun univ (t,ty) -> 
+         prerr_endline ("indexing: " ^ CicPp.ppterm ty);
 	 Universe.index_local_term univ context t ty)
       univ terms_and_types  
   in
   univ, cache
 
 let cache_examine (_,oldcache) cache_key = 
-  try List.assoc cache_key oldcache with Not_found -> Notfound
+  prerr_endline ("examine : " ^ CicPp.ppterm cache_key);
+  try snd (List.find (fun (x,_) -> CicUtil.alpha_equivalence x cache_key) 
+        oldcache) with Not_found -> 
+    prerr_endline "notfound";
+    Notfound
 ;;
 let cache_replace (univ,oldcache) key v =
   let oldcache = List.filter (fun (i,_) -> i <> key) oldcache in
@@ -70,27 +81,46 @@ let cache_remove (univ,oldcache) key =
   univ,oldcache
 ;;
 let cache_add_failure cache cache_key depth =
+  prerr_endline 
+    ("CACHE: ADD FAIL " ^ CicPp.ppterm cache_key ^ 
+      " depth: " ^ string_of_int depth);
   match cache_examine cache cache_key with
   | Failed_in i when i > depth -> cache
   | Notfound  
   | Failed_in _ 
   | UnderInspection -> cache_replace cache cache_key (Failed_in depth)
-  | Succeded t -> 
+  | Succeded t -> cache 
+                  (*
       prerr_endline (CicPp.ppterm t);
-      assert false (* if succed it can't fail *)
+      assert false (* if succed it can't fail *) *)
 ;;
 let cache_add_success ((univ,_) as cache) cache_key proof =
+  let u_key = Universe.key cache_key in
+  if u_key <> cache_key then
+    Universe.index univ u_key proof, snd cache
+  else
+    univ, 
+    snd 
+    (match cache_examine cache cache_key with
+    | Failed_in _ -> cache_replace cache cache_key (Succeded proof)
+    | UnderInspection -> cache_replace cache cache_key (Succeded proof)
+    | Succeded t -> (* we may decide to keep the smallest proof *) cache
+    | Notfound -> cache_replace cache cache_key (Succeded proof))
+(*
   (if Universe.key cache_key = cache_key then
     Universe.index univ cache_key proof
   else
     univ),snd
-  (match cache_examine cache cache_key with
+  (prerr_endline ("CACHE: ADD SUCCESS" ^ CicPp.ppterm cache_key);
+  match cache_examine cache cache_key with
   | Failed_in _ -> cache_replace cache cache_key (Succeded proof)
   | UnderInspection -> cache_replace cache cache_key (Succeded proof)
   | Succeded t -> (* we may decide to keep the smallest proof *) cache
   | Notfound -> cache_replace cache cache_key (Succeded proof))
 ;;
+*)
 let cache_add_underinspection ((univ,oldcache) as cache) cache_key depth =
+  prerr_endline ("CACHE: ADD INSPECTING" ^ CicPp.ppterm cache_key);
   match cache_examine cache cache_key with
   | Failed_in i when i < depth -> cache_replace cache cache_key UnderInspection
   | Notfound -> univ,(cache_key,UnderInspection)::oldcache
@@ -103,16 +133,19 @@ let cache_print context (_,oldcache) =
   String.concat "\n" 
     (HExtlib.filter_map 
       (function 
-        | (k,Succeded _) -> Some (CicPp.pp k names)
+        | (k,Succeded _) -> Some ("CACHE SUCCESS: " ^ CicPp.pp k names)
         | _ -> None)
       oldcache)
 ;;
 let cache_remove_underinspection ((univ,oldcache) as cache) cache_key =
+  prerr_endline ("CACHE: REMOVE INSPECTING" ^ CicPp.ppterm cache_key);
   match cache_examine cache cache_key with
   | Notfound 
+  | Failed_in _ (* -> assert false  *)
   | UnderInspection ->  cache_remove cache cache_key
-  | Failed_in _ -> assert false
-  | Succeded _ -> assert false (* it must be a new goal *)
+  | Succeded _ -> cache (* 
+      prerr_endline (CicPp.ppterm cache_key);            
+      assert false (* it must be a new goal *) *)
 ;;
 let cache_size (_,oldcache) = 
   List.length (List.filter (function (_,Succeded _) -> true | _ -> false) oldcache)