debug pps removed

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

diff --git a/helm/software/components/ng_kernel/nCicLibrary.ml b/helm/software/components/ng_kernel/nCicLibrary.ml
index 80b0911b2d41453ef2ff3b8789af110933e99806..d54002d60c9c60dabf96ac50bca3808824d054f9 100644 (file)
--- a/helm/software/components/ng_kernel/nCicLibrary.ml
+++ b/helm/software/components/ng_kernel/nCicLibrary.ml
@@ -23,7 +23,18 @@ let storage = ref [];;
 let aliases = ref [];;
 let cache = ref NUri.UriMap.empty;;
 
-let time_travel (sto,ali,cac) = storage := sto; aliases := ali; cache := cac;;
+class status =
+ object
+  val timestamp = (time0 : timestamp)
+  method timestamp = timestamp
+  method set_timestamp v = {< timestamp = v >}
+  method set_library_status (o : status) = {< timestamp = o#timestamp >}
+ end
+
+let time_travel status =
+ let sto,ali,cac = status#timestamp in
+  storage := sto; aliases := ali; cache := cac
+;;
 
 let path_of_baseuri baseuri =
  let uri = NUri.string_of_uri baseuri in
@@ -56,7 +67,7 @@ let serialize ~baseuri dump =
     Marshal.to_channel ch (magic,obj) [];
     close_out ch
   ) !storage;
- time_travel time0
+ time_travel (new status)
 ;;
 
 let refresh_uri uri = NUri.uri_of_string (NUri.string_of_uri uri);;
@@ -79,7 +90,10 @@ module type Serializer =
  sig
   type status
   type obj
-  val register: string -> ('a -> status -> status) -> ('a -> obj)
+  val register:
+   string ->
+    ('a -> refresh_uri_in_term:(NCic.term -> NCic.term) -> status -> status) ->
+    ('a -> obj)
   val serialize: baseuri:NUri.uri -> obj list -> unit
   val require: baseuri:NUri.uri -> status -> status
  end
@@ -97,7 +111,10 @@ module Serializer(S: sig type status end) =
    already_registered := tag :: !already_registered;
    require1 :=
     (fun (tag',data) as x ->
-     if tag=tag' then require (Obj.magic data) else !require1 x);
+     if tag=tag' then
+      require (Obj.magic data) ~refresh_uri_in_term
+     else
+      !require1 x);
    (fun x -> tag,Obj.repr x)
 
   let serialize = serialize
@@ -133,7 +150,7 @@ let aliases_of uri =
   Not_found -> raise (NCicEnvironment.ObjectNotFound (lazy (NUri.string_of_uri uri)))
 ;;
 
-let add_obj u obj =
+let add_obj status u obj =
  storage := (u,obj)::!storage;
   let _,height,_,_,obj = obj in
   let references =
@@ -164,7 +181,7 @@ let add_obj u obj =
          ) il)
   in
   aliases := references @ !aliases;
-  !storage,!aliases,!cache
+  status#set_timestamp (!storage,!aliases,!cache)
 ;;
 
 let get_obj u =