X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_paramodulation%2FnCicParamod.ml;h=16ae66e5da45f76259420625ebd2311247899987;hb=f9abd21eb0d26cf9b632af4df819225be4d091e3;hp=c680e8417346885453b2e70852d814065c6e0ed8;hpb=fa01419bafd483b5a043a93a2f812a98cf178e22;p=helm.git diff --git a/helm/software/components/ng_paramodulation/nCicParamod.ml b/helm/software/components/ng_paramodulation/nCicParamod.ml index c680e8417..16ae66e5d 100644 --- a/helm/software/components/ng_paramodulation/nCicParamod.ml +++ b/helm/software/components/ng_paramodulation/nCicParamod.ml @@ -25,16 +25,17 @@ module B(C : NCicBlob.NCicContext): Orderings.Blob module NCicParamod(C : NCicBlob.NCicContext) = Paramod.Paramod(B(C)) -let readback rdb metasenv subst context (bag,i,fo_subst,l) = +let readback ?(demod=false) rdb metasenv subst context (bag,i,fo_subst,l) = (* List.iter (fun x -> print_endline (Pp.pp_unit_clause ~margin:max_int (fst(Terms.M.find x bag)))) l; *) (* let stamp = Unix.gettimeofday () in *) - let proofterm,prooftype = NCicProof.mk_proof bag i fo_subst l in + let proofterm,prooftype = NCicProof.mk_proof ~demod bag i fo_subst l in (* debug (lazy (Printf.sprintf "Got proof term in %fs" (Unix.gettimeofday() -. stamp))); *) +(* let metasenv, proofterm = let rec aux k metasenv = function | NCic.Meta _ as t -> metasenv, t @@ -47,7 +48,7 @@ let readback rdb metasenv subst context (bag,i,fo_subst,l) = (fun _ k -> k+1) k aux metasenv t in aux 0 metasenv proofterm - in + in *) debug (lazy (NCicPp.ppterm ~metasenv ~subst ~context proofterm)); (* let stamp = Unix.gettimeofday () in @@ -77,7 +78,7 @@ let nparamod rdb metasenv subst context t table = HExtlib.list_mapi_acc (fun x _ a -> P.mk_goal a x) (bag,maxvar) [t] in let (bag,maxvar), passives = - HExtlib.list_mapi_acc (fun x _ a -> prerr_endline "there"; P.mk_passive a x) (bag,maxvar) table + HExtlib.list_mapi_acc (fun x _ a -> P.mk_passive a x) (bag,maxvar) table in match P.paramod ~useage:true ~max_steps:max_int ~timeout:(Unix.gettimeofday () +. 300.0) @@ -95,6 +96,7 @@ module EmptyC = let context = [] end +module CB = NCicBlob.NCicBlob(EmptyC) module P = NCicParamod(EmptyC) type state = P.state @@ -102,21 +104,47 @@ let empty_state = P.empty_state let forward_infer_step s t ty = let bag = P.bag_of_state s in - prerr_endline "here"; let bag,clause = P.mk_passive bag (t,ty) in if Terms.is_eq_clause clause then P.forward_infer_step (P.replace_bag s bag) clause 0 - else s + else (debug (lazy "not eq"); s) ;; let index_obj s uri = let obj = NCicEnvironment.get_checked_obj uri in + debug (lazy ("indexing : " ^ (NUri.string_of_uri uri))); + debug (lazy ("no : " ^ (string_of_int (fst (Obj.magic uri))))); match obj with - | (_,_,[],[],NCic.Constant(_,_,Some(t),ty,_)) -> - forward_infer_step s t ty + | (_,_,[],[],NCic.Constant(_,_,None,ty,_)) -> + let nref = NReference.reference_of_spec uri NReference.Decl in + forward_infer_step s (NCic.Const nref) ty + | (_,d,[],[],NCic.Constant(_,_,Some(_),ty,_)) -> + let nref = NReference.reference_of_spec uri (NReference.Def d) in + forward_infer_step s (NCic.Const nref) ty | _ -> s ;; +let demod rdb metasenv subst context s goal = + (* let stamp = Unix.gettimeofday () in *) + match P.demod s goal with + | P.Error _ | P.GaveUp | P.Timeout _ -> [] + | P.Unsatisfiable solutions -> + (* print (lazy (Printf.sprintf "Got solutions in %fs" + (Unix.gettimeofday() -. stamp))); *) + List.map (readback ~demod:true rdb metasenv subst context) solutions +;; + +let paramod rdb metasenv subst context s goal = + (* let stamp = Unix.gettimeofday () in *) + match P.nparamod ~useage:true ~max_steps:max_int + ~timeout:(Unix.gettimeofday () +. 300.0) s goal with + | P.Error _ | P.GaveUp | P.Timeout _ -> [] + | P.Unsatisfiable solutions -> + (* print (lazy (Printf.sprintf "Got solutions in %fs" + (Unix.gettimeofday() -. stamp))); *) + List.map (readback rdb metasenv subst context) solutions +;; + let fast_eq_check rdb metasenv subst context s goal = (* let stamp = Unix.gettimeofday () in *) match P.fast_eq_check s goal with @@ -127,3 +155,24 @@ let fast_eq_check rdb metasenv subst context s goal = List.map (readback rdb metasenv subst context) solutions ;; +let is_equation metasenv subst context ty = + let hty, _, _ = + NCicMetaSubst.saturate ~delta:0 metasenv subst context + ty 0 + in match hty with + | NCic.Appl (eq ::tl) when eq = CB.eqP -> true + | _ -> false +;; + + +(* +let demodulate rdb metasenv subst context s goal = + (* let stamp = Unix.gettimeofday () in *) + match P.fast_eq_check s goal with + | P.Error _ | P.GaveUp | P.Timeout _ -> [] + | P.Unsatisfiable solutions -> + (* print (lazy (Printf.sprintf "Got solutions in %fs" + (Unix.gettimeofday() -. stamp))); *) + List.map (readback rdb metasenv subst context) solutions +;; +*)