1) NCicTypechecker.typecheck_obj removed, since it did not add to the

[helm.git] / helm / software / components / ng_kernel / nCicEnvironment.ml

diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml
index ef3bca22d06941ebfa20fe883d4423eb7ec87e0e..9cec01f60c2ed9d96de0d84172a4e8eedd509d13 100644 (file)
--- a/helm/software/components/ng_kernel/nCicEnvironment.ml
+++ b/helm/software/components/ng_kernel/nCicEnvironment.ml
@@ -113,57 +113,81 @@ let set_typecheck_obj f =
 ;;
 
 let cache = NUri.UriHash.create 313;;
+let history = ref [];;
 let frozen_list = ref [];;
 
+let invalidate_obj uri =
+prerr_endline ("INVALIDO: " ^ NUri.string_of_uri uri);
+List.iter (fun uri -> prerr_endline ("INH: " ^ NUri.string_of_uri uri)) !history;
+ let rec aux to_be_deleted =
+  function
+     [] -> assert false
+   | uri'::tl when NUri.eq uri uri' -> uri'::to_be_deleted,tl
+   | uri'::tl -> aux (uri'::to_be_deleted) tl
+ in
+  let to_be_deleted,h = aux [] !history in
+   history := h;
+   List.iter (fun uri -> NUri.UriHash.remove cache uri) to_be_deleted
+;;
+
 exception Propagate of NUri.uri * exn;;
 
+let to_exn f x =
+ match f x with
+    `WellTyped o -> o
+  | `Exn e -> raise e
+;;
+
+let check_and_add_obj ((u,_,_,_,_) as obj) =
+ let saved_frozen_list = !frozen_list in
+ try
+   frozen_list := (u,obj)::saved_frozen_list;
+   !typecheck_obj obj;
+   frozen_list := saved_frozen_list;
+   let obj = `WellTyped obj in
+   NUri.UriHash.add cache u obj;
+   history := u::!history;
+   obj
+ with
+    Sys.Break as e ->
+     frozen_list := saved_frozen_list;
+     raise e
+  | Propagate (u',old_exn) as e' ->
+     frozen_list := saved_frozen_list;
+     let exn = `Exn (BadDependency (lazy (NUri.string_of_uri u ^
+       " depends (recursively) on " ^ NUri.string_of_uri u' ^
+       " which is not well-typed"), 
+       match old_exn with BadDependency (_,e) -> e | _ -> old_exn)) in
+     NUri.UriHash.add cache u exn;
+     history := u::!history;
+     if saved_frozen_list = [] then
+      exn
+     else
+      raise e'
+  | e ->
+     frozen_list := saved_frozen_list;
+     let exn = `Exn e in
+     NUri.UriHash.add cache u exn;
+     history := u::!history;
+     if saved_frozen_list = [] then
+      exn
+     else
+      raise (Propagate (u,e))
+;;
+
 let get_checked_obj u =
  if List.exists (fun (k,_) -> NUri.eq u k) !frozen_list
  then
   raise (CircularDependency (lazy (NUri.string_of_uri u)))
  else
-  let obj =
-   try NUri.UriHash.find cache u
-   with
-    Not_found ->
-     let saved_frozen_list = !frozen_list in
-     try
-      let obj = !get_obj u in
-       frozen_list := (u,obj)::saved_frozen_list;
-       !typecheck_obj obj;
-       frozen_list := saved_frozen_list;
-       let obj = `WellTyped obj in
-       NUri.UriHash.add cache u obj;
-       obj
-     with
-        Sys.Break as e ->
-         frozen_list := saved_frozen_list;
-         raise e
-      | Propagate (u',old_exn) as e' ->
-         frozen_list := saved_frozen_list;
-         let exn = `Exn (BadDependency (lazy (NUri.string_of_uri u ^
-           " depends (recursively) on " ^ NUri.string_of_uri u' ^
-           " which is not well-typed"), 
-           match old_exn with BadDependency (_,e) -> e | _ -> old_exn)) in
-         NUri.UriHash.add cache u exn;
-         if saved_frozen_list = [] then
-          exn
-         else
-          raise e'
-      | e ->
-         frozen_list := saved_frozen_list;
-         let exn = `Exn e in
-         NUri.UriHash.add cache u exn;
-         if saved_frozen_list = [] then
-          exn
-         else
-          raise (Propagate (u,e))
-  in
-   match obj with
-      `WellTyped o -> o
-    | `Exn e -> raise e
+  try NUri.UriHash.find cache u
+  with Not_found -> check_and_add_obj (!get_obj u)
 ;;
 
+let get_checked_obj u = to_exn get_checked_obj u;;
+
+let check_and_add_obj obj = ignore (to_exn check_and_add_obj obj);;
+
 let get_checked_decl = function
   | Ref.Ref (uri, Ref.Decl) ->
       (match get_checked_obj uri with