X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicPp.ml;h=991b26ffc2800c81b8217fb502b4537231989498;hb=703515866ff6b77ab0e8b186c6703ec634fc23df;hp=72e8abff5347e9d41c34bf933aa3016c0d3a3959;hpb=385fe4ef8b24dc17d2c6a214c9b025c5275f1d7e;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml index 72e8abff5..991b26ffc 100644 --- a/helm/software/components/ng_kernel/nCicPp.ml +++ b/helm/software/components/ng_kernel/nCicPp.ml @@ -14,23 +14,23 @@ module R = NReference let r2s pp_fix_name r = try match r with - | R.Ref (_,u,R.Ind i) -> - (match snd(NCicEnvironment.get_obj u) with + | R.Ref (_,u,R.Ind (_,i)) -> + (match NCicLibrary.get_obj u with | _,_,_,_, C.Inductive (_,_,itl,_) -> let _,name,_,_ = List.nth itl i in name | _ -> assert false) | R.Ref (_,u,R.Con (i,j)) -> - (match snd(NCicEnvironment.get_obj u) with + (match NCicLibrary.get_obj u with | _,_,_,_, C.Inductive (_,_,itl,_) -> let _,_,_,cl = List.nth itl i in let _,name,_ = List.nth cl (j-1) in name | _ -> assert false) | R.Ref (_,u,(R.Decl | R.Def )) -> - (match snd(NCicEnvironment.get_obj u) with + (match NCicLibrary.get_obj u with | _,_,_,_, C.Constant (_,name,_,_,_) -> name | _ -> assert false) | R.Ref (_,u,(R.Fix (i,_)|R.CoFix i)) -> - (match snd(NCicEnvironment.get_obj u) with + (match NCicLibrary.get_obj u with | _,_,_,_, C.Fixpoint (_,fl,_) -> if pp_fix_name then let _,name,_,_,_ = List.nth fl i in name @@ -52,12 +52,14 @@ let trivial_pp_term ~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 context)) + with Failure _ -> 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 "("; F.fprintf f "@["; - aux ~toplevel:true ctx s; + (match s with + | C.Prod ("_",_,_) -> aux ~toplevel:false ctx s + | _ -> aux ~toplevel:true ctx s); F.fprintf f "@;→ "; aux ~toplevel:true ("_"::ctx) t; F.fprintf f "@]"; @@ -132,7 +134,7 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t = let ppobj = function | (u,_,metasenv,subst,NCic.Fixpoint (b, fl, _)) -> "{"^NUri.string_of_uri u^"}\n"^ - "let rec "^ + (if b then "let rec " else "let corec ") ^ String.concat "\nand " (List.map (fun (_,name,n,ty,bo) -> name^ " on " ^ string_of_int n ^ " : " ^ @@ -158,3 +160,14 @@ let ppobj = function ppterm ~metasenv ~subst ~context:[] ty ^ " := \n"^ ppterm ~metasenv ~subst ~context:[] bo ^ "\n" ;; + +let rec ppcontext ~subst ~metasenv = function + | [] -> "" + | (name, NCic.Decl t) :: tl -> + ppcontext ~subst ~metasenv tl ^ + name ^ ": " ^ ppterm ~subst ~metasenv ~context:tl t ^ "\n" + | (name, NCic.Def (bo,ty)) :: tl-> + ppcontext ~subst ~metasenv tl ^ + name ^ ": " ^ ppterm ~subst ~metasenv ~context:tl ty ^ + " := " ^ ppterm ~subst ~metasenv ~context:tl bo ^ "\n" +;;