diff --git a/src/HOL/Nominal/Examples/Fsub.thy b/src/HOL/Nominal/Examples/Fsub.thy
--- a/src/HOL/Nominal/Examples/Fsub.thy
+++ b/src/HOL/Nominal/Examples/Fsub.thy
@@ -1,1886 +1,1853 @@
 (*<*)
 theory Fsub
 imports "HOL-Nominal.Nominal" 
 begin
 (*>*)
 
 text\<open>Authors: Christian Urban,
                 Benjamin Pierce,
                 Dimitrios Vytiniotis
                 Stephanie Weirich
                 Steve Zdancewic
                 Julien Narboux
                 Stefan Berghofer
 
        with great help from Markus Wenzel.\<close>
 
 section \<open>Types for Names, Nominal Datatype Declaration for Types and Terms\<close>
 
 no_syntax
   "_Map" :: "maplets => 'a \<rightharpoonup> 'b"  ("(1[_])")
 
 text \<open>The main point of this solution is to use names everywhere (be they bound, 
   binding or free). In System \FSUB{} there are two kinds of names corresponding to 
   type-variables and to term-variables. These two kinds of names are represented in 
   the nominal datatype package as atom-types \<open>tyvrs\<close> and \<open>vrs\<close>:\<close>
 
 atom_decl tyvrs vrs
 
 text\<open>There are numerous facts that come with this declaration: for example that 
   there are infinitely many elements in \<open>tyvrs\<close> and \<open>vrs\<close>.\<close>
 
 text\<open>The constructors for types and terms in System \FSUB{} contain abstractions 
   over type-variables and term-variables. The nominal datatype package uses 
   \<open>\<guillemotleft>\<dots>\<guillemotright>\<dots>\<close> to indicate where abstractions occur.\<close>
 
 nominal_datatype ty = 
     Tvar   "tyvrs"
   | Top
   | Arrow  "ty" "ty"         (infixr "\<rightarrow>" 200)
   | Forall "\<guillemotleft>tyvrs\<guillemotright>ty" "ty" 
 
 nominal_datatype trm = 
     Var   "vrs"
   | Abs   "\<guillemotleft>vrs\<guillemotright>trm" "ty" 
   | TAbs  "\<guillemotleft>tyvrs\<guillemotright>trm" "ty"
   | App   "trm" "trm" (infixl "\<cdot>" 200)
   | TApp  "trm" "ty"  (infixl "\<cdot>\<^sub>\<tau>" 200)
 
 text \<open>To be polite to the eye, some more familiar notation is introduced. 
   Because of the change in the order of arguments, one needs to use 
   translation rules, instead of syntax annotations at the term-constructors
   as given above for \<^term>\<open>Arrow\<close>.\<close>
 
 abbreviation
   Forall_syn :: "tyvrs \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty"  ("(3\<forall>_<:_./ _)" [0, 0, 10] 10) 
 where
   "\<forall>X<:T\<^sub>1. T\<^sub>2 \<equiv> ty.Forall X T\<^sub>2 T\<^sub>1"
 
 abbreviation
   Abs_syn    :: "vrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"  ("(3\<lambda>_:_./ _)" [0, 0, 10] 10) 
 where
   "\<lambda>x:T. t \<equiv> trm.Abs x t T"
 
 abbreviation
   TAbs_syn   :: "tyvrs \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm" ("(3\<lambda>_<:_./ _)" [0, 0, 10] 10) 
 where
   "\<lambda>X<:T. t \<equiv> trm.TAbs X t T"
 
 text \<open>Again there are numerous facts that are proved automatically for \<^typ>\<open>ty\<close> 
   and \<^typ>\<open>trm\<close>: for example that the set of free variables, i.e.~the \<open>support\<close>, 
   is finite. However note that nominal-datatype declarations do \emph{not} define 
   ``classical" constructor-based datatypes, but rather define $\alpha$-equivalence 
   classes---we can for example show that $\alpha$-equivalent \<^typ>\<open>ty\<close>s 
   and \<^typ>\<open>trm\<close>s are equal:\<close>
 
 lemma alpha_illustration:
   shows "(\<forall>X<:T. Tvar X) = (\<forall>Y<:T. Tvar Y)"
   and   "(\<lambda>x:T. Var x) = (\<lambda>y:T. Var y)"
   by (simp_all add: ty.inject trm.inject alpha calc_atm fresh_atm)
 
 section \<open>SubTyping Contexts\<close>
 
 nominal_datatype binding = 
     VarB vrs ty 
   | TVarB tyvrs ty
 
 type_synonym env = "binding list"
 
 text \<open>Typing contexts are represented as lists that ``grow" on the left; we
   thereby deviating from the convention in the POPLmark-paper. The lists contain
   pairs of type-variables and types (this is sufficient for Part 1A).\<close>
 
 text \<open>In order to state validity-conditions for typing-contexts, the notion of
   a \<open>dom\<close> of a typing-context is handy.\<close>
 
 nominal_primrec
   "tyvrs_of" :: "binding \<Rightarrow> tyvrs set"
 where
   "tyvrs_of (VarB  x y) = {}"
 | "tyvrs_of (TVarB x y) = {x}"
 by auto
 
 nominal_primrec
   "vrs_of" :: "binding \<Rightarrow> vrs set"
 where
   "vrs_of (VarB  x y) = {x}"
 | "vrs_of (TVarB x y) = {}"
 by auto
 
 primrec
   "ty_dom" :: "env \<Rightarrow> tyvrs set"
 where
   "ty_dom [] = {}"
 | "ty_dom (X#\<Gamma>) = (tyvrs_of X)\<union>(ty_dom \<Gamma>)" 
 
 primrec
   "trm_dom" :: "env \<Rightarrow> vrs set"
 where
   "trm_dom [] = {}"
 | "trm_dom (X#\<Gamma>) = (vrs_of X)\<union>(trm_dom \<Gamma>)" 
 
 lemma vrs_of_eqvt[eqvt]:
   fixes pi ::"tyvrs prm"
   and   pi'::"vrs   prm"
   shows "pi \<bullet>(tyvrs_of x) = tyvrs_of (pi\<bullet>x)"
   and   "pi'\<bullet>(tyvrs_of x) = tyvrs_of (pi'\<bullet>x)"
   and   "pi \<bullet>(vrs_of x)   = vrs_of   (pi\<bullet>x)"
   and   "pi'\<bullet>(vrs_of x)   = vrs_of   (pi'\<bullet>x)"
 by (nominal_induct x rule: binding.strong_induct) (simp_all add: tyvrs_of.simps eqvts)
 
 lemma doms_eqvt[eqvt]:
   fixes pi::"tyvrs prm"
   and   pi'::"vrs prm"
   shows "pi \<bullet>(ty_dom \<Gamma>)  = ty_dom  (pi\<bullet>\<Gamma>)"
   and   "pi'\<bullet>(ty_dom \<Gamma>)  = ty_dom  (pi'\<bullet>\<Gamma>)"
   and   "pi \<bullet>(trm_dom \<Gamma>) = trm_dom (pi\<bullet>\<Gamma>)"
   and   "pi'\<bullet>(trm_dom \<Gamma>) = trm_dom (pi'\<bullet>\<Gamma>)"
 by (induct \<Gamma>) (simp_all add: eqvts)
 
 lemma finite_vrs:
   shows "finite (tyvrs_of x)"
   and   "finite (vrs_of x)"
 by (nominal_induct rule:binding.strong_induct) auto
  
 lemma finite_doms:
   shows "finite (ty_dom \<Gamma>)"
   and   "finite (trm_dom \<Gamma>)"
-by (induct \<Gamma>) (auto simp add: finite_vrs)
+by (induct \<Gamma>) (auto simp: finite_vrs)
 
 lemma ty_dom_supp:
   shows "(supp (ty_dom  \<Gamma>)) = (ty_dom  \<Gamma>)"
   and   "(supp (trm_dom \<Gamma>)) = (trm_dom \<Gamma>)"
 by (simp only: at_fin_set_supp at_tyvrs_inst at_vrs_inst finite_doms)+
 
 lemma ty_dom_inclusion:
   assumes a: "(TVarB X T)\<in>set \<Gamma>" 
   shows "X\<in>(ty_dom \<Gamma>)"
 using a by (induct \<Gamma>) (auto)
 
 lemma ty_binding_existence:
   assumes "X \<in> (tyvrs_of a)"
   shows "\<exists>T.(TVarB X T=a)"
   using assms
 by (nominal_induct a rule: binding.strong_induct) (auto)
 
 lemma ty_dom_existence:
   assumes a: "X\<in>(ty_dom \<Gamma>)" 
   shows "\<exists>T.(TVarB X T)\<in>set \<Gamma>"
   using a 
-  apply (induct \<Gamma>, auto)
-  apply (rename_tac a \<Gamma>') 
-  apply (subgoal_tac "\<exists>T.(TVarB X T=a)")
-  apply (auto)
-  apply (auto simp add: ty_binding_existence)
-done
+proof (induction \<Gamma>)
+  case Nil then show ?case by simp
+next
+  case (Cons a \<Gamma>) then show ?case
+    using ty_binding_existence by fastforce
+qed
 
 lemma doms_append:
   shows "ty_dom (\<Gamma>@\<Delta>) = ((ty_dom \<Gamma>) \<union> (ty_dom \<Delta>))"
   and   "trm_dom (\<Gamma>@\<Delta>) = ((trm_dom \<Gamma>) \<union> (trm_dom \<Delta>))"
   by (induct \<Gamma>) (auto)
 
 lemma ty_vrs_prm_simp:
   fixes pi::"vrs prm"
   and   S::"ty"
   shows "pi\<bullet>S = S"
-by (induct S rule: ty.induct) (auto simp add: calc_atm)
+by (induct S rule: ty.induct) (auto simp: calc_atm)
 
 lemma fresh_ty_dom_cons:
   fixes X::"tyvrs"
   shows "X\<sharp>(ty_dom (Y#\<Gamma>)) = (X\<sharp>(tyvrs_of Y) \<and> X\<sharp>(ty_dom \<Gamma>))"
-  apply (nominal_induct rule:binding.strong_induct)
-  apply (auto)
-  apply (simp add: fresh_def supp_def eqvts)
-  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms)
-  apply (simp add: fresh_def supp_def eqvts)
-  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms)+
-  done
+proof (nominal_induct rule:binding.strong_induct)
+  case (VarB vrs ty)
+  then show ?case by auto
+next
+  case (TVarB tyvrs ty)
+  then show ?case
+    by (simp add: at_fin_set_supp at_tyvrs_inst finite_doms(1) fresh_def supp_atm(1))
+qed
 
 lemma tyvrs_fresh:
   fixes   X::"tyvrs"
   assumes "X \<sharp> a" 
   shows   "X \<sharp> tyvrs_of a"
   and     "X \<sharp> vrs_of a"
   using assms
-  apply (nominal_induct a rule:binding.strong_induct)
-  apply (auto)
-  apply (fresh_guess)+
-done
+  by (nominal_induct a rule:binding.strong_induct) (force simp: fresh_singleton)+
 
 lemma fresh_dom:
   fixes X::"tyvrs"
   assumes a: "X\<sharp>\<Gamma>" 
   shows "X\<sharp>(ty_dom \<Gamma>)"
 using a
-apply(induct \<Gamma>)
-apply(simp add: fresh_set_empty) 
-apply(simp only: fresh_ty_dom_cons)
-apply(auto simp add: fresh_prod fresh_list_cons tyvrs_fresh) 
-done
+proof (induct \<Gamma>)
+  case Nil then show ?case by auto
+next
+  case (Cons a \<Gamma>) then show ?case
+    by (meson fresh_list_cons fresh_ty_dom_cons tyvrs_fresh(1))
+qed
 
 text \<open>Not all lists of type \<^typ>\<open>env\<close> are well-formed. One condition
   requires that in \<^term>\<open>TVarB X S#\<Gamma>\<close> all free variables of \<^term>\<open>S\<close> must be 
   in the \<^term>\<open>ty_dom\<close> of \<^term>\<open>\<Gamma>\<close>, that is \<^term>\<open>S\<close> must be \<open>closed\<close> 
   in \<^term>\<open>\<Gamma>\<close>. The set of free variables of \<^term>\<open>S\<close> is the 
   \<open>support\<close> of \<^term>\<open>S\<close>.\<close>
 
 definition "closed_in" :: "ty \<Rightarrow> env \<Rightarrow> bool" ("_ closed'_in _" [100,100] 100) where
   "S closed_in \<Gamma> \<equiv> (supp S)\<subseteq>(ty_dom \<Gamma>)"
 
 lemma closed_in_eqvt[eqvt]:
   fixes pi::"tyvrs prm"
   assumes a: "S closed_in \<Gamma>" 
   shows "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)"
   using a
 proof -
   from a have "pi\<bullet>(S closed_in \<Gamma>)" by (simp add: perm_bool)
   then show "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)" by (simp add: closed_in_def eqvts)
 qed
 
 lemma tyvrs_vrs_prm_simp:
   fixes pi::"vrs prm"
   shows "tyvrs_of (pi\<bullet>a) = tyvrs_of a"
-  apply (nominal_induct rule:binding.strong_induct) 
-  apply (simp_all add: eqvts)
-  apply (simp add: dj_perm_forget[OF dj_tyvrs_vrs])
-  done
+  by (nominal_induct rule:binding.strong_induct) (auto simp: vrs_prm_tyvrs_def)
 
 lemma ty_vrs_fresh:
   fixes x::"vrs"
   and   T::"ty"
   shows "x \<sharp> T"
 by (simp add: fresh_def supp_def ty_vrs_prm_simp)
 
 lemma ty_dom_vrs_prm_simp:
   fixes pi::"vrs prm"
   and   \<Gamma>::"env"
   shows "(ty_dom (pi\<bullet>\<Gamma>)) = (ty_dom \<Gamma>)"
-  apply(induct \<Gamma>) 
-  apply (simp add: eqvts)
-  apply(simp add:  tyvrs_vrs_prm_simp)
-done
+by (induct \<Gamma>) (auto simp: tyvrs_vrs_prm_simp)
 
 lemma closed_in_eqvt'[eqvt]:
   fixes pi::"vrs prm"
   assumes a: "S closed_in \<Gamma>" 
   shows "(pi\<bullet>S) closed_in (pi\<bullet>\<Gamma>)"
-using a
-by (simp add: closed_in_def ty_dom_vrs_prm_simp  ty_vrs_prm_simp)
+  using assms closed_in_def ty_dom_vrs_prm_simp ty_vrs_prm_simp by force
 
 lemma fresh_vrs_of: 
   fixes x::"vrs"
   shows "x\<sharp>vrs_of b = x\<sharp>b"
   by (nominal_induct b rule: binding.strong_induct)
     (simp_all add: fresh_singleton fresh_set_empty ty_vrs_fresh fresh_atm)
 
 lemma fresh_trm_dom: 
   fixes x::"vrs"
   shows "x\<sharp> trm_dom \<Gamma> = x\<sharp>\<Gamma>"
   by (induct \<Gamma>)
-    (simp_all add: fresh_set_empty fresh_list_cons
+    (simp_all add: fresh_list_cons
      fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
-     finite_doms finite_vrs fresh_vrs_of fresh_list_nil)
+     finite_doms finite_vrs fresh_vrs_of)
 
 lemma closed_in_fresh: "(X::tyvrs) \<sharp> ty_dom \<Gamma> \<Longrightarrow> T closed_in \<Gamma> \<Longrightarrow> X \<sharp> T"
-  by (auto simp add: closed_in_def fresh_def ty_dom_supp)
+  by (auto simp: closed_in_def fresh_def ty_dom_supp)
 
 text \<open>Now validity of a context is a straightforward inductive definition.\<close>
   
 inductive
   valid_rel :: "env \<Rightarrow> bool" ("\<turnstile> _ ok" [100] 100)
 where
   valid_nil[simp]:   "\<turnstile> [] ok"
 | valid_consT[simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; X\<sharp>(ty_dom  \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (TVarB X T#\<Gamma>) ok"
 | valid_cons [simp]: "\<lbrakk>\<turnstile> \<Gamma> ok; x\<sharp>(trm_dom \<Gamma>); T closed_in \<Gamma>\<rbrakk>  \<Longrightarrow>  \<turnstile> (VarB  x T#\<Gamma>) ok"
 
 equivariance valid_rel
 
 declare binding.inject [simp add]
 declare trm.inject     [simp add]
 
 inductive_cases validE[elim]: 
   "\<turnstile> (TVarB X T#\<Gamma>) ok" 
   "\<turnstile> (VarB  x T#\<Gamma>) ok" 
   "\<turnstile> (b#\<Gamma>) ok" 
 
 declare binding.inject [simp del]
 declare trm.inject     [simp del]
 
 lemma validE_append:
   assumes a: "\<turnstile> (\<Delta>@\<Gamma>) ok" 
   shows "\<turnstile> \<Gamma> ok"
   using a 
 proof (induct \<Delta>)
   case (Cons a \<Gamma>')
   then show ?case 
-    by (nominal_induct a rule:binding.strong_induct)
-       (auto elim: validE)
+    by (nominal_induct a rule:binding.strong_induct) auto
 qed (auto)
 
 lemma replace_type:
   assumes a: "\<turnstile> (\<Delta>@(TVarB X T)#\<Gamma>) ok"
   and     b: "S closed_in \<Gamma>"
   shows "\<turnstile> (\<Delta>@(TVarB X S)#\<Gamma>) ok"
 using a b
 proof(induct \<Delta>)
   case Nil
-  then show ?case by (auto elim: validE intro: valid_cons simp add: doms_append closed_in_def)
+  then show ?case by (auto intro: valid_cons simp add: doms_append closed_in_def)
 next
   case (Cons a \<Gamma>')
   then show ?case 
     by (nominal_induct a rule:binding.strong_induct)
-       (auto elim: validE intro!: valid_cons simp add: doms_append closed_in_def)
+       (auto intro!: valid_cons simp add: doms_append closed_in_def)
 qed
 
 text \<open>Well-formed contexts have a unique type-binding for a type-variable.\<close> 
 
 lemma uniqueness_of_ctxt:
   fixes \<Gamma>::"env"
   assumes a: "\<turnstile> \<Gamma> ok"
   and     b: "(TVarB X T)\<in>set \<Gamma>"
   and     c: "(TVarB X S)\<in>set \<Gamma>"
   shows "T=S"
 using a b c
 proof (induct)
   case (valid_consT \<Gamma> X' T')
   moreover
   { fix \<Gamma>'::"env"
     assume a: "X'\<sharp>(ty_dom \<Gamma>')" 
     have "\<not>(\<exists>T.(TVarB X' T)\<in>(set \<Gamma>'))" using a 
     proof (induct \<Gamma>')
       case (Cons Y \<Gamma>')
       thus "\<not> (\<exists>T.(TVarB X' T)\<in>set(Y#\<Gamma>'))"
         by (simp add:  fresh_ty_dom_cons 
                        fresh_fin_union[OF pt_tyvrs_inst  at_tyvrs_inst fs_tyvrs_inst]  
                        finite_vrs finite_doms, 
-            auto simp add: fresh_atm fresh_singleton)
+            auto simp: fresh_atm fresh_singleton)
     qed (simp)
   }
-  ultimately show "T=S" by (auto simp add: binding.inject)
+  ultimately show "T=S" by (auto simp: binding.inject)
 qed (auto)
 
 lemma uniqueness_of_ctxt':
   fixes \<Gamma>::"env"
   assumes a: "\<turnstile> \<Gamma> ok"
   and     b: "(VarB x T)\<in>set \<Gamma>"
   and     c: "(VarB x S)\<in>set \<Gamma>"
   shows "T=S"
 using a b c
 proof (induct)
   case (valid_cons \<Gamma> x' T')
   moreover
   { fix \<Gamma>'::"env"
     assume a: "x'\<sharp>(trm_dom \<Gamma>')" 
     have "\<not>(\<exists>T.(VarB x' T)\<in>(set \<Gamma>'))" using a 
     proof (induct \<Gamma>')
       case (Cons y \<Gamma>')
       thus "\<not> (\<exists>T.(VarB x' T)\<in>set(y#\<Gamma>'))" 
         by (simp add:  fresh_fin_union[OF pt_vrs_inst  at_vrs_inst fs_vrs_inst]  
                        finite_vrs finite_doms, 
-            auto simp add: fresh_atm fresh_singleton)
+            auto simp: fresh_atm fresh_singleton)
     qed (simp)
   }
-  ultimately show "T=S" by (auto simp add: binding.inject)
+  ultimately show "T=S" by (auto simp: binding.inject)
 qed (auto)
 
 section \<open>Size and Capture-Avoiding Substitution for Types\<close>
 
 nominal_primrec
   size_ty :: "ty \<Rightarrow> nat"
 where
   "size_ty (Tvar X) = 1"
 | "size_ty (Top) = 1"
 | "size_ty (T1 \<rightarrow> T2) = (size_ty T1) + (size_ty T2) + 1"
 | "X \<sharp> T1 \<Longrightarrow> size_ty (\<forall>X<:T1. T2) = (size_ty T1) + (size_ty T2) + 1"
-  apply (finite_guess)+
-  apply (rule TrueI)+
-  apply (simp add: fresh_nat)
-  apply (fresh_guess)+
-  done
+  by (finite_guess | fresh_guess | simp)+
 
 nominal_primrec
   subst_ty :: "ty \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> ty" ("_[_ \<mapsto> _]\<^sub>\<tau>" [300, 0, 0] 300)
 where
   "(Tvar X)[Y \<mapsto> T]\<^sub>\<tau> = (if X=Y then T else Tvar X)"
 | "(Top)[Y \<mapsto> T]\<^sub>\<tau> = Top"
 | "(T\<^sub>1 \<rightarrow> T\<^sub>2)[Y \<mapsto> T]\<^sub>\<tau> = T\<^sub>1[Y \<mapsto> T]\<^sub>\<tau> \<rightarrow> T\<^sub>2[Y \<mapsto> T]\<^sub>\<tau>"
 | "X\<sharp>(Y,T,T\<^sub>1) \<Longrightarrow> (\<forall>X<:T\<^sub>1. T\<^sub>2)[Y \<mapsto> T]\<^sub>\<tau> = (\<forall>X<:T\<^sub>1[Y \<mapsto> T]\<^sub>\<tau>. T\<^sub>2[Y \<mapsto> T]\<^sub>\<tau>)"
-  apply (finite_guess)+
-  apply (rule TrueI)+
-  apply (simp add: abs_fresh)
-  apply (fresh_guess)+
-  done
+  by (finite_guess | fresh_guess | simp add: abs_fresh)+
 
 lemma subst_eqvt[eqvt]:
   fixes pi::"tyvrs prm" 
   and   T::"ty"
   shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
   by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
      (perm_simp add: fresh_bij)+
 
 lemma subst_eqvt'[eqvt]:
   fixes pi::"vrs prm" 
   and   T::"ty"
   shows "pi\<bullet>(T[X \<mapsto> T']\<^sub>\<tau>) = (pi\<bullet>T)[(pi\<bullet>X) \<mapsto> (pi\<bullet>T')]\<^sub>\<tau>"
   by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
      (perm_simp add: fresh_left)+
 
 lemma type_subst_fresh:
   fixes X::"tyvrs"
   assumes "X\<sharp>T" and "X\<sharp>P"
   shows   "X\<sharp>T[Y \<mapsto> P]\<^sub>\<tau>"
-using assms
-by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
-   (auto simp add: abs_fresh)
+  using assms
+  by (nominal_induct T avoiding: X Y P rule:ty.strong_induct)
+    (auto simp: abs_fresh)
 
 lemma fresh_type_subst_fresh:
-    assumes "X\<sharp>T'"
-    shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
-using assms 
-by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
-   (auto simp add: fresh_atm abs_fresh fresh_nat) 
+  assumes "X\<sharp>T'"
+  shows "X\<sharp>T[X \<mapsto> T']\<^sub>\<tau>"
+  using assms 
+  by (nominal_induct T avoiding: X T' rule: ty.strong_induct)
+     (auto simp: fresh_atm abs_fresh) 
 
 lemma type_subst_identity: 
   "X\<sharp>T \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> = T"
   by (nominal_induct T avoiding: X U rule: ty.strong_induct)
     (simp_all add: fresh_atm abs_fresh)
 
 lemma type_substitution_lemma:  
   "X \<noteq> Y \<Longrightarrow> X\<sharp>L \<Longrightarrow> M[X \<mapsto> N]\<^sub>\<tau>[Y \<mapsto> L]\<^sub>\<tau> = M[Y \<mapsto> L]\<^sub>\<tau>[X \<mapsto> N[Y \<mapsto> L]\<^sub>\<tau>]\<^sub>\<tau>"
   by (nominal_induct M avoiding: X Y N L rule: ty.strong_induct)
-    (auto simp add: type_subst_fresh type_subst_identity)
+    (auto simp: type_subst_fresh type_subst_identity)
 
 lemma type_subst_rename:
   "Y\<sharp>T \<Longrightarrow> ([(Y,X)]\<bullet>T)[Y \<mapsto> U]\<^sub>\<tau> = T[X \<mapsto> U]\<^sub>\<tau>"
   by (nominal_induct T avoiding: X Y U rule: ty.strong_induct)
     (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux)
 
 nominal_primrec
   subst_tyb :: "binding \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> binding" ("_[_ \<mapsto> _]\<^sub>b" [100,100,100] 100)
 where
   "(TVarB X U)[Y \<mapsto> T]\<^sub>b = TVarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
 | "(VarB  X U)[Y \<mapsto> T]\<^sub>b =  VarB X (U[Y \<mapsto> T]\<^sub>\<tau>)"
 by auto
 
 lemma binding_subst_fresh:
   fixes X::"tyvrs"
   assumes "X\<sharp>a"
   and     "X\<sharp>P"
   shows "X\<sharp>a[Y \<mapsto> P]\<^sub>b"
 using assms
 by (nominal_induct a rule: binding.strong_induct)
-   (auto simp add: type_subst_fresh)
+   (auto simp: type_subst_fresh)
 
 lemma binding_subst_identity: 
   shows "X\<sharp>B \<Longrightarrow> B[X \<mapsto> U]\<^sub>b = B"
 by (induct B rule: binding.induct)
    (simp_all add: fresh_atm type_subst_identity)
 
 primrec subst_tyc :: "env \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> env" ("_[_ \<mapsto> _]\<^sub>e" [100,100,100] 100) where
   "([])[Y \<mapsto> T]\<^sub>e= []"
 | "(B#\<Gamma>)[Y \<mapsto> T]\<^sub>e = (B[Y \<mapsto> T]\<^sub>b)#(\<Gamma>[Y \<mapsto> T]\<^sub>e)"
 
 lemma ctxt_subst_fresh':
   fixes X::"tyvrs"
   assumes "X\<sharp>\<Gamma>"
   and     "X\<sharp>P"
   shows   "X\<sharp>\<Gamma>[Y \<mapsto> P]\<^sub>e"
 using assms
 by (induct \<Gamma>)
-   (auto simp add: fresh_list_cons binding_subst_fresh)
+   (auto simp: fresh_list_cons binding_subst_fresh)
 
 lemma ctxt_subst_mem_TVarB: "TVarB X T \<in> set \<Gamma> \<Longrightarrow> TVarB X (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
   by (induct \<Gamma>) auto
 
 lemma ctxt_subst_mem_VarB: "VarB x T \<in> set \<Gamma> \<Longrightarrow> VarB x (T[Y \<mapsto> U]\<^sub>\<tau>) \<in> set (\<Gamma>[Y \<mapsto> U]\<^sub>e)"
   by (induct \<Gamma>) auto
 
 lemma ctxt_subst_identity: "X\<sharp>\<Gamma> \<Longrightarrow> \<Gamma>[X \<mapsto> U]\<^sub>e = \<Gamma>"
   by (induct \<Gamma>) (simp_all add: fresh_list_cons binding_subst_identity)
 
 lemma ctxt_subst_append: "(\<Delta> @ \<Gamma>)[X \<mapsto> T]\<^sub>e = \<Delta>[X \<mapsto> T]\<^sub>e @ \<Gamma>[X \<mapsto> T]\<^sub>e"
   by (induct \<Delta>) simp_all
 
 nominal_primrec
    subst_trm :: "trm \<Rightarrow> vrs \<Rightarrow> trm \<Rightarrow> trm"  ("_[_ \<mapsto> _]" [300, 0, 0] 300)
 where
   "(Var x)[y \<mapsto> t'] = (if x=y then t' else (Var x))"
 | "(t1 \<cdot> t2)[y \<mapsto> t'] = t1[y \<mapsto> t'] \<cdot> t2[y \<mapsto> t']"
 | "(t \<cdot>\<^sub>\<tau> T)[y \<mapsto> t'] = t[y \<mapsto> t'] \<cdot>\<^sub>\<tau> T"
 | "X\<sharp>(T,t') \<Longrightarrow> (\<lambda>X<:T. t)[y \<mapsto> t'] = (\<lambda>X<:T. t[y \<mapsto> t'])" 
 | "x\<sharp>(y,t') \<Longrightarrow> (\<lambda>x:T. t)[y \<mapsto> t'] = (\<lambda>x:T. t[y \<mapsto> t'])"
 apply(finite_guess)+
 apply(rule TrueI)+
 apply(simp add: abs_fresh)+
 apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
 done
 
 lemma subst_trm_fresh_tyvar:
   fixes X::"tyvrs"
   shows "X\<sharp>t \<Longrightarrow> X\<sharp>u \<Longrightarrow> X\<sharp>t[x \<mapsto> u]"
   by (nominal_induct t avoiding: x u rule: trm.strong_induct)
-    (auto simp add: trm.fresh abs_fresh)
+    (auto simp: abs_fresh)
 
 lemma subst_trm_fresh_var: 
   "x\<sharp>u \<Longrightarrow> x\<sharp>t[x \<mapsto> u]"
   by (nominal_induct t avoiding: x u rule: trm.strong_induct)
     (simp_all add: abs_fresh fresh_atm ty_vrs_fresh)
 
 lemma subst_trm_eqvt[eqvt]:
   fixes pi::"tyvrs prm" 
   and   t::"trm"
   shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
   by (nominal_induct t avoiding: x u rule: trm.strong_induct)
      (perm_simp add: fresh_left)+
 
 lemma subst_trm_eqvt'[eqvt]:
   fixes pi::"vrs prm" 
   and   t::"trm"
   shows "pi\<bullet>(t[x \<mapsto> u]) = (pi\<bullet>t)[(pi\<bullet>x) \<mapsto> (pi\<bullet>u)]"
   by (nominal_induct t avoiding: x u rule: trm.strong_induct)
      (perm_simp add: fresh_left)+
 
 lemma subst_trm_rename:
   "y\<sharp>t \<Longrightarrow> ([(y, x)] \<bullet> t)[y \<mapsto> u] = t[x \<mapsto> u]"
   by (nominal_induct t avoiding: x y u rule: trm.strong_induct)
     (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux ty_vrs_fresh perm_fresh_fresh)
 
 nominal_primrec (freshness_context: "T2::ty")
   subst_trm_ty :: "trm \<Rightarrow> tyvrs \<Rightarrow> ty \<Rightarrow> trm"  ("_[_ \<mapsto>\<^sub>\<tau> _]" [300, 0, 0] 300)
 where
   "(Var x)[Y \<mapsto>\<^sub>\<tau> T2] = Var x"
 | "(t1 \<cdot> t2)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot> t2[Y \<mapsto>\<^sub>\<tau> T2]"
 | "(t1 \<cdot>\<^sub>\<tau> T)[Y \<mapsto>\<^sub>\<tau> T2] = t1[Y \<mapsto>\<^sub>\<tau> T2] \<cdot>\<^sub>\<tau> T[Y \<mapsto> T2]\<^sub>\<tau>"
 | "X\<sharp>(Y,T,T2) \<Longrightarrow> (\<lambda>X<:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>X<:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])" 
 | "(\<lambda>x:T. t)[Y \<mapsto>\<^sub>\<tau> T2] = (\<lambda>x:T[Y \<mapsto> T2]\<^sub>\<tau>. t[Y \<mapsto>\<^sub>\<tau> T2])"
-apply(finite_guess)+
-apply(rule TrueI)+
-apply(simp add: abs_fresh ty_vrs_fresh)+
-apply(simp add: type_subst_fresh)
+apply(finite_guess | simp add: abs_fresh ty_vrs_fresh type_subst_fresh)+
 apply(fresh_guess add: ty_vrs_fresh abs_fresh)+
 done
 
 lemma subst_trm_ty_fresh:
   fixes X::"tyvrs"
   shows "X\<sharp>t \<Longrightarrow> X\<sharp>T \<Longrightarrow> X\<sharp>t[Y \<mapsto>\<^sub>\<tau> T]"
   by (nominal_induct t avoiding: Y T rule: trm.strong_induct)
-    (auto simp add: abs_fresh type_subst_fresh)
+    (auto simp: abs_fresh type_subst_fresh)
 
 lemma subst_trm_ty_fresh':
   "X\<sharp>T \<Longrightarrow> X\<sharp>t[X \<mapsto>\<^sub>\<tau> T]"
   by (nominal_induct t avoiding: X T rule: trm.strong_induct)
     (simp_all add: abs_fresh fresh_type_subst_fresh fresh_atm)
 
 lemma subst_trm_ty_eqvt[eqvt]:
   fixes pi::"tyvrs prm" 
   and   t::"trm"
   shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
   by (nominal_induct t avoiding: X T rule: trm.strong_induct)
      (perm_simp add: fresh_bij subst_eqvt)+
 
 lemma subst_trm_ty_eqvt'[eqvt]:
   fixes pi::"vrs prm" 
   and   t::"trm"
   shows "pi\<bullet>(t[X \<mapsto>\<^sub>\<tau> T]) = (pi\<bullet>t)[(pi\<bullet>X) \<mapsto>\<^sub>\<tau> (pi\<bullet>T)]"
   by (nominal_induct t avoiding: X T rule: trm.strong_induct)
      (perm_simp add: fresh_left subst_eqvt')+
 
 lemma subst_trm_ty_rename:
   "Y\<sharp>t \<Longrightarrow> ([(Y, X)] \<bullet> t)[Y \<mapsto>\<^sub>\<tau> U] = t[X \<mapsto>\<^sub>\<tau> U]"
   by (nominal_induct t avoiding: X Y U rule: trm.strong_induct)
     (simp_all add: fresh_atm calc_atm abs_fresh fresh_aux type_subst_rename)
 
 section \<open>Subtyping-Relation\<close>
 
 text \<open>The definition for the subtyping-relation follows quite closely what is written 
   in the POPLmark-paper, except for the premises dealing with well-formed contexts and 
   the freshness constraint \<^term>\<open>X\<sharp>\<Gamma>\<close> in the \<open>S_Forall\<close>-rule. (The freshness
   constraint is specific to the \emph{nominal approach}. Note, however, that the constraint
   does \emph{not} make the subtyping-relation ``partial"\ldots because we work over
   $\alpha$-equivalence classes.)\<close>
 
 inductive 
   subtype_of :: "env \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"   ("_\<turnstile>_<:_" [100,100,100] 100)
 where
   SA_Top[intro]:    "\<lbrakk>\<turnstile> \<Gamma> ok; S closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: Top"
 | SA_refl_TVar[intro]:   "\<lbrakk>\<turnstile> \<Gamma> ok; X \<in> ty_dom \<Gamma>\<rbrakk>\<Longrightarrow> \<Gamma> \<turnstile> Tvar X <: Tvar X"
 | SA_trans_TVar[intro]:    "\<lbrakk>(TVarB X S) \<in> set \<Gamma>; \<Gamma> \<turnstile> S <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (Tvar X) <: T"
 | SA_arrow[intro]:  "\<lbrakk>\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1; \<Gamma> \<turnstile> S\<^sub>2 <: T\<^sub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (S\<^sub>1 \<rightarrow> S\<^sub>2) <: (T\<^sub>1 \<rightarrow> T\<^sub>2)" 
 | SA_all[intro]: "\<lbrakk>\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1; ((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: (\<forall>X<:T\<^sub>1. T\<^sub>2)"
 
 lemma subtype_implies_ok:
   fixes X::"tyvrs"
   assumes a: "\<Gamma> \<turnstile> S <: T"
   shows "\<turnstile> \<Gamma> ok"  
 using a by (induct) (auto)
 
 lemma subtype_implies_closed:
   assumes a: "\<Gamma> \<turnstile> S <: T"
   shows "S closed_in \<Gamma> \<and> T closed_in \<Gamma>"
 using a
 proof (induct)
   case (SA_Top \<Gamma> S)
   have "Top closed_in \<Gamma>" by (simp add: closed_in_def ty.supp)
   moreover
   have "S closed_in \<Gamma>" by fact
   ultimately show "S closed_in \<Gamma> \<and> Top closed_in \<Gamma>" by simp
 next
   case (SA_trans_TVar X S \<Gamma> T)
   have "(TVarB X S)\<in>set \<Gamma>" by fact
   hence "X \<in> ty_dom \<Gamma>" by (rule ty_dom_inclusion)
   hence "(Tvar X) closed_in \<Gamma>" by (simp add: closed_in_def ty.supp supp_atm)
   moreover
   have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by fact
   hence "T closed_in \<Gamma>" by force
   ultimately show "(Tvar X) closed_in \<Gamma> \<and> T closed_in \<Gamma>" by simp
-qed (auto simp add: closed_in_def ty.supp supp_atm abs_supp)
+qed (auto simp: closed_in_def ty.supp supp_atm abs_supp)
 
 lemma subtype_implies_fresh:
   fixes X::"tyvrs"
   assumes a1: "\<Gamma> \<turnstile> S <: T"
   and     a2: "X\<sharp>\<Gamma>"
   shows "X\<sharp>S \<and> X\<sharp>T"  
 proof -
   from a1 have "\<turnstile> \<Gamma> ok" by (rule subtype_implies_ok)
   with a2 have "X\<sharp>ty_dom(\<Gamma>)" by (simp add: fresh_dom)
   moreover
   from a1 have "S closed_in \<Gamma> \<and> T closed_in \<Gamma>" by (rule subtype_implies_closed)
   hence "supp S \<subseteq> ((supp (ty_dom \<Gamma>))::tyvrs set)" 
     and "supp T \<subseteq> ((supp (ty_dom \<Gamma>))::tyvrs set)" by (simp_all add: ty_dom_supp closed_in_def)
-  ultimately show "X\<sharp>S \<and> X\<sharp>T" by (force simp add: supp_prod fresh_def)
+  ultimately show "X\<sharp>S \<and> X\<sharp>T" by (force simp: supp_prod fresh_def)
 qed
 
 lemma valid_ty_dom_fresh:
   fixes X::"tyvrs"
   assumes valid: "\<turnstile> \<Gamma> ok"
   shows "X\<sharp>(ty_dom \<Gamma>) = X\<sharp>\<Gamma>" 
   using valid
-  apply induct
-  apply (simp add: fresh_list_nil fresh_set_empty)
-  apply (simp_all add: binding.fresh fresh_list_cons
-     fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms fresh_atm)
-  apply (auto simp add: closed_in_fresh)
-  done
+proof induct
+  case valid_nil
+  then show ?case by auto
+next
+  case (valid_consT \<Gamma> X T)
+  then show ?case
+    by (auto simp: fresh_list_cons closed_in_fresh
+     fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms)
+next
+  case (valid_cons \<Gamma> x T)
+  then show ?case
+    using fresh_atm by (auto simp: fresh_list_cons closed_in_fresh)
+qed
 
 equivariance subtype_of
 
 nominal_inductive subtype_of
   apply (simp_all add: abs_fresh)
-  apply (fastforce simp add: valid_ty_dom_fresh dest: subtype_implies_ok)
-  apply (force simp add: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
+  apply (fastforce simp: valid_ty_dom_fresh dest: subtype_implies_ok)
+  apply (force simp: closed_in_fresh dest: subtype_implies_closed subtype_implies_ok)+
   done
 
 section \<open>Reflexivity of Subtyping\<close>
 
 lemma subtype_reflexivity:
   assumes a: "\<turnstile> \<Gamma> ok"
   and b: "T closed_in \<Gamma>"
   shows "\<Gamma> \<turnstile> T <: T"
 using a b
 proof(nominal_induct T avoiding: \<Gamma> rule: ty.strong_induct)
   case (Forall X T\<^sub>1 T\<^sub>2)
   have ih_T\<^sub>1: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^sub>1 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^sub>1 <: T\<^sub>1" by fact 
   have ih_T\<^sub>2: "\<And>\<Gamma>. \<lbrakk>\<turnstile> \<Gamma> ok; T\<^sub>2 closed_in \<Gamma>\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>2" by fact
   have fresh_cond: "X\<sharp>\<Gamma>" by fact
   hence fresh_ty_dom: "X\<sharp>(ty_dom \<Gamma>)" by (simp add: fresh_dom)
   have "(\<forall>X<:T\<^sub>2. T\<^sub>1) closed_in \<Gamma>" by fact
   hence closed\<^sub>T2: "T\<^sub>2 closed_in \<Gamma>" and closed\<^sub>T1: "T\<^sub>1 closed_in ((TVarB  X T\<^sub>2)#\<Gamma>)" 
-    by (auto simp add: closed_in_def ty.supp abs_supp)
+    by (auto simp: closed_in_def ty.supp abs_supp)
   have ok: "\<turnstile> \<Gamma> ok" by fact  
   hence ok': "\<turnstile> ((TVarB X T\<^sub>2)#\<Gamma>) ok" using closed\<^sub>T2 fresh_ty_dom by simp
   have "\<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>2" using ih_T\<^sub>2 closed\<^sub>T2 ok by simp
   moreover
   have "((TVarB X T\<^sub>2)#\<Gamma>) \<turnstile> T\<^sub>1 <: T\<^sub>1" using ih_T\<^sub>1 closed\<^sub>T1 ok' by simp
   ultimately show "\<Gamma> \<turnstile> (\<forall>X<:T\<^sub>2. T\<^sub>1) <: (\<forall>X<:T\<^sub>2. T\<^sub>1)" using fresh_cond 
     by (simp add: subtype_of.SA_all)
-qed (auto simp add: closed_in_def ty.supp supp_atm)
+qed (auto simp: closed_in_def ty.supp supp_atm)
 
 lemma subtype_reflexivity_semiautomated:
   assumes a: "\<turnstile> \<Gamma> ok"
   and     b: "T closed_in \<Gamma>"
   shows "\<Gamma> \<turnstile> T <: T"
 using a b
 apply(nominal_induct T avoiding: \<Gamma> rule: ty.strong_induct)
-apply(auto simp add: ty.supp abs_supp supp_atm closed_in_def)
+apply(auto simp: ty.supp abs_supp supp_atm closed_in_def)
   \<comment> \<open>Too bad that this instantiation cannot be found automatically by
   \isakeyword{auto}; \isakeyword{blast} would find it if we had not used 
   an explicit definition for \<open>closed_in_def\<close>.\<close>
 apply(drule_tac x="(TVarB tyvrs ty2)#\<Gamma>" in meta_spec)
 apply(force dest: fresh_dom simp add: closed_in_def)
 done
 
 section \<open>Weakening\<close>
 
 text \<open>In order to prove weakening we introduce the notion of a type-context extending 
   another. This generalization seems to make the proof for weakening to be
   smoother than if we had strictly adhered to the version in the POPLmark-paper.\<close>
 
 definition extends :: "env \<Rightarrow> env \<Rightarrow> bool" ("_ extends _" [100,100] 100) where
   "\<Delta> extends \<Gamma> \<equiv> \<forall>X Q. (TVarB X Q)\<in>set \<Gamma> \<longrightarrow> (TVarB X Q)\<in>set \<Delta>"
 
 lemma extends_ty_dom:
-  assumes a: "\<Delta> extends \<Gamma>"
+  assumes "\<Delta> extends \<Gamma>"
   shows "ty_dom \<Gamma> \<subseteq> ty_dom \<Delta>"
-  using a 
-  apply (auto simp add: extends_def)
-  apply (drule ty_dom_existence)
-  apply (force simp add: ty_dom_inclusion)
-  done
+  using assms
+  by (meson extends_def subsetI ty_dom_existence ty_dom_inclusion) 
 
 lemma extends_closed:
-  assumes a1: "T closed_in \<Gamma>"
-  and     a2: "\<Delta> extends \<Gamma>"
+  assumes "T closed_in \<Gamma>" and "\<Delta> extends \<Gamma>"
   shows "T closed_in \<Delta>"
-  using a1 a2
-  by (auto dest: extends_ty_dom simp add: closed_in_def)
+  by (meson assms closed_in_def extends_ty_dom order.trans)
 
 lemma extends_memb:
   assumes a: "\<Delta> extends \<Gamma>"
   and b: "(TVarB X T) \<in> set \<Gamma>"
   shows "(TVarB X T) \<in> set \<Delta>"
   using a b by (simp add: extends_def)
 
 lemma weakening:
   assumes a: "\<Gamma> \<turnstile> S <: T"
   and b: "\<turnstile> \<Delta> ok"
   and c: "\<Delta> extends \<Gamma>"
   shows "\<Delta> \<turnstile> S <: T"
   using a b c 
 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
   case (SA_Top \<Gamma> S) 
   have lh_drv_prem: "S closed_in \<Gamma>" by fact
   have "\<turnstile> \<Delta> ok" by fact
   moreover
   have "\<Delta> extends \<Gamma>" by fact
   hence "S closed_in \<Delta>" using lh_drv_prem by (simp only: extends_closed)
   ultimately show "\<Delta> \<turnstile> S <: Top" by force
 next 
   case (SA_trans_TVar X S \<Gamma> T)
   have lh_drv_prem: "(TVarB X S) \<in> set \<Gamma>" by fact
   have ih: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> S <: T" by fact
   have ok: "\<turnstile> \<Delta> ok" by fact
   have extends: "\<Delta> extends \<Gamma>" by fact
   have "(TVarB X S) \<in> set \<Delta>" using lh_drv_prem extends by (simp only: extends_memb)
   moreover
   have "\<Delta> \<turnstile> S <: T" using ok extends ih by simp
   ultimately show "\<Delta> \<turnstile> Tvar X <: T" using ok by force
 next
   case (SA_refl_TVar \<Gamma> X)
   have lh_drv_prem: "X \<in> ty_dom \<Gamma>" by fact
   have "\<turnstile> \<Delta> ok" by fact
   moreover
   have "\<Delta> extends \<Gamma>" by fact
   hence "X \<in> ty_dom \<Delta>" using lh_drv_prem by (force dest: extends_ty_dom)
   ultimately show "\<Delta> \<turnstile> Tvar X <: Tvar X" by force
 next 
   case (SA_arrow \<Gamma> T\<^sub>1 S\<^sub>1 S\<^sub>2 T\<^sub>2) thus "\<Delta> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T\<^sub>1 \<rightarrow> T\<^sub>2" by blast
 next
   case (SA_all \<Gamma> T\<^sub>1 S\<^sub>1 X S\<^sub>2 T\<^sub>2)
   have fresh_cond: "X\<sharp>\<Delta>" by fact
   hence fresh_dom: "X\<sharp>(ty_dom \<Delta>)" by (simp add: fresh_dom)
   have ih\<^sub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
   have ih\<^sub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^sub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^sub>2 <: T\<^sub>2" by fact
   have lh_drv_prem: "\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
   hence closed\<^sub>T1: "T\<^sub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
   have ok: "\<turnstile> \<Delta> ok" by fact
   have ext: "\<Delta> extends \<Gamma>" by fact
   have "T\<^sub>1 closed_in \<Delta>" using ext closed\<^sub>T1 by (simp only: extends_closed)
   hence "\<turnstile> ((TVarB X T\<^sub>1)#\<Delta>) ok" using fresh_dom ok by force   
   moreover 
-  have "((TVarB X T\<^sub>1)#\<Delta>) extends ((TVarB X T\<^sub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
+  have "((TVarB X T\<^sub>1)#\<Delta>) extends ((TVarB X T\<^sub>1)#\<Gamma>)" using ext by (force simp: extends_def)
   ultimately have "((TVarB X T\<^sub>1)#\<Delta>) \<turnstile> S\<^sub>2 <: T\<^sub>2" using ih\<^sub>2 by simp
   moreover
   have "\<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" using ok ext ih\<^sub>1 by simp 
   ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: (\<forall>X<:T\<^sub>1. T\<^sub>2)" using ok by (force intro: SA_all)
 qed
 
 text \<open>In fact all ``non-binding" cases can be solved automatically:\<close>
 
 lemma weakening_more_automated:
   assumes a: "\<Gamma> \<turnstile> S <: T"
   and b: "\<turnstile> \<Delta> ok"
   and c: "\<Delta> extends \<Gamma>"
   shows "\<Delta> \<turnstile> S <: T"
   using a b c 
 proof (nominal_induct \<Gamma> S T avoiding: \<Delta> rule: subtype_of.strong_induct)
   case (SA_all \<Gamma> T\<^sub>1 S\<^sub>1 X S\<^sub>2 T\<^sub>2)
   have fresh_cond: "X\<sharp>\<Delta>" by fact
   hence fresh_dom: "X\<sharp>(ty_dom \<Delta>)" by (simp add: fresh_dom)
   have ih\<^sub>1: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends \<Gamma> \<Longrightarrow> \<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
   have ih\<^sub>2: "\<And>\<Delta>. \<turnstile> \<Delta> ok \<Longrightarrow> \<Delta> extends ((TVarB X T\<^sub>1)#\<Gamma>) \<Longrightarrow> \<Delta> \<turnstile> S\<^sub>2 <: T\<^sub>2" by fact
   have lh_drv_prem: "\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1" by fact
   hence closed\<^sub>T1: "T\<^sub>1 closed_in \<Gamma>" by (simp add: subtype_implies_closed) 
   have ok: "\<turnstile> \<Delta> ok" by fact
   have ext: "\<Delta> extends \<Gamma>" by fact
   have "T\<^sub>1 closed_in \<Delta>" using ext closed\<^sub>T1 by (simp only: extends_closed)
   hence "\<turnstile> ((TVarB X T\<^sub>1)#\<Delta>) ok" using fresh_dom ok by force   
   moreover
-  have "((TVarB X T\<^sub>1)#\<Delta>) extends ((TVarB X T\<^sub>1)#\<Gamma>)" using ext by (force simp add: extends_def)
+  have "((TVarB X T\<^sub>1)#\<Delta>) extends ((TVarB X T\<^sub>1)#\<Gamma>)" using ext by (force simp: extends_def)
   ultimately have "((TVarB X T\<^sub>1)#\<Delta>) \<turnstile> S\<^sub>2 <: T\<^sub>2" using ih\<^sub>2 by simp
   moreover
   have "\<Delta> \<turnstile> T\<^sub>1 <: S\<^sub>1" using ok ext ih\<^sub>1 by simp 
   ultimately show "\<Delta> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: (\<forall>X<:T\<^sub>1. T\<^sub>2)" using ok by (force intro: SA_all)
 qed (blast intro: extends_closed extends_memb dest: extends_ty_dom)+
 
 section \<open>Transitivity and Narrowing\<close>
 
 text \<open>Some inversion lemmas that are needed in the transitivity and narrowing proof.\<close>
 
 declare ty.inject [simp add]
 
 inductive_cases S_TopE: "\<Gamma> \<turnstile> Top <: T"
 inductive_cases S_ArrowE_left: "\<Gamma> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T" 
 
 declare ty.inject [simp del]
 
 lemma S_ForallE_left:
   shows "\<lbrakk>\<Gamma> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: T; X\<sharp>\<Gamma>; X\<sharp>S\<^sub>1; X\<sharp>T\<rbrakk>
          \<Longrightarrow> T = Top \<or> (\<exists>T\<^sub>1 T\<^sub>2. T = (\<forall>X<:T\<^sub>1. T\<^sub>2) \<and> \<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1 \<and> ((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2)"
-apply(erule subtype_of.strong_cases[where X="X"])
-apply(auto simp add: abs_fresh ty.inject alpha)
-done
+  using subtype_of.strong_cases[where X="X"]
+  by(force simp: abs_fresh ty.inject alpha)
 
 text \<open>Next we prove the transitivity and narrowing for the subtyping-relation. 
 The POPLmark-paper says the following:
 
 \begin{quote}
 \begin{lemma}[Transitivity and Narrowing] \
 \begin{enumerate}
 \item If \<^term>\<open>\<Gamma> \<turnstile> S<:Q\<close> and \<^term>\<open>\<Gamma> \<turnstile> Q<:T\<close>, then \<^term>\<open>\<Gamma> \<turnstile> S<:T\<close>.
 \item If \<open>\<Gamma>,X<:Q,\<Delta> \<turnstile> M<:N\<close> and \<^term>\<open>\<Gamma> \<turnstile> P<:Q\<close> then \<open>\<Gamma>,X<:P,\<Delta> \<turnstile> M<:N\<close>.
 \end{enumerate}
 \end{lemma}
 
 The two parts are proved simultaneously, by induction on the size
 of \<^term>\<open>Q\<close>.  The argument for part (2) assumes that part (1) has 
 been established already for the \<^term>\<open>Q\<close> in question; part (1) uses 
 part (2) only for strictly smaller \<^term>\<open>Q\<close>.
 \end{quote}
 
 For the induction on the size of \<^term>\<open>Q\<close>, we use the induction-rule 
 \<open>measure_induct_rule\<close>:
 
 \begin{center}
 @{thm measure_induct_rule[of "size_ty",no_vars]}
 \end{center}
 
 That means in order to show a property \<^term>\<open>P a\<close> for all \<^term>\<open>a\<close>, 
 the induct-rule requires to prove that for all \<^term>\<open>x\<close> \<^term>\<open>P x\<close> holds using the 
 assumption that for all \<^term>\<open>y\<close> whose size is strictly smaller than 
 that of \<^term>\<open>x\<close> the property \<^term>\<open>P y\<close> holds.\<close>
 
 lemma 
   shows subtype_transitivity: "\<Gamma>\<turnstile>S<:Q \<Longrightarrow> \<Gamma>\<turnstile>Q<:T \<Longrightarrow> \<Gamma>\<turnstile>S<:T" 
   and subtype_narrow: "(\<Delta>@[(TVarB X Q)]@\<Gamma>)\<turnstile>M<:N \<Longrightarrow> \<Gamma>\<turnstile>P<:Q \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N"
 proof (induct Q arbitrary: \<Gamma> S T \<Delta> X P M N taking: "size_ty" rule: measure_induct_rule)
   case (less Q)
   have IH_trans:  
     "\<And>Q' \<Gamma> S T. \<lbrakk>size_ty Q' < size_ty Q; \<Gamma>\<turnstile>S<:Q'; \<Gamma>\<turnstile>Q'<:T\<rbrakk> \<Longrightarrow> \<Gamma>\<turnstile>S<:T" by fact
   have IH_narrow:
     "\<And>Q' \<Delta> \<Gamma> X M N P. \<lbrakk>size_ty Q' < size_ty Q; (\<Delta>@[(TVarB X Q')]@\<Gamma>)\<turnstile>M<:N; \<Gamma>\<turnstile>P<:Q'\<rbrakk> 
     \<Longrightarrow> (\<Delta>@[(TVarB X P)]@\<Gamma>)\<turnstile>M<:N" by fact
 
   { fix \<Gamma> S T
     have "\<lbrakk>\<Gamma> \<turnstile> S <: Q; \<Gamma> \<turnstile> Q <: T\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> S <: T" 
     proof (induct \<Gamma> S Q\<equiv>Q rule: subtype_of.induct) 
       case (SA_Top \<Gamma> S) 
       then have rh_drv: "\<Gamma> \<turnstile> Top <: T" by simp
       then have T_inst: "T = Top" by (auto elim: S_TopE)
       from \<open>\<turnstile> \<Gamma> ok\<close> and \<open>S closed_in \<Gamma>\<close>
       have "\<Gamma> \<turnstile> S <: Top" by auto
       then show "\<Gamma> \<turnstile> S <: T" using T_inst by simp 
     next
       case (SA_trans_TVar Y U \<Gamma>) 
       then have IH_inner: "\<Gamma> \<turnstile> U <: T" by simp
       have "(TVarB Y U) \<in> set \<Gamma>" by fact
       with IH_inner show "\<Gamma> \<turnstile> Tvar Y <: T" by auto
     next
       case (SA_refl_TVar \<Gamma> X) 
       then show "\<Gamma> \<turnstile> Tvar X <: T" by simp
     next
       case (SA_arrow \<Gamma> Q\<^sub>1 S\<^sub>1 S\<^sub>2 Q\<^sub>2) 
       then have rh_drv: "\<Gamma> \<turnstile> Q\<^sub>1 \<rightarrow> Q\<^sub>2 <: T" by simp
       from \<open>Q\<^sub>1 \<rightarrow> Q\<^sub>2 = Q\<close> 
       have Q\<^sub>12_less: "size_ty Q\<^sub>1 < size_ty Q" "size_ty Q\<^sub>2 < size_ty Q" by auto
       have lh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> Q\<^sub>1 <: S\<^sub>1" by fact
       have lh_drv_prm\<^sub>2: "\<Gamma> \<turnstile> S\<^sub>2 <: Q\<^sub>2" by fact      
       from rh_drv have "T=Top \<or> (\<exists>T\<^sub>1 T\<^sub>2. T=T\<^sub>1\<rightarrow>T\<^sub>2 \<and> \<Gamma>\<turnstile>T\<^sub>1<:Q\<^sub>1 \<and> \<Gamma>\<turnstile>Q\<^sub>2<:T\<^sub>2)" 
         by (auto elim: S_ArrowE_left)
       moreover
       have "S\<^sub>1 closed_in \<Gamma>" and "S\<^sub>2 closed_in \<Gamma>" 
         using lh_drv_prm\<^sub>1 lh_drv_prm\<^sub>2 by (simp_all add: subtype_implies_closed)
       hence "(S\<^sub>1 \<rightarrow> S\<^sub>2) closed_in \<Gamma>" by (simp add: closed_in_def ty.supp)
       moreover
       have "\<turnstile> \<Gamma> ok" using rh_drv by (rule subtype_implies_ok)
       moreover
       { assume "\<exists>T\<^sub>1 T\<^sub>2. T = T\<^sub>1\<rightarrow>T\<^sub>2 \<and> \<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1 \<and> \<Gamma> \<turnstile> Q\<^sub>2 <: T\<^sub>2"
         then obtain T\<^sub>1 T\<^sub>2 
           where T_inst: "T = T\<^sub>1 \<rightarrow> T\<^sub>2" 
           and   rh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1"
           and   rh_drv_prm\<^sub>2: "\<Gamma> \<turnstile> Q\<^sub>2 <: T\<^sub>2" by force
         from IH_trans[of "Q\<^sub>1"] 
         have "\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1" using Q\<^sub>12_less rh_drv_prm\<^sub>1 lh_drv_prm\<^sub>1 by simp 
         moreover
         from IH_trans[of "Q\<^sub>2"] 
         have "\<Gamma> \<turnstile> S\<^sub>2 <: T\<^sub>2" using Q\<^sub>12_less rh_drv_prm\<^sub>2 lh_drv_prm\<^sub>2 by simp
         ultimately have "\<Gamma> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T\<^sub>1 \<rightarrow> T\<^sub>2" by auto
         then have "\<Gamma> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T" using T_inst by simp
       }
       ultimately show "\<Gamma> \<turnstile> S\<^sub>1 \<rightarrow> S\<^sub>2 <: T" by blast
     next
       case (SA_all \<Gamma> Q\<^sub>1 S\<^sub>1 X S\<^sub>2 Q\<^sub>2) 
       then have rh_drv: "\<Gamma> \<turnstile> (\<forall>X<:Q\<^sub>1. Q\<^sub>2) <: T" by simp
       have lh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> Q\<^sub>1 <: S\<^sub>1" by fact
       have lh_drv_prm\<^sub>2: "((TVarB X Q\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: Q\<^sub>2" by fact
       then have "X\<sharp>\<Gamma>" by (force dest: subtype_implies_ok simp add: valid_ty_dom_fresh)
       then have fresh_cond: "X\<sharp>\<Gamma>" "X\<sharp>Q\<^sub>1" "X\<sharp>T" using rh_drv lh_drv_prm\<^sub>1 
         by (simp_all add: subtype_implies_fresh)
       from rh_drv 
       have "T = Top \<or> 
           (\<exists>T\<^sub>1 T\<^sub>2. T = (\<forall>X<:T\<^sub>1. T\<^sub>2) \<and> \<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1 \<and> ((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> Q\<^sub>2 <: T\<^sub>2)" 
         using fresh_cond by (simp add: S_ForallE_left)
       moreover
       have "S\<^sub>1 closed_in \<Gamma>" and "S\<^sub>2 closed_in ((TVarB X Q\<^sub>1)#\<Gamma>)" 
         using lh_drv_prm\<^sub>1 lh_drv_prm\<^sub>2 by (simp_all add: subtype_implies_closed)
-      then have "(\<forall>X<:S\<^sub>1. S\<^sub>2) closed_in \<Gamma>" by (force simp add: closed_in_def ty.supp abs_supp)
+      then have "(\<forall>X<:S\<^sub>1. S\<^sub>2) closed_in \<Gamma>" by (force simp: closed_in_def ty.supp abs_supp)
       moreover
       have "\<turnstile> \<Gamma> ok" using rh_drv by (rule subtype_implies_ok)
       moreover
       { assume "\<exists>T\<^sub>1 T\<^sub>2. T=(\<forall>X<:T\<^sub>1. T\<^sub>2) \<and> \<Gamma>\<turnstile>T\<^sub>1<:Q\<^sub>1 \<and> ((TVarB X T\<^sub>1)#\<Gamma>)\<turnstile>Q\<^sub>2<:T\<^sub>2"
         then obtain T\<^sub>1 T\<^sub>2 
           where T_inst: "T = (\<forall>X<:T\<^sub>1. T\<^sub>2)" 
           and   rh_drv_prm\<^sub>1: "\<Gamma> \<turnstile> T\<^sub>1 <: Q\<^sub>1" 
           and   rh_drv_prm\<^sub>2:"((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> Q\<^sub>2 <: T\<^sub>2" by force
         have "(\<forall>X<:Q\<^sub>1. Q\<^sub>2) = Q" by fact 
         then have Q\<^sub>12_less: "size_ty Q\<^sub>1 < size_ty Q" "size_ty Q\<^sub>2 < size_ty Q" 
           using fresh_cond by auto
         from IH_trans[of "Q\<^sub>1"] 
         have "\<Gamma> \<turnstile> T\<^sub>1 <: S\<^sub>1" using lh_drv_prm\<^sub>1 rh_drv_prm\<^sub>1 Q\<^sub>12_less by blast
         moreover
         from IH_narrow[of "Q\<^sub>1" "[]"] 
         have "((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: Q\<^sub>2" using Q\<^sub>12_less lh_drv_prm\<^sub>2 rh_drv_prm\<^sub>1 by simp
         with IH_trans[of "Q\<^sub>2"] 
         have "((TVarB X T\<^sub>1)#\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2" using Q\<^sub>12_less rh_drv_prm\<^sub>2 by simp
         ultimately have "\<Gamma> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: (\<forall>X<:T\<^sub>1. T\<^sub>2)"
           using fresh_cond by (simp add: subtype_of.SA_all)
         hence "\<Gamma> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: T" using T_inst by simp
       }
       ultimately show "\<Gamma> \<turnstile> (\<forall>X<:S\<^sub>1. S\<^sub>2) <: T" by blast
     qed
   } note transitivity_lemma = this  
 
   { \<comment> \<open>The transitivity proof is now by the auxiliary lemma.\<close>
     case 1 
     from \<open>\<Gamma> \<turnstile> S <: Q\<close> and \<open>\<Gamma> \<turnstile> Q <: T\<close>
     show "\<Gamma> \<turnstile> S <: T" by (rule transitivity_lemma) 
   next 
     case 2
     from \<open>(\<Delta>@[(TVarB X Q)]@\<Gamma>) \<turnstile> M <: N\<close> 
       and \<open>\<Gamma> \<turnstile> P<:Q\<close> 
     show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> M <: N" 
     proof (induct "\<Delta>@[(TVarB X Q)]@\<Gamma>" M N arbitrary: \<Gamma> X \<Delta> rule: subtype_of.induct) 
       case (SA_Top S \<Gamma> X \<Delta>)
       from \<open>\<Gamma> \<turnstile> P <: Q\<close>
       have "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
       with \<open>\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok\<close> have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok"
         by (simp add: replace_type)
       moreover
       from \<open>S closed_in (\<Delta>@[(TVarB X Q)]@\<Gamma>)\<close> have "S closed_in (\<Delta>@[(TVarB X P)]@\<Gamma>)" 
         by (simp add: closed_in_def doms_append)
       ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: Top" by (simp add: subtype_of.SA_Top)
     next
       case (SA_trans_TVar Y S N \<Gamma> X \<Delta>) 
       then have IH_inner: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> S <: N"
         and lh_drv_prm: "(TVarB Y S) \<in> set (\<Delta>@[(TVarB X Q)]@\<Gamma>)"
         and rh_drv: "\<Gamma> \<turnstile> P<:Q"
         and ok\<^sub>Q: "\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok" by (simp_all add: subtype_implies_ok)
       then have ok\<^sub>P: "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok" by (simp add: subtype_implies_ok) 
       show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N"
       proof (cases "X=Y")
         case False
         have "X\<noteq>Y" by fact
         hence "(TVarB Y S)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" using lh_drv_prm by (simp add:binding.inject)
         with IH_inner show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" by (simp add: subtype_of.SA_trans_TVar)
       next
         case True
         have memb\<^sub>XQ: "(TVarB X Q)\<in>set (\<Delta>@[(TVarB X Q)]@\<Gamma>)" by simp
         have memb\<^sub>XP: "(TVarB X P)\<in>set (\<Delta>@[(TVarB X P)]@\<Gamma>)" by simp
         have eq: "X=Y" by fact 
         hence "S=Q" using ok\<^sub>Q lh_drv_prm memb\<^sub>XQ by (simp only: uniqueness_of_ctxt)
         hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q <: N" using IH_inner by simp
         moreover
         have "(\<Delta>@[(TVarB X P)]@\<Gamma>) extends \<Gamma>" by (simp add: extends_def)
         hence "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: Q" using rh_drv ok\<^sub>P by (simp only: weakening)
         ultimately have "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> P <: N" by (simp add: transitivity_lemma) 
         then show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: N" using memb\<^sub>XP eq by auto
       qed
     next
       case (SA_refl_TVar Y \<Gamma> X \<Delta>)
       from \<open>\<Gamma> \<turnstile> P <: Q\<close>
       have "P closed_in \<Gamma>" by (simp add: subtype_implies_closed)
       with \<open>\<turnstile> (\<Delta>@[(TVarB X Q)]@\<Gamma>) ok\<close> have "\<turnstile> (\<Delta>@[(TVarB X P)]@\<Gamma>) ok"
         by (simp add: replace_type)
       moreover
       from \<open>Y \<in> ty_dom (\<Delta>@[(TVarB X Q)]@\<Gamma>)\<close> have "Y \<in> ty_dom (\<Delta>@[(TVarB X P)]@\<Gamma>)"
         by (simp add: doms_append)
       ultimately show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Tvar Y <: Tvar Y" by (simp add: subtype_of.SA_refl_TVar)
     next
       case (SA_arrow S\<^sub>1 Q\<^sub>1 Q\<^sub>2 S\<^sub>2 \<Gamma> X \<Delta>) 
       then show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> Q\<^sub>1 \<rightarrow> Q\<^sub>2 <: S\<^sub>1 \<rightarrow> S\<^sub>2" by blast 
     next
       case (SA_all T\<^sub>1 S\<^sub>1 Y S\<^sub>2 T\<^sub>2 \<Gamma> X \<Delta>)
       have IH_inner\<^sub>1: "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> T\<^sub>1 <: S\<^sub>1" 
         and IH_inner\<^sub>2: "(((TVarB Y T\<^sub>1)#\<Delta>)@[(TVarB X P)]@\<Gamma>) \<turnstile> S\<^sub>2 <: T\<^sub>2"
         by (fastforce intro: SA_all)+
       then show "(\<Delta>@[(TVarB X P)]@\<Gamma>) \<turnstile> (\<forall>Y<:S\<^sub>1. S\<^sub>2) <: (\<forall>Y<:T\<^sub>1. T\<^sub>2)" by auto
     qed
   } 
 qed
 
 section \<open>Typing\<close>
 
 inductive
   typing :: "env \<Rightarrow> trm \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _ : _" [60,60,60] 60) 
 where
   T_Var[intro]: "\<lbrakk> VarB x T \<in> set \<Gamma>; \<turnstile> \<Gamma> ok \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> Var x : T"
 | T_App[intro]: "\<lbrakk> \<Gamma> \<turnstile> t\<^sub>1 : T\<^sub>1 \<rightarrow> T\<^sub>2; \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^sub>1 \<cdot> t\<^sub>2 : T\<^sub>2"
 | T_Abs[intro]: "\<lbrakk> VarB x T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>x:T\<^sub>1. t\<^sub>2) : T\<^sub>1 \<rightarrow> T\<^sub>2"
 | T_Sub[intro]: "\<lbrakk> \<Gamma> \<turnstile> t : S; \<Gamma> \<turnstile> S <: T \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t : T"
 | T_TAbs[intro]:"\<lbrakk> TVarB X T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>X<:T\<^sub>1. t\<^sub>2) : (\<forall>X<:T\<^sub>1. T\<^sub>2)"
 | T_TApp[intro]:"\<lbrakk>X\<sharp>(\<Gamma>,t\<^sub>1,T\<^sub>2); \<Gamma> \<turnstile> t\<^sub>1 : (\<forall>X<:T\<^sub>11. T\<^sub>12); \<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>11\<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> t\<^sub>1 \<cdot>\<^sub>\<tau> T\<^sub>2 : (T\<^sub>12[X \<mapsto> T\<^sub>2]\<^sub>\<tau>)" 
 
 equivariance typing
 
 lemma better_T_TApp:
   assumes H1: "\<Gamma> \<turnstile> t\<^sub>1 : (\<forall>X<:T11. T12)"
   and H2: "\<Gamma> \<turnstile> T2 <: T11"
   shows "\<Gamma> \<turnstile> t\<^sub>1 \<cdot>\<^sub>\<tau> T2 : (T12[X \<mapsto> T2]\<^sub>\<tau>)"
 proof -
   obtain Y::tyvrs where Y: "Y \<sharp> (X, T12, \<Gamma>, t\<^sub>1, T2)"
     by (rule exists_fresh) (rule fin_supp)
   then have "Y \<sharp> (\<Gamma>, t\<^sub>1, T2)" by simp
   moreover from Y have "(\<forall>X<:T11. T12) = (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)"
-    by (auto simp add: ty.inject alpha' fresh_prod fresh_atm)
+    by (auto simp: ty.inject alpha' fresh_prod fresh_atm)
   with H1 have "\<Gamma> \<turnstile> t\<^sub>1 : (\<forall>Y<:T11. [(Y, X)] \<bullet> T12)" by simp
   ultimately have "\<Gamma> \<turnstile> t\<^sub>1 \<cdot>\<^sub>\<tau> T2 : (([(Y, X)] \<bullet> T12)[Y \<mapsto> T2]\<^sub>\<tau>)" using H2
     by (rule T_TApp)
   with Y show ?thesis by (simp add: type_subst_rename)
 qed
 
 lemma typing_ok:
   assumes "\<Gamma> \<turnstile> t : T"
   shows   "\<turnstile> \<Gamma> ok"
 using assms by (induct) (auto)
 
 nominal_inductive typing
 by (auto dest!: typing_ok intro: closed_in_fresh fresh_dom type_subst_fresh
     simp: abs_fresh fresh_type_subst_fresh ty_vrs_fresh valid_ty_dom_fresh fresh_trm_dom)
 
 lemma ok_imp_VarB_closed_in:
   assumes ok: "\<turnstile> \<Gamma> ok"
   shows "VarB x T \<in> set \<Gamma> \<Longrightarrow> T closed_in \<Gamma>" using ok
-  by induct (auto simp add: binding.inject closed_in_def)
+  by induct (auto simp: binding.inject closed_in_def)
 
 lemma tyvrs_of_subst: "tyvrs_of (B[X \<mapsto> T]\<^sub>b) = tyvrs_of B"
   by (nominal_induct B rule: binding.strong_induct) simp_all
 
 lemma ty_dom_subst: "ty_dom (\<Gamma>[X \<mapsto> T]\<^sub>e) = ty_dom \<Gamma>"
   by (induct \<Gamma>) (simp_all add: tyvrs_of_subst)
 
 lemma vrs_of_subst: "vrs_of (B[X \<mapsto> T]\<^sub>b) = vrs_of B"
   by (nominal_induct B rule: binding.strong_induct) simp_all
 
 lemma trm_dom_subst: "trm_dom (\<Gamma>[X \<mapsto> T]\<^sub>e) = trm_dom \<Gamma>"
   by (induct \<Gamma>) (simp_all add: vrs_of_subst)
 
 lemma subst_closed_in:
   "T closed_in (\<Delta> @ TVarB X S # \<Gamma>) \<Longrightarrow> U closed_in \<Gamma> \<Longrightarrow> T[X \<mapsto> U]\<^sub>\<tau> closed_in (\<Delta>[X \<mapsto> U]\<^sub>e @ \<Gamma>)"
-  apply (nominal_induct T avoiding: X U \<Gamma> rule: ty.strong_induct)
-  apply (simp add: closed_in_def ty.supp supp_atm doms_append ty_dom_subst)
-  apply blast
-  apply (simp add: closed_in_def ty.supp)
-  apply (simp add: closed_in_def ty.supp)
-  apply (simp add: closed_in_def ty.supp abs_supp)
-  apply (drule_tac x = X in meta_spec)
-  apply (drule_tac x = U in meta_spec)
-  apply (drule_tac x = "(TVarB tyvrs ty2) # \<Gamma>" in meta_spec)
-  apply (simp add: doms_append ty_dom_subst)
-  apply blast
-  done
+proof (nominal_induct T avoiding: X U \<Gamma> rule: ty.strong_induct)
+  case (Tvar tyvrs)
+  then show ?case
+    by (auto simp add: closed_in_def ty.supp supp_atm doms_append ty_dom_subst)
+next
+  case Top
+  then show ?case
+    using closed_in_def fresh_def by fastforce
+next
+  case (Arrow ty1 ty2)
+  then show ?case
+    by (simp add: closed_in_def ty.supp)
+next
+  case (Forall tyvrs ty1 ty2)
+  then have "supp (ty1[X \<mapsto> U]\<^sub>\<tau>) \<subseteq> ty_dom (\<Delta>[X \<mapsto> U]\<^sub>e @ TVarB tyvrs ty2 # \<Gamma>)"
+    apply (simp add: closed_in_def ty.supp abs_supp)
+    by (metis Diff_subset_conv Un_left_commute doms_append(1) le_supI2 ty_dom.simps(2) tyvrs_of.simps(2))
+  with Forall show ?case
+    by (auto simp add: closed_in_def ty.supp abs_supp doms_append)
+qed
 
 lemmas subst_closed_in' = subst_closed_in [where \<Delta>="[]", simplified]
 
 lemma typing_closed_in:
   assumes "\<Gamma> \<turnstile> t : T"
   shows   "T closed_in \<Gamma>"
 using assms
 proof induct
   case (T_Var x T \<Gamma>)
   from \<open>\<turnstile> \<Gamma> ok\<close> and \<open>VarB x T \<in> set \<Gamma>\<close>
   show ?case by (rule ok_imp_VarB_closed_in)
 next
   case (T_App \<Gamma> t\<^sub>1 T\<^sub>1 T\<^sub>2 t\<^sub>2)
-  then show ?case by (auto simp add: ty.supp closed_in_def)
+  then show ?case by (auto simp: ty.supp closed_in_def)
 next
   case (T_Abs x T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
   from \<open>VarB x T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
   have "T\<^sub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
-  with T_Abs show ?case by (auto simp add: ty.supp closed_in_def)
+  with T_Abs show ?case by (auto simp: ty.supp closed_in_def)
 next
   case (T_Sub \<Gamma> t S T)
   from \<open>\<Gamma> \<turnstile> S <: T\<close> show ?case by (simp add: subtype_implies_closed)
 next
   case (T_TAbs X T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
   from \<open>TVarB X T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
   have "T\<^sub>1 closed_in \<Gamma>" by (auto dest: typing_ok)
-  with T_TAbs show ?case by (auto simp add: ty.supp closed_in_def abs_supp)
+  with T_TAbs show ?case by (auto simp: ty.supp closed_in_def abs_supp)
 next
   case (T_TApp X \<Gamma> t\<^sub>1 T2 T11 T12)
   then have "T12 closed_in (TVarB X T11 # \<Gamma>)"
-    by (auto simp add: closed_in_def ty.supp abs_supp)
+    by (auto simp: closed_in_def ty.supp abs_supp)
   moreover from T_TApp have "T2 closed_in \<Gamma>"
     by (simp add: subtype_implies_closed)
   ultimately show ?case by (rule subst_closed_in')
 qed
 
 
 subsection \<open>Evaluation\<close>
 
 inductive
   val :: "trm \<Rightarrow> bool"
 where
   Abs[intro]:  "val (\<lambda>x:T. t)"
 | TAbs[intro]: "val (\<lambda>X<:T. t)"
 
 equivariance val
 
 inductive_cases val_inv_auto[elim]: 
   "val (Var x)" 
   "val (t1 \<cdot> t2)" 
   "val (t1 \<cdot>\<^sub>\<tau> t2)"
 
 inductive 
   eval :: "trm \<Rightarrow> trm \<Rightarrow> bool" ("_ \<longmapsto> _" [60,60] 60)
 where
   E_Abs         : "\<lbrakk> x \<sharp> v\<^sub>2; val v\<^sub>2 \<rbrakk> \<Longrightarrow> (\<lambda>x:T\<^sub>11. t\<^sub>12) \<cdot> v\<^sub>2 \<longmapsto> t\<^sub>12[x \<mapsto> v\<^sub>2]"
 | E_App1 [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot> u \<longmapsto> t' \<cdot> u"
 | E_App2 [intro]: "\<lbrakk> val v; t \<longmapsto> t' \<rbrakk> \<Longrightarrow> v \<cdot> t \<longmapsto> v \<cdot> t'"
 | E_TAbs        : "X \<sharp> (T\<^sub>11, T\<^sub>2) \<Longrightarrow> (\<lambda>X<:T\<^sub>11. t\<^sub>12) \<cdot>\<^sub>\<tau> T\<^sub>2 \<longmapsto> t\<^sub>12[X \<mapsto>\<^sub>\<tau> T\<^sub>2]"
 | E_TApp [intro]: "t \<longmapsto> t' \<Longrightarrow> t \<cdot>\<^sub>\<tau> T \<longmapsto> t' \<cdot>\<^sub>\<tau> T"
 
 lemma better_E_Abs[intro]:
   assumes H: "val v2"
   shows "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> t12[x \<mapsto> v2]"
 proof -
   obtain y::vrs where y: "y \<sharp> (x, t12, v2)" by (rule exists_fresh) (rule fin_supp)
   then have "y \<sharp> v2" by simp
   then have "(\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]" using H
     by (rule E_Abs)
   moreover from y have "(\<lambda>x:T11. t12) \<cdot> v2 = (\<lambda>y:T11. [(y, x)] \<bullet> t12) \<cdot> v2"
-    by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
+    by (auto simp: trm.inject alpha' fresh_prod fresh_atm)
   ultimately have "(\<lambda>x:T11. t12) \<cdot> v2 \<longmapsto> ([(y, x)] \<bullet> t12)[y \<mapsto> v2]"
     by simp
   with y show ?thesis by (simp add: subst_trm_rename)
 qed
 
 lemma better_E_TAbs[intro]: "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> t12[X \<mapsto>\<^sub>\<tau> T2]"
 proof -
   obtain Y::tyvrs where Y: "Y \<sharp> (X, t12, T11, T2)" by (rule exists_fresh) (rule fin_supp)
   then have "Y \<sharp> (T11, T2)" by simp
   then have "(\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
     by (rule E_TAbs)
   moreover from Y have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 = (\<lambda>Y<:T11. [(Y, X)] \<bullet> t12) \<cdot>\<^sub>\<tau> T2"
-    by (auto simp add: trm.inject alpha' fresh_prod fresh_atm)
+    by (auto simp: trm.inject alpha' fresh_prod fresh_atm)
   ultimately have "(\<lambda>X<:T11. t12) \<cdot>\<^sub>\<tau> T2 \<longmapsto> ([(Y, X)] \<bullet> t12)[Y \<mapsto>\<^sub>\<tau> T2]"
     by simp
   with Y show ?thesis by (simp add: subst_trm_ty_rename)
 qed
 
 equivariance eval
 
 nominal_inductive eval
   by (simp_all add: abs_fresh ty_vrs_fresh subst_trm_fresh_tyvar
     subst_trm_fresh_var subst_trm_ty_fresh')
 
 inductive_cases eval_inv_auto[elim]: 
   "Var x \<longmapsto> t'" 
   "(\<lambda>x:T. t) \<longmapsto> t'" 
   "(\<lambda>X<:T. t) \<longmapsto> t'" 
 
 lemma ty_dom_cons:
   shows "ty_dom (\<Gamma>@[VarB X Q]@\<Delta>) = ty_dom (\<Gamma>@\<Delta>)"
 by (induct \<Gamma>) (auto)
 
 lemma closed_in_cons: 
   assumes "S closed_in (\<Gamma> @ VarB X Q # \<Delta>)"
   shows "S closed_in (\<Gamma>@\<Delta>)"
 using assms ty_dom_cons closed_in_def by auto
 
 lemma closed_in_weaken: "T closed_in (\<Delta> @ \<Gamma>) \<Longrightarrow> T closed_in (\<Delta> @ B # \<Gamma>)"
-  by (auto simp add: closed_in_def doms_append)
+  by (auto simp: closed_in_def doms_append)
 
 lemma closed_in_weaken': "T closed_in \<Gamma> \<Longrightarrow> T closed_in (\<Delta> @ \<Gamma>)"
-  by (auto simp add: closed_in_def doms_append)
+  by (auto simp: closed_in_def doms_append)
 
 lemma valid_subst:
   assumes ok: "\<turnstile> (\<Delta> @ TVarB X Q # \<Gamma>) ok"
   and closed: "P closed_in \<Gamma>"
   shows "\<turnstile> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using ok closed
-  apply (induct \<Delta>)
-  apply simp_all
-  apply (erule validE)
-  apply assumption
-  apply (erule validE)
-  apply simp
-  apply (rule valid_consT)
-  apply assumption
-  apply (simp add: doms_append ty_dom_subst)
-  apply (simp add: fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst] finite_doms)
-  apply (rule_tac S=Q in subst_closed_in')
-  apply (simp add: closed_in_def doms_append ty_dom_subst)
-  apply (simp add: closed_in_def doms_append)
-  apply blast
-  apply simp
-  apply (rule valid_cons)
-  apply assumption
-  apply (simp add: doms_append trm_dom_subst)
-  apply (rule_tac S=Q in subst_closed_in')
-  apply (simp add: closed_in_def doms_append ty_dom_subst)
-  apply (simp add: closed_in_def doms_append)
-  apply blast
-  done
+proof (induct \<Delta>)
+  case Nil
+  then show ?case
+    by auto
+next
+  case (Cons a \<Delta>)
+  then have *: "\<turnstile> (a # \<Delta> @ TVarB X Q # \<Gamma>) ok"
+    by fastforce
+  then show ?case
+    apply (rule validE)
+    using Cons
+     apply (simp add: at_tyvrs_inst closed doms_append(1) finite_doms(1) fresh_fin_insert fs_tyvrs_inst pt_tyvrs_inst subst_closed_in ty_dom_subst)
+    by (simp add: doms_append(2) subst_closed_in Cons.hyps closed trm_dom_subst)
+qed
 
 lemma ty_dom_vrs:
   shows "ty_dom (G @ [VarB x Q] @ D) = ty_dom (G @ D)"
-by (induct G) (auto)
+  by (induct G) (auto)
 
 lemma valid_cons':
   assumes "\<turnstile> (\<Gamma> @ VarB x Q # \<Delta>) ok"
   shows "\<turnstile> (\<Gamma> @ \<Delta>) ok"
   using assms
 proof (induct "\<Gamma> @ VarB x Q # \<Delta>" arbitrary: \<Gamma> \<Delta>)
   case valid_nil
   have "[] = \<Gamma> @ VarB x Q # \<Delta>" by fact
   then have "False" by auto
   then show ?case by auto
 next
   case (valid_consT G X T)
   then show ?case
   proof (cases \<Gamma>)
     case Nil
     with valid_consT show ?thesis by simp
   next
     case (Cons b bs)
     with valid_consT
     have "\<turnstile> (bs @ \<Delta>) ok" by simp
     moreover from Cons and valid_consT have "X \<sharp> ty_dom (bs @ \<Delta>)"
       by (simp add: doms_append)
     moreover from Cons and valid_consT have "T closed_in (bs @ \<Delta>)"
       by (simp add: closed_in_def doms_append)
     ultimately have "\<turnstile> (TVarB X T # bs @ \<Delta>) ok"
       by (rule valid_rel.valid_consT)
     with Cons and valid_consT show ?thesis by simp
   qed
 next
   case (valid_cons G x T)
   then show ?case
   proof (cases \<Gamma>)
     case Nil
     with valid_cons show ?thesis by simp
   next
     case (Cons b bs)
     with valid_cons
     have "\<turnstile> (bs @ \<Delta>) ok" by simp
     moreover from Cons and valid_cons have "x \<sharp> trm_dom (bs @ \<Delta>)"
       by (simp add: doms_append finite_doms
         fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst])
     moreover from Cons and valid_cons have "T closed_in (bs @ \<Delta>)"
       by (simp add: closed_in_def doms_append)
     ultimately have "\<turnstile> (VarB x T # bs @ \<Delta>) ok"
       by (rule valid_rel.valid_cons)
     with Cons and valid_cons show ?thesis by simp
   qed
 qed
   
 text \<open>A.5(6)\<close>
 
 lemma type_weaken:
   assumes "(\<Delta>@\<Gamma>) \<turnstile> t : T"
   and     "\<turnstile> (\<Delta> @ B # \<Gamma>) ok"
   shows   "(\<Delta> @ B # \<Gamma>) \<turnstile> t : T"
 using assms
 proof(nominal_induct "\<Delta> @ \<Gamma>" t T avoiding: \<Delta> \<Gamma> B rule: typing.strong_induct)
   case (T_Var x T)
   then show ?case by auto
 next
   case (T_App X t\<^sub>1 T\<^sub>2 T\<^sub>11 T\<^sub>12)
   then show ?case by force
 next
   case (T_Abs y T\<^sub>1 t\<^sub>2 T\<^sub>2 \<Delta> \<Gamma>)
   then have "VarB y T\<^sub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2" by simp
   then have closed: "T\<^sub>1 closed_in (\<Delta> @ \<Gamma>)"
     by (auto dest: typing_ok)
   have "\<turnstile> (VarB y T\<^sub>1 # \<Delta> @ B # \<Gamma>) ok"
-    apply (rule valid_cons)
-    apply (rule T_Abs)
-    apply (simp add: doms_append
-      fresh_fin_insert [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
-      fresh_fin_union [OF pt_vrs_inst at_vrs_inst fs_vrs_inst]
-      finite_doms finite_vrs fresh_vrs_of T_Abs fresh_trm_dom)
-    apply (rule closed_in_weaken)
-    apply (rule closed)
-    done
+    by (simp add: T_Abs closed closed_in_weaken fresh_list_append fresh_list_cons fresh_trm_dom)
   then have "\<turnstile> ((VarB y T\<^sub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
   with _ have "(VarB y T\<^sub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2"
     by (rule T_Abs) simp
   then have "VarB y T\<^sub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2" by simp
   then show ?case by (rule typing.T_Abs)
 next
   case (T_Sub t S T \<Delta> \<Gamma>)
   from refl and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
   have "\<Delta> @ B # \<Gamma> \<turnstile> t : S" by (rule T_Sub)
   moreover from  \<open>(\<Delta> @ \<Gamma>)\<turnstile>S<:T\<close> and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
   have "(\<Delta> @ B # \<Gamma>)\<turnstile>S<:T"
     by (rule weakening) (simp add: extends_def T_Sub)
   ultimately show ?case by (rule typing.T_Sub)
 next
   case (T_TAbs X T\<^sub>1 t\<^sub>2 T\<^sub>2 \<Delta> \<Gamma>)
   from \<open>TVarB X T\<^sub>1 # \<Delta> @ \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close>
   have closed: "T\<^sub>1 closed_in (\<Delta> @ \<Gamma>)"
     by (auto dest: typing_ok)
   have "\<turnstile> (TVarB X T\<^sub>1 # \<Delta> @ B # \<Gamma>) ok"
-    apply (rule valid_consT)
-    apply (rule T_TAbs)
-    apply (simp add: doms_append
-      fresh_fin_insert [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
-      fresh_fin_union [OF pt_tyvrs_inst at_tyvrs_inst fs_tyvrs_inst]
-      finite_doms finite_vrs tyvrs_fresh T_TAbs fresh_dom)
-    apply (rule closed_in_weaken)
-    apply (rule closed)
-    done
+    by (simp add: T_TAbs at_tyvrs_inst closed closed_in_weaken doms_append finite_doms finite_vrs
+        fresh_dom fresh_fin_union fs_tyvrs_inst pt_tyvrs_inst tyvrs_fresh)
   then have "\<turnstile> ((TVarB X T\<^sub>1 # \<Delta>) @ B # \<Gamma>) ok" by simp
   with _ have "(TVarB X T\<^sub>1 # \<Delta>) @ B # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2"
     by (rule T_TAbs) simp
   then have "TVarB X T\<^sub>1 # \<Delta> @ B # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2" by simp
   then show ?case by (rule typing.T_TAbs)
 next
   case (T_TApp X t\<^sub>1 T2 T11 T12 \<Delta> \<Gamma>)
   have "\<Delta> @ B # \<Gamma> \<turnstile> t\<^sub>1 : (\<forall>X<:T11. T12)"
     by (rule T_TApp refl)+
   moreover from \<open>(\<Delta> @ \<Gamma>)\<turnstile>T2<:T11\<close> and \<open>\<turnstile> (\<Delta> @ B # \<Gamma>) ok\<close>
   have "(\<Delta> @ B # \<Gamma>)\<turnstile>T2<:T11"
     by (rule weakening) (simp add: extends_def T_TApp)
   ultimately show ?case by (rule better_T_TApp)
 qed
 
 lemma type_weaken':
  "\<Gamma> \<turnstile> t : T \<Longrightarrow>  \<turnstile> (\<Delta>@\<Gamma>) ok \<Longrightarrow> (\<Delta>@\<Gamma>) \<turnstile> t : T"
-  apply (induct \<Delta>)
-  apply simp_all
-  apply (erule validE)
-  apply (insert type_weaken [of "[]", simplified])
-  apply simp_all
-  done
+proof (induct \<Delta>)
+  case Nil
+  then show ?case by auto
+next
+  case (Cons a \<Delta>)
+  then show ?case
+    by (metis append_Cons append_Nil type_weaken validE(3))
+qed
 
 text \<open>A.6\<close>
 
 lemma strengthening:
   assumes "(\<Gamma> @ VarB x Q # \<Delta>) \<turnstile> S <: T"
   shows  "(\<Gamma>@\<Delta>) \<turnstile> S <: T"
   using assms
 proof (induct "\<Gamma> @ VarB x Q # \<Delta>" S T arbitrary: \<Gamma>)
   case (SA_Top S)
   then have "\<turnstile> (\<Gamma> @ \<Delta>) ok" by (auto dest: valid_cons')
   moreover have "S closed_in (\<Gamma> @ \<Delta>)" using SA_Top by (auto dest: closed_in_cons)
   ultimately show ?case using subtype_of.SA_Top by auto
 next
   case (SA_refl_TVar X)
   from \<open>\<turnstile> (\<Gamma> @ VarB x Q # \<Delta>) ok\<close>
   have h1:"\<turnstile> (\<Gamma> @ \<Delta>) ok" by (auto dest: valid_cons')
   have "X \<in> ty_dom (\<Gamma> @ VarB x Q # \<Delta>)" using SA_refl_TVar by auto
   then have h2:"X \<in> ty_dom (\<Gamma> @ \<Delta>)" using ty_dom_vrs by auto
   show ?case using h1 h2 by auto
 next
   case (SA_all T1 S1 X S2 T2)
   have h1:"((TVarB X T1 # \<Gamma>) @ \<Delta>)\<turnstile>S2<:T2" by (fastforce intro: SA_all)
   have h2:"(\<Gamma> @ \<Delta>)\<turnstile>T1<:S1" using SA_all by auto
   then show ?case using h1 h2 by auto
 qed (auto)
 
 lemma narrow_type: \<comment> \<open>A.7\<close>
   assumes H: "\<Delta> @ (TVarB X Q) # \<Gamma> \<turnstile> t : T"
   shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> \<Delta> @ (TVarB X P) # \<Gamma> \<turnstile> t : T"
   using H
   proof (nominal_induct "\<Delta> @ (TVarB X Q) # \<Gamma>" t T avoiding: P arbitrary: \<Delta> rule: typing.strong_induct)
     case (T_Var x T P D)
     then have "VarB x T \<in> set (D @ TVarB X P # \<Gamma>)" 
       and "\<turnstile>  (D @ TVarB X P # \<Gamma>) ok"
       by (auto intro: replace_type dest!: subtype_implies_closed)
     then show ?case by auto
   next
     case (T_App t1 T1 T2 t2 P D)
     then show ?case by force
   next
     case (T_Abs x T1 t2 T2 P D)
     then show ?case by (fastforce dest: typing_ok)
   next
     case (T_Sub t S T P D)
     then show ?case using subtype_narrow by fastforce
   next
     case (T_TAbs X' T1 t2 T2 P D)
     then show ?case by (fastforce dest: typing_ok)
   next
     case (T_TApp X' t1 T2 T11 T12 P D)
     then have "D @ TVarB X P # \<Gamma> \<turnstile> t1 : Forall X' T12 T11" by fastforce
     moreover have "(D @ [TVarB X Q] @ \<Gamma>) \<turnstile> T2<:T11" using T_TApp by auto
     then have "(D @ [TVarB X P] @ \<Gamma>) \<turnstile> T2<:T11" using \<open>\<Gamma>\<turnstile>P<:Q\<close>
       by (rule subtype_narrow)
     moreover from T_TApp have "X' \<sharp> (D @ TVarB X P # \<Gamma>, t1, T2)"
       by (simp add: fresh_list_append fresh_list_cons fresh_prod)
     ultimately show ?case by auto
 qed
 
 subsection \<open>Substitution lemmas\<close>
 
 subsubsection \<open>Substition Preserves Typing\<close>
 
 theorem subst_type: \<comment> \<open>A.8\<close>
   assumes H: "(\<Delta> @ (VarB x U) # \<Gamma>) \<turnstile> t : T"
   shows "\<Gamma> \<turnstile> u : U \<Longrightarrow> \<Delta> @ \<Gamma> \<turnstile> t[x \<mapsto> u] : T" using H
  proof (nominal_induct "\<Delta> @ (VarB x U) # \<Gamma>" t T avoiding: x u arbitrary: \<Delta> rule: typing.strong_induct)
    case (T_Var y T x u D)
    show ?case
    proof (cases "x = y")
      assume eq:"x=y"
      then have "T=U" using T_Var uniqueness_of_ctxt' by auto
      then show ?case using eq T_Var
        by (auto intro: type_weaken' dest: valid_cons')
    next
      assume "x\<noteq>y"
      then show ?case using T_Var
-       by (auto simp add:binding.inject dest: valid_cons')
+       by (auto simp:binding.inject dest: valid_cons')
    qed
  next
    case (T_App t1 T1 T2 t2 x u D)
    then show ?case by force
  next
    case (T_Abs y T1 t2 T2 x u D)
    then show ?case by force
  next
    case (T_Sub t S T x u D)
    then have "D @ \<Gamma> \<turnstile> t[x \<mapsto> u] : S" by auto
    moreover have "(D @ \<Gamma>) \<turnstile> S<:T" using T_Sub by (auto dest: strengthening)
    ultimately show ?case by auto 
  next
    case (T_TAbs X T1 t2 T2 x u D)
    from \<open>TVarB X T1 # D @ VarB x U # \<Gamma> \<turnstile> t2 : T2\<close> have "X \<sharp> T1"
-     by (auto simp add: valid_ty_dom_fresh dest: typing_ok intro!: closed_in_fresh)
+     by (auto simp: valid_ty_dom_fresh dest: typing_ok intro!: closed_in_fresh)
    with \<open>X \<sharp> u\<close> and T_TAbs show ?case by fastforce
  next
    case (T_TApp X t1 T2 T11 T12 x u D)
    then have "(D@\<Gamma>) \<turnstile>T2<:T11" using T_TApp by (auto dest: strengthening)
    then show "((D @ \<Gamma>) \<turnstile> ((t1 \<cdot>\<^sub>\<tau> T2)[x \<mapsto> u]) : (T12[X \<mapsto> T2]\<^sub>\<tau>))" using T_TApp
-     by (force simp add: fresh_prod fresh_list_append fresh_list_cons subst_trm_fresh_tyvar)
+     by (force simp: fresh_prod fresh_list_append fresh_list_cons subst_trm_fresh_tyvar)
 qed
 
 subsubsection \<open>Type Substitution Preserves Subtyping\<close>
 
 lemma substT_subtype: \<comment> \<open>A.10\<close>
   assumes H: "(\<Delta> @ ((TVarB X Q) # \<Gamma>)) \<turnstile> S <: T"
   shows "\<Gamma> \<turnstile> P <: Q \<Longrightarrow> (\<Delta>[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>" 
   using H
 proof (nominal_induct "\<Delta> @ TVarB X Q # \<Gamma>" S T avoiding: X P arbitrary: \<Delta> rule: subtype_of.strong_induct)
   case (SA_Top S X P D)
   then have "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by simp
   moreover have closed: "P closed_in \<Gamma>" using SA_Top subtype_implies_closed by auto 
   ultimately have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule valid_subst)
   moreover from SA_Top have "S closed_in (D @ TVarB X Q # \<Gamma>)" by simp
   then have "S[X \<mapsto> P]\<^sub>\<tau> closed_in  (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" using closed by (rule subst_closed_in)
   ultimately show ?case by auto
 next
   case (SA_trans_TVar Y S T X P D)
   have h:"(D @ TVarB X Q # \<Gamma>)\<turnstile>S<:T" by fact
   then have ST: "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S[X \<mapsto> P]\<^sub>\<tau> <: T[X \<mapsto> P]\<^sub>\<tau>" using SA_trans_TVar by auto
   from h have G_ok: "\<turnstile> (D @ TVarB X Q # \<Gamma>) ok" by (rule subtype_implies_ok)
   from G_ok and SA_trans_TVar have X_\<Gamma>_ok: "\<turnstile> (TVarB X Q # \<Gamma>) ok"
     by (auto intro: validE_append)
   show "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> Tvar Y[X \<mapsto> P]\<^sub>\<tau><:T[X \<mapsto> P]\<^sub>\<tau>"
   proof (cases "X = Y")
     assume eq: "X = Y"
     from eq and SA_trans_TVar have "TVarB Y Q \<in> set (D @ TVarB X Q # \<Gamma>)" by simp
     with G_ok have QS: "Q = S" using \<open>TVarB Y S \<in> set (D @ TVarB X Q # \<Gamma>)\<close>
       by (rule uniqueness_of_ctxt)
     from X_\<Gamma>_ok have "X \<sharp> ty_dom \<Gamma>" and "Q closed_in \<Gamma>" by auto
     then have XQ: "X \<sharp> Q" by (rule closed_in_fresh)
     note \<open>\<Gamma>\<turnstile>P<:Q\<close>
     moreover from ST have "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" by (rule subtype_implies_ok)
     moreover have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) extends \<Gamma>" by (simp add: extends_def)
     ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:Q" by (rule weakening)
     with QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:S" by simp
     moreover from XQ and ST and QS have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> S<:T[X \<mapsto> P]\<^sub>\<tau>"
       by (simp add: type_subst_identity)
     ultimately have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>) \<turnstile> P<:T[X \<mapsto> P]\<^sub>\<tau>"
       by (rule subtype_transitivity)
     with eq show ?case by simp
   next
     assume neq: "X \<noteq> Y"
     with SA_trans_TVar have "TVarB Y S \<in> set D \<or> TVarB Y S \<in> set \<Gamma>"
       by (simp add: binding.inject)
     then show ?case
     proof
       assume "TVarB Y S \<in> set D"
       then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e)"
         by (rule ctxt_subst_mem_TVarB)
       then have "TVarB Y (S[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
       with neq and ST show ?thesis by auto
     next
       assume Y: "TVarB Y S \<in> set \<Gamma>"
       from X_\<Gamma>_ok have "X \<sharp> ty_dom \<Gamma>" and "\<turnstile> \<Gamma> ok" by auto
       then have "X \<sharp> \<Gamma>" by (simp add: valid_ty_dom_fresh)
       with Y have "X \<sharp> S"
-        by (induct \<Gamma>) (auto simp add: fresh_list_nil fresh_list_cons)
+        by (induct \<Gamma>) (auto simp: fresh_list_nil fresh_list_cons)
       with ST have "(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S<:T[X \<mapsto> P]\<^sub>\<tau>"
         by (simp add: type_subst_identity)
       moreover from Y have "TVarB Y S \<in> set (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)" by simp
       ultimately show ?thesis using neq by auto
     qed
   qed
 next
   case (SA_refl_TVar Y X P D)
   note \<open>\<turnstile> (D @ TVarB X Q # \<Gamma>) ok\<close>
   moreover from SA_refl_TVar have closed: "P closed_in \<Gamma>"
     by (auto dest: subtype_implies_closed)
   ultimately have ok: "\<turnstile> (D[X \<mapsto> P]\<^sub>e @ \<Gamma>) ok" using valid_subst by auto
   from closed have closed': "P closed_in (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
     by (simp add: closed_in_weaken')
   show ?case
   proof (cases "X = Y")
     assume "X = Y"
     with closed' and ok show ?thesis
       by (auto intro: subtype_reflexivity)
   next
     assume neq: "X \<noteq> Y"
     with SA_refl_TVar have "Y \<in> ty_dom (D[X \<mapsto> P]\<^sub>e @ \<Gamma>)"
       by (simp add: ty_dom_subst doms_append)
     with neq and ok show ?thesis by auto
   qed
 next
   case (SA_arrow T1 S1 S2 T2 X P D)
   then have h1:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>T1[X \<mapsto> P]\<^sub>\<tau><:S1[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
   from SA_arrow have h2:"(D[X \<mapsto> P]\<^sub>e @ \<Gamma>)\<turnstile>S2[X \<mapsto> P]\<^sub>\<tau><:T2[X \<mapsto> P]\<^sub>\<tau>" using SA_arrow by auto
   show ?case using subtype_of.SA_arrow h1 h2 by auto
 next
   case (SA_all T1 S1 Y S2 T2 X P D)
   then have Y: "Y \<sharp> ty_dom (D @ TVarB X Q # \<Gamma>)"
     by (auto dest: subtype_implies_ok intro: fresh_dom)
   moreover from SA_all have "S1 closed_in (D @ TVarB X Q # \<Gamma>)"
     by (auto dest: subtype_implies_closed)
   ultimately have S1: "Y \<sharp> S1" by (rule closed_in_fresh)
   from SA_all have "T1 closed_in (D @ TVarB X Q # \<Gamma>)"
     by (auto dest: subtype_implies_closed)
   with Y have T1: "Y \<sharp> T1" by (rule closed_in_fresh)
   with SA_all and S1 show ?case by force
 qed
 
 subsubsection \<open>Type Substitution Preserves Typing\<close>
 
 theorem substT_type: \<comment> \<open>A.11\<close>
   assumes H: "(D @ TVarB X Q # G) \<turnstile> t : T"
   shows "G \<turnstile> P <: Q \<Longrightarrow>
     (D[X \<mapsto> P]\<^sub>e @ G) \<turnstile> t[X \<mapsto>\<^sub>\<tau> P] : T[X \<mapsto> P]\<^sub>\<tau>" using H
 proof (nominal_induct "D @ TVarB X Q # G" t T avoiding: X P arbitrary: D rule: typing.strong_induct)
   case (T_Var x T X P D')
   have "G\<turnstile>P<:Q" by fact
   then have "P closed_in G" using subtype_implies_closed by auto
   moreover note \<open>\<turnstile> (D' @ TVarB X Q # G) ok\<close>
   ultimately have "\<turnstile> (D'[X \<mapsto> P]\<^sub>e @ G) ok" using valid_subst by auto
   moreover note \<open>VarB x T \<in> set (D' @ TVarB X Q # G)\<close>
   then have "VarB x T \<in> set D' \<or> VarB x T \<in> set G" by simp
   then have "(VarB x (T[X \<mapsto> P]\<^sub>\<tau>)) \<in> set (D'[X \<mapsto> P]\<^sub>e @ G)"
   proof
     assume "VarB x T \<in> set D'"
     then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set (D'[X \<mapsto> P]\<^sub>e)"
       by (rule ctxt_subst_mem_VarB)
     then show ?thesis by simp
   next
     assume x: "VarB x T \<in> set G"
     from T_Var have ok: "\<turnstile> G ok" by (auto dest: subtype_implies_ok)
     then have "X \<sharp> ty_dom G" using T_Var by (auto dest: validE_append)
     with ok have "X \<sharp> G" by (simp add: valid_ty_dom_fresh)
     moreover from x have "VarB x T \<in> set (D' @ G)" by simp
     then have "VarB x (T[X \<mapsto> P]\<^sub>\<tau>) \<in> set ((D' @ G)[X \<mapsto> P]\<^sub>e)"
       by (rule ctxt_subst_mem_VarB)
     ultimately show ?thesis
       by (simp add: ctxt_subst_append ctxt_subst_identity)
   qed
   ultimately show ?case by auto
 next
   case (T_App t1 T1 T2 t2 X P D')
   then have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (T1 \<rightarrow> T2)[X \<mapsto> P]\<^sub>\<tau>" by auto
   moreover from T_App have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t2[X \<mapsto>\<^sub>\<tau> P] : T1[X \<mapsto> P]\<^sub>\<tau>" by auto
   ultimately show ?case by auto
 next
   case (T_Abs x T1 t2 T2 X P D')
   then show ?case by force
 next
   case (T_Sub t S T X P D')
   then show ?case using substT_subtype by force
 next
   case (T_TAbs X' T1 t2 T2 X P D')
   then have "X' \<sharp> ty_dom (D' @ TVarB X Q # G)"
   and "T1 closed_in (D' @ TVarB X Q # G)"
     by (auto dest: typing_ok)
   then have "X' \<sharp> T1" by (rule closed_in_fresh)
   with T_TAbs show ?case by force
 next
   case (T_TApp X' t1 T2 T11 T12 X P D')
   then have "X' \<sharp> ty_dom (D' @ TVarB X Q # G)"
     by (simp add: fresh_dom)
   moreover from T_TApp have "T11 closed_in (D' @ TVarB X Q # G)"
     by (auto dest: subtype_implies_closed)
   ultimately have X': "X' \<sharp> T11" by (rule closed_in_fresh)
   from T_TApp have "D'[X \<mapsto> P]\<^sub>e @ G \<turnstile> t1[X \<mapsto>\<^sub>\<tau> P] : (\<forall>X'<:T11. T12)[X \<mapsto> P]\<^sub>\<tau>"
     by simp
   with X' and T_TApp show ?case
-    by (auto simp add: fresh_atm type_substitution_lemma
+    by (auto simp: fresh_atm type_substitution_lemma
       fresh_list_append fresh_list_cons
       ctxt_subst_fresh' type_subst_fresh subst_trm_ty_fresh
       intro: substT_subtype)
 qed
 
 lemma Abs_type: \<comment> \<open>A.13(1)\<close>
   assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : T"
   and H': "\<Gamma> \<turnstile> T <: U \<rightarrow> U'"
   and H'': "x \<sharp> \<Gamma>"
   obtains S' where "\<Gamma> \<turnstile> U <: S"
              and   "(VarB x S) # \<Gamma> \<turnstile> s : S'"
              and   "\<Gamma> \<turnstile> S' <: U'"
   using H H' H''
 proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>x:S. s" T avoiding: x arbitrary: U U' S s rule: typing.strong_induct)
   case (T_Abs y T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
   from \<open>\<Gamma> \<turnstile> T\<^sub>1 \<rightarrow> T\<^sub>2 <: U \<rightarrow> U'\<close>
   obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "\<Gamma> \<turnstile> T\<^sub>2 <: U'" using T_Abs
     by cases (simp_all add: ty.inject trm.inject alpha fresh_atm)
   from T_Abs have "VarB y S # \<Gamma> \<turnstile> [(y, x)] \<bullet> s : T\<^sub>2"
     by (simp add: trm.inject alpha fresh_atm)
   then have "[(y, x)] \<bullet> (VarB y S # \<Gamma>) \<turnstile> [(y, x)] \<bullet> [(y, x)] \<bullet> s : [(y, x)] \<bullet> T\<^sub>2"
     by (rule typing.eqvt)
   moreover from T_Abs have "y \<sharp> \<Gamma>"
     by (auto dest!: typing_ok simp add: fresh_trm_dom)
   ultimately have "VarB x S # \<Gamma> \<turnstile> s : T\<^sub>2" using T_Abs
     by (perm_simp add: ty_vrs_prm_simp)
   with ty1 show ?case using ty2 by (rule T_Abs)
 next
   case (T_Sub \<Gamma> t S T)
   then show ?case using subtype_transitivity by blast
 qed simp_all
 
 lemma subtype_reflexivity_from_typing:
   assumes "\<Gamma> \<turnstile> t : T"
   shows "\<Gamma> \<turnstile> T <: T"
 using assms subtype_reflexivity typing_ok typing_closed_in by simp
 
 lemma Abs_type':
   assumes H: "\<Gamma> \<turnstile> (\<lambda>x:S. s) : U \<rightarrow> U'"
   and H': "x \<sharp> \<Gamma>"
   obtains S'
   where "\<Gamma> \<turnstile> U <: S"
   and "(VarB x S) # \<Gamma> \<turnstile> s : S'"
   and "\<Gamma> \<turnstile> S' <: U'"
   using H subtype_reflexivity_from_typing [OF H] H'
   by (rule Abs_type)
 
 lemma TAbs_type: \<comment> \<open>A.13(2)\<close>
   assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : T"
   and H': "\<Gamma> \<turnstile> T <: (\<forall>X<:U. U')"
   and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
   obtains S'
   where "\<Gamma> \<turnstile> U <: S"
   and   "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
   and   "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
   using H H' fresh
 proof (nominal_induct \<Gamma> t \<equiv> "\<lambda>X<:S. s" T avoiding: X U U' S arbitrary: s rule: typing.strong_induct)
   case (T_TAbs Y T\<^sub>1 \<Gamma> t\<^sub>2 T\<^sub>2)
   from \<open>TVarB Y T\<^sub>1 # \<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>2\<close> have Y: "Y \<sharp> \<Gamma>"
     by (auto dest!: typing_ok simp add: valid_ty_dom_fresh)
   from \<open>Y \<sharp> U'\<close> and \<open>Y \<sharp> X\<close>
   have "(\<forall>X<:U. U') = (\<forall>Y<:U. [(Y, X)] \<bullet> U')"
     by (simp add: ty.inject alpha' fresh_atm)
   with T_TAbs have "\<Gamma> \<turnstile> (\<forall>Y<:S. T\<^sub>2) <: (\<forall>Y<:U. [(Y, X)] \<bullet> U')" by (simp add: trm.inject)
   then obtain ty1: "\<Gamma> \<turnstile> U <: S" and ty2: "(TVarB Y U # \<Gamma>) \<turnstile> T\<^sub>2 <: ([(Y, X)] \<bullet> U')" using T_TAbs Y
     by (cases rule: subtype_of.strong_cases [where X=Y]) (simp_all add: ty.inject alpha abs_fresh)
   note ty1
   moreover from T_TAbs have "TVarB Y S # \<Gamma> \<turnstile> ([(Y, X)] \<bullet> s) : T\<^sub>2"
     by (simp add: trm.inject alpha fresh_atm)
   then have "[(Y, X)] \<bullet> (TVarB Y S # \<Gamma>) \<turnstile> [(Y, X)] \<bullet> [(Y, X)] \<bullet> s : [(Y, X)] \<bullet> T\<^sub>2"
     by (rule typing.eqvt)
   with \<open>X \<sharp> \<Gamma>\<close> \<open>X \<sharp> S\<close> Y \<open>Y \<sharp> S\<close> have "TVarB X S # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^sub>2"
     by perm_simp
   then have "TVarB X U # \<Gamma> \<turnstile> s : [(Y, X)] \<bullet> T\<^sub>2" using ty1
     by (rule narrow_type [of "[]", simplified])
   moreover from ty2 have "([(Y, X)] \<bullet> (TVarB Y U # \<Gamma>)) \<turnstile> ([(Y, X)] \<bullet> T\<^sub>2) <: ([(Y, X)] \<bullet> [(Y, X)] \<bullet> U')"
     by (rule subtype_of.eqvt)
   with \<open>X \<sharp> \<Gamma>\<close> \<open>X \<sharp> U\<close> Y \<open>Y \<sharp> U\<close> have "(TVarB X U # \<Gamma>) \<turnstile> ([(Y, X)] \<bullet> T\<^sub>2) <: U'"
     by perm_simp
   ultimately show ?case by (rule T_TAbs)
 next
   case (T_Sub \<Gamma> t S T)
   then show ?case using subtype_transitivity by blast 
 qed simp_all
 
 lemma TAbs_type':
   assumes H: "\<Gamma> \<turnstile> (\<lambda>X<:S. s) : (\<forall>X<:U. U')"
   and fresh: "X \<sharp> \<Gamma>" "X \<sharp> S" "X \<sharp> U"
   obtains S'
   where "\<Gamma> \<turnstile> U <: S"
   and "(TVarB X U # \<Gamma>) \<turnstile> s : S'"
   and "(TVarB X U # \<Gamma>) \<turnstile> S' <: U'"
   using H subtype_reflexivity_from_typing [OF H] fresh
   by (rule TAbs_type)
 
 theorem preservation: \<comment> \<open>A.20\<close>
   assumes H: "\<Gamma> \<turnstile> t : T"
   shows "t \<longmapsto> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : T" using H
 proof (nominal_induct avoiding: t' rule: typing.strong_induct)
   case (T_App \<Gamma> t\<^sub>1 T\<^sub>11 T\<^sub>12 t\<^sub>2 t')
   obtain x::vrs where x_fresh: "x \<sharp> (\<Gamma>, t\<^sub>1 \<cdot> t\<^sub>2, t')"
     by (rule exists_fresh) (rule fin_supp)
   obtain X::tyvrs where "X \<sharp> (t\<^sub>1 \<cdot> t\<^sub>2, t')"
     by (rule exists_fresh) (rule fin_supp)
   with \<open>t\<^sub>1 \<cdot> t\<^sub>2 \<longmapsto> t'\<close> show ?case
   proof (cases rule: eval.strong_cases [where x=x and X=X])
     case (E_Abs v\<^sub>2 T\<^sub>11' t\<^sub>12)
     with T_App and x_fresh have h: "\<Gamma> \<turnstile> (\<lambda>x:T\<^sub>11'. t\<^sub>12) : T\<^sub>11 \<rightarrow> T\<^sub>12"
       by (simp add: trm.inject fresh_prod)
     moreover from x_fresh have "x \<sharp> \<Gamma>" by simp
     ultimately obtain S'
       where T\<^sub>11: "\<Gamma> \<turnstile> T\<^sub>11 <: T\<^sub>11'"
       and t\<^sub>12: "(VarB x T\<^sub>11') # \<Gamma> \<turnstile> t\<^sub>12 : S'"
       and S': "\<Gamma> \<turnstile> S' <: T\<^sub>12"
       by (rule Abs_type') blast
     from \<open>\<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>11\<close>
     have "\<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>11'" using T\<^sub>11 by (rule T_Sub)
     with t\<^sub>12 have "\<Gamma> \<turnstile> t\<^sub>12[x \<mapsto> t\<^sub>2] : S'" 
       by (rule subst_type [where \<Delta>="[]", simplified])
     hence "\<Gamma> \<turnstile> t\<^sub>12[x \<mapsto> t\<^sub>2] : T\<^sub>12" using S' by (rule T_Sub)
     with E_Abs and x_fresh show ?thesis by (simp add: trm.inject fresh_prod)
   next
     case (E_App1 t''' t'' u)
     hence "t\<^sub>1 \<longmapsto> t''" by (simp add:trm.inject) 
     hence "\<Gamma> \<turnstile> t'' : T\<^sub>11 \<rightarrow> T\<^sub>12" by (rule T_App)
     hence "\<Gamma> \<turnstile> t'' \<cdot> t\<^sub>2 : T\<^sub>12" using \<open>\<Gamma> \<turnstile> t\<^sub>2 : T\<^sub>11\<close>
       by (rule typing.T_App)
     with E_App1 show ?thesis by (simp add:trm.inject)
   next
     case (E_App2 v t''' t'')
     hence "t\<^sub>2 \<longmapsto> t''" by (simp add:trm.inject) 
     hence "\<Gamma> \<turnstile> t'' : T\<^sub>11" by (rule T_App)
     with T_App(1) have "\<Gamma> \<turnstile> t\<^sub>1 \<cdot> t'' : T\<^sub>12"
       by (rule typing.T_App)
     with E_App2 show ?thesis by (simp add:trm.inject) 
   qed (simp_all add: fresh_prod)
 next
   case (T_TApp X \<Gamma> t\<^sub>1 T\<^sub>2  T\<^sub>11  T\<^sub>12 t')
   obtain x::vrs where "x \<sharp> (t\<^sub>1 \<cdot>\<^sub>\<tau> T\<^sub>2, t')"
     by (rule exists_fresh) (rule fin_supp)
   with \<open>t\<^sub>1 \<cdot>\<^sub>\<tau> T\<^sub>2 \<longmapsto> t'\<close>
   show ?case
   proof (cases rule: eval.strong_cases [where X=X and x=x])
     case (E_TAbs T\<^sub>11' T\<^sub>2' t\<^sub>12)
     with T_TApp have "\<Gamma> \<turnstile> (\<lambda>X<:T\<^sub>11'. t\<^sub>12) : (\<forall>X<:T\<^sub>11. T\<^sub>12)" and "X \<sharp> \<Gamma>" and "X \<sharp> T\<^sub>11'"
       by (simp_all add: trm.inject)
     moreover from \<open>\<Gamma>\<turnstile>T\<^sub>2<:T\<^sub>11\<close> and \<open>X \<sharp> \<Gamma>\<close> have "X \<sharp> T\<^sub>11"
       by (blast intro: closed_in_fresh fresh_dom dest: subtype_implies_closed)
     ultimately obtain S'
       where "TVarB X T\<^sub>11 # \<Gamma> \<turnstile> t\<^sub>12 : S'"
       and "(TVarB X T\<^sub>11 # \<Gamma>) \<turnstile> S' <: T\<^sub>12"
       by (rule TAbs_type') blast
     hence "TVarB X T\<^sub>11 # \<Gamma> \<turnstile> t\<^sub>12 : T\<^sub>12" by (rule T_Sub)
     hence "\<Gamma> \<turnstile> t\<^sub>12[X \<mapsto>\<^sub>\<tau> T\<^sub>2] : T\<^sub>12[X \<mapsto> T\<^sub>2]\<^sub>\<tau>" using \<open>\<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>11\<close>
       by (rule substT_type [where D="[]", simplified])
     with T_TApp and E_TAbs show ?thesis by (simp add: trm.inject)
   next
     case (E_TApp t''' t'' T)
     from E_TApp have "t\<^sub>1 \<longmapsto> t''" by (simp add: trm.inject)
     then have "\<Gamma> \<turnstile> t'' : (\<forall>X<:T\<^sub>11. T\<^sub>12)" by (rule T_TApp)
     then have "\<Gamma> \<turnstile> t'' \<cdot>\<^sub>\<tau> T\<^sub>2 : T\<^sub>12[X \<mapsto> T\<^sub>2]\<^sub>\<tau>" using \<open>\<Gamma> \<turnstile> T\<^sub>2 <: T\<^sub>11\<close>
       by (rule better_T_TApp)
     with E_TApp show ?thesis by (simp add: trm.inject)
   qed (simp_all add: fresh_prod)
 next
   case (T_Sub \<Gamma> t S T t')
   have "t \<longmapsto> t'" by fact
   hence "\<Gamma> \<turnstile> t' : S" by (rule T_Sub)
   moreover have "\<Gamma> \<turnstile> S <: T" by fact
   ultimately show ?case by (rule typing.T_Sub)
 qed (auto)
 
 lemma Fun_canonical: \<comment> \<open>A.14(1)\<close>
   assumes ty: "[] \<turnstile> v : T\<^sub>1 \<rightarrow> T\<^sub>2"
   shows "val v \<Longrightarrow> \<exists>x t S. v = (\<lambda>x:S. t)" using ty
 proof (induct "[]::env" v "T\<^sub>1 \<rightarrow> T\<^sub>2" arbitrary: T\<^sub>1 T\<^sub>2)
   case (T_Sub t S)
   from \<open>[] \<turnstile> S <: T\<^sub>1 \<rightarrow> T\<^sub>2\<close>
   obtain S\<^sub>1 S\<^sub>2 where S: "S = S\<^sub>1 \<rightarrow> S\<^sub>2" 
-    by cases (auto simp add: T_Sub)
+    by cases (auto simp: T_Sub)
   then show ?case using \<open>val t\<close> by (rule T_Sub)
 qed (auto)
 
 lemma TyAll_canonical: \<comment> \<open>A.14(3)\<close>
   fixes X::tyvrs
   assumes ty: "[] \<turnstile> v : (\<forall>X<:T\<^sub>1. T\<^sub>2)"
   shows "val v \<Longrightarrow> \<exists>X t S. v = (\<lambda>X<:S. t)" using ty
 proof (induct "[]::env" v "\<forall>X<:T\<^sub>1. T\<^sub>2" arbitrary: X T\<^sub>1 T\<^sub>2)
   case (T_Sub t S)
   from \<open>[] \<turnstile> S <: (\<forall>X<:T\<^sub>1. T\<^sub>2)\<close>
   obtain X S\<^sub>1 S\<^sub>2 where S: "S = (\<forall>X<:S\<^sub>1. S\<^sub>2)"
-    by cases (auto simp add: T_Sub)
+    by cases (auto simp: T_Sub)
   then show ?case using T_Sub by auto 
 qed (auto)
 
 theorem progress:
   assumes "[] \<turnstile> t : T"
   shows "val t \<or> (\<exists>t'. t \<longmapsto> t')" 
 using assms
 proof (induct "[]::env" t T)
   case (T_App t\<^sub>1 T\<^sub>11  T\<^sub>12 t\<^sub>2)
   hence "val t\<^sub>1 \<or> (\<exists>t'. t\<^sub>1 \<longmapsto> t')" by simp
   thus ?case
   proof
     assume t\<^sub>1_val: "val t\<^sub>1"
     with T_App obtain x t3 S where t\<^sub>1: "t\<^sub>1 = (\<lambda>x:S. t3)"
       by (auto dest!: Fun_canonical)
     from T_App have "val t\<^sub>2 \<or> (\<exists>t'. t\<^sub>2 \<longmapsto> t')" by simp
     thus ?case
     proof
       assume "val t\<^sub>2"
       with t\<^sub>1 have "t\<^sub>1 \<cdot> t\<^sub>2 \<longmapsto> t3[x \<mapsto> t\<^sub>2]" by auto
       thus ?case by auto
     next
       assume "\<exists>t'. t\<^sub>2 \<longmapsto> t'"
       then obtain t' where "t\<^sub>2 \<longmapsto> t'" by auto
       with t\<^sub>1_val have "t\<^sub>1 \<cdot> t\<^sub>2 \<longmapsto> t\<^sub>1 \<cdot> t'" by auto
       thus ?case by auto
     qed
   next
     assume "\<exists>t'. t\<^sub>1 \<longmapsto> t'"
     then obtain t' where "t\<^sub>1 \<longmapsto> t'" by auto
     hence "t\<^sub>1 \<cdot> t\<^sub>2 \<longmapsto> t' \<cdot> t\<^sub>2" by auto
     thus ?case by auto
   qed
 next
   case (T_TApp X t\<^sub>1 T\<^sub>2 T\<^sub>11 T\<^sub>12)
   hence "val t\<^sub>1 \<or> (\<exists>t'. t\<^sub>1 \<longmapsto> t')" by simp
   thus ?case
   proof
     assume "val t\<^sub>1"
     with T_TApp obtain x t S where "t\<^sub>1 = (\<lambda>x<:S. t)"
       by (auto dest!: TyAll_canonical)
     hence "t\<^sub>1 \<cdot>\<^sub>\<tau> T\<^sub>2 \<longmapsto> t[x \<mapsto>\<^sub>\<tau> T\<^sub>2]" by auto
     thus ?case by auto
   next
     assume "\<exists>t'. t\<^sub>1 \<longmapsto> t'" thus ?case by auto
   qed
 qed (auto)
 
 end
diff --git a/src/HOL/Nominal/Examples/Pattern.thy b/src/HOL/Nominal/Examples/Pattern.thy
--- a/src/HOL/Nominal/Examples/Pattern.thy
+++ b/src/HOL/Nominal/Examples/Pattern.thy
@@ -1,850 +1,861 @@
 section \<open>Simply-typed lambda-calculus with let and tuple patterns\<close>
 
 theory Pattern
 imports "HOL-Nominal.Nominal"
 begin
 
 no_syntax
   "_Map" :: "maplets => 'a \<rightharpoonup> 'b"  ("(1[_])")
 
 atom_decl name
 
 nominal_datatype ty =
     Atom nat
   | Arrow ty ty  (infixr "\<rightarrow>" 200)
   | TupleT ty ty  (infixr "\<otimes>" 210)
 
 lemma fresh_type [simp]: "(a::name) \<sharp> (T::ty)"
   by (induct T rule: ty.induct) (simp_all add: fresh_nat)
 
 lemma supp_type [simp]: "supp (T::ty) = ({} :: name set)"
   by (induct T rule: ty.induct) (simp_all add: ty.supp supp_nat)
 
 lemma perm_type: "(pi::name prm) \<bullet> (T::ty) = T"
   by (induct T rule: ty.induct) (simp_all add: perm_nat_def)
 
 nominal_datatype trm =
     Var name
   | Tuple trm trm  ("(1'\<langle>_,/ _'\<rangle>)")
   | Abs ty "\<guillemotleft>name\<guillemotright>trm"
   | App trm trm  (infixl "\<cdot>" 200)
   | Let ty trm btrm
 and btrm =
     Base trm
   | Bind ty "\<guillemotleft>name\<guillemotright>btrm"
 
 abbreviation
   Abs_syn :: "name \<Rightarrow> ty \<Rightarrow> trm \<Rightarrow> trm"  ("(3\<lambda>_:_./ _)" [0, 0, 10] 10) 
 where
   "\<lambda>x:T. t \<equiv> Abs T x t"
 
 datatype pat =
     PVar name ty
   | PTuple pat pat  ("(1'\<langle>\<langle>_,/ _'\<rangle>\<rangle>)")
 
 (* FIXME: The following should be done automatically by the nominal package *)
 overloading pat_perm \<equiv> "perm :: name prm \<Rightarrow> pat \<Rightarrow> pat" (unchecked)
 begin
 
 primrec pat_perm
 where
   "pat_perm pi (PVar x ty) = PVar (pi \<bullet> x) (pi \<bullet> ty)"
 | "pat_perm pi \<langle>\<langle>p, q\<rangle>\<rangle> = \<langle>\<langle>pat_perm pi p, pat_perm pi q\<rangle>\<rangle>"
 
 end
 
 declare pat_perm.simps [eqvt]
 
 lemma supp_PVar [simp]: "((supp (PVar x T))::name set) = supp x"
   by (simp add: supp_def perm_fresh_fresh)
 
 lemma supp_PTuple [simp]: "((supp \<langle>\<langle>p, q\<rangle>\<rangle>)::name set) = supp p \<union> supp q"
   by (simp add: supp_def Collect_disj_eq del: disj_not1)
 
 instance pat :: pt_name
 proof
   fix x :: pat
   show "([]::(name \<times> _) list) \<bullet> x = x"
     by (induct x) simp_all
   fix pi1 pi2 :: "(name \<times> name) list"
   show "(pi1 @ pi2) \<bullet> x = pi1 \<bullet> pi2 \<bullet> x"
     by (induct x) (simp_all add: pt_name2)
   assume "pi1 \<triangleq> pi2"
   then show "pi1 \<bullet> x = pi2 \<bullet> x"
     by (induct x) (simp_all add: pt_name3)
 qed
 
 instance pat :: fs_name
 proof
   fix x :: pat
   show "finite (supp x::name set)"
     by (induct x) (simp_all add: fin_supp)
 qed
 
 (* the following function cannot be defined using nominal_primrec, *)
 (* since variable parameters are currently not allowed.            *)
 primrec abs_pat :: "pat \<Rightarrow> btrm \<Rightarrow> btrm" ("(3\<lambda>[_]./ _)" [0, 10] 10)
 where
   "(\<lambda>[PVar x T]. t) = Bind T x t"
 | "(\<lambda>[\<langle>\<langle>p, q\<rangle>\<rangle>]. t) = (\<lambda>[p]. \<lambda>[q]. t)"
 
 lemma abs_pat_eqvt [eqvt]:
   "(pi :: name prm) \<bullet> (\<lambda>[p]. t) = (\<lambda>[pi \<bullet> p]. (pi \<bullet> t))"
   by (induct p arbitrary: t) simp_all
 
 lemma abs_pat_fresh [simp]:
   "(x::name) \<sharp> (\<lambda>[p]. t) = (x \<in> supp p \<or> x \<sharp> t)"
   by (induct p arbitrary: t) (simp_all add: abs_fresh supp_atm)
 
 lemma abs_pat_alpha:
   assumes fresh: "((pi::name prm) \<bullet> supp p::name set) \<sharp>* t"
   and pi: "set pi \<subseteq> supp p \<times> pi \<bullet> supp p"
   shows "(\<lambda>[p]. t) = (\<lambda>[pi \<bullet> p]. pi \<bullet> t)"
 proof -
   note pt_name_inst at_name_inst pi
   moreover have "(supp p::name set) \<sharp>* (\<lambda>[p]. t)"
     by (simp add: fresh_star_def)
   moreover from fresh
   have "(pi \<bullet> supp p::name set) \<sharp>* (\<lambda>[p]. t)"
     by (simp add: fresh_star_def)
   ultimately have "pi \<bullet> (\<lambda>[p]. t) = (\<lambda>[p]. t)"
     by (rule pt_freshs_freshs)
   then show ?thesis by (simp add: eqvts)
 qed
 
 primrec pat_vars :: "pat \<Rightarrow> name list"
 where
   "pat_vars (PVar x T) = [x]"
 | "pat_vars \<langle>\<langle>p, q\<rangle>\<rangle> = pat_vars q @ pat_vars p"
 
 lemma pat_vars_eqvt [eqvt]:
   "(pi :: name prm) \<bullet> (pat_vars p) = pat_vars (pi \<bullet> p)"
   by (induct p rule: pat.induct) (simp_all add: eqvts)
 
 lemma set_pat_vars_supp: "set (pat_vars p) = supp p"
   by (induct p) (auto simp add: supp_atm)
 
 lemma distinct_eqvt [eqvt]:
   "(pi :: name prm) \<bullet> (distinct (xs::name list)) = distinct (pi \<bullet> xs)"
   by (induct xs) (simp_all add: eqvts)
 
 primrec pat_type :: "pat \<Rightarrow> ty"
 where
   "pat_type (PVar x T) = T"
 | "pat_type \<langle>\<langle>p, q\<rangle>\<rangle> = pat_type p \<otimes> pat_type q"
 
 lemma pat_type_eqvt [eqvt]:
   "(pi :: name prm) \<bullet> (pat_type p) = pat_type (pi \<bullet> p)"
   by (induct p) simp_all
 
 lemma pat_type_perm_eq: "pat_type ((pi :: name prm) \<bullet> p) = pat_type p"
   by (induct p) (simp_all add: perm_type)
 
 type_synonym ctx = "(name \<times> ty) list"
 
 inductive
   ptyping :: "pat \<Rightarrow> ty \<Rightarrow> ctx \<Rightarrow> bool"  ("\<turnstile> _ : _ \<Rightarrow> _" [60, 60, 60] 60)
 where
   PVar: "\<turnstile> PVar x T : T \<Rightarrow> [(x, T)]"
 | PTuple: "\<turnstile> p : T \<Rightarrow> \<Delta>\<^sub>1 \<Longrightarrow> \<turnstile> q : U \<Rightarrow> \<Delta>\<^sub>2 \<Longrightarrow> \<turnstile> \<langle>\<langle>p, q\<rangle>\<rangle> : T \<otimes> U \<Rightarrow> \<Delta>\<^sub>2 @ \<Delta>\<^sub>1"
 
 lemma pat_vars_ptyping:
   assumes "\<turnstile> p : T \<Rightarrow> \<Delta>"
   shows "pat_vars p = map fst \<Delta>" using assms
   by induct simp_all
 
 inductive
   valid :: "ctx \<Rightarrow> bool"
 where
   Nil [intro!]: "valid []"
 | Cons [intro!]: "valid \<Gamma> \<Longrightarrow> x \<sharp> \<Gamma> \<Longrightarrow> valid ((x, T) # \<Gamma>)"
 
 inductive_cases validE[elim!]: "valid ((x, T) # \<Gamma>)"
 
 lemma fresh_ctxt_set_eq: "((x::name) \<sharp> (\<Gamma>::ctx)) = (x \<notin> fst ` set \<Gamma>)"
   by (induct \<Gamma>) (auto simp add: fresh_list_nil fresh_list_cons fresh_prod fresh_atm)
 
 lemma valid_distinct: "valid \<Gamma> = distinct (map fst \<Gamma>)"
   by (induct \<Gamma>) (auto simp add: fresh_ctxt_set_eq [symmetric])
 
 abbreviation
   "sub_ctx" :: "ctx \<Rightarrow> ctx \<Rightarrow> bool" ("_ \<sqsubseteq> _") 
 where
   "\<Gamma>\<^sub>1 \<sqsubseteq> \<Gamma>\<^sub>2 \<equiv> \<forall>x. x \<in> set \<Gamma>\<^sub>1 \<longrightarrow> x \<in> set \<Gamma>\<^sub>2"
 
 abbreviation
   Let_syn :: "pat \<Rightarrow> trm \<Rightarrow> trm \<Rightarrow> trm"  ("(LET (_ =/ _)/ IN (_))" 10)
 where
   "LET p = t IN u \<equiv> Let (pat_type p) t (\<lambda>[p]. Base u)"
 
 inductive typing :: "ctx \<Rightarrow> trm \<Rightarrow> ty \<Rightarrow> bool" ("_ \<turnstile> _ : _" [60, 60, 60] 60)
 where
   Var [intro]: "valid \<Gamma> \<Longrightarrow> (x, T) \<in> set \<Gamma> \<Longrightarrow> \<Gamma> \<turnstile> Var x : T"
 | Tuple [intro]: "\<Gamma> \<turnstile> t : T \<Longrightarrow> \<Gamma> \<turnstile> u : U \<Longrightarrow> \<Gamma> \<turnstile> \<langle>t, u\<rangle> : T \<otimes> U"
 | Abs [intro]: "(x, T) # \<Gamma> \<turnstile> t : U \<Longrightarrow> \<Gamma> \<turnstile> (\<lambda>x:T. t) : T \<rightarrow> U"
 | App [intro]: "\<Gamma> \<turnstile> t : T \<rightarrow> U \<Longrightarrow> \<Gamma> \<turnstile> u : T \<Longrightarrow> \<Gamma> \<turnstile> t \<cdot> u : U"
 | Let: "((supp p)::name set) \<sharp>* t \<Longrightarrow>
     \<Gamma> \<turnstile> t : T \<Longrightarrow> \<turnstile> p : T \<Rightarrow> \<Delta> \<Longrightarrow> \<Delta> @ \<Gamma> \<turnstile> u : U \<Longrightarrow>
     \<Gamma> \<turnstile> (LET p = t IN u) : U"
 
 equivariance ptyping
 
 equivariance valid
 
 equivariance typing
 
 lemma valid_typing:
   assumes "\<Gamma> \<turnstile> t : T"
   shows "valid \<Gamma>" using assms
   by induct auto
 
 lemma pat_var:
   assumes "\<turnstile> p : T \<Rightarrow> \<Delta>"
   shows "(supp p::name set) = supp \<Delta>" using assms
   by induct (auto simp add: supp_list_nil supp_list_cons supp_prod supp_list_append)
 
 lemma valid_app_fresh:
   assumes "valid (\<Delta> @ \<Gamma>)" and "(x::name) \<in> supp \<Delta>"
   shows "x \<sharp> \<Gamma>" using assms
   by (induct \<Delta>)
     (auto simp add: supp_list_nil supp_list_cons supp_prod supp_atm fresh_list_append)
 
 lemma pat_freshs:
   assumes "\<turnstile> p : T \<Rightarrow> \<Delta>"
   shows "(supp p::name set) \<sharp>* c = (supp \<Delta>::name set) \<sharp>* c" using assms
   by (auto simp add: fresh_star_def pat_var)
 
 lemma valid_app_mono:
   assumes "valid (\<Delta> @ \<Gamma>\<^sub>1)" and "(supp \<Delta>::name set) \<sharp>* \<Gamma>\<^sub>2" and "valid \<Gamma>\<^sub>2" and "\<Gamma>\<^sub>1 \<sqsubseteq> \<Gamma>\<^sub>2"
   shows "valid (\<Delta> @ \<Gamma>\<^sub>2)" using assms
   by (induct \<Delta>)
     (auto simp add: supp_list_cons fresh_star_Un_elim supp_prod
        fresh_list_append supp_atm fresh_star_insert_elim fresh_star_empty_elim)
 
 nominal_inductive2 typing
 avoids
   Abs: "{x}"
 | Let: "(supp p)::name set"
   by (auto simp add: fresh_star_def abs_fresh fin_supp pat_var
     dest!: valid_typing valid_app_fresh)
 
 lemma better_T_Let [intro]:
   assumes t: "\<Gamma> \<turnstile> t : T" and p: "\<turnstile> p : T \<Rightarrow> \<Delta>" and u: "\<Delta> @ \<Gamma> \<turnstile> u : U"
   shows "\<Gamma> \<turnstile> (LET p = t IN u) : U"
 proof -
   obtain pi::"name prm" where pi: "(pi \<bullet> (supp p::name set)) \<sharp>* (t, Base u, \<Gamma>)"
     and pi': "set pi \<subseteq> supp p \<times> (pi \<bullet> supp p)"
     by (rule at_set_avoiding [OF at_name_inst fin_supp fin_supp])
   from p u have p_fresh: "(supp p::name set) \<sharp>* \<Gamma>"
     by (auto simp add: fresh_star_def pat_var dest!: valid_typing valid_app_fresh)
   from pi have p_fresh': "(pi \<bullet> (supp p::name set)) \<sharp>* \<Gamma>"
     by (simp add: fresh_star_prod_elim)
   from pi have p_fresh'': "(pi \<bullet> (supp p::name set)) \<sharp>* Base u"
     by (simp add: fresh_star_prod_elim)
   from pi have "(supp (pi \<bullet> p)::name set) \<sharp>* t"
     by (simp add: fresh_star_prod_elim eqvts)
   moreover note t
   moreover from p have "pi \<bullet> (\<turnstile> p : T \<Rightarrow> \<Delta>)" by (rule perm_boolI)
   then have "\<turnstile> (pi \<bullet> p) : T \<Rightarrow> (pi \<bullet> \<Delta>)" by (simp add: eqvts perm_type)
   moreover from u have "pi \<bullet> (\<Delta> @ \<Gamma> \<turnstile> u : U)" by (rule perm_boolI)
   with pt_freshs_freshs [OF pt_name_inst at_name_inst pi' p_fresh p_fresh']
   have "(pi \<bullet> \<Delta>) @ \<Gamma> \<turnstile> (pi \<bullet> u) : U" by (simp add: eqvts perm_type)
   ultimately have "\<Gamma> \<turnstile> (LET (pi \<bullet> p) = t IN (pi \<bullet> u)) : U"
     by (rule Let)
   then show ?thesis by (simp add: abs_pat_alpha [OF p_fresh'' pi'] pat_type_perm_eq)
 qed
 
 lemma weakening: 
   assumes "\<Gamma>\<^sub>1 \<turnstile> t : T" and "valid \<Gamma>\<^sub>2" and "\<Gamma>\<^sub>1 \<sqsubseteq> \<Gamma>\<^sub>2"
   shows "\<Gamma>\<^sub>2 \<turnstile> t : T" using assms
 proof (nominal_induct \<Gamma>\<^sub>1 t T avoiding: \<Gamma>\<^sub>2 rule: typing.strong_induct)
   case (Abs x T \<Gamma> t U)
   then show ?case
     by (simp add: typing.Abs valid.Cons)
 next
   case (Let p t \<Gamma> T \<Delta> u U)
   then show ?case
     by (smt (verit, ccfv_threshold) Un_iff pat_freshs set_append typing.simps valid_app_mono valid_typing) 
 qed auto
 
 inductive
   match :: "pat \<Rightarrow> trm \<Rightarrow> (name \<times> trm) list \<Rightarrow> bool"  ("\<turnstile> _ \<rhd> _ \<Rightarrow> _" [50, 50, 50] 50)
 where
   PVar: "\<turnstile> PVar x T \<rhd> t \<Rightarrow> [(x, t)]"
 | PProd: "\<turnstile> p \<rhd> t \<Rightarrow> \<theta> \<Longrightarrow> \<turnstile> q \<rhd> u \<Rightarrow> \<theta>' \<Longrightarrow> \<turnstile> \<langle>\<langle>p, q\<rangle>\<rangle> \<rhd> \<langle>t, u\<rangle> \<Rightarrow> \<theta> @ \<theta>'"
 
 fun
   lookup :: "(name \<times> trm) list \<Rightarrow> name \<Rightarrow> trm"   
 where
   "lookup [] x = Var x"
 | "lookup ((y, e) # \<theta>) x = (if x = y then e else lookup \<theta> x)"
 
 lemma lookup_eqvt[eqvt]:
   fixes pi :: "name prm"
   and   \<theta> :: "(name \<times> trm) list"
   and   X :: "name"
   shows "pi \<bullet> (lookup \<theta> X) = lookup (pi \<bullet> \<theta>) (pi \<bullet> X)"
   by (induct \<theta>) (auto simp add: eqvts)
  
 nominal_primrec
   psubst :: "(name \<times> trm) list \<Rightarrow> trm \<Rightarrow> trm"  ("_\<lparr>_\<rparr>" [95,0] 210)
   and psubstb :: "(name \<times> trm) list \<Rightarrow> btrm \<Rightarrow> btrm"  ("_\<lparr>_\<rparr>\<^sub>b" [95,0] 210)
 where
   "\<theta>\<lparr>Var x\<rparr> = (lookup \<theta> x)"
 | "\<theta>\<lparr>t \<cdot> u\<rparr> = \<theta>\<lparr>t\<rparr> \<cdot> \<theta>\<lparr>u\<rparr>"
 | "\<theta>\<lparr>\<langle>t, u\<rangle>\<rparr> = \<langle>\<theta>\<lparr>t\<rparr>, \<theta>\<lparr>u\<rparr>\<rangle>"
 | "\<theta>\<lparr>Let T t u\<rparr> = Let T (\<theta>\<lparr>t\<rparr>) (\<theta>\<lparr>u\<rparr>\<^sub>b)"
 | "x \<sharp> \<theta> \<Longrightarrow> \<theta>\<lparr>\<lambda>x:T. t\<rparr> = (\<lambda>x:T. \<theta>\<lparr>t\<rparr>)"
 | "\<theta>\<lparr>Base t\<rparr>\<^sub>b = Base (\<theta>\<lparr>t\<rparr>)"
 | "x \<sharp> \<theta> \<Longrightarrow> \<theta>\<lparr>Bind T x t\<rparr>\<^sub>b = Bind T x (\<theta>\<lparr>t\<rparr>\<^sub>b)"
   by (finite_guess | simp add: abs_fresh | fresh_guess)+
 
 lemma lookup_fresh:
   "x = y \<longrightarrow> x \<in> set (map fst \<theta>) \<Longrightarrow> \<forall>(y, t)\<in>set \<theta>. x \<sharp> t \<Longrightarrow> x \<sharp> lookup \<theta> y"
   by (induct \<theta>) (use fresh_atm in force)+
 
 lemma psubst_fresh:
   assumes "x \<in> set (map fst \<theta>)" and "\<forall>(y, t)\<in>set \<theta>. x \<sharp> t"
   shows "x \<sharp> \<theta>\<lparr>t\<rparr>" and "x \<sharp> \<theta>\<lparr>t'\<rparr>\<^sub>b" using assms
 proof (nominal_induct t and t' avoiding: \<theta> rule: trm_btrm.strong_inducts)
   case (Var name)
   then show ?case
     by (metis lookup_fresh simps(1))
 qed (auto simp: abs_fresh)
 
 lemma psubst_eqvt[eqvt]:
   fixes pi :: "name prm" 
   shows "pi \<bullet> (\<theta>\<lparr>t\<rparr>) = (pi \<bullet> \<theta>)\<lparr>pi \<bullet> t\<rparr>"
   and "pi \<bullet> (\<theta>\<lparr>t'\<rparr>\<^sub>b) = (pi \<bullet> \<theta>)\<lparr>pi \<bullet> t'\<rparr>\<^sub>b"
   by (nominal_induct t and t' avoiding: \<theta> rule: trm_btrm.strong_inducts)
     (simp_all add: eqvts fresh_bij)
 
 abbreviation 
   subst :: "trm \<Rightarrow> name \<Rightarrow> trm \<Rightarrow> trm" ("_[_\<mapsto>_]" [100,0,0] 100)
 where 
   "t[x\<mapsto>t'] \<equiv> [(x,t')]\<lparr>t\<rparr>"
 
 abbreviation 
   substb :: "btrm \<Rightarrow> name \<Rightarrow> trm \<Rightarrow> btrm" ("_[_\<mapsto>_]\<^sub>b" [100,0,0] 100)
 where 
   "t[x\<mapsto>t']\<^sub>b \<equiv> [(x,t')]\<lparr>t\<rparr>\<^sub>b"
 
 lemma lookup_forget:
   "(supp (map fst \<theta>)::name set) \<sharp>* x \<Longrightarrow> lookup \<theta> x = Var x"
   by (induct \<theta>) (auto simp add: split_paired_all fresh_star_def fresh_atm supp_list_cons supp_atm)
 
 lemma supp_fst: "(x::name) \<in> supp (map fst (\<theta>::(name \<times> trm) list)) \<Longrightarrow> x \<in> supp \<theta>"
   by (induct \<theta>) (auto simp add: supp_list_nil supp_list_cons supp_prod)
 
 lemma psubst_forget:
   "(supp (map fst \<theta>)::name set) \<sharp>* t \<Longrightarrow> \<theta>\<lparr>t\<rparr> = t"
   "(supp (map fst \<theta>)::name set) \<sharp>* t' \<Longrightarrow> \<theta>\<lparr>t'\<rparr>\<^sub>b = t'"
 proof (nominal_induct t and t' avoiding: \<theta> rule: trm_btrm.strong_inducts)
   case (Var name)
   then show ?case
     by (simp add: fresh_star_set lookup_forget)
 next
   case (Abs ty name trm)
   then show ?case
     apply (simp add: fresh_def)
     by (metis abs_fresh(1) fresh_star_set supp_fst trm.fresh(3))
 next
   case (Bind ty name btrm)
   then show ?case
     apply (simp add: fresh_def)
     by (metis abs_fresh(1) btrm.fresh(2) fresh_star_set supp_fst)
 qed (auto simp: fresh_star_set)
 
-lemma psubst_nil: "[]\<lparr>t\<rparr> = t" "[]\<lparr>t'\<rparr>\<^sub>b = t'"
+lemma psubst_nil[simp]: "[]\<lparr>t\<rparr> = t" "[]\<lparr>t'\<rparr>\<^sub>b = t'"
   by (induct t and t' rule: trm_btrm.inducts) (simp_all add: fresh_list_nil)
 
 lemma psubst_cons:
   assumes "(supp (map fst \<theta>)::name set) \<sharp>* u"
   shows "((x, u) # \<theta>)\<lparr>t\<rparr> = \<theta>\<lparr>t[x\<mapsto>u]\<rparr>" and "((x, u) # \<theta>)\<lparr>t'\<rparr>\<^sub>b = \<theta>\<lparr>t'[x\<mapsto>u]\<^sub>b\<rparr>\<^sub>b"
   using assms
   by (nominal_induct t and t' avoiding: x u \<theta> rule: trm_btrm.strong_inducts)
     (simp_all add: fresh_list_nil fresh_list_cons psubst_forget)
 
 lemma psubst_append:
   "(supp (map fst (\<theta>\<^sub>1 @ \<theta>\<^sub>2))::name set) \<sharp>* map snd (\<theta>\<^sub>1 @ \<theta>\<^sub>2) \<Longrightarrow> (\<theta>\<^sub>1 @ \<theta>\<^sub>2)\<lparr>t\<rparr> = \<theta>\<^sub>2\<lparr>\<theta>\<^sub>1\<lparr>t\<rparr>\<rparr>"
-  by (induct \<theta>\<^sub>1 arbitrary: t)
-    (simp_all add: psubst_nil split_paired_all supp_list_cons psubst_cons fresh_star_def
-      fresh_list_cons fresh_list_append supp_list_append)
+proof (induct \<theta>\<^sub>1 arbitrary: t)
+  case Nil
+  then show ?case
+    by (auto simp: psubst_nil)
+next
+  case (Cons a \<theta>\<^sub>1)
+  then show ?case
+  proof (cases a)
+    case (Pair a b)
+    with Cons show ?thesis
+      apply (simp add: supp_list_cons fresh_star_set fresh_list_cons)
+      by (metis Un_iff fresh_star_set map_append psubst_cons(1) supp_list_append)
+  qed
+qed
 
 lemma abs_pat_psubst [simp]:
   "(supp p::name set) \<sharp>* \<theta> \<Longrightarrow> \<theta>\<lparr>\<lambda>[p]. t\<rparr>\<^sub>b = (\<lambda>[p]. \<theta>\<lparr>t\<rparr>\<^sub>b)"
   by (induct p arbitrary: t) (auto simp add: fresh_star_def supp_atm)
 
 lemma valid_insert:
   assumes "valid (\<Delta> @ [(x, T)] @ \<Gamma>)"
   shows "valid (\<Delta> @ \<Gamma>)" using assms
   by (induct \<Delta>)
     (auto simp add: fresh_list_append fresh_list_cons)
 
 lemma fresh_set: 
   shows "y \<sharp> xs = (\<forall>x\<in>set xs. y \<sharp> x)"
   by (induct xs) (simp_all add: fresh_list_nil fresh_list_cons)
 
 lemma context_unique:
   assumes "valid \<Gamma>"
   and "(x, T) \<in> set \<Gamma>"
   and "(x, U) \<in> set \<Gamma>"
   shows "T = U" using assms
   by induct (auto simp add: fresh_set fresh_prod fresh_atm)
 
 lemma subst_type_aux:
   assumes a: "\<Delta> @ [(x, U)] @ \<Gamma> \<turnstile> t : T"
   and b: "\<Gamma> \<turnstile> u : U"
   shows "\<Delta> @ \<Gamma> \<turnstile> t[x\<mapsto>u] : T" using a b
 proof (nominal_induct \<Gamma>'\<equiv>"\<Delta> @ [(x, U)] @ \<Gamma>" t T avoiding: x u \<Delta> rule: typing.strong_induct)
   case (Var y T x u \<Delta>)
   from \<open>valid (\<Delta> @ [(x, U)] @ \<Gamma>)\<close>
   have valid: "valid (\<Delta> @ \<Gamma>)" by (rule valid_insert)
   show "\<Delta> @ \<Gamma> \<turnstile> Var y[x\<mapsto>u] : T"
   proof cases
     assume eq: "x = y"
     from Var eq have "T = U" by (auto intro: context_unique)
     with Var eq valid show "\<Delta> @ \<Gamma> \<turnstile> Var y[x\<mapsto>u] : T" by (auto intro: weakening)
   next
     assume ineq: "x \<noteq> y"
     from Var ineq have "(y, T) \<in> set (\<Delta> @ \<Gamma>)" by simp
     then show "\<Delta> @ \<Gamma> \<turnstile> Var y[x\<mapsto>u] : T" using ineq valid by auto
   qed
 next
   case (Tuple t\<^sub>1 T\<^sub>1 t\<^sub>2 T\<^sub>2)
   from refl \<open>\<Gamma> \<turnstile> u : U\<close>
   have "\<Delta> @ \<Gamma> \<turnstile> t\<^sub>1[x\<mapsto>u] : T\<^sub>1" by (rule Tuple)
   moreover from refl \<open>\<Gamma> \<turnstile> u : U\<close>
   have "\<Delta> @ \<Gamma> \<turnstile> t\<^sub>2[x\<mapsto>u] : T\<^sub>2" by (rule Tuple)
   ultimately have "\<Delta> @ \<Gamma> \<turnstile> \<langle>t\<^sub>1[x\<mapsto>u], t\<^sub>2[x\<mapsto>u]\<rangle> : T\<^sub>1 \<otimes> T\<^sub>2" ..
   then show ?case by simp
 next
   case (Let p t T \<Delta>' s S)
   from refl \<open>\<Gamma> \<turnstile> u : U\<close>
   have "\<Delta> @ \<Gamma> \<turnstile> t[x\<mapsto>u] : T" by (rule Let)
   moreover note \<open>\<turnstile> p : T \<Rightarrow> \<Delta>'\<close>
   moreover have "\<Delta>' @ (\<Delta> @ [(x, U)] @ \<Gamma>) = (\<Delta>' @ \<Delta>) @ [(x, U)] @ \<Gamma>" by simp
   then have "(\<Delta>' @ \<Delta>) @ \<Gamma> \<turnstile> s[x\<mapsto>u] : S" using \<open>\<Gamma> \<turnstile> u : U\<close> by (rule Let)
   then have "\<Delta>' @ \<Delta> @ \<Gamma> \<turnstile> s[x\<mapsto>u] : S" by simp
   ultimately have "\<Delta> @ \<Gamma> \<turnstile> (LET p = t[x\<mapsto>u] IN s[x\<mapsto>u]) : S"
     by (rule better_T_Let)
   moreover from Let have "(supp p::name set) \<sharp>* [(x, u)]"
     by (simp add: fresh_star_def fresh_list_nil fresh_list_cons)
   ultimately show ?case by simp
 next
   case (Abs y T t S)
   have "(y, T) # \<Delta> @ [(x, U)] @ \<Gamma> = ((y, T) # \<Delta>) @ [(x, U)] @ \<Gamma>"
     by simp
   then have "((y, T) # \<Delta>) @ \<Gamma> \<turnstile> t[x\<mapsto>u] : S" using \<open>\<Gamma> \<turnstile> u : U\<close> by (rule Abs)
   then have "(y, T) # \<Delta> @ \<Gamma> \<turnstile> t[x\<mapsto>u] : S" by simp
   then have "\<Delta> @ \<Gamma> \<turnstile> (\<lambda>y:T. t[x\<mapsto>u]) : T \<rightarrow> S"
     by (rule typing.Abs)
   moreover from Abs have "y \<sharp> [(x, u)]"
     by (simp add: fresh_list_nil fresh_list_cons)
   ultimately show ?case by simp
 next
   case (App t\<^sub>1 T S t\<^sub>2)
   from refl \<open>\<Gamma> \<turnstile> u : U\<close>
   have "\<Delta> @ \<Gamma> \<turnstile> t\<^sub>1[x\<mapsto>u] : T \<rightarrow> S" by (rule App)
   moreover from refl \<open>\<Gamma> \<turnstile> u : U\<close>
   have "\<Delta> @ \<Gamma> \<turnstile> t\<^sub>2[x\<mapsto>u] : T" by (rule App)
   ultimately have "\<Delta> @ \<Gamma> \<turnstile> (t\<^sub>1[x\<mapsto>u]) \<cdot> (t\<^sub>2[x\<mapsto>u]) : S"
     by (rule typing.App)
   then show ?case by simp
 qed
 
 lemmas subst_type = subst_type_aux [of "[]", simplified]
 
 lemma match_supp_fst:
   assumes "\<turnstile> p \<rhd> u \<Rightarrow> \<theta>" shows "(supp (map fst \<theta>)::name set) = supp p" using assms
   by induct (simp_all add: supp_list_nil supp_list_cons supp_list_append)
 
 lemma match_supp_snd:
   assumes "\<turnstile> p \<rhd> u \<Rightarrow> \<theta>" shows "(supp (map snd \<theta>)::name set) = supp u" using assms
   by induct (simp_all add: supp_list_nil supp_list_cons supp_list_append trm.supp)
 
 lemma match_fresh: "\<turnstile> p \<rhd> u \<Rightarrow> \<theta> \<Longrightarrow> (supp p::name set) \<sharp>* u \<Longrightarrow>
   (supp (map fst \<theta>)::name set) \<sharp>* map snd \<theta>"
   by (simp add: fresh_star_def fresh_def match_supp_fst match_supp_snd)
 
 lemma match_type_aux:
   assumes "\<turnstile> p : U \<Rightarrow> \<Delta>"
   and "\<Gamma>\<^sub>2 \<turnstile> u : U"
   and "\<Gamma>\<^sub>1 @ \<Delta> @ \<Gamma>\<^sub>2 \<turnstile> t : T"
   and "\<turnstile> p \<rhd> u \<Rightarrow> \<theta>"
   and "(supp p::name set) \<sharp>* u"
   shows "\<Gamma>\<^sub>1 @ \<Gamma>\<^sub>2 \<turnstile> \<theta>\<lparr>t\<rparr> : T" using assms
 proof (induct arbitrary: \<Gamma>\<^sub>1 \<Gamma>\<^sub>2 t u T \<theta>)
   case (PVar x U)
   from \<open>\<Gamma>\<^sub>1 @ [(x, U)] @ \<Gamma>\<^sub>2 \<turnstile> t : T\<close> \<open>\<Gamma>\<^sub>2 \<turnstile> u : U\<close>
   have "\<Gamma>\<^sub>1 @ \<Gamma>\<^sub>2 \<turnstile> t[x\<mapsto>u] : T" by (rule subst_type_aux)
   moreover from \<open>\<turnstile> PVar x U \<rhd> u \<Rightarrow> \<theta>\<close> have "\<theta> = [(x, u)]"
     by cases simp_all
   ultimately show ?case by simp
 next
   case (PTuple p S \<Delta>\<^sub>1 q U \<Delta>\<^sub>2)
   from \<open>\<turnstile> \<langle>\<langle>p, q\<rangle>\<rangle> \<rhd> u \<Rightarrow> \<theta>\<close> obtain u\<^sub>1 u\<^sub>2 \<theta>\<^sub>1 \<theta>\<^sub>2
     where u: "u = \<langle>u\<^sub>1, u\<^sub>2\<rangle>" and \<theta>: "\<theta> = \<theta>\<^sub>1 @ \<theta>\<^sub>2"
     and p: "\<turnstile> p \<rhd> u\<^sub>1 \<Rightarrow> \<theta>\<^sub>1" and q: "\<turnstile> q \<rhd> u\<^sub>2 \<Rightarrow> \<theta>\<^sub>2"
     by cases simp_all
   with PTuple have "\<Gamma>\<^sub>2 \<turnstile> \<langle>u\<^sub>1, u\<^sub>2\<rangle> : S \<otimes> U" by simp
   then obtain u\<^sub>1: "\<Gamma>\<^sub>2 \<turnstile> u\<^sub>1 : S" and u\<^sub>2: "\<Gamma>\<^sub>2 \<turnstile> u\<^sub>2 : U"
     by cases (simp_all add: ty.inject trm.inject)
   note u\<^sub>1
   moreover from \<open>\<Gamma>\<^sub>1 @ (\<Delta>\<^sub>2 @ \<Delta>\<^sub>1) @ \<Gamma>\<^sub>2 \<turnstile> t : T\<close>
   have "(\<Gamma>\<^sub>1 @ \<Delta>\<^sub>2) @ \<Delta>\<^sub>1 @ \<Gamma>\<^sub>2 \<turnstile> t : T" by simp
   moreover note p
   moreover from \<open>supp \<langle>\<langle>p, q\<rangle>\<rangle> \<sharp>* u\<close> and u
   have "(supp p::name set) \<sharp>* u\<^sub>1" by (simp add: fresh_star_def)
   ultimately have \<theta>\<^sub>1: "(\<Gamma>\<^sub>1 @ \<Delta>\<^sub>2) @ \<Gamma>\<^sub>2 \<turnstile> \<theta>\<^sub>1\<lparr>t\<rparr> : T"
     by (rule PTuple)
   note u\<^sub>2
   moreover from \<theta>\<^sub>1
   have "\<Gamma>\<^sub>1 @ \<Delta>\<^sub>2 @ \<Gamma>\<^sub>2 \<turnstile> \<theta>\<^sub>1\<lparr>t\<rparr> : T" by simp
   moreover note q
   moreover from \<open>supp \<langle>\<langle>p, q\<rangle>\<rangle> \<sharp>* u\<close> and u
   have "(supp q::name set) \<sharp>* u\<^sub>2" by (simp add: fresh_star_def)
   ultimately have "\<Gamma>\<^sub>1 @ \<Gamma>\<^sub>2 \<turnstile> \<theta>\<^sub>2\<lparr>\<theta>\<^sub>1\<lparr>t\<rparr>\<rparr> : T"
     by (rule PTuple)
   moreover from \<open>\<turnstile> \<langle>\<langle>p, q\<rangle>\<rangle> \<rhd> u \<Rightarrow> \<theta>\<close> \<open>supp \<langle>\<langle>p, q\<rangle>\<rangle> \<sharp>* u\<close>
   have "(supp (map fst \<theta>)::name set) \<sharp>* map snd \<theta>"
     by (rule match_fresh)
   ultimately show ?case using \<theta> by (simp add: psubst_append)
 qed
 
 lemmas match_type = match_type_aux [where \<Gamma>\<^sub>1="[]", simplified]
 
 inductive eval :: "trm \<Rightarrow> trm \<Rightarrow> bool" ("_ \<longmapsto> _" [60,60] 60)
 where
   TupleL: "t \<longmapsto> t' \<Longrightarrow> \<langle>t, u\<rangle> \<longmapsto> \<langle>t', u\<rangle>"
 | TupleR: "u \<longmapsto> u' \<Longrightarrow> \<langle>t, u\<rangle> \<longmapsto> \<langle>t, u'\<rangle>"
 | Abs: "t \<longmapsto> t' \<Longrightarrow> (\<lambda>x:T. t) \<longmapsto> (\<lambda>x:T. t')"
 | AppL: "t \<longmapsto> t' \<Longrightarrow> t \<cdot> u \<longmapsto> t' \<cdot> u"
 | AppR: "u \<longmapsto> u' \<Longrightarrow> t \<cdot> u \<longmapsto> t \<cdot> u'"
 | Beta: "x \<sharp> u \<Longrightarrow> (\<lambda>x:T. t) \<cdot> u \<longmapsto> t[x\<mapsto>u]"
 | Let: "((supp p)::name set) \<sharp>* t \<Longrightarrow> distinct (pat_vars p) \<Longrightarrow>
     \<turnstile> p \<rhd> t \<Rightarrow> \<theta> \<Longrightarrow> (LET p = t IN u) \<longmapsto> \<theta>\<lparr>u\<rparr>"
 
 equivariance match
 
 equivariance eval
 
 lemma match_vars:
   assumes "\<turnstile> p \<rhd> t \<Rightarrow> \<theta>" and "x \<in> supp p"
   shows "x \<in> set (map fst \<theta>)" using assms
   by induct (auto simp add: supp_atm)
 
 lemma match_fresh_mono:
   assumes "\<turnstile> p \<rhd> t \<Rightarrow> \<theta>" and "(x::name) \<sharp> t"
   shows "\<forall>(y, t)\<in>set \<theta>. x \<sharp> t" using assms
   by induct auto
 
 nominal_inductive2 eval
 avoids
   Abs: "{x}"
 | Beta: "{x}"
 | Let: "(supp p)::name set"
 proof (simp_all add: fresh_star_def abs_fresh fin_supp)
   show "x \<sharp> t[x\<mapsto>u]" if "x \<sharp> u" for x t u
     by (simp add: \<open>x \<sharp> u\<close> psubst_fresh(1))
 next
   show "\<forall>x\<in>supp p. (x::name) \<sharp> \<theta>\<lparr>u\<rparr>" 
     if "\<forall>x\<in>supp p. (x::name) \<sharp> t" and "\<turnstile> p \<rhd> t \<Rightarrow> \<theta>"
     for p t \<theta> u
     by (meson that match_fresh_mono match_vars psubst_fresh(1))
 qed
 
 lemma typing_case_Abs:
   assumes ty: "\<Gamma> \<turnstile> (\<lambda>x:T. t) : S"
   and fresh: "x \<sharp> \<Gamma>"
   and R: "\<And>U. S = T \<rightarrow> U \<Longrightarrow> (x, T) # \<Gamma> \<turnstile> t : U \<Longrightarrow> P"
   shows P using ty
 proof cases
   case (Abs x' T' t' U)
   obtain y::name where y: "y \<sharp> (x, \<Gamma>, \<lambda>x':T'. t')"
     by (rule exists_fresh) (auto intro: fin_supp)
   from \<open>(\<lambda>x:T. t) = (\<lambda>x':T'. t')\<close> [symmetric]
   have x: "x \<sharp> (\<lambda>x':T'. t')" by (simp add: abs_fresh)
   have x': "x' \<sharp> (\<lambda>x':T'. t')" by (simp add: abs_fresh)
   from \<open>(x', T') # \<Gamma> \<turnstile> t' : U\<close> have x'': "x' \<sharp> \<Gamma>"
     by (auto dest: valid_typing)
   have "(\<lambda>x:T. t) = (\<lambda>x':T'. t')" by fact
   also from x x' y have "\<dots> = [(x, y)] \<bullet> [(x', y)] \<bullet> (\<lambda>x':T'. t')"
     by (simp only: perm_fresh_fresh fresh_prod)
   also have "\<dots> = (\<lambda>x:T'. [(x, y)] \<bullet> [(x', y)] \<bullet> t')"
     by (simp add: swap_simps perm_fresh_fresh)
   finally have "(\<lambda>x:T. t) = (\<lambda>x:T'. [(x, y)] \<bullet> [(x', y)] \<bullet> t')" .
   then have T: "T = T'" and t: "[(x, y)] \<bullet> [(x', y)] \<bullet> t' = t"
     by (simp_all add: trm.inject alpha)
   from Abs T have "S = T \<rightarrow> U" by simp
   moreover from \<open>(x', T') # \<Gamma> \<turnstile> t' : U\<close>
   have "[(x, y)] \<bullet> [(x', y)] \<bullet> ((x', T') # \<Gamma> \<turnstile> t' : U)"
     by (simp add: perm_bool)
   with T t y x'' fresh have "(x, T) # \<Gamma> \<turnstile> t : U"
     by (simp add: eqvts swap_simps perm_fresh_fresh fresh_prod)
   ultimately show ?thesis by (rule R)
 qed simp_all
 
 nominal_primrec ty_size :: "ty \<Rightarrow> nat"
 where
   "ty_size (Atom n) = 0"
 | "ty_size (T \<rightarrow> U) = ty_size T + ty_size U + 1"
 | "ty_size (T \<otimes> U) = ty_size T + ty_size U + 1"
   by (rule TrueI)+
 
 lemma bind_tuple_ineq:
   "ty_size (pat_type p) < ty_size U \<Longrightarrow> Bind U x t \<noteq> (\<lambda>[p]. u)"
   by (induct p arbitrary: U x t u) (auto simp add: btrm.inject)
 
 lemma valid_appD: assumes "valid (\<Gamma> @ \<Delta>)"
   shows "valid \<Gamma>" "valid \<Delta>" using assms
   by (induct \<Gamma>'\<equiv>"\<Gamma> @ \<Delta>" arbitrary: \<Gamma> \<Delta>)
     (auto simp add: Cons_eq_append_conv fresh_list_append)
 
 lemma valid_app_freshs: assumes "valid (\<Gamma> @ \<Delta>)"
   shows "(supp \<Gamma>::name set) \<sharp>* \<Delta>" "(supp \<Delta>::name set) \<sharp>* \<Gamma>" using assms
   by (induct \<Gamma>'\<equiv>"\<Gamma> @ \<Delta>" arbitrary: \<Gamma> \<Delta>)
     (auto simp add: Cons_eq_append_conv fresh_star_def
      fresh_list_nil fresh_list_cons supp_list_nil supp_list_cons fresh_list_append
      supp_prod fresh_prod supp_atm fresh_atm
      dest: notE [OF iffD1 [OF fresh_def]])
 
 lemma perm_mem_left: "(x::name) \<in> ((pi::name prm) \<bullet> A) \<Longrightarrow> (rev pi \<bullet> x) \<in> A"
   by (drule perm_boolI [of _ "rev pi"]) (simp add: eqvts perm_pi_simp)
 
 lemma perm_mem_right: "(rev (pi::name prm) \<bullet> (x::name)) \<in> A \<Longrightarrow> x \<in> (pi \<bullet> A)"
   by (drule perm_boolI [of _ pi]) (simp add: eqvts perm_pi_simp)
 
 lemma perm_cases:
   assumes pi: "set pi \<subseteq> A \<times> A"
   shows "((pi::name prm) \<bullet> B) \<subseteq> A \<union> B"
 proof
   fix x assume "x \<in> pi \<bullet> B"
   then show "x \<in> A \<union> B" using pi
   proof (induct pi arbitrary: x B rule: rev_induct)
     case Nil
     then show ?case
       by simp
   next
     case (snoc y xs)
     then show ?case
       apply simp
       by (metis SigmaE perm_mem_left perm_pi_simp(2) pt_name2 swap_simps(3))
   qed
 qed
 
 lemma abs_pat_alpha':
   assumes eq: "(\<lambda>[p]. t) = (\<lambda>[q]. u)"
   and ty: "pat_type p = pat_type q"
   and pv: "distinct (pat_vars p)"
   and qv: "distinct (pat_vars q)"
   shows "\<exists>pi::name prm. p = pi \<bullet> q \<and> t = pi \<bullet> u \<and>
     set pi \<subseteq> (supp p \<union> supp q) \<times> (supp p \<union> supp q)"
   using assms
 proof (induct p arbitrary: q t u)
   case (PVar x T)
   note PVar' = this
   show ?case
   proof (cases q)
     case (PVar x' T')
     with \<open>(\<lambda>[PVar x T]. t) = (\<lambda>[q]. u)\<close>
     have "x = x' \<and> t = u \<or> x \<noteq> x' \<and> t = [(x, x')] \<bullet> u \<and> x \<sharp> u"
       by (simp add: btrm.inject alpha)
     then show ?thesis
     proof
       assume "x = x' \<and> t = u"
       with PVar PVar' have "PVar x T = ([]::name prm) \<bullet> q \<and>
         t = ([]::name prm) \<bullet> u \<and>
         set ([]::name prm) \<subseteq> (supp (PVar x T) \<union> supp q) \<times>
           (supp (PVar x T) \<union> supp q)" by simp
       then show ?thesis ..
     next
       assume "x \<noteq> x' \<and> t = [(x, x')] \<bullet> u \<and> x \<sharp> u"
       with PVar PVar' have "PVar x T = [(x, x')] \<bullet> q \<and>
         t = [(x, x')] \<bullet> u \<and>
         set [(x, x')] \<subseteq> (supp (PVar x T) \<union> supp q) \<times>
           (supp (PVar x T) \<union> supp q)"
         by (simp add: perm_swap swap_simps supp_atm perm_type)
       then show ?thesis ..
     qed
   next
     case (PTuple p\<^sub>1 p\<^sub>2)
     with PVar have "ty_size (pat_type p\<^sub>1) < ty_size T" by simp
     then have "Bind T x t \<noteq> (\<lambda>[p\<^sub>1]. \<lambda>[p\<^sub>2]. u)"
       by (rule bind_tuple_ineq)
     moreover from PTuple PVar
     have "Bind T x t = (\<lambda>[p\<^sub>1]. \<lambda>[p\<^sub>2]. u)" by simp
     ultimately show ?thesis ..
   qed
 next
   case (PTuple p\<^sub>1 p\<^sub>2)
   note PTuple' = this
   show ?case
   proof (cases q)
     case (PVar x T)
     with PTuple have "ty_size (pat_type p\<^sub>1) < ty_size T" by auto
     then have "Bind T x u \<noteq> (\<lambda>[p\<^sub>1]. \<lambda>[p\<^sub>2]. t)"
       by (rule bind_tuple_ineq)
     moreover from PTuple PVar
     have "Bind T x u = (\<lambda>[p\<^sub>1]. \<lambda>[p\<^sub>2]. t)" by simp
     ultimately show ?thesis ..
   next
     case (PTuple p\<^sub>1' p\<^sub>2')
     with PTuple' have "(\<lambda>[p\<^sub>1]. \<lambda>[p\<^sub>2]. t) = (\<lambda>[p\<^sub>1']. \<lambda>[p\<^sub>2']. u)" by simp
     moreover from PTuple PTuple' have "pat_type p\<^sub>1 = pat_type p\<^sub>1'"
       by (simp add: ty.inject)
     moreover from PTuple' have "distinct (pat_vars p\<^sub>1)" by simp
     moreover from PTuple PTuple' have "distinct (pat_vars p\<^sub>1')" by simp
     ultimately have "\<exists>pi::name prm. p\<^sub>1 = pi \<bullet> p\<^sub>1' \<and>
       (\<lambda>[p\<^sub>2]. t) = pi \<bullet> (\<lambda>[p\<^sub>2']. u) \<and>
       set pi \<subseteq> (supp p\<^sub>1 \<union> supp p\<^sub>1') \<times> (supp p\<^sub>1 \<union> supp p\<^sub>1')"
       by (rule PTuple')
     then obtain pi::"name prm" where
       "p\<^sub>1 = pi \<bullet> p\<^sub>1'" "(\<lambda>[p\<^sub>2]. t) = pi \<bullet> (\<lambda>[p\<^sub>2']. u)" and
       pi: "set pi \<subseteq> (supp p\<^sub>1 \<union> supp p\<^sub>1') \<times> (supp p\<^sub>1 \<union> supp p\<^sub>1')" by auto
     from \<open>(\<lambda>[p\<^sub>2]. t) = pi \<bullet> (\<lambda>[p\<^sub>2']. u)\<close>
     have "(\<lambda>[p\<^sub>2]. t) = (\<lambda>[pi \<bullet> p\<^sub>2']. pi \<bullet> u)"
       by (simp add: eqvts)
     moreover from PTuple PTuple' have "pat_type p\<^sub>2 = pat_type (pi \<bullet> p\<^sub>2')"
       by (simp add: ty.inject pat_type_perm_eq)
     moreover from PTuple' have "distinct (pat_vars p\<^sub>2)" by simp
     moreover from PTuple PTuple' have "distinct (pat_vars (pi \<bullet> p\<^sub>2'))"
       by (simp add: pat_vars_eqvt [symmetric] distinct_eqvt [symmetric])
     ultimately have "\<exists>pi'::name prm. p\<^sub>2 = pi' \<bullet> pi \<bullet> p\<^sub>2' \<and>
       t = pi' \<bullet> pi \<bullet> u \<and>
       set pi' \<subseteq> (supp p\<^sub>2 \<union> supp (pi \<bullet> p\<^sub>2')) \<times> (supp p\<^sub>2 \<union> supp (pi \<bullet> p\<^sub>2'))"
       by (rule PTuple')
     then obtain pi'::"name prm" where
       "p\<^sub>2 = pi' \<bullet> pi \<bullet> p\<^sub>2'" "t = pi' \<bullet> pi \<bullet> u" and
       pi': "set pi' \<subseteq> (supp p\<^sub>2 \<union> supp (pi \<bullet> p\<^sub>2')) \<times>
         (supp p\<^sub>2 \<union> supp (pi \<bullet> p\<^sub>2'))" by auto
     from PTuple PTuple' have "pi \<bullet> distinct (pat_vars \<langle>\<langle>p\<^sub>1', p\<^sub>2'\<rangle>\<rangle>)" by simp
     then have "distinct (pat_vars \<langle>\<langle>pi \<bullet> p\<^sub>1', pi \<bullet> p\<^sub>2'\<rangle>\<rangle>)" by (simp only: eqvts)
     with \<open>p\<^sub>1 = pi \<bullet> p\<^sub>1'\<close> PTuple'
     have fresh: "(supp p\<^sub>2 \<union> supp (pi \<bullet> p\<^sub>2') :: name set) \<sharp>* p\<^sub>1"
       by (auto simp add: set_pat_vars_supp fresh_star_def fresh_def eqvts)
     from \<open>p\<^sub>1 = pi \<bullet> p\<^sub>1'\<close> have "pi' \<bullet> (p\<^sub>1 = pi \<bullet> p\<^sub>1')" by (rule perm_boolI)
     with pt_freshs_freshs [OF pt_name_inst at_name_inst pi' fresh fresh]
     have "p\<^sub>1 = pi' \<bullet> pi \<bullet> p\<^sub>1'" by (simp add: eqvts)
     with \<open>p\<^sub>2 = pi' \<bullet> pi \<bullet> p\<^sub>2'\<close> have "\<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> = (pi' @ pi) \<bullet> \<langle>\<langle>p\<^sub>1', p\<^sub>2'\<rangle>\<rangle>"
       by (simp add: pt_name2)
     moreover
     have "((supp p\<^sub>2 \<union> (pi \<bullet> supp p\<^sub>2')) \<times> (supp p\<^sub>2 \<union> (pi \<bullet> supp p\<^sub>2'))::(name \<times> name) set) \<subseteq>
       (supp p\<^sub>2 \<union> (supp p\<^sub>1 \<union> supp p\<^sub>1' \<union> supp p\<^sub>2')) \<times> (supp p\<^sub>2 \<union> (supp p\<^sub>1 \<union> supp p\<^sub>1' \<union> supp p\<^sub>2'))"
       by (rule subset_refl Sigma_mono Un_mono perm_cases [OF pi])+
     with pi' have "set pi' \<subseteq> \<dots>" by (simp add: supp_eqvt [symmetric])
     with pi have "set (pi' @ pi) \<subseteq> (supp \<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> \<union> supp \<langle>\<langle>p\<^sub>1', p\<^sub>2'\<rangle>\<rangle>) \<times>
       (supp \<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> \<union> supp \<langle>\<langle>p\<^sub>1', p\<^sub>2'\<rangle>\<rangle>)"
       by (simp add: Sigma_Un_distrib1 Sigma_Un_distrib2 Un_ac) blast
     moreover note \<open>t = pi' \<bullet> pi \<bullet> u\<close>
     ultimately have "\<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> = (pi' @ pi) \<bullet> q \<and> t = (pi' @ pi) \<bullet> u \<and>
       set (pi' @ pi) \<subseteq> (supp \<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> \<union> supp q) \<times>
         (supp \<langle>\<langle>p\<^sub>1, p\<^sub>2\<rangle>\<rangle> \<union> supp q)" using PTuple
       by (simp add: pt_name2)
     then show ?thesis ..
   qed
 qed
 
 lemma typing_case_Let:
   assumes ty: "\<Gamma> \<turnstile> (LET p = t IN u) : U"
   and fresh: "(supp p::name set) \<sharp>* \<Gamma>"
   and distinct: "distinct (pat_vars p)"
   and R: "\<And>T \<Delta>. \<Gamma> \<turnstile> t : T \<Longrightarrow> \<turnstile> p : T \<Rightarrow> \<Delta> \<Longrightarrow> \<Delta> @ \<Gamma> \<turnstile> u : U \<Longrightarrow> P"
   shows P using ty
 proof cases
   case (Let p' t' T \<Delta> u')
   then have "(supp \<Delta>::name set) \<sharp>* \<Gamma>"
     by (auto intro: valid_typing valid_app_freshs)
   with Let have "(supp p'::name set) \<sharp>* \<Gamma>"
     by (simp add: pat_var)
   with fresh have fresh': "(supp p \<union> supp p' :: name set) \<sharp>* \<Gamma>"
     by (auto simp add: fresh_star_def)
   from Let have "(\<lambda>[p]. Base u) = (\<lambda>[p']. Base u')"
     by (simp add: trm.inject)
   moreover from Let have "pat_type p = pat_type p'"
     by (simp add: trm.inject)
   moreover note distinct
   moreover from \<open>\<Delta> @ \<Gamma> \<turnstile> u' : U\<close> have "valid (\<Delta> @ \<Gamma>)"
     by (rule valid_typing)
   then have "valid \<Delta>" by (rule valid_appD)
   with \<open>\<turnstile> p' : T \<Rightarrow> \<Delta>\<close> have "distinct (pat_vars p')"
     by (simp add: valid_distinct pat_vars_ptyping)
   ultimately have "\<exists>pi::name prm. p = pi \<bullet> p' \<and> Base u = pi \<bullet> Base u' \<and>
     set pi \<subseteq> (supp p \<union> supp p') \<times> (supp p \<union> supp p')"
     by (rule abs_pat_alpha')
   then obtain pi::"name prm" where pi: "p = pi \<bullet> p'" "u = pi \<bullet> u'"
     and pi': "set pi \<subseteq> (supp p \<union> supp p') \<times> (supp p \<union> supp p')"
     by (auto simp add: btrm.inject)
   from Let have "\<Gamma> \<turnstile> t : T" by (simp add: trm.inject)
   moreover from \<open>\<turnstile> p' : T \<Rightarrow> \<Delta>\<close> have "\<turnstile> (pi \<bullet> p') : (pi \<bullet> T) \<Rightarrow> (pi \<bullet> \<Delta>)"
     by (simp add: ptyping.eqvt)
   with pi have "\<turnstile> p : T \<Rightarrow> (pi \<bullet> \<Delta>)" by (simp add: perm_type)
   moreover from Let
   have "(pi \<bullet> \<Delta>) @ (pi \<bullet> \<Gamma>) \<turnstile> (pi \<bullet> u') : (pi \<bullet> U)"
     by (simp add: append_eqvt [symmetric] typing.eqvt)
   with pi have "(pi \<bullet> \<Delta>) @ \<Gamma> \<turnstile> u : U"
     by (simp add: perm_type pt_freshs_freshs
       [OF pt_name_inst at_name_inst pi' fresh' fresh'])
   ultimately show ?thesis by (rule R)
 qed simp_all
 
 lemma preservation:
   assumes "t \<longmapsto> t'" and "\<Gamma> \<turnstile> t : T"
   shows "\<Gamma> \<turnstile> t' : T" using assms
 proof (nominal_induct avoiding: \<Gamma> T rule: eval.strong_induct)
   case (TupleL t t' u)
   from \<open>\<Gamma> \<turnstile> \<langle>t, u\<rangle> : T\<close> obtain T\<^sub>1 T\<^sub>2
     where "T = T\<^sub>1 \<otimes> T\<^sub>2" "\<Gamma> \<turnstile> t : T\<^sub>1" "\<Gamma> \<turnstile> u : T\<^sub>2"
     by cases (simp_all add: trm.inject)
   from \<open>\<Gamma> \<turnstile> t : T\<^sub>1\<close> have "\<Gamma> \<turnstile> t' : T\<^sub>1" by (rule TupleL)
   then have "\<Gamma> \<turnstile> \<langle>t', u\<rangle> : T\<^sub>1 \<otimes> T\<^sub>2" using \<open>\<Gamma> \<turnstile> u : T\<^sub>2\<close>
     by (rule Tuple)
   with \<open>T = T\<^sub>1 \<otimes> T\<^sub>2\<close> show ?case by simp
 next
   case (TupleR u u' t)
   from \<open>\<Gamma> \<turnstile> \<langle>t, u\<rangle> : T\<close> obtain T\<^sub>1 T\<^sub>2
     where "T = T\<^sub>1 \<otimes> T\<^sub>2" "\<Gamma> \<turnstile> t : T\<^sub>1" "\<Gamma> \<turnstile> u : T\<^sub>2"
     by cases (simp_all add: trm.inject)
   from \<open>\<Gamma> \<turnstile> u : T\<^sub>2\<close> have "\<Gamma> \<turnstile> u' : T\<^sub>2" by (rule TupleR)
   with \<open>\<Gamma> \<turnstile> t : T\<^sub>1\<close> have "\<Gamma> \<turnstile> \<langle>t, u'\<rangle> : T\<^sub>1 \<otimes> T\<^sub>2"
     by (rule Tuple)
   with \<open>T = T\<^sub>1 \<otimes> T\<^sub>2\<close> show ?case by simp
 next
   case (Abs t t' x S)
   from \<open>\<Gamma> \<turnstile> (\<lambda>x:S. t) : T\<close> \<open>x \<sharp> \<Gamma>\<close> obtain U where
     T: "T = S \<rightarrow> U" and U: "(x, S) # \<Gamma> \<turnstile> t : U"
     by (rule typing_case_Abs)
   from U have "(x, S) # \<Gamma> \<turnstile> t' : U" by (rule Abs)
   then have "\<Gamma> \<turnstile> (\<lambda>x:S. t') : S \<rightarrow> U"
     by (rule typing.Abs)
   with T show ?case by simp
 next
   case (Beta x u S t)
   from \<open>\<Gamma> \<turnstile> (\<lambda>x:S. t) \<cdot> u : T\<close> \<open>x \<sharp> \<Gamma>\<close>
   obtain "(x, S) # \<Gamma> \<turnstile> t : T" and "\<Gamma> \<turnstile> u : S"
     by cases (auto simp add: trm.inject ty.inject elim: typing_case_Abs)
   then show ?case by (rule subst_type)
 next
   case (Let p t \<theta> u)
   from \<open>\<Gamma> \<turnstile> (LET p = t IN u) : T\<close> \<open>supp p \<sharp>* \<Gamma>\<close> \<open>distinct (pat_vars p)\<close>
   obtain U \<Delta> where "\<turnstile> p : U \<Rightarrow> \<Delta>" "\<Gamma> \<turnstile> t : U" "\<Delta> @ \<Gamma> \<turnstile> u : T"
     by (rule typing_case_Let)
   then show ?case using \<open>\<turnstile> p \<rhd> t \<Rightarrow> \<theta>\<close> \<open>supp p \<sharp>* t\<close>
     by (rule match_type)
 next
   case (AppL t t' u)
   from \<open>\<Gamma> \<turnstile> t \<cdot> u : T\<close> obtain U where
     t: "\<Gamma> \<turnstile> t : U \<rightarrow> T" and u: "\<Gamma> \<turnstile> u : U"
     by cases (auto simp add: trm.inject)
   from t have "\<Gamma> \<turnstile> t' : U \<rightarrow> T" by (rule AppL)
   then show ?case using u by (rule typing.App)
 next
   case (AppR u u' t)
   from \<open>\<Gamma> \<turnstile> t \<cdot> u : T\<close> obtain U where
     t: "\<Gamma> \<turnstile> t : U \<rightarrow> T" and u: "\<Gamma> \<turnstile> u : U"
     by cases (auto simp add: trm.inject)
   from u have "\<Gamma> \<turnstile> u' : U" by (rule AppR)
   with t show ?case by (rule typing.App)
 qed
 
 end
diff --git a/src/HOL/Nominal/Nominal.thy b/src/HOL/Nominal/Nominal.thy
--- a/src/HOL/Nominal/Nominal.thy
+++ b/src/HOL/Nominal/Nominal.thy
@@ -1,3430 +1,3430 @@
 theory Nominal 
   imports "HOL-Library.Infinite_Set" "HOL-Library.Old_Datatype"
 
 keywords
   "atom_decl" :: thy_decl and
   "nominal_datatype" :: thy_defn and
   "equivariance" :: thy_decl and
   "nominal_primrec" "nominal_inductive" "nominal_inductive2" :: thy_goal_defn and
   "avoids"
 begin
 
 declare [[typedef_overloaded]]
 
 
 section \<open>Permutations\<close>
 (*======================*)
 
 type_synonym 
   'x prm = "('x \<times> 'x) list"
 
 (* polymorphic constants for permutation and swapping *)
 consts 
   perm :: "'x prm \<Rightarrow> 'a \<Rightarrow> 'a"     (infixr \<open>\<bullet>\<close> 80)
   swap :: "('x \<times> 'x) \<Rightarrow> 'x \<Rightarrow> 'x"
 
 (* a "private" copy of the option type used in the abstraction function *)
 datatype 'a noption = nSome 'a | nNone
 
 datatype_compat noption
 
 (* a "private" copy of the product type used in the nominal induct method *)
 datatype ('a, 'b) nprod = nPair 'a 'b
 
 datatype_compat nprod
 
 (* an auxiliary constant for the decision procedure involving *) 
 (* permutations (to avoid loops when using perm-compositions)  *)
 definition
   "perm_aux pi x = pi\<bullet>x"
 
 (* overloaded permutation operations *)
 overloading
   perm_fun    \<equiv> "perm :: 'x prm \<Rightarrow> ('a\<Rightarrow>'b) \<Rightarrow> ('a\<Rightarrow>'b)"   (unchecked)
   perm_bool   \<equiv> "perm :: 'x prm \<Rightarrow> bool \<Rightarrow> bool"           (unchecked)
   perm_set    \<equiv> "perm :: 'x prm \<Rightarrow> 'a set \<Rightarrow> 'a set"           (unchecked)
   perm_unit   \<equiv> "perm :: 'x prm \<Rightarrow> unit \<Rightarrow> unit"           (unchecked)
   perm_prod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)"    (unchecked)
   perm_list   \<equiv> "perm :: 'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list"     (unchecked)
   perm_option \<equiv> "perm :: 'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option" (unchecked)
   perm_char   \<equiv> "perm :: 'x prm \<Rightarrow> char \<Rightarrow> char"           (unchecked)
   perm_nat    \<equiv> "perm :: 'x prm \<Rightarrow> nat \<Rightarrow> nat"             (unchecked)
   perm_int    \<equiv> "perm :: 'x prm \<Rightarrow> int \<Rightarrow> int"             (unchecked)
 
   perm_noption \<equiv> "perm :: 'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption"   (unchecked)
   perm_nprod   \<equiv> "perm :: 'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod" (unchecked)
 begin
 
 definition perm_fun :: "'x prm \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where
   "perm_fun pi f = (\<lambda>x. pi \<bullet> f (rev pi \<bullet> x))"
 
 definition perm_bool :: "'x prm \<Rightarrow> bool \<Rightarrow> bool" where
   "perm_bool pi b = b"
 
 definition perm_set :: "'x prm \<Rightarrow> 'a set \<Rightarrow> 'a set" where
   "perm_set pi X = {pi \<bullet> x | x. x \<in> X}"
 
 primrec perm_unit :: "'x prm \<Rightarrow> unit \<Rightarrow> unit"  where 
   "perm_unit pi () = ()"
   
 primrec perm_prod :: "'x prm \<Rightarrow> ('a\<times>'b) \<Rightarrow> ('a\<times>'b)" where
   "perm_prod pi (x, y) = (pi\<bullet>x, pi\<bullet>y)"
 
 primrec perm_list :: "'x prm \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   nil_eqvt:  "perm_list pi []     = []"
 | cons_eqvt: "perm_list pi (x#xs) = (pi\<bullet>x)#(pi\<bullet>xs)"
 
 primrec perm_option :: "'x prm \<Rightarrow> 'a option \<Rightarrow> 'a option" where
   some_eqvt:  "perm_option pi (Some x) = Some (pi\<bullet>x)"
 | none_eqvt:  "perm_option pi None     = None"
 
 definition perm_char :: "'x prm \<Rightarrow> char \<Rightarrow> char" where
   "perm_char pi c = c"
 
 definition perm_nat :: "'x prm \<Rightarrow> nat \<Rightarrow> nat" where
   "perm_nat pi i = i"
 
 definition perm_int :: "'x prm \<Rightarrow> int \<Rightarrow> int" where
   "perm_int pi i = i"
 
 primrec perm_noption :: "'x prm \<Rightarrow> 'a noption \<Rightarrow> 'a noption" where
   nsome_eqvt:  "perm_noption pi (nSome x) = nSome (pi\<bullet>x)"
 | nnone_eqvt:  "perm_noption pi nNone     = nNone"
 
 primrec perm_nprod :: "'x prm \<Rightarrow> ('a, 'b) nprod \<Rightarrow> ('a, 'b) nprod" where
   "perm_nprod pi (nPair x y) = nPair (pi\<bullet>x) (pi\<bullet>y)"
 
 end
 
 (* permutations on booleans *)
 lemmas perm_bool = perm_bool_def
 
 lemma true_eqvt [simp]:
   "pi \<bullet> True \<longleftrightarrow> True"
   by (simp add: perm_bool_def)
 
 lemma false_eqvt [simp]:
   "pi \<bullet> False \<longleftrightarrow> False"
   by (simp add: perm_bool_def)
 
 lemma perm_boolI:
   assumes a: "P"
   shows "pi\<bullet>P"
   using a by (simp add: perm_bool)
 
 lemma perm_boolE:
   assumes a: "pi\<bullet>P"
   shows "P"
   using a by (simp add: perm_bool)
 
 lemma if_eqvt:
   fixes pi::"'a prm"
   shows "pi\<bullet>(if b then c1 else c2) = (if (pi\<bullet>b) then (pi\<bullet>c1) else (pi\<bullet>c2))"
   by (simp add: perm_fun_def)
 
 lemma imp_eqvt:
   shows "pi\<bullet>(A\<longrightarrow>B) = ((pi\<bullet>A)\<longrightarrow>(pi\<bullet>B))"
   by (simp add: perm_bool)
 
 lemma conj_eqvt:
   shows "pi\<bullet>(A\<and>B) = ((pi\<bullet>A)\<and>(pi\<bullet>B))"
   by (simp add: perm_bool)
 
 lemma disj_eqvt:
   shows "pi\<bullet>(A\<or>B) = ((pi\<bullet>A)\<or>(pi\<bullet>B))"
   by (simp add: perm_bool)
 
 lemma neg_eqvt:
   shows "pi\<bullet>(\<not> A) = (\<not> (pi\<bullet>A))"
   by (simp add: perm_bool)
 
 (* permutation on sets *)
-lemma empty_eqvt:
+lemma empty_eqvt[simp]:
   shows "pi\<bullet>{} = {}"
   by (simp add: perm_set_def)
 
 lemma union_eqvt:
   shows "(pi\<bullet>(X\<union>Y)) = (pi\<bullet>X) \<union> (pi\<bullet>Y)"
   by (auto simp add: perm_set_def)
 
 lemma insert_eqvt:
   shows "pi\<bullet>(insert x X) = insert (pi\<bullet>x) (pi\<bullet>X)"
   by (auto simp add: perm_set_def)
 
 (* permutations on products *)
 lemma fst_eqvt:
   "pi\<bullet>(fst x) = fst (pi\<bullet>x)"
  by (cases x) simp
 
 lemma snd_eqvt:
   "pi\<bullet>(snd x) = snd (pi\<bullet>x)"
  by (cases x) simp
 
 (* permutation on lists *)
 lemma append_eqvt:
   fixes pi :: "'x prm"
   and   l1 :: "'a list"
   and   l2 :: "'a list"
   shows "pi\<bullet>(l1@l2) = (pi\<bullet>l1)@(pi\<bullet>l2)"
   by (induct l1) auto
 
 lemma rev_eqvt:
   fixes pi :: "'x prm"
   and   l  :: "'a list"
   shows "pi\<bullet>(rev l) = rev (pi\<bullet>l)"
   by (induct l) (simp_all add: append_eqvt)
 
 lemma set_eqvt:
   fixes pi :: "'x prm"
   and   xs :: "'a list"
   shows "pi\<bullet>(set xs) = set (pi\<bullet>xs)"
 by (induct xs) (auto simp add: empty_eqvt insert_eqvt)
 
 (* permutation on characters and strings *)
 lemma perm_string:
   fixes s::"string"
   shows "pi\<bullet>s = s"
   by (induct s)(auto simp add: perm_char_def)
 
 
 section \<open>permutation equality\<close>
 (*==============================*)
 
 definition prm_eq :: "'x prm \<Rightarrow> 'x prm \<Rightarrow> bool" (\<open> _ \<triangleq> _ \<close> [80,80] 80) where
   "pi1 \<triangleq> pi2 \<longleftrightarrow> (\<forall>a::'x. pi1\<bullet>a = pi2\<bullet>a)"
 
 section \<open>Support, Freshness and Supports\<close>
 (*========================================*)
 definition supp :: "'a \<Rightarrow> ('x set)" where  
    "supp x = {a . (infinite {b . [(a,b)]\<bullet>x \<noteq> x})}"
 
 definition fresh :: "'x \<Rightarrow> 'a \<Rightarrow> bool" (\<open>_ \<sharp> _\<close> [80,80] 80) where
    "a \<sharp> x \<longleftrightarrow> a \<notin> supp x"
 
 definition supports :: "'x set \<Rightarrow> 'a \<Rightarrow> bool" (infixl \<open>supports\<close> 80) where
    "S supports x \<longleftrightarrow> (\<forall>a b. (a\<notin>S \<and> b\<notin>S \<longrightarrow> [(a,b)]\<bullet>x=x))"
 
 (* lemmas about supp *)
 lemma supp_fresh_iff: 
   fixes x :: "'a"
   shows "(supp x) = {a::'x. \<not>a\<sharp>x}"
   by (simp add: fresh_def)
 
-lemma supp_unit:
+lemma supp_unit[simp]:
   shows "supp () = {}"
   by (simp add: supp_def)
 
-lemma supp_set_empty:
+lemma supp_set_empty[simp]:
   shows "supp {} = {}"
   by (force simp add: supp_def empty_eqvt)
 
 lemma supp_prod: 
   fixes x :: "'a"
   and   y :: "'b"
   shows "(supp (x,y)) = (supp x)\<union>(supp y)"
   by  (force simp add: supp_def Collect_imp_eq Collect_neg_eq)
 
 lemma supp_nprod: 
   fixes x :: "'a"
   and   y :: "'b"
   shows "(supp (nPair x y)) = (supp x)\<union>(supp y)"
   by  (force simp add: supp_def Collect_imp_eq Collect_neg_eq)
 
-lemma supp_list_nil:
+lemma supp_list_nil[simp]:
   shows "supp [] = {}"
   by (simp add: supp_def)
 
 lemma supp_list_cons:
   fixes x  :: "'a"
   and   xs :: "'a list"
   shows "supp (x#xs) = (supp x)\<union>(supp xs)"
   by (auto simp add: supp_def Collect_imp_eq Collect_neg_eq)
 
 lemma supp_list_append:
   fixes xs :: "'a list"
   and   ys :: "'a list"
   shows "supp (xs@ys) = (supp xs)\<union>(supp ys)"
   by (induct xs) (auto simp add: supp_list_nil supp_list_cons)
 
 lemma supp_list_rev:
   fixes xs :: "'a list"
   shows "supp (rev xs) = (supp xs)"
   by (induct xs, auto simp add: supp_list_append supp_list_cons supp_list_nil)
 
-lemma supp_bool:
+lemma supp_bool[simp]:
   fixes x  :: "bool"
   shows "supp x = {}"
   by (cases "x") (simp_all add: supp_def)
 
-lemma supp_some:
+lemma supp_some[simp]:
   fixes x :: "'a"
   shows "supp (Some x) = (supp x)"
   by (simp add: supp_def)
 
-lemma supp_none:
+lemma supp_none[simp]:
   fixes x :: "'a"
   shows "supp (None) = {}"
   by (simp add: supp_def)
 
-lemma supp_int:
+lemma supp_int[simp]:
   fixes i::"int"
   shows "supp (i) = {}"
   by (simp add: supp_def perm_int_def)
 
-lemma supp_nat:
+lemma supp_nat[simp]:
   fixes n::"nat"
   shows "(supp n) = {}"
   by (simp add: supp_def perm_nat_def)
 
-lemma supp_char:
+lemma supp_char[simp]:
   fixes c::"char"
   shows "(supp c) = {}"
   by (simp add: supp_def perm_char_def)
   
-lemma supp_string:
+lemma supp_string[simp]:
   fixes s::"string"
   shows "(supp s) = {}"
   by (simp add: supp_def perm_string)
 
 (* lemmas about freshness *)
-lemma fresh_set_empty:
+lemma fresh_set_empty[simp]:
   shows "a\<sharp>{}"
   by (simp add: fresh_def supp_set_empty)
 
-lemma fresh_unit:
+lemma fresh_unit[simp]:
   shows "a\<sharp>()"
   by (simp add: fresh_def supp_unit)
 
 lemma fresh_prod:
   fixes a :: "'x"
   and   x :: "'a"
   and   y :: "'b"
   shows "a\<sharp>(x,y) = (a\<sharp>x \<and> a\<sharp>y)"
   by (simp add: fresh_def supp_prod)
 
-lemma fresh_list_nil:
+lemma fresh_list_nil[simp]:
   fixes a :: "'x"
   shows "a\<sharp>[]"
   by (simp add: fresh_def supp_list_nil) 
 
 lemma fresh_list_cons:
   fixes a :: "'x"
   and   x :: "'a"
   and   xs :: "'a list"
   shows "a\<sharp>(x#xs) = (a\<sharp>x \<and> a\<sharp>xs)"
   by (simp add: fresh_def supp_list_cons)
 
 lemma fresh_list_append:
   fixes a :: "'x"
   and   xs :: "'a list"
   and   ys :: "'a list"
   shows "a\<sharp>(xs@ys) = (a\<sharp>xs \<and> a\<sharp>ys)"
   by (simp add: fresh_def supp_list_append)
 
-lemma fresh_list_rev:
+lemma fresh_list_rev[simp]:
   fixes a :: "'x"
   and   xs :: "'a list"
   shows "a\<sharp>(rev xs) = a\<sharp>xs"
   by (simp add: fresh_def supp_list_rev)
 
-lemma fresh_none:
+lemma fresh_none[simp]:
   fixes a :: "'x"
   shows "a\<sharp>None"
   by (simp add: fresh_def supp_none)
 
-lemma fresh_some:
+lemma fresh_some[simp]:
   fixes a :: "'x"
   and   x :: "'a"
   shows "a\<sharp>(Some x) = a\<sharp>x"
   by (simp add: fresh_def supp_some)
 
-lemma fresh_int:
+lemma fresh_int[simp]:
   fixes a :: "'x"
   and   i :: "int"
   shows "a\<sharp>i"
   by (simp add: fresh_def supp_int)
 
-lemma fresh_nat:
+lemma fresh_nat[simp]:
   fixes a :: "'x"
   and   n :: "nat"
   shows "a\<sharp>n"
   by (simp add: fresh_def supp_nat)
 
-lemma fresh_char:
+lemma fresh_char[simp]:
   fixes a :: "'x"
   and   c :: "char"
   shows "a\<sharp>c"
   by (simp add: fresh_def supp_char)
 
-lemma fresh_string:
+lemma fresh_string[simp]:
   fixes a :: "'x"
   and   s :: "string"
   shows "a\<sharp>s"
   by (simp add: fresh_def supp_string)
 
-lemma fresh_bool:
+lemma fresh_bool[simp]:
   fixes a :: "'x"
   and   b :: "bool"
   shows "a\<sharp>b"
   by (simp add: fresh_def supp_bool)
 
 text \<open>Normalization of freshness results; cf.\ \<open>nominal_induct\<close>\<close>
 lemma fresh_unit_elim: 
   shows "(a\<sharp>() \<Longrightarrow> PROP C) \<equiv> PROP C"
   by (simp add: fresh_def supp_unit)
 
 lemma fresh_prod_elim: 
   shows "(a\<sharp>(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>x \<Longrightarrow> a\<sharp>y \<Longrightarrow> PROP C)"
   by rule (simp_all add: fresh_prod)
 
 (* this rule needs to be added before the fresh_prodD is *)
 (* added to the simplifier with mksimps                  *) 
 lemma [simp]:
   shows "a\<sharp>x1 \<Longrightarrow> a\<sharp>x2 \<Longrightarrow> a\<sharp>(x1,x2)"
   by (simp add: fresh_prod)
 
 lemma fresh_prodD:
   shows "a\<sharp>(x,y) \<Longrightarrow> a\<sharp>x"
   and   "a\<sharp>(x,y) \<Longrightarrow> a\<sharp>y"
   by (simp_all add: fresh_prod)
 
 ML \<open>
   val mksimps_pairs = (\<^const_name>\<open>Nominal.fresh\<close>, @{thms fresh_prodD}) :: mksimps_pairs;
 \<close>
 declaration \<open>fn _ =>
   Simplifier.map_ss (Simplifier.set_mksimps (mksimps mksimps_pairs))
 \<close>
 
 section \<open>Abstract Properties for Permutations and  Atoms\<close>
 (*=========================================================*)
 
 (* properties for being a permutation type *)
 definition
   "pt TYPE('a) TYPE('x) \<equiv> 
      (\<forall>(x::'a). ([]::'x prm)\<bullet>x = x) \<and> 
      (\<forall>(pi1::'x prm) (pi2::'x prm) (x::'a). (pi1@pi2)\<bullet>x = pi1\<bullet>(pi2\<bullet>x)) \<and> 
      (\<forall>(pi1::'x prm) (pi2::'x prm) (x::'a). pi1 \<triangleq> pi2 \<longrightarrow> pi1\<bullet>x = pi2\<bullet>x)"
 
 (* properties for being an atom type *)
 definition
   "at TYPE('x) \<equiv> 
      (\<forall>(x::'x). ([]::'x prm)\<bullet>x = x) \<and>
      (\<forall>(a::'x) (b::'x) (pi::'x prm) (x::'x). ((a,b)#(pi::'x prm))\<bullet>x = swap (a,b) (pi\<bullet>x)) \<and> 
      (\<forall>(a::'x) (b::'x) (c::'x). swap (a,b) c = (if a=c then b else (if b=c then a else c))) \<and> 
      (infinite (UNIV::'x set))"
 
 (* property of two atom-types being disjoint *)
 definition
   "disjoint TYPE('x) TYPE('y) \<equiv> 
        (\<forall>(pi::'x prm)(x::'y). pi\<bullet>x = x) \<and> 
        (\<forall>(pi::'y prm)(x::'x). pi\<bullet>x = x)"
 
 (* composition property of two permutation on a type 'a *)
 definition
   "cp TYPE ('a) TYPE('x) TYPE('y) \<equiv> 
       (\<forall>(pi2::'y prm) (pi1::'x prm) (x::'a) . pi1\<bullet>(pi2\<bullet>x) = (pi1\<bullet>pi2)\<bullet>(pi1\<bullet>x))" 
 
 (* property of having finite support *)
 definition
   "fs TYPE('a) TYPE('x) \<equiv> \<forall>(x::'a). finite ((supp x)::'x set)"
 
 section \<open>Lemmas about the atom-type properties\<close>
 (*==============================================*)
 
 lemma at1: 
   fixes x::"'x"
   assumes a: "at TYPE('x)"
   shows "([]::'x prm)\<bullet>x = x"
   using a by (simp add: at_def)
 
 lemma at2: 
   fixes a ::"'x"
   and   b ::"'x"
   and   x ::"'x"
   and   pi::"'x prm"
   assumes a: "at TYPE('x)"
   shows "((a,b)#pi)\<bullet>x = swap (a,b) (pi\<bullet>x)"
   using a by (simp only: at_def)
 
 lemma at3: 
   fixes a ::"'x"
   and   b ::"'x"
   and   c ::"'x"
   assumes a: "at TYPE('x)"
   shows "swap (a,b) c = (if a=c then b else (if b=c then a else c))"
   using a by (simp only: at_def)
 
 (* rules to calculate simple permutations *)
 lemmas at_calc = at2 at1 at3
 
 lemma at_swap_simps:
   fixes a ::"'x"
   and   b ::"'x"
   assumes a: "at TYPE('x)"
   shows "[(a,b)]\<bullet>a = b"
   and   "[(a,b)]\<bullet>b = a"
   and   "\<lbrakk>a\<noteq>c; b\<noteq>c\<rbrakk> \<Longrightarrow> [(a,b)]\<bullet>c = c"
   using a by (simp_all add: at_calc)
 
 lemma at4: 
   assumes a: "at TYPE('x)"
   shows "infinite (UNIV::'x set)"
   using a by (simp add: at_def)
 
 lemma at_append:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   c   :: "'x"
   assumes at: "at TYPE('x)" 
   shows "(pi1@pi2)\<bullet>c = pi1\<bullet>(pi2\<bullet>c)"
 proof (induct pi1)
   case Nil show ?case by (simp add: at1[OF at])
 next
   case (Cons x xs)
   have "(xs@pi2)\<bullet>c  =  xs\<bullet>(pi2\<bullet>c)" by fact
   also have "(x#xs)@pi2 = x#(xs@pi2)" by simp
   ultimately show ?case by (cases "x", simp add:  at2[OF at])
 qed
  
 lemma at_swap:
   fixes a :: "'x"
   and   b :: "'x"
   and   c :: "'x"
   assumes at: "at TYPE('x)" 
   shows "swap (a,b) (swap (a,b) c) = c"
   by (auto simp add: at3[OF at])
 
 lemma at_rev_pi:
   fixes pi :: "'x prm"
   and   c  :: "'x"
   assumes at: "at TYPE('x)"
   shows "(rev pi)\<bullet>(pi\<bullet>c) = c"
 proof(induct pi)
   case Nil show ?case by (simp add: at1[OF at])
 next
   case (Cons x xs) thus ?case 
     by (cases "x", simp add: at2[OF at] at_append[OF at] at1[OF at] at_swap[OF at])
 qed
 
 lemma at_pi_rev:
   fixes pi :: "'x prm"
   and   x  :: "'x"
   assumes at: "at TYPE('x)"
   shows "pi\<bullet>((rev pi)\<bullet>x) = x"
   by (rule at_rev_pi[OF at, of "rev pi" _,simplified])
 
 lemma at_bij1: 
   fixes pi :: "'x prm"
   and   x  :: "'x"
   and   y  :: "'x"
   assumes at: "at TYPE('x)"
   and     a:  "(pi\<bullet>x) = y"
   shows   "x=(rev pi)\<bullet>y"
 proof -
   from a have "y=(pi\<bullet>x)" by (rule sym)
   thus ?thesis by (simp only: at_rev_pi[OF at])
 qed
 
 lemma at_bij2: 
   fixes pi :: "'x prm"
   and   x  :: "'x"
   and   y  :: "'x"
   assumes at: "at TYPE('x)"
   and     a:  "((rev pi)\<bullet>x) = y"
   shows   "x=pi\<bullet>y"
 proof -
   from a have "y=((rev pi)\<bullet>x)" by (rule sym)
   thus ?thesis by (simp only: at_pi_rev[OF at])
 qed
 
 lemma at_bij:
   fixes pi :: "'x prm"
   and   x  :: "'x"
   and   y  :: "'x"
   assumes at: "at TYPE('x)"
   shows "(pi\<bullet>x = pi\<bullet>y) = (x=y)"
 proof 
   assume "pi\<bullet>x = pi\<bullet>y" 
   hence  "x=(rev pi)\<bullet>(pi\<bullet>y)" by (rule at_bij1[OF at]) 
   thus "x=y" by (simp only: at_rev_pi[OF at])
 next
   assume "x=y"
   thus "pi\<bullet>x = pi\<bullet>y" by simp
 qed
 
 lemma at_supp:
   fixes x :: "'x"
   assumes at: "at TYPE('x)"
   shows "supp x = {x}"
 by(auto simp: supp_def Collect_conj_eq Collect_imp_eq at_calc[OF at] at4[OF at])
 
 lemma at_fresh:
   fixes a :: "'x"
   and   b :: "'x"
   assumes at: "at TYPE('x)"
   shows "(a\<sharp>b) = (a\<noteq>b)" 
   by (simp add: at_supp[OF at] fresh_def)
 
 lemma at_prm_fresh1:
   fixes c :: "'x"
   and   pi:: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "c\<sharp>pi" 
   shows "\<forall>(a,b)\<in>set pi. c\<noteq>a \<and> c\<noteq>b"
 using a by (induct pi) (auto simp add: fresh_list_cons fresh_prod at_fresh[OF at])
 
 lemma at_prm_fresh2:
   fixes c :: "'x"
   and   pi:: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "\<forall>(a,b)\<in>set pi. c\<noteq>a \<and> c\<noteq>b" 
   shows "pi\<bullet>c = c"
 using a  by(induct pi) (auto simp add: at1[OF at] at2[OF at] at3[OF at])
 
 lemma at_prm_fresh:
   fixes c :: "'x"
   and   pi:: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "c\<sharp>pi" 
   shows "pi\<bullet>c = c"
 by (rule at_prm_fresh2[OF at], rule at_prm_fresh1[OF at, OF a])
 
 lemma at_prm_rev_eq:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   assumes at: "at TYPE('x)"
   shows "((rev pi1) \<triangleq> (rev pi2)) = (pi1 \<triangleq> pi2)"
 proof (simp add: prm_eq_def, auto)
   fix x
   assume "\<forall>x::'x. (rev pi1)\<bullet>x = (rev pi2)\<bullet>x"
   hence "(rev (pi1::'x prm))\<bullet>(pi2\<bullet>(x::'x)) = (rev (pi2::'x prm))\<bullet>(pi2\<bullet>x)" by simp
   hence "(rev (pi1::'x prm))\<bullet>((pi2::'x prm)\<bullet>x) = (x::'x)" by (simp add: at_rev_pi[OF at])
   hence "(pi2::'x prm)\<bullet>x = (pi1::'x prm)\<bullet>x" by (simp add: at_bij2[OF at])
   thus "pi1\<bullet>x  =  pi2\<bullet>x" by simp
 next
   fix x
   assume "\<forall>x::'x. pi1\<bullet>x = pi2\<bullet>x"
   hence "(pi1::'x prm)\<bullet>((rev pi2)\<bullet>x) = (pi2::'x prm)\<bullet>((rev pi2)\<bullet>(x::'x))" by simp
   hence "(pi1::'x prm)\<bullet>((rev pi2)\<bullet>(x::'x)) = x" by (simp add: at_pi_rev[OF at])
   hence "(rev pi2)\<bullet>x = (rev pi1)\<bullet>(x::'x)" by (simp add: at_bij1[OF at])
   thus "(rev pi1)\<bullet>x = (rev pi2)\<bullet>(x::'x)" by simp
 qed
 
 lemma at_prm_eq_append:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   pi3 :: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "pi1 \<triangleq> pi2"
   shows "(pi3@pi1) \<triangleq> (pi3@pi2)"
 using a by (simp add: prm_eq_def at_append[OF at] at_bij[OF at])
 
 lemma at_prm_eq_append':
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   pi3 :: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "pi1 \<triangleq> pi2"
   shows "(pi1@pi3) \<triangleq> (pi2@pi3)"
 using a by (simp add: prm_eq_def at_append[OF at])
 
 lemma at_prm_eq_trans:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   pi3 :: "'x prm"
   assumes a1: "pi1 \<triangleq> pi2"
   and     a2: "pi2 \<triangleq> pi3"  
   shows "pi1 \<triangleq> pi3"
 using a1 a2 by (auto simp add: prm_eq_def)
   
 lemma at_prm_eq_refl:
   fixes pi :: "'x prm"
   shows "pi \<triangleq> pi"
 by (simp add: prm_eq_def)
 
 lemma at_prm_rev_eq1:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   assumes at: "at TYPE('x)"
   shows "pi1 \<triangleq> pi2 \<Longrightarrow> (rev pi1) \<triangleq> (rev pi2)"
   by (simp add: at_prm_rev_eq[OF at])
 
 lemma at_ds1:
   fixes a  :: "'x"
   assumes at: "at TYPE('x)"
   shows "[(a,a)] \<triangleq> []"
   by (force simp add: prm_eq_def at_calc[OF at])
 
 lemma at_ds2: 
   fixes pi :: "'x prm"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes at: "at TYPE('x)"
   shows "([(a,b)]@pi) \<triangleq> (pi@[((rev pi)\<bullet>a,(rev pi)\<bullet>b)])"
   by (force simp add: prm_eq_def at_append[OF at] at_bij[OF at] at_pi_rev[OF at] 
       at_rev_pi[OF at] at_calc[OF at])
 
 lemma at_ds3: 
   fixes a  :: "'x"
   and   b  :: "'x"
   and   c  :: "'x"
   assumes at: "at TYPE('x)"
   and     a:  "distinct [a,b,c]"
   shows "[(a,c),(b,c),(a,c)] \<triangleq> [(a,b)]"
   using a by (force simp add: prm_eq_def at_calc[OF at])
 
 lemma at_ds4: 
   fixes a  :: "'x"
   and   b  :: "'x"
   and   pi  :: "'x prm"
   assumes at: "at TYPE('x)"
   shows "(pi@[(a,(rev pi)\<bullet>b)]) \<triangleq> ([(pi\<bullet>a,b)]@pi)"
   by (force simp add: prm_eq_def at_append[OF at] at_calc[OF at] at_bij[OF at] 
       at_pi_rev[OF at] at_rev_pi[OF at])
 
 lemma at_ds5: 
   fixes a  :: "'x"
   and   b  :: "'x"
   assumes at: "at TYPE('x)"
   shows "[(a,b)] \<triangleq> [(b,a)]"
   by (force simp add: prm_eq_def at_calc[OF at])
 
 lemma at_ds5': 
   fixes a  :: "'x"
   and   b  :: "'x"
   assumes at: "at TYPE('x)"
   shows "[(a,b),(b,a)] \<triangleq> []"
   by (force simp add: prm_eq_def at_calc[OF at])
 
 lemma at_ds6: 
   fixes a  :: "'x"
   and   b  :: "'x"
   and   c  :: "'x"
   assumes at: "at TYPE('x)"
   and     a: "distinct [a,b,c]"
   shows "[(a,c),(a,b)] \<triangleq> [(b,c),(a,c)]"
   using a by (force simp add: prm_eq_def at_calc[OF at])
 
 lemma at_ds7:
   fixes pi :: "'x prm"
   assumes at: "at TYPE('x)"
   shows "((rev pi)@pi) \<triangleq> []"
   by (simp add: prm_eq_def at1[OF at] at_append[OF at] at_rev_pi[OF at])
 
 lemma at_ds8_aux:
   fixes pi :: "'x prm"
   and   a  :: "'x"
   and   b  :: "'x"
   and   c  :: "'x"
   assumes at: "at TYPE('x)"
   shows "pi\<bullet>(swap (a,b) c) = swap (pi\<bullet>a,pi\<bullet>b) (pi\<bullet>c)"
   by (force simp add: at_calc[OF at] at_bij[OF at])
 
 lemma at_ds8: 
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes at: "at TYPE('x)"
   shows "(pi1@pi2) \<triangleq> ((pi1\<bullet>pi2)@pi1)"
 proof(induct_tac pi2)
   show "(pi1 @ []) \<triangleq> (pi1 \<bullet> [] @ pi1)"
     by(simp add: prm_eq_def)
   show "\<And>a l. (pi1 @ l) \<triangleq> (pi1 \<bullet> l @ pi1)  \<Longrightarrow>
         (pi1 @ a # l) \<triangleq> (pi1 \<bullet> (a # l) @ pi1) "
     by(auto simp add: prm_eq_def at at2 at_append at_ds8_aux)
 qed
 
 lemma at_ds9: 
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes at: "at TYPE('x)"
   shows " ((rev pi2)@(rev pi1)) \<triangleq> ((rev pi1)@(rev (pi1\<bullet>pi2)))"
   using at at_ds8 at_prm_rev_eq1 rev_append by fastforce
 
 lemma at_ds10:
   fixes pi :: "'x prm"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes "at TYPE('x)"
   and     "b\<sharp>(rev pi)"
   shows "([(pi\<bullet>a,b)]@pi) \<triangleq> (pi@[(a,b)])"
   by (metis assms at_bij1 at_ds2 at_prm_fresh)
 
 \<comment> \<open>there always exists an atom that is not being in a finite set\<close>
 lemma ex_in_inf:
   fixes   A::"'x set"
   assumes at: "at TYPE('x)"
   and     fs: "finite A"
   obtains c::"'x" where "c\<notin>A"
   using at at4 ex_new_if_finite fs by blast
 
 text \<open>there always exists a fresh name for an object with finite support\<close>
 lemma at_exists_fresh': 
   fixes  x :: "'a"
   assumes at: "at TYPE('x)"
   and     fs: "finite ((supp x)::'x set)"
   shows "\<exists>c::'x. c\<sharp>x"
   by (auto simp add: fresh_def intro: ex_in_inf[OF at, OF fs])
 
 lemma at_exists_fresh: 
   fixes  x :: "'a"
   assumes at: "at TYPE('x)"
   and     fs: "finite ((supp x)::'x set)"
   obtains c::"'x" where  "c\<sharp>x"
   by (auto intro: ex_in_inf[OF at, OF fs] simp add: fresh_def)
 
 lemma at_finite_select: 
   fixes S::"'a set"
   assumes a: "at TYPE('a)"
   and     b: "finite S" 
   shows "\<exists>x. x \<notin> S"
   by (meson a b ex_in_inf) 
 
 lemma at_different:
   assumes at: "at TYPE('x)"
   shows "\<exists>(b::'x). a\<noteq>b"
 proof -
   have "infinite (UNIV::'x set)" by (rule at4[OF at])
   hence inf2: "infinite (UNIV-{a})" by (rule infinite_remove)
   have "(UNIV-{a}) \<noteq> ({}::'x set)"
     by (metis finite.emptyI inf2) 
   hence "\<exists>(b::'x). b\<in>(UNIV-{a})" by blast
   then obtain b::"'x" where mem2: "b\<in>(UNIV-{a})" by blast
   from mem2 have "a\<noteq>b" by blast
   then show "\<exists>(b::'x). a\<noteq>b" by blast
 qed
 
 \<comment> \<open>the at-props imply the pt-props\<close>
 lemma at_pt_inst:
   assumes at: "at TYPE('x)"
   shows "pt TYPE('x) TYPE('x)"
   using at at_append at_def prm_eq_def pt_def by fastforce
 
 section \<open>finite support properties\<close>
 (*===================================*)
 
 lemma fs1:
   fixes x :: "'a"
   assumes a: "fs TYPE('a) TYPE('x)"
   shows "finite ((supp x)::'x set)"
   using a by (simp add: fs_def)
 
 lemma fs_at_inst:
   fixes a :: "'x"
   assumes at: "at TYPE('x)"
   shows "fs TYPE('x) TYPE('x)"
   by (simp add: at at_supp fs_def)
 
 lemma fs_unit_inst:
   shows "fs TYPE(unit) TYPE('x)"
   by(simp add: fs_def supp_unit)
 
 lemma fs_prod_inst:
   assumes fsa: "fs TYPE('a) TYPE('x)"
   and     fsb: "fs TYPE('b) TYPE('x)"
   shows "fs TYPE('a\<times>'b) TYPE('x)"
   by (simp add: assms fs1 supp_prod fs_def)
 
 
 lemma fs_nprod_inst:
   assumes fsa: "fs TYPE('a) TYPE('x)"
   and     fsb: "fs TYPE('b) TYPE('x)"
   shows "fs TYPE(('a,'b) nprod) TYPE('x)"
   unfolding fs_def by (metis assms finite_Un fs_def nprod.exhaust supp_nprod)
 
 lemma fs_list_inst:
   assumes "fs TYPE('a) TYPE('x)"
   shows "fs TYPE('a list) TYPE('x)"
   unfolding fs_def
   by (clarify, induct_tac x) (auto simp: fs1 assms supp_list_nil supp_list_cons)
 
 lemma fs_option_inst:
   assumes fs: "fs TYPE('a) TYPE('x)"
   shows "fs TYPE('a option) TYPE('x)"
   unfolding fs_def
   by (metis assms finite.emptyI fs1 option.exhaust supp_none supp_some)
 
 section \<open>Lemmas about the permutation properties\<close>
 (*=================================================*)
 
 lemma pt1:
   fixes x::"'a"
   assumes a: "pt TYPE('a) TYPE('x)"
   shows "([]::'x prm)\<bullet>x = x"
   using a by (simp add: pt_def)
 
 lemma pt2: 
   fixes pi1::"'x prm"
   and   pi2::"'x prm"
   and   x  ::"'a"
   assumes a: "pt TYPE('a) TYPE('x)"
   shows "(pi1@pi2)\<bullet>x = pi1\<bullet>(pi2\<bullet>x)"
   using a by (simp add: pt_def)
 
 lemma pt3:
   fixes pi1::"'x prm"
   and   pi2::"'x prm"
   and   x  ::"'a"
   assumes a: "pt TYPE('a) TYPE('x)"
   shows "pi1 \<triangleq> pi2 \<Longrightarrow> pi1\<bullet>x = pi2\<bullet>x"
   using a by (simp add: pt_def)
 
 lemma pt3_rev:
   fixes pi1::"'x prm"
   and   pi2::"'x prm"
   and   x  ::"'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi1 \<triangleq> pi2 \<Longrightarrow> (rev pi1)\<bullet>x = (rev pi2)\<bullet>x"
   by (rule pt3[OF pt], simp add: at_prm_rev_eq[OF at])
 
 section \<open>composition properties\<close>
 (* ============================== *)
 lemma cp1:
   fixes pi1::"'x prm"
   and   pi2::"'y prm"
   and   x  ::"'a"
   assumes cp: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "pi1\<bullet>(pi2\<bullet>x) = (pi1\<bullet>pi2)\<bullet>(pi1\<bullet>x)"
   using cp by (simp add: cp_def)
 
 lemma cp_pt_inst:
   assumes "pt TYPE('a) TYPE('x)"
   and     "at TYPE('x)"
   shows "cp TYPE('a) TYPE('x) TYPE('x)"
   using assms at_ds8 cp_def pt2 pt3 by fastforce
 
 section \<open>disjointness properties\<close>
 (*=================================*)
 lemma dj_perm_forget:
   fixes pi::"'y prm"
   and   x ::"'x"
   assumes dj: "disjoint TYPE('x) TYPE('y)"
   shows "pi\<bullet>x=x" 
   using dj by (simp_all add: disjoint_def)
 
 lemma dj_perm_set_forget:
   fixes pi::"'y prm"
   and   x ::"'x set"
   assumes dj: "disjoint TYPE('x) TYPE('y)"
   shows "pi\<bullet>x=x" 
   using dj by (simp_all add: perm_set_def disjoint_def)
 
 lemma dj_perm_perm_forget:
   fixes pi1::"'x prm"
   and   pi2::"'y prm"
   assumes dj: "disjoint TYPE('x) TYPE('y)"
   shows "pi2\<bullet>pi1=pi1"
   using dj by (induct pi1, auto simp add: disjoint_def)
 
 lemma dj_cp:
   fixes pi1::"'x prm"
   and   pi2::"'y prm"
   and   x  ::"'a"
   assumes cp: "cp TYPE ('a) TYPE('x) TYPE('y)"
   and     dj: "disjoint TYPE('y) TYPE('x)"
   shows "pi1\<bullet>(pi2\<bullet>x) = (pi2)\<bullet>(pi1\<bullet>x)"
   by (simp add: cp1[OF cp] dj_perm_perm_forget[OF dj])
 
 lemma dj_supp:
   fixes a::"'x"
   assumes dj: "disjoint TYPE('x) TYPE('y)"
   shows "(supp a) = ({}::'y set)"
   by (simp add: supp_def dj_perm_forget[OF dj])
 
 lemma at_fresh_ineq:
   fixes a :: "'x"
   and   b :: "'y"
   assumes dj: "disjoint TYPE('y) TYPE('x)"
   shows "a\<sharp>b" 
   by (simp add: fresh_def dj_supp[OF dj])
 
 section \<open>permutation type instances\<close>
 (* ===================================*)
 
 lemma pt_fun_inst:
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at:  "at TYPE('x)"
   shows  "pt TYPE('a\<Rightarrow>'b) TYPE('x)"
   unfolding pt_def using assms
   by (auto simp add: perm_fun_def pt1 pt2 ptb pt3 pt3_rev)
 
-lemma pt_bool_inst:
+lemma pt_bool_inst[simp]:
   shows  "pt TYPE(bool) TYPE('x)"
   by (simp add: pt_def perm_bool_def)
 
 lemma pt_set_inst:
   assumes pt: "pt TYPE('a) TYPE('x)"
   shows  "pt TYPE('a set) TYPE('x)"
   unfolding pt_def
   by(auto simp add: perm_set_def  pt1[OF pt] pt2[OF pt] pt3[OF pt])
 
-lemma pt_unit_inst:
+lemma pt_unit_inst[simp]:
   shows "pt TYPE(unit) TYPE('x)"
   by (simp add: pt_def)
 
 lemma pt_prod_inst:
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
 shows  "pt TYPE('a \<times> 'b) TYPE('x)"
   using assms pt1 pt2 pt3
   by(auto simp add: pt_def)
 
 lemma pt_list_nil: 
   fixes xs :: "'a list"
   assumes pt: "pt TYPE('a) TYPE ('x)"
   shows "([]::'x prm)\<bullet>xs = xs" 
   by (induct_tac xs) (simp_all add: pt1[OF pt])
 
 lemma pt_list_append: 
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   xs  :: "'a list"
   assumes pt: "pt TYPE('a) TYPE ('x)"
   shows "(pi1@pi2)\<bullet>xs = pi1\<bullet>(pi2\<bullet>xs)"
   by (induct_tac xs) (simp_all add: pt2[OF pt])
 
 lemma pt_list_prm_eq: 
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   xs  :: "'a list"
   assumes pt: "pt TYPE('a) TYPE ('x)"
   shows "pi1 \<triangleq> pi2  \<Longrightarrow> pi1\<bullet>xs = pi2\<bullet>xs"
   by (induct_tac xs) (simp_all add: pt3[OF pt])
 
 lemma pt_list_inst:
   assumes pt: "pt TYPE('a) TYPE('x)"
   shows  "pt TYPE('a list) TYPE('x)"
   by (simp add: pt pt_def pt_list_append pt_list_nil pt_list_prm_eq)
 
 lemma pt_option_inst:
   assumes pta: "pt TYPE('a) TYPE('x)"
   shows  "pt TYPE('a option) TYPE('x)"
 proof -
   have "([]::('x \<times> _) list) \<bullet> x = x" for x :: "'a option"
     by (metis assms none_eqvt not_None_eq pt1 some_eqvt)
   moreover have "(pi1 @ pi2) \<bullet> x = pi1 \<bullet> pi2 \<bullet> x"
     for pi1 pi2 :: "('x \<times> 'x) list" and x :: "'a option"
     by (metis assms none_eqvt option.collapse pt2 some_eqvt)
   moreover have "pi1 \<bullet> x = pi2 \<bullet> x"
     if "pi1 \<triangleq> pi2" for pi1 pi2 :: "('x \<times> 'x) list" and x :: "'a option"
     using that pt3[OF pta] by (metis none_eqvt not_Some_eq some_eqvt)
   ultimately show ?thesis
     by (auto simp add: pt_def)
 qed
 
 lemma pt_noption_inst:
   assumes pta: "pt TYPE('a) TYPE('x)"
   shows  "pt TYPE('a noption) TYPE('x)"
 proof -
   have "([]::('x \<times> _) list) \<bullet> x = x" for x :: "'a noption"
     by (metis assms nnone_eqvt noption.exhaust nsome_eqvt pt1)
   moreover have "(pi1 @ pi2) \<bullet> x = pi1 \<bullet> pi2 \<bullet> x"
     for pi1 pi2 :: "('x \<times> 'x) list" and x :: "'a noption"
     using pt2[OF pta]
     by (metis nnone_eqvt noption.exhaust nsome_eqvt)
   moreover have "pi1 \<bullet> x = pi2 \<bullet> x"
     if "pi1 \<triangleq> pi2"
     for pi1 pi2 :: "('x \<times> 'x) list"
       and x :: "'a noption"
     using that pt3[OF pta] by (metis nnone_eqvt noption.exhaust nsome_eqvt)
   ultimately show ?thesis
     by (auto simp add: pt_def)
 qed
 
 lemma pt_nprod_inst:
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   shows  "pt TYPE(('a,'b) nprod) TYPE('x)"
 proof -
   have "([]::('x \<times> _) list) \<bullet> x = x"
     for x :: "('a, 'b) nprod"
     by (metis assms(1) nprod.exhaust perm_nprod.simps pt1 ptb)
   moreover have "(pi1 @ pi2) \<bullet> x = pi1 \<bullet> pi2 \<bullet> x"
     for pi1 pi2 :: "('x \<times> 'x) list" and x :: "('a, 'b) nprod"
     using pt2[OF pta] pt2[OF ptb]
     by (metis nprod.exhaust perm_nprod.simps)
   moreover have "pi1 \<bullet> x = pi2 \<bullet> x"
     if "pi1 \<triangleq> pi2" for pi1 pi2 :: "('x \<times> 'x) list" and x :: "('a, 'b) nprod"
     using that pt3[OF pta] pt3[OF ptb] by (smt (verit) nprod.exhaust perm_nprod.simps)
   ultimately show ?thesis
     by (auto simp add: pt_def)
 qed
 
 
 section \<open>further lemmas for permutation types\<close>
 (*==============================================*)
 
 lemma pt_rev_pi:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(rev pi)\<bullet>(pi\<bullet>x) = x"
 proof -
   have "((rev pi)@pi) \<triangleq> ([]::'x prm)" by (simp add: at_ds7[OF at])
   hence "((rev pi)@pi)\<bullet>(x::'a) = ([]::'x prm)\<bullet>x" by (simp add: pt3[OF pt]) 
   thus ?thesis by (simp add: pt1[OF pt] pt2[OF pt])
 qed
 
 lemma pt_pi_rev:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>((rev pi)\<bullet>x) = x"
   by (simp add: pt_rev_pi[OF pt, OF at,of "rev pi" "x",simplified])
 
 lemma pt_bij1: 
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "(pi\<bullet>x) = y"
   shows   "x=(rev pi)\<bullet>y"
 proof -
   from a have "y=(pi\<bullet>x)" by (rule sym)
   thus ?thesis by (simp only: pt_rev_pi[OF pt, OF at])
 qed
 
 lemma pt_bij2: 
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "x = (rev pi)\<bullet>y"
   shows   "(pi\<bullet>x)=y"
   using a by (simp add: pt_pi_rev[OF pt, OF at])
 
 lemma pt_bij:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>x = pi\<bullet>y) = (x=y)"
 proof 
   assume "pi\<bullet>x = pi\<bullet>y" 
   hence  "x=(rev pi)\<bullet>(pi\<bullet>y)" by (rule pt_bij1[OF pt, OF at]) 
   thus "x=y" by (simp only: pt_rev_pi[OF pt, OF at])
 next
   assume "x=y"
   thus "pi\<bullet>x = pi\<bullet>y" by simp
 qed
 
 lemma pt_eq_eqvt:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(x=y) = (pi\<bullet>x = pi\<bullet>y)"
   using pt at
   by (auto simp add: pt_bij perm_bool)
 
 lemma pt_bij3:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes a:  "x=y"
   shows "(pi\<bullet>x = pi\<bullet>y)"
   using a by simp 
 
 lemma pt_bij4:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "pi\<bullet>x = pi\<bullet>y"
   shows "x = y"
   using a by (simp add: pt_bij[OF pt, OF at])
 
 lemma pt_swap_bij:
   fixes a  :: "'x"
   and   b  :: "'x"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "[(a,b)]\<bullet>([(a,b)]\<bullet>x) = x"
   by (rule pt_bij2[OF pt, OF at], simp)
 
 lemma pt_swap_bij':
   fixes a  :: "'x"
   and   b  :: "'x"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "[(a,b)]\<bullet>([(b,a)]\<bullet>x) = x"
   by (metis assms at_ds5 pt_def pt_swap_bij)
 
 lemma pt_swap_bij'':
   fixes a  :: "'x"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "[(a,a)]\<bullet>x = x"
   by (metis assms at_ds1 pt_def)
 
 lemma supp_singleton:
   shows "supp {x} = supp x"
   by (force simp add: supp_def perm_set_def)
 
 lemma fresh_singleton:
   shows "a\<sharp>{x} = a\<sharp>x"
   by (simp add: fresh_def supp_singleton)
 
 lemma pt_set_bij1:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "((pi\<bullet>x)\<in>X) = (x\<in>((rev pi)\<bullet>X))"
   by (force simp add: perm_set_def pt_rev_pi[OF pt, OF at] pt_pi_rev[OF pt, OF at])
 
 lemma pt_set_bij1a:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(x\<in>(pi\<bullet>X)) = (((rev pi)\<bullet>x)\<in>X)"
   by (force simp add: perm_set_def pt_rev_pi[OF pt, OF at] pt_pi_rev[OF pt, OF at])
 
 lemma pt_set_bij:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "((pi\<bullet>x)\<in>(pi\<bullet>X)) = (x\<in>X)"
   by (simp add: perm_set_def pt_bij[OF pt, OF at])
 
 lemma pt_in_eqvt:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(x\<in>X)=((pi\<bullet>x)\<in>(pi\<bullet>X))"
 using assms
 by (auto simp add:  pt_set_bij perm_bool)
 
 lemma pt_set_bij2:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "x\<in>X"
   shows "(pi\<bullet>x)\<in>(pi\<bullet>X)"
   using a by (simp add: pt_set_bij[OF pt, OF at])
 
 lemma pt_set_bij2a:
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "x\<in>((rev pi)\<bullet>X)"
   shows "(pi\<bullet>x)\<in>X"
   using a by (simp add: pt_set_bij1[OF pt, OF at])
 
 lemma pt_subseteq_eqvt:
   fixes pi :: "'x prm"
   and   Y  :: "'a set"
   and   X  :: "'a set"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>(X\<subseteq>Y)) = ((pi\<bullet>X)\<subseteq>(pi\<bullet>Y))"
 by (auto simp add: perm_set_def perm_bool pt_bij[OF pt, OF at])
 
 lemma pt_set_diff_eqvt:
   fixes X::"'a set"
   and   Y::"'a set"
   and   pi::"'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(X - Y) = (pi\<bullet>X) - (pi\<bullet>Y)"
   by (auto simp add: perm_set_def pt_bij[OF pt, OF at])
 
 lemma pt_Collect_eqvt:
   fixes pi::"'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>{x::'a. P x} = {x. P ((rev pi)\<bullet>x)}"
 proof -
   have "\<exists>y. x = pi \<bullet> y \<and> P y"
     if "P (rev pi \<bullet> x)" for x
     using that by (metis at pt pt_pi_rev)
   then show ?thesis
     by (auto simp add: perm_set_def pt_rev_pi [OF assms])
 qed
 
 \<comment> \<open>some helper lemmas for the pt_perm_supp_ineq lemma\<close>
 lemma Collect_permI: 
   fixes pi :: "'x prm"
   and   x  :: "'a"
   assumes a: "\<forall>x. (P1 x = P2 x)" 
   shows "{pi\<bullet>x| x. P1 x} = {pi\<bullet>x| x. P2 x}"
   using a by force
 
 lemma Infinite_cong:
   assumes a: "X = Y"
   shows "infinite X = infinite Y"
   using a by (simp)
 
 lemma pt_set_eq_ineq:
   fixes pi :: "'y prm"
   assumes pt: "pt TYPE('x) TYPE('y)"
   and     at: "at TYPE('y)"
   shows "{pi\<bullet>x| x::'x. P x} = {x::'x. P ((rev pi)\<bullet>x)}"
   by (force simp only: pt_rev_pi[OF pt, OF at] pt_pi_rev[OF pt, OF at])
 
 lemma pt_inject_on_ineq:
   fixes X  :: "'y set"
   and   pi :: "'x prm"
   assumes pt: "pt TYPE('y) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "inj_on (perm pi) X"
 proof (unfold inj_on_def, intro strip)
   fix x::"'y" and y::"'y"
   assume "pi\<bullet>x = pi\<bullet>y"
   thus "x=y" by (simp add: pt_bij[OF pt, OF at])
 qed
 
 lemma pt_set_finite_ineq: 
   fixes X  :: "'x set"
   and   pi :: "'y prm"
   assumes pt: "pt TYPE('x) TYPE('y)"
   and     at: "at TYPE('y)"
   shows "finite (pi\<bullet>X) = finite X"
 proof -
   have image: "(pi\<bullet>X) = (perm pi ` X)" by (force simp only: perm_set_def)
   show ?thesis
   proof (rule iffI)
     assume "finite (pi\<bullet>X)"
     hence "finite (perm pi ` X)" using image by (simp)
     thus "finite X" using pt_inject_on_ineq[OF pt, OF at] by (rule finite_imageD)
   next
     assume "finite X"
     hence "finite (perm pi ` X)" by (rule finite_imageI)
     thus "finite (pi\<bullet>X)" using image by (simp)
   qed
 qed
 
 lemma pt_set_infinite_ineq: 
   fixes X  :: "'x set"
   and   pi :: "'y prm"
   assumes pt: "pt TYPE('x) TYPE('y)"
   and     at: "at TYPE('y)"
   shows "infinite (pi\<bullet>X) = infinite X"
 using pt at by (simp add: pt_set_finite_ineq)
 
 lemma pt_perm_supp_ineq:
   fixes  pi  :: "'x prm"
   and    x   :: "'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   shows "(pi\<bullet>((supp x)::'y set)) = supp (pi\<bullet>x)" (is "?LHS = ?RHS")
 proof -
   have "?LHS = {pi\<bullet>a | a. infinite {b. [(a,b)]\<bullet>x \<noteq> x}}" by (simp add: supp_def perm_set_def)
   also have "\<dots> = {pi\<bullet>a | a. infinite {pi\<bullet>b | b. [(a,b)]\<bullet>x \<noteq> x}}" 
   proof (rule Collect_permI, rule allI, rule iffI)
     fix a
     assume "infinite {b::'y. [(a,b)]\<bullet>x  \<noteq> x}"
     hence "infinite (pi\<bullet>{b::'y. [(a,b)]\<bullet>x \<noteq> x})" by (simp add: pt_set_infinite_ineq[OF ptb, OF at])
     thus "infinite {pi\<bullet>b |b::'y. [(a,b)]\<bullet>x  \<noteq> x}" by (simp add: perm_set_def)
   next
     fix a
     assume "infinite {pi\<bullet>b |b::'y. [(a,b)]\<bullet>x \<noteq> x}"
     hence "infinite (pi\<bullet>{b::'y. [(a,b)]\<bullet>x \<noteq> x})" by (simp add: perm_set_def)
     thus "infinite {b::'y. [(a,b)]\<bullet>x  \<noteq> x}" 
       by (simp add: pt_set_infinite_ineq[OF ptb, OF at])
   qed
   also have "\<dots> = {a. infinite {b::'y. [((rev pi)\<bullet>a,(rev pi)\<bullet>b)]\<bullet>x \<noteq> x}}" 
     by (simp add: pt_set_eq_ineq[OF ptb, OF at])
   also have "\<dots> = {a. infinite {b. pi\<bullet>([((rev pi)\<bullet>a,(rev pi)\<bullet>b)]\<bullet>x) \<noteq> (pi\<bullet>x)}}"
     by (simp add: pt_bij[OF pta, OF at])
   also have "\<dots> = {a. infinite {b. [(a,b)]\<bullet>(pi\<bullet>x) \<noteq> (pi\<bullet>x)}}"
   proof (rule Collect_cong, rule Infinite_cong, rule Collect_cong)
     fix a::"'y" and b::"'y"
     have "pi\<bullet>(([((rev pi)\<bullet>a,(rev pi)\<bullet>b)])\<bullet>x) = [(a,b)]\<bullet>(pi\<bullet>x)"
       by (simp add: cp1[OF cp] pt_pi_rev[OF ptb, OF at])
     thus "(pi\<bullet>([((rev pi)\<bullet>a,(rev pi)\<bullet>b)]\<bullet>x) \<noteq>  pi\<bullet>x) = ([(a,b)]\<bullet>(pi\<bullet>x) \<noteq> pi\<bullet>x)" by simp
   qed
   finally show "?LHS = ?RHS" by (simp add: supp_def) 
 qed
 
 lemma pt_perm_supp:
   fixes  pi  :: "'x prm"
   and    x   :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>((supp x)::'x set)) = supp (pi\<bullet>x)"
   by (rule pt_perm_supp_ineq) (auto simp: assms at_pt_inst cp_pt_inst)
 
 lemma pt_supp_finite_pi:
   fixes  pi  :: "'x prm"
   and    x   :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     f: "finite ((supp x)::'x set)"
   shows "finite ((supp (pi\<bullet>x))::'x set)"
   by (metis at at_pt_inst f pt pt_perm_supp pt_set_finite_ineq)
 
 lemma pt_fresh_left_ineq:  
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'y"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   shows "a\<sharp>(pi\<bullet>x) = ((rev pi)\<bullet>a)\<sharp>x"
   using pt_perm_supp_ineq[OF pta, OF ptb, OF at, OF cp] pt_set_bij1[OF ptb, OF at]
   by (simp add: fresh_def)
 
 lemma pt_fresh_right_ineq:  
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'y"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   shows "(pi\<bullet>a)\<sharp>x = a\<sharp>((rev pi)\<bullet>x)"
   by (simp add: assms pt_fresh_left_ineq)
 
 lemma pt_fresh_bij_ineq:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'y"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   shows "(pi\<bullet>a)\<sharp>(pi\<bullet>x) = a\<sharp>x"
   using assms pt_bij1 pt_fresh_right_ineq by fastforce
 
 lemma pt_fresh_left:  
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "a\<sharp>(pi\<bullet>x) = ((rev pi)\<bullet>a)\<sharp>x"
   by (simp add: assms at_pt_inst cp_pt_inst pt_fresh_left_ineq)
 
 lemma pt_fresh_right:  
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>a)\<sharp>x = a\<sharp>((rev pi)\<bullet>x)"
   by (simp add: assms at_pt_inst cp_pt_inst pt_fresh_right_ineq)
 
 lemma pt_fresh_bij:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>a)\<sharp>(pi\<bullet>x) = a\<sharp>x"
   by (metis assms pt_bij1 pt_fresh_right)
 
 lemma pt_fresh_bij1:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "a\<sharp>x"
   shows "(pi\<bullet>a)\<sharp>(pi\<bullet>x)"
 using a by (simp add: pt_fresh_bij[OF pt, OF at])
 
 lemma pt_fresh_bij2:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a:  "(pi\<bullet>a)\<sharp>(pi\<bullet>x)"
   shows  "a\<sharp>x"
 using a by (simp add: pt_fresh_bij[OF pt, OF at])
 
 lemma pt_fresh_eqvt:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(a\<sharp>x) = (pi\<bullet>a)\<sharp>(pi\<bullet>x)"
   by (simp add: perm_bool pt_fresh_bij[OF pt, OF at])
 
 lemma pt_perm_fresh1:
   fixes a :: "'x"
   and   b :: "'x"
   and   x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE ('x)"
   and     a1: "\<not>(a\<sharp>x)"
   and     a2: "b\<sharp>x"
   shows "[(a,b)]\<bullet>x \<noteq> x"
 proof
   assume neg: "[(a,b)]\<bullet>x = x"
   from a1 have a1':"a\<in>(supp x)" by (simp add: fresh_def) 
   from a2 have a2':"b\<notin>(supp x)" by (simp add: fresh_def) 
   from a1' a2' have a3: "a\<noteq>b" by force
   from a1' have "([(a,b)]\<bullet>a)\<in>([(a,b)]\<bullet>(supp x))" 
     by (simp only: pt_set_bij[OF at_pt_inst[OF at], OF at])
   hence "b\<in>([(a,b)]\<bullet>(supp x))" by (simp add: at_calc[OF at])
   hence "b\<in>(supp ([(a,b)]\<bullet>x))" by (simp add: pt_perm_supp[OF pt,OF at])
   with a2' neg show False by simp
 qed
 
 (* the next two lemmas are needed in the proof *)
 (* of the structural induction principle       *)
 lemma pt_fresh_aux:
   fixes a::"'x"
   and   b::"'x"
   and   c::"'x"
   and   x::"'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE ('x)"
   assumes a1: "c\<noteq>a" and  a2: "a\<sharp>x" and a3: "c\<sharp>x"
   shows "c\<sharp>([(a,b)]\<bullet>x)"
 using a1 a2 a3 by (simp_all add: pt_fresh_left[OF pt, OF at] at_calc[OF at])
 
 lemma pt_fresh_perm_app:
   fixes pi :: "'x prm" 
   and   a  :: "'x"
   and   x  :: "'y"
   assumes pt: "pt TYPE('y) TYPE('x)"
   and     at: "at TYPE('x)"
   and     h1: "a\<sharp>pi"
   and     h2: "a\<sharp>x"
   shows "a\<sharp>(pi\<bullet>x)"
 using assms
 proof -
   have "a\<sharp>(rev pi)"using h1 by (simp add: fresh_list_rev)
   then have "(rev pi)\<bullet>a = a" by (simp add: at_prm_fresh[OF at])
   then have "((rev pi)\<bullet>a)\<sharp>x" using h2 by simp
   thus "a\<sharp>(pi\<bullet>x)"  by (simp add: pt_fresh_right[OF pt, OF at])
 qed
 
 lemma pt_fresh_perm_app_ineq:
   fixes pi::"'x prm"
   and   c::"'y"
   and   x::"'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   and     dj:  "disjoint TYPE('y) TYPE('x)"
   assumes a: "c\<sharp>x"
   shows "c\<sharp>(pi\<bullet>x)"
 using a by (simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj])
 
 lemma pt_fresh_eqvt_ineq:
   fixes pi::"'x prm"
   and   c::"'y"
   and   x::"'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   and     dj:  "disjoint TYPE('y) TYPE('x)"
   shows "pi\<bullet>(c\<sharp>x) = (pi\<bullet>c)\<sharp>(pi\<bullet>x)"
 by (simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
 
 \<comment> \<open>the co-set of a finite set is infinte\<close>
 lemma finite_infinite:
   assumes a: "finite {b::'x. P b}"
   and     b: "infinite (UNIV::'x set)"        
   shows "infinite {b. \<not>P b}"
 proof -
   from a b have "infinite (UNIV - {b::'x. P b})" by (simp add: Diff_infinite_finite)
   moreover 
   have "{b::'x. \<not>P b} = UNIV - {b::'x. P b}" by auto
   ultimately show "infinite {b::'x. \<not>P b}" by simp
 qed 
 
 lemma pt_fresh_fresh:
   fixes   x :: "'a"
   and     a :: "'x"
   and     b :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE ('x)"
   and     a1: "a\<sharp>x" and a2: "b\<sharp>x" 
   shows "[(a,b)]\<bullet>x=x"
 proof (cases "a=b")
   assume "a=b"
   hence "[(a,b)] \<triangleq> []" by (simp add: at_ds1[OF at])
   hence "[(a,b)]\<bullet>x=([]::'x prm)\<bullet>x" by (rule pt3[OF pt])
   thus ?thesis by (simp only: pt1[OF pt])
 next
   assume c2: "a\<noteq>b"
   from a1 have f1: "finite {c. [(a,c)]\<bullet>x \<noteq> x}" by (simp add: fresh_def supp_def)
   from a2 have f2: "finite {c. [(b,c)]\<bullet>x \<noteq> x}" by (simp add: fresh_def supp_def)
   from f1 and f2 have f3: "finite {c. perm [(a,c)] x \<noteq> x \<or> perm [(b,c)] x \<noteq> x}" 
     by (force simp only: Collect_disj_eq)
   have "infinite {c. [(a,c)]\<bullet>x = x \<and> [(b,c)]\<bullet>x = x}" 
     by (simp add: finite_infinite[OF f3,OF at4[OF at], simplified])
   hence "infinite ({c. [(a,c)]\<bullet>x = x \<and> [(b,c)]\<bullet>x = x}-{a,b})" 
     by (force dest: Diff_infinite_finite)
   hence "({c. [(a,c)]\<bullet>x = x \<and> [(b,c)]\<bullet>x = x}-{a,b}) \<noteq> {}"
     by (metis finite_set set_empty2)
   hence "\<exists>c. c\<in>({c. [(a,c)]\<bullet>x = x \<and> [(b,c)]\<bullet>x = x}-{a,b})" by (force)
   then obtain c 
     where eq1: "[(a,c)]\<bullet>x = x" 
       and eq2: "[(b,c)]\<bullet>x = x" 
       and ineq: "a\<noteq>c \<and> b\<noteq>c"
     by (force)
   hence "[(a,c)]\<bullet>([(b,c)]\<bullet>([(a,c)]\<bullet>x)) = x" by simp 
   hence eq3: "[(a,c),(b,c),(a,c)]\<bullet>x = x" by (simp add: pt2[OF pt,symmetric])
   from c2 ineq have "[(a,c),(b,c),(a,c)] \<triangleq> [(a,b)]" by (simp add: at_ds3[OF at])
   hence "[(a,c),(b,c),(a,c)]\<bullet>x = [(a,b)]\<bullet>x" by (rule pt3[OF pt])
   thus ?thesis using eq3 by simp
 qed
 
 lemma pt_pi_fresh_fresh:
   fixes   x :: "'a"
   and     pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE ('x)"
   and     a:  "\<forall>(a,b)\<in>set pi. a\<sharp>x \<and> b\<sharp>x" 
   shows "pi\<bullet>x=x"
 using a
 proof (induct pi)
   case Nil
   show "([]::'x prm)\<bullet>x = x" by (rule pt1[OF pt])
 next
   case (Cons ab pi)
   have a: "\<forall>(a,b)\<in>set (ab#pi). a\<sharp>x \<and> b\<sharp>x" by fact
   have ih: "(\<forall>(a,b)\<in>set pi. a\<sharp>x \<and> b\<sharp>x) \<Longrightarrow> pi\<bullet>x=x" by fact
   obtain a b where e: "ab=(a,b)" by (cases ab) (auto)
   from a have a': "a\<sharp>x" "b\<sharp>x" using e by auto
   have "(ab#pi)\<bullet>x = ([(a,b)]@pi)\<bullet>x" using e by simp
   also have "\<dots> = [(a,b)]\<bullet>(pi\<bullet>x)" by (simp only: pt2[OF pt])
   also have "\<dots> = [(a,b)]\<bullet>x" using ih a by simp
   also have "\<dots> = x" using a' by (simp add: pt_fresh_fresh[OF pt, OF at])
   finally show "(ab#pi)\<bullet>x = x" by simp
 qed
 
 lemma pt_perm_compose:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi2\<bullet>(pi1\<bullet>x) = (pi2\<bullet>pi1)\<bullet>(pi2\<bullet>x)" 
 proof -
   have "(pi2@pi1) \<triangleq> ((pi2\<bullet>pi1)@pi2)" by (rule at_ds8 [OF at])
   hence "(pi2@pi1)\<bullet>x = ((pi2\<bullet>pi1)@pi2)\<bullet>x" by (rule pt3[OF pt])
   thus ?thesis by (simp add: pt2[OF pt])
 qed
 
 lemma pt_perm_compose':
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi2\<bullet>pi1)\<bullet>x = pi2\<bullet>(pi1\<bullet>((rev pi2)\<bullet>x))" 
 proof -
   have "pi2\<bullet>(pi1\<bullet>((rev pi2)\<bullet>x)) = (pi2\<bullet>pi1)\<bullet>(pi2\<bullet>((rev pi2)\<bullet>x))"
     by (rule pt_perm_compose[OF pt, OF at])
   also have "\<dots> = (pi2\<bullet>pi1)\<bullet>x" by (simp add: pt_pi_rev[OF pt, OF at])
   finally have "pi2\<bullet>(pi1\<bullet>((rev pi2)\<bullet>x)) = (pi2\<bullet>pi1)\<bullet>x" by simp
   thus ?thesis by simp
 qed
 
 lemma pt_perm_compose_rev:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(rev pi2)\<bullet>((rev pi1)\<bullet>x) = (rev pi1)\<bullet>(rev (pi1\<bullet>pi2)\<bullet>x)" 
 proof -
   have "((rev pi2)@(rev pi1)) \<triangleq> ((rev pi1)@(rev (pi1\<bullet>pi2)))" by (rule at_ds9[OF at])
   hence "((rev pi2)@(rev pi1))\<bullet>x = ((rev pi1)@(rev (pi1\<bullet>pi2)))\<bullet>x" by (rule pt3[OF pt])
   thus ?thesis by (simp add: pt2[OF pt])
 qed
 
 section \<open>equivariance for some connectives\<close>
 lemma pt_all_eqvt:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(\<forall>(x::'a). P x) = (\<forall>(x::'a). pi\<bullet>(P ((rev pi)\<bullet>x)))"
   by (smt (verit, ccfv_threshold) assms pt_bij1 true_eqvt)
 
 lemma pt_ex_eqvt:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
 shows "pi\<bullet>(\<exists>(x::'a). P x) = (\<exists>(x::'a). pi\<bullet>(P ((rev pi)\<bullet>x)))"
 proof -
   have "\<And>x. P x \<Longrightarrow> P (rev pi \<bullet> pi \<bullet> x)"
     by (simp add: assms(1) at pt_rev_pi)
   then show ?thesis
     by(auto simp add: perm_bool perm_fun_def)
 qed
 
 lemma pt_ex1_eqvt:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows  "(pi\<bullet>(\<exists>!x. P (x::'a))) = (\<exists>!x. pi\<bullet>(P (rev pi\<bullet>x)))"
 unfolding Ex1_def
 by (simp add: pt_ex_eqvt[OF pt at] conj_eqvt pt_all_eqvt[OF pt at] 
               imp_eqvt pt_eq_eqvt[OF pt at] pt_pi_rev[OF pt at])
 
 lemma pt_the_eqvt:
   fixes  pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     unique: "\<exists>!x. P x"
   shows "pi\<bullet>(THE(x::'a). P x) = (THE(x::'a). pi\<bullet>(P ((rev pi)\<bullet>x)))"
   by (smt (verit, best) assms perm_bool_def pt_rev_pi theI_unique unique)
 
 section \<open>facts about supports\<close>
 (*==============================*)
 
 lemma supports_subset:
   fixes x  :: "'a"
   and   S1 :: "'x set"
   and   S2 :: "'x set"
   assumes  a: "S1 supports x"
   and      b: "S1 \<subseteq> S2"
   shows "S2 supports x"
   using a b
   by (force simp add: supports_def)
 
 lemma supp_is_subset:
   fixes S :: "'x set"
   and   x :: "'a"
   assumes a1: "S supports x"
   and     a2: "finite S"
   shows "(supp x)\<subseteq>S"
 proof (rule ccontr)
   assume "\<not>(supp x \<subseteq> S)"
   hence "\<exists>a. a\<in>(supp x) \<and> a\<notin>S" by force
   then obtain a where b1: "a\<in>supp x" and b2: "a\<notin>S" by force
   from a1 b2 have "\<forall>b. (b\<notin>S \<longrightarrow> ([(a,b)]\<bullet>x = x))" by (unfold supports_def, force)
   hence "{b. [(a,b)]\<bullet>x \<noteq> x}\<subseteq>S" by force
   with a2 have "finite {b. [(a,b)]\<bullet>x \<noteq> x}" by (simp add: finite_subset)
   hence "a\<notin>(supp x)" by (unfold supp_def, auto)
   with b1 show False by simp
 qed
 
 lemma supp_supports:
   fixes x :: "'a"
   assumes  pt: "pt TYPE('a) TYPE('x)"
   and      at: "at TYPE ('x)"
   shows "((supp x)::'x set) supports x"
 proof (unfold supports_def, intro strip)
   fix a b
   assume "(a::'x)\<notin>(supp x) \<and> (b::'x)\<notin>(supp x)"
   hence "a\<sharp>x" and "b\<sharp>x" by (auto simp add: fresh_def)
   thus "[(a,b)]\<bullet>x = x" by (rule pt_fresh_fresh[OF pt, OF at])
 qed
 
 lemma supports_finite:
   fixes S :: "'x set"
   and   x :: "'a"
   assumes a1: "S supports x"
   and     a2: "finite S"
   shows "finite ((supp x)::'x set)"
 proof -
   have "(supp x)\<subseteq>S" using a1 a2 by (rule supp_is_subset)
   thus ?thesis using a2 by (simp add: finite_subset)
 qed
   
 lemma supp_is_inter:
   fixes  x :: "'a"
   assumes  pt: "pt TYPE('a) TYPE('x)"
   and      at: "at TYPE ('x)"
   and      fs: "fs TYPE('a) TYPE('x)"
   shows "((supp x)::'x set) = (\<Inter>{S. finite S \<and> S supports x})"
 proof (rule equalityI)
   show "((supp x)::'x set) \<subseteq> (\<Inter>{S. finite S \<and> S supports x})"
   proof (clarify)
     fix S c
     assume b: "c\<in>((supp x)::'x set)" and "finite (S::'x set)" and "S supports x"
     hence  "((supp x)::'x set)\<subseteq>S" by (simp add: supp_is_subset) 
     with b show "c\<in>S" by force
   qed
 next
   show "(\<Inter>{S. finite S \<and> S supports x}) \<subseteq> ((supp x)::'x set)"
   proof (clarify, simp)
     fix c
     assume d: "\<forall>(S::'x set). finite S \<and> S supports x \<longrightarrow> c\<in>S"
     have "((supp x)::'x set) supports x" by (rule supp_supports[OF pt, OF at])
     with d fs1[OF fs] show "c\<in>supp x" by force
   qed
 qed
     
 lemma supp_is_least_supports:
   fixes S :: "'x set"
   and   x :: "'a"
   assumes  pt: "pt TYPE('a) TYPE('x)"
   and      at: "at TYPE ('x)"
   and      a1: "S supports x"
   and      a2: "finite S"
   and      a3: "\<forall>S'. (S' supports x) \<longrightarrow> S\<subseteq>S'"
   shows "S = (supp x)"
 proof (rule equalityI)
   show "((supp x)::'x set)\<subseteq>S" using a1 a2 by (rule supp_is_subset)
 next
   have "((supp x)::'x set) supports x" by (rule supp_supports[OF pt, OF at])
   with a3 show "S\<subseteq>supp x" by force
 qed
 
 lemma supports_set:
   fixes S :: "'x set"
   and   X :: "'a set"
   assumes  pt: "pt TYPE('a) TYPE('x)"
   and      at: "at TYPE ('x)"
   and      a: "\<forall>x\<in>X. (\<forall>(a::'x) (b::'x). a\<notin>S\<and>b\<notin>S \<longrightarrow> ([(a,b)]\<bullet>x)\<in>X)"
 shows  "S supports X"
 proof -
   have "x \<in> X"
     if "a \<notin> S" "b \<notin> S" and "x \<in> [(a, b)] \<bullet> X" for a b x
     using that by (metis a assms(1) at pt_pi_rev pt_set_bij1a)
   moreover have "x \<in> [(a, b)] \<bullet> X"
     if "a \<notin> S" "b \<notin> S" and "x \<in> X" for a b x
     using that by (simp add: a assms(1) at pt_set_bij1a)
   ultimately show ?thesis
     by (meson subsetI subset_antisym supports_def)
 qed
 
 lemma supports_fresh:
   fixes S :: "'x set"
   and   a :: "'x"
   and   x :: "'a"
   assumes a1: "S supports x"
   and     a2: "finite S"
   and     a3: "a\<notin>S"
   shows "a\<sharp>x"
   by (meson assms fresh_def in_mono supp_is_subset)
 
 lemma at_fin_set_supports:
   fixes X::"'x set"
   assumes at: "at TYPE('x)"
   shows "X supports X"
 proof -
   have "\<forall>a b. a\<notin>X \<and> b\<notin>X \<longrightarrow> [(a,b)]\<bullet>X = X"
     by (auto simp add: perm_set_def at_calc[OF at])
   then show ?thesis by (simp add: supports_def)
 qed
 
 lemma infinite_Collection:
   assumes a1:"infinite X"
   and     a2:"\<forall>b\<in>X. P(b)"
   shows "infinite {b\<in>X. P(b)}"
   using assms rev_finite_subset by fastforce
 
 lemma at_fin_set_supp:
   fixes X::"'x set" 
   assumes at: "at TYPE('x)"
   and     fs: "finite X"
   shows "(supp X) = X"
 proof (rule subset_antisym)
   show "(supp X) \<subseteq> X" using at_fin_set_supports[OF at] using fs by (simp add: supp_is_subset)
 next
   have inf: "infinite (UNIV-X)" using at4[OF at] fs by (auto simp add: Diff_infinite_finite)
   { fix a::"'x"
     assume asm: "a\<in>X"
     hence "\<forall>b\<in>(UNIV-X). [(a,b)]\<bullet>X\<noteq>X"
       by (auto simp add: perm_set_def at_calc[OF at])
     with inf have "infinite {b\<in>(UNIV-X). [(a,b)]\<bullet>X\<noteq>X}" by (rule infinite_Collection)
     hence "infinite {b. [(a,b)]\<bullet>X\<noteq>X}" by (rule_tac infinite_super, auto)
     hence "a\<in>(supp X)" by (simp add: supp_def)
   }
   then show "X\<subseteq>(supp X)" by blast
 qed
 
 lemma at_fin_set_fresh:
   fixes X::"'x set" 
   assumes at: "at TYPE('x)"
   and     fs: "finite X"
   shows "(x \<sharp> X) = (x \<notin> X)"
   by (simp add: at_fin_set_supp fresh_def at fs)
 
 
 section \<open>Permutations acting on Functions\<close>
 (*==========================================*)
 
 lemma pt_fun_app_eq:
   fixes f  :: "'a\<Rightarrow>'b"
   and   x  :: "'a"
   and   pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(f x) = (pi\<bullet>f)(pi\<bullet>x)"
   by (simp add: perm_fun_def pt_rev_pi[OF pt, OF at])
 
 
 \<comment> \<open>sometimes pt_fun_app_eq does too much; this lemma 'corrects it'\<close>
 lemma pt_perm:
   fixes x  :: "'a"
   and   pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE ('x)"
   shows "(pi1\<bullet>perm pi2)(pi1\<bullet>x) = pi1\<bullet>(pi2\<bullet>x)" 
   by (simp add: pt_fun_app_eq[OF pt, OF at])
 
 
 lemma pt_fun_eq:
   fixes f  :: "'a\<Rightarrow>'b"
   and   pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>f = f) = (\<forall> x. pi\<bullet>(f x) = f (pi\<bullet>x))" (is "?LHS = ?RHS")
 proof
   assume a: "?LHS"
   show "?RHS"
   proof
     fix x
     have "pi\<bullet>(f x) = (pi\<bullet>f)(pi\<bullet>x)" by (simp add: pt_fun_app_eq[OF pt, OF at])
     also have "\<dots> = f (pi\<bullet>x)" using a by simp
     finally show "pi\<bullet>(f x) = f (pi\<bullet>x)" by simp
   qed
 next
   assume b: "?RHS"
   show "?LHS"
   proof (rule ccontr)
     assume "(pi\<bullet>f) \<noteq> f"
     hence "\<exists>x. (pi\<bullet>f) x \<noteq> f x" by (simp add: fun_eq_iff)
     then obtain x where b1: "(pi\<bullet>f) x \<noteq> f x" by force
     from b have "pi\<bullet>(f ((rev pi)\<bullet>x)) = f (pi\<bullet>((rev pi)\<bullet>x))" by force
     hence "(pi\<bullet>f)(pi\<bullet>((rev pi)\<bullet>x)) = f (pi\<bullet>((rev pi)\<bullet>x))" 
       by (simp add: pt_fun_app_eq[OF pt, OF at])
     hence "(pi\<bullet>f) x = f x" by (simp add: pt_pi_rev[OF pt, OF at])
     with b1 show "False" by simp
   qed
 qed
 
 \<comment> \<open>two helper lemmas for the equivariance of functions\<close>
 lemma pt_swap_eq_aux:
   fixes   y :: "'a"
   and    pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     a: "\<forall>(a::'x) (b::'x). [(a,b)]\<bullet>y = y"
   shows "pi\<bullet>y = y"
 proof(induct pi)
   case Nil show ?case by (simp add: pt1[OF pt])
 next
   case (Cons x xs)
   have ih: "xs\<bullet>y = y" by fact
   obtain a b where p: "x=(a,b)" by force
   have "((a,b)#xs)\<bullet>y = ([(a,b)]@xs)\<bullet>y" by simp
   also have "\<dots> = [(a,b)]\<bullet>(xs\<bullet>y)" by (simp only: pt2[OF pt])
   finally show ?case using a ih p by simp
 qed
 
 lemma pt_swap_eq:
   fixes   y :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   shows "(\<forall>(a::'x) (b::'x). [(a,b)]\<bullet>y = y) = (\<forall>pi::'x prm. pi\<bullet>y = y)"
   by (force intro: pt_swap_eq_aux[OF pt])
 
 lemma pt_eqvt_fun1a:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     a:   "((supp f)::'x set)={}"
   shows "\<forall>(pi::'x prm). pi\<bullet>f = f" 
 proof (intro strip)
   fix pi
   have "\<forall>a b. a\<notin>((supp f)::'x set) \<and> b\<notin>((supp f)::'x set) \<longrightarrow> (([(a,b)]\<bullet>f) = f)" 
     by (intro strip, fold fresh_def, 
       simp add: pt_fresh_fresh[OF pt_fun_inst[OF pta, OF ptb, OF at],OF at])
   with a have "\<forall>(a::'x) (b::'x). ([(a,b)]\<bullet>f) = f" by force
   hence "\<forall>(pi::'x prm). pi\<bullet>f = f" 
     by (simp add: pt_swap_eq[OF pt_fun_inst[OF pta, OF ptb, OF at]])
   thus "(pi::'x prm)\<bullet>f = f" by simp
 qed
 
 lemma pt_eqvt_fun1b:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes a: "\<forall>(pi::'x prm). pi\<bullet>f = f"
   shows "((supp f)::'x set)={}"
 using a by (simp add: supp_def)
 
 lemma pt_eqvt_fun1:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(((supp f)::'x set)={}) = (\<forall>(pi::'x prm). pi\<bullet>f = f)" (is "?LHS = ?RHS")
 by (rule iffI, simp add: pt_eqvt_fun1a[OF pta, OF ptb, OF at], simp add: pt_eqvt_fun1b)
 
 lemma pt_eqvt_fun2a:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at: "at TYPE('x)"
   assumes a: "((supp f)::'x set)={}"
   shows "\<forall>(pi::'x prm) (x::'a). pi\<bullet>(f x) = f(pi\<bullet>x)" 
 proof (intro strip)
   fix pi x
   from a have b: "\<forall>(pi::'x prm). pi\<bullet>f = f" by (simp add: pt_eqvt_fun1[OF pta, OF ptb, OF at]) 
   have "(pi::'x prm)\<bullet>(f x) = (pi\<bullet>f)(pi\<bullet>x)" by (simp add: pt_fun_app_eq[OF pta, OF at]) 
   with b show "(pi::'x prm)\<bullet>(f x) = f (pi\<bullet>x)" by force 
 qed
 
 lemma pt_eqvt_fun2b:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes pt1: "pt TYPE('a) TYPE('x)"
   and     pt2: "pt TYPE('b) TYPE('x)"
   and     at: "at TYPE('x)"
   assumes a: "\<forall>(pi::'x prm) (x::'a). pi\<bullet>(f x) = f(pi\<bullet>x)"
   shows "((supp f)::'x set)={}"
 proof -
   from a have "\<forall>(pi::'x prm). pi\<bullet>f = f" by (simp add: pt_fun_eq[OF pt1, OF at, symmetric])
   thus ?thesis by (simp add: supp_def)
 qed
 
 lemma pt_eqvt_fun2:
   fixes f     :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(((supp f)::'x set)={}) = (\<forall>(pi::'x prm) (x::'a). pi\<bullet>(f x) = f(pi\<bullet>x))" 
 by (rule iffI, 
     simp add: pt_eqvt_fun2a[OF pta, OF ptb, OF at], 
     simp add: pt_eqvt_fun2b[OF pta, OF ptb, OF at])
 
 lemma pt_supp_fun_subset:
   fixes f :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at: "at TYPE('x)" 
   and     f1: "finite ((supp f)::'x set)"
   and     f2: "finite ((supp x)::'x set)"
   shows "supp (f x) \<subseteq> (((supp f)\<union>(supp x))::'x set)"
 proof -
   have s1: "((supp f)\<union>((supp x)::'x set)) supports (f x)"
   proof (simp add: supports_def, fold fresh_def, auto)
     fix a::"'x" and b::"'x"
     assume "a\<sharp>f" and "b\<sharp>f"
     hence a1: "[(a,b)]\<bullet>f = f" 
       by (rule pt_fresh_fresh[OF pt_fun_inst[OF pta, OF ptb, OF at], OF at])
     assume "a\<sharp>x" and "b\<sharp>x"
     hence a2: "[(a,b)]\<bullet>x = x" by (rule pt_fresh_fresh[OF pta, OF at])
     from a1 a2 show "[(a,b)]\<bullet>(f x) = (f x)" by (simp add: pt_fun_app_eq[OF pta, OF at])
   qed
   from f1 f2 have "finite ((supp f)\<union>((supp x)::'x set))" by force
   with s1 show ?thesis by (rule supp_is_subset)
 qed
       
 lemma pt_empty_supp_fun_subset:
   fixes f :: "'a\<Rightarrow>'b"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('b) TYPE('x)"
   and     at:  "at TYPE('x)" 
   and     e:   "(supp f)=({}::'x set)"
   shows "supp (f x) \<subseteq> ((supp x)::'x set)"
 proof (unfold supp_def, auto)
   fix a::"'x"
   assume a1: "finite {b. [(a, b)]\<bullet>x \<noteq> x}"
   assume "infinite {b. [(a, b)]\<bullet>(f x) \<noteq> f x}"
   hence a2: "infinite {b. f ([(a, b)]\<bullet>x) \<noteq> f x}" using e
     by (simp add: pt_eqvt_fun2[OF pta, OF ptb, OF at])
   have a3: "{b. f ([(a,b)]\<bullet>x) \<noteq> f x}\<subseteq>{b. [(a,b)]\<bullet>x \<noteq> x}" by force
   from a1 a2 a3 show False by (force dest: finite_subset)
 qed
 
 section \<open>Facts about the support of finite sets of finitely supported things\<close>
 (*=============================================================================*)
 
 definition X_to_Un_supp :: "('a set) \<Rightarrow> 'x set" where
   "X_to_Un_supp X \<equiv> \<Union>x\<in>X. ((supp x)::'x set)"
 
 lemma UNION_f_eqvt:
   fixes X::"('a set)"
   and   f::"'a \<Rightarrow> 'x set"
   and   pi::"'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(\<Union>x\<in>X. f x) = (\<Union>x\<in>(pi\<bullet>X). (pi\<bullet>f) x)"
 proof -
   have pt_x: "pt TYPE('x) TYPE('x)" by (force intro: at_pt_inst at)
   show ?thesis
   proof -
     have "\<exists>x. (\<exists>u. x = pi \<bullet> u \<and> u \<in> X) \<and> pi \<bullet> z \<in> (pi \<bullet> f) x"
       if "y \<in> X" and "z \<in> f y" for y z
       using that by (metis assms at_pt_inst pt_fun_app_eq pt_set_bij)
     moreover have "\<exists>u. x = pi \<bullet> u \<and> (\<exists>x\<in>X. u \<in> f x)"
       if "x \<in> (pi \<bullet> f) (pi \<bullet> y)" and "y \<in> X" for x y
       using that by (metis at at_pi_rev pt pt_fun_app_eq pt_set_bij1a pt_x)
     ultimately show ?thesis
       by (auto simp: perm_set_def)
   qed
 qed
 
 lemma X_to_Un_supp_eqvt:
   fixes X::"('a set)"
   and   pi::"'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(X_to_Un_supp X) = ((X_to_Un_supp (pi\<bullet>X))::'x set)"
   by (metis UNION_f_eqvt X_to_Un_supp_def assms pt_fun_eq pt_perm_supp)
 
 lemma Union_supports_set:
   fixes X::"('a set)"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(\<Union>x\<in>X. ((supp x)::'x set)) supports X"
   by (simp add: assms fresh_def pt_fresh_fresh supports_set)
 
 lemma Union_of_fin_supp_sets:
   fixes X::"('a set)"
   assumes fs: "fs TYPE('a) TYPE('x)" 
   and     fi: "finite X"   
   shows "finite (\<Union>x\<in>X. ((supp x)::'x set))"
 using fi by (induct, auto simp add: fs1[OF fs])
 
 lemma Union_included_in_supp:
   fixes X::"('a set)"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     fi: "finite X"
   shows "(\<Union>x\<in>X. ((supp x)::'x set)) \<subseteq> supp X"
 proof -
   have "supp ((X_to_Un_supp X)::'x set) \<subseteq> ((supp X)::'x set)"  
   proof (rule pt_empty_supp_fun_subset)
     show "supp (\<lambda>a. X_to_Un_supp (a::'a set)::'x set) = ({}::'x set)"
     by (simp add: X_to_Un_supp_eqvt at at_pt_inst pt pt_eqvt_fun2b pt_set_inst)
   qed (use assms at_pt_inst pt_set_inst in auto)
   hence "supp (\<Union>x\<in>X. ((supp x)::'x set)) \<subseteq> ((supp X)::'x set)" by (simp add: X_to_Un_supp_def)
   moreover
   have "supp (\<Union>x\<in>X. ((supp x)::'x set)) = (\<Union>x\<in>X. ((supp x)::'x set))"
     using Union_of_fin_supp_sets at at_fin_set_supp fi fs by auto
   ultimately show ?thesis by force
 qed
 
 lemma supp_of_fin_sets:
   fixes X::"('a set)"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     fi: "finite X"
   shows "(supp X) = (\<Union>x\<in>X. ((supp x)::'x set))"
 proof (rule equalityI)
   have "finite (\<Union> (supp ` X)::'x set)"
     using Union_of_fin_supp_sets fi fs by blast
   then show "(supp X::'x set) \<subseteq> \<Union> (supp ` X)"
     by (metis Union_supports_set at pt supp_is_subset)
 next
   show "(\<Union>x\<in>X. (supp x::'x set)) \<subseteq> supp X"
     by (simp add: Union_included_in_supp at fi fs pt)
 qed
 
 lemma supp_fin_union:
   fixes X::"('a set)"
   and   Y::"('a set)"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     f1: "finite X"
   and     f2: "finite Y"
   shows "(supp (X\<union>Y)) = (supp X)\<union>((supp Y)::'x set)"
 using f1 f2 by (force simp add: supp_of_fin_sets[OF pt, OF at, OF fs])
 
 lemma supp_fin_insert:
   fixes X::"('a set)"
   and   x::"'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     f:  "finite X"
   shows "(supp (insert x X)) = (supp x)\<union>((supp X)::'x set)"
 proof -
   have "(supp (insert x X)) = ((supp ({x}\<union>(X::'a set)))::'x set)" by simp
   also have "\<dots> = (supp {x})\<union>(supp X)"
     by (rule supp_fin_union[OF pt, OF at, OF fs], simp_all add: f)
   finally show "(supp (insert x X)) = (supp x)\<union>((supp X)::'x set)" 
     by (simp add: supp_singleton)
 qed
 
 lemma fresh_fin_union:
   fixes X::"('a set)"
   and   Y::"('a set)"
   and   a::"'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     f1: "finite X"
   and     f2: "finite Y"
   shows "a\<sharp>(X\<union>Y) = (a\<sharp>X \<and> a\<sharp>Y)"
   by (simp add: assms fresh_def supp_fin_union)
 
 lemma fresh_fin_insert:
   fixes X::"('a set)"
   and   x::"'a"
   and   a::"'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     f:  "finite X"
   shows "a\<sharp>(insert x X) = (a\<sharp>x \<and> a\<sharp>X)"
   by (simp add: assms fresh_def supp_fin_insert)
 
 lemma fresh_fin_insert1:
   fixes X::"('a set)"
   and   x::"'a"
   and   a::"'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)" 
   and     f:  "finite X"
   and     a1:  "a\<sharp>x"
   and     a2:  "a\<sharp>X"
   shows "a\<sharp>(insert x X)"
   using a1 a2
   by (simp add: fresh_fin_insert[OF pt, OF at, OF fs, OF f])
 
 lemma pt_list_set_supp:
   fixes xs :: "'a list"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)"
   shows "supp (set xs) = ((supp xs)::'x set)"
 proof -
   have "supp (set xs) = (\<Union>x\<in>(set xs). ((supp x)::'x set))"
     by (rule supp_of_fin_sets[OF pt, OF at, OF fs], rule finite_set)
   also have "(\<Union>x\<in>(set xs). ((supp x)::'x set)) = (supp xs)"
   proof(induct xs)
     case Nil show ?case by (simp add: supp_list_nil)
   next
     case (Cons h t) thus ?case by (simp add: supp_list_cons)
   qed
   finally show ?thesis by simp
 qed
     
 lemma pt_list_set_fresh:
   fixes a :: "'x"
   and   xs :: "'a list"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     fs: "fs TYPE('a) TYPE('x)"
   shows "a\<sharp>(set xs) = a\<sharp>xs"
 by (simp add: fresh_def pt_list_set_supp[OF pt, OF at, OF fs])
 
 
 section \<open>generalisation of freshness to lists and sets of atoms\<close>
 (*================================================================*)
  
 consts
   fresh_star :: "'b \<Rightarrow> 'a \<Rightarrow> bool" (\<open>_ \<sharp>* _\<close> [100,100] 100)
 
 overloading fresh_star_set \<equiv> "fresh_star :: 'b set \<Rightarrow> 'a \<Rightarrow> bool"
 begin
   definition fresh_star_set: "xs\<sharp>*c \<equiv> \<forall>x::'b\<in>xs. x\<sharp>(c::'a)"
 end
 
 overloading frsh_star_list \<equiv> "fresh_star :: 'b list \<Rightarrow> 'a \<Rightarrow> bool"
 begin
   definition fresh_star_list: "xs\<sharp>*c \<equiv> \<forall>x::'b\<in>set xs. x\<sharp>(c::'a)"
 end
 
 lemmas fresh_star_def = fresh_star_list fresh_star_set
 
 lemma fresh_star_prod_set:
   fixes xs::"'a set"
   shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
 by (auto simp add: fresh_star_def fresh_prod)
 
 lemma fresh_star_prod_list:
   fixes xs::"'a list"
   shows "xs\<sharp>*(a,b) = (xs\<sharp>*a \<and> xs\<sharp>*b)"
   by (auto simp add: fresh_star_def fresh_prod)
 
 lemmas fresh_star_prod = fresh_star_prod_list fresh_star_prod_set
 
 lemma fresh_star_set_eq: "set xs \<sharp>* c = xs \<sharp>* c"
   by (simp add: fresh_star_def)
 
 lemma fresh_star_Un_elim:
   "((S \<union> T) \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (S \<sharp>* c \<Longrightarrow> T \<sharp>* c \<Longrightarrow> PROP C)"
 proof
   assume \<section>: "(S \<union> T) \<sharp>* c \<Longrightarrow> PROP C" and c: "S \<sharp>* c" "T \<sharp>* c"
   show "PROP C"
     using c by (intro \<section>) (metis Un_iff fresh_star_set)
 qed (auto simp: fresh_star_def)
 
 lemma fresh_star_insert_elim:
   "(insert x S \<sharp>* c \<Longrightarrow> PROP C) \<equiv> (x \<sharp> c \<Longrightarrow> S \<sharp>* c \<Longrightarrow> PROP C)"
   by rule (simp_all add: fresh_star_def)
 
 lemma fresh_star_empty_elim:
   "({} \<sharp>* c \<Longrightarrow> PROP C) \<equiv> PROP C"
   by (simp add: fresh_star_def)
 
 text \<open>Normalization of freshness results; see \ \<open>nominal_induct\<close>\<close>
 
 lemma fresh_star_unit_elim: 
   shows "((a::'a set)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
   and "((b::'a list)\<sharp>*() \<Longrightarrow> PROP C) \<equiv> PROP C"
   by (simp_all add: fresh_star_def fresh_def supp_unit)
 
 lemma fresh_star_prod_elim: 
   shows "((a::'a set)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (a\<sharp>*x \<Longrightarrow> a\<sharp>*y \<Longrightarrow> PROP C)"
   and "((b::'a list)\<sharp>*(x,y) \<Longrightarrow> PROP C) \<equiv> (b\<sharp>*x \<Longrightarrow> b\<sharp>*y \<Longrightarrow> PROP C)"
   by (rule, simp_all add: fresh_star_prod)+
 
 
 lemma pt_fresh_star_bij_ineq:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'y set"
   and     b :: "'y list"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
   and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
   unfolding fresh_star_def
 proof -
   have "y \<sharp> x" if "\<forall>z\<in>pi \<bullet> a. z \<sharp> pi \<bullet> x" and "y \<in> a" for y
     using that by (meson assms at pt_fresh_bij_ineq pt_set_bij2)
   moreover have "y \<sharp> pi \<bullet> x" if "\<forall>z\<in>a. z \<sharp> x" and "y \<in> pi \<bullet> a" for y
     using that by (simp add: assms pt_fresh_left_ineq pt_set_bij1a)
   moreover have "y \<sharp> x"
     if "\<forall>z\<in>set (pi \<bullet> b). z \<sharp> pi \<bullet> x" and "y \<in> set b" for y
     using that by (metis at cp pt_fresh_bij_ineq pt_set_bij pta ptb set_eqvt)
   moreover have "y \<sharp> pi \<bullet> x"
     if "\<forall>z\<in>set b. z \<sharp> x" and "y \<in> set (pi \<bullet> b)" for y
     using that by (metis at cp pt_fresh_left_ineq pt_set_bij1a pta ptb set_eqvt)
   ultimately show "(\<forall>xa\<in>pi \<bullet> a. xa \<sharp> pi \<bullet> x) = (\<forall>xa\<in>a. xa \<sharp> x)" "(\<forall>xa\<in>set (pi \<bullet> b). xa \<sharp> pi \<bullet> x) = (\<forall>xa\<in>set b. xa \<sharp> x)"
     by blast+
 qed
 
 
 lemma pt_fresh_star_bij:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x set"
   and     b :: "'x list"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>a)\<sharp>*(pi\<bullet>x) = a\<sharp>*x"
   and   "(pi\<bullet>b)\<sharp>*(pi\<bullet>x) = b\<sharp>*x"
 proof (rule pt_fresh_star_bij_ineq)
   show "(pi \<bullet> b) \<sharp>* (pi \<bullet> x) = b \<sharp>* x"
   by (simp add: at at_pt_inst cp_pt_inst pt pt_fresh_star_bij_ineq)
 qed (auto simp: at pt at_pt_inst cp_pt_inst)
 
 lemma pt_fresh_star_eqvt:
   fixes  pi :: "'x prm"
   and     x :: "'a"
   and     a :: "'x set"
   and     b :: "'x list"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
   and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
   by (simp_all add: perm_bool pt_fresh_star_bij[OF pt, OF at])
 
 lemma pt_fresh_star_eqvt_ineq:
   fixes pi::"'x prm"
   and   a::"'y set"
   and   b::"'y list"
   and   x::"'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   and     dj:  "disjoint TYPE('y) TYPE('x)"
   shows "pi\<bullet>(a\<sharp>*x) = (pi\<bullet>a)\<sharp>*(pi\<bullet>x)"
   and   "pi\<bullet>(b\<sharp>*x) = (pi\<bullet>b)\<sharp>*(pi\<bullet>x)"
   by (simp_all add: pt_fresh_star_bij_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)
 
 lemma pt_freshs_freshs:
   assumes pt: "pt TYPE('a) TYPE('x)"
   and at: "at TYPE ('x)"
   and pi: "set (pi::'x prm) \<subseteq> Xs \<times> Ys"
   and Xs: "Xs \<sharp>* (x::'a)"
   and Ys: "Ys \<sharp>* x"
   shows "pi\<bullet>x = x"
   using pi
 proof (induct pi)
   case Nil
   show ?case by (simp add: pt1 [OF pt])
 next
   case (Cons p pi)
   obtain a b where p: "p = (a, b)" by (cases p)
   with Cons Xs Ys have "a \<sharp> x" "b \<sharp> x"
     by (simp_all add: fresh_star_def)
   with Cons p show ?case
     by (simp add: pt_fresh_fresh [OF pt at]
       pt2 [OF pt, of "[(a, b)]" pi, simplified])
 qed
 
 lemma pt_fresh_star_pi: 
   fixes x::"'a"
   and   pi::"'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     a: "((supp x)::'x set)\<sharp>* pi"
   shows "pi\<bullet>x = x"
 using a
 apply(induct pi)
   apply (simp add: assms(1) pt1)
 apply(auto simp add: fresh_star_def fresh_list_cons fresh_prod pt1[OF pt])
   by (metis Cons_eq_append_conv append_self_conv2 assms(1) at at_fresh fresh_def pt2 pt_fresh_fresh)
 
 section \<open>Infrastructure lemmas for strong rule inductions\<close>
 (*==========================================================*)
 
 text \<open>
   For every set of atoms, there is another set of atoms
   avoiding a finitely supported c and there is a permutation
   which 'translates' between both sets.
 \<close>
 
 lemma at_set_avoiding_aux:
   fixes Xs::"'a set"
   and   As::"'a set"
   assumes at: "at TYPE('a)"
   and     b: "Xs \<subseteq> As"
   and     c: "finite As"
   and     d: "finite ((supp c)::'a set)"
   shows "\<exists>(pi::'a prm). (pi\<bullet>Xs)\<sharp>*c \<and> (pi\<bullet>Xs) \<inter> As = {} \<and> set pi \<subseteq> Xs \<times> (pi\<bullet>Xs)"
 proof -
   from b c have "finite Xs" by (simp add: finite_subset)
   then show ?thesis using b 
   proof (induct)
     case empty
     have "({}::'a set)\<sharp>*c" by (simp add: fresh_star_def)
     moreover
     have "({}::'a set) \<inter> As = {}" by simp
     moreover
     have "set ([]::'a prm) \<subseteq> {} \<times> {}" by simp
     ultimately show ?case by (simp add: empty_eqvt)
   next
     case (insert x Xs)
     then have ih: "\<exists>pi. (pi\<bullet>Xs)\<sharp>*c \<and> (pi\<bullet>Xs) \<inter> As = {} \<and> set pi \<subseteq> Xs \<times> (pi\<bullet>Xs)" by simp
     then obtain pi where a1: "(pi\<bullet>Xs)\<sharp>*c" and a2: "(pi\<bullet>Xs) \<inter> As = {}" and 
       a4: "set pi \<subseteq> Xs \<times> (pi\<bullet>Xs)" by blast
     have b: "x\<notin>Xs" by fact
     have d1: "finite As" by fact
     have d2: "finite Xs" by fact
     have d3: "({x} \<union> Xs) \<subseteq> As" using insert(4) by simp
     from d d1 d2
     obtain y::"'a" where fr: "y\<sharp>(c,pi\<bullet>Xs,As)" 
       apply(rule_tac at_exists_fresh[OF at, where x="(c,pi\<bullet>Xs,As)"])
       apply(auto simp add: supp_prod at_supp[OF at] at_fin_set_supp[OF at]
         pt_supp_finite_pi[OF pt_set_inst[OF at_pt_inst[OF at]] at])
       done
     have "({y}\<union>(pi\<bullet>Xs))\<sharp>*c" using a1 fr by (simp add: fresh_star_def)
     moreover
     have "({y}\<union>(pi\<bullet>Xs))\<inter>As = {}" using a2 d1 fr 
       by (simp add: fresh_prod at_fin_set_fresh[OF at])
     moreover
     have "pi\<bullet>x=x" using a4 b a2 d3 
       by (rule_tac at_prm_fresh2[OF at]) (auto)
     then have "set ((pi\<bullet>x,y)#pi) \<subseteq> ({x} \<union> Xs) \<times> ({y}\<union>(pi\<bullet>Xs))" using a4 by auto
     moreover
     have "(((pi\<bullet>x,y)#pi)\<bullet>({x} \<union> Xs)) = {y}\<union>(pi\<bullet>Xs)"
     proof -
       have eq: "[(pi\<bullet>x,y)]\<bullet>(pi\<bullet>Xs) = (pi\<bullet>Xs)" 
       proof -
         have "(pi\<bullet>x)\<sharp>(pi\<bullet>Xs)" using b d2 
           by (simp add: pt_fresh_bij [OF pt_set_inst [OF at_pt_inst [OF at]], OF at]
             at_fin_set_fresh [OF at])
         moreover
         have "y\<sharp>(pi\<bullet>Xs)" using fr by simp
         ultimately show "[(pi\<bullet>x,y)]\<bullet>(pi\<bullet>Xs) = (pi\<bullet>Xs)" 
           by (simp add: pt_fresh_fresh[OF pt_set_inst
             [OF at_pt_inst[OF at]], OF at])
       qed
       have "(((pi\<bullet>x,y)#pi)\<bullet>({x}\<union>Xs)) = ([(pi\<bullet>x,y)]\<bullet>(pi\<bullet>({x}\<union>Xs)))"
         by (simp add: pt2[symmetric, OF pt_set_inst [OF at_pt_inst[OF at]]])
       also have "\<dots> = {y}\<union>([(pi\<bullet>x,y)]\<bullet>(pi\<bullet>Xs))" 
         by (simp only: union_eqvt perm_set_def at_calc[OF at])(auto)
       finally show "(((pi\<bullet>x,y)#pi)\<bullet>({x} \<union> Xs)) = {y}\<union>(pi\<bullet>Xs)" using eq by simp
     qed
     ultimately 
     show ?case by (rule_tac x="(pi\<bullet>x,y)#pi" in exI) (auto)
   qed
 qed
 
 lemma at_set_avoiding:
   fixes Xs::"'a set"
   assumes at: "at TYPE('a)"
   and     a: "finite Xs"
   and     b: "finite ((supp c)::'a set)"
   obtains pi::"'a prm" where "(pi\<bullet>Xs)\<sharp>*c" and "set pi \<subseteq> Xs \<times> (pi\<bullet>Xs)"
 using a b at_set_avoiding_aux[OF at, where Xs="Xs" and As="Xs" and c="c"]
 by (blast)
 
 section \<open>composition instances\<close>
 (* ============================= *)
 
 lemma cp_list_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "cp TYPE ('a list) TYPE('x) TYPE('y)"
 using c1
 apply(clarsimp simp add: cp_def)
   by (induct_tac x) auto
 
 lemma cp_set_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "cp TYPE ('a set) TYPE('x) TYPE('y)"
   using c1
   unfolding cp_def perm_set_def
   by (smt (verit) Collect_cong mem_Collect_eq)
 
 
 lemma cp_option_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "cp TYPE ('a option) TYPE('x) TYPE('y)"
   using c1 unfolding cp_def by (metis none_eqvt not_None_eq some_eqvt)
 
 lemma cp_noption_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "cp TYPE ('a noption) TYPE('x) TYPE('y)"
   using c1 unfolding cp_def
   by (metis nnone_eqvt noption.exhaust nsome_eqvt)
 
 lemma cp_unit_inst:
   shows "cp TYPE (unit) TYPE('x) TYPE('y)"
   by (simp add: cp_def)
 
 lemma cp_bool_inst:
   shows "cp TYPE (bool) TYPE('x) TYPE('y)"
   apply(clarsimp simp add: cp_def)
   by (induct_tac x) auto
 
 lemma cp_prod_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   and     c2: "cp TYPE ('b) TYPE('x) TYPE('y)"
   shows "cp TYPE ('a\<times>'b) TYPE('x) TYPE('y)"
 using c1 c2
   by (simp add: cp_def)
 
 lemma cp_fun_inst:
   assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
   and     c2: "cp TYPE ('b) TYPE('x) TYPE('y)"
   and     pt: "pt TYPE ('y) TYPE('x)"
   and     at: "at TYPE ('x)"
   shows "cp TYPE ('a\<Rightarrow>'b) TYPE('x) TYPE('y)"
   using c1 c2
   by(auto simp add: cp_def perm_fun_def fun_eq_iff at pt pt_list_inst pt_prod_inst pt_rev_pi rev_eqvt)
 
 
 section \<open>Andy's freshness lemma\<close>
 (*================================*)
 
 lemma freshness_lemma:
   fixes h :: "'x\<Rightarrow>'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     at:  "at TYPE('x)" 
   and     f1:  "finite ((supp h)::'x set)"
   and     a: "\<exists>a::'x. a\<sharp>(h,h a)"
   shows  "\<exists>fr::'a. \<forall>a::'x. a\<sharp>h \<longrightarrow> (h a) = fr"
 proof -
   have ptb: "pt TYPE('x) TYPE('x)" by (simp add: at_pt_inst[OF at]) 
   have ptc: "pt TYPE('x\<Rightarrow>'a) TYPE('x)" by (simp add: pt_fun_inst[OF ptb, OF pta, OF at]) 
   from a obtain a0 where a1: "a0\<sharp>h" and a2: "a0\<sharp>(h a0)" by (force simp add: fresh_prod)
   show ?thesis
   proof
     let ?fr = "h (a0::'x)"
     show "\<forall>(a::'x). (a\<sharp>h \<longrightarrow> ((h a) = ?fr))" 
     proof (intro strip)
       fix a
       assume a3: "(a::'x)\<sharp>h"
       show "h (a::'x) = h a0"
       proof (cases "a=a0")
         case True thus "h (a::'x) = h a0" by simp
       next
         case False 
         assume "a\<noteq>a0"
         hence c1: "a\<notin>((supp a0)::'x set)" by  (simp add: fresh_def[symmetric] at_fresh[OF at])
         have c2: "a\<notin>((supp h)::'x set)" using a3 by (simp add: fresh_def)
         from c1 c2 have c3: "a\<notin>((supp h)\<union>((supp a0)::'x set))" by force
         have f2: "finite ((supp a0)::'x set)" by (simp add: at_supp[OF at])
         from f1 f2 have "((supp (h a0))::'x set)\<subseteq>((supp h)\<union>(supp a0))"
           by (simp add: pt_supp_fun_subset[OF ptb, OF pta, OF at])
         hence "a\<notin>((supp (h a0))::'x set)" using c3 by force
         hence "a\<sharp>(h a0)" by (simp add: fresh_def) 
         with a2 have d1: "[(a0,a)]\<bullet>(h a0) = (h a0)" by (rule pt_fresh_fresh[OF pta, OF at])
         from a1 a3 have d2: "[(a0,a)]\<bullet>h = h" by (rule pt_fresh_fresh[OF ptc, OF at])
         from d1 have "h a0 = [(a0,a)]\<bullet>(h a0)" by simp
         also have "\<dots>= ([(a0,a)]\<bullet>h)([(a0,a)]\<bullet>a0)" by (simp add: pt_fun_app_eq[OF ptb, OF at])
         also have "\<dots> = h ([(a0,a)]\<bullet>a0)" using d2 by simp
         also have "\<dots> = h a" by (simp add: at_calc[OF at])
         finally show "h a = h a0" by simp
       qed
     qed
   qed
 qed
 
 lemma freshness_lemma_unique:
   fixes h :: "'x\<Rightarrow>'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)" 
   and     f1: "finite ((supp h)::'x set)"
   and     a: "\<exists>(a::'x). a\<sharp>(h,h a)"
   shows  "\<exists>!(fr::'a). \<forall>(a::'x). a\<sharp>h \<longrightarrow> (h a) = fr"
 proof (rule ex_ex1I)
   from pt at f1 a show "\<exists>fr::'a. \<forall>a::'x. a\<sharp>h \<longrightarrow> h a = fr" by (simp add: freshness_lemma)
 next
   fix fr1 fr2
   assume b1: "\<forall>a::'x. a\<sharp>h \<longrightarrow> h a = fr1"
   assume b2: "\<forall>a::'x. a\<sharp>h \<longrightarrow> h a = fr2"
   from a obtain a where "(a::'x)\<sharp>h" by (force simp add: fresh_prod) 
   with b1 b2 have "h a = fr1 \<and> h a = fr2" by force
   thus "fr1 = fr2" by force
 qed
 
 \<comment> \<open>packaging the freshness lemma into a function\<close>
 definition fresh_fun :: "('x\<Rightarrow>'a)\<Rightarrow>'a" where
   "fresh_fun (h) \<equiv> THE fr. (\<forall>(a::'x). a\<sharp>h \<longrightarrow> (h a) = fr)"
 
 lemma fresh_fun_app:
   fixes h :: "'x\<Rightarrow>'a"
   and   a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)" 
   and     f1: "finite ((supp h)::'x set)"
   and     a: "\<exists>(a::'x). a\<sharp>(h,h a)"
   and     b: "a\<sharp>h"
   shows "(fresh_fun h) = (h a)"
 proof (unfold fresh_fun_def, rule the_equality)
   show "\<forall>(a'::'x). a'\<sharp>h \<longrightarrow> h a' = h a"
   proof (intro strip)
     fix a'::"'x"
     assume c: "a'\<sharp>h"
     from pt at f1 a have "\<exists>(fr::'a). \<forall>(a::'x). a\<sharp>h \<longrightarrow> (h a) = fr" by (rule freshness_lemma)
     with b c show "h a' = h a" by force
   qed
 next
   fix fr::"'a"
   assume "\<forall>a. a\<sharp>h \<longrightarrow> h a = fr"
   with b show "fr = h a" by force
 qed
 
 lemma fresh_fun_app':
   fixes h :: "'x\<Rightarrow>'a"
   and   a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)" 
   and     f1: "finite ((supp h)::'x set)"
   and     a: "a\<sharp>h" "a\<sharp>h a"
   shows "(fresh_fun h) = (h a)"
   by (meson assms fresh_fun_app fresh_prod pt)
 
 lemma fresh_fun_equiv_ineq:
   fixes h :: "'y\<Rightarrow>'a"
   and   pi:: "'x prm"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     ptb':"pt TYPE('a) TYPE('y)"
   and     at:  "at TYPE('x)" 
   and     at': "at TYPE('y)"
   and     cpa: "cp TYPE('a) TYPE('x) TYPE('y)"
   and     cpb: "cp TYPE('y) TYPE('x) TYPE('y)"
   and     f1: "finite ((supp h)::'y set)"
   and     a1: "\<exists>(a::'y). a\<sharp>(h,h a)"
   shows "pi\<bullet>(fresh_fun h) = fresh_fun(pi\<bullet>h)" (is "?LHS = ?RHS")
 proof -
   have ptd: "pt TYPE('y) TYPE('y)" by (simp add: at_pt_inst[OF at']) 
   have ptc: "pt TYPE('y\<Rightarrow>'a) TYPE('x)" by (simp add: pt_fun_inst[OF ptb, OF pta, OF at]) 
   have cpc: "cp TYPE('y\<Rightarrow>'a) TYPE ('x) TYPE ('y)" by (rule cp_fun_inst[OF cpb cpa ptb at])
   have f2: "finite ((supp (pi\<bullet>h))::'y set)"
   proof -
     from f1 have "finite (pi\<bullet>((supp h)::'y set))"
       by (simp add: pt_set_finite_ineq[OF ptb, OF at])
     thus ?thesis
       by (simp add: pt_perm_supp_ineq[OF ptc, OF ptb, OF at, OF cpc])
   qed
   from a1 obtain a' where c0: "a'\<sharp>(h,h a')" by force
   hence c1: "a'\<sharp>h" and c2: "a'\<sharp>(h a')" by (simp_all add: fresh_prod)
   have c3: "(pi\<bullet>a')\<sharp>(pi\<bullet>h)" using c1
   by (simp add: pt_fresh_bij_ineq[OF ptc, OF ptb, OF at, OF cpc])
   have c4: "(pi\<bullet>a')\<sharp>(pi\<bullet>h) (pi\<bullet>a')"
   proof -
     from c2 have "(pi\<bullet>a')\<sharp>(pi\<bullet>(h a'))"
       by (simp add: pt_fresh_bij_ineq[OF pta, OF ptb, OF at,OF cpa])
     thus ?thesis by (simp add: pt_fun_app_eq[OF ptb, OF at])
   qed
   have a2: "\<exists>(a::'y). a\<sharp>(pi\<bullet>h,(pi\<bullet>h) a)" using c3 c4 by (force simp add: fresh_prod)
   have d1: "?LHS = pi\<bullet>(h a')" using c1 a1 by (simp add: fresh_fun_app[OF ptb', OF at', OF f1])
   have d2: "?RHS = (pi\<bullet>h) (pi\<bullet>a')" using c3 a2 
     by (simp add: fresh_fun_app[OF ptb', OF at', OF f2])
   show ?thesis using d1 d2 by (simp add: pt_fun_app_eq[OF ptb, OF at])
 qed
 
 lemma fresh_fun_equiv:
   fixes h :: "'x\<Rightarrow>'a"
   and   pi:: "'x prm"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     at:  "at TYPE('x)" 
   and     f1:  "finite ((supp h)::'x set)"
   and     a1: "\<exists>(a::'x). a\<sharp>(h,h a)"
   shows "pi\<bullet>(fresh_fun h) = fresh_fun(pi\<bullet>h)" (is "?LHS = ?RHS")
 proof -
   have ptb: "pt TYPE('x) TYPE('x)" by (simp add: at_pt_inst[OF at]) 
   have ptc: "pt TYPE('x\<Rightarrow>'a) TYPE('x)" by (simp add: pt_fun_inst[OF ptb, OF pta, OF at]) 
   have f2: "finite ((supp (pi\<bullet>h))::'x set)"
   proof -
     from f1 have "finite (pi\<bullet>((supp h)::'x set))" by (simp add: pt_set_finite_ineq[OF ptb, OF at])
     thus ?thesis by (simp add: pt_perm_supp[OF ptc, OF at])
   qed
   from a1 obtain a' where c0: "a'\<sharp>(h,h a')" by force
   hence c1: "a'\<sharp>h" and c2: "a'\<sharp>(h a')" by (simp_all add: fresh_prod)
   have c3: "(pi\<bullet>a')\<sharp>(pi\<bullet>h)" using c1 by (simp add: pt_fresh_bij[OF ptc, OF at])
   have c4: "(pi\<bullet>a')\<sharp>(pi\<bullet>h) (pi\<bullet>a')"
   proof -
     from c2 have "(pi\<bullet>a')\<sharp>(pi\<bullet>(h a'))" by (simp add: pt_fresh_bij[OF pta, OF at])
     thus ?thesis by (simp add: pt_fun_app_eq[OF ptb, OF at])
   qed
   have a2: "\<exists>(a::'x). a\<sharp>(pi\<bullet>h,(pi\<bullet>h) a)" using c3 c4 by (force simp add: fresh_prod)
   have d1: "?LHS = pi\<bullet>(h a')" using c1 a1 by (simp add: fresh_fun_app[OF pta, OF at, OF f1])
   have d2: "?RHS = (pi\<bullet>h) (pi\<bullet>a')" using c3 a2 by (simp add: fresh_fun_app[OF pta, OF at, OF f2])
   show ?thesis using d1 d2 by (simp add: pt_fun_app_eq[OF ptb, OF at])
 qed
 
 lemma fresh_fun_supports:
   fixes h :: "'x\<Rightarrow>'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)" 
   and     f1: "finite ((supp h)::'x set)"
   and     a: "\<exists>(a::'x). a\<sharp>(h,h a)"
   shows "((supp h)::'x set) supports (fresh_fun h)"
   by(simp flip: fresh_def add: supports_def assms at_pt_inst fresh_fun_equiv pt_fresh_fresh pt_fun_inst)
   
 section \<open>Abstraction function\<close>
 (*==============================*)
 
 lemma pt_abs_fun_inst:
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pt TYPE('x\<Rightarrow>('a noption)) TYPE('x)"
   by (simp add: at at_pt_inst pt pt_fun_inst pt_noption_inst)
 
 definition abs_fun :: "'x\<Rightarrow>'a\<Rightarrow>('x\<Rightarrow>('a noption))" (\<open>[_]._\<close> [100,100] 100) where 
   "[a].x \<equiv> (\<lambda>b. (if b=a then nSome(x) else (if b\<sharp>x then nSome([(a,b)]\<bullet>x) else nNone)))"
 
 (* FIXME: should be called perm_if and placed close to the definition of permutations on bools *)
 lemma abs_fun_if: 
   fixes pi :: "'x prm"
   and   x  :: "'a"
   and   y  :: "'a"
   and   c  :: "bool"
   shows "pi\<bullet>(if c then x else y) = (if c then (pi\<bullet>x) else (pi\<bullet>y))"   
   by force
 
 lemma abs_fun_pi_ineq:
   fixes a  :: "'y"
   and   x  :: "'a"
   and   pi :: "'x prm"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
 shows "pi\<bullet>([a].x) = [(pi\<bullet>a)].(pi\<bullet>x)"
   unfolding fun_eq_iff
 proof
   fix y
   have "(((rev pi)\<bullet>y) = a) = (y = pi\<bullet>a)"
     by (metis at pt_rev_pi ptb)
   moreover
   have "(((rev pi)\<bullet>y)\<sharp>x) = (y\<sharp>(pi\<bullet>x))"
     by (simp add: assms pt_fresh_left_ineq)
   moreover
   have "pi\<bullet>([(a,(rev pi)\<bullet>y)]\<bullet>x) = [(pi\<bullet>a,y)]\<bullet>(pi\<bullet>x)"
     using assms cp1[OF cp] by (simp add: pt_pi_rev)
   ultimately
   show "(pi \<bullet> [a].x) y = ([(pi \<bullet> a)].(pi \<bullet> x)) y"
     by (simp add: abs_fun_def perm_fun_def)
 qed
 
 lemma abs_fun_pi:
   fixes a  :: "'x"
   and   x  :: "'a"
   and   pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi\<bullet>([a].x) = [(pi\<bullet>a)].(pi\<bullet>x)"
   by (simp add: abs_fun_pi_ineq at at_pt_inst cp_pt_inst pt)
 
 lemma abs_fun_eq1: 
   fixes x  :: "'a"
   and   y  :: "'a"
   and   a  :: "'x"
   shows "([a].x = [a].y) = (x = y)"
   by (metis abs_fun_def noption.inject)
 
 lemma abs_fun_eq2:
   fixes x  :: "'a"
   and   y  :: "'a"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
       and a1: "a\<noteq>b" 
       and a2: "[a].x = [b].y" 
   shows "x=[(a,b)]\<bullet>y \<and> a\<sharp>y"
 proof -
   from a2 have "\<forall>c::'x. ([a].x) c = ([b].y) c" by (force simp add: fun_eq_iff)
   hence "([a].x) a = ([b].y) a" by simp
   hence a3: "nSome(x) = ([b].y) a" by (simp add: abs_fun_def)
   show "x=[(a,b)]\<bullet>y \<and> a\<sharp>y"
   proof (cases "a\<sharp>y")
     assume a4: "a\<sharp>y"
     hence "x=[(b,a)]\<bullet>y" using a3 a1 by (simp add: abs_fun_def)
     moreover
     have "[(a,b)]\<bullet>y = [(b,a)]\<bullet>y" by (rule pt3[OF pt], rule at_ds5[OF at])
     ultimately show ?thesis using a4 by simp
   next
     assume "\<not>a\<sharp>y"
     hence "nSome(x) = nNone" using a1 a3 by (simp add: abs_fun_def)
     hence False by simp
     thus ?thesis by simp
   qed
 qed
 
 lemma abs_fun_eq3: 
   fixes x  :: "'a"
   and   y  :: "'a"
   and   a   :: "'x"
   and   b   :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
       and a1: "a\<noteq>b" 
       and a2: "x=[(a,b)]\<bullet>y" 
       and a3: "a\<sharp>y" 
   shows "[a].x =[b].y"
 proof -
   show ?thesis 
   proof (simp only: abs_fun_def fun_eq_iff, intro strip)
     fix c::"'x"
     let ?LHS = "if c=a then nSome(x) else if c\<sharp>x then nSome([(a,c)]\<bullet>x) else nNone"
     and ?RHS = "if c=b then nSome(y) else if c\<sharp>y then nSome([(b,c)]\<bullet>y) else nNone"
     show "?LHS=?RHS"
     proof -
       have "(c=a) \<or> (c=b) \<or> (c\<noteq>a \<and> c\<noteq>b)" by blast
       moreover  \<comment> \<open>case c=a\<close>
       { have "nSome(x) = nSome([(a,b)]\<bullet>y)" using a2 by simp
         also have "\<dots> = nSome([(b,a)]\<bullet>y)" by (simp, rule pt3[OF pt], rule at_ds5[OF at])
         finally have "nSome(x) = nSome([(b,a)]\<bullet>y)" by simp
         moreover
         assume "c=a"
         ultimately have "?LHS=?RHS" using a1 a3 by simp
       }
       moreover  \<comment> \<open>case c=b\<close>
       { have a4: "y=[(a,b)]\<bullet>x" using a2 by (simp only: pt_swap_bij[OF pt, OF at])
         hence "a\<sharp>([(a,b)]\<bullet>x)" using a3 by simp
         hence "b\<sharp>x" by (simp add: at_calc[OF at] pt_fresh_left[OF pt, OF at])
         moreover
         assume "c=b"
         ultimately have "?LHS=?RHS" using a1 a4 by simp
       }
       moreover  \<comment> \<open>case c\<noteq>a \<and> c\<noteq>b\<close>
       { assume a5: "c\<noteq>a \<and> c\<noteq>b"
         moreover 
         have "c\<sharp>x = c\<sharp>y" using a2 a5 by (force simp add: at_calc[OF at] pt_fresh_left[OF pt, OF at])
         moreover 
         have "c\<sharp>y \<longrightarrow> [(a,c)]\<bullet>x = [(b,c)]\<bullet>y" 
         proof (intro strip)
           assume a6: "c\<sharp>y"
           have "[(a,c),(b,c),(a,c)] \<triangleq> [(a,b)]" using a1 a5 by (force intro: at_ds3[OF at])
           hence "[(a,c)]\<bullet>([(b,c)]\<bullet>([(a,c)]\<bullet>y)) = [(a,b)]\<bullet>y" 
             by (simp add: pt2[OF pt, symmetric] pt3[OF pt])
           hence "[(a,c)]\<bullet>([(b,c)]\<bullet>y) = [(a,b)]\<bullet>y" using a3 a6 
             by (simp add: pt_fresh_fresh[OF pt, OF at])
           hence "[(a,c)]\<bullet>([(b,c)]\<bullet>y) = x" using a2 by simp
           hence "[(b,c)]\<bullet>y = [(a,c)]\<bullet>x" by (drule_tac pt_bij1[OF pt, OF at], simp)
           thus "[(a,c)]\<bullet>x = [(b,c)]\<bullet>y" by simp
         qed
         ultimately have "?LHS=?RHS" by simp
       }
       ultimately show "?LHS = ?RHS" by blast
     qed
   qed
 qed
         
 (* alpha equivalence *)
 lemma abs_fun_eq: 
   fixes x  :: "'a"
   and   y  :: "'a"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
   shows "([a].x = [b].y) = ((a=b \<and> x=y)\<or>(a\<noteq>b \<and> x=[(a,b)]\<bullet>y \<and> a\<sharp>y))"
 proof (rule iffI)
   assume b: "[a].x = [b].y"
   show "(a=b \<and> x=y)\<or>(a\<noteq>b \<and> x=[(a,b)]\<bullet>y \<and> a\<sharp>y)"
   proof (cases "a=b")
     case True with b show ?thesis by (simp add: abs_fun_eq1)
   next
     case False with b show ?thesis by (simp add: abs_fun_eq2[OF pt, OF at])
   qed
 next
   assume "(a=b \<and> x=y)\<or>(a\<noteq>b \<and> x=[(a,b)]\<bullet>y \<and> a\<sharp>y)"
   thus "[a].x = [b].y"
   proof
     assume "a=b \<and> x=y" thus ?thesis by simp
   next
     assume "a\<noteq>b \<and> x=[(a,b)]\<bullet>y \<and> a\<sharp>y" 
     thus ?thesis by (simp add: abs_fun_eq3[OF pt, OF at])
   qed
 qed
 
 (* symmetric version of alpha-equivalence *)
 lemma abs_fun_eq': 
   fixes x  :: "'a"
   and   y  :: "'a"
   and   a  :: "'x"
   and   b  :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
   shows "([a].x = [b].y) = ((a=b \<and> x=y)\<or>(a\<noteq>b \<and> [(b,a)]\<bullet>x=y \<and> b\<sharp>x))"
 by (auto simp add: abs_fun_eq[OF pt, OF at] pt_swap_bij'[OF pt, OF at] 
                    pt_fresh_left[OF pt, OF at] 
                    at_calc[OF at])
 
 (* alpha_equivalence with a fresh name *)
 lemma abs_fun_fresh: 
   fixes x :: "'a"
   and   y :: "'a"
   and   c :: "'x"
   and   a :: "'x"
   and   b :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
       and fr: "c\<noteq>a" "c\<noteq>b" "c\<sharp>x" "c\<sharp>y" 
   shows "([a].x = [b].y) = ([(a,c)]\<bullet>x = [(b,c)]\<bullet>y)"
 proof (rule iffI)
   assume eq0: "[a].x = [b].y"
   show "[(a,c)]\<bullet>x = [(b,c)]\<bullet>y"
   proof (cases "a=b")
     case True then show ?thesis using eq0 by (simp add: pt_bij[OF pt, OF at] abs_fun_eq[OF pt, OF at])
   next
     case False 
     have ineq: "a\<noteq>b" by fact
     with eq0 have eq: "x=[(a,b)]\<bullet>y" and fr': "a\<sharp>y" by (simp_all add: abs_fun_eq[OF pt, OF at])
     from eq have "[(a,c)]\<bullet>x = [(a,c)]\<bullet>[(a,b)]\<bullet>y" by (simp add: pt_bij[OF pt, OF at])
     also have "\<dots> = ([(a,c)]\<bullet>[(a,b)])\<bullet>([(a,c)]\<bullet>y)" by (rule pt_perm_compose[OF pt, OF at])
     also have "\<dots> = [(c,b)]\<bullet>y" using ineq fr fr' 
       by (simp add: pt_fresh_fresh[OF pt, OF at] at_calc[OF at])
     also have "\<dots> = [(b,c)]\<bullet>y" by (rule pt3[OF pt], rule at_ds5[OF at])
     finally show ?thesis by simp
   qed
 next
   assume eq: "[(a,c)]\<bullet>x = [(b,c)]\<bullet>y"
   thus "[a].x = [b].y"
   proof (cases "a=b")
     case True then show ?thesis using eq by (simp add: pt_bij[OF pt, OF at] abs_fun_eq[OF pt, OF at])
   next
     case False
     have ineq: "a\<noteq>b" by fact
     from fr have "([(a,c)]\<bullet>c)\<sharp>([(a,c)]\<bullet>x)" by (simp add: pt_fresh_bij[OF pt, OF at])
     hence "a\<sharp>([(b,c)]\<bullet>y)" using eq fr by (simp add: at_calc[OF at])
     hence fr0: "a\<sharp>y" using ineq fr by (simp add: pt_fresh_left[OF pt, OF at] at_calc[OF at])
     from eq have "x = (rev [(a,c)])\<bullet>([(b,c)]\<bullet>y)" by (rule pt_bij1[OF pt, OF at])
     also have "\<dots> = [(a,c)]\<bullet>([(b,c)]\<bullet>y)" by simp
     also have "\<dots> = ([(a,c)]\<bullet>[(b,c)])\<bullet>([(a,c)]\<bullet>y)" by (rule pt_perm_compose[OF pt, OF at])
     also have "\<dots> = [(b,a)]\<bullet>y" using ineq fr fr0  
       by (simp add: pt_fresh_fresh[OF pt, OF at] at_calc[OF at])
     also have "\<dots> = [(a,b)]\<bullet>y" by (rule pt3[OF pt], rule at_ds5[OF at])
     finally show ?thesis using ineq fr0 by (simp add: abs_fun_eq[OF pt, OF at])
   qed
 qed
 
 lemma abs_fun_fresh': 
   fixes x :: "'a"
   and   y :: "'a"
   and   c :: "'x"
   and   a :: "'x"
   and   b :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
       and at: "at TYPE('x)"
       and as: "[a].x = [b].y"
       and fr: "c\<noteq>a" "c\<noteq>b" "c\<sharp>x" "c\<sharp>y" 
   shows "x = [(a,c)]\<bullet>[(b,c)]\<bullet>y"
   using assms by (metis abs_fun_fresh pt_swap_bij)
 
 lemma abs_fun_supp_approx:
   fixes x :: "'a"
   and   a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "((supp ([a].x))::'x set) \<subseteq> (supp (x,a))"
 proof 
   fix c
   assume "c\<in>((supp ([a].x))::'x set)"
   hence "infinite {b. [(c,b)]\<bullet>([a].x) \<noteq> [a].x}" by (simp add: supp_def)
   hence "infinite {b. [([(c,b)]\<bullet>a)].([(c,b)]\<bullet>x) \<noteq> [a].x}" by (simp add: abs_fun_pi[OF pt, OF at])
   moreover
   have "{b. [([(c,b)]\<bullet>a)].([(c,b)]\<bullet>x) \<noteq> [a].x} \<subseteq> {b. ([(c,b)]\<bullet>x,[(c,b)]\<bullet>a) \<noteq> (x, a)}" by force
   ultimately have "infinite {b. ([(c,b)]\<bullet>x,[(c,b)]\<bullet>a) \<noteq> (x, a)}" by (simp add: infinite_super)
   thus "c\<in>(supp (x,a))" by (simp add: supp_def)
 qed
 
 lemma abs_fun_finite_supp:
   fixes x :: "'a"
   and   a :: "'x"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     f:  "finite ((supp x)::'x set)"
   shows "finite ((supp ([a].x))::'x set)"
 proof -
   from f have "finite ((supp (x,a))::'x set)" by (simp add: supp_prod at_supp[OF at])
   moreover
   have "((supp ([a].x))::'x set) \<subseteq> (supp (x,a))" by (rule abs_fun_supp_approx[OF pt, OF at])
   ultimately show ?thesis by (simp add: finite_subset)
 qed
 
 lemma fresh_abs_funI1:
   fixes  x :: "'a"
   and    a :: "'x"
   and    b :: "'x"
   assumes pt:  "pt TYPE('a) TYPE('x)"
   and     at:   "at TYPE('x)"
   and f:  "finite ((supp x)::'x set)"
   and a1: "b\<sharp>x" 
   and a2: "a\<noteq>b"
   shows "b\<sharp>([a].x)"
   proof -
     have "\<exists>c::'x. c\<sharp>(b,a,x,[a].x)" 
     proof (rule at_exists_fresh'[OF at], auto simp add: supp_prod at_supp[OF at] f)
       show "finite ((supp ([a].x))::'x set)" using f
         by (simp add: abs_fun_finite_supp[OF pt, OF at])        
     qed
     then obtain c where fr1: "c\<noteq>b"
                   and   fr2: "c\<noteq>a"
                   and   fr3: "c\<sharp>x"
                   and   fr4: "c\<sharp>([a].x)"
                   by (force simp add: fresh_prod at_fresh[OF at])
     have e: "[(c,b)]\<bullet>([a].x) = [a].([(c,b)]\<bullet>x)" using a2 fr1 fr2 
       by (force simp add: abs_fun_pi[OF pt, OF at] at_calc[OF at])
     from fr4 have "([(c,b)]\<bullet>c)\<sharp> ([(c,b)]\<bullet>([a].x))"
       by (simp add: pt_fresh_bij[OF pt_abs_fun_inst[OF pt, OF at], OF at])
     hence "b\<sharp>([a].([(c,b)]\<bullet>x))" using fr1 fr2 e  
       by (simp add: at_calc[OF at])
     thus ?thesis using a1 fr3 
       by (simp add: pt_fresh_fresh[OF pt, OF at])
 qed
 
 lemma fresh_abs_funE:
   fixes a :: "'x"
   and   b :: "'x"
   and   x :: "'a"
   assumes pt:  "pt TYPE('a) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     f:  "finite ((supp x)::'x set)"
   and     a1: "b\<sharp>([a].x)" 
   and     a2: "b\<noteq>a" 
   shows "b\<sharp>x"
 proof -
   have "\<exists>c::'x. c\<sharp>(b,a,x,[a].x)"
   proof (rule at_exists_fresh'[OF at], auto simp add: supp_prod at_supp[OF at] f)
     show "finite ((supp ([a].x))::'x set)" using f
       by (simp add: abs_fun_finite_supp[OF pt, OF at])  
   qed
   then obtain c where fr1: "b\<noteq>c"
                 and   fr2: "c\<noteq>a"
                 and   fr3: "c\<sharp>x"
                 and   fr4: "c\<sharp>([a].x)" by (force simp add: fresh_prod at_fresh[OF at])
   have "[a].x = [(b,c)]\<bullet>([a].x)" using a1 fr4 
     by (simp add: pt_fresh_fresh[OF pt_abs_fun_inst[OF pt, OF at], OF at])
   hence "[a].x = [a].([(b,c)]\<bullet>x)" using fr2 a2 
     by (force simp add: abs_fun_pi[OF pt, OF at] at_calc[OF at])
   hence b: "([(b,c)]\<bullet>x) = x" by (simp add: abs_fun_eq1)
   from fr3 have "([(b,c)]\<bullet>c)\<sharp>([(b,c)]\<bullet>x)" 
     by (simp add: pt_fresh_bij[OF pt, OF at]) 
   thus ?thesis using b fr1 by (simp add: at_calc[OF at])
 qed
 
 lemma fresh_abs_funI2:
   fixes a :: "'x"
   and   x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     f: "finite ((supp x)::'x set)"
   shows "a\<sharp>([a].x)"
 proof -
   have "\<exists>c::'x. c\<sharp>(a,x)"
     by  (rule at_exists_fresh'[OF at], auto simp add: supp_prod at_supp[OF at] f) 
   then obtain c where fr1: "a\<noteq>c" and fr1_sym: "c\<noteq>a" 
                 and   fr2: "c\<sharp>x" by (force simp add: fresh_prod at_fresh[OF at])
   have "c\<sharp>([a].x)" using f fr1 fr2 by (simp add: fresh_abs_funI1[OF pt, OF at])
   hence "([(c,a)]\<bullet>c)\<sharp>([(c,a)]\<bullet>([a].x))" using fr1  
     by (simp only: pt_fresh_bij[OF pt_abs_fun_inst[OF pt, OF at], OF at])
   hence a: "a\<sharp>([c].([(c,a)]\<bullet>x))" using fr1_sym 
     by (simp add: abs_fun_pi[OF pt, OF at] at_calc[OF at])
   have "[c].([(c,a)]\<bullet>x) = ([a].x)" using fr1_sym fr2 
     by (simp add: abs_fun_eq[OF pt, OF at])
   thus ?thesis using a by simp
 qed
 
 lemma fresh_abs_fun_iff: 
   fixes a :: "'x"
   and   b :: "'x"
   and   x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     f: "finite ((supp x)::'x set)"
   shows "(b\<sharp>([a].x)) = (b=a \<or> b\<sharp>x)" 
   by (auto  dest: fresh_abs_funE[OF pt, OF at,OF f] 
            intro: fresh_abs_funI1[OF pt, OF at,OF f] 
                   fresh_abs_funI2[OF pt, OF at,OF f])
 
 lemma abs_fun_supp: 
   fixes a :: "'x"
   and   x :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   and     f: "finite ((supp x)::'x set)"
   shows "supp ([a].x) = (supp x)-{a}"
  by (force simp add: supp_fresh_iff fresh_abs_fun_iff[OF pt, OF at, OF f])
 
 (* maybe needs to be better stated as supp intersection supp *)
 lemma abs_fun_supp_ineq: 
   fixes a :: "'y"
   and   x :: "'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   and     dj:  "disjoint TYPE('y) TYPE('x)"
 shows "((supp ([a].x))::'x set) = (supp x)"
 unfolding supp_def
   using abs_fun_pi_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj]
   by (smt (verit, ccfv_threshold) Collect_cong abs_fun_eq1)
 
 lemma fresh_abs_fun_iff_ineq: 
   fixes a :: "'y"
   and   b :: "'x"
   and   x :: "'a"
   assumes pta: "pt TYPE('a) TYPE('x)"
   and     ptb: "pt TYPE('y) TYPE('x)"
   and     at:  "at TYPE('x)"
   and     cp:  "cp TYPE('a) TYPE('x) TYPE('y)"
   and     dj:  "disjoint TYPE('y) TYPE('x)"
   shows "b\<sharp>([a].x) = b\<sharp>x" 
   by (simp add: fresh_def abs_fun_supp_ineq[OF pta, OF ptb, OF at, OF cp, OF dj])
 
 section \<open>abstraction type for the parsing in nominal datatype\<close>
 (*==============================================================*)
 
 inductive_set ABS_set :: "('x\<Rightarrow>('a noption)) set"
   where
   ABS_in: "(abs_fun a x)\<in>ABS_set"
 
 definition "ABS = ABS_set"
 
 typedef ('x, 'a) ABS (\<open>\<guillemotleft>_\<guillemotright>_\<close> [1000,1000] 1000) =
     "ABS::('x\<Rightarrow>('a noption)) set"
   morphisms Rep_ABS Abs_ABS
   unfolding ABS_def
 proof 
   fix x::"'a" and a::"'x"
   show "(abs_fun a x)\<in> ABS_set" by (rule ABS_in)
 qed
 
 
 section \<open>lemmas for deciding permutation equations\<close>
 (*===================================================*)
 
 lemma perm_aux_fold:
   shows "perm_aux pi x = pi\<bullet>x" by (simp only: perm_aux_def)
 
 lemma pt_perm_compose_aux:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   x  :: "'a"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "pi2\<bullet>(pi1\<bullet>x) = perm_aux (pi2\<bullet>pi1) (pi2\<bullet>x)" 
 proof -
   have "(pi2@pi1) \<triangleq> ((pi2\<bullet>pi1)@pi2)" by (rule at_ds8[OF at])
   hence "(pi2@pi1)\<bullet>x = ((pi2\<bullet>pi1)@pi2)\<bullet>x" by (rule pt3[OF pt])
   thus ?thesis by (simp add: pt2[OF pt] perm_aux_def)
 qed  
 
 lemma cp1_aux:
   fixes pi1::"'x prm"
   and   pi2::"'y prm"
   and   x  ::"'a"
   assumes cp: "cp TYPE ('a) TYPE('x) TYPE('y)"
   shows "pi1\<bullet>(pi2\<bullet>x) = perm_aux (pi1\<bullet>pi2) (pi1\<bullet>x)"
   using cp by (simp add: cp_def perm_aux_def)
 
 lemma perm_eq_app:
   fixes f  :: "'a\<Rightarrow>'b"
   and   x  :: "'a"
   and   pi :: "'x prm"
   assumes pt: "pt TYPE('a) TYPE('x)"
   and     at: "at TYPE('x)"
   shows "(pi\<bullet>(f x)=y) = ((pi\<bullet>f)(pi\<bullet>x)=y)"
   by (simp add: pt_fun_app_eq[OF pt, OF at])
 
 lemma perm_eq_lam:
   fixes f  :: "'a\<Rightarrow>'b"
   and   x  :: "'a"
   and   pi :: "'x prm"
   shows "((pi\<bullet>(\<lambda>x. f x))=y) = ((\<lambda>x. (pi\<bullet>(f ((rev pi)\<bullet>x))))=y)"
   by (simp add: perm_fun_def)
 
 section \<open>test\<close>
 lemma at_prm_eq_compose:
   fixes pi1 :: "'x prm"
   and   pi2 :: "'x prm"
   and   pi3 :: "'x prm"
   assumes at: "at TYPE('x)"
   and     a: "pi1 \<triangleq> pi2"
   shows "(pi3\<bullet>pi1) \<triangleq> (pi3\<bullet>pi2)"
 proof -
   have pt: "pt TYPE('x) TYPE('x)" by (rule at_pt_inst[OF at])
   have pt_prm: "pt TYPE('x prm) TYPE('x)" 
     by (rule pt_list_inst[OF pt_prod_inst[OF pt, OF pt]])  
   from a show ?thesis
     by (auto simp add: prm_eq_def at pt pt_perm_compose')
 qed
 
 (************************)
 (* Various eqvt-lemmas  *)
 
-lemma Zero_nat_eqvt:
+lemma Zero_nat_eqvt[simp]:
   shows "pi\<bullet>(0::nat) = 0" 
 by (auto simp add: perm_nat_def)
 
-lemma One_nat_eqvt:
+lemma One_nat_eqvt[simp]:
   shows "pi\<bullet>(1::nat) = 1"
 by (simp add: perm_nat_def)
 
 lemma Suc_eqvt:
   shows "pi\<bullet>(Suc x) = Suc (pi\<bullet>x)" 
 by (auto simp add: perm_nat_def)
 
 lemma numeral_nat_eqvt: 
  shows "pi\<bullet>((numeral n)::nat) = numeral n" 
 by (simp add: perm_nat_def perm_int_def)
 
 lemma max_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(max x y) = max (pi\<bullet>x) (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
 lemma min_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(min x y) = min (pi\<bullet>x) (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
 lemma plus_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(x + y) = (pi\<bullet>x) + (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
 lemma minus_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(x - y) = (pi\<bullet>x) - (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
 lemma mult_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(x * y) = (pi\<bullet>x) * (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
 lemma div_nat_eqvt:
   fixes x::"nat"
   shows "pi\<bullet>(x div y) = (pi\<bullet>x) div (pi\<bullet>y)" 
 by (simp add:perm_nat_def) 
 
-lemma Zero_int_eqvt:
+lemma Zero_int_eqvt[simp]:
   shows "pi\<bullet>(0::int) = 0" 
 by (auto simp add: perm_int_def)
 
-lemma One_int_eqvt:
+lemma One_int_eqvt[simp]:
   shows "pi\<bullet>(1::int) = 1"
 by (simp add: perm_int_def)
 
-lemma numeral_int_eqvt: 
+lemma numeral_int_eqvt[simp]: 
  shows "pi\<bullet>((numeral n)::int) = numeral n"
   using perm_int_def by blast 
 
-lemma neg_numeral_int_eqvt:
+lemma neg_numeral_int_eqvt[simp]:
   shows "pi\<bullet>((- numeral n)::int) = - numeral n"
   by (simp add: perm_int_def)
 
 lemma max_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(max (x::int) y) = max (pi\<bullet>x) (pi\<bullet>y)" 
   by (simp add:perm_int_def) 
 
 lemma min_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(min x y) = min (pi\<bullet>x) (pi\<bullet>y)" 
   by (simp add:perm_int_def) 
 
 lemma plus_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(x + y) = (pi\<bullet>x) + (pi\<bullet>y)" 
   by (simp add:perm_int_def) 
 
 lemma minus_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(x - y) = (pi\<bullet>x) - (pi\<bullet>y)" 
   by (simp add:perm_int_def) 
 
 lemma mult_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(x * y) = (pi\<bullet>x) * (pi\<bullet>y)" 
 by (simp add:perm_int_def) 
 
 lemma div_int_eqvt:
   fixes x::"int"
   shows "pi\<bullet>(x div y) = (pi\<bullet>x) div (pi\<bullet>y)" 
   by (simp add:perm_int_def) 
 
 (*******************************************************)
 (* Setup of the theorem attributes eqvt and eqvt_force *)
 ML_file \<open>nominal_thmdecls.ML\<close>
 setup "NominalThmDecls.setup"
 
 lemmas [eqvt] = 
   (* connectives *)
   if_eqvt imp_eqvt disj_eqvt conj_eqvt neg_eqvt 
   true_eqvt false_eqvt
   imp_eqvt [folded HOL.induct_implies_def]
   
   (* datatypes *)
   perm_unit.simps
   perm_list.simps append_eqvt
   perm_prod.simps
   fst_eqvt snd_eqvt
   perm_option.simps
 
   (* nats *)
   Suc_eqvt Zero_nat_eqvt One_nat_eqvt min_nat_eqvt max_nat_eqvt
   plus_nat_eqvt minus_nat_eqvt mult_nat_eqvt div_nat_eqvt
   
   (* ints *)
   Zero_int_eqvt One_int_eqvt min_int_eqvt max_int_eqvt
   plus_int_eqvt minus_int_eqvt mult_int_eqvt div_int_eqvt
   
   (* sets *)
   union_eqvt empty_eqvt insert_eqvt set_eqvt
   
  
 (* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
 (* usual form of an eqvt-lemma, but they are needed for analysing       *)
 (* permutations on nats and ints *)
 lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
 
 (***************************************)
 (* setup for the individial atom-kinds *)
 (* and nominal datatypes               *)
 ML_file \<open>nominal_atoms.ML\<close>
 
 (************************************************************)
 (* various tactics for analysing permutations, supports etc *)
 ML_file \<open>nominal_permeq.ML\<close>
 
 method_setup perm_simp =
   \<open>NominalPermeq.perm_simp_meth\<close>
   \<open>simp rules and simprocs for analysing permutations\<close>
 
 method_setup perm_simp_debug =
   \<open>NominalPermeq.perm_simp_meth_debug\<close>
   \<open>simp rules and simprocs for analysing permutations including debugging facilities\<close>
 
 method_setup perm_extend_simp =
   \<open>NominalPermeq.perm_extend_simp_meth\<close>
   \<open>tactic for deciding equalities involving permutations\<close>
 
 method_setup perm_extend_simp_debug =
   \<open>NominalPermeq.perm_extend_simp_meth_debug\<close>
   \<open>tactic for deciding equalities involving permutations including debugging facilities\<close>
 
 method_setup supports_simp =
   \<open>NominalPermeq.supports_meth\<close>
   \<open>tactic for deciding whether something supports something else\<close>
 
 method_setup supports_simp_debug =
   \<open>NominalPermeq.supports_meth_debug\<close>
   \<open>tactic for deciding whether something supports something else including debugging facilities\<close>
 
 method_setup finite_guess =
   \<open>NominalPermeq.finite_guess_meth\<close>
   \<open>tactic for deciding whether something has finite support\<close>
 
 method_setup finite_guess_debug =
   \<open>NominalPermeq.finite_guess_meth_debug\<close>
   \<open>tactic for deciding whether something has finite support including debugging facilities\<close>
 
 method_setup fresh_guess =
   \<open>NominalPermeq.fresh_guess_meth\<close>
   \<open>tactic for deciding whether an atom is fresh for something\<close>
 
 method_setup fresh_guess_debug =
   \<open>NominalPermeq.fresh_guess_meth_debug\<close>
   \<open>tactic for deciding whether an atom is fresh for something including debugging facilities\<close>
 
 (*****************************************************************)
 (* tactics for generating fresh names and simplifying fresh_funs *)
 ML_file \<open>nominal_fresh_fun.ML\<close>
 
 method_setup generate_fresh = \<open>
   Args.type_name {proper = true, strict = true} >>
     (fn s => fn ctxt => SIMPLE_METHOD (generate_fresh_tac ctxt s))
 \<close> "generate a name fresh for all the variables in the goal"
 
 method_setup fresh_fun_simp = \<open>
   Scan.lift (Args.parens (Args.$$$ "no_asm") >> K true || Scan.succeed false) >>
     (fn b => fn ctxt => SIMPLE_METHOD' (fresh_fun_tac ctxt b))
 \<close> "delete one inner occurrence of fresh_fun"
 
 
 (************************************************)
 (* main file for constructing nominal datatypes *)
 lemma allE_Nil: assumes "\<forall>x. P x" obtains "P []"
   using assms ..
 
 ML_file \<open>nominal_datatype.ML\<close>
 
 (******************************************************)
 (* primitive recursive functions on nominal datatypes *)
 ML_file \<open>nominal_primrec.ML\<close>
 
 (****************************************************)
 (* inductive definition involving nominal datatypes *)
 ML_file \<open>nominal_inductive.ML\<close>
 ML_file \<open>nominal_inductive2.ML\<close>
 
 (*****************************************)
 (* setup for induction principles method *)
 ML_file \<open>nominal_induct.ML\<close>
 method_setup nominal_induct =
   \<open>NominalInduct.nominal_induct_method\<close>
   \<open>nominal induction\<close>
 
 end