X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicPp.ml;h=8ae842868301e4172fc2d22e1936fa1ed8f494bf;hb=17a2d79ff87d6b1942772b516e4d633347419c2e;hp=72088e48b1c4bd9b1544ce228c0590ded9056464;hpb=d33b08df0d8929dff96f4c7499cd819103d2bb5c;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml index 72088e48b..8ae842868 100644 --- a/helm/software/components/ng_kernel/nCicPp.ml +++ b/helm/software/components/ng_kernel/nCicPp.ml @@ -1,3 +1,16 @@ +(* + ||M|| This file is part of HELM, an Hypertextual, Electronic + ||A|| Library of Mathematics, developed at the Computer Science + ||T|| Department, University of Bologna, Italy. + ||I|| + ||T|| HELM is free software; you can redistribute it and/or + ||A|| modify it under the terms of the GNU General Public License + \ / version 2 or (at your option) any later version. + \ / This software is distributed as is, NO WARRANTY. + V_______________________________________________________________ *) + +(* $Id$ *) + let ppterm = ref (fun ~context ~subst ~metasenv ?inside_fix t -> "Please, set a pp callback") ;; @@ -14,31 +27,28 @@ 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 + | R.Ref (u,R.Con (i,j)) -> + (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 + | R.Ref (u,(R.Decl | R.Def _)) -> + (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 + | R.Ref (u,(R.Fix (i,_,_)|R.CoFix i)) -> + (match NCicLibrary.get_obj u with | _,_,_,_, C.Fixpoint (_,fl,_) -> if pp_fix_name then let _,name,_,_,_ = List.nth fl i in name else - let name = NUri.string_of_uri u in - let name = Filename.basename name in - let name = Filename.chop_extension name in - name ^"("^ string_of_int i ^ ")" + NUri.name_of_uri u ^"("^ string_of_int i ^ ")" | _ -> assert false) with exn -> R.string_of_reference r ;; @@ -52,7 +62,7 @@ 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 "("; @@ -124,7 +134,15 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t = | C.Meta (n,_) -> F.fprintf f "?%d" n | C.Sort C.Prop -> F.fprintf f "Prop" | C.Sort C.CProp -> F.fprintf f "CProp" - | C.Sort (C.Type n) -> F.fprintf f "Type%d" n + | C.Sort (C.Type []) -> F.fprintf f "IllFormedUniverse" + | 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) -> + F.fprintf f "Max("; + aux ctx (C.Sort (C.Type [List.hd l])); + List.iter (fun x -> F.fprintf f ",";aux ctx (C.Sort (C.Type [x]))) + (List.tl l); + F.fprintf f ")" in aux ~toplevel:true (List.map fst context) t; F.fprintf f "@?"; @@ -134,7 +152,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 ^ " : " ^