]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/tactics/equalityTactics.ml
- removed some unneeded dependencies from debian/control
[helm.git] / helm / ocaml / tactics / equalityTactics.ml
index 8cb794ff6e17e918eefd4f0696276a41fc806822..3af6b861dd4ddafc15c18b0e8aff8d43ecba6bc6 100644 (file)
@@ -61,9 +61,8 @@ let rewrite_tac ~term:equality ~status:(proof,goal) =
       C.Lambda
        (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
     in
-    let fresh_meta = ProofEngineHelpers.new_meta proof in
-    let irl =
-     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+    let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
+    let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
     let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
 
      let (proof',goals) =
@@ -123,9 +122,9 @@ let rewrite_back_tac ~term:equality ~status:(proof,goal) =
       C.Lambda
        (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
     in
-    let fresh_meta = ProofEngineHelpers.new_meta proof in
+    let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
     let irl =
-     ProofEngineHelpers.identity_relocation_list_for_metavariable context in
+     CicMkImplicit.identity_relocation_list_for_metavariable context in
     let metasenv' = (fresh_meta,context,C.Appl [pred ; t2])::metasenv in
 
      let (proof',goals) =
@@ -159,22 +158,31 @@ let replace_tac ~what ~with_what ~status:((proof, goal) as status) =
      let wty = CicTypeChecker.type_of_aux' metasenv context what in
       try
       if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what))
-       then T.thens
-              ~start:(
-                P.cut_tac 
-                 (C.Appl [
-                   (C.MutInd ((U.uri_of_string "cic:/Coq/Init/Logic/eq.ind"), 0, [])) ; (* quale uguaglianza usare, eq o eqT ? *)
-                     wty ; 
-                     what ; 
-                     with_what]))
-              ~continuations:[
-                T.then_
-                   ~start:(rewrite_back_tac ~term:(C.Rel 1))
-                   ~continuation:(
-                     ProofEngineStructuralRules.clear
-                      ~hyp:(List.hd context)) ;
-                T.id_tac]
-              ~status
+       then
+        let equality =
+         match CicTypeChecker.type_of_aux' metasenv context wty with
+            C.Sort C.Set -> "cic:/Coq/Init/Logic/eq.ind"
+          | C.Sort C.Type
+         | C.Sort C.CProp
+          | C.Sort C.Prop -> "cic:/Coq/Init/Logic_Type/eqT.ind"
+          | _ -> assert false
+        in
+         T.thens
+          ~start:(
+            P.cut_tac 
+             (C.Appl [
+               (C.MutInd ((U.uri_of_string equality), 0, [])) ;
+                 wty ; 
+                 what ; 
+                 with_what]))
+          ~continuations:[
+            T.then_
+               ~start:(rewrite_simpl_tac ~term:(C.Rel 1))
+               ~continuation:(
+                 ProofEngineStructuralRules.clear
+                  ~hyp:(List.hd context)) ;
+            T.id_tac]
+          ~status
        else raise (ProofEngineTypes.Fail "Replace: terms not replaceable")
        with (Failure "hd") -> raise (ProofEngineTypes.Fail "Replace: empty context")
 ;;