From ea3883261d74eda2451ab90efc354a9c03b48707 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Fri, 19 Jun 2009 14:05:18 +0000 Subject: [PATCH] Persistent db (to lookup names in the library) inefficiently implemented as an associative list which is: 1) loaded from disk and stored in memory when matita starts 2) updated every time a file is saved Still to be implemented: decompilation. --- .../components/ng_kernel/nCicLibrary.ml | 36 ++++++++++++++----- .../components/ng_kernel/nCicLibrary.mli | 2 ++ helm/software/matita/matitaInit.ml | 7 ++-- 3 files changed, 33 insertions(+), 12 deletions(-) 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 = diff --git a/helm/software/components/ng_kernel/nCicLibrary.mli b/helm/software/components/ng_kernel/nCicLibrary.mli index a8b546d2e..326ef143e 100644 --- a/helm/software/components/ng_kernel/nCicLibrary.mli +++ b/helm/software/components/ng_kernel/nCicLibrary.mli @@ -47,4 +47,6 @@ module type Serializer = module Serializer(S: sig type status end): Serializer with type status= S.status +val init: unit -> unit + (* EOF *) diff --git a/helm/software/matita/matitaInit.ml b/helm/software/matita/matitaInit.ml index aee55d60d..72792a56d 100644 --- a/helm/software/matita/matitaInit.ml +++ b/helm/software/matita/matitaInit.ml @@ -25,10 +25,10 @@ (* $Id$ *) -type thingsToInitilaize = +type thingsToInitialize = ConfigurationFile | Db | Environment | Getter | CmdLine | Registry -exception FailedToInitialize of thingsToInitilaize +exception FailedToInitialize of thingsToInitialize let wants s l = List.iter ( @@ -275,7 +275,8 @@ let other_components = let initialize_all () = status := List.fold_left (fun s f -> f s) !status - (conf_components @ other_components) + (conf_components @ other_components); + NCicLibrary.init () let parse_cmdline_and_configuration_file () = status := List.fold_left (fun s f -> f s) !status conf_components -- 2.39.2