X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=matitaB%2Fcomponents%2Fng_paramodulation%2FnCicBlob.ml;h=59d57a854806aafe016d8a0ab8c56bebd09b1889;hb=bbb6dd07ecb430bf06bb52c2506626106449a5af;hp=b9314a20317203d127413454acc13727d7c8616a;hpb=cacbe3c6493ddce76c4c13379ade271d8dd172e8;p=helm.git diff --git a/matitaB/components/ng_paramodulation/nCicBlob.ml b/matitaB/components/ng_paramodulation/nCicBlob.ml index b9314a203..59d57a854 100644 --- a/matitaB/components/ng_paramodulation/nCicBlob.ml +++ b/matitaB/components/ng_paramodulation/nCicBlob.ml @@ -11,15 +11,15 @@ (* $Id: terms.mli 9822 2009-06-03 15:37:06Z tassi $ *) -let eqPref = ref (fun _ -> assert false);; -let set_eqP t = eqPref := fun _ -> t;; - -let default_eqP() = +let default_eqP = let uri = NUri.uri_of_string "cic:/matita/basics/logic/eq.ind" in let ref = NReference.reference_of_spec uri (NReference.Ind(true,0,2)) in NCic.Const ref ;; +let eqPref = ref default_eqP;; +let set_eqP t = eqPref := t;; + let equivalence_relation = let uri = NUri.uri_of_string "cic:/matita/ng/properties/relations/eq_rel.con" in @@ -33,14 +33,20 @@ let setoid_eq = let set_default_eqP() = eqPref := default_eqP -module type NCicContext = - sig - val metasenv : NCic.metasenv - val subst : NCic.substitution - val context : NCic.context - end +let saturate status metasenv subst context t ty = + let sty, _, args = + (* CSC: NCicPp.status is the best I can put here *) + NCicMetaSubst.saturate status ~delta:0 metasenv subst context ty 0 + in + let proof = + if args = [] then t + else NCic.Appl (t :: args) + in + proof, sty +;; + -module NCicBlob(C : NCicContext) : Terms.Blob +module NCicBlob: Terms.Blob with type t = NCic.term and type input = NCic.term = struct type t = NCic.term @@ -78,19 +84,36 @@ with type t = NCic.term and type input = NCic.term = struct ;; - let compare x y = + let rec alpha_norm k = function + | NCic.Lambda (_,ty,t) -> + NCic.Lambda("_",alpha_norm k ty,alpha_norm k t) + | NCic.Prod (_,ty,t) -> + NCic.Prod("_",alpha_norm k ty,alpha_norm k t) + | NCic.LetIn (_,ty,t,b) -> + NCic.LetIn("_",alpha_norm k ty,alpha_norm k t,alpha_norm k b) + | NCic.Meta (_,(_,NCic.Irl _)) as t -> t + | NCic.Meta (n,(s,NCic.Ctx tl)) as t -> + let tl' = HExtlib.sharing_map (alpha_norm k) tl in + if tl == tl' then t else NCic.Meta (n,(s,NCic.Ctx tl')) + | t -> NCicUtils.map ~hbr:false (new NCicPp.status None) + (fun _ _ -> ()) () alpha_norm t + + (* let compare x y = (* CSC: NCicPp.status is the best I can put here *) - if NCicReduction.alpha_eq (new NCicPp.status) [] [] [] x y then 0 + (* WR: and I can't guess a user id, so I must put None *) + if NCicReduction.alpha_eq (new NCicPp.status None) [] [] [] x y then 0 (* if x = y then 0 *) else compare x y - ;; + ;; *) - let eqP = (!eqPref)() + let eqP = fun () -> !eqPref ;; let is_eq = function - | Terms.Node [ Terms.Leaf eqt ; ty; l; r ] when eq eqP eqt -> + | Terms.Node [ Terms.Leaf eqt ; ty; l; r ] when eq (eqP()) eqt -> Some (ty,l,r) + | Terms.Node [ Terms.Leaf eqt ; ty; l; r ] -> + None (* | Terms.Node [ Terms.Leaf eqt ; _; Terms.Node [Terms.Leaf eqt2 ; ty]; l; r] when eq equivalence_relation eqt && eq setoid_eq eqt2 -> @@ -99,8 +122,7 @@ with type t = NCic.term and type input = NCic.term = struct let pp t = (* CSC: NCicPp.status is the best I can put here *) - (new NCicPp.status)#ppterm ~context:C.context - ~metasenv:C.metasenv ~subst:C.subst t;; + (new NCicPp.status None)#ppterm ~context:[] ~metasenv:[] ~subst:[] t type input = NCic.term @@ -114,23 +136,9 @@ with type t = NCic.term and type input = NCic.term = struct 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, [] + | t -> Terms.Leaf (alpha_norm () t), [] ;; let embed t = fst (embed t) ;; - let saturate t ty = - let sty, _, args = - (* CSC: NCicPp.status is the best I can put here *) - NCicMetaSubst.saturate (new NCicPp.status) ~delta:0 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 - ;; - end