# HG changeset patch # User Christian Urban # Date 1295330118 -3600 # Node ID 92c001d932258402bdd0b8cb3f9853a02407ab43 # Parent e3f8673085b15418d394ef030098f0658ecde093 modified the renaming_perm lemmas diff -r e3f8673085b1 -r 92c001d93225 Nominal/Nominal2_Abs.thy --- a/Nominal/Nominal2_Abs.thy Mon Jan 17 17:20:21 2011 +0100 +++ b/Nominal/Nominal2_Abs.thy Tue Jan 18 06:55:18 2011 +0100 @@ -250,6 +250,102 @@ apply(rule_tac [!] x="p \ pa" in exI) by (auto simp add: fresh_star_permute_iff permute_eqvt[symmetric]) + +section {* Strengthening the equivalence *} + +lemma disjoint_right_eq: + assumes a: "A \ B1 = A \ B2" + and b: "A \ B1 = {}" "A \ B2 = {}" + shows "B1 = B2" +using a b +by (metis Int_Un_distrib2 Int_absorb2 Int_commute Un_upper2) + +lemma supp_property_set: + assumes a: "(as, x) \set (op =) supp p (as', x')" + shows "p \ (supp x \ as) = supp x' \ as'" +proof - + from a have "(supp x - as) \* p" by (auto simp only: alphas) + then have *: "p \ (supp x - as) = (supp x - as)" + by (simp add: atom_set_perm_eq) + have "(supp x' - as') \ (supp x' \ as') = supp x'" by auto + also have "\ = supp (p \ x)" using a by (simp add: alphas) + also have "\ = p \ (supp x)" by (simp add: supp_eqvt) + also have "\ = p \ ((supp x - as) \ (supp x \ as))" by auto + also have "\ = (p \ (supp x - as)) \ (p \ (supp x \ as))" by (simp add: union_eqvt) + also have "\ = (supp x - as) \ (p \ (supp x \ as))" using * by simp + also have "\ = (supp x' - as') \ (p \ (supp x \ as))" using a by (simp add: alphas) + finally have "(supp x' - as') \ (supp x' \ as') = (supp x' - as') \ (p \ (supp x \ as))" . + moreover + have "(supp x' - as') \ (supp x' \ as') = {}" by auto + moreover + have "(supp x - as) \ (supp x \ as) = {}" by auto + then have "p \ ((supp x - as) \ (supp x \ as) = {})" by (simp add: permute_bool_def) + then have "(p \ (supp x - as)) \ (p \ (supp x \ as)) = {}" by (perm_simp) (simp) + then have "(supp x - as) \ (p \ (supp x \ as)) = {}" using * by simp + then have "(supp x' - as') \ (p \ (supp x \ as)) = {}" using a by (simp add: alphas) + ultimately show "p \ (supp x \ as) = supp x' \ as'" + by (auto dest: disjoint_right_eq) +qed + +lemma supp_property_res: + assumes a: "(as, x) \res (op =) supp p (as', x')" + shows "p \ (supp x \ as) = supp x' \ as'" +proof - + from a have "(supp x - as) \* p" by (auto simp only: alphas) + then have *: "p \ (supp x - as) = (supp x - as)" + by (simp add: atom_set_perm_eq) + have "(supp x' - as') \ (supp x' \ as') = supp x'" by auto + also have "\ = supp (p \ x)" using a by (simp add: alphas) + also have "\ = p \ (supp x)" by (simp add: supp_eqvt) + also have "\ = p \ ((supp x - as) \ (supp x \ as))" by auto + also have "\ = (p \ (supp x - as)) \ (p \ (supp x \ as))" by (simp add: union_eqvt) + also have "\ = (supp x - as) \ (p \ (supp x \ as))" using * by simp + also have "\ = (supp x' - as') \ (p \ (supp x \ as))" using a by (simp add: alphas) + finally have "(supp x' - as') \ (supp x' \ as') = (supp x' - as') \ (p \ (supp x \ as))" . + moreover + have "(supp x' - as') \ (supp x' \ as') = {}" by auto + moreover + have "(supp x - as) \ (supp x \ as) = {}" by auto + then have "p \ ((supp x - as) \ (supp x \ as) = {})" by (simp add: permute_bool_def) + then have "(p \ (supp x - as)) \ (p \ (supp x \ as)) = {}" by (perm_simp) (simp) + then have "(supp x - as) \ (p \ (supp x \ as)) = {}" using * by simp + then have "(supp x' - as') \ (p \ (supp x \ as)) = {}" using a by (simp add: alphas) + ultimately show "p \ (supp x \ as) = supp x' \ as'" + by (auto dest: disjoint_right_eq) +qed + +lemma supp_property_list: + assumes a: "(as, x) \lst (op =) supp p (as', x')" + shows "p \ (supp x \ set as) = supp x' \ set as'" +proof - + from a have "(supp x - set as) \* p" by (auto simp only: alphas) + then have *: "p \ (supp x - set as) = (supp x - set as)" + by (simp add: atom_set_perm_eq) + have "(supp x' - set as') \ (supp x' \ set as') = supp x'" by auto + also have "\ = supp (p \ x)" using a by (simp add: alphas) + also have "\ = p \ (supp x)" by (simp add: supp_eqvt) + also have "\ = p \ ((supp x - set as) \ (supp x \ set as))" by auto + also have "\ = (p \ (supp x - set as)) \ (p \ (supp x \ set as))" by (simp add: union_eqvt) + also have "\ = (supp x - set as) \ (p \ (supp x \ set as))" using * by simp + also have "\ = (supp x' - set as') \ (p \ (supp x \ set as))" using a by (simp add: alphas) + finally + have "(supp x' - set as') \ (supp x' \ set as') = (supp x' - set as') \ (p \ (supp x \ set as))" . + moreover + have "(supp x' - set as') \ (supp x' \ set as') = {}" by auto + moreover + have "(supp x - set as) \ (supp x \ set as) = {}" by auto + then have "p \ ((supp x - set as) \ (supp x \ set as) = {})" by (simp add: permute_bool_def) + then have "(p \ (supp x - set as)) \ (p \ (supp x \ set as)) = {}" by (perm_simp) (simp) + then have "(supp x - set as) \ (p \ (supp x \ set as)) = {}" using * by simp + then have "(supp x' - set as') \ (p \ (supp x \ set as)) = {}" using a by (simp add: alphas) + ultimately show "p \ (supp x \ set as) = supp x' \ set as'" + by (auto dest: disjoint_right_eq) +qed + + + +section {* Quotient types *} + quotient_type 'a abs_set = "(atom set \ 'a::pt)" / "alpha_abs_set" and 'b abs_res = "(atom set \ 'b::pt)" / "alpha_abs_res" @@ -550,7 +646,8 @@ shows "\q. [bs]set. x = [p \ bs]set. (q \ x) \ q \ bs = p \ bs" proof - from b set_renaming_perm - obtain q where *: "q \ bs = p \ bs" and **: "supp q \ bs \ (p \ bs)" by blast + obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast + have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) have "[bs]set. x = q \ ([bs]set. x)" apply(rule perm_supp_eq[symmetric]) using a ** @@ -558,8 +655,8 @@ unfolding fresh_star_def by auto also have "\ = [q \ bs]set. (q \ x)" by simp - finally have "[bs]set. x = [p \ bs]set. (q \ x)" by (simp add: *) - then show "\q. [bs]set. x = [p \ bs]set. (q \ x) \ q \ bs = p \ bs" using * by metis + finally have "[bs]set. x = [p \ bs]set. (q \ x)" by (simp add: ***) + then show "\q. [bs]set. x = [p \ bs]set. (q \ x) \ q \ bs = p \ bs" using *** by metis qed lemma Abs_rename_res: @@ -569,7 +666,8 @@ shows "\q. [bs]res. x = [p \ bs]res. (q \ x) \ q \ bs = p \ bs" proof - from b set_renaming_perm - obtain q where *: "q \ bs = p \ bs" and **: "supp q \ bs \ (p \ bs)" by blast + obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast + have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) have "[bs]res. x = q \ ([bs]res. x)" apply(rule perm_supp_eq[symmetric]) using a ** @@ -577,8 +675,8 @@ unfolding fresh_star_def by auto also have "\ = [q \ bs]res. (q \ x)" by simp - finally have "[bs]res. x = [p \ bs]res. (q \ x)" by (simp add: *) - then show "\q. [bs]res. x = [p \ bs]res. (q \ x) \ q \ bs = p \ bs" using * by metis + finally have "[bs]res. x = [p \ bs]res. (q \ x)" by (simp add: ***) + then show "\q. [bs]res. x = [p \ bs]res. (q \ x) \ q \ bs = p \ bs" using *** by metis qed lemma Abs_rename_lst: @@ -587,7 +685,8 @@ shows "\q. [bs]lst. x = [p \ bs]lst. (q \ x) \ q \ bs = p \ bs" proof - from a list_renaming_perm - obtain q where *: "q \ bs = p \ bs" and **: "supp q \ set bs \ (p \ set bs)" by blast + obtain q where *: "\b \ set bs. q \ b = p \ b" and **: "supp q \ set bs \ (p \ set bs)" by blast + have ***: "q \ bs = p \ bs" using * by (induct bs) (simp_all add: insert_eqvt) have "[bs]lst. x = q \ ([bs]lst. x)" apply(rule perm_supp_eq[symmetric]) using a ** @@ -595,8 +694,8 @@ unfolding fresh_star_def by auto also have "\ = [q \ bs]lst. (q \ x)" by simp - finally have "[bs]lst. x = [p \ bs]lst. (q \ x)" by (simp add: *) - then show "\q. [bs]lst. x = [p \ bs]lst. (q \ x) \ q \ bs = p \ bs" using * by metis + finally have "[bs]lst. x = [p \ bs]lst. (q \ x)" by (simp add: ***) + then show "\q. [bs]lst. x = [p \ bs]lst. (q \ x) \ q \ bs = p \ bs" using *** by metis qed diff -r e3f8673085b1 -r 92c001d93225 Nominal/Nominal2_Base.thy --- a/Nominal/Nominal2_Base.thy Mon Jan 17 17:20:21 2011 +0100 +++ b/Nominal/Nominal2_Base.thy Tue Jan 18 06:55:18 2011 +0100 @@ -1785,7 +1785,22 @@ by (metis permute_minus_cancel permute_plus) qed - +lemma atom_set_perm_eq: + assumes a: "as \* p" + shows "p \ as = as" +proof - + from a have "supp p \ {a. a \ as}" + unfolding supp_perm fresh_star_def fresh_def by auto + then show "p \ as = as" + proof (induct p rule: perm_struct_induct) + case zero + show "0 \ as = as" by simp + next + case (swap p a b) + then have "a \ as" "b \ as" "p \ as = as" by simp_all + then show "((a \ b) + p) \ as = as" by (simp add: swap_set_not_in) + qed +qed section {* Avoiding of atom sets *} @@ -1910,38 +1925,34 @@ section {* Renaming permutations *} + lemma set_renaming_perm: assumes b: "finite bs" - shows "\q. q \ bs = p \ bs \ supp q \ bs \ (p \ bs)" + shows "\q. (\b \ bs. q \ b = p \ b) \ supp q \ bs \ (p \ bs)" using b proof (induct) case empty - have "0 \ {} = p \ {} \ supp (0::perm) \ {} \ p \ {}" + have "(\b \ {}. 0 \ b = p \ b) \ supp (0::perm) \ {} \ p \ {}" by (simp add: permute_set_eq supp_perm) - then show "\q. q \ {} = p \ {} \ supp q \ {} \ p \ {}" by blast + then show "\q. (\b \ {}. q \ b = p \ b) \ supp q \ {} \ p \ {}" by blast next case (insert a bs) - then have " \q. q \ bs = p \ bs \ supp q \ bs \ p \ bs" - by (simp add: insert_eqvt) - then obtain q where *: "q \ bs = p \ bs" and **: "supp q \ bs \ p \ bs" by blast + then have " \q. (\b \ bs. q \ b = p \ b) \ supp q \ bs \ p \ bs" by simp + then obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ p \ bs" + by (metis empty_subsetI insert(3) supp_swap) { assume 1: "q \ a = p \ a" - have "q \ insert a bs = p \ insert a bs" using 1 * by (simp add: insert_eqvt) + have "\b \ (insert a bs). q \ b = p \ b" using 1 * by simp moreover have "supp q \ insert a bs \ p \ insert a bs" using ** by (auto simp add: insert_eqvt) ultimately - have "\q. q \ insert a bs = p \ insert a bs \ supp q \ insert a bs \ p \ insert a bs" by blast + have "\q. (\b \ insert a bs. q \ b = p \ b) \ supp q \ insert a bs \ p \ insert a bs" by blast } moreover { assume 2: "q \ a \ p \ a" def q' \ "((q \ a) \ (p \ a)) + q" - { have "(q \ a) \ (p \ bs)" using `a \ bs` *[symmetric] by (simp add: mem_permute_iff) - moreover - have "(p \ a) \ (p \ bs)" using `a \ bs` by (simp add: mem_permute_iff) - ultimately - have "q' \ insert a bs = p \ insert a bs" using 2 * unfolding q'_def - by (simp add: insert_eqvt swap_set_not_in) - } + have "\b \ insert a bs. q' \ b = p \ b" using 2 * `a \ bs` unfolding q'_def + by (auto simp add: swap_atom) moreover { have "{q \ a, p \ a} \ insert a bs \ p \ insert a bs" using ** @@ -1961,45 +1972,38 @@ unfolding q'_def using supp_plus_perm by blast } ultimately - have "\q. q \ insert a bs = p \ insert a bs \ supp q \ insert a bs \ p \ insert a bs" by blast + have "\q. (\b \ insert a bs. q \ b = p \ b) \ supp q \ insert a bs \ p \ insert a bs" by blast } - ultimately show "\q. q \ insert a bs = p \ insert a bs \ supp q \ insert a bs \ p \ insert a bs" + ultimately show "\q. (\b \ insert a bs. q \ b = p \ b) \ supp q \ insert a bs \ p \ insert a bs" by blast qed + lemma list_renaming_perm: - fixes bs::"atom list" - shows "\q. q \ bs = p \ bs \ supp q \ (set bs) \ (p \ (set bs))" + shows "\q. (\b \ set bs. q \ b = p \ b) \ supp q \ set bs \ (p \ set bs)" proof (induct bs) case Nil - have "0 \ [] = p \ [] \ supp (0::perm) \ set [] \ p \ set []" - by (simp add: permute_set_eq supp_perm) - then show "\q. q \ [] = p \ [] \ supp q \ set [] \ p \ (set [])" by blast + have "(\b \ set []. 0 \ b = p \ b) \ supp (0::perm) \ set [] \ p \ set []" + by (simp add: supp_zero_perm) + then show "\q. (\b \ set []. q \ b = p \ b) \ supp q \ set [] \ p \ (set [])" by blast next case (Cons a bs) - then have " \q. q \ bs = p \ bs \ supp q \ set bs \ p \ (set bs)" - by (simp add: insert_eqvt) - then obtain q where *: "q \ bs = p \ bs" and **: "supp q \ set bs \ p \ (set bs)" by blast + then have " \q. (\b \ set bs. q \ b = p \ b) \ supp q \ set bs \ p \ (set bs)" by simp + then obtain q where *: "\b \ set bs. q \ b = p \ b" and **: "supp q \ set bs \ p \ (set bs)" + by (blast) { assume 1: "a \ set bs" have "q \ a = p \ a" using * 1 by (induct bs) (auto) - then have "q \ (a # bs) = p \ (a # bs)" using * by simp + then have "\b \ set (a # bs). q \ b = p \ b" using * by simp moreover have "supp q \ set (a # bs) \ p \ (set (a # bs))" using ** by (auto simp add: insert_eqvt) ultimately - have "\q. q \ (a # bs) = p \ (a # bs) \ supp q \ set (a # bs) \ p \ (set (a # bs))" by blast + have "\q. (\b \ set (a # bs). q \ b = p \ b) \ supp q \ set (a # bs) \ p \ (set (a # bs))" by blast } moreover { assume 2: "a \ set bs" def q' \ "((q \ a) \ (p \ a)) + q" - { have "(q \ a) \ (p \ bs)" using `a \ set bs` *[symmetric] - by (simp add: fresh_permute_iff) (simp add: fresh_def supp_of_atom_list) - moreover - have "(p \ a) \ (p \ bs)" using `a \ set bs` - by (simp add: fresh_permute_iff) (simp add: fresh_def supp_of_atom_list) - ultimately - have "q' \ (a # bs) = p \ (a # bs)" using 2 * unfolding q'_def - by (simp add: swap_fresh_fresh) - } + have "\b \ set (a # bs). q' \ b = p \ b" + unfolding q'_def using 2 * `a \ set bs` by (auto simp add: swap_atom) moreover { have "{q \ a, p \ a} \ set (a # bs) \ p \ (set (a # bs))" using ** @@ -2019,14 +2023,13 @@ unfolding q'_def using supp_plus_perm by blast } ultimately - have "\q. q \ (a # bs) = p \ (a # bs) \ supp q \ set (a # bs) \ p \ (set (a # bs))" by blast + have "\q. (\b \ set (a # bs). q \ b = p \ b) \ supp q \ set (a # bs) \ p \ (set (a # bs))" by blast } - ultimately show "\q. q \ (a # bs) = p \ (a # bs) \ supp q \ set (a # bs) \ p \ (set (a # bs))" + ultimately show "\q. (\b \ set (a # bs). q \ b = p \ b) \ supp q \ set (a # bs) \ p \ (set (a # bs))" by blast qed - section {* Concrete Atoms Types *} text {* diff -r e3f8673085b1 -r 92c001d93225 Nominal/Nominal2_Eqvt.thy --- a/Nominal/Nominal2_Eqvt.thy Mon Jan 17 17:20:21 2011 +0100 +++ b/Nominal/Nominal2_Eqvt.thy Tue Jan 18 06:55:18 2011 +0100 @@ -113,11 +113,6 @@ shows "p \ (\x. P x) = (\x. p \ P (- p \ x))" by (perm_simp add: permute_minus_cancel) (rule refl) -lemma ex1_eqvt[eqvt]: - shows "p \ (\!x. P x) = (\!x. (p \ P) x)" - unfolding Ex1_def - by (perm_simp) (rule refl) - lemma ex1_eqvt2: shows "p \ (\!x. P x) = (\!x. p \ P (- p \ x))" by (perm_simp add: permute_minus_cancel) (rule refl)