# HG changeset patch
# User Christian Urban <urbanc@in.tum.de>
# Date 1253549909 -7200
# Node ID 160f287ebb75f987a4ba3458455cbd5ce4117150
# Parent  68d64432623e83e50906df67286e4d88ffbfc654# Parent  9020ee23a0200e7623dc5bdc5f7b9dc7f1c77c77
merged

diff -r 68d64432623e -r 160f287ebb75 QuotMain.thy
--- a/QuotMain.thy	Mon Sep 21 18:18:01 2009 +0200
+++ b/QuotMain.thy	Mon Sep 21 18:18:29 2009 +0200
@@ -114,11 +114,12 @@
 qed
 
 lemma REPS_same:
-  shows "R (REP a) (REP b) = (a = b)"
+  shows "R (REP a) (REP b) \<equiv> (a = b)"
+  apply (rule eq_reflection)
 proof
   assume as: "R (REP a) (REP b)"
   from rep_prop
-  obtain x y 
+  obtain x y
     where eqs: "Rep a = R x" "Rep b = R y" by blast
   from eqs have "R (Eps (R x)) (Eps (R y))" using as unfolding REP_def by simp
   then have "R x (Eps (R y))" using lem9 by simp
@@ -812,7 +813,7 @@
 ML {*@{thm arg_cong2}*}
 ML {*@{thm arg_cong2[of _ _ _ _ "op ="]} *}
 ML {* val cT = @{cpat "op ="} |> Thm.ctyp_of_term |> Thm.dest_ctyp |> hd *}
-ML {* 
+ML {*
   Toplevel.program (fn () =>
     Drule.instantiate' [SOME cT,SOME cT,SOME @{ctyp bool}] [NONE,NONE,NONE,NONE,SOME (@{cpat "op ="})] @{thm arg_cong2}
   )
@@ -836,8 +837,8 @@
       val concl = Thm.cprem_of thm n;
       val (_, cconcl) = Thm.dest_comb concl;
       val rewr = foo_conv cconcl;
-      val _ = tracing (Display.string_of_thm @{context} rewr)
-      val _ = tracing (Display.string_of_thm @{context} thm)
+(*      val _ = tracing (Display.string_of_thm @{context} rewr)
+      val _ = tracing (Display.string_of_thm @{context} thm)*)
     in
       rtac rewr n thm
     end
@@ -847,14 +848,15 @@
 (* Has all the theorems about fset plugged in. These should be parameters to the tactic *)
 
 ML {*
-  val foo_tac' =
-    FIRST' [
+  fun foo_tac' ctxt =
+    REPEAT_ALL_NEW (FIRST' [
       rtac @{thm list_eq_sym},
       rtac @{thm cons_preserves},
       rtac @{thm mem_respects},
-      foo_tac,
-      simp_tac (@{simpset} addsimps @{thms QUOT_TYPE_I_fset.REP_ABS_rsp})
-    ]
+      rtac @{thm QUOT_TYPE_I_fset.R_trans2},
+      CHANGED o (simp_tac ((Simplifier.context ctxt HOL_ss) addsimps @{thms QUOT_TYPE_I_fset.REP_ABS_rsp})),
+      foo_tac
+    ])
 *}
 
 thm m1
@@ -868,11 +870,7 @@
 
 prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal2) *}
   apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} )
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
+  apply (tactic {* foo_tac' @{context} 1 *})
   done
 
 
@@ -883,13 +881,10 @@
   val cgoal = cterm_of @{theory} goal
   val cgoal2 = Thm.rhs_of (MetaSimplifier.rewrite false fset_defs_sym cgoal)
 *}
-(* prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal2) *}
+prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal2) *}
   apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} )
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 2 *})
-  apply (tactic {* foo_tac' 2 *})
-  apply (tactic {* foo_tac' 2 *})
-  apply (tactic {* foo_tac' 1 *}) *)
+  apply (tactic {* foo_tac' @{context} 1 *})
+  sorry
 
 thm m2
 ML {*
@@ -900,19 +895,7 @@
 *}
 prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal2) *}
   apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} )
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
+  apply (tactic {* foo_tac' @{context} 1 *})
   done
 
 thm list_eq.intros(4)
@@ -927,19 +910,10 @@
 (* It is the same, but we need a name for it. *)
 prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal3) *} sorry
 lemma zzz :
-  "(REP_fset (INSERT a (INSERT a (ABS_fset xs))) \<approx>
-    REP_fset (INSERT a (ABS_fset xs))) =  (a # a # xs \<approx> a # xs)"
+  "(REP_fset (INSERT a (INSERT a (ABS_fset xs))) \<approx> REP_fset (INSERT a (ABS_fset xs)))
+    = (a # a # xs \<approx> a # xs)"
   apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} )
-  apply (simp only: QUOT_TYPE_I_fset.REP_ABS_rsp)
-  apply (rule QUOT_TYPE_I_fset.R_trans2)
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
+  apply (tactic {* foo_tac' @{context} 1 *})
   done
 
 lemma zzz' :
@@ -947,7 +921,20 @@
   using list_eq.intros(4) by (simp only: zzz)
 
 thm QUOT_TYPE_I_fset.REPS_same
-ML {* MetaSimplifier.rewrite_rule @{thms QUOT_TYPE_I_fset.REPS_same} @{thm zzz'} *}
+ML {* val zzz'' = MetaSimplifier.rewrite_rule @{thms QUOT_TYPE_I_fset.REPS_same} @{thm zzz'} *}
+
+ML Drule.instantiate'
+ML {* zzz'' *}
+text {*
+  A variable export will still be necessary in the end, but this is already the final theorem.
+*}
+ML {*
+  Toplevel.program (fn () =>
+    MetaSimplifier.rewrite_rule @{thms QUOT_TYPE_I_fset.thm10} (
+      Drule.instantiate' [] [NONE,SOME (@{cpat "REP_fset x"})] zzz''
+    )
+  )
+*}
 
 thm list_eq.intros(5)
 ML {*
@@ -958,15 +945,7 @@
 *}
 prove {* HOLogic.mk_Trueprop (Thm.term_of cgoal2) *}
   apply (tactic {* LocalDefs.unfold_tac @{context} fset_defs *} )
-  apply (rule QUOT_TYPE_I_fset.R_trans2)
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
-  apply (tactic {* foo_tac' 1 *})
+  apply (tactic {* foo_tac' @{context} 1 *})
   done
 
 (*