X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicPp.ml;h=cebdaf0b29908916a601c04756058aed1d1c8450;hb=b08fc6cc9775b74ab859541ce42f0b87dd7f42de;hp=73c3f572c0ff1dbade596812d08ae80c25f84ae6;hpb=1ef41da37d7b39da1521f53d3b22981556bfbe68;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml index 73c3f572c..cebdaf0b2 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,12 +131,13 @@ 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" - | C.Sort (C.Type []) -> F.fprintf f "IllFormedUniverse" + | C.Sort (C.Type []) -> F.fprintf f "Type0" | C.Sort (C.Type [false, u]) -> F.fprintf f "%s" (NUri.name_of_uri u) | C.Sort (C.Type [true, u]) -> F.fprintf f "S(%s)" (NUri.name_of_uri u) | C.Sort (C.Type l) -> @@ -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;; +