implemented inductive and less parentheses

[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 5a96545fe3f0d2442b35a3f7a86ebf37933d1bb2..8bcbf6ad9755d0a5fc43a7a5cc686f09e0c8ffbe 100644 (file)
--- a/helm/software/components/ng_kernel/nCicPp.ml
+++ b/helm/software/components/ng_kernel/nCicPp.ml
@@ -49,15 +49,17 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t =
   let module F = Format in
   let rec aux ?(toplevel=false) ctx = function
    | C.Rel m ->
-       (try F.fprintf f "%s" (List.nth ctx (m-1))
-       with Failure _ -> F.fprintf f " -%d" (m - List.length context))
+         (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))
    | 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 "@[<hov 1>";
        aux ~toplevel:true ctx s; 
        F.fprintf f "@;→ ";
-       aux ~toplevel ("_"::ctx) t;
+       aux ~toplevel:true ("_"::ctx) t;
        F.fprintf f "@]";
        if not toplevel then F.fprintf f ")";
    | C.Prod (name,s,t) -> 
@@ -66,7 +68,7 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t =
        F.fprintf f "@[<hov 2>∀%s:@;" name;
        aux ~toplevel:true ctx s; 
        F.fprintf f "@].@;";
-       aux ~toplevel (name::ctx) t;
+       aux ~toplevel:true (name::ctx) t;
        F.fprintf f "@]";
        if not toplevel then F.fprintf f ")";
    | C.Lambda (name,s,t) -> 
@@ -75,7 +77,7 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t =
        F.fprintf f "λ%s:" name;
        aux ~toplevel:true ctx s; 
        F.fprintf f ".@;";
-       aux ~toplevel (name::ctx) t;
+       aux ~toplevel:true (name::ctx) t;
        F.fprintf f "@]";
        if not toplevel then F.fprintf f ")";
    | C.LetIn (name,ty,t,b) -> 
@@ -86,7 +88,7 @@ let trivial_pp_term ~context ~subst ~metasenv ?(inside_fix=false) t =
        F.fprintf f "@;≝ ";
        aux ~toplevel:true ctx t;
        F.fprintf f "@;in@;";
-       (aux ~toplevel (name::ctx) b);
+       (aux ~toplevel:true (name::ctx) b);
        F.fprintf f "@]";
        if not toplevel then F.fprintf f ")";
    | C.Match (r,oty,t,pl) ->
@@ -131,14 +133,21 @@ let ppobj = function
   | (u,_,metasenv,subst,NCic.Fixpoint (b, fl, _)) -> 
       "{"^NUri.string_of_uri u^"}\n"^
       "let rec "^
-       String.concat "\nand " (fst
-        (List.fold_right (fun (_,name,n,ty,bo) (l,i) ->
-          ((name^
-          " on " ^ string_of_int n ^ " : " ^ 
+       String.concat "\nand " 
+        (List.map (fun (_,name,n,ty,bo) ->
+          name^ " on " ^ string_of_int n ^ " : " ^ 
           ppterm ~metasenv ~subst ~context:[] ty ^ " :=\n"^
-          ppterm ~metasenv ~subst ~context:[] ~inside_fix:true bo) :: l),i-1) fl 
-           ([],List.length fl)))
-  | (u,_,_,_,NCic.Inductive (b, _,tyl, _)) -> "inductive"
+          ppterm ~metasenv ~subst ~context:[] ~inside_fix:true bo) fl)
+  | (u,_,metasenv,subst,NCic.Inductive (b, leftno,tyl, _)) -> 
+      "{"^NUri.string_of_uri u^"}\n"^
+      "inductive ("^string_of_int leftno^") "^
+      String.concat "\nand "
+        (List.map (fun (_,name,ty,cl) ->
+          name^": "^ppterm ~metasenv ~subst ~context:[] ty^ " :=\n"^
+          String.concat "\n"
+          (List.map (fun (_,name,ty) ->
+           "  | "^name^": "^ppterm ~metasenv ~subst ~context:[] ty)
+           cl)) tyl) ^ "."
   | (u,_,metasenv,subst,NCic.Constant (_,name,None,ty, _)) -> 
         "axiom " ^ name ^ " : " ^ 
           ppterm ~metasenv ~subst ~context:[] ty ^ "\n"