# HG changeset patch # User Cezary Kaliszyk # Date 1287123859 -32400 # Node ID 9bde8a508594ef6c70b761bb9ff690ce72241794 # Parent 40187684fc160bda95f08ddb0500ba50f8c7ca8c Partially merging changes from Isabelle diff -r 40187684fc16 -r 9bde8a508594 Nominal/FSet.thy --- a/Nominal/FSet.thy Thu Oct 14 17:32:06 2010 +0100 +++ b/Nominal/FSet.thy Fri Oct 15 15:24:19 2010 +0900 @@ -6,7 +6,7 @@ *) theory FSet -imports Quotient_List Quotient_Product +imports Quotient_List begin text {* Definiton of List relation and the quotient type *} @@ -26,7 +26,7 @@ 'a fset = "'a list" / "list_eq" by (rule list_eq_equivp) -text {* Raw definitions of membership, sublist, cardinality, +text {* Raw definitions of membership, sublist, cardinality, intersection *} @@ -379,7 +379,7 @@ apply (auto) done -instantiation fset :: (type) "{bounded_lattice_bot,distrib_lattice,minus}" +instantiation fset :: (type) "{bounded_lattice_bot, distrib_lattice, minus}" begin quotient_definition @@ -438,35 +438,42 @@ instance proof fix x y z :: "'a fset" - show "(x |\| y) = (x |\| y \ \ y |\| x)" + show "x |\| y \ x |\| y \ \ y |\| x" unfolding less_fset_def by (lifting sub_list_not_eq) - show "x |\| x" by (lifting sub_list_refl) - show "{||} |\| x" by (lifting sub_list_empty) - show "x |\| x |\| y" by (lifting sub_list_append_left) - show "y |\| x |\| y" by (lifting sub_list_append_right) - show "x |\| y |\| x" by (lifting sub_list_inter_left) - show "x |\| y |\| y" by (lifting sub_list_inter_right) - show "x |\| (y |\| z) = x |\| y |\| (x |\| z)" by (lifting append_inter_distrib) + show "x |\| x" by (descending) (simp add: sub_list_def) + show "{||} |\| x" by (descending) (simp add: sub_list_def) + show "x |\| x |\| y" by (descending) (simp add: sub_list_def) + show "y |\| x |\| y" by (descending) (simp add: sub_list_def) + show "x |\| y |\| x" + by (descending) (simp add: sub_list_def memb_def[symmetric]) + show "x |\| y |\| y" + by (descending) (simp add: sub_list_def memb_def[symmetric]) + show "x |\| (y |\| z) = x |\| y |\| (x |\| z)" + by (descending) (rule append_inter_distrib) next fix x y z :: "'a fset" assume a: "x |\| y" assume b: "y |\| z" - show "x |\| z" using a b by (lifting sub_list_trans) + show "x |\| z" using a b + by (descending) (simp add: sub_list_def) next fix x y :: "'a fset" assume a: "x |\| y" assume b: "y |\| x" - show "x = y" using a b by (lifting sub_list_list_eq) + show "x = y" using a b + by (descending) (unfold sub_list_def list_eq.simps, blast) next fix x y z :: "'a fset" assume a: "y |\| x" assume b: "z |\| x" - show "y |\| z |\| x" using a b by (lifting sub_list_append) + show "y |\| z |\| x" using a b + by (descending) (simp add: sub_list_def) next fix x y z :: "'a fset" assume a: "x |\| y" assume b: "x |\| z" - show "x |\| y |\| z" using a b by (lifting sub_list_inter) + show "x |\| y |\| z" using a b + by (descending) (simp add: sub_list_def memb_def[symmetric]) qed end @@ -543,11 +550,6 @@ apply auto done -lemma insert_preserve2: - shows "((rep_fset ---> (map rep_fset \ rep_fset) ---> (abs_fset \ map abs_fset)) op #) = - (id ---> rep_fset ---> abs_fset) op #" - by (simp add: fun_eq_iff abs_o_rep[OF Quotient_fset] map_id Quotient_abs_rep[OF Quotient_fset]) - lemma [quot_preserve]: "(rep_fset ---> (map rep_fset \ rep_fset) ---> (abs_fset \ map abs_fset)) op # = finsert" by (simp add: fun_eq_iff Quotient_abs_rep[OF Quotient_fset] @@ -828,17 +830,17 @@ by (lifting not_memb_nil) lemma fin_finsert_iff[simp]: - "x |\| finsert y S = (x = y \ x |\| S)" - by (lifting memb_cons_iff) + "x |\| finsert y S \ x = y \ x |\| S" + by (descending) (simp add: memb_def) lemma shows finsertI1: "x |\| finsert x S" and finsertI2: "x |\| S \ x |\| finsert y S" - by (lifting memb_consI1, lifting memb_consI2) + by (lifting memb_consI1 memb_consI2) lemma finsert_absorb[simp]: shows "x |\| S \ finsert x S = S" - by (lifting memb_absorb) + by (descending) (auto simp add: memb_def) lemma fempty_not_finsert[simp]: "{||} \ finsert x S" @@ -847,15 +849,15 @@ lemma finsert_left_comm: "finsert x (finsert y S) = finsert y (finsert x S)" - by (lifting cons_left_comm) + by (descending) (auto) lemma finsert_left_idem: "finsert x (finsert x S) = finsert x S" - by (lifting cons_left_idem) + by (descending) (auto) lemma fsingleton_eq[simp]: shows "{|x|} = {|y|} \ x = y" - by (lifting singleton_list_eq) + by (descending) (auto) text {* fset *} @@ -1013,8 +1015,9 @@ section {* fmap *} lemma fmap_simps[simp]: - "fmap (f :: 'a \ 'b) {||} = {||}" - "fmap f (finsert x S) = finsert (f x) (fmap f S)" + fixes f::"'a \ 'b" + shows "fmap f {||} = {||}" + and "fmap f (finsert x S) = finsert (f x) (fmap f S)" by (lifting map.simps) lemma fmap_set_image: @@ -1025,11 +1028,12 @@ "inj f \ (fmap f S = fmap f T) = (S = T)" by (lifting inj_map_eq_iff) -lemma fmap_funion: "fmap f (S |\| T) = fmap f S |\| fmap f T" +lemma fmap_funion: + shows "fmap f (S |\| T) = fmap f S |\| fmap f T" by (lifting map_append) lemma fin_funion: - "x |\| S |\| T \ x |\| S \ x |\| T" + shows "x |\| S |\| T \ x |\| S \ x |\| T" by (lifting memb_append) @@ -1158,7 +1162,7 @@ by (simp add: fminus_red) lemma fset_eq_iff: - "(S = T) = (\x. (x |\| S) = (x |\| T))" + shows "S = T \ (\x. (x |\| S) = (x |\| T))" by (descending) (auto simp add: memb_def) (* We cannot write it as "assumes .. shows" since Isabelle changes @@ -1197,6 +1201,10 @@ shows "fconcat (finsert x S) = x |\| fconcat S" by (lifting concat.simps(2)) +lemma + shows "fconcat (xs |\| ys) = fconcat xs |\| fconcat ys" + by (lifting concat_append) + section {* ffilter *} @@ -1318,7 +1326,6 @@ lemma fcard_fminus_subset_finter: shows "fcard (A - B) = fcard A - fcard (A |\| B)" - using assms unfolding finter_set fcard_set fminus_set by (rule card_Diff_subset_Int) (simp) @@ -1394,6 +1401,12 @@ qed qed + +ML {* +fun dest_fsetT (Type (@{type_name fset}, [T])) = T + | dest_fsetT T = raise TYPE ("dest_fsetT: fset type expected", [T], []); +*} + no_notation list_eq (infix "\" 50) diff -r 40187684fc16 -r 9bde8a508594 Quotient-Paper/Paper.thy --- a/Quotient-Paper/Paper.thy Thu Oct 14 17:32:06 2010 +0100 +++ b/Quotient-Paper/Paper.thy Fri Oct 15 15:24:19 2010 +0900 @@ -57,6 +57,11 @@ Term_Style.setup "rhs3" (style_lhs_rhs (nth_conj 2)) *} +lemma insert_preserve2: + shows "((rep_fset ---> (map rep_fset \ rep_fset) ---> (abs_fset \ map abs_fset)) op #) = + (id ---> rep_fset ---> abs_fset) op #" + by (simp add: fun_eq_iff abs_o_rep[OF Quotient_fset] map_id Quotient_abs_rep[OF Quotient_fset]) + (*>*)