X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fcic_proof_checking%2FcicEnvironment.ml;h=ec12c8d01c80a790fec70c836ea5efa7cc4e1d3e;hb=5acff80c93b3e3df4a52ff8cb9596de46f7bd924;hp=1f6789e76895156311b0cc7470f89fb1b8fb7813;hpb=55b82bd235d82ff7f0a40d980effe1efde1f5073;p=helm.git

diff --git a/helm/software/components/cic_proof_checking/cicEnvironment.ml b/helm/software/components/cic_proof_checking/cicEnvironment.ml
index 1f6789e76..ec12c8d01 100644
--- a/helm/software/components/cic_proof_checking/cicEnvironment.ml
+++ b/helm/software/components/cic_proof_checking/cicEnvironment.ml
@@ -41,11 +41,12 @@
                  CicEnvironment SETTINGS (trust and clean_tmp)
  * ************************************************************************** *)
 
+let debug = false;;
 let cleanup_tmp = true;;
 let trust = ref  (fun _ -> true);;
 let set_trust f = trust := f
 let trust_obj uri = !trust uri
-let debug_print = fun x -> prerr_endline (Lazy.force x)
+let debug_print = if debug then fun x -> prerr_endline (Lazy.force x) else ignore
 
 (* ************************************************************************** *
                                    TYPES 
@@ -104,6 +105,7 @@ module Cache :
    val is_in_unchecked: UriManager.uri -> bool
    val is_in_cooked: UriManager.uri -> bool
    val list_all_cooked_uris: unit -> UriManager.uri list
+   val invalidate: unit -> unit
   end 
 =
   struct
@@ -142,6 +144,15 @@ module Cache :
     (* unchecked is used to store objects just fetched, nothing more. *)    
     let unchecked_list = ref [];;
 
+    let invalidate _ =
+      let l = HT.fold (fun k (o,g,gl) acc -> (k,(o,Some (g,gl)))::acc) cacheOfCookedObjects [] in
+      unchecked_list := 
+        HExtlib.list_uniq ~eq:(fun (x,_) (y,_) -> UriManager.eq x y)
+        (List.sort (fun (x,_) (y,_) -> UriManager.compare x y) (l @ !unchecked_list));
+      frozen_list := [];
+      HT.clear cacheOfCookedObjects;
+    ;;
+
     let empty () = 
       HT.clear cacheOfCookedObjects;
       unchecked_list := [] ;
@@ -216,13 +227,15 @@ module Cache :
            if List.mem_assq uri !frozen_list then
              (* CIRCULAR DEPENDENCY DETECTED, print the error and raise *)
              begin
-               print_endline "\nCircularDependency!\nfrozen list: \n";
+(*
+               prerr_endline "\nCircularDependency!\nfrozen list: \n";
                List.iter (
                  fun (u,(_,o)) ->
                    let su = UriManager.string_of_uri u in
                    let univ = if o = None then "NO_UNIV" else "" in
-                   print_endline (su^" "^univ)) 
+                   prerr_endline (su^" "^univ)) 
                  !frozen_list;
+*)
                raise (CircularDependency (lazy (UriManager.string_of_uri uri)))
              end
            else
@@ -363,7 +376,7 @@ let get_object_to_add uri =
     match UriManager.bodyuri_of_uri uri with
        None -> None
     |  Some bodyuri ->
-        if Http_getter.exists' bodyuri then
+        if Http_getter.exists' ~local:false bodyuri then
           Some (Http_getter.getxml' bodyuri)
         else
           None
@@ -456,13 +469,13 @@ let get_cooked_obj_with_univlist ?(trust=true) base_ugraph uri =
   try
     (* the object should be in the cacheOfCookedObjects *)
     let o,u,l = Cache.find_cooked uri in
-      o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri)),l
+      o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*))),l
   with Not_found ->
     (* this should be an error case, but if we trust the uri... *)
     if trust && trust_obj uri then
       (* trusting means that we will fetch cook it on the fly *)
       let o,u,l = add_trusted_uri_to_cache uri in
-        o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri)),l
+        o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*))),l
     else
       (* we don't trust the uri, so we fail *)
       begin
@@ -490,14 +503,14 @@ let get_cooked_obj ?trust base_ugraph uri =
  *)
 let is_type_checked ?(trust=true) base_ugraph uri =
   try 
-    let o,u,_ = Cache.find_cooked uri in
-      CheckedObj (o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri)))
+    let o,u,l = Cache.find_cooked uri in
+      CheckedObj (o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*))))
   with Not_found ->
     (* this should return UncheckedObj *)
     if trust && trust_obj uri then
       (* trusting means that we will fetch cook it on the fly *)
-      let o,u,_ = add_trusted_uri_to_cache uri in
-        CheckedObj ( o, CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri))
+      let o,u,l = add_trusted_uri_to_cache uri in
+        CheckedObj ( o, CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*)))
     else
       let o,u,_ = find_or_add_to_unchecked uri in
       Cache.unchecked_to_frozen uri;
@@ -510,12 +523,12 @@ let is_type_checked ?(trust=true) base_ugraph uri =
 let get_obj base_ugraph uri =
   try
     (* the object should be in the cacheOfCookedObjects *)
-    let o,u,_ = Cache.find_cooked uri in
-      o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri))
+    let o,u,l = Cache.find_cooked uri in
+      o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*)))
   with Not_found ->
     (* this should be an error case, but if we trust the uri... *)
-      let o,u,_ = find_or_add_to_unchecked uri in
-        o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri))
+      let o,u,l = find_or_add_to_unchecked uri in
+        o,(CicUniv.merge_ugraphs ~base_ugraph ~increment:(u,uri(*,l*)))
 ;; 
 
 let in_cache uri =
@@ -524,7 +537,7 @@ let in_cache uri =
 let add_type_checked_obj uri (obj,ugraph,univlist) =
  Cache.add_cooked ~key:uri (obj,ugraph,univlist)
 
-let in_library uri = in_cache uri || Http_getter.exists' uri
+let in_library uri = in_cache uri || Http_getter.exists' ~local:false uri
 
 let remove_obj = Cache.remove
   
@@ -543,3 +556,7 @@ let list_obj () =
       debug_print (lazy "Who has removed the uri in the meanwhile?");
       raise Not_found
 ;;
+
+let invalidate _ = 
+   Cache.invalidate ()
+;;