X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_tactics%2FnTacStatus.ml;h=eeca351c228f01462ce591e70569109d7c2642c4;hb=7cdfae2ec209750303818f2e39f31e4739286858;hp=86487e20d5cc575dc054ef92b4fad67482e865d1;hpb=174d3dbd5779c2ad602f905d7f4321dc68a53786;p=helm.git diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml index 86487e20d..eeca351c2 100644 --- a/helm/software/components/ng_tactics/nTacStatus.ml +++ b/helm/software/components/ng_tactics/nTacStatus.ml @@ -99,6 +99,12 @@ let term_of_cic_term s t c = s, t ;; +let ppterm status t = + let uri,height,metasenv,subst,obj = status.pstatus in + let _,context,t = t in + NCicPp.ppterm ~metasenv ~subst ~context t +;; + let disambiguate status t ty context = let status, expty = match ty with @@ -319,3 +325,46 @@ let analyse_indty status ty = ;; let mk_cic_term c t = None,c,t ;; + +(* CSC: next two functions to be moved elsewhere *) +let rec apply_subst subst ctx = + function + NCic.Meta (i,lc) -> + (try + let _,_,t,_ = NCicUtils.lookup_subst i subst in + let t = NCicSubstitution.subst_meta lc t in + apply_subst subst ctx t + with + Not_found -> + match lc with + _,NCic.Irl _ -> NCic.Meta (i,lc) + | n,NCic.Ctx l -> + NCic.Meta + (i,(0,NCic.Ctx + (List.map (fun t -> + apply_subst subst ctx (NCicSubstitution.lift n t)) l)))) + | t -> NCicUtils.map (fun item ctx -> item::ctx) ctx (apply_subst subst) t +;; + +let apply_subst_obj subst = + function + NCic.Constant (relev,name,bo,ty,attrs) -> + NCic.Constant + (relev,name,HExtlib.map_option (apply_subst subst []) bo, + apply_subst subst [] ty,attrs) + | NCic.Fixpoint (ind,fl,attrs) -> + let fl = + List.map + (function (relevance,name,recno,ty,bo) -> + relevance,name,recno,apply_subst subst [] ty,apply_subst subst [] bo + ) fl + in + NCic.Fixpoint (ind,fl,attrs) + | _ -> assert false (* not implemented yet *) +;; + +let apply_subst status ctx t = + let status, (name,_,t) = relocate status ctx t in + let _,_,_,subst,_ = status.pstatus in + status, (name, ctx, apply_subst subst ctx t) +;;