parameter sintax added to axiom statement

[helm.git] / helm / software / components / ng_kernel / nCicPp.ml

diff --git a/helm/software/components/ng_kernel/nCicPp.ml b/helm/software/components/ng_kernel/nCicPp.ml
index ddecb4dfb9ba75c299211307787ce68e27363de3..1a793b92fde5db51b370c46eac38a5343f188058 100644 (file)
--- a/helm/software/components/ng_kernel/nCicPp.ml
+++ b/helm/software/components/ng_kernel/nCicPp.ml
@@ -180,11 +180,14 @@ let ppterm ~formatter:f ~context ~subst ~metasenv:_ ?(inside_fix=false) t =
 ;;
 
 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 = 
@@ -192,29 +195,51 @@ 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 =
+ function
+    [] -> ""
+  | attrs ->
+   "(" ^
+    String.concat ","
+     (List.map
+       (function
+         | `IsTerm -> "term"
+         | `IsType -> "type"
+         | `IsSort -> "sort"
+         | `Name n -> "name=" ^ n
+         | `InScope -> "in_scope"
+         | `OutScope n -> "out_scope:" ^ string_of_int n
+       ) attrs) ^
+    ")"
 ;;
 
 let rec ppmetasenv ~formatter ~subst metasenv = function
   | [] -> ()
-  | (i,(name, ctx, ty)) :: tl ->
+  | (i,(attrs, ctx, ty)) :: tl ->
       F.fprintf formatter "@[<hov 2>";
-      let name = match name with Some n -> "("^n^")" | _ -> "" in
       ppcontext ~formatter ~sep:"; " ~subst ~metasenv ctx;
-      F.fprintf formatter "@;⊢@;?%d%s :@;" i name;
+      F.fprintf formatter "@;⊢@;?%d%s :@;" i (ppmetaattrs attrs);
       ppterm ~formatter ~metasenv ~subst ~context:ctx ty;
       F.fprintf formatter "@]@\n";
       ppmetasenv ~formatter ~subst metasenv tl
@@ -226,10 +251,9 @@ let ppmetasenv ~formatter ~subst metasenv =
 
 let rec ppsubst ~formatter ~subst ~metasenv = function
   | [] -> ()
-  | (i,(name, ctx, t, ty)) :: tl ->
-      let name = match name with Some n -> "("^n^")" | _ -> "" in
+  | (i,(attrs, ctx, t, ty)) :: tl ->
       ppcontext ~formatter ~sep:"; " ~subst ~metasenv ctx;
-      F.fprintf formatter " ⊢ ?%d%s := " i name;
+      F.fprintf formatter " ⊢ ?%d%s := " i (ppmetaattrs attrs);
       ppterm ~formatter ~metasenv ~subst ~context:ctx t;
       F.fprintf formatter " : ";
       ppterm ~formatter ~metasenv ~subst ~context:ctx ty;
@@ -237,8 +261,38 @@ let rec ppsubst ~formatter ~subst ~metasenv = function
       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) = 
@@ -249,7 +303,7 @@ 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
@@ -260,7 +314,8 @@ let ppobj ~formatter (u,_,metasenv, subst, o) =
         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
@@ -301,7 +356,9 @@ let ppcontext ?sep ~subst ~metasenv ctx =
 
 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;;