X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicPp.ml;h=12227b4b190126414e97210547faf4625781db42;hb=8b1a49bbee9eea86eb74c040defe701370ca5893;hp=27b46431ed49b1eedf2e3be8f52386e0ecc3fc92;hpb=be88425efab1997c964137854e2f76aac6ebf877;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml index 27b46431e..12227b4b1 100644 --- a/helm/software/components/ng_kernel/nCicPp.ml +++ b/helm/software/components/ng_kernel/nCicPp.ml @@ -18,37 +18,39 @@ module F = Format let head_beta_reduce = ref (fun ~upto:_ _ -> assert false);; let set_head_beta_reduce = (:=) head_beta_reduce;; +let get_obj = ref (fun _ -> assert false);; +let set_get_obj f = get_obj := f;; + let r2s pp_fix_name r = try match r with | R.Ref (u,R.Ind (_,i,_)) -> - (match NCicLibrary.get_obj u with + (match !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 NCicLibrary.get_obj u with + (match !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 NCicLibrary.get_obj u with + (match !get_obj u with | _,_,_,_, C.Constant (_,name,_,_,_) -> name | _ -> assert false) | R.Ref (u,(R.Fix (i,_,_)|R.CoFix i)) -> - (match NCicLibrary.get_obj u with + (match !get_obj u with | _,_,_,_, C.Fixpoint (_,fl,_) -> if pp_fix_name then let _,name,_,_,_ = List.nth fl i in name else - NUri.name_of_uri u ^"("^ string_of_int i ^ ")" + NUri.name_of_uri u (*^"("^ string_of_int i ^ ")"*) | _ -> assert false) with - | NCicLibrary.ObjectNotFound _ + | NCicEnvironment.ObjectNotFound _ | Failure "nth" | Invalid_argument "List.nth" -> R.string_of_reference r - ;; let string_of_implicit_annotation = function @@ -57,6 +59,7 @@ let string_of_implicit_annotation = function | `Hole -> "□" | `Term -> "Term" | `Typeof x -> "Ty("^string_of_int x^")" + | `Vector -> "…" ;; let ppterm ~formatter:f ~context ~subst ~metasenv:_ ?(inside_fix=false) t = @@ -131,8 +134,14 @@ let ppterm ~formatter:f ~context ~subst ~metasenv:_ ?(inside_fix=false) t = 2 (List.tl pl)); end; F.fprintf f "]@] @]"; - | C.Appl [] | C.Appl [_] | C.Appl (C.Appl _::_) -> - F.fprintf f "BAD APPLICATION" + | C.Appl [] -> + F.fprintf f "BAD APPLICATION: empty list" + | C.Appl [x] -> + F.fprintf f "BAD APPLICATION: just the head: "; + aux ctx x + | C.Appl (C.Appl _ as x::_) -> + F.fprintf f "BAD APPLICATION: appl of appl with head: "; + aux ctx x | C.Appl (C.Meta (n,lc) :: args) when List.mem_assoc n subst -> let _,_,t,_ = List.assoc n subst in let hd = NCicSubstitution.subst_meta lc t in @@ -164,16 +173,7 @@ let ppterm ~formatter:f ~context ~subst ~metasenv:_ ?(inside_fix=false) t = (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 "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) -> - 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 ")" + | C.Sort s -> NCicEnvironment.ppsort f s in aux ~toplevel:true (List.map fst context) t ;;