Nominal/Nominal2_Abs.thy
changeset 2669 1d1772a89026
parent 2668 92c001d93225
child 2671 eef49daac6c8
--- a/Nominal/Nominal2_Abs.thy	Tue Jan 18 06:55:18 2011 +0100
+++ b/Nominal/Nominal2_Abs.thy	Tue Jan 18 11:02:57 2011 +0100
@@ -342,6 +342,41 @@
     by (auto dest: disjoint_right_eq)
 qed
 
+lemma alpha_abs_res_stronger1:
+  fixes x::"'a::fs"
+  assumes asm: "(as, x) \<approx>res (op =) supp p' (as', x')" 
+  shows "\<exists>p. (as, x) \<approx>res (op =) supp p (as', x') \<and> supp p \<subseteq> (supp x \<inter> as) \<union> (supp x' \<inter> as')" 
+proof -
+  from asm have 0: "(supp x - as) \<sharp>* p'" by  (auto simp only: alphas)
+  then have #: "p' \<bullet> (supp x - as) = (supp x - as)" 
+    by (simp add: atom_set_perm_eq)
+  have "finite (supp x)" by (simp add: finite_supp)
+  then obtain p where *: "\<forall>b \<in> supp x. p \<bullet> b = p' \<bullet> b" and **: "supp p \<subseteq> supp x \<union> p' \<bullet> supp x"
+    using set_renaming_perm by blast
+  from * have a: "p \<bullet> x = p' \<bullet> x" using supp_perm_perm_eq by auto
+  from 0 have 1: "(supp x - as) \<sharp>* p" using *
+    by (auto simp add: fresh_star_def fresh_perm)
+  then have 2: "(supp x - as) \<inter> supp p = {}"
+    by (auto simp add: fresh_star_def fresh_def)
+  have b: "supp x = (supp x - as) \<union> (supp x \<inter> as)" by auto
+  have "supp p \<subseteq> supp x \<union> p' \<bullet> supp x" using ** by simp
+  also have "\<dots> = (supp x - as) \<union> (supp x \<inter> as) \<union> (p' \<bullet> ((supp x - as) \<union> (supp x \<inter> as)))" 
+    using b by simp
+  also have "\<dots> = (supp x - as) \<union> (supp x \<inter> as) \<union> ((p' \<bullet> (supp x - as)) \<union> (p' \<bullet> (supp x \<inter> as)))"
+    by (simp add: union_eqvt)
+  also have "\<dots> = (supp x - as) \<union> (supp x \<inter> as) \<union> (p' \<bullet> (supp x \<inter> as))" 
+    using # by auto
+  also have "\<dots> = (supp x - as) \<union> (supp x \<inter> as) \<union> (supp x' \<inter> as')" using asm
+    by (simp add: supp_property_res)
+  finally have "supp p \<subseteq> (supp x - as) \<union> (supp x \<inter> as) \<union> (supp x' \<inter> as')" .
+  then 
+  have "supp p \<subseteq> (supp x \<inter> as) \<union> (supp x' \<inter> as')" using 2 by auto
+  moreover 
+  have "(as, x) \<approx>res (op =) supp p (as', x')" using asm 1 a by (simp add: alphas)
+  ultimately 
+  show "\<exists>p. (as, x) \<approx>res (op =) supp p (as', x') \<and> supp p \<subseteq> (supp x \<inter> as) \<union> (supp x' \<inter> as')" by blast
+qed
+
 
 
 section {* Quotient types *}