X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicLibrary.ml;h=984b7ef6840a68552e952c58b882d10addbb2bb7;hb=ea3883261d74eda2451ab90efc354a9c03b48707;hp=18b7903e55d4ad66762491a72f45333d445ec546;hpb=bd3680d6b90f6c8bdda4eb4a915a86a0e806de63;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicLibrary.ml b/helm/software/components/ng_kernel/nCicLibrary.ml index 18b7903e5..984b7ef68 100644 --- a/helm/software/components/ng_kernel/nCicLibrary.ml +++ b/helm/software/components/ng_kernel/nCicLibrary.ml @@ -20,7 +20,8 @@ type timestamp = let time0 = [],[],NUri.UriMap.empty;; let storage = ref [];; -let aliases = ref [];; +let local_aliases = ref [];; +let global_aliases = ref [];; let cache = ref NUri.UriMap.empty;; class status = @@ -35,7 +36,7 @@ class status = let time_travel status = let sto,ali,cac = status#timestamp in - storage := sto; aliases := ali; cache := cac + storage := sto; local_aliases := ali; cache := cac ;; let path_of_baseuri ?(no_suffix=false) baseuri = @@ -52,8 +53,8 @@ let path_of_baseuri ?(no_suffix=false) baseuri = let magic = 0;; -let require0 ~baseuri = - let ch = open_in (path_of_baseuri baseuri) in +let require_path path = + let ch = open_in path in let mmagic,dump = Marshal.from_channel ch in close_in ch; if mmagic <> magic then @@ -62,9 +63,20 @@ let require0 ~baseuri = dump ;; +let require0 ~baseuri = require_path (path_of_baseuri baseuri);; + +let db_path () = Helm_registry.get "matita.basedir" ^ "/ng_db.ng";; + +let init () = + try + global_aliases := require_path (db_path ()) + with + Sys_error _ -> () +;; + let serialize ~baseuri dump = let ch = open_out (path_of_baseuri baseuri) in - Marshal.to_channel ch (magic,dump) [Marshal.Closures]; + Marshal.to_channel ch (magic,dump) []; close_out ch; List.iter (fun (uri,obj) -> @@ -72,6 +84,10 @@ let serialize ~baseuri dump = Marshal.to_channel ch (magic,obj) []; close_out ch ) !storage; + global_aliases := !local_aliases @ !global_aliases; + let ch = open_out (db_path ()) in + Marshal.to_channel ch (magic,!global_aliases) []; + close_out ch; time_travel (new status) ;; @@ -159,7 +175,8 @@ let fetch_obj uri = let resolve name = try HExtlib.filter_map - (fun (_,name',nref) -> if name'=name then Some nref else None) !aliases + (fun (_,name',nref) -> if name'=name then Some nref else None) + (!local_aliases @ !global_aliases) with Not_found -> raise (NCicEnvironment.ObjectNotFound (lazy name)) ;; @@ -167,7 +184,8 @@ let resolve name = let aliases_of uri = try HExtlib.filter_map - (fun (uri',_,nref) -> if NUri.eq uri' uri then Some nref else None) !aliases + (fun (uri',_,nref) -> + if NUri.eq uri' uri then Some nref else None) !local_aliases with Not_found -> raise (NCicEnvironment.ObjectNotFound (lazy (NUri.string_of_uri uri))) ;; @@ -202,8 +220,8 @@ let add_obj status u obj = (NReference.Ind (inductive,i,leftno))] ) il) in - aliases := references @ !aliases; - status#set_timestamp (!storage,!aliases,!cache) + local_aliases := references @ !local_aliases; + status#set_timestamp (!storage,!local_aliases,!cache) ;; let get_obj u =