New tactic rewrite implemented.

[helm.git] / helm / gTopLevel / fourierR.ml

diff --git a/helm/gTopLevel/fourierR.ml b/helm/gTopLevel/fourierR.ml
index 1de87fdd99c4d6eb53c4185524192c8acd09839e..b9e78233033806975a816af1b2b7a792960f3fe5 100644 (file)
--- a/helm/gTopLevel/fourierR.ml
+++ b/helm/gTopLevel/fourierR.ml
@@ -24,6 +24,54 @@
  *)
 
 
+(******************** OTHER USEFUL TACTICS **********************)
+
+let rewrite_tac ~term:equality ~status:(proof,goal) =
+ let module C = Cic in
+ let module U = UriManager in
+  let curi,metasenv,pbo,pty = proof in
+  let metano,context,gty = List.find (function (m,_,_) -> m=goal) metasenv in
+   let ty,t1,t2 = 
+    match CicTypeChecker.type_of_aux' metasenv context equality with
+       C.Appl [C.MutInd (uri,_,0) ; ty ; t1 ; t2]
+        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/Equality/eq.ind") ->
+         ty,t1,t2
+     | _ ->
+       raise
+        (ProofEngineTypes.Fail
+          "Rewrite: the argument is not a proof of an equality")
+   in
+    let pred =
+     let gty' = CicSubstitution.lift 1 gty in
+     let t1' = CicSubstitution.lift 1 t1 in
+     let gty'' =
+      ProofEngineReduction.replace_lifting
+       ~equality:ProofEngineReduction.syntactic_equality
+       ~what:t1' ~with_what:(C.Rel 1) ~where:gty'
+     in
+      C.Lambda (C.Name "dummy_for_rewrite", ty, gty'')
+    in
+prerr_endline ("##### Atteso: " ^ CicPp.ppterm
+     (C.Lambda (C.Name "x", ty,
+      C.Appl
+       [C.MutInd (U.uri_of_string "cic:/Coq/Init/Logic/Equality/eq.ind",0,0) ;
+        ty ; C.Rel 3 ; C.Rel 1]))
+) ;
+prerr_endline ("#### Sintetizzato: " ^ CicPp.ppterm pred);
+    let eq_ind_r =
+     C.Const
+      (U.uri_of_string "cic:/Coq/Init/Logic/Logic_lemmas/eq_ind_r.con",0) in
+    let fresh_meta = ProofEngineHelpers.new_meta proof in
+    let irl =
+     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+    let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
+     PrimitiveTactics.exact_tac  
+      (C.Appl
+        [eq_ind_r ; ty ; t2 ; pred ; C.Meta (fresh_meta,irl) ; t1 ;equality])
+       ((curi,metasenv',pbo,pty),goal)
+;;
+
+(******************** THE FOURIER TACTIC ***********************)
 
 (* La tactique Fourier ne fonctionne de manière sûre que si les coefficients 
 des inéquations et équations sont entiers. En attendant la tactique Field.
@@ -1026,4 +1074,3 @@ let rec fourier ~status:(s_proof,s_goal)=
 ;;
 
 let fourier_tac ~status:(proof,goal) = fourier ~status:(proof,goal);;
-