]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/content_pres/content2pres.ml
Bug fixed in bottom-up conversion.
[helm.git] / helm / software / components / content_pres / content2pres.ml
index b9c46917c236c32006f0759a1b4fbc7b8c7c7dfa..97f225f62b0bc2a9b9ad5c4781ba6bbcbcba2be5 100644 (file)
@@ -97,8 +97,8 @@ let make_args_for_apply term2pres args =
           Some "xlink", "href", lemma.Con.lemma_uri ]
         in
         (B.b_object (P.Mi(lemma_attrs,lemma.Con.lemma_name)))::row 
-    | Con.Term t -> 
-        if is_first then
+    | Con.Term (b,t) -> 
+        if is_first || (not b) then
           (term2pres t)::row
         else (B.b_object (P.Mi([],"?")))::row
     | Con.ArgProof _ 
@@ -135,8 +135,7 @@ let rec justification term2pres p =
     Some (B.b_toggle [B.b_kw "proof";proof2pres true term2pres p])
      
 and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
-  let rec proof2pres ?(skip_initial_lambdas_internal=false) is_top_down p omit_dot =
-    prerr_endline p.Con.proof_conclude.Con.conclude_method;
+  let rec proof2pres ?skip_initial_lambdas_internal is_top_down p omit_dot =
     let indent = 
       let is_decl e = 
         (match e with 
@@ -151,7 +150,13 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
        | Some t -> Some (term2pres t)) in
     let body =
         let presconclude = 
-          conclude2pres ~skip_initial_lambdas_internal is_top_down p.Con.proof_conclude indent omit_conclusion
+          conclude2pres
+           ?skip_initial_lambdas_internal:
+             (match skip_initial_lambdas_internal with
+                 Some (`Later s) -> Some (`Now s)
+               | _ -> None)
+             is_top_down
+             p.Con.proof_name p.Con.proof_conclude indent omit_conclusion
            omit_dot in
         let presacontext = 
           acontext2pres
@@ -161,7 +166,9 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
            (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
         in
         context2pres 
-          (if skip_initial_lambdas_internal then [] else p.Con.proof_context)
+         (match skip_initial_lambdas_internal with
+             Some (`Now n) -> snd (HExtlib.split_nth n p.Con.proof_context)
+           | _ -> p.Con.proof_context)
           presacontext
     in
     match p.Con.proof_name with
@@ -174,7 +181,9 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
              let concl =
                make_concl ~attrs:[ Some "helm", "xref", p.Con.proof_id ]
                  "proof of" ac in
-             B.b_toggle [ concl; body ]
+             B.b_toggle [ B.H ([], [concl; B.skip ; B.Text([],"(");
+                      B.Object ([], P.Mi ([],name));
+                      B.Text([],")") ]) ; body ]
         in
          B.indent action
 
@@ -248,19 +257,37 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
               term])
 
   and acontext2pres is_top_down ac continuation indent in_bu_conversion =
-    List.fold_right
-      (fun p continuation ->
+   let rec aux =
+    function
+       [] -> continuation
+     | p::tl ->
+        let continuation = aux tl in
+        (* Applicative context get flattened and the "body" of a BU_Conversion
+           is put in the applicative context. Thus two different situations
+           are possible:
+            {method = "BU_Conversion"; applicative_context=[p1; ...; pn]}
+            {method = xxx; applicative_context =
+              [ p1; ...; pn; {method="BU_Conversion"} ; p_{n+1}; ... ; pm ]}
+           In both situations only pn must be processed in in_bu_conversion
+           mode
+        *)
+        let in_bu_conversion =
+         match tl with
+            [] -> in_bu_conversion
+          | p::_ -> p.Con.proof_conclude.Con.conclude_method = "BU_Conversion"
+        in
         let hd = 
           if indent then
             B.indent (proof2pres is_top_down p in_bu_conversion)
           else 
             proof2pres is_top_down p in_bu_conversion
         in
-         B.V([Some "helm","xref",p.Con.proof_id],
-           [B.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
-            continuation])) ac continuation 
+        B.V([Some "helm","xref",p.Con.proof_id],
+          [B.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
+           continuation])
+   in aux ac
 
-  and conclude2pres ?skip_initial_lambdas_internal is_top_down conclude indent omit_conclusion omit_dot =
+  and conclude2pres ?skip_initial_lambdas_internal is_top_down name conclude indent omit_conclusion omit_dot =
     let tconclude_body = 
       match conclude.Con.conclude_conclusion with
         Some t (*when not omit_conclusion or
@@ -273,11 +300,34 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
           if conclude.Con.conclude_method = "BU_Conversion" then
             B.b_hv []
              (make_concl "that is equivalent to" concl ::
-              if is_top_down then [B.b_space ; B.Text([],"done.")] else [])
+                     if is_top_down then [B.b_space ; B.b_kw "done";
+                     B.Text([],".")] else [B.Text([],".")])
           else if conclude.Con.conclude_method = "FalseInd" then
            (* false ind is in charge to add the conclusion *)
            falseind conclude
           else  
+            let prequel =
+              if
+               (not is_top_down) &&
+                conclude.Con.conclude_method = "Intros+LetTac"
+              then
+                let name = get_name name in
+                 [B.V ([],
+                 [ B.H([],
+                    let expected = 
+                      (match conclude.Con.conclude_conclusion with 
+                         None -> B.Text([],"NO EXPECTED!!!")
+                       | Some c -> term2pres c)
+                    in
+                     [make_concl "we need to prove" expected;
+                      B.skip;
+                      B.Text([],"(");
+                      B.Object ([], P.Mi ([],name));
+                      B.Text([],")");
+                      B.Text ([],".")
+                     ])])]
+              else
+               [] in
             let conclude_body = 
               conclude_aux ?skip_initial_lambdas_internal conclude in
             let ann_concl = 
@@ -286,11 +336,19 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                || conclude.Con.conclude_method = "TD_Conversion"
               then
                B.Text([],"")
-              else if omit_conclusion then B.Text([],"done.")
-              else B.b_hv []
-               ((if not is_top_down || omit_dot then [make_concl "we proved" concl; B.Text([],if not is_top_down then "(previous)" else "")] else [B.Text([],"done")]) @ if not omit_dot then [B.Text([],".")] else [])
+              else if omit_conclusion then 
+                B.H([], [B.b_kw "done" ; B.Text([],".") ])
+              else
+                B.b_hv []
+                 ((if not is_top_down || omit_dot then
+                    (make_concl "we proved" concl) ::
+                      if not is_top_down then
+                       [B.b_space; B.Text([],"(previous)")]
+                      else []
+                   else [B.b_kw "done"]
+                  ) @ if not omit_dot then [B.Text([],".")] else [])
             in
-             B.V ([], [conclude_body; ann_concl])
+            B.V ([], prequel @ [conclude_body; ann_concl])
       | _ -> conclude_aux ?skip_initial_lambdas_internal conclude
     in
      if indent then 
@@ -316,15 +374,14 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
       B.V 
         ([],
         [make_concl "we need to  prove" expected;
-         make_concl "or equivalently" synth;
-         B.Text([],".");
+         B.H ([],[make_concl "or equivalently" synth; B.Text([],".")]);
          proof2pres true subproof false])
     else if conclude.Con.conclude_method = "BU_Conversion" then
       assert false
     else if conclude.Con.conclude_method = "Exact" then
       let arg = 
         (match conclude.Con.conclude_args with 
-           [Con.Term t] -> term2pres t
+           [Con.Term (b,t)] -> assert (not b);term2pres t
          | [Con.Premise p] -> 
              (match p.Con.premise_binder with
              | None -> assert false; (* unnamed hypothesis ??? *)
@@ -333,12 +390,16 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
       (match conclude.Con.conclude_conclusion with 
          None ->
           B.b_h [] [B.b_kw "by"; B.b_space; arg]
-       | Some c -> let conclusion = term2pres c in
+       | Some c -> 
           B.b_h [] [B.b_kw "by"; B.b_space; arg]
        )
     else if conclude.Con.conclude_method = "Intros+LetTac" then
       (match conclude.Con.conclude_args with
-         [Con.ArgProof p] -> proof2pres ?skip_initial_lambdas_internal true p false
+         [Con.ArgProof p] ->
+           (match conclude.Con.conclude_args with
+              [Con.ArgProof p] -> 
+                proof2pres ?skip_initial_lambdas_internal true p false
+            | _ -> assert false)
        | _ -> assert false)
 (* OLD CODE 
       let conclusion = 
@@ -372,11 +433,11 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
          | _ -> assert false) in
       let term1 = 
         (match List.nth conclude.Con.conclude_args 2 with
-           Con.Term t -> term2pres t
+           Con.Term (_,t) -> term2pres t
          | _ -> assert false) in 
       let term2 = 
         (match List.nth conclude.Con.conclude_args 5 with
-           Con.Term t -> term2pres t
+           Con.Term (_,t) -> term2pres t
          | _ -> assert false) in
 (*
       B.V ([], 
@@ -390,16 +451,18 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
 *) B.V([], [justif1 ; B.H([],[B.b_kw "we proved (" ; term2 ; B.b_kw "=" ; term1; B.b_kw ") (previous)."]); B.b_kw "by _"])
     else if conclude.Con.conclude_method = "Eq_chain" then
       let justification p =
+(*
         if skip_initial_lambdas <> None (* cheating *) then
           [B.b_kw "by _"]
         else
+*)
           let j1,j2 = justification term2pres p in
          j1 :: B.b_space :: (match j2 with Some j -> [j] | None -> [])
       in
       let rec aux args =
        match args with
          | [] -> []
-         | (Con.ArgProof p)::(Con.Term t)::tl -> 
+         | (Con.ArgProof p)::(Con.Term (_,t))::tl -> 
              B.HOV(RenderingAttrs.indent_attributes `BoxML,([B.b_kw
               "=";B.b_space;term2pres t;B.b_space]@justification p@
               (if tl <> [] then [B.Text ([],".")] else [])))::(aux tl)
@@ -407,10 +470,10 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
       in
       let hd = 
        match List.hd conclude.Con.conclude_args with
-         | Con.Term t -> t 
+         | Con.Term (_,t) -> t 
          | _ -> assert false 
       in
-      B.HOV([],[B.Text ([],"conclude");B.b_space;term2pres hd; (* B.b_space; *)
+      B.HOV([],[B.b_kw "conclude";B.b_space;term2pres hd; (* B.b_space; *)
              B.V ([],aux (List.tl conclude.Con.conclude_args))])
     else if conclude.Con.conclude_method = "Apply" then
       let pres_args = 
@@ -431,7 +494,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
         Con.Aux n -> B.b_kw ("aux " ^ n)
       | Con.Premise prem -> B.b_kw "premise"
       | Con.Lemma lemma -> B.b_kw "lemma"
-      | Con.Term t -> term2pres t
+      | Con.Term (_,t) -> term2pres t
       | Con.ArgProof p -> proof2pres true p false
       | Con.ArgMethod s -> B.b_kw "method"
  
@@ -454,7 +517,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                  None -> B.b_kw "the previous result"
                | Some n -> B.Object ([], P.Mi([],n)))
            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
-           | Con.Term t -> 
+           | Con.Term (_,t) -> 
                term2pres t
            | Con.ArgProof p -> B.b_kw "a proof???"
            | Con.ArgMethod s -> B.b_kw "a method???")
@@ -485,14 +548,14 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                  None -> B.b_kw "the previous result"
                | Some n -> B.Object ([], P.Mi([],n)))
            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
-           | Con.Term t -> 
+           | Con.Term (_,t) -> 
                term2pres t
            | Con.ArgProof p -> B.b_kw "a proof???"
            | Con.ArgMethod s -> B.b_kw "a method???") in
         (make_concl "we proceed by induction on" arg) in
      let to_prove =
-        (make_concl "to prove" proof_conclusion) in
-     B.V ([], induction_on::to_prove:: B.Text([],".")::(make_cases args_for_cases))
+      B.H ([], [make_concl "to prove" proof_conclusion ; B.Text([],".")]) in
+     B.V ([], induction_on::to_prove::(make_cases args_for_cases))
 
     and make_cases l = List.map make_case l
 
@@ -556,10 +619,8 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                    | _ -> assert false in
                let hyps = List.map make_hyp indhyps in
                text::hyps) in          
-          (* let acontext = 
-               acontext2pres_old p.Con.proof_apply_context true in *)
           let body =
-           conclude2pres true p.Con.proof_conclude true true false in
+           conclude2pres true p.Con.proof_name p.Con.proof_conclude true true false in
           let presacontext = 
            let acontext_id =
             match p.Con.proof_apply_context with
@@ -573,7 +634,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                  p.Con.proof_apply_context body true
                  (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
               ]) in
-          B.V ([], pattern::induction_hypothesis@[asubconcl;B.Text([],".");presacontext])
+          B.V ([], pattern::induction_hypothesis@[B.H ([],[asubconcl;B.Text([],".")]);presacontext])
        | _ -> assert false 
 
      and falseind conclude =
@@ -601,7 +662,6 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                [ B.Object ([], P.Mi([],lemma.Con.lemma_name)); B.skip;
                  B.b_kw "is contradictory, hence" ]
            | _ -> assert false) in
-            (* let body = proof2pres {proof with Con.proof_context = tl} false in *)
        make_row arg proof_conclusion
 
      and andind conclude =
@@ -639,8 +699,9 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                 B.Text([],")");
                 B.skip;
                 term2pres hyp2.Con.dec_type]) in
-            (* let body = proof2pres {proof with Con.proof_context = tl} false in *)
-            let body= conclude2pres false proof.Con.proof_conclude false true false in
+            let body =
+             conclude2pres false proof.Con.proof_name proof.Con.proof_conclude
+              false true false in
             let presacontext = 
               acontext2pres false proof.Con.proof_apply_context body false false
             in
@@ -679,8 +740,9 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
                 B.Text([],")");
                 B.skip;
                 term2pres hyp.Con.dec_type]) in
-            (* let body = proof2pres {proof with Con.proof_context = tl} false in *)
-            let body= conclude2pres false proof.Con.proof_conclude false true false in
+            let body =
+             conclude2pres false proof.Con.proof_name proof.Con.proof_conclude
+              false true false in
             let presacontext = 
               acontext2pres false proof.Con.proof_apply_context body false false
             in
@@ -692,7 +754,12 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
          | _ -> assert false
 
     in
-    proof2pres ?skip_initial_lambdas_internal:skip_initial_lambdas is_top_down p false
+    proof2pres
+     ?skip_initial_lambdas_internal:
+       (match skip_initial_lambdas with
+           None -> Some (`Later 0) (* we already printed theorem: *)
+         | Some n -> Some (`Later n))
+     is_top_down p false
 
 exception ToDo
 
@@ -823,7 +890,7 @@ let content2pres
         [Some "helm","xref","id"]
         ([ B.b_h [] (B.b_kw ("theorem " ^ name) :: 
           params2pres params @ [B.b_kw ":"]);
-           B.indent (term2pres thesis) ; B.b_kw "." ] @
+           B.H ([],[B.indent (term2pres thesis) ; B.b_kw "." ])] @
          metasenv2pres term2pres metasenv @
          [proof ; B.b_kw "qed."])
   | `Def (_, ty, `Definition body) ->