;;
let on_buffer f t =
+ try
let buff = Buffer.create 100 in
let formatter = F.formatter_of_buffer buff in
f ~formatter:formatter t;
F.fprintf formatter "@?";
Buffer.contents buff
+ with Failure m ->
+ "[[Unprintable: " ^ m ^ "]]"
;;
let ppterm ~formatter ~context ~subst ~metasenv ?(margin=80) ?inside_fix t =
ppterm ~formatter ~context ~subst ~metasenv ?inside_fix t
;;
-let rec ppcontext ~formatter ?(sep="\n") ~subst ~metasenv = function
+let rec ppcontext ~formatter ?(sep="; ") ~subst ~metasenv = function
| [] -> ()
| (name, NCic.Decl t) :: tl ->
ppcontext ~formatter ~sep ~subst ~metasenv tl;
F.fprintf formatter "%s: " name;
ppterm ~formatter ~subst ~metasenv ~context:tl t;
- F.fprintf formatter "%s" sep
+ F.fprintf formatter "%s@;" sep
| (name, NCic.Def (bo,ty)) :: tl->
ppcontext ~formatter ~sep ~subst ~metasenv tl;
F.fprintf formatter "%s: " name;
ppterm ~formatter ~subst ~metasenv ~context:tl ty;
F.fprintf formatter " := ";
ppterm ~formatter ~subst ~metasenv ~context:tl bo;
- F.fprintf formatter "%s" sep
+ F.fprintf formatter "%s@;" sep
+;;
+let ppcontext ~formatter ?sep ~subst ~metasenv c =
+ F.fprintf formatter "@[<hov>";
+ ppcontext ~formatter ?sep ~subst ~metasenv c;
+ F.fprintf formatter "@]";
;;
let ppmetaattrs =
String.concat ","
(List.map
(function
- `IsSort -> "sort"
+ | `IsTerm -> "term"
+ | `IsType -> "type"
+ | `IsSort -> "sort"
| `Name n -> "name=" ^ n
| `InScope -> "in_scope"
| `OutScope n -> "out_scope:" ^ string_of_int n
ppsubst ~formatter ~subst ~metasenv tl
;;
-let ppsubst ~formatter ~metasenv subst =
- ppsubst ~formatter ~metasenv ~subst subst
+let ppsubst ~formatter ~metasenv ?(use_subst=true) subst =
+ let ssubst = if use_subst then subst else [] in
+ ppsubst ~formatter ~metasenv ~subst:ssubst subst
+;;
+
+let string_of_generated = function
+ | `Generated -> "Generated"
+ | `Provided -> "Provided"
+;;
+
+let string_of_flavour = function
+ | `Definition -> "Definition"
+ | `Fact -> "Fact"
+ | `Lemma -> "Lemma"
+ | `Theorem -> "Theorem"
+ | `Corollary -> "Corollary"
+ | `Example -> "Example"
+;;
+
+let string_of_pragma = function
+ | `Coercion _arity -> "Coercion _"
+ | `Elim _sort -> "Elim _"
+ | `Projection -> "Projection"
+ | `InversionPrinciple -> "InversionPrinciple"
+ | `Variant -> "Variant"
+ | `Local -> "Local"
+ | `Regular -> "Regular"
+;;
+
+let string_of_fattrs (g,f,p) =
+ String.concat ","
+ [ string_of_generated g; string_of_flavour f; string_of_pragma p ]
;;
let ppobj ~formatter (u,_,metasenv, subst, o) =
(*ppsubst subst ~formatter ~metasenv;*) F.fprintf formatter "...";
F.fprintf formatter "\n";
match o with
- | NCic.Fixpoint (b, fl, _) ->
+ | NCic.Fixpoint (b, fl, attrs) ->
F.fprintf formatter "{%s}@\n@[<hov 0>" (NUri.string_of_uri u);
F.fprintf formatter "@[<hov 2>%s"(if b then "let rec " else "let corec ");
HExtlib.list_iter_sep
F.fprintf formatter "@]@;@[<hov 2>:=@;";
ppterm ~formatter ~metasenv ~subst ~context:[] ~inside_fix:true bo;
F.fprintf formatter "@]") fl;
- F.fprintf formatter "@]"
+ F.fprintf formatter "@; %s" (string_of_fattrs attrs);
+ F.fprintf formatter "@]"
| NCic.Inductive (b, leftno,tyl, _) ->
F.fprintf formatter "{%s} with %d fixed params@\n@[<hov 0>@[<hov 2>%s"
(NUri.string_of_uri u) leftno
let ppmetasenv ~subst metasenv = on_buffer (ppmetasenv ~subst) metasenv;;
-let ppsubst ~metasenv subst = on_buffer (ppsubst ~metasenv) subst;;
+let ppsubst ~metasenv ?use_subst subst =
+ on_buffer (ppsubst ~metasenv ?use_subst) subst
+;;
let ppobj obj = on_buffer ppobj obj;;