# HG changeset patch
# User Christian Urban <urbanc@in.tum.de>
# Date 1287148283 -3600
# Node ID 767161329839840db5b3991f873cc3f8fca49c6f
# Parent  22c37deb3dacbfac486d40d1967ae787ac7ebb5a
further cleaning

diff -r 22c37deb3dac -r 767161329839 Nominal/FSet.thy
--- a/Nominal/FSet.thy	Fri Oct 15 13:28:39 2010 +0100
+++ b/Nominal/FSet.thy	Fri Oct 15 14:11:23 2010 +0100
@@ -2,14 +2,14 @@
     Author:     Cezary Kaliszyk, TU Munich
     Author:     Christian Urban, TU Munich
 
-A reasoning infrastructure for the type of finite sets.
+    Type of finite sets.
 *)
 
 theory FSet
 imports Quotient_List
 begin
 
-text {* Definiton of List relation and the quotient type *}
+text {* Definiton of the list equivalence relation *}
 
 fun
   list_eq :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" (infix "\<approx>" 50)
@@ -22,12 +22,15 @@
   unfolding reflp_def symp_def transp_def
   by auto
 
+text {* Fset type *}
+
 quotient_type
   'a fset = "'a list" / "list_eq"
   by (rule list_eq_equivp)
 
-text {* Raw definitions of membership, sublist, cardinality,
-  intersection
+text {* 
+  Definitions of membership, sublist, cardinality,
+  intersection etc over lists
 *}
 
 definition
@@ -45,6 +48,13 @@
 where
   "fcard_raw xs = card (set xs)"
 
+(*
+definition
+  finter_raw :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
+where
+  "finter_raw xs ys \<equiv> [x \<leftarrow> xs. x\<notin>set ys]"
+*)
+
 primrec
   finter_raw :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
@@ -73,7 +83,19 @@
        else f a (ffold_raw f z xs)
      else z)"
 
-text {* Composition Quotient *}
+
+
+lemma set_finter_raw[simp]:
+  shows "set (finter_raw xs ys) = set xs \<inter> set ys"
+  by (induct xs) (auto simp add: memb_def)
+
+lemma set_fminus_raw[simp]: 
+  shows "set (fminus_raw xs ys) = (set xs - set ys)"
+  by (induct ys arbitrary: xs) (auto)
+
+
+
+section {* Quotient composition lemmas *}
 
 lemma list_all2_refl1:
   shows "(list_all2 op \<approx>) r r"
@@ -151,20 +173,11 @@
 qed
 
 
-lemma set_finter_raw[simp]:
-  "set (finter_raw xs ys) = set xs \<inter> set ys"
-  by (induct xs) (auto simp add: memb_def)
-
-lemma set_fminus_raw[simp]: 
-  "set (fminus_raw xs ys) = (set xs - set ys)"
-  by (induct ys arbitrary: xs) (auto)
-
-
 text {* Respectfulness *}
 
 lemma append_rsp[quot_respect]:
   shows "(op \<approx> ===> op \<approx> ===> op \<approx>) append append"
-  by (simp)
+  by simp
 
 lemma sub_list_rsp[quot_respect]:
   shows "(op \<approx> ===> op \<approx> ===> op =) sub_list sub_list"
@@ -212,23 +225,6 @@
 
 
 
-lemma not_memb_nil:
-  shows "\<not> memb x []"
-  by (simp add: memb_def)
-
-lemma memb_cons_iff:
-  shows "memb x (y # xs) = (x = y \<or> memb x xs)"
-  by (induct xs) (auto simp add: memb_def)
-
-lemma memb_absorb:
-  shows "memb x xs \<Longrightarrow> x # xs \<approx> xs"
-  by (induct xs) (auto simp add: memb_def)
-
-lemma none_memb_nil:
-  "(\<forall>x. \<not> memb x xs) = (xs \<approx> [])"
-  by (simp add: memb_def)
-
-
 lemma memb_commute_ffold_raw:
   "rsp_fold f \<Longrightarrow> h \<in> set b \<Longrightarrow> ffold_raw f z b = f h (ffold_raw f z (removeAll h b))"
   apply (induct b)
@@ -302,13 +298,6 @@
   shows "(op = ===> op \<approx> ===> op \<approx>) filter filter"
   by auto
 
-text {* Distributive lattice with bot *}
-
-lemma append_inter_distrib:
-  "x @ (finter_raw y z) \<approx> finter_raw (x @ y) (x @ z)"
-  apply (induct x)
-  apply (auto)
-  done
 
 instantiation fset :: (type) "{bounded_lattice_bot, distrib_lattice, minus}"
 begin
@@ -366,6 +355,12 @@
 is
   "fminus_raw :: 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
 
+lemma append_finter_raw_distrib:
+  "x @ (finter_raw y z) \<approx> finter_raw (x @ y) (x @ z)"
+  apply (induct x)
+  apply (auto)
+  done
+
 instance
 proof
   fix x y z :: "'a fset"
@@ -381,7 +376,7 @@
   show "x |\<inter>| y |\<subseteq>| y" 
     by (descending) (simp add: sub_list_def memb_def[symmetric])
   show "x |\<union>| (y |\<inter>| z) = x |\<union>| y |\<inter>| (x |\<union>| z)" 
-    by (descending) (rule append_inter_distrib)
+    by (descending) (rule append_finter_raw_distrib)
 next
   fix x y z :: "'a fset"
   assume a: "x |\<subseteq>| y"
@@ -595,23 +590,14 @@
   shows "\<not>(fcard_raw A = 0)"
 proof -
   have "\<not>(\<forall>x. \<not> memb x A)" using a by auto
-  then have "\<not>A \<approx> []" using none_memb_nil[of A] by simp
+  then have "\<not>A \<approx> []" by (simp add: memb_def)
   then show ?thesis using fcard_raw_0[of A] by simp
 qed
 
 
 
-section {* fmap *}
-
-(* there is another fmap section below *)
+section {* ? *}
 
-lemma map_append:
-  "map f (xs @ ys) \<approx> (map f xs) @ (map f ys)"
-  by simp
-
-lemma memb_append:
-  "memb x (xs @ ys) \<longleftrightarrow> memb x xs \<or> memb x ys"
-  by (induct xs) (simp_all add: not_memb_nil memb_cons_iff)
 
 lemma fset_raw_strong_cases:
   obtains "xs = []"
@@ -687,7 +673,7 @@
   apply (induct A)
   apply (simp add: memb_def list_eq2_refl)
   apply (case_tac "memb a (aa # A)")
-  apply (simp_all only: memb_cons_iff)
+  apply (simp_all only: memb_def)
   apply (case_tac [!] "a = aa")
   apply (simp_all)
   apply (case_tac "memb a A")
@@ -785,16 +771,16 @@
 
 lemma fset_simps[simp]:
   "fset {||} = ({} :: 'a set)"
-  "fset (finsert (h :: 'a) t) = insert h (fset t)"
+  "fset (finsert (x :: 'a) S) = insert x (fset S)"
   by (lifting set.simps)
 
-lemma in_fset:
-  "x \<in> fset S \<equiv> x |\<in>| S"
+lemma fin_fset:
+  "x \<in> fset S \<longleftrightarrow> x |\<in>| S"
   by (lifting memb_def[symmetric])
 
 lemma none_fin_fempty:
   "(\<forall>x. x |\<notin>| S) \<longleftrightarrow> S = {||}"
-  by (lifting none_memb_nil)
+  by (descending) (simp add: memb_def)
 
 lemma fset_cong:
   "S = T \<longleftrightarrow> fset S = fset T"
@@ -949,12 +935,11 @@
 
 lemma fmap_funion: 
   shows "fmap f (S |\<union>| T) = fmap f S |\<union>| fmap f T"
-  by (lifting map_append)
+  by (descending) (simp)
 
 lemma fin_funion:
   shows "x |\<in>| S |\<union>| T \<longleftrightarrow> x |\<in>| S \<or> x |\<in>| T"
-  by (lifting memb_append)
-
+  by (descending) (simp add: memb_def)
 
 section {* fset *}