# HG changeset patch # User Cezary Kaliszyk # Date 1268997730 -3600 # Node ID 63e327e95abd948831d07613d5458171ffca3b9d # Parent 2789dd26171a31ccbaf66f5a15dc08f9168f847e Showed the instance: fset::(at) fs diff -r 2789dd26171a -r 63e327e95abd Nominal/Abs.thy --- a/Nominal/Abs.thy Fri Mar 19 10:24:49 2010 +0100 +++ b/Nominal/Abs.thy Fri Mar 19 12:22:10 2010 +0100 @@ -749,17 +749,6 @@ (* support of concrete atom sets *) -lemma atom_eqvt_raw: - fixes p::"perm" - shows "(p \ atom) = atom" -by (simp add: expand_fun_eq permute_fun_def atom_eqvt) - -lemma atom_image_cong: - shows "(atom ` X = atom ` Y) = (X = Y)" -apply(rule inj_image_eq_iff) -apply(simp add: inj_on_def) -done - lemma supp_atom_image: fixes as::"'a::at_base set" shows "supp (atom ` as) = supp as" diff -r 2789dd26171a -r 63e327e95abd Nominal/Nominal2_FSet.thy --- a/Nominal/Nominal2_FSet.thy Fri Mar 19 10:24:49 2010 +0100 +++ b/Nominal/Nominal2_FSet.thy Fri Mar 19 12:22:10 2010 +0100 @@ -61,6 +61,10 @@ lemma fset_to_set_eqvt[eqvt]: "pi \ (fset_to_set x) = fset_to_set (pi \ x)" by (lifting set_eqvt) +lemma fin_fset_to_set: + "finite (fset_to_set x)" + by (induct x) (simp_all) + lemma supp_fset_to_set: "supp (fset_to_set x) = supp x" apply (simp add: supp_def) @@ -80,28 +84,75 @@ apply (simp add: eqvts eqvts_raw atom_fmap_cong) done -(*lemma "\ (memb x S) \ \ (memb y T) \ ((x # S) \ (y # T)) = (x = y \ S \ T)"*) +lemma supp_atom_insert: + "finite (xs :: atom set) \ supp (insert x xs) = supp x \ supp xs" + apply (simp add: supp_finite_atom_set) + apply (simp add: supp_atom) + done -lemma infinite_Un: - shows "infinite (S \ T) \ infinite S \ infinite T" - by simp +lemma atom_image_cong: + shows "(atom ` X = atom ` Y) = (X = Y)" + apply(rule inj_image_eq_iff) + apply(simp add: inj_on_def) + done -lemma supp_insert: "supp (insert (x :: 'a :: fs) xs) = supp x \ supp xs" - oops +lemma atom_eqvt_raw: + fixes p::"perm" + shows "(p \ atom) = atom" + by (simp add: expand_fun_eq permute_fun_def atom_eqvt) -lemma supp_finsert: - "supp (finsert (x :: 'a :: fs) S) = supp x \ supp S" +lemma supp_finite_at_set: + fixes S::"('a :: at) set" + assumes a: "finite S" + shows "supp S = atom ` S" + apply(rule finite_supp_unique) + apply(simp add: supports_def) + apply (rule finite_induct[OF a]) + apply (simp add: eqvts) + apply (simp) + apply clarify + apply (subst atom_image_cong[symmetric]) + apply (subst atom_eqvt_raw[symmetric]) + apply (subst eqvts[symmetric]) + apply (rule swap_set_not_in) + apply simp_all + apply(rule finite_imageI) + apply(rule a) + apply (subst atom_image_cong[symmetric]) + apply (subst atom_eqvt_raw[symmetric]) + apply (subst eqvts[symmetric]) + apply (rule swap_set_in) + apply simp_all + done + +lemma supp_at_insert: + "finite (xs :: ('a :: at) set) \ supp (insert x xs) = supp x \ supp xs" + apply (simp add: supp_finite_at_set) + apply (simp add: supp_at_base) + done + +lemma supp_atom_finsert: + "supp (finsert (x :: atom) S) = supp x \ supp S" apply (subst supp_fset_to_set[symmetric]) - apply simp - (* apply (simp add: supp_insert supp_fset_to_set) *) - oops + apply (simp add: supp_finite_atom_set) + apply (simp add: supp_atom_insert[OF fin_fset_to_set]) + apply (simp add: supp_fset_to_set) + done -instance fset :: (fs) fs +lemma supp_at_finsert: + "supp (finsert (x :: 'a :: at) S) = supp x \ supp S" + apply (subst supp_fset_to_set[symmetric]) + apply (simp add: supp_finite_atom_set) + apply (simp add: supp_at_insert[OF fin_fset_to_set]) + apply (simp add: supp_fset_to_set) + done + +instance fset :: (at) fs apply (default) apply (induct_tac x rule: fset_induct) apply (simp add: supp_def eqvts) - (* apply (simp add: supp_finsert) *) - (* apply default ? *) - oops + apply (simp add: supp_at_finsert) + apply (simp add: supp_at_base) + done end