From 2b80895770829206d04600abbc029b4ddfad33f9 Mon Sep 17 00:00:00 2001 From: Andrea Asperti Date: Wed, 2 Dec 2009 10:06:47 +0000 Subject: [PATCH] The new paramodulation functions instantiated over nCic. --- .../ng_paramodulation/nCicParamod.ml | 102 ++++++++++++------ .../ng_paramodulation/nCicParamod.mli | 14 ++- 2 files changed, 82 insertions(+), 34 deletions(-) diff --git a/helm/software/components/ng_paramodulation/nCicParamod.ml b/helm/software/components/ng_paramodulation/nCicParamod.ml index 6096d88da..a96d3cc0a 100644 --- a/helm/software/components/ng_paramodulation/nCicParamod.ml +++ b/helm/software/components/ng_paramodulation/nCicParamod.ml @@ -11,6 +11,10 @@ (* $Id: orderings.ml 9869 2009-06-11 22:52:38Z denes $ *) +NCicBlob.set_default_eqP() +;; +NCicProof.set_default_sig() +;; module B(C : NCicBlob.NCicContext): Orderings.Blob with type t = NCic.term and type input = NCic.term @@ -18,6 +22,38 @@ module B(C : NCicBlob.NCicContext): Orderings.Blob module NCicParamod(C : NCicBlob.NCicContext) = Paramod.Paramod(B(C)) +let readback rdb metasenv subst context (bag,i,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 = NCicProof.mk_proof bag i l in + prerr_endline (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 + | NCic.Implicit _ -> + let metasenv, i, _, _ = + NCicMetaSubst.mk_meta metasenv context `IsTerm + in + metasenv, NCic.Meta (i,(k,NCic.Irl (List.length context))) + | t -> NCicUntrusted.map_term_fold_a + (fun _ k -> k+1) k aux metasenv t + in + aux 0 metasenv proofterm + in + prerr_endline "so far 1"; + prerr_endline (NCicPp.ppterm ~metasenv ~subst ~context proofterm); + let metasenv, subst, proofterm, _prooftype = + NCicRefiner.typeof + (rdb#set_coerc_db NCicCoercion.empty_db) + metasenv subst context proofterm None + in + proofterm, metasenv, subst + let nparamod rdb metasenv subst context t table = let module C = struct @@ -41,38 +77,42 @@ let nparamod rdb metasenv subst context t table = ~g_passives:goals ~passives (bag,maxvar) with | P.Error _ | P.GaveUp | P.Timeout _ -> [] - | P.Unsatisfiable solutions -> - List.map - (fun (bag,i,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 = NCicProof.mk_proof bag i l in - prerr_endline (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 - | NCic.Implicit _ -> - let metasenv, i, _, _ = - NCicMetaSubst.mk_meta metasenv context `IsTerm - in - metasenv, NCic.Meta (i,(k,NCic.Irl (List.length context))) - | t -> NCicUntrusted.map_term_fold_a - (fun _ k -> k+1) k aux metasenv t - in - aux 0 metasenv proofterm - in - let metasenv, subst, proofterm, _prooftype = - NCicRefiner.typeof - (rdb#set_coerc_db NCicCoercion.empty_db) - metasenv subst context proofterm None - in - proofterm, metasenv, subst) - solutions + | P.Unsatisfiable solutions -> + List.map (readback rdb metasenv subst context) solutions ;; - +module EmptyC = + struct + let metasenv = [] + let subst = [] + let context = [] + end + +module P = NCicParamod(EmptyC) +type state = P.state +let empty_state = P.empty_state + +let forward_infer_step s t ty = + let bag = P.bag_of_state s in + 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 (prerr_endline "not and equality"; s) +;; + +let index_obj s uri = + let obj = NCicEnvironment.get_checked_obj uri in + match obj with + | (_,_,[],[],NCic.Constant(_,_,Some(t),ty,_)) -> + forward_infer_step s t ty + | _ -> s +;; + +let fast_eq_check rdb metasenv subst context s goal = + match P.fast_eq_check s goal with + | P.Error _ | P.GaveUp | P.Timeout _ -> [] + | P.Unsatisfiable solutions -> + List.map (readback rdb metasenv subst context) solutions +;; diff --git a/helm/software/components/ng_paramodulation/nCicParamod.mli b/helm/software/components/ng_paramodulation/nCicParamod.mli index 067235158..0572f8c64 100644 --- a/helm/software/components/ng_paramodulation/nCicParamod.mli +++ b/helm/software/components/ng_paramodulation/nCicParamod.mli @@ -11,11 +11,19 @@ (* $Id: orderings.ml 9869 2009-06-11 22:52:38Z denes $ *) -module NCicParamod(C : NCicBlob.NCicContext) : Paramod.Paramod -with type t = NCic.term and type input = NCic.term - val nparamod : #NRstatus.status -> NCic.metasenv -> NCic.substitution -> NCic.context -> (NCic.term * NCic.term) -> (NCic.term * NCic.term) list -> (NCic.term * NCic.metasenv * NCic.substitution) list + +type state +val empty_state: state +val forward_infer_step: state -> NCic.term -> NCic.term -> state +val index_obj: state -> NUri.uri -> state +val fast_eq_check : + #NRstatus.status -> + NCic.metasenv -> NCic.substitution -> NCic.context -> + state -> + (NCic.term * NCic.term) -> + (NCic.term * NCic.metasenv * NCic.substitution) list -- 2.39.2