QuotMain.thy
changeset 429 cd6ce3322b8f
parent 428 f62d59cd8e1b
parent 427 5a3965aa4d80
child 431 5b298c42f6c8
--- a/QuotMain.thy	Sat Nov 28 04:37:04 2009 +0100
+++ b/QuotMain.thy	Sat Nov 28 04:37:30 2009 +0100
@@ -511,11 +511,11 @@
     DT ctxt "4" (rtac @{thm impI} THEN' atac),
     DT ctxt "5" (rtac @{thm implication_twice}),
     DT ctxt "6" (EqSubst.eqsubst_tac ctxt [0]
-      [(@{thm equiv_res_forall} OF [rel_eqv]),
-       (@{thm equiv_res_exists} OF [rel_eqv])]),
+      [(@{thm ball_reg_eqv} OF [rel_eqv]),
+       (@{thm ball_reg_eqv} OF [rel_eqv])]),
     (* For a = b \<longrightarrow> a \<approx> b *)
     DT ctxt "7" (rtac @{thm impI} THEN' (asm_full_simp_tac HOL_ss) THEN' (resolve_tac rel_refl)),
-    DT ctxt "8" (rtac @{thm RIGHT_RES_FORALL_REGULAR})
+    DT ctxt "8" (rtac @{thm ball_reg_right})
   ]);
 *}
 
@@ -534,41 +534,6 @@
 lemma [mono]: "P \<longrightarrow> Q \<Longrightarrow> \<not>Q \<longrightarrow> \<not>P"
 by auto
 
-lemma ball_respects_refl:
-  fixes P Q::"'a \<Rightarrow> bool"
-  and x::"'a"
-  assumes a: "EQUIV R2"
-  and     b: "\<And>f. Q (f x) \<longrightarrow> P (f x)"
-  shows   "(Ball (Respects (R1 ===> R2)) (\<lambda>f. Q (f x)) \<longrightarrow> All (\<lambda>f. P (f x)))"
-apply(rule impI)
-apply(rule allI)
-apply(drule_tac x="\<lambda>y. f x" in bspec)
-apply(simp add: Respects_def IN_RESPECTS)
-apply(rule impI)
-using a EQUIV_REFL_SYM_TRANS[of "R2"]
-apply(simp add: REFL_def)
-using b
-apply(simp)
-done
-
-lemma bex_respects_refl:
-  fixes P Q::"'a \<Rightarrow> bool"
-  and x::"'a"
-  assumes a: "EQUIV R2"
-  and     b: "\<And>f. P (f x) \<longrightarrow> Q (f x)"
-  shows   "(Ex (\<lambda>f. P (f x))) \<longrightarrow> (Bex (Respects (R1 ===> R2)) (\<lambda>f. Q (f x)))"
-apply(rule impI)
-apply(erule exE)
-thm bexI
-apply(rule_tac x="\<lambda>y. f x" in bexI)
-using b
-apply(simp)
-apply(simp add: Respects_def IN_RESPECTS)
-apply(rule impI)
-using a EQUIV_REFL_SYM_TRANS[of "R2"]
-apply(simp add: REFL_def)
-done
-
 (* FIXME: OPTION_EQUIV, PAIR_EQUIV, ... *)
 ML {*
 fun equiv_tac rel_eqvs =
@@ -582,6 +547,7 @@
 fun SOLVES' tac = tac THEN_ALL_NEW (fn _ => no_tac)
 *}
 
+(*
 ML {*
 fun regularize_tac ctxt rel_eqvs rel_refl =
   let
@@ -603,6 +569,7 @@
      (rtac @{thm impI} THEN' (asm_full_simp_tac HOL_ss) THEN' (resolve_tac rel_refl))])
   end
 *}
+*)
 
 section {* Injections of REP and ABSes *}
 
@@ -1015,6 +982,13 @@
 end 
 *}
 
+(* Rewrites the term with LAMBDA_PRS thm.
+
+Replaces: (Rep1 ---> Abs2) (\<lambda>x. Rep2 (f (Abs1 x)))
+    with: f
+
+It proves the QUOTIENT assumptions by calling quotient_tac
+ *)
 ML {*
 fun lambda_prs_conv1 ctxt quot_thms ctrm =
   case (term_of ctrm) of ((Const (@{const_name "fun_map"}, _) $ r1 $ a2) $ (Abs _)) =>
@@ -1196,7 +1170,7 @@
       EVERY1 
        [rtac rule, 
         RANGE [rtac rthm',
-               regularize_tac lthy rel_eqv rel_refl,
+               regularize_tac lthy (hd rel_eqv) rel_refl, (* temporary hd *)
                REPEAT_ALL_NEW (r_mk_comb_tac lthy rty quot rel_refl trans2 rsp_thms),
                clean_tac lthy quot defs aps]] 
     end) lthy