]> matita.cs.unibo.it Git - helm.git/blob - helm/software/components/content_pres/content2pres.ml
More exceptions pretty-printed.
[helm.git] / helm / software / components / content_pres / content2pres.ml
1 (* Copyright (C) 2003-2005, HELM Team.
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://cs.unibo.it/helm/.
24  *)
25
26 (***************************************************************************)
27 (*                                                                         *)
28 (*                            PROJECT HELM                                 *)
29 (*                                                                         *)
30 (*                Andrea Asperti <asperti@cs.unibo.it>                     *)
31 (*                              17/06/2003                                 *)
32 (*                                                                         *)
33 (***************************************************************************)
34
35 (* $Id$ *)
36
37 module P = Mpresentation
38 module B = Box
39 module Con = Content
40
41 let p_mtr a b = Mpresentation.Mtr(a,b)
42 let p_mtd a b = Mpresentation.Mtd(a,b)
43 let p_mtable a b = Mpresentation.Mtable(a,b)
44 let p_mtext a b = Mpresentation.Mtext(a,b)
45 let p_mi a b = Mpresentation.Mi(a,b)
46 let p_mo a b = Mpresentation.Mo(a,b)
47 let p_mrow a b = Mpresentation.Mrow(a,b)
48 let p_mphantom a b = Mpresentation.Mphantom(a,b)
49
50 let rec split n l =
51   if n = 0 then [],l
52   else let l1,l2 = 
53     split (n-1) (List.tl l) in
54     (List.hd l)::l1,l2
55   
56 let get_xref = function
57   | `Declaration d  
58   | `Hypothesis d -> d.Con.dec_id
59   | `Proof p -> p.Con.proof_id
60   | `Definition d -> d.Con.def_id
61   | `Joint jo -> jo.Con.joint_id
62
63 let hv_attrs =
64   RenderingAttrs.spacing_attributes `BoxML
65   @ RenderingAttrs.indent_attributes `BoxML
66
67 let make_row items concl =
68   B.b_hv hv_attrs (items @ [ concl ])
69 (*   match concl with 
70       B.V _ -> |+ big! +|
71         B.b_v attrs [B.b_h [] items; B.b_indent concl]
72     | _ ->  |+ small +|
73         B.b_h attrs (items@[B.b_space; concl]) *)
74
75 let make_concl ?(attrs=[]) verb concl =
76   B.b_hv (hv_attrs @ attrs) [ B.b_kw verb; concl ]
77 (*   match concl with 
78       B.V _ -> |+ big! +|
79         B.b_v attrs [ B.b_kw verb; B.b_indent concl]
80     | _ ->  |+ small +|
81         B.b_h attrs [ B.b_kw verb; B.b_space; concl ] *)
82
83 let make_args_for_apply term2pres args =
84  let make_arg_for_apply is_first arg row = 
85   let res =
86    match arg with 
87       Con.Aux n -> assert false
88     | Con.Premise prem -> 
89         let name = 
90           (match prem.Con.premise_binder with
91              None -> "previous"
92            | Some s -> s) in
93         (B.b_object (P.Mi ([], name)))::row
94     | Con.Lemma lemma -> 
95         let lemma_attrs = [
96           Some "helm", "xref", lemma.Con.lemma_id;
97           Some "xlink", "href", lemma.Con.lemma_uri ]
98         in
99         (B.b_object (P.Mi(lemma_attrs,lemma.Con.lemma_name)))::row 
100     | Con.Term t -> 
101         if is_first then
102           (term2pres t)::row
103         else (B.b_object (P.Mi([],"_")))::row
104     | Con.ArgProof _ 
105     | Con.ArgMethod _ -> 
106         (B.b_object (P.Mi([],"_")))::row
107   in
108    if is_first then res else B.skip::res
109  in
110   match args with 
111     hd::tl -> 
112       make_arg_for_apply true hd 
113         (List.fold_right (make_arg_for_apply false) tl [])
114   | _ -> assert false
115
116 let get_name = function
117   | Some s -> s
118   | None -> "_"
119
120 let add_xref id = function
121   | B.Text (attrs, t) -> B.Text (((Some "helm", "xref", id) :: attrs), t)
122   | _ -> assert false (* TODO, add_xref is meaningful for all boxes *)
123
124 let rec justification term2pres p = 
125   if ((p.Con.proof_conclude.Con.conclude_method = "Exact") or
126      ((p.Con.proof_context = []) &
127       (p.Con.proof_apply_context = []) &
128       (p.Con.proof_conclude.Con.conclude_method = "Apply"))) then
129     let pres_args = 
130       make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args in
131     B.H([],
132       (B.b_kw "by")::B.b_space::
133       B.Text([],"(")::pres_args@[B.Text([],")")]), None 
134   else (B.b_kw "by"),
135     Some (B.b_toggle [B.b_kw "proof";proof2pres term2pres p])
136      
137 and proof2pres term2pres p =
138   let rec proof2pres p =
139     let indent = 
140       let is_decl e = 
141         (match e with 
142            `Declaration _
143          | `Hypothesis _ -> true
144          | _ -> false) in
145       ((List.filter is_decl p.Con.proof_context) != []) in 
146     let omit_conclusion = (not indent) && (p.Con.proof_context != []) in
147     let concl = 
148       (match p.Con.proof_conclude.Con.conclude_conclusion with
149          None -> None
150        | Some t -> Some (term2pres t)) in
151     let body =
152         let presconclude = 
153           conclude2pres p.Con.proof_conclude indent omit_conclusion in
154         let presacontext = 
155           acontext2pres p.Con.proof_apply_context presconclude indent in
156         context2pres p.Con.proof_context presacontext in
157     match p.Con.proof_name with
158       None -> body
159     | Some name ->
160         let action = 
161          match concl with
162             None -> body
163           | Some ac ->
164              let concl =
165                make_concl ~attrs:[ Some "helm", "xref", p.Con.proof_id ]
166                  "proof of" ac in
167              B.b_toggle [ concl; body ]
168         in
169         B.V ([],
170           [B.Text ([],"(" ^ name ^ ")");
171            B.indent action])
172
173   and context2pres c continuation =
174     (* we generate a subtable for each context element, for selection
175        purposes 
176        The table generated by the head-element does not have an xref;
177        the whole context-proof is already selectable *)
178     match c with
179       [] -> continuation
180     | hd::tl -> 
181         let continuation' =
182           List.fold_right
183             (fun ce continuation ->
184               let xref = get_xref ce in
185               B.V([Some "helm", "xref", xref ],
186                 [B.H([Some "helm", "xref", "ce_"^xref],
187                      [ce2pres_in_proof_context_element ce]);
188                  continuation])) tl continuation in
189          let hd_xref= get_xref hd in
190          B.V([],
191              [B.H([Some "helm", "xref", "ce_"^hd_xref],
192                [ce2pres_in_proof_context_element hd]);
193              continuation'])
194         
195   and ce2pres_in_joint_context_element = function
196     | `Inductive _ -> assert false (* TODO *)
197     | (`Declaration _) as x -> ce2pres x
198     | (`Hypothesis _) as x  -> ce2pres x
199     | (`Proof _) as x       -> ce2pres x
200     | (`Definition _) as x  -> ce2pres x
201   
202   and ce2pres_in_proof_context_element = function 
203     | `Joint ho -> 
204       B.H ([],(List.map ce2pres_in_joint_context_element ho.Content.joint_defs))
205     | (`Declaration _) as x -> ce2pres x
206     | (`Hypothesis _) as x  -> ce2pres x
207     | (`Proof _) as x       -> ce2pres x
208     | (`Definition _) as x  -> ce2pres x
209   
210   and ce2pres = 
211     function 
212         `Declaration d -> 
213          let ty = term2pres d.Con.dec_type in
214          B.H ([],
215            [(B.b_kw "Assume");
216             B.b_space;
217             B.Object ([], P.Mi([],get_name d.Con.dec_name));
218             B.Text([],":");
219             ty])
220       | `Hypothesis h ->
221           let ty = term2pres h.Con.dec_type in
222           B.H ([],
223             [(B.b_kw "Suppose");
224              B.b_space;
225              B.Text([],"(");
226              B.Object ([], P.Mi ([],get_name h.Con.dec_name));
227              B.Text([],")");
228              B.b_space;
229              ty])
230       | `Proof p -> 
231            proof2pres p 
232       | `Definition d -> 
233           let term = term2pres d.Con.def_term in
234           B.H ([],
235             [ B.b_kw "Let"; B.b_space;
236               B.Object ([], P.Mi([],get_name d.Con.def_name));
237               B.Text([]," = ");
238               term])
239
240   and acontext2pres ac continuation indent =
241     List.fold_right
242       (fun p continuation ->
243          let hd = 
244            if indent then
245              B.indent (proof2pres p)
246            else 
247              proof2pres p in
248          B.V([Some "helm","xref",p.Con.proof_id],
249            [B.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
250             continuation])) ac continuation 
251
252   and conclude2pres conclude indent omit_conclusion =
253     let tconclude_body = 
254       match conclude.Con.conclude_conclusion with
255         Some t when
256          not omit_conclusion or
257          (* CSC: I ignore the omit_conclusion flag in this case.   *)
258          (* CSC: Is this the correct behaviour? In the stylesheets *)
259          (* CSC: we simply generated nothing (i.e. the output type *)
260          (* CSC: of the function should become an option.          *)
261          conclude.Con.conclude_method = "BU_Conversion" ->
262           let concl = (term2pres t) in 
263           if conclude.Con.conclude_method = "BU_Conversion" then
264             make_concl "that is equivalent to" concl
265           else if conclude.Con.conclude_method = "FalseInd" then
266            (* false ind is in charge to add the conclusion *)
267            falseind conclude
268           else  
269             let conclude_body = conclude_aux conclude in
270             let ann_concl = 
271               if conclude.Con.conclude_method = "TD_Conversion" then
272                  make_concl "that is equivalent to" concl 
273               else make_concl "we conclude" concl in
274             B.V ([], [conclude_body; ann_concl])
275       | _ -> conclude_aux conclude in
276     if indent then 
277       B.indent (B.H ([Some "helm", "xref", conclude.Con.conclude_id],
278                     [tconclude_body]))
279     else 
280       B.H ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
281
282   and conclude_aux conclude =
283     if conclude.Con.conclude_method = "TD_Conversion" then
284       let expected = 
285         (match conclude.Con.conclude_conclusion with 
286            None -> B.Text([],"NO EXPECTED!!!")
287          | Some c -> term2pres c) in
288       let subproof = 
289         (match conclude.Con.conclude_args with
290           [Con.ArgProof p] -> p
291          | _ -> assert false) in
292       let synth = 
293         (match subproof.Con.proof_conclude.Con.conclude_conclusion with
294            None -> B.Text([],"NO SYNTH!!!")
295          | Some c -> (term2pres c)) in
296       B.V 
297         ([],
298         [make_concl "we must prove" expected;
299          make_concl "or equivalently" synth;
300          proof2pres subproof])
301     else if conclude.Con.conclude_method = "BU_Conversion" then
302       assert false
303     else if conclude.Con.conclude_method = "Exact" then
304       let arg = 
305         (match conclude.Con.conclude_args with 
306            [Con.Term t] -> term2pres t
307          | [Con.Premise p] -> 
308              (match p.Con.premise_binder with
309              | None -> assert false; (* unnamed hypothesis ??? *)
310              | Some s -> B.Text([],s))
311          | err -> assert false) in
312       (match conclude.Con.conclude_conclusion with 
313          None ->
314           B.b_h [] [B.b_kw "Consider"; B.b_space; arg]
315        | Some c -> let conclusion = term2pres c in
316           make_row 
317             [arg; B.b_space; B.b_kw "proves"]
318             conclusion
319        )
320     else if conclude.Con.conclude_method = "Intros+LetTac" then
321       (match conclude.Con.conclude_args with
322          [Con.ArgProof p] -> proof2pres p
323        | _ -> assert false)
324 (* OLD CODE 
325       let conclusion = 
326       (match conclude.Con.conclude_conclusion with 
327          None -> B.Text([],"NO Conclusion!!!")
328        | Some c -> term2pres c) in
329       (match conclude.Con.conclude_args with
330          [Con.ArgProof p] -> 
331            B.V 
332             ([None,"align","baseline 1"; None,"equalrows","false";
333               None,"columnalign","left"],
334               [B.H([],[B.Object([],proof2pres p)]);
335                B.H([],[B.Object([],
336                 (make_concl "we proved 1" conclusion))])]);
337        | _ -> assert false)
338 *)
339     else if (conclude.Con.conclude_method = "Case") then
340       case conclude
341     else if (conclude.Con.conclude_method = "ByInduction") then
342       byinduction conclude
343     else if (conclude.Con.conclude_method = "Exists") then
344       exists conclude
345     else if (conclude.Con.conclude_method = "AndInd") then
346       andind conclude
347     else if (conclude.Con.conclude_method = "FalseInd") then
348       falseind conclude
349     else if (conclude.Con.conclude_method = "Rewrite") then
350       let justif1,justif2 = 
351         (match (List.nth conclude.Con.conclude_args 6) with
352            Con.ArgProof p -> justification term2pres p
353          | _ -> assert false) in
354       let term1 = 
355         (match List.nth conclude.Con.conclude_args 2 with
356            Con.Term t -> term2pres t
357          | _ -> assert false) in 
358       let term2 = 
359         (match List.nth conclude.Con.conclude_args 5 with
360            Con.Term t -> term2pres t
361          | _ -> assert false) in
362       B.V ([], 
363          B.H ([],[
364           (B.b_kw "rewrite");
365           B.b_space; term1;
366           B.b_space; (B.b_kw "with");
367           B.b_space; term2;
368           B.b_space; justif1])::
369             match justif2 with None -> [] | Some j -> [B.indent j])
370     else if conclude.Con.conclude_method = "Eq_chain" then
371       let justification p =
372         let j1,j2 = justification term2pres p in
373           j1 :: B.b_space :: (match j2 with Some j -> [j] | None -> [])
374       in
375       let rec aux args =
376         match args with
377           | [] -> []
378           | (Con.ArgProof p)::(Con.Term t)::tl -> 
379               B.HOV(RenderingAttrs.indent_attributes `BoxML,([B.b_kw "=";B.b_space;term2pres t;B.b_space]@justification p))::(aux tl)
380           | _ -> assert false 
381       in
382       let hd = 
383         match List.hd conclude.Con.conclude_args with
384           | Con.Term t -> t 
385           | _ -> assert false 
386       in
387       B.HOV([],[term2pres hd; (* B.b_space; *)
388               B.V ([],aux (List.tl conclude.Con.conclude_args))])
389     else if conclude.Con.conclude_method = "Apply" then
390       let pres_args = 
391         make_args_for_apply term2pres conclude.Con.conclude_args in
392       B.H([],
393         (B.b_kw "by")::
394         B.b_space::
395         B.Text([],"(")::pres_args@[B.Text([],")")])
396     else 
397       B.V ([], [
398         B.b_kw ("Apply method" ^ conclude.Con.conclude_method ^ " to");
399         (B.indent (B.V ([], args2pres conclude.Con.conclude_args)))])
400
401   and args2pres l = List.map arg2pres l
402
403   and arg2pres =
404     function
405         Con.Aux n -> B.b_kw ("aux " ^ n)
406       | Con.Premise prem -> B.b_kw "premise"
407       | Con.Lemma lemma -> B.b_kw "lemma"
408       | Con.Term t -> term2pres t
409       | Con.ArgProof p -> proof2pres p 
410       | Con.ArgMethod s -> B.b_kw "method"
411  
412    and case conclude =
413      let proof_conclusion = 
414        (match conclude.Con.conclude_conclusion with
415           None -> B.b_kw "No conclusion???"
416         | Some t -> term2pres t) in
417      let arg,args_for_cases = 
418        (match conclude.Con.conclude_args with
419            Con.Aux(_)::Con.Aux(_)::Con.Term(_)::arg::tl ->
420              arg,tl
421          | _ -> assert false) in
422      let case_on =
423        let case_arg = 
424          (match arg with
425             Con.Aux n -> B.b_kw "an aux???"
426            | Con.Premise prem ->
427               (match prem.Con.premise_binder with
428                  None -> B.b_kw "the previous result"
429                | Some n -> B.Object ([], P.Mi([],n)))
430            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
431            | Con.Term t -> 
432                term2pres t
433            | Con.ArgProof p -> B.b_kw "a proof???"
434            | Con.ArgMethod s -> B.b_kw "a method???")
435       in
436         (make_concl "we proceed by cases on" case_arg) in
437      let to_prove =
438         (make_concl "to prove" proof_conclusion) in
439      B.V ([], case_on::to_prove::(make_cases args_for_cases))
440
441    and byinduction conclude =
442      let proof_conclusion = 
443        (match conclude.Con.conclude_conclusion with
444           None -> B.b_kw "No conclusion???"
445         | Some t -> term2pres t) in
446      let inductive_arg,args_for_cases = 
447        (match conclude.Con.conclude_args with
448            Con.Aux(n)::_::tl ->
449              let l1,l2 = split (int_of_string n) tl in
450              let last_pos = (List.length l2)-1 in
451              List.nth l2 last_pos,l1
452          | _ -> assert false) in
453      let induction_on =
454        let arg = 
455          (match inductive_arg with
456             Con.Aux n -> B.b_kw "an aux???"
457            | Con.Premise prem ->
458               (match prem.Con.premise_binder with
459                  None -> B.b_kw "the previous result"
460                | Some n -> B.Object ([], P.Mi([],n)))
461            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
462            | Con.Term t -> 
463                term2pres t
464            | Con.ArgProof p -> B.b_kw "a proof???"
465            | Con.ArgMethod s -> B.b_kw "a method???") in
466         (make_concl "we proceed by induction on" arg) in
467      let to_prove =
468         (make_concl "to prove" proof_conclusion) in
469      B.V ([], induction_on::to_prove:: (make_cases args_for_cases))
470
471     and make_cases l = List.map make_case l
472
473     and make_case =  
474       function 
475         Con.ArgProof p ->
476           let name =
477             (match p.Con.proof_name with
478                None -> B.b_kw "no name for case!!"
479              | Some n -> B.Object ([], P.Mi([],n))) in
480           let indhyps,args =
481              List.partition 
482                (function
483                    `Hypothesis h -> h.Con.dec_inductive
484                  | _ -> false) p.Con.proof_context in
485           let pattern_aux =
486              List.fold_right
487                (fun e p -> 
488                   let dec  = 
489                     (match e with 
490                        `Declaration h 
491                      | `Hypothesis h -> 
492                          let name = get_name h.Con.dec_name in
493                          [B.b_space;
494                           B.Object ([], P.Mi ([],name));
495                           B.Text([],":");
496                           (term2pres h.Con.dec_type)]
497                      | _ -> [B.Text ([],"???")]) in
498                   dec@p) args [] in
499           let pattern = 
500             B.H ([],
501                (B.b_kw "Case"::B.b_space::name::pattern_aux)@
502                 [B.b_space;
503                  B.Text([], Utf8Macro.unicode_of_tex "\\Rightarrow")]) in
504           let subconcl = 
505             (match p.Con.proof_conclude.Con.conclude_conclusion with
506                None -> B.b_kw "No conclusion!!!"
507              | Some t -> term2pres t) in
508           let asubconcl = B.indent (make_concl "the thesis becomes" subconcl) in
509           let induction_hypothesis = 
510             (match indhyps with
511               [] -> []
512             | _ -> 
513                let text = B.indent (B.b_kw "by induction hypothesis we know") in
514                let make_hyp =
515                  function 
516                    `Hypothesis h ->
517                      let name = 
518                        (match h.Con.dec_name with
519                           None -> "no name"
520                         | Some s -> s) in
521                      B.indent (B.H ([],
522                        [B.Text([],"(");
523                         B.Object ([], P.Mi ([],name));
524                         B.Text([],")");
525                         B.b_space;
526                         term2pres h.Con.dec_type]))
527                    | _ -> assert false in
528                let hyps = List.map make_hyp indhyps in
529                text::hyps) in          
530           (* let acontext = 
531                acontext2pres_old p.Con.proof_apply_context true in *)
532           let body = conclude2pres p.Con.proof_conclude true false in
533           let presacontext = 
534            let acontext_id =
535             match p.Con.proof_apply_context with
536                [] -> p.Con.proof_conclude.Con.conclude_id
537              | {Con.proof_id = id}::_ -> id
538            in
539             B.Action([None,"type","toggle"],
540               [ B.indent (add_xref acontext_id (B.b_kw "Proof"));
541                 acontext2pres p.Con.proof_apply_context body true]) in
542           B.V ([], pattern::asubconcl::induction_hypothesis@[presacontext])
543        | _ -> assert false 
544
545      and falseind conclude =
546        let proof_conclusion = 
547          (match conclude.Con.conclude_conclusion with
548             None -> B.b_kw "No conclusion???"
549           | Some t -> term2pres t) in
550        let case_arg = 
551          (match conclude.Con.conclude_args with
552              [Con.Aux(n);_;case_arg] -> case_arg
553            | _ -> assert false;
554              (* 
555              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
556              assert false *)) in
557        let arg = 
558          (match case_arg with
559              Con.Aux n -> assert false
560            | Con.Premise prem ->
561               (match prem.Con.premise_binder with
562                  None -> [B.b_kw "Contradiction, hence"]
563                | Some n -> 
564                    [ B.Object ([],P.Mi([],n)); B.skip;
565                      B.b_kw "is contradictory, hence"])
566            | Con.Lemma lemma -> 
567                [ B.Object ([], P.Mi([],lemma.Con.lemma_name)); B.skip;
568                  B.b_kw "is contradictory, hence" ]
569            | _ -> assert false) in
570             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
571        make_row arg proof_conclusion
572
573      and andind conclude =
574        let proof,case_arg = 
575          (match conclude.Con.conclude_args with
576              [Con.Aux(n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
577            | _ -> assert false;
578              (* 
579              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
580              assert false *)) in
581        let arg = 
582          (match case_arg with
583              Con.Aux n -> assert false
584            | Con.Premise prem ->
585               (match prem.Con.premise_binder with
586                  None -> []
587                | Some n -> [(B.b_kw "by"); B.b_space; B.Object([], P.Mi([],n))])
588            | Con.Lemma lemma -> 
589                [(B.b_kw "by");B.skip;
590                 B.Object([], P.Mi([],lemma.Con.lemma_name))]
591            | _ -> assert false) in
592        match proof.Con.proof_context with
593          `Hypothesis hyp1::`Hypothesis hyp2::tl ->
594             let preshyp1 = 
595               B.H ([],
596                [B.Text([],"(");
597                 B.Object ([], P.Mi([],get_name hyp1.Con.dec_name));
598                 B.Text([],")");
599                 B.skip;
600                 term2pres hyp1.Con.dec_type]) in
601             let preshyp2 = 
602               B.H ([],
603                [B.Text([],"(");
604                 B.Object ([], P.Mi([],get_name hyp2.Con.dec_name));
605                 B.Text([],")");
606                 B.skip;
607                 term2pres hyp2.Con.dec_type]) in
608             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
609             let body = conclude2pres proof.Con.proof_conclude false true in
610             let presacontext = 
611               acontext2pres proof.Con.proof_apply_context body false in
612             B.V 
613               ([],
614                [B.H ([],arg@[B.skip; B.b_kw "we have"]);
615                 preshyp1;
616                 B.b_kw "and";
617                 preshyp2;
618                 presacontext]);
619          | _ -> assert false
620
621      and exists conclude =
622        let proof = 
623          (match conclude.Con.conclude_args with
624              [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
625            | _ -> assert false;
626              (* 
627              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
628              assert false *)) in
629        match proof.Con.proof_context with
630            `Declaration decl::`Hypothesis hyp::tl
631          | `Hypothesis decl::`Hypothesis hyp::tl ->
632            let presdecl = 
633              B.H ([],
634                [(B.b_kw "let");
635                 B.skip;
636                 B.Object ([], P.Mi([],get_name decl.Con.dec_name));
637                 B.Text([],":"); term2pres decl.Con.dec_type]) in
638            let suchthat =
639              B.H ([],
640                [(B.b_kw "such that");
641                 B.skip;
642                 B.Text([],"(");
643                 B.Object ([], P.Mi([],get_name hyp.Con.dec_name));
644                 B.Text([],")");
645                 B.skip;
646                 term2pres hyp.Con.dec_type]) in
647             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
648             let body = conclude2pres proof.Con.proof_conclude false true in
649             let presacontext = 
650               acontext2pres proof.Con.proof_apply_context body false in
651             B.V 
652               ([],
653                [presdecl;
654                 suchthat;
655                 presacontext]);
656          | _ -> assert false
657
658     in
659     proof2pres p
660
661 exception ToDo
662
663 let counter = ref 0
664
665 let conjecture2pres term2pres (id, n, context, ty) =
666  B.b_indent
667   (B.b_hv [Some "helm", "xref", id]
668      ((B.b_toggle [
669         B.b_h [] [B.b_text [] "{...}"; B.b_space];
670         B.b_hv [] (List.map
671           (function
672              | None ->
673                  B.b_h []
674                    [ B.b_object (p_mi [] "_") ;
675                      B.b_object (p_mo [] ":?") ;
676                      B.b_object (p_mi [] "_")]
677              | Some (`Declaration d)
678              | Some (`Hypothesis d) ->
679                  let { Content.dec_name =
680                      dec_name ; Content.dec_type = ty } = d
681                  in
682                    B.b_h []
683                      [ B.b_object
684                          (p_mi []
685                             (match dec_name with
686                                  None -> "_"
687                                | Some n -> n));
688                        B.b_text [] ":";
689                        term2pres ty ]
690              | Some (`Definition d) ->
691                  let
692                      { Content.def_name = def_name ;
693                        Content.def_term = bo } = d
694                  in
695                    B.b_h []
696                      [ B.b_object (p_mi []
697                                      (match def_name with
698                                           None -> "_"
699                                         | Some n -> n)) ;
700                        B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
701                        term2pres bo]
702              | Some (`Proof p) ->
703                  let proof_name = p.Content.proof_name in
704                    B.b_h []
705                      [ B.b_object (p_mi []
706                                      (match proof_name with
707                                           None -> "_"
708                                         | Some n -> n)) ;
709                        B.b_text [] (Utf8Macro.unicode_of_tex "\\Assign");
710                        proof2pres term2pres p])
711           (List.rev context)) ] ::
712          [ B.b_h []
713            [ B.b_text [] (Utf8Macro.unicode_of_tex "\\vdash");
714              B.b_object (p_mi [] (string_of_int n)) ;
715              B.b_text [] ":" ;
716              term2pres ty ]])))
717
718 let metasenv2pres term2pres = function
719   | None -> []
720   | Some metasenv' ->
721       (* Conjectures are in their own table to make *)
722       (* diffing the DOM trees easier.              *)
723       [B.b_v []
724         ((B.b_kw ("Conjectures:" ^
725             (let _ = incr counter; in (string_of_int !counter)))) ::
726          (List.map (conjecture2pres term2pres) metasenv'))]
727
728 let params2pres params =
729   let param2pres uri =
730     B.b_text [Some "xlink", "href", UriManager.string_of_uri uri]
731       (UriManager.name_of_uri uri)
732   in
733   let rec spatiate = function
734     | [] -> []
735     | hd :: [] -> [hd]
736     | hd :: tl -> hd :: B.b_text [] ", " :: spatiate tl
737   in
738   match params with
739   | [] -> []
740   | p ->
741       let params = spatiate (List.map param2pres p) in
742       [B.b_space;
743        B.b_h [] (B.b_text [] "[" :: params @ [ B.b_text [] "]" ])]
744
745 let recursion_kind2pres params kind =
746   let kind =
747     match kind with
748     | `Recursive _ -> "Recursive definition"
749     | `CoRecursive -> "CoRecursive definition"
750     | `Inductive _ -> "Inductive definition"
751     | `CoInductive _ -> "CoInductive definition"
752   in
753   B.b_h [] (B.b_kw kind :: params2pres params)
754
755 let inductive2pres term2pres ind =
756   let constructor2pres decl =
757     B.b_h [] [
758       B.b_text [] ("| " ^ get_name decl.Content.dec_name ^ ":");
759       B.b_space;
760       term2pres decl.Content.dec_type
761     ]
762   in
763   B.b_v []
764     (B.b_h [] [
765       B.b_kw (ind.Content.inductive_name ^ " of arity");
766       B.smallskip;
767       term2pres ind.Content.inductive_type ]
768     :: List.map constructor2pres ind.Content.inductive_constructors)
769
770 let joint_def2pres term2pres def =
771   match def with
772   | `Inductive ind -> inductive2pres term2pres ind
773   | _ -> assert false (* ZACK or raise ToDo? *)
774
775 let content2pres term2pres (id,params,metasenv,obj) =
776   match obj with
777   | `Def (Content.Const, thesis, `Proof p) ->
778       let name = get_name p.Content.proof_name in
779       B.b_v
780         [Some "helm","xref","id"]
781         ([ B.b_h [] (B.b_kw ("Proof " ^ name) :: params2pres params);
782            B.b_kw "Thesis:";
783            B.indent (term2pres thesis) ] @
784          metasenv2pres term2pres metasenv @
785          [proof2pres term2pres p])
786   | `Def (_, ty, `Definition body) ->
787       let name = get_name body.Content.def_name in
788       B.b_v
789         [Some "helm","xref","id"]
790         ([B.b_h [] (B.b_kw ("Definition " ^ name) :: params2pres params);
791           B.b_kw "Type:";
792           B.indent (term2pres ty)] @
793           metasenv2pres term2pres metasenv @
794           [B.b_kw "Body:"; term2pres body.Content.def_term])
795   | `Decl (_, `Declaration decl)
796   | `Decl (_, `Hypothesis decl) ->
797       let name = get_name decl.Content.dec_name in
798       B.b_v
799         [Some "helm","xref","id"]
800         ([B.b_h [] (B.b_kw ("Axiom " ^ name) :: params2pres params);
801           B.b_kw "Type:";
802           B.indent (term2pres decl.Content.dec_type)] @
803           metasenv2pres term2pres metasenv)
804   | `Joint joint ->
805       B.b_v []
806         (recursion_kind2pres params joint.Content.joint_kind
807         :: List.map (joint_def2pres term2pres) joint.Content.joint_defs)
808   | _ -> raise ToDo
809
810 let content2pres ~ids_to_inner_sorts =
811   content2pres
812     (fun annterm ->
813       let ast, ids_to_uris =
814         TermAcicContent.ast_of_acic ids_to_inner_sorts annterm
815       in
816       CicNotationPres.box_of_mpres
817         (CicNotationPres.render ids_to_uris
818           (TermContentPres.pp_ast ast)))
819