X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_paramodulation%2FnCicBlob.ml;h=4c3c1320558f39f424a0c510d21404608ae675cb;hb=86a273d0b145e058baf50b6e97fcb0dc0adc90e3;hp=87d081deae51cad79c4951bf7eb004c2660729e7;hpb=3c1a432c1612f8ed21f5b2220005599c4d9da1d5;p=helm.git diff --git a/helm/software/components/ng_paramodulation/nCicBlob.ml b/helm/software/components/ng_paramodulation/nCicBlob.ml index 87d081dea..4c3c13205 100644 --- a/helm/software/components/ng_paramodulation/nCicBlob.ml +++ b/helm/software/components/ng_paramodulation/nCicBlob.ml @@ -11,28 +11,98 @@ (* $Id: terms.mli 9822 2009-06-03 15:37:06Z tassi $ *) -module type NCicContext = +let eqPref = ref (fun _ -> assert false);; +let set_eqP t = eqPref := fun _ -> t;; + +let default_eqP() = + let uri = NUri.uri_of_string "cic:/matita/ng/Plogic/equality/peq.ind" in + let ref = NReference.reference_of_spec uri (NReference.Ind(true,0,2)) in + NCic.Const ref + +let set_default_eqP() = eqPref := default_eqP + +let set_reference_of_oxuri f = + let eqnew = function + _ -> + let r = f(UriManager.uri_of_string + "cic:/matita/logic/equality/eq.ind#xpointer(1/1)") + in + NCic.Const r + in + eqPref := eqnew +;; + + +module type NCicContext = sig val metasenv : NCic.metasenv val subst : NCic.substitution val context : NCic.context end -module NCicBlob(C : NCicContext) : Terms.Blob with type t = NCic.term = struct +module NCicBlob(C : NCicContext) : Terms.Blob +with type t = NCic.term and type input = NCic.term = struct type t = NCic.term - let eq x y = NCicReduction.alpha_eq C.metasenv C.subst C.context x y;; + let eq x y = x = y;; + (* NCicReduction.alpha_eq C.metasenv C.subst C.context x y;; *) let rec compare x y = match x,y with - | NCic.Rel i, NCic.Rel j -> i-j + | NCic.Rel i, NCic.Rel j -> j-i + | NCic.Meta (i,_), NCic.Meta (j,_) -> i-j | NCic.Const r1, NCic.Const r2 -> NReference.compare r1 r2 - | NCic.Appl l1, NCic.Appl l2 -> assert false (* TODO *) + | NCic.Appl l1, NCic.Appl l2 -> FoUtils.lexicograph compare l1 l2 + | NCic.Rel _, ( NCic.Meta _ | NCic.Const _ | NCic.Appl _ ) -> ~-1 + | ( NCic.Meta _ | NCic.Const _ | NCic.Appl _ ), NCic.Rel _ -> 1 + | NCic.Const _, ( NCic.Meta _ | NCic.Appl _ ) -> ~-1 + | ( NCic.Meta _ | NCic.Appl _ ), NCic.Const _ -> 1 + | NCic.Appl _, NCic.Meta _ -> ~-1 + | NCic.Meta _, NCic.Appl _ -> 1 | _ -> assert false ;; + + let compare x y = + (* if NCicReduction.alpha_eq C.metasenv C.subst C.context x y then 0 *) + if x = y then 0 + else compare x y + ;; let pp t = NCicPp.ppterm ~context:C.context ~metasenv:C.metasenv ~subst:C.subst t;; + type input = NCic.term + + let rec embed = function + | NCic.Meta (i,_) -> Terms.Var i, [i] + | NCic.Appl l -> + let rec aux acc l = function + |[] -> acc@l + |hd::tl -> if List.mem hd l then aux acc l tl else aux (hd::acc) l tl + in + let res,vars = List.fold_left + (fun (r,v) t -> let r1,v1 = embed t in (r1::r),aux [] v v1) ([],[]) l + in (Terms.Node (List.rev res)), vars + | t -> Terms.Leaf t, [] + ;; + + let embed t = fst (embed t) ;; + + let saturate t ty = + let sty, _, args = + NCicMetaSubst.saturate ~delta:max_int C.metasenv C.subst C.context + ty 0 + in + let proof = + if args = [] then Terms.Leaf t + else Terms.Node (Terms.Leaf t :: List.map embed args) + in + let sty = embed sty in + proof, sty + ;; + + let eqP = (!eqPref)() + ;; + end