FSet.thy
changeset 450 2dc708ddb93a
parent 448 24fa145fc2e3
child 451 586e3dc4afdb
--- a/FSet.thy	Sun Nov 29 02:51:42 2009 +0100
+++ b/FSet.thy	Sun Nov 29 03:59:18 2009 +0100
@@ -178,37 +178,38 @@
 
 ML {* val defs = @{thms EMPTY_def IN_def FUNION_def CARD_def INSERT_def fmap_def FOLD_def} *}
 
-lemma memb_rsp:
+lemma memb_rsp[quot_rsp]:
   fixes z
-  assumes a: "list_eq x y"
+  assumes a: "x \<approx> y"
   shows "(z memb x) = (z memb y)"
   using a by induct auto
 
-lemma ho_memb_rsp:
+lemma ho_memb_rsp[quot_rsp]:
   "(op = ===> (op \<approx> ===> op =)) (op memb) (op memb)"
   by (simp add: memb_rsp)
 
-lemma card1_rsp:
+lemma card1_rsp[quot_rsp]:
   fixes a b :: "'a list"
   assumes e: "a \<approx> b"
   shows "card1 a = card1 b"
   using e by induct (simp_all add:memb_rsp)
 
-lemma ho_card1_rsp: "(op \<approx> ===> op =) card1 card1"
+lemma ho_card1_rsp[quot_rsp]: 
+  "(op \<approx> ===> op =) card1 card1"
   by (simp add: card1_rsp)
 
-lemma cons_rsp:
+lemma cons_rsp[quot_rsp]:
   fixes z
   assumes a: "xs \<approx> ys"
   shows "(z # xs) \<approx> (z # ys)"
   using a by (rule list_eq.intros(5))
 
-lemma ho_cons_rsp:
+lemma ho_cons_rsp[quot_rsp]:
   "(op = ===> op \<approx> ===> op \<approx>) op # op #"
   by (simp add: cons_rsp)
 
 lemma append_rsp_fst:
-  assumes a : "list_eq l1 l2"
+  assumes a : "l1 \<approx> l2"
   shows "(l1 @ s) \<approx> (l2 @ s)"
   using a
   by (induct) (auto intro: list_eq.intros list_eq_refl)
@@ -245,9 +246,9 @@
   apply (rule rev_rsp)
   done
 
-lemma append_rsp:
-  assumes a : "list_eq l1 r1"
-  assumes b : "list_eq l2 r2 "
+lemma append_rsp[quot_rsp]:
+  assumes a : "l1 \<approx> r1"
+  assumes b : "l2 \<approx> r2 "
   shows "(l1 @ l2) \<approx> (r1 @ r2)"
   apply (rule list_eq.intros(6))
   apply (rule append_rsp_fst)
@@ -260,11 +261,11 @@
   apply (rule append_sym_rsp)
   done
 
-lemma ho_append_rsp:
+lemma ho_append_rsp[quot_rsp]:
   "(op \<approx> ===> op \<approx> ===> op \<approx>) op @ op @"
   by (simp add: append_rsp)
 
-lemma map_rsp:
+lemma map_rsp[quot_rsp]:
   assumes a: "a \<approx> b"
   shows "map f a \<approx> map f b"
   using a
@@ -272,16 +273,15 @@
   apply(auto intro: list_eq.intros)
   done
 
-lemma ho_map_rsp:
+lemma ho_map_rsp[quot_rsp]:
   "(op = ===> op \<approx> ===> op \<approx>) map map"
   by (simp add: map_rsp)
 
 lemma map_append:
-  "(map f (a @ b)) \<approx>
-  (map f a) @ (map f b)"
+  "(map f (a @ b)) \<approx> (map f a) @ (map f b)"
  by simp (rule list_eq_refl)
 
-lemma ho_fold_rsp:
+lemma ho_fold_rsp[quot_rsp]:
   "(op = ===> op = ===> op = ===> op \<approx> ===> op =) fold1 fold1"
   apply (auto simp add: FUN_REL_EQ)
   apply (case_tac "rsp_fold x")
@@ -295,7 +295,6 @@
 
 print_quotients
 
-
 ML {* val qty = @{typ "'a fset"} *}
 ML {* val rsp_thms =
   @{thms ho_memb_rsp ho_cons_rsp ho_card1_rsp ho_map_rsp ho_append_rsp ho_fold_rsp}
@@ -304,7 +303,7 @@
 ML {* val (rty, rel, rel_refl, rel_eqv) = lookup_quot_data @{context} qty *}
 ML {* val (trans2, reps_same, absrep, quot) = lookup_quot_thms @{context} "fset"; *}
 ML {* val consts = lookup_quot_consts defs *}
-ML {* fun lift_tac_fset lthy t = lift_tac lthy t [rel_eqv] rty [quot] rsp_thms defs *}
+ML {* fun lift_tac_fset lthy t = lift_tac lthy t [rel_eqv] rty [quot] defs *}
 
 lemma "IN x EMPTY = False"
 by (tactic {* lift_tac_fset @{context} @{thm m1} 1 *})
@@ -328,7 +327,7 @@
 apply (tactic {* lift_tac_fset @{context} @{thm not_mem_card1} 1 *})
 done
 
-ML {* fun inj_repabs_tac_fset lthy = inj_repabs_tac lthy rty [quot] [rel_refl] [trans2] rsp_thms *}
+ML {* fun inj_repabs_tac_fset lthy = inj_repabs_tac lthy rty [quot] [rel_refl] [trans2] *}
 
 lemma "FOLD f g (z::'b) (INSERT a x) =
   (if rsp_fold f then if IN a x then FOLD f g z x else f (g a) (FOLD f g z x) else z)"
@@ -393,9 +392,6 @@
 apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* E *) (* R x y assumptions *)
 apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* A *) (* application if type needs lifting *)
 apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* 9 *) (* Rep-Abs-elim - can be complex Rep-Abs *)
-apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* E *) (* R x y assumptions *)
-apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* 9 *) (* Rep-Abs-elim - can be complex Rep-Abs *)
-apply(tactic {* inj_repabs_tac_fset @{context} 1*}) (* E *) (* R x y assumptions *)
 done
 
 quotient_def
@@ -409,21 +405,21 @@
   "fset_case \<equiv> list_case"
 
 (* Probably not true without additional assumptions about the function *)
-lemma list_rec_rsp:
+lemma list_rec_rsp[quot_rsp]:
   "(op = ===> (op = ===> op \<approx> ===> op =) ===> op \<approx> ===> op =) list_rec list_rec"
   apply (auto simp add: FUN_REL_EQ)
   apply (erule_tac list_eq.induct)
   apply (simp_all)
   sorry
 
-lemma list_case_rsp:
+lemma list_case_rsp[quot_rsp]:
   "(op = ===> (op = ===> op \<approx> ===> op =) ===> op \<approx> ===> op =) list_case list_case"
   apply (auto simp add: FUN_REL_EQ)
   sorry
 
 ML {* val rsp_thms = @{thms list_rec_rsp list_case_rsp} @ rsp_thms *}
 ML {* val defs = @{thms fset_rec_def fset_case_def} @ defs *}
-ML {* fun lift_tac_fset lthy t = lift_tac lthy t [rel_eqv] rty [quot] rsp_thms defs *}
+ML {* fun lift_tac_fset lthy t = lift_tac lthy t [rel_eqv] rty [quot] defs *}
 
 lemma "fset_rec (f1::'t) x (INSERT a xa) = x a xa (fset_rec f1 x xa)"
 apply (tactic {* lift_tac_fset @{context} @{thm list.recs(2)} 1 *})
@@ -443,7 +439,7 @@
   apply (assumption)
   done
 
-ML {* fun inj_repabs_tac_fset lthy = inj_repabs_tac lthy rty [quot] [rel_refl] [trans2] rsp_thms *}
+ML {* fun inj_repabs_tac_fset lthy = inj_repabs_tac lthy rty [quot] [rel_refl] [trans2] *}
 
 (* Construction site starts here *)
 lemma "P (x :: 'a list) (EMPTY :: 'c fset) \<Longrightarrow> (\<And>e t. P x t \<Longrightarrow> P x (INSERT e t)) \<Longrightarrow> P x l"