From: Enrico Tassi Date: Mon, 13 Oct 2008 15:51:11 +0000 (+0000) Subject: ppmetasenv & subst added X-Git-Tag: make_still_working~4694 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;ds=sidebyside;h=efea8f34e71084fcc6e7791e4927f2f7f8d3f1af;hp=a981b42002f822aa49a41b3889a76b9438b093bb;p=helm.git ppmetasenv & subst added --- diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml index 73c3f572c..cde028be4 100644 --- a/helm/software/components/ng_kernel/nCicPp.ml +++ b/helm/software/components/ng_kernel/nCicPp.ml @@ -52,7 +52,8 @@ let ppterm ~context ~subst ~metasenv:_ ?(inside_fix=false) t = (try let name = List.nth ctx (m-1) in F.fprintf f "%s" (if name = "_" then "__"^string_of_int m else name) - with Failure _ -> F.fprintf f " -%d" (m - List.length ctx)) + with Failure "nth" | Invalid_argument "List.nth" -> + F.fprintf f " -%d" (m - List.length ctx)) | C.Const r -> F.fprintf f "%s" (r2s inside_fix r) | C.Prod ("_",s,t) -> if not toplevel then F.fprintf f "("; @@ -130,8 +131,9 @@ let ppterm ~context ~subst ~metasenv:_ ?(inside_fix=false) t = F.fprintf f "?%d(%d,[" n shift; if List.length l > 0 then begin - aux ctx (List.hd l); - List.iter (fun x -> F.fprintf f ",";aux ctx x) (List.tl l); + aux ctx (NCicSubstitution.lift shift (List.hd l)); + List.iter (fun x -> F.fprintf f ",";aux ctx x) + (List.map (NCicSubstitution.lift shift) (List.tl l)); end; F.fprintf f "])" | C.Sort C.Prop -> F.fprintf f "Prop" @@ -180,13 +182,42 @@ let ppobj = function ppterm ~metasenv ~subst ~context:[] bo ^ "\n" ;; -let rec ppcontext ~subst ~metasenv = function +let rec ppcontext ?(sep="\n") ~subst ~metasenv = function | [] -> "" | (name, NCic.Decl t) :: tl -> - ppcontext ~subst ~metasenv tl ^ - name ^ ": " ^ ppterm ~subst ~metasenv ~context:tl t ^ "\n" + ppcontext ~sep ~subst ~metasenv tl ^ + name ^ ": " ^ ppterm ~subst ~metasenv ~context:tl t ^ sep | (name, NCic.Def (bo,ty)) :: tl-> - ppcontext ~subst ~metasenv tl ^ + ppcontext ~sep ~subst ~metasenv tl ^ name ^ ": " ^ ppterm ~subst ~metasenv ~context:tl ty ^ - " := " ^ ppterm ~subst ~metasenv ~context:tl bo ^ "\n" + " := " ^ ppterm ~subst ~metasenv ~context:tl bo ^ sep ;; + +let rec ppmetasenv ~subst metasenv = function + | [] -> "" + | (i,(name, ctx, ty)) :: tl -> + let name = match name with Some n -> "("^n^")" | _ -> "" in + ppcontext ~sep:"; " ~subst ~metasenv ctx ^ + " ⊢ ?"^string_of_int i^name^" : " ^ + ppterm ~metasenv ~subst ~context:ctx ty ^ "\n" ^ + ppmetasenv ~subst metasenv tl +;; + +let ppmetasenv ~subst metasenv = ppmetasenv ~subst metasenv metasenv;; + +let rec ppsubst ~subst ~metasenv = function + | [] -> "" + | (i,(name, ctx, t, ty)) :: tl -> + + let name = match name with Some n -> "("^n^")" | _ -> "" in + ppcontext ~sep:"; " ~subst ~metasenv ctx ^ + " ⊢ ?"^string_of_int i^name^" := " ^ + ppterm ~metasenv ~subst ~context:ctx t ^ " : " ^ + ppterm ~metasenv ~subst ~context:ctx ty ^ "\n" ^ + ppsubst ~subst ~metasenv tl +;; + +let ppsubst ~metasenv subst = ppsubst ~metasenv ~subst subst;; + +let _ = NCicSubstitution.set_ppterm ppterm;; + diff --git a/helm/software/components/ng_kernel/nCicPp.mli b/helm/software/components/ng_kernel/nCicPp.mli index 1654cdfb2..507f38d16 100644 --- a/helm/software/components/ng_kernel/nCicPp.mli +++ b/helm/software/components/ng_kernel/nCicPp.mli @@ -19,8 +19,14 @@ val ppterm: NCic.term -> string val ppcontext: + ?sep:string -> subst:NCic.substitution -> metasenv:NCic.metasenv -> NCic.context -> string +val ppmetasenv: + subst:NCic.substitution -> NCic.metasenv -> string + +val ppsubst: metasenv:NCic.metasenv -> NCic.substitution -> string + val ppobj: NCic.obj -> string