]> matita.cs.unibo.it Git - helm.git/blobdiff - components/content_pres/content2pres.ml
Pretty-printing of "match ... with" pattern syntax fixed. We need an
[helm.git] / components / content_pres / content2pres.ml
index 5620b68473ea414a377d97f2d3fd1a2396a22aa8..b9e89769472371c31b3a27e4ae8beedf1db53c49 100644 (file)
@@ -113,29 +113,37 @@ let make_args_for_apply term2pres args =
         (List.fold_right (make_arg_for_apply false) tl [])
   | _ -> assert false
 
-let get_name = function
+let get_name ?(default="_") = function
   | Some s -> s
-  | None -> "_"
+  | None -> default
 
 let add_xref id = function
   | B.Text (attrs, t) -> B.Text (((Some "helm", "xref", id) :: attrs), t)
   | _ -> assert false (* TODO, add_xref is meaningful for all boxes *)
 
-let rec justification term2pres p = 
-  if ((p.Con.proof_conclude.Con.conclude_method = "Exact") or
-     ((p.Con.proof_context = []) &
-      (p.Con.proof_apply_context = []) &
-      (p.Con.proof_conclude.Con.conclude_method = "Apply"))) then
+let rec justification ~ignore_atoms term2pres p = 
+  if p.Con.proof_conclude.Con.conclude_method = "Exact" &&
+     ignore_atoms
+  then
+   [], None
+  else if
+   (p.Con.proof_conclude.Con.conclude_method = "Exact" && not ignore_atoms) ||
+   (p.Con.proof_context = [] &&
+    p.Con.proof_apply_context = [] &&
+    p.Con.proof_conclude.Con.conclude_method = "Apply")
+  then
     let pres_args = 
-      make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args in
-    B.H([],
-      (B.b_kw "by")::B.b_space::
-      B.Text([],"(")::pres_args@[B.Text([],")")]), None 
-  else (B.b_kw "by"),
-    Some (B.b_toggle [B.b_kw "proof";proof2pres true term2pres p])
+      make_args_for_apply term2pres p.Con.proof_conclude.Con.conclude_args
+    in
+     [B.H([],
+       (B.b_kw "by")::B.b_space::
+       B.Text([],"(")::pres_args@[B.Text([],")")])], None 
+  else
+   [B.H([],[B.b_kw "by"; B.b_space; B.b_kw "proof"])],
+    Some (B.b_toggle [B.b_kw "proof";B.indent (proof2pres true term2pres p)])
      
 and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
-  let rec proof2pres ?skip_initial_lambdas_internal is_top_down p omit_dot =
+  let rec proof2pres ?skip_initial_lambdas_internal is_top_down p in_bu_conversion =
     let indent = 
       let is_decl e = 
         (match e with 
@@ -151,18 +159,20 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
     let body =
         let presconclude = 
           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
+          ?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 in_bu_conversion in
         let presacontext = 
           acontext2pres
-           (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
-            p.Con.proof_apply_context
-            presconclude indent
+           (if p.Con.proof_conclude.Con.conclude_method = "BU_Conversion" then
+             is_top_down
+            else
+             false)
+           p.Con.proof_apply_context
+           presconclude indent
            (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
         in
         context2pres 
@@ -171,6 +181,9 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
            | _ -> p.Con.proof_context)
           presacontext
     in
+(*
+let body = B.V([],[B.b_kw ("(*<<" ^ p.Con.proof_conclude.Con.conclude_method ^ (if is_top_down then "(TD)" else "(NTD)") ^ "*)"); body; B.b_kw "(*>>*)"]) in
+*)
     match p.Con.proof_name with
       None -> body
     | Some name ->
@@ -257,19 +270,33 @@ 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 hd = 
-          if indent then
-            B.indent (proof2pres is_top_down p in_bu_conversion)
-          else 
-            proof2pres is_top_down p in_bu_conversion
+   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 = proof2pres is_top_down p in_bu_conversion in
+        let hd = if indent then B.indent hd else hd 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.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
+           continuation])
+   in aux ac
 
-  and conclude2pres ?skip_initial_lambdas_internal is_top_down name conclude indent omit_conclusion omit_dot =
+  and conclude2pres ?skip_initial_lambdas_internal is_top_down name conclude indent omit_conclusion in_bu_conversion =
     let tconclude_body = 
       match conclude.Con.conclude_conclusion with
         Some t (*when not omit_conclusion or
@@ -311,22 +338,29 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
               else
                [] in
             let conclude_body = 
-              conclude_aux ?skip_initial_lambdas_internal conclude in
+              conclude_aux ?skip_initial_lambdas_internal is_top_down conclude in
             let ann_concl = 
               if  conclude.Con.conclude_method = "Intros+LetTac"
                || conclude.Con.conclude_method = "ByInduction"
                || conclude.Con.conclude_method = "TD_Conversion"
+               || conclude.Con.conclude_method = "Eq_chain"
               then
                B.Text([],"")
               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; B.Text([],if not is_top_down then "(previous)" else "")]
-               else [B.b_kw "done"]) @ if not omit_dot then [B.Text([],".")] else [])
+              else
+                B.b_hv []
+                 ((if not is_top_down || in_bu_conversion then
+                    (make_concl "we proved" concl) ::
+                      if not is_top_down then
+                       let name = get_name ~default:"previous" name in
+                        [B.b_space; B.Text([],"(" ^ name ^ ")")]
+                      else []
+                   else [B.b_kw "done"]
+                  ) @ if not in_bu_conversion then [B.Text([],".")] else [])
             in
-            B.V ([], prequel @ [conclude_body; ann_concl])
-      | _ -> conclude_aux ?skip_initial_lambdas_internal conclude
+             B.V ([], prequel @ [conclude_body; ann_concl])
+      | _ -> conclude_aux ?skip_initial_lambdas_internal is_top_down conclude
     in
      if indent then 
        B.indent (B.H ([Some "helm", "xref", conclude.Con.conclude_id],
@@ -334,7 +368,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
      else 
        B.H ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
 
-  and conclude_aux ?skip_initial_lambdas_internal conclude =
+  and conclude_aux ?skip_initial_lambdas_internal is_top_down conclude =
     if conclude.Con.conclude_method = "TD_Conversion" then
       let expected = 
         (match conclude.Con.conclude_conclusion with 
@@ -403,19 +437,39 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
       andind conclude
     else if (conclude.Con.conclude_method = "FalseInd") then
       falseind conclude
-    else if (conclude.Con.conclude_method = "Rewrite") then
+    else if conclude.Con.conclude_method = "RewriteLR"
+         || conclude.Con.conclude_method = "RewriteRL" then
       let justif1,justif2 = 
         (match (List.nth conclude.Con.conclude_args 6) with
-           Con.ArgProof p -> justification term2pres p
+           Con.ArgProof p -> justification ~ignore_atoms:true term2pres p
          | _ -> assert false) in
+      let justif =
+       match justif2 with
+          None -> justif1
+        | Some j -> [j]
+      in
+      let index_term1, index_term2 =
+       if conclude.Con.conclude_method = "RewriteLR" then 2,5 else 5,2
+      in
       let term1 = 
-        (match List.nth conclude.Con.conclude_args 2 with
+        (match List.nth conclude.Con.conclude_args index_term1 with
            Con.Term (_,t) -> term2pres t
          | _ -> assert false) in 
       let term2 = 
-        (match List.nth conclude.Con.conclude_args 5 with
+        (match List.nth conclude.Con.conclude_args index_term2 with
            Con.Term (_,t) -> term2pres t
          | _ -> assert false) in
+      let justif =
+       match justif with
+          [] -> []
+        | _ ->
+         justif @
+          [B.V([],
+            [B.b_kw "we proved (" ;
+             term1 ;
+             B.b_kw "=" ;
+             term2; B.b_kw ") (equality)."])]
+      in
 (*
       B.V ([], 
          B.H ([],[
@@ -425,24 +479,22 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
           B.b_space; term2;
           B.b_space; justif1])::
            match justif2 with None -> [] | Some j -> [B.indent j])
-*) B.V([], [justif1 ; B.H([],[B.b_kw "we proved (" ; term2 ; B.b_kw "=" ; term1; B.b_kw ") (previous)."]); B.b_kw "by _"])
+*)
+      B.V([], justif @ [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 -> [])
+       let j1,j2 = justification ~ignore_atoms:false term2pres p in
+        j1, match j2 with Some j -> [j] | None -> []
       in
       let rec aux args =
        match args with
          | [] -> []
          | (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)
+              let justif1,justif2 = justification p in
+              B.HOV(RenderingAttrs.indent_attributes `BoxML,([B.b_kw
+               "=";B.b_space;term2pres t;B.b_space]@justif1@
+               (if tl <> [] then [B.Text ([],".")] else [B.b_space; B.b_kw "done" ; B.Text([],".")])@
+               justif2))::(aux tl)
          | _ -> assert false 
       in
       let hd = 
@@ -450,8 +502,14 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
          | Con.Term (_,t) -> t 
          | _ -> assert false 
       in
-      B.HOV([],[B.b_kw "conclude";B.b_space;term2pres hd; (* B.b_space; *)
-             B.V ([],aux (List.tl conclude.Con.conclude_args))])
+       if is_top_down then
+        B.HOV([],
+         [B.b_kw "conclude";B.b_space;term2pres hd;
+         B.V ([],aux (List.tl conclude.Con.conclude_args))])
+       else
+        B.HOV([],
+         [B.b_kw "obtain";B.b_space;B.b_kw "FIXMEXX"; B.b_space;term2pres hd;
+         B.V ([],aux (List.tl conclude.Con.conclude_args))])
     else if conclude.Con.conclude_method = "Apply" then
       let pres_args = 
         make_args_for_apply term2pres conclude.Con.conclude_args in
@@ -491,7 +549,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
             Con.Aux n -> B.b_kw "an aux???"
            | Con.Premise prem ->
               (match prem.Con.premise_binder with
-                 None -> B.b_kw "the previous result"
+                 None -> B.b_kw "previous"
                | Some n -> B.Object ([], P.Mi([],n)))
            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
            | Con.Term (_,t) -> 
@@ -522,7 +580,7 @@ and proof2pres ?skip_initial_lambdas is_top_down term2pres p =
             Con.Aux n -> B.b_kw "an aux???"
            | Con.Premise prem ->
               (match prem.Con.premise_binder with
-                 None -> B.b_kw "the previous result"
+                 None -> B.b_kw "previous"
                | Some n -> B.Object ([], P.Mi([],n)))
            | Con.Lemma lemma -> B.Object ([], P.Mi([],lemma.Con.lemma_name))
            | Con.Term (_,t) -> 
@@ -596,8 +654,6 @@ 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_name p.Con.proof_conclude true true false in
           let presacontext = 
@@ -641,7 +697,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 =
@@ -679,8 +734,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_name 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
@@ -719,8 +775,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_name 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
@@ -903,7 +960,7 @@ let content2pres
   content2pres ?skip_initial_lambdas ?skip_thm_and_qed
     (fun ?(prec=90) annterm ->
       let ast, ids_to_uris =
-        TermAcicContent.ast_of_acic ids_to_inner_sorts annterm
+       TermAcicContent.ast_of_acic ~output_type:`Term ids_to_inner_sorts annterm
       in
        CicNotationPres.box_of_mpres
         (CicNotationPres.render ids_to_uris ~prec