X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicEnvironment.ml;h=cca0e5cdf55868a9e38c411710f0a51e3295afa4;hb=c87ca87169e38a22e7bf7a347238597500964285;hp=37cebe647cc567bfc4437ba8ce9aff87e632423e;hpb=a981dd18ae8ad9e9da79615fb80fe85dfe609f05;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml index 37cebe647..cca0e5cdf 100644 --- a/helm/software/components/ng_kernel/nCicEnvironment.ml +++ b/helm/software/components/ng_kernel/nCicEnvironment.ml @@ -1,13 +1,93 @@ let cache = NUri.UriHash.create 313;; +let oldg = ref CicUniv.empty_ugraph;; + +let load_graph uri = + let _,g = CicEnvironment.get_obj !oldg uri in + oldg := g +;; + +let get_graph _ = !oldg;; + let get_checked_obj u = - try NUri.UriHash.find cache u + try let b, o = NUri.UriHash.find cache u in + if not b then assert false else o with Not_found -> let ouri = NUri.ouri_of_nuri u in let o,_ = - CicEnvironment.get_cooked_obj ~trust:false CicUniv.oblivion_ugraph - ouri in - let no = OCic2NCic.convert_obj ouri o in - NUri.UriHash.add cache u no; - no + try + CicEnvironment.get_obj CicUniv.oblivion_ugraph ouri + with exn -> prerr_endline (UriManager.string_of_uri ouri); raise exn + in + (* FIX: add all objects to the environment and give back the last one *) + 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 (false,o)) l; + HExtlib.list_last l +;; + +let get_obj u = + try NUri.UriHash.find cache u + with Not_found -> + (* in th 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 (false,o)) l; + false, HExtlib.list_last l +;; + +let add_obj (u,_,_,_,_ as o) = + NUri.UriHash.replace cache u (true, o) ;; + +let get_checked_def = function + | NReference.Ref (_, uri, NReference.Def) -> + (match get_checked_obj uri with + | _,height,_,_, NCic.Constant (rlv,name,Some bo,ty,att) -> + rlv,name,bo,ty,att,height + | _,_,_,_, NCic.Constant (_,_,None,_,_) -> + prerr_endline "get_checked_def on an axiom"; assert false + | _ -> prerr_endline "get_checked_def on a non def 2"; assert false) + | _ -> prerr_endline "get_checked_def on a non def"; assert false +;; + +let get_checked_indtys = function + | NReference.Ref (_, uri, NReference.Ind n) -> + (match get_checked_obj uri with + | _,_,_,_, NCic.Inductive (inductive,leftno,tys,att) -> + inductive,leftno,tys,att,n + | _ -> prerr_endline "get_checked_indtys on a non ind 2"; assert false) + | _ -> prerr_endline "get_checked_indtys on a non ind"; assert false +;; + +let get_checked_fix_or_cofix b = function + | NReference.Ref (_, uri, (NReference.Fix (fixno,_)|NReference.CoFix fixno))-> + (match get_checked_obj uri with + | _,height,_,_, NCic.Fixpoint (is_fix,funcs,att) when is_fix = b -> + funcs, att, height + | _ ->prerr_endline "get_checked_(co)fix on a non (co)fix 2";assert false) + | r -> prerr_endline ("get_checked_(co)fix on " ^ NReference.string_of_reference r); assert false +;; +let get_checked_fixes r = get_checked_fix_or_cofix true r;; +let get_checked_cofixes r = get_checked_fix_or_cofix false r;; + +let get_indty_leftno = function + | NReference.Ref (_, uri, NReference.Ind _) + | NReference.Ref (_, uri, NReference.Con _) -> + (match get_checked_obj uri with + | _,_,_,_, NCic.Inductive (_,left,_,_) -> left + | _ ->prerr_endline "get_indty_leftno called on a non ind 2";assert false) + | _ -> prerr_endline "get_indty_leftno called on a non indty";assert false +;; + +let invalidate _ = + List.iter + (fun (k,v) -> + NUri.UriHash.replace cache k (false,v)) + (NUri.UriHash.fold (fun k v -> (@) [k,snd v]) cache []) +;; +