content2pres for the new cic fixed

[helm.git] / helm / software / components / content_pres / content2pres.ml

diff --git a/helm/software/components/content_pres/content2pres.ml b/helm/software/components/content_pres/content2pres.ml
index f7b7067cc0a90649db11182b5c83bb6c79fec02f..6dee8f04066b2a1023cb006fad016f480b0a7719 100644 (file)
--- a/helm/software/components/content_pres/content2pres.ml
+++ b/helm/software/components/content_pres/content2pres.ml
@@ -815,7 +815,9 @@ let conjecture2pres term2pres (id, n, context, ty) =
   (B.b_hv [Some "helm", "xref", id]
      ((B.b_toggle [
         B.b_h [] [B.b_text [] "{...}"; B.b_space];
-        B.b_hv [] (List.map
+        B.b_hv [] (HExtlib.list_concat ~sep:[B.b_text [] ";"; B.b_space] 
+         (List.map (fun x -> [x])
+         (List.map
           (function
              | None ->
                 B.b_h []
@@ -833,7 +835,7 @@ let conjecture2pres term2pres (id, n, context, ty) =
                            (match dec_name with
                                 None -> "_"
                               | Some n -> n));
-                       B.b_text [] ":";
+                       B.b_text [] ":"; B.b_space; 
                        term2pres ty ]
              | Some (`Definition d) ->
                  let
@@ -846,6 +848,7 @@ let conjecture2pres term2pres (id, n, context, ty) =
                                          None -> "_"
                                        | Some n -> n)) ;
                        B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
+                       B.b_space;
                        term2pres bo]
              | Some (`Proof p) ->
                  let proof_name = p.Content.proof_name in
@@ -855,12 +858,16 @@ let conjecture2pres term2pres (id, n, context, ty) =
                                          None -> "_"
                                        | Some n -> n)) ;
                        B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
+                       B.b_space;
                        proof2pres true term2pres p])
-          (List.rev context)) ] ::
+          (List.rev context)))) ] ::
          [ B.b_h []
-           [ B.b_text [] (Utf8Macro.unicode_of_tex "\\vdash");
+           [ B.b_space; 
+             B.b_text [] (Utf8Macro.unicode_of_tex "\\vdash");
+             B.b_space;
              B.b_object (p_mi [] (string_of_int n)) ;
              B.b_text [] ":" ;
+             B.b_space;
              term2pres ty ]])))
 
 let metasenv2pres term2pres = function
@@ -922,7 +929,7 @@ let joint_def2pres term2pres def =
   | `Inductive ind -> inductive2pres term2pres ind
   | _ -> assert false (* ZACK or raise ToDo? *)
 
-let content2pres 
+let content2pres0
   ?skip_initial_lambdas ?(skip_thm_and_qed=false) term2pres 
   (id,params,metasenv,obj) 
 =
@@ -956,7 +963,7 @@ let content2pres
       let name = get_name decl.Content.dec_name in
       B.b_v
         [Some "helm","xref","id"]
-        ([B.b_h [] (B.b_kw ("Axiom " ^ name) :: params2pres params);
+        ([B.b_h [] (B.b_kw ("axiom " ^ name) :: params2pres params);
           B.b_kw "Type:";
           B.indent (term2pres decl.Content.dec_type)] @
           metasenv2pres term2pres metasenv)
@@ -969,11 +976,68 @@ let content2pres
 let content2pres 
   ?skip_initial_lambdas ?skip_thm_and_qed ~ids_to_inner_sorts 
 =
-  content2pres ?skip_initial_lambdas ?skip_thm_and_qed
+  content2pres0 ?skip_initial_lambdas ?skip_thm_and_qed
     (fun ?(prec=90) annterm ->
       let ast, ids_to_uris =
        TermAcicContent.ast_of_acic ~output_type:`Term ids_to_inner_sorts annterm
       in
        CicNotationPres.box_of_mpres
-        (CicNotationPres.render ids_to_uris ~prec
+        (CicNotationPres.render
+          ~lookup_uri:(CicNotationPres.lookup_uri ids_to_uris) ~prec
           (TermContentPres.pp_ast ast)))
+
+let ncontent2pres0
+  ?skip_initial_lambdas ?(skip_thm_and_qed=false) term2pres 
+  (id,params,metasenv,obj) 
+=
+  match obj with
+  | `Def (Content.Const, thesis, `Proof p) ->
+      let name = get_name p.Content.proof_name in
+      let proof = proof2pres true term2pres ?skip_initial_lambdas p in
+      if skip_thm_and_qed then
+        proof
+      else
+      B.b_v
+        [Some "helm","xref","id"]
+        ([ B.b_h [] (B.b_kw ("ntheorem " ^ name) :: 
+          params2pres params @ [B.b_kw ":"]);
+           B.H ([],[B.indent (term2pres thesis) ; B.b_kw "." ])] @
+         metasenv2pres term2pres metasenv @
+         [proof ; B.b_kw "qed."])
+  | `Def (_, ty, `Definition body) ->
+      let name = get_name body.Content.def_name in
+      B.b_v
+        [Some "helm","xref","id"]
+        ([B.b_h []
+           (B.b_kw ("ndefinition " ^ name) :: params2pres params @ [B.b_kw ":"]);
+          B.indent (term2pres ty)] @
+          metasenv2pres term2pres metasenv @
+          [B.b_kw ":=";
+           B.indent (term2pres body.Content.def_term);
+           B.b_kw "."])
+  | `Decl (_, `Declaration decl)
+  | `Decl (_, `Hypothesis decl) ->
+      let name = get_name decl.Content.dec_name in
+      B.b_v
+        [Some "helm","xref","id"]
+        ([B.b_h [] (B.b_kw ("naxiom " ^ name) :: params2pres params);
+          B.b_kw "Type:";
+          B.indent (term2pres decl.Content.dec_type)] @
+          metasenv2pres term2pres metasenv)
+  | `Joint joint ->
+      B.b_v []
+        (recursion_kind2pres params joint.Content.joint_kind
+        :: List.map (joint_def2pres term2pres) joint.Content.joint_defs)
+  | _ -> raise ToDo
+
+let ncontent2pres ?skip_initial_lambdas ?skip_thm_and_qed ~ids_to_nrefs =
+ let lookup_uri id =
+  try
+   let nref = Hashtbl.find ids_to_nrefs id in
+    Some (NReference.string_of_reference nref)
+  with Not_found -> None
+ in
+  ncontent2pres0 ?skip_initial_lambdas ?skip_thm_and_qed
+    (fun ?(prec=90) ast ->
+      CicNotationPres.box_of_mpres
+       (CicNotationPres.render ~lookup_uri ~prec (TermContentPres.pp_ast ast)))