]> matita.cs.unibo.it Git - helm.git/blob - helm/ocaml/cic_transformations/content2pres.ml
Added Method "exists".
[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 rec make_arg_for_apply is_first arg row = 
161    (match arg with 
162       Con.Aux n -> assert false
163     | Con.Premise prem -> 
164         let name = 
165           (match prem.Con.premise_binder with
166              None -> "previous"
167            | Some s -> s) in
168         P.smallskip::P.Mi([],name)::row
169     | Con.Lemma lemma -> 
170          P.smallskip::P.Mi([],lemma.Con.lemma_name)::row 
171     | Con.Term t -> 
172         if is_first then
173           (term2pres t)::row
174         else P.smallskip::P.Mi([],"_")::row
175     | Con.ArgProof _ 
176     | Con.ArgMethod _ -> 
177        P.smallskip::P.Mi([],"_")::row) in
178  match args with 
179    hd::tl -> 
180      make_arg_for_apply true hd 
181        (List.fold_right (make_arg_for_apply false) tl [])
182  | _ -> assert false;;
183
184 let rec justification term2pres p = 
185   let module Con = Content in
186   let module P = Mpresentation in
187   if ((p.Con.proof_conclude.Con.conclude_method = "Exact") or
188      ((p.Con.proof_context = []) &
189       (p.Con.proof_apply_context = []) &
190       (p.Con.proof_conclude.Con.conclude_method = "Apply"))) then
191     let pres_args = 
192       make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args in
193     P.Mrow([],
194       P.Mtext([None,"mathcolor","Red"],"by")::P.Mspace([None,"width","0.1cm"])::
195       P.Mo([],"(")::pres_args@[P.Mo([],")")]) 
196   else proof2pres term2pres p 
197      
198 and proof2pres term2pres p =
199   let rec proof2pres p =
200     let module Con = Content in
201     let module P = Mpresentation in
202       let indent = 
203         let is_decl e = 
204           (match e with 
205              `Declaration _
206            | `Hypothesis _ -> true
207            | _ -> false) in
208         ((List.filter is_decl p.Con.proof_context) != []) in 
209       let omit_conclusion = (not indent) && (p.Con.proof_context != []) in
210       let concl = 
211         (match p.Con.proof_conclude.Con.conclude_conclusion with
212            None -> None
213          | Some t -> Some (term2pres t)) in
214       let body =
215           let presconclude = 
216             conclude2pres p.Con.proof_conclude indent omit_conclusion in
217           let presacontext = 
218             acontext2pres p.Con.proof_apply_context presconclude indent in
219           context2pres p.Con.proof_context presacontext in
220       match p.Con.proof_name with
221         None -> body
222       | Some name ->
223           let action = 
224            match concl with
225               None -> body
226 (*
227                P.Maction
228                  ([None,"actiontype","toggle" ; None,"selection","1"],
229                   [P.Mtext [] "proof" ; body])
230 *)
231             | Some ac ->
232                P.Maction
233                  ([None,"actiontype","toggle" ; None,"selection","1"],
234                   [(make_concl "proof of" ac); body])
235           in
236           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
237               None,"columnalign","left"],
238             [P.Mtr ([],[P.Mtd ([],P.Mfenced([],[P.Mtext ([],name)]))]);
239              P.Mtr ([],[P.Mtd ([], P.indented action)])])
240 (*
241           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
242               None,"columnalign","left";Some "helm", "xref", p.Con.proof_id],
243             [P.Mtr ([],[P.Mtd ([],P.Mfenced([],[P.Mtext ([],name)]))]);
244              P.Mtr ([],[P.Mtd ([], P.indented action)])]) *)
245
246   and context2pres c continuation =
247     (* we generate a subtable for each context element, for selection
248        purposes 
249        The table generated by the head-element does not have an xref;
250        the whole context-proof is already selectable *)
251     let module P = Mpresentation in
252     match c with
253       [] -> continuation
254     | hd::tl -> 
255         let continuation' =
256           List.fold_right
257             (fun ce continuation ->
258               let xref = get_xref ce in
259               P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
260                None,"columnalign","left"; Some "helm", "xref", xref ],
261                 [P.Mtr([Some "helm", "xref", "ce_"^xref],[P.Mtd ([],ce2pres ce)]);
262                  P.Mtr([],[P.Mtd ([], continuation)])])) tl continuation in
263          let hd_xref= get_xref hd in
264          P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
265            None,"columnalign","left"],
266              [P.Mtr([Some "helm", "xref", "ce_"^hd_xref],
267                [P.Mtd ([],ce2pres hd)]);
268              P.Mtr([],[P.Mtd ([], continuation')])])
269          
270   and ce2pres =
271     let module P = Mpresentation in
272     let module Con = Content in
273       function
274         `Declaration d -> 
275           (match d.Con.dec_name with
276               Some s ->
277                 let ty = term2pres d.Con.dec_type in
278                 P.Mrow ([],
279                   [P.Mtext([None,"mathcolor","Red"],"Assume");
280                    P.Mspace([None,"width","0.1cm"]);
281                    P.Mi([],s);
282                    P.Mtext([],":");
283                    ty])
284             | None -> 
285                 prerr_endline "NO NAME!!"; assert false)
286       | `Hypothesis h ->
287           (match h.Con.dec_name with
288               Some s ->
289                 let ty = term2pres h.Con.dec_type in
290                 P.Mrow ([],
291                   [P.Mtext([None,"mathcolor","Red"],"Suppose");
292                    P.Mspace([None,"width","0.1cm"]);
293                    P.Mtext([],"(");
294                    P.Mi ([],s);
295                    P.Mtext([],")");
296                    P.Mspace([None,"width","0.1cm"]);
297                    ty])
298             | None -> 
299                 prerr_endline "NO NAME!!"; assert false) 
300       | `Proof p -> 
301            (match  p.Con.proof_name with
302               Some "w" -> prerr_endline ("processing w");
303             | _ -> ());
304            proof2pres p 
305       | `Definition d -> 
306            (match d.Con.def_name with
307               Some s ->
308                 let term = term2pres d.Con.def_term in
309                 P.Mrow ([],
310                   [P.Mtext([],"Let ");
311                    P.Mi([],s);
312                    P.Mtext([]," = ");
313                    term])
314             | None -> 
315                 prerr_endline "NO NAME!!"; assert false) 
316       | `Joint ho -> 
317             P.Mtext ([],"jointdef")
318
319   and acontext2pres ac continuation indent =
320     let module Con = Content in
321     let module P = Mpresentation in
322     List.fold_right
323       (fun p continuation ->
324          let hd = 
325            if indent then
326              P.indented (proof2pres p)
327            else 
328              proof2pres p in
329          P.Mtable([None,"align","baseline 1"; None,"equalrows","false";
330           None,"columnalign","left"; Some "helm","xref",p.Con.proof_id],
331            [P.Mtr([Some "helm","xref","ace_"^p.Con.proof_id],[P.Mtd ([],hd)]);
332             P.Mtr([],[P.Mtd ([], continuation)])])) ac continuation 
333
334   and conclude2pres conclude indent omit_conclusion =
335     let module Con = Content in
336     let module P = Mpresentation in
337     let tconclude_body = 
338       match conclude.Con.conclude_conclusion with
339         Some t when not omit_conclusion ->
340           let concl = (term2pres t) in 
341           if conclude.Con.conclude_method = "BU_Conversion" then
342             make_concl "that is equivalent to" concl
343           else  
344             let conclude_body = conclude_aux conclude in
345             let ann_concl = make_concl "we conclude" concl in
346             P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
347               None,"columnalign","left"],
348                 [P.Mtr ([],[P.Mtd ([],conclude_body)]);
349                  P.Mtr ([],[P.Mtd ([],ann_concl)])])
350       | _ -> conclude_aux conclude in
351     if indent then 
352       P.indented (P.Mrow ([Some "helm", "xref", conclude.Con.conclude_id],
353                     [tconclude_body]))
354     else 
355       P.Mrow ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
356
357
358   and conclude_aux conclude =
359     let module Con = Content in
360     let module P = Mpresentation in
361     if conclude.Con.conclude_method = "TD_Conversion" then
362       let expected = 
363         (match conclude.Con.conclude_conclusion with 
364            None -> P.Mtext([],"NO EXPECTED!!!")
365          | Some c -> term2pres c) in
366       let subproof = 
367         (match conclude.Con.conclude_args with
368           [Con.ArgProof p] -> p
369          | _ -> assert false) in
370       let synth = 
371         (match subproof.Con.proof_conclude.Con.conclude_conclusion with
372            None -> P.Mtext([],"NO SYNTH!!!")
373          | Some c -> (term2pres c)) in
374       P.Mtable 
375         ([None,"align","baseline 1"; None,"equalrows","false"; None,"columnalign","left"],
376         [P.Mtr([],[P.Mtd([],make_concl "we must prove" expected)]);
377          P.Mtr([],[P.Mtd([],make_concl "or equivalently" synth)]);
378          P.Mtr([],[P.Mtd([],proof2pres subproof)])])
379     else if conclude.Con.conclude_method = "BU_Conversion" then
380       assert false
381     else if conclude.Con.conclude_method = "Exact" then
382       let arg = 
383         (match conclude.Con.conclude_args with 
384            [Con.Term t] -> term2pres t
385          | _ -> assert false) in
386       (match conclude.Con.conclude_conclusion with 
387          None ->
388           P.Mrow []
389            [P.Mtext [None, "mathcolor", "red"] "Consider" ; P.smallskip; arg]
390        | Some c -> let conclusion = term2pres c in
391           make_row 
392             [arg; P.Mspace([None,"width","0.1cm"]);P.Mtext([],"proves")]
393             conclusion
394        )
395     else if conclude.Con.conclude_method = "Intros+LetTac" then
396       (match conclude.Con.conclude_args with
397          [Con.ArgProof p] -> proof2pres p
398        | _ -> assert false)
399 (* OLD CODE 
400       let conclusion = 
401       (match conclude.Con.conclude_conclusion with 
402          None -> P.Mtext([],"NO Conclusion!!!")
403        | Some c -> term2pres c) in
404       (match conclude.Con.conclude_args with
405          [Con.ArgProof p] -> 
406            P.Mtable 
407             ([None,"align","baseline 1"; None,"equalrows","false";
408               None,"columnalign","left"],
409               [P.Mtr([],[P.Mtd([],proof2pres p)]);
410                P.Mtr([],[P.Mtd([],
411                 (make_concl "we proved 1" conclusion))])]);
412        | _ -> assert false)
413 *)
414     else if (conclude.Con.conclude_method = "ByInduction") then
415       byinduction conclude
416     else if (conclude.Con.conclude_method = "Exists") then
417       exists conclude
418     else if (conclude.Con.conclude_method = "Rewrite") then
419       let justif = 
420         (match (List.nth conclude.Con.conclude_args 6) with
421            Con.ArgProof p -> justification term2pres p
422          | _ -> assert false) in
423       let term1 = 
424         (match List.nth conclude.Con.conclude_args 2 with
425            Con.Term t -> term2pres t
426          | _ -> assert false) in 
427       let term2 = 
428         (match List.nth conclude.Con.conclude_args 5 with
429            Con.Term t -> term2pres t
430          | _ -> assert false) in
431       P.Mtable ([None,"align","baseline 1";None,"equalrows","false";
432         None,"columnalign","left"], 
433          [P.Mtr ([],[P.Mtd ([],P.Mrow([],[
434           P.Mtext([None,"mathcolor","Red"],"rewrite");
435           P.Mspace([None,"width","0.1cm"]);term1;
436           P.Mspace([None,"width","0.1cm"]);
437           P.Mtext([None,"mathcolor","Red"],"with");
438           P.Mspace([None,"width","0.1cm"]);term2]))]);
439           P.Mtr ([],[P.Mtd ([],P.indented justif)])]);
440 (* OLD CODE   
441       let conclusion = 
442         (match conclude.Con.conclude_conclusion with 
443            None -> P.Mtext([],"NO Conclusion!!!")
444          | Some c -> term2pres c) in
445       P.Mtable ([None,"align","baseline 1";None,"equalrows","false";
446             None,"columnalign","left"],
447              [P.Mtr ([],[P.Mtd ([],P.Mrow([],[
448                P.Mtext([None,"mathcolor","Red"],"rewrite");
449                P.Mspace([None,"width","0.1cm"]);term1;
450                P.Mspace([None,"width","0.1cm"]);
451                P.Mtext([None,"mathcolor","Red"],"with");
452                P.Mspace([None,"width","0.1cm"]);term2]))]);
453               P.Mtr ([],[P.Mtd ([],P.indented justif)]);
454               P.Mtr ([],[P.Mtd ([],make_concl "we proved 2" conclusion)])]) *)
455     else if conclude.Con.conclude_method = "Apply" then
456       let pres_args = 
457         make_args_for_apply term2pres conclude.Con.conclude_args in
458       P.Mrow([],
459         P.Mtext([None,"mathcolor","Red"],"by")::
460         P.Mspace([None,"width","0.1cm"])::
461         P.Mo([],"(")::pres_args@[P.Mo([],")")])
462 (* OLD CODE 
463       let by = 
464          P.Mrow([],
465            P.Mtext([None,"mathcolor","Red"],"by")::P.Mspace([None,"width","0.1cm"])::
466            P.Mo([],"(")::pres_args@[P.Mo([],")")]) in 
467       match conclude.Con.conclude_conclusion with
468         None -> P.Mrow([],[P.Mtext([],"QUA");by])
469       | Some t ->
470          let concl = (term2pres t) in
471          let ann_concl = make_concl "we proved 3" concl in
472          P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
473             None,"columnalign","left"; 
474             Some "helm", "xref", conclude.Con.conclude_id],
475              [P.Mtr ([],[P.Mtd ([],by)]);
476               P.Mtr ([],[P.Mtd ([],ann_concl)])]) *)
477     else 
478       P.Mtable 
479         ([None,"align","baseline 1"; None,"equalrows","false"; None,"columnalign","left"],
480          [P.Mtr ([],[P.Mtd ([],P.Mtext([],"Apply method" ^ conclude.Con.conclude_method ^ " to"))]);
481           P.Mtr ([],
482            [P.Mtd ([], 
483              (P.indented 
484                (P.Mtable 
485                  ([None,"align","baseline 1"; None,"equalrows","false";
486                    None,"columnalign","left"],
487                   args2pres conclude.Con.conclude_args))))])]) 
488 (* OLD CODE 
489      match conclude.Con.conclude_conclusion with
490        None -> body
491      | Some t ->
492          let concl = (term2pres t) in
493          let ann_concl = make_concl "we proved 4" concl in
494          P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
495             None,"columnalign","left"],
496              [P.Mtr ([],[P.Mtd ([],body)]);
497               P.Mtr ([],[P.Mtd ([],ann_concl)])]) *)
498
499   and args2pres l =
500     let module P = Mpresentation in
501     List.map 
502      (function a -> P.Mtr ([], [P.Mtd ([], arg2pres a)])) l
503
504   and arg2pres =
505     let module P = Mpresentation in
506     let module Con = Content in
507     function
508         Con.Aux n -> 
509           P.Mtext ([],"aux " ^ n)
510       | Con.Premise prem -> 
511           P.Mtext ([],"premise")
512       | Con.Lemma lemma ->
513           P.Mtext ([],"lemma")
514       | Con.Term t -> 
515           term2pres t
516       | Con.ArgProof p ->
517         proof2pres p 
518       | Con.ArgMethod s -> 
519          P.Mtext ([],"method") 
520  
521    and byinduction conclude =
522      let module P = Mpresentation in
523      let module Con = Content in
524      let proof_conclusion = 
525        (match conclude.Con.conclude_conclusion with
526           None -> P.Mtext([],"No conclusion???")
527         | Some t -> term2pres t) in
528      let inductive_arg,args_for_cases = 
529        (match conclude.Con.conclude_args with
530            Con.Aux(n)::_::tl ->
531              let l1,l2 = split (int_of_string n) tl in
532              let last_pos = (List.length l2)-1 in
533              List.nth l2 last_pos,l1
534          | _ -> assert false) in
535      let induction_on =
536        let arg = 
537          (match inductive_arg with
538             Con.Aux n -> 
539               P.Mtext ([],"an aux???")
540            | Con.Premise prem ->
541               (match prem.Con.premise_binder with
542                  None -> P.Mtext ([],"the previous result")
543                | Some n -> P.Mi([],n))
544            | Con.Lemma lemma -> P.Mi([],lemma.Con.lemma_name)
545            | Con.Term t -> 
546                term2pres t
547            | Con.ArgProof p ->
548                P.Mtext ([],"a proof???")
549            | Con.ArgMethod s -> 
550                P.Mtext ([],"a method???")) in
551         (make_concl "we proceede by induction on" arg) in
552      let to_prove =
553         (make_concl "to prove" proof_conclusion) in
554      P.Mtable 
555        ([None,"align","baseline 1"; None,"equalrows","false"; 
556          None,"columnalign","left"],
557           P.Mtr ([],[P.Mtd ([],induction_on)])::
558           P.Mtr ([],[P.Mtd ([],to_prove)])::
559           (make_cases args_for_cases))
560
561     and make_cases args_for_cases =
562     let module P = Mpresentation in
563     List.map 
564       (fun p -> P.Mtr ([],[P.Mtd ([],make_case p)])) args_for_cases
565
566     and make_case =  
567       let module P = Mpresentation in
568       let module Con = Content in
569       function 
570         Con.ArgProof p ->
571           let name =
572             (match p.Con.proof_name with
573                None -> P.Mtext([],"no name for case!!")
574              | Some n -> P.Mi([],n)) in
575           let indhyps,args =
576              List.partition 
577                (function
578                    `Hypothesis h -> h.Con.dec_inductive
579                  | _ -> false) p.Con.proof_context in
580           let pattern_aux =
581              List.fold_right
582                (fun e p -> 
583                   let dec  = 
584                     (match e with 
585                        `Declaration h 
586                      | `Hypothesis h -> 
587                          let name = 
588                            (match h.Con.dec_name with
589                               None -> "NO NAME???"
590                            | Some n ->n) in
591                          [P.Mspace([None,"width","0.1cm"]);
592                           P.Mi ([],name);
593                           P.Mtext([],":");
594                           (term2pres h.Con.dec_type)]
595                      | _ -> [P.Mtext ([],"???")]) in
596                   dec@p) args [] in
597           let pattern = 
598             P.Mtr ([],[P.Mtd ([],P.Mrow([],
599                P.Mtext([],"Case")::P.Mspace([None,"width","0.1cm"])::name::pattern_aux@
600                 [P.Mspace([None,"width","0.1cm"]);
601                  P.Mtext([],"->")]))]) in
602           let subconcl = 
603             (match p.Con.proof_conclude.Con.conclude_conclusion with
604                None -> P.Mtext([],"No conclusion!!!") 
605              | Some t -> term2pres t) in
606           let asubconcl =
607              P.Mtr([],[P.Mtd([],
608               P.indented (make_concl "the thesis becomes" subconcl))]) in
609           let induction_hypothesis = 
610             (match indhyps with
611               [] -> []
612             | _ -> 
613                let text =
614                  P.Mtr([],[P.Mtd([], P.indented 
615                  (P.Mtext([],"by induction hypothesis we know:")))]) in
616                let make_hyp =
617                  function 
618                    `Hypothesis h ->
619                      let name = 
620                        (match h.Con.dec_name with
621                           None -> "no name"
622                         | Some s -> s) in
623                      P.indented (P.Mrow ([],
624                        [P.Mtext([],"(");
625                         P.Mi ([],name);
626                         P.Mtext([],")");
627                         P.Mspace([None,"width","0.1cm"]);
628                         term2pres h.Con.dec_type]))
629                    | _ -> assert false in
630                let hyps = 
631                  List.map 
632                    (function ce -> P.Mtr ([], [P.Mtd ([], make_hyp ce)])) 
633                     indhyps in
634                text::hyps) in          
635           (* let acontext = 
636                acontext2pres_old p.Con.proof_apply_context true in *)
637           let body = conclude2pres p.Con.proof_conclude true false in
638           let presacontext = 
639             P.Maction([None,"actiontype","toggle" ; None,"selection","1"],
640               [P.indented (P.Mtext([None,"mathcolor","Red"],"Proof"));
641                acontext2pres p.Con.proof_apply_context body true]) in
642           P.Mtable ([None,"align","baseline 1"; None,"equalrows","false";
643              None,"columnalign","left"],
644              pattern::asubconcl::induction_hypothesis@
645               [P.Mtr([],[P.Mtd([],presacontext)])])
646        | _ -> assert false 
647
648      and exists conclude =
649        let module P = Mpresentation in
650        let module Con = Content in
651        let proof_conclusion = 
652          (match conclude.Con.conclude_conclusion with
653             None -> P.Mtext([],"No conclusion???")
654           | Some t -> term2pres t) in
655        let proof = 
656          (match conclude.Con.conclude_args with
657              [Con.Aux(n);_;Con.ArgProof proof;_] -> proof
658            | _ -> assert false;
659              (* 
660              List.map (ContentPp.parg 0) conclude.Con.conclude_args;
661              assert false *)) in
662        match proof.Con.proof_context with
663            `Declaration decl::`Hypothesis hyp::tl
664          | `Hypothesis decl::`Hypothesis hyp::tl ->
665            let get_name decl =
666              (match decl.Con.dec_name with
667                 None -> "_"
668               | Some s -> s) in
669            let presdecl = 
670              P.Mrow ([],
671                [P.Mtext([None,"mathcolor","Red"],"let");
672                 P.smallskip;
673                 P.Mi([],get_name decl);
674                 P.Mtext([],":"); term2pres decl.Con.dec_type]) in
675            let suchthat =
676              P.Mrow ([],
677                [P.Mtext([None,"mathcolor","Red"],"such that");
678                 P.smallskip;
679                 P.Mtext([],"(");
680                 P.Mi([],get_name hyp);
681                 P.Mtext([],")");
682                 P.smallskip;
683                 term2pres hyp.Con.dec_type]) in
684             (* let body = proof2pres {proof with Con.proof_context = tl} in *)
685             let body = conclude2pres proof.Con.proof_conclude false true in
686             let presacontext = 
687               acontext2pres proof.Con.proof_apply_context body false in
688             P.Mtable 
689               ([None,"align","baseline 1"; None,"equalrows","false"; 
690                 None,"columnalign","left"],
691                [P.Mtr ([],[P.Mtd ([],presdecl)]);
692                 P.Mtr ([],[P.Mtd ([],suchthat)]);
693                 P.Mtr ([],[P.Mtd ([],presacontext)])]);
694          | _ -> assert false in
695
696 proof2pres p
697 ;;
698
699 exception ToDo;;
700
701 let content2pres term2pres (id,params,metasenv,obj) =
702  let module K = Content in
703  let module P = Mpresentation in
704   match obj with
705      `Def (K.Const,thesis,`Proof p) ->
706        P.Mtable
707         [None,"align","baseline 1";
708          None,"equalrows","false";
709          None,"columnalign","left";
710          None,"helm:xref","id"]
711         ([P.Mtr []
712            [P.Mtd []
713             (P.Mrow []
714              [P.Mtext []
715                ("UNFINISHED PROOF" ^ id ^"(" ^
716                  String.concat " ; " (List.map UriManager.string_of_uri params)^
717                 ")")])] ;
718          P.Mtr []
719           [P.Mtd []
720             (P.Mrow []
721               [P.Mtext [] "THESIS:"])] ;
722          P.Mtr []
723           [P.Mtd []
724             (P.Mrow []
725               [P.Mphantom []
726                 (P.Mtext [] "__") ;
727               term2pres thesis])]] @
728          (match metasenv with
729              None -> []
730            | Some metasenv' ->
731               [P.Mtr []
732                 [P.Mtd []
733                   (* Conjectures are in their own table to make *)
734                   (* diffing the DOM trees easier.              *)
735                   (P.Mtable
736                     [None,"align","baseline 1";
737                      None,"equalrows","false";
738                      None,"columnalign","left"]
739                    ((P.Mtr []
740                       [P.Mtd []
741                        (P.Mrow []
742                          [P.Mtext [] "CONJECTURES:"])])::
743                     List.map
744                      (function
745                        (id,n,context,ty) ->
746                          P.Mtr []
747                           [P.Mtd []
748                            (P.Mrow [Some "helm", "xref", id]
749                              (List.map
750                                (function
751                                    (_,None) ->
752                                      P.Mrow []
753                                       [ P.Mi [] "_" ;
754                                         P.Mo [] ":?" ;
755                                         P.Mi [] "_"]
756                                  | (_,Some (`Declaration d))
757                                  | (_,Some (`Hypothesis d)) ->
758                                     let
759                                      { K.dec_name = dec_name ;
760                                        K.dec_type = ty } = d
761                                      in
762                                       P.Mrow []
763                                        [ P.Mi []
764                                           (match dec_name with
765                                               None -> "_"
766                                             | Some n -> n) ;
767                                          P.Mo [] ":" ;
768                                          term2pres ty]
769                                  | (_,Some (`Definition d)) ->
770                                     let
771                                      { K.def_name = def_name ;
772                                        K.def_term = bo } = d
773                                      in
774                                       P.Mrow []
775                                        [ P.Mi []
776                                           (match def_name with
777                                               None -> "_"
778                                             | Some n -> n) ;
779                                          P.Mo [] ":=" ;
780                                          term2pres bo]
781                                  | (_,Some (`Proof p)) ->
782                                     let proof_name = p.K.proof_name in
783                                      P.Mrow []
784                                       [ P.Mi []
785                                          (match proof_name with
786                                              None -> "_"
787                                            | Some n -> n) ;
788                                         P.Mo [] ":=" ;
789                                         proof2pres term2pres p]
790                                ) context @
791                              [ P.Mo [] "|-" ] @
792                              [ P.Mi [] (string_of_int n) ;
793                                P.Mo [] ":" ;
794                                term2pres ty ]
795                            ))
796                           ]
797                      ) metasenv'
798                   ))]]
799          )  @
800         [P.Mtr []
801           [P.Mtd []
802             (P.Mrow []
803               [proof2pres term2pres p])]])
804    | _ -> raise ToDo
805 ;;
806
807 let content2pres ~ids_to_inner_sorts =
808  content2pres 
809   (function p -> 
810    (Cexpr2pres.cexpr2pres_charcount 
811     (Content_expressions.acic2cexpr ids_to_inner_sorts p)))
812 ;;