X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Ftactics%2FautoCache.ml;h=0b42391fa63beb345d941aa34a773562cdf8fb97;hb=004ccf29097c8ab5c4997555b54aba5831fa035a;hp=4c18713888d4e789421474fe092759d3f4c4211c;hpb=bbdf43ea2ac586be4f3c0779e98642b8f7bd1a03;p=helm.git

diff --git a/helm/software/components/tactics/autoCache.ml b/helm/software/components/tactics/autoCache.ml
index 4c1871388..0b42391fa 100644
--- a/helm/software/components/tactics/autoCache.ml
+++ b/helm/software/components/tactics/autoCache.ml
@@ -49,18 +49,30 @@ let rec unfold context = function
       let t' = unfold ((Some (name,Cic.Decl s))::context) t in
 	Cic.Prod(name,s,t')	
   | t -> ProofEngineReduction.unfold context t
+
+
+let rec collapse_head_metas = function 
+  | Cic.Appl(a::l) -> 
+      let a' = collapse_head_metas a in
+      (match a' with
+	| Cic.Meta(n,m) -> Cic.Meta(n,m)
+	| t -> 	
+	    let l' = List.map collapse_head_metas l in
+	       Cic.Appl(t::l'))
+  | t -> t
+;;
   
-let rec head = function 
-  | Cic.Prod(_,_,t) -> CicSubstitution.subst (Cic.Meta (-1,[])) (head t)
+let rec head t = 
+  let rec aux = function
+  | Cic.Prod(_,_,t) -> 
+      CicSubstitution.subst (Cic.Meta (-1,[])) (aux t)
   | t -> t
+  in collapse_head_metas (aux t)
 ;;
 
-let index ((univ,oldcache) as cache) key term =
-  match key with
-  | Cic.Meta _ -> cache
-  | _ -> 
-      prerr_endline("ADD: "^CicPp.ppterm key^" |-> "^CicPp.ppterm term);
-      (TI.index univ key term,oldcache)
+let index (univ,oldcache) key term =
+  prerr_endline("ADD: "^CicPp.ppterm key^" |-> "^CicPp.ppterm term);
+  (TI.index univ key term,oldcache)
 ;;
 
 let index_term_and_unfolded_term cache context t ty =
@@ -72,47 +84,11 @@ let index_term_and_unfolded_term cache context t ty =
   with ProofEngineTypes.Fail _ -> cache
 ;;
 
-let cache_add_library dbd proof gl cache = 
-  let univ = MetadataQuery.universe_of_goals ~dbd proof gl in
-  let terms = List.map CicUtil.term_of_uri univ in
-  let tyof t = fst(CicTypeChecker.type_of_aux' [] [] t CicUniv.empty_ugraph)in
-  List.fold_left 
-    (fun acc term -> 
-      (* 
-      let key = head (tyof term) in
-      index acc key term
-      *)
-      index_term_and_unfolded_term acc [] term (tyof term))
-    cache terms
-;;
-let cache_add_context context metasenv cache =  
-  let tail = function [] -> [] | h::tl -> tl in
-  let rc,_,_ = 
-    List.fold_left 
-    (fun (acc,i,ctx) ctxentry ->
-      match ctxentry with
-      | Some (_,Cic.Decl t) -> 
-          let ty = CicSubstitution.lift i t in
-          let elem = Cic.Rel i in
-	  index_term_and_unfolded_term acc context elem ty, i+1, tail ctx
-          (* index acc key elem, i+1, tail ctx *)
-      | Some (_,Cic.Def (_,Some t)) ->
-          let ty = CicSubstitution.lift i t in
-          let elem = Cic.Rel i in
-	  index_term_and_unfolded_term acc context elem ty, i+1, tail ctx
-      | Some (_,Cic.Def (t,None)) ->
-          let ctx = tail ctx in 
-          let ty = 
-	    CicSubstitution.lift i
-              (fst (CicTypeChecker.type_of_aux' metasenv ctx t CicUniv.empty_ugraph))
-          in
-          let elem = Cic.Rel i in
-	  index_term_and_unfolded_term acc context elem ty, i+1, tail ctx
-      |  _ -> acc,i+1,tail ctx)
-    (cache,1,context) context
-  in
-  rc
-;;
+let cache_add_list cache context terms_and_types =
+  List.fold_left  
+    (fun acc (term,ty) -> 
+       index_term_and_unfolded_term acc context term ty)
+    cache terms_and_types
 
 let cache_examine (_,oldcache) cache_key = 
   try List.assoc cache_key oldcache with Not_found -> Notfound