diff -r fe290b4e508f -r d66430c7c4f1 Nominal/Ex/Classical.thy
--- a/Nominal/Ex/Classical.thy	Fri Jun 24 09:42:44 2011 +0100
+++ b/Nominal/Ex/Classical.thy	Sat Jun 25 21:28:24 2011 +0100
@@ -46,6 +46,93 @@
 thm trm.supp
 thm trm.supp[simplified]
 
+lemma Abs_lst1_fcb2:
+  fixes a b :: "'a :: at"
+    and S T :: "'b :: fs"
+    and c::"'c::fs"
+  assumes e: "(Abs_lst [atom a] T) = (Abs_lst [atom b] S)"
+  and fcb: "\<And>a T. atom a \<sharp> f a T c"
+  and fresh: "{atom a, atom b} \<sharp>* c"
+  and p1: "\<And>p. supp p \<sharp>* c \<Longrightarrow> p \<bullet> (f a T c) = f (p \<bullet> a) (p \<bullet> T) c"
+  and p2: "\<And>p. supp p \<sharp>* c \<Longrightarrow> p \<bullet> (f b S c) = f (p \<bullet> b) (p \<bullet> S) c"
+  shows "f a T c = f b S c"
+proof -
+  have fin1: "finite (supp (f a T c))"
+    apply(rule_tac S="supp (a, T, c)" in supports_finite)
+    apply(simp add: supports_def)
+    apply(simp add: fresh_def[symmetric])
+    apply(clarify)
+    apply(subst p1)
+    apply(simp add: supp_swap fresh_star_def)
+    apply(simp add: swap_fresh_fresh fresh_Pair)
+    apply(simp add: finite_supp)
+    done
+  have fin2: "finite (supp (f b S c))"
+    apply(rule_tac S="supp (b, S, c)" in supports_finite)
+    apply(simp add: supports_def)
+    apply(simp add: fresh_def[symmetric])
+    apply(clarify)
+    apply(subst p2)
+    apply(simp add: supp_swap fresh_star_def)
+    apply(simp add: swap_fresh_fresh fresh_Pair)
+    apply(simp add: finite_supp)
+    done
+  obtain d::"'a::at" where fr: "atom d \<sharp> (a, b, S, T, c, f a T c, f b S c)" 
+    using obtain_fresh'[where x="(a, b, S, T, c, f a T c, f b S c)"]
+    apply(auto simp add: finite_supp supp_Pair fin1 fin2)
+    done
+  have "(a \<leftrightarrow> d) \<bullet> (Abs_lst [atom a] T) = (b \<leftrightarrow> d) \<bullet> (Abs_lst [atom b] S)" 
+    apply(simp (no_asm_use) only: flip_def)
+    apply(subst swap_fresh_fresh)
+    apply(simp add: Abs_fresh_iff)
+    using fr
+    apply(simp add: Abs_fresh_iff)
+    apply(subst swap_fresh_fresh)
+    apply(simp add: Abs_fresh_iff)
+    using fr
+    apply(simp add: Abs_fresh_iff)
+    apply(rule e)
+    done
+  then have "Abs_lst [atom d] ((a \<leftrightarrow> d) \<bullet> T) = Abs_lst [atom d] ((b \<leftrightarrow> d) \<bullet> S)"
+    apply (simp add: swap_atom flip_def)
+    done
+  then have eq: "(a \<leftrightarrow> d) \<bullet> T = (b \<leftrightarrow> d) \<bullet> S"
+    by (simp add: Abs1_eq_iff)
+  have "f a T c = (a \<leftrightarrow> d) \<bullet> f a T c"
+    unfolding flip_def
+    apply(rule sym)
+    apply(rule swap_fresh_fresh)
+    using fcb[where a="a"] 
+    apply(simp)
+    using fr
+    apply(simp add: fresh_Pair)
+    done
+  also have "... = f d ((a \<leftrightarrow> d) \<bullet> T) c"
+    unfolding flip_def
+    apply(subst p1)
+    using fresh fr
+    apply(simp add: supp_swap fresh_star_def fresh_Pair)
+    apply(simp)
+    done
+  also have "... = f d ((b \<leftrightarrow> d) \<bullet> S) c" using eq by simp
+  also have "... = (b \<leftrightarrow> d) \<bullet> f b S c"
+    unfolding flip_def
+    apply(subst p2)
+    using fresh fr
+    apply(simp add: supp_swap fresh_star_def fresh_Pair)
+    apply(simp)
+    done
+  also have "... = f b S c"   
+    apply(rule flip_fresh_fresh)
+    using fcb[where a="b"] 
+    apply(simp)
+    using fr
+    apply(simp add: fresh_Pair)
+    done
+  finally show ?thesis by simp
+qed
+
+
 lemma swap_at_base_sort: 
   "sort_of (atom a) \<noteq> sort_of (atom x) \<Longrightarrow> sort_of (atom b) \<noteq> sort_of (atom x) 
   \<Longrightarrow> (atom a \<rightleftharpoons> atom b) \<bullet> x = x"
@@ -83,24 +170,18 @@
   apply(simp_all)
   apply(rule conjI)
   apply(elim conjE)
-  apply(erule Abs_lst1_fcb)
-  apply(simp add: Abs_fresh_iff)
+  apply(erule_tac c="(da,ea)" in Abs_lst1_fcb2)
   apply(simp add: Abs_fresh_iff)
-  apply(erule fresh_eqvt_at)
-  apply(simp add: finite_supp)
-  apply(simp add: fresh_Pair fresh_at_base(1))
-  apply(simp add: eqvt_at_def swap_at_base_sort)
-  apply simp
+  apply(simp add: fresh_at_base fresh_star_def fresh_Pair)
+  apply(simp add: eqvt_at_def atom_eqvt fresh_star_Pair perm_supp_eq)
+  apply(simp add: eqvt_at_def atom_eqvt fresh_star_Pair perm_supp_eq)
   apply(elim conjE)
-  apply(erule Abs_lst1_fcb)
-  apply(simp add: Abs_fresh_iff)
+  apply(erule_tac c="(da,ea)" in Abs_lst1_fcb2)
   apply(simp add: Abs_fresh_iff)
-  apply(erule fresh_eqvt_at)
-  apply(simp add: finite_supp)
-  apply(simp add: fresh_Pair fresh_at_base(1))
-  apply(simp add: fresh_Pair)
-  apply(simp add: eqvt_at_def swap_at_base_sort swap_fresh_fresh)
-  apply simp
+  apply(simp add: fresh_at_base fresh_star_def fresh_Pair)
+  apply(simp add: eqvt_at_def atom_eqvt fresh_star_Pair perm_supp_eq)
+  apply(simp add: eqvt_at_def atom_eqvt fresh_star_Pair perm_supp_eq)
+  -- "old fcb"
   apply(elim conjE)
   apply(subgoal_tac "eqvt_at crename_sumC (M, da, ea)")
   apply(erule Abs_lst1_fcb)