QuotMain.thy
changeset 252 e30997c88050
parent 251 c770f36f9459
child 253 e169a99c6ada
child 254 77ff9624cfd6
--- a/QuotMain.thy	Fri Oct 30 18:31:06 2009 +0100
+++ b/QuotMain.thy	Fri Oct 30 19:03:53 2009 +0100
@@ -517,25 +517,31 @@
        (my_reg lthy rel rty (prop_of thm)))
 *}
 
-lemma eq_rr: "(\<And>x. R x x) \<Longrightarrow> a = b \<Longrightarrow> R a b"
-by (auto)
+lemma universal_twice: "(\<And>x. (P x \<longrightarrow> Q x)) \<Longrightarrow> ((\<forall>x. P x) \<longrightarrow> (\<forall>x. Q x))"
+apply (auto)
+done
+
+lemma implication_twice: "(c \<longrightarrow> a) \<Longrightarrow> (a \<Longrightarrow> b \<longrightarrow> d) \<Longrightarrow> (a \<longrightarrow> b) \<longrightarrow> (c \<longrightarrow> d)"
+apply (auto)
+done
 
 ML {*
 fun regularize thm rty rel rel_eqv rel_refl lthy =
   let
     val g = build_regularize_goal thm rty rel lthy;
     fun tac ctxt =
+      (ObjectLogic.full_atomize_tac) THEN'
      REPEAT_ALL_NEW (FIRST' [
       rtac rel_refl,
       atac,
-      (rtac @{thm  allI} THEN' dtac @{thm spec}),
+      rtac @{thm universal_twice},
+      rtac @{thm implication_twice},
       (fn i => CHANGED (asm_full_simp_tac ((Simplifier.context ctxt HOL_ss) addsimps
         [(@{thm equiv_res_forall} OF [rel_eqv]),
          (@{thm equiv_res_exists} OF [rel_eqv])]) i)),
-      MetisTools.metis_tac ctxt [],
-      rtac (@{thm eq_rr} OF [rel_refl]),
-      ((rtac @{thm RIGHT_RES_FORALL_REGULAR}) THEN' (RANGE [fn _ => all_tac, atac]))
-    ]);
+      (rtac @{thm impI} THEN' (asm_full_simp_tac (Simplifier.context ctxt HOL_ss)) THEN' rtac rel_refl),
+      (rtac @{thm RIGHT_RES_FORALL_REGULAR})
+     ]);
     val cthm = Goal.prove lthy [] [] g (fn x => tac (#context x) 1);
   in
     cthm OF [thm]