X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicLibrary.ml;h=e2d800157dd4d57c4f44852dd6735b6dfc6ebd0e;hb=105236d275296be7ab2561f83ec539a1d166b445;hp=a5ecefad8fb0dcd18ee4879f8dbfb95ebcdd5e35;hpb=e48acbc0d00717ce8f12412673ece4e4ee0e9642;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicLibrary.ml b/helm/software/components/ng_kernel/nCicLibrary.ml index a5ecefad8..e2d800157 100644 --- a/helm/software/components/ng_kernel/nCicLibrary.ml +++ b/helm/software/components/ng_kernel/nCicLibrary.ml @@ -13,17 +13,78 @@ exception ObjectNotFound of string Lazy.t +let storage = ref [];; + +let aliases = ref [];; + +let resolve name = + try + HExtlib.filter_map + (fun (_,name',nref) -> if name'=name then Some nref else None) !aliases + with + Not_found -> raise (ObjectNotFound (lazy name)) +;; + +let aliases_of uri = + try + HExtlib.filter_map + (fun (uri',_,nref) -> if NUri.eq uri' uri then Some nref else None) !aliases + with + Not_found -> raise (ObjectNotFound (lazy (NUri.string_of_uri uri))) +;; + +let add_obj u obj = + storage := (u,obj)::!storage; + let _,height,_,_,obj = obj in + let references = + match obj with + NCic.Constant (_,name,None,_,_) -> + [u,name,NReference.reference_of_spec u NReference.Decl] + | NCic.Constant (_,name,Some _,_,_) -> + [u,name,NReference.reference_of_spec u (NReference.Def height)] + | NCic.Fixpoint (is_ind,fl,_) -> + HExtlib.list_mapi + (fun (_,name,recno,_,_) i -> + if is_ind then + u,name,NReference.reference_of_spec u(NReference.Fix(i,recno,height)) + else + u,name,NReference.reference_of_spec u (NReference.CoFix i)) fl + | NCic.Inductive (inductive,leftno,il,_) -> + List.flatten + (HExtlib.list_mapi + (fun (_,iname,_,cl) i -> + HExtlib.list_mapi + (fun (_,cname,_) j-> + u,cname, + NReference.reference_of_spec u (NReference.Con (i,j+1,leftno)) + ) cl @ + [u,iname, + NReference.reference_of_spec u + (NReference.Ind (inductive,i,leftno))] + ) il) + in + aliases := references @ !aliases +;; + let cache = NUri.UriHash.create 313;; let get_obj u = + try List.assq u !storage + with Not_found -> try NUri.UriHash.find cache u with Not_found -> (* in the final implementation should get it from disk *) - let ouri = NUri.ouri_of_nuri u in - let o,_ = CicEnvironment.get_obj CicUniv.oblivion_ugraph ouri in - let l = OCic2NCic.convert_obj ouri o in - List.iter (fun (u,_,_,_,_ as o) -> -(* prerr_endline ("+"^NUri.string_of_uri u); *) - NUri.UriHash.add cache u o) l; - HExtlib.list_last l + let ouri = NCic2OCic.ouri_of_nuri u in + try + let o,_ = CicEnvironment.get_obj CicUniv.oblivion_ugraph ouri in + let l = OCic2NCic.convert_obj ouri o in + List.iter (fun (u,_,_,_,_ as o) -> + (* prerr_endline ("+"^NUri.string_of_uri u); *) + NUri.UriHash.add cache u o) l; + HExtlib.list_last l + with CicEnvironment.Object_not_found u -> + raise (ObjectNotFound + (lazy (NUri.string_of_uri (OCic2NCic.nuri_of_ouri u)))) ;; + +let clear_cache () = NUri.UriHash.clear cache;;