]> matita.cs.unibo.it Git - helm.git/blob - helm/ocaml/cic_transformations/content2pres.ml
Closed induction cases are now pointers to the acontext/conclusion ==>
[helm.git] / helm / ocaml / cic_transformations / content2pres.ml
1 (* Copyright (C) 2000, 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 let rec split n l =
36   if n = 0 then [],l
37   else let l1,l2 = 
38     split (n-1) (List.tl l) in
39     (List.hd l)::l1,l2
40 ;;
41   
42
43 let is_big_general countterm p =
44   let maxsize = Cexpr2pres.maxsize in
45   let module Con = Content in
46   let rec countp current_size p =
47     if current_size > maxsize then current_size
48     else 
49       let c1 = (countcontext current_size p.Con.proof_context) in
50       if c1 > maxsize then c1
51     else 
52       let c2 = (countapplycontext c1 p.Con.proof_apply_context) in
53       if c2 > maxsize then c2
54     else 
55       countconclude c2 p.Con.proof_conclude
56
57   and 
58     countcontext current_size c =
59       List.fold_left countcontextitem current_size c
60   and
61     countcontextitem current_size e =
62       if current_size > maxsize then maxsize
63       else 
64         (match e with
65           `Declaration d -> 
66             (match d.Con.dec_name with
67                Some s -> current_size + 4 + (String.length s)
68              | None -> prerr_endline "NO NAME!!"; assert false)
69         | `Hypothesis h ->
70             (match h.Con.dec_name with
71                 Some s -> current_size + 4 + (String.length s)
72               | None -> prerr_endline "NO NAME!!"; assert false) 
73         | `Proof p -> countp current_size p
74         | `Definition d -> 
75             (match d.Con.def_name with
76                 Some s -> 
77                   let c1 = (current_size + 4 + (String.length s)) in
78                   (countterm c1 d.Con.def_term)
79               | None -> 
80                   prerr_endline "NO NAME!!"; assert false) 
81         | `Joint ho -> maxsize + 1) (* we assume is big *)
82   and 
83     countapplycontext current_size ac =
84       List.fold_left countp current_size ac
85   and 
86     countconclude current_size co =
87       if current_size > maxsize then current_size
88       else
89         let c1 = countargs current_size co.Con.conclude_args in
90         if c1 > maxsize then c1 
91       else 
92         (match co.Con.conclude_conclusion with
93            Some concl ->  countterm c1 concl
94         | None -> c1)
95   and 
96     countargs current_size args =
97       List.fold_left countarg current_size args
98   and
99     countarg current_size arg =
100       if current_size > maxsize then current_size
101       else 
102         (match arg with 
103            Con.Aux _ -> current_size
104          | Con.Premise prem -> 
105              (match prem.Con.premise_binder with
106                 Some s -> current_size + (String.length s)
107               | None -> current_size + 7) 
108          | Con.Lemma lemma -> 
109              current_size + (String.length lemma.Con.lemma_name)
110          | Con.Term t -> countterm current_size t
111          | Con.ArgProof p -> countp current_size p
112          | Con.ArgMethod s -> (maxsize + 1)) in
113   let size = (countp 0 p) in
114   (size > maxsize)
115 ;;
116
117 let is_big = is_big_general (Cexpr2pres.countterm)
118 ;;
119
120 let get_xref =
121     let module Con = Content in
122       function
123         `Declaration d  
124       | `Hypothesis d -> d.Con.dec_id
125       | `Proof p -> p.Con.proof_id
126       | `Definition d -> d.Con.def_id
127       | `Joint jo -> jo.Con.joint_id
128 ;;
129
130 let make_row ?(attrs=[]) items concl =
131   let module P = Mpresentation in
132     (match concl with 
133        P.Mtable _ -> (* big! *)
134          P.Mtable (attrs@[None,"align","baseline 1"; None,"equalrows","false";
135           None,"columnalign","left"],
136            [P.Mtr([],[P.Mtd ([],P.Mrow([],items))]);
137             P.Mtr ([],[P.Mtd ([],P.indented concl)])])
138      | _ ->  (* small *)
139        P.Mrow(attrs,items@[P.Mspace([None,"width","0.1cm"]);concl]))
140 ;;
141
142 let make_concl ?(attrs=[]) verb concl =
143   let module P = Mpresentation in
144     (match concl with 
145        P.Mtable _ -> (* big! *)
146          P.Mtable (attrs@[None,"align","baseline 1"; None,"equalrows","false";
147           None,"columnalign","left"],
148            [P.Mtr([],[P.Mtd ([],P.Mtext([None,"mathcolor","Red"],verb))]);
149             P.Mtr ([],[P.Mtd ([],P.indented concl)])])
150      | _ ->  (* small *)
151        P.Mrow(attrs,
152         [P.Mtext([None,"mathcolor","Red"],verb); 
153          P.Mspace([None,"width","0.1cm"]);
154          concl]))
155 ;;
156
157 let make_args_for_apply term2pres args =
158  let module Con = Content in
159  let module P = Mpresentation in
160  let make_arg_for_apply is_first arg row = 
161   let res =
162    match arg with 
163       Con.Aux n -> assert false
164     | Con.Premise prem -> 
165         let name = 
166           (match prem.Con.premise_binder with
167              None -> "previous"
168            | Some s -> s) in
169         P.Mi([],name)::row
170     | Con.Lemma lemma -> 
171          P.Mi([],lemma.Con.lemma_name)::row 
172     | Con.Term t -> 
173         if is_first then
174           (term2pres t)::row
175         else P.Mi([],"_")::row
176     | Con.ArgProof _ 
177     | Con.ArgMethod _ -> 
178        P.Mi([],"_")::row
179   in
180    if is_first then res else P.smallskip::res
181  in
182   match args with 
183     hd::tl -> 
184       make_arg_for_apply true hd 
185         (List.fold_right (make_arg_for_apply false) tl [])
186   | _ -> assert false
187 ;;
188
189 let rec justification term2pres p = 
190   let module Con = Content in
191   let module P = Mpresentation in
192   if ((p.Con.proof_conclude.Con.conclude_method = "Exact") or
193      ((p.Con.proof_context = []) &
194       (p.Con.proof_apply_context = []) &
195       (p.Con.proof_conclude.Con.conclude_method = "Apply"))) then
196     let pres_args = 
197       make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args in
198     P.Mrow([],
199       P.Mtext([None,"mathcolor","Red"],"by")::P.Mspace([None,"width","0.1cm"])::
200       P.Mo([],"(")::pres_args@[P.Mo([],")")]) 
201   else proof2pres term2pres p 
202      
203 and proof2pres term2pres p =
204   let rec proof2pres p =
205     let module Con = Content in
206     let module P = Mpresentation in
207       let indent = 
208         let is_decl e = 
209           (match e with 
210              `Declaration _
211            | `Hypothesis _ -> true
212            | _ -> false) in
213         ((List.filter is_decl p.Con.proof_context) != []) in 
214       let omit_conclusion = (not indent) && (p.Con.proof_context != []) in
215       let concl = 
216         (match p.Con.proof_conclude.Con.conclude_conclusion with
217            None -> None
218          | Some t -> Some (term2pres t)) in
219       let body =
220           let presconclude = 
221             conclude2pres p.Con.proof_conclude indent omit_conclusion in
222           let presacontext = 
223             acontext2pres p.Con.proof_apply_context presconclude indent in
224           context2pres p.Con.proof_context presacontext in
225       match p.Con.proof_name with
226         None -> body
227       | Some name ->
228           let action = 
229            match concl with
230               None -> body
231 (*
232                P.Maction
233                  ([None,"actiontype","toggle" ; None,"selection","1"],
234                   [P.Mtext [] "proof" ; body])
235 *)
236             | Some ac ->
237                P.Maction
238                  ([None,"actiontype","toggle" ; None,"selection","1"],
239                   [(make_concl ~attrs:[Some "helm", "xref", p.Con.proof_id]
240                      "proof of" ac); body])
241           in
242           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
243               None,"columnalign","left"],
244             [P.Mtr ([],[P.Mtd ([],P.Mfenced([],[P.Mtext ([],name)]))]);
245              P.Mtr ([],[P.Mtd ([], P.indented action)])])
246 (*
247           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
248               None,"columnalign","left";Some "helm", "xref", p.Con.proof_id],
249             [P.Mtr ([],[P.Mtd ([],P.Mfenced([],[P.Mtext ([],name)]))]);
250              P.Mtr ([],[P.Mtd ([], P.indented action)])]) *)
251
252   and context2pres c continuation =
253     (* we generate a subtable for each context element, for selection
254        purposes 
255        The table generated by the head-element does not have an xref;
256        the whole context-proof is already selectable *)
257     let module P = Mpresentation in
258     match c with
259       [] -> continuation
260     | hd::tl -> 
261         let continuation' =
262           List.fold_right
263             (fun ce continuation ->
264               let xref = get_xref ce in
265               P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
266                None,"columnalign","left"; Some "helm", "xref", xref ],
267                 [P.Mtr([Some "helm", "xref", "ce_"^xref],[P.Mtd ([],ce2pres ce)]);
268                  P.Mtr([],[P.Mtd ([], continuation)])])) tl continuation in
269          let hd_xref= get_xref hd in
270          P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
271            None,"columnalign","left"],
272              [P.Mtr([Some "helm", "xref", "ce_"^hd_xref],
273                [P.Mtd ([],ce2pres hd)]);
274              P.Mtr([],[P.Mtd ([], continuation')])])
275          
276   and ce2pres =
277     let module P = Mpresentation in
278     let module Con = Content in
279       function
280         `Declaration d -> 
281           (match d.Con.dec_name with
282               Some s ->
283                 let ty = term2pres d.Con.dec_type in
284                 P.Mrow ([],
285                   [P.Mtext([None,"mathcolor","Red"],"Assume");
286                    P.Mspace([None,"width","0.1cm"]);
287                    P.Mi([],s);
288                    P.Mtext([],":");
289                    ty])
290             | None -> 
291                 prerr_endline "NO NAME!!"; assert false)
292       | `Hypothesis h ->
293           (match h.Con.dec_name with
294               Some s ->
295                 let ty = term2pres h.Con.dec_type in
296                 P.Mrow ([],
297                   [P.Mtext([None,"mathcolor","Red"],"Suppose");
298                    P.Mspace([None,"width","0.1cm"]);
299                    P.Mo([],"(");
300                    P.Mi ([],s);
301                    P.Mo([],")");
302                    P.Mspace([None,"width","0.1cm"]);
303                    ty])
304             | None -> 
305                 prerr_endline "NO NAME!!"; assert false) 
306       | `Proof p -> 
307            (match  p.Con.proof_name with
308               Some "w" -> prerr_endline ("processing w");
309             | _ -> ());
310            proof2pres p 
311       | `Definition d -> 
312            (match d.Con.def_name with
313               Some s ->
314                 let term = term2pres d.Con.def_term in
315                 P.Mrow ([],
316                   [P.Mtext([],"Let ");
317                    P.Mi([],s);
318                    P.Mtext([]," = ");
319                    term])
320             | None -> 
321                 prerr_endline "NO NAME!!"; assert false) 
322       | `Joint ho -> 
323             P.Mtext ([],"jointdef")
324
325   and acontext2pres ac continuation indent =
326     let module Con = Content in
327     let module P = Mpresentation in
328     List.fold_right
329       (fun p continuation ->
330          let hd = 
331            if indent then
332              P.indented (proof2pres p)
333            else 
334              proof2pres p in
335          P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
336           None,"columnalign","left"; Some "helm","xref",p.Con.proof_id],
337            [P.Mtr([Some "helm","xref","ace_"^p.Con.proof_id],[P.Mtd ([],hd)]);
338             P.Mtr([],[P.Mtd ([], continuation)])])) ac continuation 
339
340   and conclude2pres conclude indent omit_conclusion =
341     let module Con = Content in
342     let module P = Mpresentation in
343     let tconclude_body = 
344       match conclude.Con.conclude_conclusion with
345         Some t when not omit_conclusion ->
346           let concl = (term2pres t) in 
347           if conclude.Con.conclude_method = "BU_Conversion" then
348             make_concl "that is equivalent to" concl
349           else if conclude.Con.conclude_method = "FalseInd" then
350            (* false ind is in charge to add the conclusion *)
351            falseind conclude
352           else  
353             let conclude_body = conclude_aux conclude in
354             let ann_concl = 
355               if conclude.Con.conclude_method = "TD_Conversion" then
356                  make_concl "that is equivalent to" concl 
357               else make_concl "we conclude" concl in
358             P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
359               None,"columnalign","left"],
360                 [P.Mtr ([],[P.Mtd ([],conclude_body)]);
361                  P.Mtr ([],[P.Mtd ([],ann_concl)])])
362       | _ -> conclude_aux conclude in
363     if indent then 
364       P.indented (P.Mrow ([Some "helm", "xref", conclude.Con.conclude_id],
365                     [tconclude_body]))
366     else 
367       P.Mrow ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
368
369
370   and conclude_aux conclude =
371     let module Con = Content in
372     let module P = Mpresentation in
373     if conclude.Con.conclude_method = "TD_Conversion" then
374       let expected = 
375         (match conclude.Con.conclude_conclusion with 
376            None -> P.Mtext([],"NO EXPECTED!!!")
377          | Some c -> term2pres c) in
378       let subproof = 
379         (match conclude.Con.conclude_args with
380           [Con.ArgProof p] -> p
381          | _ -> assert false) in
382       let synth = 
383         (match subproof.Con.proof_conclude.Con.conclude_conclusion with
384            None -> P.Mtext([],"NO SYNTH!!!")
385          | Some c -> (term2pres c)) in
386       P.Mtable 
387         ([None,"align","baseline 1"; None,"equalrows","false"; None,"columnalign","left"],
388         [P.Mtr([],[P.Mtd([],make_concl "we must prove" expected)]);
389          P.Mtr([],[P.Mtd([],make_concl "or equivalently" synth)]);
390          P.Mtr([],[P.Mtd([],proof2pres subproof)])])
391     else if conclude.Con.conclude_method = "BU_Conversion" then
392       assert false
393     else if conclude.Con.conclude_method = "Exact" then
394       let arg = 
395         (match conclude.Con.conclude_args with 
396            [Con.Term t] -> term2pres t
397          | _ -> assert false) in
398       (match conclude.Con.conclude_conclusion with 
399          None ->
400           P.Mrow []
401            [P.Mtext [None, "mathcolor", "red"] "Consider" ; P.smallskip; arg]
402        | Some c -> let conclusion = term2pres c in
403           make_row 
404             [arg; P.Mspace([None,"width","0.1cm"]);P.Mtext([],"proves")]
405             conclusion
406        )
407     else if conclude.Con.conclude_method = "Intros+LetTac" then
408       (match conclude.Con.conclude_args with
409          [Con.ArgProof p] -> proof2pres p
410        | _ -> assert false)
411 (* OLD CODE 
412       let conclusion = 
413       (match conclude.Con.conclude_conclusion with 
414          None -> P.Mtext([],"NO Conclusion!!!")
415        | Some c -> term2pres c) in
416       (match conclude.Con.conclude_args with
417          [Con.ArgProof p] -> 
418            P.Mtable 
419             ([None,"align","baseline 1"; None,"equalrows","false";
420               None,"columnalign","left"],
421               [P.Mtr([],[P.Mtd([],proof2pres p)]);
422                P.Mtr([],[P.Mtd([],
423                 (make_concl "we proved 1" conclusion))])]);
424        | _ -> assert false)
425 *)
426     else if (conclude.Con.conclude_method = "ByInduction") then
427       byinduction conclude
428     else if (conclude.Con.conclude_method = "Exists") then
429       exists conclude
430     else if (conclude.Con.conclude_method = "AndInd") then
431       andind conclude
432     else if (conclude.Con.conclude_method = "FalseInd") then
433       falseind conclude
434     else if (conclude.Con.conclude_method = "Rewrite") then
435       let justif = 
436         (match (List.nth conclude.Con.conclude_args 6) with
437            Con.ArgProof p -> justification term2pres p
438          | _ -> assert false) in
439       let term1 = 
440         (match List.nth conclude.Con.conclude_args 2 with
441            Con.Term t -> term2pres t
442          | _ -> assert false) in 
443       let term2 = 
444         (match List.nth conclude.Con.conclude_args 5 with
445            Con.Term t -> term2pres t
446          | _ -> assert false) in
447       P.Mtable ([None,"align","baseline 1";None,"equalrows","false";
448         None,"columnalign","left"], 
449          [P.Mtr ([],[P.Mtd ([],P.Mrow([],[
450           P.Mtext([None,"mathcolor","Red"],"rewrite");
451           P.Mspace([None,"width","0.1cm"]);term1;
452           P.Mspace([None,"width","0.1cm"]);
453           P.Mtext([None,"mathcolor","Red"],"with");
454           P.Mspace([None,"width","0.1cm"]);term2]))]);
455           P.Mtr ([],[P.Mtd ([],P.indented justif)])]);
456     else if conclude.Con.conclude_method = "Apply" then
457       let pres_args = 
458         make_args_for_apply term2pres conclude.Con.conclude_args in
459       P.Mrow([],
460         P.Mtext([None,"mathcolor","Red"],"by")::
461         P.Mspace([None,"width","0.1cm"])::
462         P.Mo([],"(")::pres_args@[P.Mo([],")")])
463     else 
464       P.Mtable 
465         ([None,"align","baseline 1"; None,"equalrows","false"; None,"columnalign","left"],
466          [P.Mtr ([],[P.Mtd ([],P.Mtext([],"Apply method" ^ conclude.Con.conclude_method ^ " to"))]);
467           P.Mtr ([],
468            [P.Mtd ([], 
469              (P.indented 
470                (P.Mtable 
471                  ([None,"align","baseline 1"; None,"equalrows","false";
472                    None,"columnalign","left"],
473                   args2pres conclude.Con.conclude_args))))])]) 
474
475   and args2pres l =
476     let module P = Mpresentation in
477     List.map 
478      (function a -> P.Mtr ([], [P.Mtd ([], arg2pres a)])) l
479
480   and arg2pres =
481     let module P = Mpresentation in
482     let module Con = Content in
483     function
484         Con.Aux n -> 
485           P.Mtext ([],"aux " ^ n)
486       | Con.Premise prem -> 
487           P.Mtext ([],"premise")
488       | Con.Lemma lemma ->
489           P.Mtext ([],"lemma")
490       | Con.Term t -> 
491           term2pres t
492       | Con.ArgProof p ->
493         proof2pres p 
494       | Con.ArgMethod s -> 
495          P.Mtext ([],"method") 
496  
497    and byinduction conclude =
498      let module P = Mpresentation in
499      let module Con = Content in
500      let proof_conclusion = 
501        (match conclude.Con.conclude_conclusion with
502           None -> P.Mtext([],"No conclusion???")
503         | Some t -> term2pres t) in
504      let inductive_arg,args_for_cases = 
505        (match conclude.Con.conclude_args with
506            Con.Aux(n)::_::tl ->
507              let l1,l2 = split (int_of_string n) tl in
508              let last_pos = (List.length l2)-1 in
509              List.nth l2 last_pos,l1
510          | _ -> assert false) in
511      let induction_on =
512        let arg = 
513          (match inductive_arg with
514             Con.Aux n -> 
515               P.Mtext ([],"an aux???")
516            | Con.Premise prem ->
517               (match prem.Con.premise_binder with
518                  None -> P.Mtext ([],"the previous result")
519                | Some n -> P.Mi([],n))
520            | Con.Lemma lemma -> P.Mi([],lemma.Con.lemma_name)
521            | Con.Term t -> 
522                term2pres t
523            | Con.ArgProof p ->
524                P.Mtext ([],"a proof???")
525            | Con.ArgMethod s -> 
526                P.Mtext ([],"a method???")) in
527         (make_concl "we proceede by induction on" arg) in
528      let to_prove =
529         (make_concl "to prove" proof_conclusion) in
530      P.Mtable 
531        ([None,"align","baseline 1"; None,"equalrows","false"; 
532          None,"columnalign","left"],
533           P.Mtr ([],[P.Mtd ([],induction_on)])::
534           P.Mtr ([],[P.Mtd ([],to_prove)])::
535           (make_cases args_for_cases))
536
537     and make_cases args_for_cases =
538     let module P = Mpresentation in
539     List.map 
540       (fun p -> P.Mtr ([],[P.Mtd ([],make_case p)])) args_for_cases
541
542     and make_case =  
543       let module P = Mpresentation in
544       let module Con = Content in
545       function 
546         Con.ArgProof p ->
547           let name =
548             (match p.Con.proof_name with
549                None -> P.Mtext([],"no name for case!!")
550              | Some n -> P.Mi([],n)) in
551           let indhyps,args =
552              List.partition 
553                (function
554                    `Hypothesis h -> h.Con.dec_inductive
555                  | _ -> false) p.Con.proof_context in
556           let pattern_aux =
557              List.fold_right
558                (fun e p -> 
559                   let dec  = 
560                     (match e with 
561                        `Declaration h 
562                      | `Hypothesis h -> 
563                          let name = 
564                            (match h.Con.dec_name with
565                               None -> "NO NAME???"
566                            | Some n ->n) in
567                          [P.Mspace([None,"width","0.1cm"]);
568                           P.Mi ([],name);
569                           P.Mtext([],":");
570                           (term2pres h.Con.dec_type)]
571                      | _ -> [P.Mtext ([],"???")]) in
572                   dec@p) args [] in
573           let pattern = 
574             P.Mtr ([],[P.Mtd ([],P.Mrow([],
575                P.Mtext([],"Case")::P.Mspace([None,"width","0.1cm"])::name::pattern_aux@
576                 [P.Mspace([None,"width","0.1cm"]);
577                  P.Mtext([],"->")]))]) in
578           let subconcl = 
579             (match p.Con.proof_conclude.Con.conclude_conclusion with
580                None -> P.Mtext([],"No conclusion!!!") 
581              | Some t -> term2pres t) in
582           let asubconcl =
583              P.Mtr([],[P.Mtd([],
584               P.indented (make_concl "the thesis becomes" subconcl))]) in
585           let induction_hypothesis = 
586             (match indhyps with
587               [] -> []
588             | _ -> 
589                let text =
590                  P.Mtr([],[P.Mtd([], P.indented 
591                  (P.Mtext([],"by induction hypothesis we know:")))]) in
592                let make_hyp =
593                  function 
594                    `Hypothesis h ->
595                      let name = 
596                        (match h.Con.dec_name with
597                           None -> "no name"
598                         | Some s -> s) in
599                      P.indented (P.Mrow ([],
600                        [P.Mo([],"(");
601                         P.Mi ([],name);
602                         P.Mo([],")");
603                         P.Mspace([None,"width","0.1cm"]);
604                         term2pres h.Con.dec_type]))
605                    | _ -> assert false in
606                let hyps = 
607                  List.map 
608                    (function ce -> P.Mtr ([], [P.Mtd ([], make_hyp ce)])) 
609                     indhyps in
610                text::hyps) in          
611           (* let acontext = 
612                acontext2pres_old p.Con.proof_apply_context true in *)
613           let body = conclude2pres p.Con.proof_conclude true false in
614           let presacontext = 
615            let acontext_id =
616             match p.Con.proof_apply_context with
617                [] -> p.Con.proof_conclude.Con.conclude_id
618              | {Con.proof_id = id}::_ -> id
619            in
620             P.Maction([None,"actiontype","toggle" ; None,"selection","1"],
621               [P.indented
622                (P.Mtext
623                  ([None,"mathcolor","Red" ;
624                    Some "helm", "xref", acontext_id],"Proof")) ;
625                acontext2pres p.Con.proof_apply_context body true]) in
626           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
627              None,"columnalign","left"],
628              pattern::asubconcl::induction_hypothesis@
629               [P.Mtr([],[P.Mtd([],presacontext)])])
630        | _ -> assert false 
631
632      and falseind conclude =
633        let module P = Mpresentation in
634        let module Con = Content in
635        let proof_conclusion = 
636          (match conclude.Con.conclude_conclusion with
637             None -> P.Mtext([],"No conclusion???")
638           | Some t -> term2pres t) in
639        let case_arg = 
640          (match conclude.Con.conclude_args with
641              [Con.Aux(n);_;case_arg] -> case_arg
642            | _ -> assert false;
643              (* 
644              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
645              assert false *)) in
646        let arg = 
647          (match case_arg with
648              Con.Aux n -> assert false
649            | Con.Premise prem ->
650               (match prem.Con.premise_binder with
651                  None -> [P.Mtext([],"Contradiction, hence")]
652                | Some n -> 
653                   [P.Mi([],n);P.smallskip;P.Mtext([],"is contradictory, hence")])
654            | Con.Lemma lemma -> 
655                [P.Mi([],lemma.Con.lemma_name);P.smallskip;P.Mtext([],"is contradictory, hence")]
656            | _ -> assert false) in
657             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
658        make_row arg proof_conclusion
659
660      and andind conclude =
661        let module P = Mpresentation in
662        let module Con = Content in
663        let proof_conclusion = 
664          (match conclude.Con.conclude_conclusion with
665             None -> P.Mtext([],"No conclusion???")
666           | Some t -> term2pres t) in
667        let proof,case_arg = 
668          (match conclude.Con.conclude_args with
669              [Con.Aux(n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
670            | _ -> assert false;
671              (* 
672              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
673              assert false *)) in
674        let arg = 
675          (match case_arg with
676              Con.Aux n -> assert false
677            | Con.Premise prem ->
678               (match prem.Con.premise_binder with
679                  None -> []
680                | Some n -> [P.Mtext([],"by");P.smallskip;P.Mi([],n)])
681            | Con.Lemma lemma -> 
682                [P.Mtext([],"by");P.smallskip;P.Mi([],lemma.Con.lemma_name)]
683            | _ -> assert false) in
684        match proof.Con.proof_context with
685          `Hypothesis hyp1::`Hypothesis hyp2::tl ->
686             let get_name hyp =
687               (match hyp.Con.dec_name with
688                 None -> "_"
689               | Some s -> s) in
690             let preshyp1 = 
691               P.Mrow ([],
692                [P.Mtext([],"(");
693                 P.Mi([],get_name hyp1);
694                 P.Mtext([],")");
695                 P.smallskip;
696                 term2pres hyp1.Con.dec_type]) in
697             let preshyp2 = 
698               P.Mrow ([],
699                [P.Mtext([],"(");
700                 P.Mi([],get_name hyp2);
701                 P.Mtext([],")");
702                 P.smallskip;
703                 term2pres hyp2.Con.dec_type]) in
704             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
705             let body = conclude2pres proof.Con.proof_conclude false true in
706             let presacontext = 
707               acontext2pres proof.Con.proof_apply_context body false in
708             P.Mtable 
709               ([None,"align","baseline 1"; None,"equalrows","false"; 
710                 None,"columnalign","left"],
711                [P.Mtr ([],[P.Mtd ([],
712                  P.Mrow([],arg@[P.smallskip;P.Mtext([],"we have")]))]);
713                 P.Mtr ([],[P.Mtd ([],preshyp1)]);
714                 P.Mtr ([],[P.Mtd ([],P.Mtext([],"and"))]);
715                 P.Mtr ([],[P.Mtd ([],preshyp2)]);
716                 P.Mtr ([],[P.Mtd ([],presacontext)])]);
717          | _ -> assert false
718
719      and exists conclude =
720        let module P = Mpresentation in
721        let module Con = Content in
722        let proof_conclusion = 
723          (match conclude.Con.conclude_conclusion with
724             None -> P.Mtext([],"No conclusion???")
725           | Some t -> term2pres t) in
726        let proof = 
727          (match conclude.Con.conclude_args with
728              [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
729            | _ -> assert false;
730              (* 
731              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
732              assert false *)) in
733        match proof.Con.proof_context with
734            `Declaration decl::`Hypothesis hyp::tl
735          | `Hypothesis decl::`Hypothesis hyp::tl ->
736            let get_name decl =
737              (match decl.Con.dec_name with
738                 None -> "_"
739               | Some s -> s) in
740            let presdecl = 
741              P.Mrow ([],
742                [P.Mtext([None,"mathcolor","Red"],"let");
743                 P.smallskip;
744                 P.Mi([],get_name decl);
745                 P.Mtext([],":"); term2pres decl.Con.dec_type]) in
746            let suchthat =
747              P.Mrow ([],
748                [P.Mtext([None,"mathcolor","Red"],"such that");
749                 P.smallskip;
750                 P.Mtext([],"(");
751                 P.Mi([],get_name hyp);
752                 P.Mtext([],")");
753                 P.smallskip;
754                 term2pres hyp.Con.dec_type]) in
755             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
756             let body = conclude2pres proof.Con.proof_conclude false true in
757             let presacontext = 
758               acontext2pres proof.Con.proof_apply_context body false in
759             P.Mtable 
760               ([None,"align","baseline 1"; None,"equalrows","false"; 
761                 None,"columnalign","left"],
762                [P.Mtr ([],[P.Mtd ([],presdecl)]);
763                 P.Mtr ([],[P.Mtd ([],suchthat)]);
764                 P.Mtr ([],[P.Mtd ([],presacontext)])]);
765          | _ -> assert false in
766
767 proof2pres p
768 ;;
769
770 exception ToDo;;
771
772 let content2pres term2pres (id,params,metasenv,obj) =
773  let module K = Content in
774  let module P = Mpresentation in
775   match obj with
776      `Def (K.Const,thesis,`Proof p) ->
777        P.Mtable
778         [None,"align","baseline 1";
779          None,"equalrows","false";
780          None,"columnalign","left";
781          None,"helm:xref","id"]
782         ([P.Mtr []
783            [P.Mtd []
784             (P.Mrow []
785              [P.Mtext []
786                ("UNFINISHED PROOF" ^ id ^"(" ^
787                  String.concat " ; " (List.map UriManager.string_of_uri params)^
788                 ")")])] ;
789          P.Mtr []
790           [P.Mtd []
791             (P.Mrow []
792               [P.Mtext [] "THESIS:"])] ;
793          P.Mtr []
794           [P.Mtd []
795             (P.Mrow []
796               [P.Mphantom []
797                 (P.Mtext [] "__") ;
798               term2pres thesis])]] @
799          (match metasenv with
800              None -> []
801            | Some metasenv' ->
802               [P.Mtr []
803                 [P.Mtd []
804                   (* Conjectures are in their own table to make *)
805                   (* diffing the DOM trees easier.              *)
806                   (P.Mtable
807                     [None,"align","baseline 1";
808                      None,"equalrows","false";
809                      None,"columnalign","left"]
810                    ((P.Mtr []
811                       [P.Mtd []
812                        (P.Mrow []
813                          [P.Mtext [] "CONJECTURES:"])])::
814                     List.map
815                      (function
816                        (id,n,context,ty) ->
817                          P.Mtr []
818                           [P.Mtd []
819                            (P.Mrow [Some "helm", "xref", id]
820                              (List.map
821                                (function
822                                    None ->
823                                      P.Mrow []
824                                       [ P.Mi [] "_" ;
825                                         P.Mo [] ":?" ;
826                                         P.Mi [] "_"]
827                                  | Some (`Declaration d)
828                                  | Some (`Hypothesis d) ->
829                                     let
830                                      { K.dec_name = dec_name ;
831                                        K.dec_type = ty } = d
832                                      in
833                                       P.Mrow []
834                                        [ P.Mi []
835                                           (match dec_name with
836                                               None -> "_"
837                                             | Some n -> n) ;
838                                          P.Mo [] ":" ;
839                                          term2pres ty]
840                                  | Some (`Definition d) ->
841                                     let
842                                      { K.def_name = def_name ;
843                                        K.def_term = bo } = d
844                                      in
845                                       P.Mrow []
846                                        [ P.Mi []
847                                           (match def_name with
848                                               None -> "_"
849                                             | Some n -> n) ;
850                                          P.Mo [] ":=" ;
851                                          term2pres bo]
852                                  | Some (`Proof p) ->
853                                     let proof_name = p.K.proof_name in
854                                      P.Mrow []
855                                       [ P.Mi []
856                                          (match proof_name with
857                                              None -> "_"
858                                            | Some n -> n) ;
859                                         P.Mo [] ":=" ;
860                                         proof2pres term2pres p]
861                                ) (List.rev context) @
862                              [ P.Mo [] "|-" ] @
863                              [ P.Mi [] (string_of_int n) ;
864                                P.Mo [] ":" ;
865                                term2pres ty ]
866                            ))
867                           ]
868                      ) metasenv'
869                   ))]]
870          )  @
871         [P.Mtr []
872           [P.Mtd []
873             (P.Mrow []
874               [proof2pres term2pres p])]])
875    | _ -> raise ToDo
876 ;;
877
878 let content2pres ~ids_to_inner_sorts =
879  content2pres 
880   (function p -> 
881    (Cexpr2pres.cexpr2pres_charcount 
882     (Content_expressions.acic2cexpr ids_to_inner_sorts p)))
883 ;;