]> matita.cs.unibo.it Git - helm.git/blobdiff - components/content_pres/content2pres.ml
hacks for paramodulation declarative proofs
[helm.git] / components / content_pres / content2pres.ml
index e377706b7ddb69b49650306eb5a71180b0d9d6e6..b9c46917c236c32006f0759a1b4fbc7b8c7c7dfa 100644 (file)
@@ -134,8 +134,9 @@ let rec justification term2pres p =
   else (B.b_kw "by"),
     Some (B.b_toggle [B.b_kw "proof";proof2pres true term2pres p])
      
-and proof2pres is_top_down term2pres p =
-  let rec proof2pres is_top_down p omit_dot =
+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 indent = 
       let is_decl e = 
         (match e with 
@@ -150,16 +151,19 @@ and proof2pres is_top_down term2pres p =
        | Some t -> Some (term2pres t)) in
     let body =
         let presconclude = 
-          conclude2pres is_top_down p.Con.proof_conclude indent omit_conclusion
+          conclude2pres ~skip_initial_lambdas_internal is_top_down p.Con.proof_conclude indent omit_conclusion
            omit_dot in
         let presacontext = 
           acontext2pres
            (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
-           p.Con.proof_apply_context presconclude indent
+            p.Con.proof_apply_context
+            presconclude indent
            (p.Con.proof_conclude.Con.conclude_method = "BU_Conversion")
         in
-         context2pres p.Con.proof_context presacontext
-  in
+        context2pres 
+          (if skip_initial_lambdas_internal then [] else p.Con.proof_context)
+          presacontext
+    in
     match p.Con.proof_name with
       None -> body
     | Some name ->
@@ -256,7 +260,7 @@ and proof2pres is_top_down term2pres p =
            [B.H([Some "helm","xref","ace_"^p.Con.proof_id],[hd]);
             continuation])) ac continuation 
 
-  and conclude2pres is_top_down conclude indent omit_conclusion omit_dot =
+  and conclude2pres ?skip_initial_lambdas_internal is_top_down conclude indent omit_conclusion omit_dot =
     let tconclude_body = 
       match conclude.Con.conclude_conclusion with
         Some t (*when not omit_conclusion or
@@ -274,7 +278,8 @@ and proof2pres is_top_down term2pres p =
            (* false ind is in charge to add the conclusion *)
            falseind conclude
           else  
-            let conclude_body = conclude_aux conclude in
+            let conclude_body = 
+              conclude_aux ?skip_initial_lambdas_internal conclude in
             let ann_concl = 
               if  conclude.Con.conclude_method = "Intros+LetTac"
                || conclude.Con.conclude_method = "ByInduction"
@@ -286,7 +291,7 @@ and proof2pres is_top_down term2pres p =
                ((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 [])
             in
              B.V ([], [conclude_body; ann_concl])
-      | _ -> conclude_aux conclude
+      | _ -> conclude_aux ?skip_initial_lambdas_internal conclude
     in
      if indent then 
        B.indent (B.H ([Some "helm", "xref", conclude.Con.conclude_id],
@@ -294,7 +299,7 @@ and proof2pres is_top_down term2pres p =
      else 
        B.H ([Some "helm", "xref", conclude.Con.conclude_id],[tconclude_body])
 
-  and conclude_aux conclude =
+  and conclude_aux ?skip_initial_lambdas_internal conclude =
     if conclude.Con.conclude_method = "TD_Conversion" then
       let expected = 
         (match conclude.Con.conclude_conclusion with 
@@ -333,7 +338,7 @@ and proof2pres is_top_down term2pres p =
        )
     else if conclude.Con.conclude_method = "Intros+LetTac" then
       (match conclude.Con.conclude_args with
-         [Con.ArgProof p] -> proof2pres true p false
+         [Con.ArgProof p] -> proof2pres ?skip_initial_lambdas_internal true p false
        | _ -> assert false)
 (* OLD CODE 
       let conclusion = 
@@ -385,14 +390,19 @@ and proof2pres 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 =
-       let j1,j2 = justification term2pres p in
+        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 -> 
-             B.HOV(RenderingAttrs.indent_attributes `BoxML,([B.b_kw "=";B.b_space;term2pres t;B.b_space]@justification p))::(aux 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)
          | _ -> assert false 
       in
       let hd = 
@@ -400,7 +410,7 @@ and proof2pres is_top_down term2pres p =
          | Con.Term t -> t 
          | _ -> assert false 
       in
-      B.HOV([],[term2pres hd; (* B.b_space; *)
+      B.HOV([],[B.Text ([],"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 = 
@@ -682,7 +692,7 @@ and proof2pres is_top_down term2pres p =
          | _ -> assert false
 
     in
-    proof2pres is_top_down p false
+    proof2pres ?skip_initial_lambdas_internal:skip_initial_lambdas is_top_down p false
 
 exception ToDo
 
@@ -798,16 +808,24 @@ let joint_def2pres term2pres def =
   | `Inductive ind -> inductive2pres term2pres ind
   | _ -> assert false (* ZACK or raise ToDo? *)
 
-let content2pres term2pres (id,params,metasenv,obj) =
+let content2pres 
+  ?skip_initial_lambdas ?(skip_thm_and_qed=false) term2pres 
+  (id,params,metasenv,obj) 
+=
   match obj with
   | `Def (Content.Const, thesis, `Proof p) ->
       let name = get_name p.Content.proof_name in
+      let proof = proof2pres true term2pres ?skip_initial_lambdas p in
+      if skip_thm_and_qed then
+        proof
+      else
       B.b_v
         [Some "helm","xref","id"]
-        ([ B.b_h [] (B.b_kw ("theorem " ^ name) :: params2pres params @ [B.b_kw ":"]);
+        ([ B.b_h [] (B.b_kw ("theorem " ^ name) :: 
+          params2pres params @ [B.b_kw ":"]);
            B.indent (term2pres thesis) ; B.b_kw "." ] @
          metasenv2pres term2pres metasenv @
-         [proof2pres true term2pres p ; B.b_kw "qed."])
+         [proof ; B.b_kw "qed."])
   | `Def (_, ty, `Definition body) ->
       let name = get_name body.Content.def_name in
       B.b_v
@@ -834,8 +852,10 @@ let content2pres term2pres (id,params,metasenv,obj) =
         :: List.map (joint_def2pres term2pres) joint.Content.joint_defs)
   | _ -> raise ToDo
 
-let content2pres ~ids_to_inner_sorts =
-  content2pres
+let content2pres 
+  ?skip_initial_lambdas ?skip_thm_and_qed ~ids_to_inner_sorts 
+=
+  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