]> matita.cs.unibo.it Git - helm.git/blob - helm/ocaml/cic_transformations/content2pres.ml
"proof of X" closed mactions were not selectable
[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             P.Maction([None,"actiontype","toggle" ; None,"selection","1"],
616               [P.indented
617                (P.Mtext
618                  ([None,"mathcolor","Red" ;
619                    Some "helm", "xref", p.Con.proof_id],"Proof")) ;
620                acontext2pres p.Con.proof_apply_context body true]) in
621           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
622              None,"columnalign","left"],
623              pattern::asubconcl::induction_hypothesis@
624               [P.Mtr([],[P.Mtd([],presacontext)])])
625        | _ -> assert false 
626
627      and falseind conclude =
628        let module P = Mpresentation in
629        let module Con = Content in
630        let proof_conclusion = 
631          (match conclude.Con.conclude_conclusion with
632             None -> P.Mtext([],"No conclusion???")
633           | Some t -> term2pres t) in
634        let case_arg = 
635          (match conclude.Con.conclude_args with
636              [Con.Aux(n);_;case_arg] -> case_arg
637            | _ -> assert false;
638              (* 
639              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
640              assert false *)) in
641        let arg = 
642          (match case_arg with
643              Con.Aux n -> assert false
644            | Con.Premise prem ->
645               (match prem.Con.premise_binder with
646                  None -> [P.Mtext([],"Contradiction, hence")]
647                | Some n -> 
648                   [P.Mi([],n);P.smallskip;P.Mtext([],"is contradictory, hence")])
649            | Con.Lemma lemma -> 
650                [P.Mi([],lemma.Con.lemma_name);P.smallskip;P.Mtext([],"is contradictory, hence")]
651            | _ -> assert false) in
652             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
653        make_row arg proof_conclusion
654
655      and andind conclude =
656        let module P = Mpresentation in
657        let module Con = Content in
658        let proof_conclusion = 
659          (match conclude.Con.conclude_conclusion with
660             None -> P.Mtext([],"No conclusion???")
661           | Some t -> term2pres t) in
662        let proof,case_arg = 
663          (match conclude.Con.conclude_args with
664              [Con.Aux(n);_;Con.ArgProof proof;case_arg] -> proof,case_arg
665            | _ -> assert false;
666              (* 
667              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
668              assert false *)) in
669        let arg = 
670          (match case_arg with
671              Con.Aux n -> assert false
672            | Con.Premise prem ->
673               (match prem.Con.premise_binder with
674                  None -> []
675                | Some n -> [P.Mtext([],"by");P.smallskip;P.Mi([],n)])
676            | Con.Lemma lemma -> 
677                [P.Mtext([],"by");P.smallskip;P.Mi([],lemma.Con.lemma_name)]
678            | _ -> assert false) in
679        match proof.Con.proof_context with
680          `Hypothesis hyp1::`Hypothesis hyp2::tl ->
681             let get_name hyp =
682               (match hyp.Con.dec_name with
683                 None -> "_"
684               | Some s -> s) in
685             let preshyp1 = 
686               P.Mrow ([],
687                [P.Mtext([],"(");
688                 P.Mi([],get_name hyp1);
689                 P.Mtext([],")");
690                 P.smallskip;
691                 term2pres hyp1.Con.dec_type]) in
692             let preshyp2 = 
693               P.Mrow ([],
694                [P.Mtext([],"(");
695                 P.Mi([],get_name hyp2);
696                 P.Mtext([],")");
697                 P.smallskip;
698                 term2pres hyp2.Con.dec_type]) in
699             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
700             let body = conclude2pres proof.Con.proof_conclude false true in
701             let presacontext = 
702               acontext2pres proof.Con.proof_apply_context body false in
703             P.Mtable 
704               ([None,"align","baseline 1"; None,"equalrows","false"; 
705                 None,"columnalign","left"],
706                [P.Mtr ([],[P.Mtd ([],
707                  P.Mrow([],arg@[P.smallskip;P.Mtext([],"we have")]))]);
708                 P.Mtr ([],[P.Mtd ([],preshyp1)]);
709                 P.Mtr ([],[P.Mtd ([],P.Mtext([],"and"))]);
710                 P.Mtr ([],[P.Mtd ([],preshyp2)]);
711                 P.Mtr ([],[P.Mtd ([],presacontext)])]);
712          | _ -> assert false
713
714      and exists conclude =
715        let module P = Mpresentation in
716        let module Con = Content in
717        let proof_conclusion = 
718          (match conclude.Con.conclude_conclusion with
719             None -> P.Mtext([],"No conclusion???")
720           | Some t -> term2pres t) in
721        let proof = 
722          (match conclude.Con.conclude_args with
723              [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
724            | _ -> assert false;
725              (* 
726              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
727              assert false *)) in
728        match proof.Con.proof_context with
729            `Declaration decl::`Hypothesis hyp::tl
730          | `Hypothesis decl::`Hypothesis hyp::tl ->
731            let get_name decl =
732              (match decl.Con.dec_name with
733                 None -> "_"
734               | Some s -> s) in
735            let presdecl = 
736              P.Mrow ([],
737                [P.Mtext([None,"mathcolor","Red"],"let");
738                 P.smallskip;
739                 P.Mi([],get_name decl);
740                 P.Mtext([],":"); term2pres decl.Con.dec_type]) in
741            let suchthat =
742              P.Mrow ([],
743                [P.Mtext([None,"mathcolor","Red"],"such that");
744                 P.smallskip;
745                 P.Mtext([],"(");
746                 P.Mi([],get_name hyp);
747                 P.Mtext([],")");
748                 P.smallskip;
749                 term2pres hyp.Con.dec_type]) in
750             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
751             let body = conclude2pres proof.Con.proof_conclude false true in
752             let presacontext = 
753               acontext2pres proof.Con.proof_apply_context body false in
754             P.Mtable 
755               ([None,"align","baseline 1"; None,"equalrows","false"; 
756                 None,"columnalign","left"],
757                [P.Mtr ([],[P.Mtd ([],presdecl)]);
758                 P.Mtr ([],[P.Mtd ([],suchthat)]);
759                 P.Mtr ([],[P.Mtd ([],presacontext)])]);
760          | _ -> assert false in
761
762 proof2pres p
763 ;;
764
765 exception ToDo;;
766
767 let content2pres term2pres (id,params,metasenv,obj) =
768  let module K = Content in
769  let module P = Mpresentation in
770   match obj with
771      `Def (K.Const,thesis,`Proof p) ->
772        P.Mtable
773         [None,"align","baseline 1";
774          None,"equalrows","false";
775          None,"columnalign","left";
776          None,"helm:xref","id"]
777         ([P.Mtr []
778            [P.Mtd []
779             (P.Mrow []
780              [P.Mtext []
781                ("UNFINISHED PROOF" ^ id ^"(" ^
782                  String.concat " ; " (List.map UriManager.string_of_uri params)^
783                 ")")])] ;
784          P.Mtr []
785           [P.Mtd []
786             (P.Mrow []
787               [P.Mtext [] "THESIS:"])] ;
788          P.Mtr []
789           [P.Mtd []
790             (P.Mrow []
791               [P.Mphantom []
792                 (P.Mtext [] "__") ;
793               term2pres thesis])]] @
794          (match metasenv with
795              None -> []
796            | Some metasenv' ->
797               [P.Mtr []
798                 [P.Mtd []
799                   (* Conjectures are in their own table to make *)
800                   (* diffing the DOM trees easier.              *)
801                   (P.Mtable
802                     [None,"align","baseline 1";
803                      None,"equalrows","false";
804                      None,"columnalign","left"]
805                    ((P.Mtr []
806                       [P.Mtd []
807                        (P.Mrow []
808                          [P.Mtext [] "CONJECTURES:"])])::
809                     List.map
810                      (function
811                        (id,n,context,ty) ->
812                          P.Mtr []
813                           [P.Mtd []
814                            (P.Mrow [Some "helm", "xref", id]
815                              (List.map
816                                (function
817                                    None ->
818                                      P.Mrow []
819                                       [ P.Mi [] "_" ;
820                                         P.Mo [] ":?" ;
821                                         P.Mi [] "_"]
822                                  | Some (`Declaration d)
823                                  | Some (`Hypothesis d) ->
824                                     let
825                                      { K.dec_name = dec_name ;
826                                        K.dec_type = ty } = d
827                                      in
828                                       P.Mrow []
829                                        [ P.Mi []
830                                           (match dec_name with
831                                               None -> "_"
832                                             | Some n -> n) ;
833                                          P.Mo [] ":" ;
834                                          term2pres ty]
835                                  | Some (`Definition d) ->
836                                     let
837                                      { K.def_name = def_name ;
838                                        K.def_term = bo } = d
839                                      in
840                                       P.Mrow []
841                                        [ P.Mi []
842                                           (match def_name with
843                                               None -> "_"
844                                             | Some n -> n) ;
845                                          P.Mo [] ":=" ;
846                                          term2pres bo]
847                                  | Some (`Proof p) ->
848                                     let proof_name = p.K.proof_name in
849                                      P.Mrow []
850                                       [ P.Mi []
851                                          (match proof_name with
852                                              None -> "_"
853                                            | Some n -> n) ;
854                                         P.Mo [] ":=" ;
855                                         proof2pres term2pres p]
856                                ) (List.rev context) @
857                              [ P.Mo [] "|-" ] @
858                              [ P.Mi [] (string_of_int n) ;
859                                P.Mo [] ":" ;
860                                term2pres ty ]
861                            ))
862                           ]
863                      ) metasenv'
864                   ))]]
865          )  @
866         [P.Mtr []
867           [P.Mtd []
868             (P.Mrow []
869               [proof2pres term2pres p])]])
870    | _ -> raise ToDo
871 ;;
872
873 let content2pres ~ids_to_inner_sorts =
874  content2pres 
875   (function p -> 
876    (Cexpr2pres.cexpr2pres_charcount 
877     (Content_expressions.acic2cexpr ids_to_inner_sorts p)))
878 ;;