Theory Nominal

Up to index of Isabelle/HOL/HOL-Nominal

theory Nominal
imports Infinite_Set
uses (nominal_thmdecls.ML) (nominal_atoms.ML) (nominal_package.ML) (nominal_induct.ML) (nominal_permeq.ML) (nominal_fresh_fun.ML) (nominal_primrec.ML) (nominal_inductive.ML)
begin

(* $Id: Nominal.thy,v 1.92 2007/09/14 11:32:07 urbanc Exp $ *)

theory Nominal 
imports Main Infinite_Set
uses
  ("nominal_thmdecls.ML")
  ("nominal_atoms.ML")
  ("nominal_package.ML")
  ("nominal_induct.ML") 
  ("nominal_permeq.ML")
  ("nominal_fresh_fun.ML")
  ("nominal_primrec.ML")
  ("nominal_inductive.ML")
begin 

section {* Permutations *}
(*======================*)

types 
  'x prm = "('x × 'x) list"

(* polymorphic operations for permutation and swapping *)
consts 
  perm :: "'x prm => 'a => 'a"     (infixr "•" 80)
  swap :: "('x × 'x) => 'x => 'x"

(* an auxiliary constant for the decision procedure involving *) 
(* permutations (to avoid loops when using perm-composition)  *)
constdefs
  "perm_aux pi x ≡ pi•x"

(* permutation on sets *)
defs (unchecked overloaded)
  perm_set_def:  "pi•(X::'a set) ≡ {pi•x | x. x∈X}"

lemma empty_eqvt:
  shows "pi•{} = {}"
  by (simp add: perm_set_def)

lemma union_eqvt:
  shows "pi • (X ∪ Y) = (pi • X) ∪ (pi • Y)"
  by (auto simp add: perm_set_def)

lemma insert_eqvt:
  shows "pi•(insert x X) = insert (pi•x) (pi•X)"
  by (auto simp add: perm_set_def)

(* permutation on units and products *)
primrec (unchecked perm_unit)
  "pi•()    = ()"
  
primrec (unchecked perm_prod)
  "pi•(x,y) = (pi•x,pi•y)"

lemma fst_eqvt:
  "pi•(fst x) = fst (pi•x)"
 by (cases x) simp

lemma snd_eqvt:
  "pi•(snd x) = snd (pi•x)"
 by (cases x) simp

(* permutation on lists *)
primrec (unchecked perm_list)
  nil_eqvt:  "pi•[]     = []"
  cons_eqvt: "pi•(x#xs) = (pi•x)#(pi•xs)"

lemma append_eqvt:
  fixes pi :: "'x prm"
  and   l1 :: "'a list"
  and   l2 :: "'a list"
  shows "pi•(l1@l2) = (pi•l1)@(pi•l2)"
  by (induct l1) auto

lemma rev_eqvt:
  fixes pi :: "'x prm"
  and   l  :: "'a list"
  shows "pi•(rev l) = rev (pi•l)"
  by (induct l) (simp_all add: append_eqvt)

lemma set_eqvt:
  fixes pi :: "'x prm"
  and   xs :: "'a list"
  shows "pi•(set xs) = set (pi•xs)"
by (induct xs, auto simp add: empty_eqvt insert_eqvt)

(* permutation on functions *)
defs (unchecked overloaded)
  perm_fun_def: "pi•(f::'a=>'b) ≡ (λx. pi•f((rev pi)•x))"

(* permutation on bools *)
primrec (unchecked perm_bool)
  true_eqvt:  "pi•True  = True"
  false_eqvt: "pi•False = False"

lemma perm_bool:
  shows "pi•(b::bool) = b"
  by (cases b) auto

lemma perm_boolI:
  assumes a: "P"
  shows "pi•P"
  using a by (simp add: perm_bool)

lemma perm_boolE:
  assumes a: "pi•P"
  shows "P"
  using a by (simp add: perm_bool)

lemma if_eqvt:
  fixes pi::"'a prm"
  shows "pi•(if b then c1 else c2) = (if (pi•b) then (pi•c1) else (pi•c2))"
apply(simp add: perm_fun_def)
done

lemma imp_eqvt:
  shows "pi•(A-->B) = ((pi•A)-->(pi•B))"
  by (simp add: perm_bool)

lemma conj_eqvt:
  shows "pi•(A∧B) = ((pi•A)∧(pi•B))"
  by (simp add: perm_bool)

lemma disj_eqvt:
  shows "pi•(A∨B) = ((pi•A)∨(pi•B))"
  by (simp add: perm_bool)

lemma neg_eqvt:
  shows "pi•(¬ A) = (¬ (pi•A))"
  by (simp add: perm_bool)

(* permutation on options *)

primrec (unchecked perm_option)
  some_eqvt:  "pi•Some(x) = Some(pi•x)"
  none_eqvt:  "pi•None    = None"

(* a "private" copy of the option type used in the abstraction function *)
datatype 'a noption = nSome 'a | nNone

primrec (unchecked perm_noption)
  nSome_eqvt: "pi•nSome(x) = nSome(pi•x)"
  nNone_eqvt: "pi•nNone    = nNone"

(* a "private" copy of the product type used in the nominal induct method *)
datatype ('a,'b) nprod = nPair 'a 'b

primrec (unchecked perm_nprod)
  perm_nProd_def: "pi•(nPair x1 x2)  = nPair (pi•x1) (pi•x2)"

(* permutation on characters (used in strings) *)
defs (unchecked overloaded)
  perm_char_def: "pi•(c::char) ≡ c"

lemma perm_string:
  fixes s::"string"
  shows "pi•s = s"
by (induct s)(auto simp add: perm_char_def)

(* permutation on ints *)
defs (unchecked overloaded)
  perm_int_def:    "pi•(i::int) ≡ i"

(* permutation on nats *)
defs (unchecked overloaded)
  perm_nat_def:    "pi•(i::nat) ≡ i"

section {* permutation equality *}
(*==============================*)

constdefs
  prm_eq :: "'x prm => 'x prm => bool"  (" _ \<triangleq> _ " [80,80] 80)
  "pi1 \<triangleq> pi2 ≡ ∀a::'x. pi1•a = pi2•a"

section {* Support, Freshness and Supports*}
(*========================================*)
constdefs
   supp :: "'a => ('x set)"  
   "supp x ≡ {a . (infinite {b . [(a,b)]•x ≠ x})}"

   fresh :: "'x => 'a => bool" ("_ \<sharp> _" [80,80] 80)
   "a \<sharp> x ≡ a ∉ supp x"

   supports :: "'x set => 'a => bool" (infixl "supports" 80)
   "S supports x ≡ ∀a b. (a∉S ∧ b∉S --> [(a,b)]•x=x)"

lemma supp_fresh_iff: 
  fixes x :: "'a"
  shows "(supp x) = {a::'x. ¬a\<sharp>x}"
apply(simp add: fresh_def)
done

lemma supp_unit:
  shows "supp () = {}"
  by (simp add: supp_def)

lemma supp_set_empty:
  shows "supp {} = {}"
  by (force simp add: supp_def perm_set_def)

lemma supp_singleton:
  shows "supp {x} = supp x"
  by (force simp add: supp_def perm_set_def)

lemma supp_prod: 
  fixes x :: "'a"
  and   y :: "'b"
  shows "(supp (x,y)) = (supp x)∪(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)∪(supp y)"
  by  (force simp add: supp_def Collect_imp_eq Collect_neg_eq)

lemma supp_list_nil:
  shows "supp [] = {}"
apply(simp add: supp_def)
done

lemma supp_list_cons:
  fixes x  :: "'a"
  and   xs :: "'a list"
  shows "supp (x#xs) = (supp x)∪(supp xs)"
apply(auto simp add: supp_def Collect_imp_eq Collect_neg_eq)
done

lemma supp_list_append:
  fixes xs :: "'a list"
  and   ys :: "'a list"
  shows "supp (xs@ys) = (supp xs)∪(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:
  fixes x  :: "bool"
  shows "supp (x) = {}"
  apply(case_tac "x")
  apply(simp_all add: supp_def)
done

lemma supp_some:
  fixes x :: "'a"
  shows "supp (Some x) = (supp x)"
  apply(simp add: supp_def)
  done

lemma supp_none:
  fixes x :: "'a"
  shows "supp (None) = {}"
  apply(simp add: supp_def)
  done

lemma supp_int:
  fixes i::"int"
  shows "supp (i) = {}"
  apply(simp add: supp_def perm_int_def)
  done

lemma supp_nat:
  fixes n::"nat"
  shows "supp (n) = {}"
  apply(simp add: supp_def perm_nat_def)
  done

lemma supp_char:
  fixes c::"char"
  shows "supp (c) = {}"
  apply(simp add: supp_def perm_char_def)
  done
  
lemma supp_string:
  fixes s::"string"
  shows "supp (s) = {}"
apply(simp add: supp_def perm_string)
done

lemma fresh_set_empty:
  shows "a\<sharp>{}"
  by (simp add: fresh_def supp_set_empty)

lemma fresh_singleton:
  shows "a\<sharp>{x} = a\<sharp>x"
  by (simp add: fresh_def supp_singleton)

lemma fresh_unit:
  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 ∧ a\<sharp>y)"
  by (simp add: fresh_def supp_prod)

lemma fresh_list_nil:
  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 ∧ 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 ∧ a\<sharp>ys)"
  by (simp add: fresh_def supp_list_append)

lemma fresh_list_rev:
  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:
  fixes a :: "'x"
  shows "a\<sharp>None"
  by (simp add: fresh_def supp_none)

lemma fresh_some:
  fixes a :: "'x"
  and   x :: "'a"
  shows "a\<sharp>(Some x) = a\<sharp>x"
  by (simp add: fresh_def supp_some)

lemma fresh_int:
  fixes a :: "'x"
  and   i :: "int"
  shows "a\<sharp>i"
  by (simp add: fresh_def supp_int)

lemma fresh_nat:
  fixes a :: "'x"
  and   n :: "nat"
  shows "a\<sharp>n"
  by (simp add: fresh_def supp_nat)

lemma fresh_char:
  fixes a :: "'x"
  and   c :: "char"
  shows "a\<sharp>c"
  by (simp add: fresh_def supp_char)

lemma fresh_string:
  fixes a :: "'x"
  and   s :: "string"
  shows "a\<sharp>s"
  by (simp add: fresh_def supp_string)

lemma fresh_bool:
  fixes a :: "'x"
  and   b :: "bool"
  shows "a\<sharp>b"
  by (simp add: fresh_def supp_bool)

text {* Normalization of freshness results; cf.\ @{text nominal_induct} *}

lemma fresh_unit_elim: 
  shows "(a\<sharp>() ==> PROP C) ≡ PROP C"
  by (simp add: fresh_def supp_unit)

lemma fresh_prod_elim: 
  shows "(a\<sharp>(x,y) ==> PROP C) ≡ (a\<sharp>x ==> a\<sharp>y ==> 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 ==> a\<sharp>x2 ==> a\<sharp>(x1,x2)"
  by (simp add: fresh_prod)

lemma fresh_prodD:
  shows "a\<sharp>(x,y) ==> a\<sharp>x"
  and   "a\<sharp>(x,y) ==> a\<sharp>y"
  by (simp_all add: fresh_prod)

ML_setup {*
  val mksimps_pairs = ("Nominal.fresh", thms "fresh_prodD")::mksimps_pairs;
  change_simpset (fn ss => ss setmksimps (mksimps mksimps_pairs));
*}


section {* Abstract Properties for Permutations and  Atoms *}
(*=========================================================*)

(* properties for being a permutation type *)
constdefs 
  "pt TYPE('a) TYPE('x) ≡ 
     (∀(x::'a). ([]::'x prm)•x = x) ∧ 
     (∀(pi1::'x prm) (pi2::'x prm) (x::'a). (pi1@pi2)•x = pi1•(pi2•x)) ∧ 
     (∀(pi1::'x prm) (pi2::'x prm) (x::'a). pi1 \<triangleq> pi2 --> pi1•x = pi2•x)"

(* properties for being an atom type *)
constdefs 
  "at TYPE('x) ≡ 
     (∀(x::'x). ([]::'x prm)•x = x) ∧
     (∀(a::'x) (b::'x) (pi::'x prm) (x::'x). ((a,b)#(pi::'x prm))•x = swap (a,b) (pi•x)) ∧ 
     (∀(a::'x) (b::'x) (c::'x). swap (a,b) c = (if a=c then b else (if b=c then a else c))) ∧ 
     (infinite (UNIV::'x set))"

(* property of two atom-types being disjoint *)
constdefs
  "disjoint TYPE('x) TYPE('y) ≡ 
       (∀(pi::'x prm)(x::'y). pi•x = x) ∧ 
       (∀(pi::'y prm)(x::'x). pi•x = x)"

(* composition property of two permutation on a type 'a *)
constdefs
  "cp TYPE ('a) TYPE('x) TYPE('y) ≡ 
      (∀(pi2::'y prm) (pi1::'x prm) (x::'a) . pi1•(pi2•x) = (pi1•pi2)•(pi1•x))" 

(* property of having finite support *)
constdefs 
  "fs TYPE('a) TYPE('x) ≡ ∀(x::'a). finite ((supp x)::'x set)"

section {* Lemmas about the atom-type properties*}
(*==============================================*)

lemma at1: 
  fixes x::"'x"
  assumes a: "at TYPE('x)"
  shows "([]::'x prm)•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)•x = swap (a,b) (pi•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 premutations *)
lemmas at_calc = at2 at1 at3

lemma at_swap_simps:
  fixes a ::"'x"
  and   b ::"'x"
  assumes a: "at TYPE('x)"
  shows "[(a,b)]•a = b"
  and   "[(a,b)]•b = a"
  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)•c = pi1•(pi2•c)"
proof (induct pi1)
  case Nil show ?case by (simp add: at1[OF at])
next
  case (Cons x xs)
  have "(xs@pi2)•c  =  xs•(pi2•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)•(pi•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•((rev pi)•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•x) = y"
  shows   "x=(rev pi)•y"
proof -
  from a have "y=(pi•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)•x) = y"
  shows   "x=pi•y"
proof -
  from a have "y=((rev pi)•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•x = pi•y) = (x=y)"
proof 
  assume "pi•x = pi•y" 
  hence  "x=(rev pi)•(pi•y)" by (rule at_bij1[OF at]) 
  thus "x=y" by (simp only: at_rev_pi[OF at])
next
  assume "x=y"
  thus "pi•x = pi•y" by simp
qed

lemma at_supp:
  fixes x :: "'x"
  assumes at: "at TYPE('x)"
  shows "supp x = {x}"
proof (simp add: supp_def Collect_conj_eq Collect_imp_eq at_calc[OF at], auto)
  assume f: "finite {b::'x. b ≠ x}"
  have a1: "{b::'x. b ≠ x} = UNIV-{x}" by force
  have a2: "infinite (UNIV::'x set)" by (rule at4[OF at])
  from f a1 a2 show False by force
qed

lemma at_fresh:
  fixes a :: "'x"
  and   b :: "'x"
  assumes at: "at TYPE('x)"
  shows "(a\<sharp>b) = (a≠b)" 
  by (simp add: at_supp[OF at] fresh_def)

lemma at_prm_fresh:
  fixes c :: "'x"
  and   pi:: "'x prm"
  assumes at: "at TYPE('x)"
  and     a: "c\<sharp>pi" 
  shows "pi•c = c"
using a
apply(induct pi)
apply(simp add: at1[OF at]) 
apply(force simp add: fresh_list_cons at2[OF at] fresh_prod at_fresh[OF at] at3[OF at])
done

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 "∀x::'x. (rev pi1)•x = (rev pi2)•x"
  hence "(rev (pi1::'x prm))•(pi2•(x::'x)) = (rev (pi2::'x prm))•(pi2•x)" by simp
  hence "(rev (pi1::'x prm))•((pi2::'x prm)•x) = (x::'x)" by (simp add: at_rev_pi[OF at])
  hence "(pi2::'x prm)•x = (pi1::'x prm)•x" by (simp add: at_bij2[OF at])
  thus "pi1•x  =  pi2•x" by simp
next
  fix x
  assume "∀x::'x. pi1•x = pi2•x"
  hence "(pi1::'x prm)•((rev pi2)•x) = (pi2::'x prm)•((rev pi2)•(x::'x))" by simp
  hence "(pi1::'x prm)•((rev pi2)•(x::'x)) = x" by (simp add: at_pi_rev[OF at])
  hence "(rev pi2)•x = (rev pi1)•(x::'x)" by (simp add: at_bij1[OF at])
  thus "(rev pi1)•x = (rev pi2)•(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 ==> (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)•a,(rev pi)•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)•b)]) \<triangleq> ([(pi•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•(swap (a,b) c) = swap (pi•a,pi•b) (pi•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•pi2)@pi1)"
apply(induct_tac pi2)
apply(simp add: prm_eq_def)
apply(auto simp add: prm_eq_def)
apply(simp add: at2[OF at])
apply(drule_tac x="aa" in spec)
apply(drule sym)
apply(simp)
apply(simp add: at_append[OF at])
apply(simp add: at2[OF at])
apply(simp add: at_ds8_aux[OF at])
done

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•pi2)))"
apply(induct_tac pi2)
apply(simp add: prm_eq_def)
apply(auto simp add: prm_eq_def)
apply(simp add: at_append[OF at])
apply(simp add: at2[OF at] at1[OF at])
apply(drule_tac x="swap(pi1•a,pi1•b) aa" in spec)
apply(drule sym)
apply(simp)
apply(simp add: at_ds8_aux[OF at])
apply(simp add: at_rev_pi[OF at])
done

lemma at_ds10:
  fixes pi :: "'x prm"
  and   a  :: "'x"
  and   b  :: "'x"
  assumes at: "at TYPE('x)"
  and     a:  "b\<sharp>(rev pi)"
  shows "([(pi•a,b)]@pi) \<triangleq> (pi@[(a,b)])"
using a
apply -
apply(rule at_prm_eq_trans)
apply(rule at_ds2[OF at])
apply(simp add: at_prm_fresh[OF at] at_rev_pi[OF at])
apply(rule at_prm_eq_refl)
done

--"there always exists an atom that is not being in a finite set"
lemma ex_in_inf:
  fixes   A::"'x set"
  assumes at: "at TYPE('x)"
  and     fs: "finite A"
  obtains c::"'x" where "c∉A"
proof -
  from  fs at4[OF at] have "infinite ((UNIV::'x set) - A)" 
    by (simp add: Diff_infinite_finite)
  hence "((UNIV::'x set) - A) ≠ ({}::'x set)" by (force simp only:)
  then obtain c::"'x" where "c∈((UNIV::'x set) - A)" by force
  then have "c∉A" by simp
  then show ?thesis using prems by simp 
qed

text {* there always exists a fresh name for an object with finite support *}
lemma at_exists_fresh': 
  fixes  x :: "'a"
  assumes at: "at TYPE('x)"
  and     fs: "finite ((supp x)::'x set)"
  shows "∃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: 
  shows "at (TYPE('a)) ==> finite (S::'a set) ==> ∃x. x ∉ S"
  apply (drule Diff_infinite_finite)
  apply (simp add: at_def)
  apply blast
  apply (subgoal_tac "UNIV - S ≠ {}")
  apply (simp only: ex_in_conv [symmetric])
  apply blast
  apply (rule notI)
  apply simp
  done

lemma at_different:
  assumes at: "at TYPE('x)"
  shows "∃(b::'x). a≠b"
proof -
  have "infinite (UNIV::'x set)" by (rule at4[OF at])
  hence inf2: "infinite (UNIV-{a})" by (rule infinite_remove)
  have "(UNIV-{a}) ≠ ({}::'x set)" 
  proof (rule_tac ccontr, drule_tac notnotD)
    assume "UNIV-{a} = ({}::'x set)"
    with inf2 have "infinite ({}::'x set)" by simp
    then show "False" by auto
  qed
  hence "∃(b::'x). b∈(UNIV-{a})" by blast
  then obtain b::"'x" where mem2: "b∈(UNIV-{a})" by blast
  from mem2 have "a≠b" by blast
  then show "∃(b::'x). a≠b" by blast
qed

--"the at-props imply the pt-props"
lemma at_pt_inst:
  assumes at: "at TYPE('x)"
  shows "pt TYPE('x) TYPE('x)"
apply(auto simp only: pt_def)
apply(simp only: at1[OF at])
apply(simp only: at_append[OF at]) 
apply(simp only: prm_eq_def)
done

section {* finite support properties *}
(*===================================*)

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)"
apply(simp add: fs_def) 
apply(simp add: at_supp[OF at])
done

lemma fs_unit_inst:
  shows "fs TYPE(unit) TYPE('x)"
apply(simp add: fs_def)
apply(simp add: supp_unit)
done

lemma fs_prod_inst:
  assumes fsa: "fs TYPE('a) TYPE('x)"
  and     fsb: "fs TYPE('b) TYPE('x)"
  shows "fs TYPE('a×'b) TYPE('x)"
apply(unfold fs_def)
apply(auto simp add: supp_prod)
apply(rule fs1[OF fsa])
apply(rule fs1[OF fsb])
done

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)"
apply(unfold fs_def, rule allI)
apply(case_tac x)
apply(auto simp add: supp_nprod)
apply(rule fs1[OF fsa])
apply(rule fs1[OF fsb])
done

lemma fs_list_inst:
  assumes fs: "fs TYPE('a) TYPE('x)"
  shows "fs TYPE('a list) TYPE('x)"
apply(simp add: fs_def, rule allI)
apply(induct_tac x)
apply(simp add: supp_list_nil)
apply(simp add: supp_list_cons)
apply(rule fs1[OF fs])
done

lemma fs_option_inst:
  assumes fs: "fs TYPE('a) TYPE('x)"
  shows "fs TYPE('a option) TYPE('x)"
apply(simp add: fs_def, rule allI)
apply(case_tac x)
apply(simp add: supp_none)
apply(simp add: supp_some)
apply(rule fs1[OF fs])
done

section {* Lemmas about the permutation properties *}
(*=================================================*)

lemma pt1:
  fixes x::"'a"
  assumes a: "pt TYPE('a) TYPE('x)"
  shows "([]::'x prm)•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)•x = pi1•(pi2•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 ==> pi1•x = pi2•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 ==> (rev pi1)•x = (rev pi2)•x"
  by (rule pt3[OF pt], simp add: at_prm_rev_eq[OF at])

section {* composition properties *}
(* ============================== *)
lemma cp1:
  fixes pi1::"'x prm"
  and   pi2::"'y prm"
  and   x  ::"'a"
  assumes cp: "cp TYPE ('a) TYPE('x) TYPE('y)"
  shows "pi1•(pi2•x) = (pi1•pi2)•(pi1•x)"
  using cp by (simp add: cp_def)

lemma cp_pt_inst:
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "cp TYPE('a) TYPE('x) TYPE('x)"
apply(auto simp add: cp_def pt2[OF pt,symmetric])
apply(rule pt3[OF pt])
apply(rule at_ds8[OF at])
done

section {* disjointness properties *}
(*=================================*)
lemma dj_perm_forget:
  fixes pi::"'y prm"
  and   x ::"'x"
  assumes dj: "disjoint TYPE('x) TYPE('y)"
  shows "pi•x=x" 
  using dj by (simp_all add: disjoint_def)

lemma dj_perm_perm_forget:
  fixes pi1::"'x prm"
  and   pi2::"'y prm"
  assumes dj: "disjoint TYPE('x) TYPE('y)"
  shows "pi2•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•(pi2•x) = (pi2)•(pi1•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)"
apply(simp add: supp_def dj_perm_forget[OF dj])
done

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 {* permutation type instances *}
(* ===================================*)

lemma pt_set_inst:
  assumes pt: "pt TYPE('a) TYPE('x)"
  shows  "pt TYPE('a set) TYPE('x)"
apply(simp add: pt_def)
apply(simp_all add: perm_set_def)
apply(simp add: pt1[OF pt])
apply(force simp add: pt2[OF pt] pt3[OF pt])
done

lemma pt_list_nil: 
  fixes xs :: "'a list"
  assumes pt: "pt TYPE('a) TYPE ('x)"
  shows "([]::'x prm)•xs = xs" 
apply(induct_tac xs)
apply(simp_all add: pt1[OF pt])
done

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)•xs = pi1•(pi2•xs)"
apply(induct_tac xs)
apply(simp_all add: pt2[OF pt])
done

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  ==> pi1•xs = pi2•xs"
apply(induct_tac xs)
apply(simp_all add: prm_eq_def pt3[OF pt])
done

lemma pt_list_inst:
  assumes pt: "pt TYPE('a) TYPE('x)"
  shows  "pt TYPE('a list) TYPE('x)"
apply(auto simp only: pt_def)
apply(rule pt_list_nil[OF pt])
apply(rule pt_list_append[OF pt])
apply(rule pt_list_prm_eq[OF pt],assumption)
done

lemma pt_unit_inst:
  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 × 'b) TYPE('x)"
  apply(auto simp add: pt_def)
  apply(rule pt1[OF pta])
  apply(rule pt1[OF ptb])
  apply(rule pt2[OF pta])
  apply(rule pt2[OF ptb])
  apply(rule pt3[OF pta],assumption)
  apply(rule pt3[OF ptb],assumption)
  done

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)"
  apply(auto simp add: pt_def)
  apply(case_tac x)
  apply(simp add: pt1[OF pta] pt1[OF ptb])
  apply(case_tac x)
  apply(simp add: pt2[OF pta] pt2[OF ptb])
  apply(case_tac x)
  apply(simp add: pt3[OF pta] pt3[OF ptb])
  done

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=>'b) TYPE('x)"
apply(auto simp only: pt_def)
apply(simp_all add: perm_fun_def)
apply(simp add: pt1[OF pta] pt1[OF ptb])
apply(simp add: pt2[OF pta] pt2[OF ptb])
apply(subgoal_tac "(rev pi1) \<triangleq> (rev pi2)")(*A*)
apply(simp add: pt3[OF pta] pt3[OF ptb])
(*A*)
apply(simp add: at_prm_rev_eq[OF at])
done

lemma pt_option_inst:
  assumes pta: "pt TYPE('a) TYPE('x)"
  shows  "pt TYPE('a option) TYPE('x)"
apply(auto simp only: pt_def)
apply(case_tac "x")
apply(simp_all add: pt1[OF pta])
apply(case_tac "x")
apply(simp_all add: pt2[OF pta])
apply(case_tac "x")
apply(simp_all add: pt3[OF pta])
done

lemma pt_noption_inst:
  assumes pta: "pt TYPE('a) TYPE('x)"
  shows  "pt TYPE('a noption) TYPE('x)"
apply(auto simp only: pt_def)
apply(case_tac "x")
apply(simp_all add: pt1[OF pta])
apply(case_tac "x")
apply(simp_all add: pt2[OF pta])
apply(case_tac "x")
apply(simp_all add: pt3[OF pta])
done

lemma pt_bool_inst:
  shows  "pt TYPE(bool) TYPE('x)"
  by (simp add: pt_def perm_bool)

section {* further lemmas for permutation types *}
(*==============================================*)

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)•(pi•x) = x"
proof -
  have "((rev pi)@pi) \<triangleq> ([]::'x prm)" by (simp add: at_ds7[OF at])
  hence "((rev pi)@pi)•(x::'a) = ([]::'x prm)•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•((rev pi)•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•x) = y"
  shows   "x=(rev pi)•y"
proof -
  from a have "y=(pi•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)•y"
  shows   "(pi•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•x = pi•y) = (x=y)"
proof 
  assume "pi•x = pi•y" 
  hence  "x=(rev pi)•(pi•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•x = pi•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•(x=y) = (pi•x = pi•y)"
using assms
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•x = pi•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•x = pi•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)]•([(a,b)]•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)]•([(b,a)]•x) = x"
apply(simp add: pt2[OF pt,symmetric])
apply(rule trans)
apply(rule pt3[OF pt])
apply(rule at_ds5'[OF at])
apply(rule pt1[OF pt])
done

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)]•x = x"
apply(rule trans)
apply(rule pt3[OF pt])
apply(rule at_ds1[OF at])
apply(rule pt1[OF pt])
done

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•x)∈X) = (x∈((rev pi)•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∈(pi•X)) = (((rev pi)•x)∈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•x)∈(pi•X)) = (x∈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•(x∈X)=((pi•x)∈(pi•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∈X"
  shows "(pi•x)∈(pi•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∈((rev pi)•X)"
  shows "(pi•x)∈X"
  using a by (simp add: pt_set_bij1[OF pt, OF at])

lemma pt_set_bij3:
  fixes pi :: "'x prm"
  and   x  :: "'a"
  and   X  :: "'a set"
  shows "pi•(x∈X) = (x∈X)"
apply(case_tac "x∈X = True")
apply(auto)
done

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•X)⊆(pi•Y)) = (X⊆Y)"
proof (auto)
  fix x::"'a"
  assume a: "(pi•X)⊆(pi•Y)"
  and    "x∈X"
  hence  "(pi•x)∈(pi•X)" by (simp add: pt_set_bij[OF pt, OF at])
  with a have "(pi•x)∈(pi•Y)" by force
  thus "x∈Y" by (simp add: pt_set_bij[OF pt, OF at])
next
  fix x::"'a"
  assume a: "X⊆Y"
  and    "x∈(pi•X)"
  thus "x∈(pi•Y)" by (force simp add: pt_set_bij1a[OF pt, OF at])
qed

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•(X - Y) = (pi•X) - (pi•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•{x::'a. P x} = {x. P ((rev pi)•x)}"
apply(auto simp add: perm_set_def  pt_rev_pi[OF pt, OF at])
apply(rule_tac x="(rev pi)•x" in exI)
apply(simp add: pt_pi_rev[OF pt, OF at])
done

-- "some helper lemmas for the pt_perm_supp_ineq lemma"
lemma Collect_permI: 
  fixes pi :: "'x prm"
  and   x  :: "'a"
  assumes a: "∀x. (P1 x = P2 x)" 
  shows "{pi•x| x. P1 x} = {pi•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•x| x::'x. P x} = {x::'x. P ((rev pi)•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•x = pi•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•X) = finite X"
proof -
  have image: "(pi•X) = (perm pi ` X)" by (force simp only: perm_set_def)
  show ?thesis
  proof (rule iffI)
    assume "finite (pi•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•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•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•((supp x)::'y set)) = supp (pi•x)" (is "?LHS = ?RHS")
proof -
  have "?LHS = {pi•a | a. infinite {b. [(a,b)]•x ≠ x}}" by (simp add: supp_def perm_set_def)
  also have "… = {pi•a | a. infinite {pi•b | b. [(a,b)]•x ≠ x}}" 
  proof (rule Collect_permI, rule allI, rule iffI)
    fix a
    assume "infinite {b::'y. [(a,b)]•x  ≠ x}"
    hence "infinite (pi•{b::'y. [(a,b)]•x ≠ x})" by (simp add: pt_set_infinite_ineq[OF ptb, OF at])
    thus "infinite {pi•b |b::'y. [(a,b)]•x  ≠ x}" by (simp add: perm_set_def)
  next
    fix a
    assume "infinite {pi•b |b::'y. [(a,b)]•x ≠ x}"
    hence "infinite (pi•{b::'y. [(a,b)]•x ≠ x})" by (simp add: perm_set_def)
    thus "infinite {b::'y. [(a,b)]•x  ≠ x}" 
      by (simp add: pt_set_infinite_ineq[OF ptb, OF at])
  qed
  also have "… = {a. infinite {b::'y. [((rev pi)•a,(rev pi)•b)]•x ≠ x}}" 
    by (simp add: pt_set_eq_ineq[OF ptb, OF at])
  also have "… = {a. infinite {b. pi•([((rev pi)•a,(rev pi)•b)]•x) ≠ (pi•x)}}"
    by (simp add: pt_bij[OF pta, OF at])
  also have "… = {a. infinite {b. [(a,b)]•(pi•x) ≠ (pi•x)}}"
  proof (rule Collect_cong, rule Infinite_cong, rule Collect_cong)
    fix a::"'y" and b::"'y"
    have "pi•(([((rev pi)•a,(rev pi)•b)])•x) = [(a,b)]•(pi•x)"
      by (simp add: cp1[OF cp] pt_pi_rev[OF ptb, OF at])
    thus "(pi•([((rev pi)•a,(rev pi)•b)]•x) ≠  pi•x) = ([(a,b)]•(pi•x) ≠ pi•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•((supp x)::'x set)) = supp (pi•x)"
apply(rule pt_perm_supp_ineq)
apply(rule pt)
apply(rule at_pt_inst)
apply(rule at)+
apply(rule cp_pt_inst)
apply(rule pt)
apply(rule at)
done

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•x))::'x set)"
apply(simp add: pt_perm_supp[OF pt, OF at, symmetric])
apply(simp add: pt_set_finite_ineq[OF at_pt_inst[OF at], OF at])
apply(rule f)
done

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•x) = ((rev pi)•a)\<sharp>x"
apply(simp add: fresh_def)
apply(simp add: pt_set_bij1[OF ptb, OF at])
apply(simp add: pt_perm_supp_ineq[OF pta, OF ptb, OF at, OF cp])
done

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•a)\<sharp>x = a\<sharp>((rev pi)•x)"
apply(simp add: fresh_def)
apply(simp add: pt_set_bij1[OF ptb, OF at])
apply(simp add: pt_perm_supp_ineq[OF pta, OF ptb, OF at, OF cp])
done

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•a)\<sharp>(pi•x) = a\<sharp>x"
apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
apply(simp add: pt_rev_pi[OF ptb, OF at])
done

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•x) = ((rev pi)•a)\<sharp>x"
apply(rule pt_fresh_left_ineq)
apply(rule pt)
apply(rule at_pt_inst)
apply(rule at)+
apply(rule cp_pt_inst)
apply(rule pt)
apply(rule at)
done

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•a)\<sharp>x = a\<sharp>((rev pi)•x)"
apply(rule pt_fresh_right_ineq)
apply(rule pt)
apply(rule at_pt_inst)
apply(rule at)+
apply(rule cp_pt_inst)
apply(rule pt)
apply(rule at)
done

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•a)\<sharp>(pi•x) = a\<sharp>x"
apply(rule pt_fresh_bij_ineq)
apply(rule pt)
apply(rule at_pt_inst)
apply(rule at)+
apply(rule cp_pt_inst)
apply(rule pt)
apply(rule at)
done

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•a)\<sharp>(pi•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•a)\<sharp>(pi•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•(a\<sharp>x) = (pi•a)\<sharp>(pi•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: "¬(a\<sharp>x)"
  and     a2: "b\<sharp>x"
  shows "[(a,b)]•x ≠ x"
proof
  assume neg: "[(a,b)]•x = x"
  from a1 have a1':"a∈(supp x)" by (simp add: fresh_def) 
  from a2 have a2':"b∉(supp x)" by (simp add: fresh_def) 
  from a1' a2' have a3: "a≠b" by force
  from a1' have "([(a,b)]•a)∈([(a,b)]•(supp x))" 
    by (simp only: pt_set_bij[OF at_pt_inst[OF at], OF at])
  hence "b∈([(a,b)]•(supp x))" by (simp add: at_calc[OF at])
  hence "b∈(supp ([(a,b)]•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≠a" and  a2: "a\<sharp>x" and a3: "c\<sharp>x"
  shows "c\<sharp>([(a,b)]•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•x)"
using assms
proof -
  have "a\<sharp>(rev pi)"using h1 by (simp add: fresh_list_rev)
  then have "(rev pi)•a = a" by (simp add: at_prm_fresh[OF at])
  then have "((rev pi)•a)\<sharp>x" using h2 by simp
  thus "a\<sharp>(pi•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•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•(c\<sharp>x) = (pi•c)\<sharp>(pi•x)"
by (simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp] dj_perm_forget[OF dj] perm_bool)

-- "three helper lemmas for the perm_fresh_fresh-lemma"
lemma comprehension_neg_UNIV: "{b. ¬ P b} = UNIV - {b. P b}"
  by (auto)

lemma infinite_or_neg_infinite:
  assumes h:"infinite (UNIV::'a set)"
  shows "infinite {b::'a. P b} ∨ infinite {b::'a. ¬ P b}"
proof (subst comprehension_neg_UNIV, case_tac "finite {b. P b}")
  assume j:"finite {b::'a. P b}"
  have "infinite ((UNIV::'a set) - {b::'a. P b})"
    using Diff_infinite_finite[OF j h] by auto
  thus "infinite {b::'a. P b} ∨ infinite (UNIV - {b::'a. P b})" ..
next
  assume j:"infinite {b::'a. P b}"
  thus "infinite {b::'a. P b} ∨ infinite (UNIV - {b::'a. P b})" by simp
qed

--"the co-set of a finite set is infinte"
lemma finite_infinite:
  assumes a: "finite {b::'x. P b}"
  and     b: "infinite (UNIV::'x set)"        
  shows "infinite {b. ¬P b}"
  using a and infinite_or_neg_infinite[OF b] by simp

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)]•x=x"
proof (cases "a=b")
  assume "a=b"
  hence "[(a,b)] \<triangleq> []" by (simp add: at_ds1[OF at])
  hence "[(a,b)]•x=([]::'x prm)•x" by (rule pt3[OF pt])
  thus ?thesis by (simp only: pt1[OF pt])
next
  assume c2: "a≠b"
  from a1 have f1: "finite {c. [(a,c)]•x ≠ x}" by (simp add: fresh_def supp_def)
  from a2 have f2: "finite {c. [(b,c)]•x ≠ x}" by (simp add: fresh_def supp_def)
  from f1 and f2 have f3: "finite {c. perm [(a,c)] x ≠ x ∨ perm [(b,c)] x ≠ x}" 
    by (force simp only: Collect_disj_eq)
  have "infinite {c. [(a,c)]•x = x ∧ [(b,c)]•x = x}" 
    by (simp add: finite_infinite[OF f3,OF at4[OF at], simplified])
  hence "infinite ({c. [(a,c)]•x = x ∧ [(b,c)]•x = x}-{a,b})" 
    by (force dest: Diff_infinite_finite)
  hence "({c. [(a,c)]•x = x ∧ [(b,c)]•x = x}-{a,b}) ≠ {}" 
    by (auto iff del: finite_Diff_insert Diff_eq_empty_iff)
  hence "∃c. c∈({c. [(a,c)]•x = x ∧ [(b,c)]•x = x}-{a,b})" by (force)
  then obtain c 
    where eq1: "[(a,c)]•x = x" 
      and eq2: "[(b,c)]•x = x" 
      and ineq: "a≠c ∧ b≠c"
    by (force)
  hence "[(a,c)]•([(b,c)]•([(a,c)]•x)) = x" by simp 
  hence eq3: "[(a,c),(b,c),(a,c)]•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)]•x = [(a,b)]•x" by (rule pt3[OF pt])
  thus ?thesis using eq3 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•(pi1•x) = (pi2•pi1)•(pi2•x)" 
proof -
  have "(pi2@pi1) \<triangleq> ((pi2•pi1)@pi2)" by (rule at_ds8 [OF at])
  hence "(pi2@pi1)•x = ((pi2•pi1)@pi2)•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•pi1)•x = pi2•(pi1•((rev pi2)•x))" 
proof -
  have "pi2•(pi1•((rev pi2)•x)) = (pi2•pi1)•(pi2•((rev pi2)•x))"
    by (rule pt_perm_compose[OF pt, OF at])
  also have "… = (pi2•pi1)•x" by (simp add: pt_pi_rev[OF pt, OF at])
  finally have "pi2•(pi1•((rev pi2)•x)) = (pi2•pi1)•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)•((rev pi1)•x) = (rev pi1)•(rev (pi1•pi2)•x)" 
proof -
  have "((rev pi2)@(rev pi1)) \<triangleq> ((rev pi1)@(rev (pi1•pi2)))" by (rule at_ds9[OF at])
  hence "((rev pi2)@(rev pi1))•x = ((rev pi1)@(rev (pi1•pi2)))•x" by (rule pt3[OF pt])
  thus ?thesis by (simp add: pt2[OF pt])
qed

section {* equivaraince for some connectives *}

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•(∀(x::'a). P x) = (∀(x::'a). pi•(P ((rev pi)•x)))"
apply(auto simp add: perm_bool perm_fun_def)
apply(drule_tac x="pi•x" in spec)
apply(simp add: pt_rev_pi[OF pt, OF at])
done

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•(∃(x::'a). P x) = (∃(x::'a). pi•(P ((rev pi)•x)))"
apply(auto simp add: perm_bool perm_fun_def)
apply(rule_tac x="pi•x" in exI) 
apply(simp add: pt_rev_pi[OF pt, OF at])
done

section {* facts about supports *}
(*==============================*)

lemma supports_subset:
  fixes x  :: "'a"
  and   S1 :: "'x set"
  and   S2 :: "'x set"
  assumes  a: "S1 supports x"
  and      b: "S1 ⊆ 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)⊆S"
proof (rule ccontr)
  assume "¬(supp x ⊆ S)"
  hence "∃a. a∈(supp x) ∧ a∉S" by force
  then obtain a where b1: "a∈supp x" and b2: "a∉S" by force
  from a1 b2 have "∀b. (b∉S --> ([(a,b)]•x = x))" by (unfold supports_def, force)
  hence "{b. [(a,b)]•x ≠ x}⊆S" by force
  with a2 have "finite {b. [(a,b)]•x ≠ x}" by (simp add: finite_subset)
  hence "a∉(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)∉(supp x) ∧ (b::'x)∉(supp x)"
  hence "a\<sharp>x" and "b\<sharp>x" by (auto simp add: fresh_def)
  thus "[(a,b)]•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)⊆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 ∧ S supports x})"
proof (rule equalityI)
  show "((supp x)::'x set) ⊆ (\<Inter> {S. finite S ∧ S supports x})"
  proof (clarify)
    fix S c
    assume b: "c∈((supp x)::'x set)" and "finite (S::'x set)" and "S supports x"
    hence  "((supp x)::'x set)⊆S" by (simp add: supp_is_subset) 
    with b show "c∈S" by force
  qed
next
  show "(\<Inter> {S. finite S ∧ S supports x}) ⊆ ((supp x)::'x set)"
  proof (clarify, simp)
    fix c
    assume d: "∀(S::'x set). finite S ∧ S supports x --> c∈S"
    have "((supp x)::'x set) supports x" by (rule supp_supports[OF pt, OF at])
    with d fs1[OF fs] show "c∈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: "∀S'. (S' supports x) --> S⊆S'"
  shows "S = (supp x)"
proof (rule equalityI)
  show "((supp x)::'x set)⊆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⊆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: "∀x∈X. (∀(a::'x) (b::'x). a∉S∧b∉S --> ([(a,b)]•x)∈X)"
  shows  "S supports X"
using a
apply(auto simp add: supports_def)
apply(simp add: pt_set_bij1a[OF pt, OF at])
apply(force simp add: pt_swap_bij[OF pt, OF at])
apply(simp add: pt_set_bij1a[OF pt, OF at])
done

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∉S"
  shows "a\<sharp>x"
proof (simp add: fresh_def)
  have "(supp x)⊆S" using a1 a2 by (rule supp_is_subset)
  thus "a∉(supp x)" using a3 by force
qed

lemma at_fin_set_supports:
  fixes X::"'x set"
  assumes at: "at TYPE('x)"
  shows "X supports X"
proof -
  have "∀a b. a∉X ∧ b∉X --> [(a,b)]•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:"∀b∈X. P(b)"
  shows "infinite {b∈X. P(b)}"
  using a1 a2 
  apply auto
  apply (subgoal_tac "infinite (X - {b∈X. P b})")
  apply (simp add: set_diff_def)
  apply (simp add: Diff_infinite_finite)
  done

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) ⊆ 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∈X"
    hence "∀b∈(UNIV-X). [(a,b)]•X≠X" by (auto simp add: perm_set_def at_calc[OF at])
    with inf have "infinite {b∈(UNIV-X). [(a,b)]•X≠X}" by (rule infinite_Collection)
    hence "infinite {b. [(a,b)]•X≠X}" by (rule_tac infinite_super, auto)
    hence "a∈(supp X)" by (simp add: supp_def)
  }
  then show "X⊆(supp X)" by blast
qed

section {* Permutations acting on Functions *}
(*==========================================*)

lemma pt_fun_app_eq:
  fixes f  :: "'a=>'b"
  and   x  :: "'a"
  and   pi :: "'x prm"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "pi•(f x) = (pi•f)(pi•x)"
  by (simp add: perm_fun_def pt_rev_pi[OF pt, OF at])


--"sometimes pt_fun_app_eq does too much; this lemma 'corrects it'"
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•perm pi2)(pi1•x) = pi1•(pi2•x)" 
  by (simp add: pt_fun_app_eq[OF pt, OF at])


lemma pt_fun_eq:
  fixes f  :: "'a=>'b"
  and   pi :: "'x prm"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "(pi•f = f) = (∀ x. pi•(f x) = f (pi•x))" (is "?LHS = ?RHS")
proof
  assume a: "?LHS"
  show "?RHS"
  proof
    fix x
    have "pi•(f x) = (pi•f)(pi•x)" by (simp add: pt_fun_app_eq[OF pt, OF at])
    also have "… = f (pi•x)" using a by simp
    finally show "pi•(f x) = f (pi•x)" by simp
  qed
next
  assume b: "?RHS"
  show "?LHS"
  proof (rule ccontr)
    assume "(pi•f) ≠ f"
    hence "∃x. (pi•f) x ≠ f x" by (simp add: expand_fun_eq)
    then obtain x where b1: "(pi•f) x ≠ f x" by force
    from b have "pi•(f ((rev pi)•x)) = f (pi•((rev pi)•x))" by force
    hence "(pi•f)(pi•((rev pi)•x)) = f (pi•((rev pi)•x))" 
      by (simp add: pt_fun_app_eq[OF pt, OF at])
    hence "(pi•f) x = f x" by (simp add: pt_pi_rev[OF pt, OF at])
    with b1 show "False" by simp
  qed
qed

-- "two helper lemmas for the equivariance of functions"
lemma pt_swap_eq_aux:
  fixes   y :: "'a"
  and    pi :: "'x prm"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     a: "∀(a::'x) (b::'x). [(a,b)]•y = y"
  shows "pi•y = y"
proof(induct pi)
  case Nil show ?case by (simp add: pt1[OF pt])
next
  case (Cons x xs)
  have ih: "xs•y = y" by fact
  obtain a b where p: "x=(a,b)" by force
  have "((a,b)#xs)•y = ([(a,b)]@xs)•y" by simp
  also have "… = [(a,b)]•(xs•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 "(∀(a::'x) (b::'x). [(a,b)]•y = y) = (∀pi::'x prm. pi•y = y)"
  by (force intro: pt_swap_eq_aux[OF pt])

lemma pt_eqvt_fun1a:
  fixes f     :: "'a=>'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 "∀(pi::'x prm). pi•f = f" 
proof (intro strip)
  fix pi
  have "∀a b. a∉((supp f)::'x set) ∧ b∉((supp f)::'x set) --> (([(a,b)]•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 "∀(a::'x) (b::'x). ([(a,b)]•f) = f" by force
  hence "∀(pi::'x prm). pi•f = f" 
    by (simp add: pt_swap_eq[OF pt_fun_inst[OF pta, OF ptb, OF at]])
  thus "(pi::'x prm)•f = f" by simp
qed

lemma pt_eqvt_fun1b:
  fixes f     :: "'a=>'b"
  assumes a: "∀(pi::'x prm). pi•f = f"
  shows "((supp f)::'x set)={}"
using a by (simp add: supp_def)

lemma pt_eqvt_fun1:
  fixes f     :: "'a=>'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)={}) = (∀(pi::'x prm). pi•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=>'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 "∀(pi::'x prm) (x::'a). pi•(f x) = f(pi•x)" 
proof (intro strip)
  fix pi x
  from a have b: "∀(pi::'x prm). pi•f = f" by (simp add: pt_eqvt_fun1[OF pta, OF ptb, OF at]) 
  have "(pi::'x prm)•(f x) = (pi•f)(pi•x)" by (simp add: pt_fun_app_eq[OF pta, OF at]) 
  with b show "(pi::'x prm)•(f x) = f (pi•x)" by force 
qed

lemma pt_eqvt_fun2b:
  fixes f     :: "'a=>'b"
  assumes pt1: "pt TYPE('a) TYPE('x)"
  and     pt2: "pt TYPE('b) TYPE('x)"
  and     at: "at TYPE('x)"
  assumes a: "∀(pi::'x prm) (x::'a). pi•(f x) = f(pi•x)"
  shows "((supp f)::'x set)={}"
proof -
  from a have "∀(pi::'x prm). pi•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=>'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)={}) = (∀(pi::'x prm) (x::'a). pi•(f x) = f(pi•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=>'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) ⊆ (((supp f)∪(supp x))::'x set)"
proof -
  have s1: "((supp f)∪((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)]•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)]•x = x" by (rule pt_fresh_fresh[OF pta, OF at])
    from a1 a2 show "[(a,b)]•(f x) = (f x)" by (simp add: pt_fun_app_eq[OF pta, OF at])
  qed
  from f1 f2 have "finite ((supp f)∪((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=>'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) ⊆ ((supp x)::'x set)"
proof (unfold supp_def, auto)
  fix a::"'x"
  assume a1: "finite {b. [(a, b)]•x ≠ x}"
  assume "infinite {b. [(a, b)]•(f x) ≠ f x}"
  hence a2: "infinite {b. f ([(a, b)]•x) ≠ f x}" using e
    by (simp add: pt_eqvt_fun2[OF pta, OF ptb, OF at])
  have a3: "{b. f ([(a,b)]•x) ≠ f x}⊆{b. [(a,b)]•x ≠ x}" by force
  from a1 a2 a3 show False by (force dest: finite_subset)
qed

section {* Facts about the support of finite sets of finitely supported things *}
(*=============================================================================*)

constdefs
  X_to_Un_supp :: "('a set) => 'x set"
  "X_to_Un_supp X ≡ \<Union>x∈X. ((supp x)::'x set)"

lemma UNION_f_eqvt:
  fixes X::"('a set)"
  and   f::"'a => 'x set"
  and   pi::"'x prm"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "pi•(\<Union>x∈X. f x) = (\<Union>x∈(pi•X). (pi•f) x)"
proof -
  have pt_x: "pt TYPE('x) TYPE('x)" by (force intro: at_pt_inst at)
  show ?thesis
  proof (rule equalityI)
    case goal1
    show "pi•(\<Union>x∈X. f x) ⊆ (\<Union>x∈(pi•X). (pi•f) x)"
      apply(auto simp add: perm_set_def)
      apply(rule_tac x="pi•xb" in exI)
      apply(rule conjI)
      apply(rule_tac x="xb" in exI)
      apply(simp)
      apply(subgoal_tac "(pi•f) (pi•xb) = pi•(f xb)")(*A*)
      apply(simp)
      apply(rule pt_set_bij2[OF pt_x, OF at])
      apply(assumption)
      (*A*)
      apply(rule sym)
      apply(rule pt_fun_app_eq[OF pt, OF at])
      done
  next
    case goal2
    show "(\<Union>x∈(pi•X). (pi•f) x) ⊆ pi•(\<Union>x∈X. f x)"
      apply(auto simp add: perm_set_def)
      apply(rule_tac x="(rev pi)•x" in exI)
      apply(rule conjI)
      apply(simp add: pt_pi_rev[OF pt_x, OF at])
      apply(rule_tac x="xb" in bexI)
      apply(simp add: pt_set_bij1[OF pt_x, OF at])
      apply(simp add: pt_fun_app_eq[OF pt, OF at])
      apply(assumption)
      done
  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•(X_to_Un_supp X) = ((X_to_Un_supp (pi•X))::'x set)"
  apply(simp add: X_to_Un_supp_def)
  apply(simp add: UNION_f_eqvt[OF pt, OF at] perm_fun_def)
  apply(simp add: pt_perm_supp[OF pt, OF at])
  apply(simp add: pt_pi_rev[OF pt, OF at])
  done

lemma Union_supports_set:
  fixes X::"('a set)"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "(\<Union>x∈X. ((supp x)::'x set)) supports X"
  apply(simp add: supports_def fresh_def[symmetric])
  apply(rule allI)+
  apply(rule impI)
  apply(erule conjE)
  apply(simp add: perm_set_def)
  apply(auto)
  apply(subgoal_tac "[(a,b)]•xa = xa")(*A*)
  apply(simp)
  apply(rule pt_fresh_fresh[OF pt, OF at])
  apply(force)
  apply(force)
  apply(rule_tac x="x" in exI)
  apply(simp)
  apply(rule sym)
  apply(rule pt_fresh_fresh[OF pt, OF at])
  apply(force)+
  done

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∈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∈X. ((supp x)::'x set)) ⊆ supp X"
proof -
  have "supp ((X_to_Un_supp X)::'x set) ⊆ ((supp X)::'x set)"  
    apply(rule pt_empty_supp_fun_subset)
    apply(force intro: pt_set_inst at_pt_inst pt at)+
    apply(rule pt_eqvt_fun2b)
    apply(force intro: pt_set_inst at_pt_inst pt at)+
    apply(rule allI)+
    apply(rule X_to_Un_supp_eqvt[OF pt, OF at])
    done
  hence "supp (\<Union>x∈X. ((supp x)::'x set)) ⊆ ((supp X)::'x set)" by (simp add: X_to_Un_supp_def)
  moreover
  have "supp (\<Union>x∈X. ((supp x)::'x set)) = (\<Union>x∈X. ((supp x)::'x set))"
    apply(rule at_fin_set_supp[OF at])
    apply(rule Union_of_fin_supp_sets[OF fs, OF fi])
    done
  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∈X. ((supp x)::'x set))"
apply(rule equalityI)
apply(rule supp_is_subset)
apply(rule Union_supports_set[OF pt, OF at])
apply(rule Union_of_fin_supp_sets[OF fs, OF fi])
apply(rule Union_included_in_supp[OF pt, OF at, OF fs, OF fi])
done

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∪Y)) = (supp X)∪((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)∪((supp X)::'x set)"
proof -
  have "(supp (insert x X)) = ((supp ({x}∪(X::'a set)))::'x set)" by simp
  also have "… = (supp {x})∪(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)∪((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∪Y) = (a\<sharp>X ∧ a\<sharp>Y)"
apply(simp add: fresh_def)
apply(simp add: supp_fin_union[OF pt, OF at, OF fs, OF f1, OF f2])
done

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 ∧ a\<sharp>X)"
apply(simp add: fresh_def)
apply(simp add: supp_fin_insert[OF pt, OF at, OF fs, OF f])
done

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
apply(simp add: fresh_fin_insert[OF pt, OF at, OF fs, OF f])
done

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∈(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∈(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 {* composition instances *}
(* ============================= *)

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(simp add: cp_def)
apply(auto)
apply(induct_tac x)
apply(auto)
done

lemma cp_set_inst:
  assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
  shows "cp TYPE ('a set) TYPE('x) TYPE('y)"
using c1
apply(simp add: cp_def)
apply(auto)
apply(auto simp add: perm_set_def)
apply(rule_tac x="pi2•xc" in exI)
apply(auto)
done

lemma cp_option_inst:
  assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
  shows "cp TYPE ('a option) TYPE('x) TYPE('y)"
using c1
apply(simp add: cp_def)
apply(auto)
apply(case_tac x)
apply(auto)
done

lemma cp_noption_inst:
  assumes c1: "cp TYPE ('a) TYPE('x) TYPE('y)"
  shows "cp TYPE ('a noption) TYPE('x) TYPE('y)"
using c1
apply(simp add: cp_def)
apply(auto)
apply(case_tac x)
apply(auto)
done

lemma cp_unit_inst:
  shows "cp TYPE (unit) TYPE('x) TYPE('y)"
apply(simp add: cp_def)
done

lemma cp_bool_inst:
  shows "cp TYPE (bool) TYPE('x) TYPE('y)"
apply(simp add: cp_def)
apply(rule allI)+
apply(induct_tac x)
apply(simp_all)
done

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×'b) TYPE('x) TYPE('y)"
using c1 c2
apply(simp add: cp_def)
done

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=>'b) TYPE('x) TYPE('y)"
using c1 c2
apply(auto simp add: cp_def perm_fun_def expand_fun_eq)
apply(simp add: rev_eqvt[symmetric])
apply(simp add: pt_rev_pi[OF pt_list_inst[OF pt_prod_inst[OF pt, OF pt]], OF at])
done


section {* Andy's freshness lemma *}
(*================================*)

lemma freshness_lemma:
  fixes h :: "'x=>'a"
  assumes pta: "pt TYPE('a) TYPE('x)"
  and     at:  "at TYPE('x)" 
  and     f1:  "finite ((supp h)::'x set)"
  and     a: "∃a::'x. a\<sharp>(h,h a)"
  shows  "∃fr::'a. ∀a::'x. a\<sharp>h --> (h a) = fr"
proof -
  have ptb: "pt TYPE('x) TYPE('x)" by (simp add: at_pt_inst[OF at]) 
  have ptc: "pt TYPE('x=>'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 "∀(a::'x). (a\<sharp>h --> ((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≠a0"
        hence c1: "a∉((supp a0)::'x set)" by  (simp add: fresh_def[symmetric] at_fresh[OF at])
        have c2: "a∉((supp h)::'x set)" using a3 by (simp add: fresh_def)
        from c1 c2 have c3: "a∉((supp h)∪((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)⊆((supp h)∪(supp a0))"
          by (simp add: pt_supp_fun_subset[OF ptb, OF pta, OF at])
        hence "a∉((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)]•(h a0) = (h a0)" by (rule pt_fresh_fresh[OF pta, OF at])
        from a1 a3 have d2: "[(a0,a)]•h = h" by (rule pt_fresh_fresh[OF ptc, OF at])
        from d1 have "h a0 = [(a0,a)]•(h a0)" by simp
        also have "…= ([(a0,a)]•h)([(a0,a)]•a0)" by (simp add: pt_fun_app_eq[OF ptb, OF at])
        also have "… = h ([(a0,a)]•a0)" using d2 by simp
        also have "… = 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=>'a"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)" 
  and     f1: "finite ((supp h)::'x set)"
  and     a: "∃(a::'x). a\<sharp>(h,h a)"
  shows  "∃!(fr::'a). ∀(a::'x). a\<sharp>h --> (h a) = fr"
proof (rule ex_ex1I)
  from pt at f1 a show "∃fr::'a. ∀a::'x. a\<sharp>h --> h a = fr" by (simp add: freshness_lemma)
next
  fix fr1 fr2
  assume b1: "∀a::'x. a\<sharp>h --> h a = fr1"
  assume b2: "∀a::'x. a\<sharp>h --> 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 ∧ h a = fr2" by force
  thus "fr1 = fr2" by force
qed

-- "packaging the freshness lemma into a function"
constdefs
  fresh_fun :: "('x=>'a)=>'a"
  "fresh_fun (h) ≡ THE fr. (∀(a::'x). a\<sharp>h --> (h a) = fr)"

lemma fresh_fun_app:
  fixes h :: "'x=>'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::'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 "∀(a'::'x). a'\<sharp>h --> h a' = h a"
  proof (intro strip)
    fix a'::"'x"
    assume c: "a'\<sharp>h"
    from pt at f1 a have "∃(fr::'a). ∀(a::'x). a\<sharp>h --> (h a) = fr" by (rule freshness_lemma)
    with b c show "h a' = h a" by force
  qed
next
  fix fr::"'a"
  assume "∀a. a\<sharp>h --> h a = fr"
  with b show "fr = h a" by force
qed

lemma fresh_fun_app':
  fixes h :: "'x=>'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)"
apply(rule fresh_fun_app[OF pt, OF at, OF f1])
apply(auto simp add: fresh_prod intro: a)
done

lemma fresh_fun_equiv_ineq:
  fixes h :: "'y=>'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: "∃(a::'y). a\<sharp>(h,h a)"
  shows "pi•(fresh_fun h) = fresh_fun(pi•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=>'a) TYPE('x)" by (simp add: pt_fun_inst[OF ptb, OF pta, OF at]) 
  have cpc: "cp TYPE('y=>'a) TYPE ('x) TYPE ('y)" by (rule cp_fun_inst[OF cpb cpa ptb at])
  have f2: "finite ((supp (pi•h))::'y set)"
  proof -
    from f1 have "finite (pi•((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•a')\<sharp>(pi•h)" using c1
  by (simp add: pt_fresh_bij_ineq[OF ptc, OF ptb, OF at, OF cpc])
  have c4: "(pi•a')\<sharp>(pi•h) (pi•a')"
  proof -
    from c2 have "(pi•a')\<sharp>(pi•(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: "∃(a::'y). a\<sharp>(pi•h,(pi•h) a)" using c3 c4 by (force simp add: fresh_prod)
  have d1: "?LHS = pi•(h a')" using c1 a1 by (simp add: fresh_fun_app[OF ptb', OF at', OF f1])
  have d2: "?RHS = (pi•h) (pi•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=>'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: "∃(a::'x). a\<sharp>(h,h a)"
  shows "pi•(fresh_fun h) = fresh_fun(pi•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=>'a) TYPE('x)" by (simp add: pt_fun_inst[OF ptb, OF pta, OF at]) 
  have f2: "finite ((supp (pi•h))::'x set)"
  proof -
    from f1 have "finite (pi•((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•a')\<sharp>(pi•h)" using c1 by (simp add: pt_fresh_bij[OF ptc, OF at])
  have c4: "(pi•a')\<sharp>(pi•h) (pi•a')"
  proof -
    from c2 have "(pi•a')\<sharp>(pi•(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: "∃(a::'x). a\<sharp>(pi•h,(pi•h) a)" using c3 c4 by (force simp add: fresh_prod)
  have d1: "?LHS = pi•(h a')" using c1 a1 by (simp add: fresh_fun_app[OF pta, OF at, OF f1])
  have d2: "?RHS = (pi•h) (pi•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=>'a"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)" 
  and     f1: "finite ((supp h)::'x set)"
  and     a: "∃(a::'x). a\<sharp>(h,h a)"
  shows "((supp h)::'x set) supports (fresh_fun h)"
  apply(simp add: supports_def fresh_def[symmetric])
  apply(auto)
  apply(simp add: fresh_fun_equiv[OF pt, OF at, OF f1, OF a])
  apply(simp add: pt_fresh_fresh[OF pt_fun_inst[OF at_pt_inst[OF at], OF pt], OF at, OF at])
  done
  
section {* Abstraction function *}
(*==============================*)

lemma pt_abs_fun_inst:
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "pt TYPE('x=>('a noption)) TYPE('x)"
  by (rule pt_fun_inst[OF at_pt_inst[OF at],OF pt_noption_inst[OF pt],OF at])

constdefs
  abs_fun :: "'x=>'a=>('x=>('a noption))" ("[_]._" [100,100] 100)
  "[a].x ≡ (λb. (if b=a then nSome(x) else (if b\<sharp>x then nSome([(a,b)]•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•(if c then x else y) = (if c then (pi•x) else (pi•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•([a].x) = [(pi•a)].(pi•x)"
  apply(simp add: abs_fun_def perm_fun_def abs_fun_if)
  apply(simp only: expand_fun_eq)
  apply(rule allI)
  apply(subgoal_tac "(((rev pi)•(xa::'y)) = (a::'y)) = (xa = pi•a)")(*A*)
  apply(subgoal_tac "(((rev pi)•xa)\<sharp>x) = (xa\<sharp>(pi•x))")(*B*)
  apply(subgoal_tac "pi•([(a,(rev pi)•xa)]•x) = [(pi•a,xa)]•(pi•x)")(*C*)
  apply(simp)
(*C*)
  apply(simp add: cp1[OF cp])
  apply(simp add: pt_pi_rev[OF ptb, OF at])
(*B*)
  apply(simp add: pt_fresh_left_ineq[OF pta, OF ptb, OF at, OF cp])
(*A*)
  apply(rule iffI)
  apply(rule pt_bij2[OF ptb, OF at, THEN sym])
  apply(simp)
  apply(rule pt_bij2[OF ptb, OF at])
  apply(simp)
done

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•([a].x) = [(pi•a)].(pi•x)"
apply(rule abs_fun_pi_ineq)
apply(rule pt)
apply(rule at_pt_inst)
apply(rule at)+
apply(rule cp_pt_inst)
apply(rule pt)
apply(rule at)
done

lemma abs_fun_eq1: 
  fixes x  :: "'a"
  and   y  :: "'a"
  and   a  :: "'x"
  shows "([a].x = [a].y) = (x = y)"
apply(auto simp add: abs_fun_def)
apply(auto simp add: expand_fun_eq)
apply(drule_tac x="a" in spec)
apply(simp)
done

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≠b" 
      and a2: "[a].x = [b].y" 
  shows "x=[(a,b)]•y ∧ a\<sharp>y"
proof -
  from a2 have "∀c::'x. ([a].x) c = ([b].y) c" by (force simp add: expand_fun_eq)
  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)]•y ∧ a\<sharp>y"
  proof (cases "a\<sharp>y")
    assume a4: "a\<sharp>y"
    hence "x=[(b,a)]•y" using a3 a1 by (simp add: abs_fun_def)
    moreover
    have "[(a,b)]•y = [(b,a)]•y" by (rule pt3[OF pt], rule at_ds5[OF at])
    ultimately show ?thesis using a4 by simp
  next
    assume "¬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≠b" 
      and a2: "x=[(a,b)]•y" 
      and a3: "a\<sharp>y" 
  shows "[a].x =[b].y"
proof -
  show ?thesis 
  proof (simp only: abs_fun_def expand_fun_eq, intro strip)
    fix c::"'x"
    let ?LHS = "if c=a then nSome(x) else if c\<sharp>x then nSome([(a,c)]•x) else nNone"
    and ?RHS = "if c=b then nSome(y) else if c\<sharp>y then nSome([(b,c)]•y) else nNone"
    show "?LHS=?RHS"
    proof -
      have "(c=a) ∨ (c=b) ∨ (c≠a ∧ c≠b)" by blast
      moreover  --"case c=a"
      { have "nSome(x) = nSome([(a,b)]•y)" using a2 by simp
        also have "… = nSome([(b,a)]•y)" by (simp, rule pt3[OF pt], rule at_ds5[OF at])
        finally have "nSome(x) = nSome([(b,a)]•y)" by simp
        moreover
        assume "c=a"
        ultimately have "?LHS=?RHS" using a1 a3 by simp
      }
      moreover  -- "case c=b"
      { have a4: "y=[(a,b)]•x" using a2 by (simp only: pt_swap_bij[OF pt, OF at])
        hence "a\<sharp>([(a,b)]•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  -- "case c≠a ∧ c≠b"
      { assume a5: "c≠a ∧ c≠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 --> [(a,c)]•x = [(b,c)]•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)]•([(b,c)]•([(a,c)]•y)) = [(a,b)]•y" 
            by (simp add: pt2[OF pt, symmetric] pt3[OF pt])
          hence "[(a,c)]•([(b,c)]•y) = [(a,b)]•y" using a3 a6 
            by (simp add: pt_fresh_fresh[OF pt, OF at])
          hence "[(a,c)]•([(b,c)]•y) = x" using a2 by simp
          hence "[(b,c)]•y = [(a,c)]•x" by (drule_tac pt_bij1[OF pt, OF at], simp)
          thus "[(a,c)]•x = [(b,c)]•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 ∧ x=y)∨(a≠b ∧ x=[(a,b)]•y ∧ a\<sharp>y))"
proof (rule iffI)
  assume b: "[a].x = [b].y"
  show "(a=b ∧ x=y)∨(a≠b ∧ x=[(a,b)]•y ∧ 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 ∧ x=y)∨(a≠b ∧ x=[(a,b)]•y ∧ a\<sharp>y)"
  thus "[a].x = [b].y"
  proof
    assume "a=b ∧ x=y" thus ?thesis by simp
  next
    assume "a≠b ∧ x=[(a,b)]•y ∧ 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 ∧ x=y)∨(a≠b ∧ [(b,a)]•x=y ∧ 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≠a" "c≠b" "c\<sharp>x" "c\<sharp>y" 
  shows "([a].x = [b].y) = ([(a,c)]•x = [(b,c)]•y)"
proof (rule iffI)
  assume eq0: "[a].x = [b].y"
  show "[(a,c)]•x = [(b,c)]•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≠b" by fact
    with eq0 have eq: "x=[(a,b)]•y" and fr': "a\<sharp>y" by (simp_all add: abs_fun_eq[OF pt, OF at])
    from eq have "[(a,c)]•x = [(a,c)]•[(a,b)]•y" by (simp add: pt_bij[OF pt, OF at])
    also have "… = ([(a,c)]•[(a,b)])•([(a,c)]•y)" by (rule pt_perm_compose[OF pt, OF at])
    also have "… = [(c,b)]•y" using ineq fr fr' 
      by (simp add: pt_fresh_fresh[OF pt, OF at] at_calc[OF at])
    also have "… = [(b,c)]•y" by (rule pt3[OF pt], rule at_ds5[OF at])
    finally show ?thesis by simp
  qed
next
  assume eq: "[(a,c)]•x = [(b,c)]•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≠b" by fact
    from fr have "([(a,c)]•c)\<sharp>([(a,c)]•x)" by (simp add: pt_fresh_bij[OF pt, OF at])
    hence "a\<sharp>([(b,c)]•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)])•([(b,c)]•y)" by (rule pt_bij1[OF pt, OF at])
    also have "… = [(a,c)]•([(b,c)]•y)" by simp
    also have "… = ([(a,c)]•[(b,c)])•([(a,c)]•y)" by (rule pt_perm_compose[OF pt, OF at])
    also have "… = [(b,a)]•y" using ineq fr fr0  
      by (simp add: pt_fresh_fresh[OF pt, OF at] at_calc[OF at])
    also have "… = [(a,b)]•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≠a" "c≠b" "c\<sharp>x" "c\<sharp>y" 
  shows "x = [(a,c)]•[(b,c)]•y"
using as fr
apply(drule_tac sym)
apply(simp add: abs_fun_fresh[OF pt, OF at] pt_swap_bij[OF pt, OF at])
done

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) ⊆ (supp (x,a))"
proof 
  fix c
  assume "c∈((supp ([a].x))::'x set)"
  hence "infinite {b. [(c,b)]•([a].x) ≠ [a].x}" by (simp add: supp_def)
  hence "infinite {b. [([(c,b)]•a)].([(c,b)]•x) ≠ [a].x}" by (simp add: abs_fun_pi[OF pt, OF at])
  moreover
  have "{b. [([(c,b)]•a)].([(c,b)]•x) ≠ [a].x} ⊆ {b. ([(c,b)]•x,[(c,b)]•a) ≠ (x, a)}" by force
  ultimately have "infinite {b. ([(c,b)]•x,[(c,b)]•a) ≠ (x, a)}" by (simp add: infinite_super)
  thus "c∈(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) ⊆ (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≠b"
  shows "b\<sharp>([a].x)"
  proof -
    have "∃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≠b"
                  and   fr2: "c≠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)]•([a].x) = [a].([(c,b)]•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)]•c)\<sharp> ([(c,b)]•([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)]•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≠a" 
  shows "b\<sharp>x"
proof -
  have "∃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≠c"
                and   fr2: "c≠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)]•([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)]•x)" using fr2 a2 
    by (force simp add: abs_fun_pi[OF pt, OF at] at_calc[OF at])
  hence b: "([(b,c)]•x) = x" by (simp add: abs_fun_eq1)
  from fr3 have "([(b,c)]•c)\<sharp>([(b,c)]•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 "∃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≠c" and fr1_sym: "c≠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)]•c)\<sharp>([(c,a)]•([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)]•x))" using fr1_sym 
    by (simp add: abs_fun_pi[OF pt, OF at] at_calc[OF at])
  have "[c].([(c,a)]•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 ∨ 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)"
apply(auto simp add: supp_def)
apply(auto simp add: abs_fun_pi_ineq[OF pta, OF ptb, OF at, OF cp])
apply(auto simp add: dj_perm_forget[OF dj])
apply(auto simp add: abs_fun_eq1) 
done

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 {* abstraction type for the parsing in nominal datatype *}
(*==============================================================*)

inductive_set ABS_set :: "('x=>('a noption)) set"
  where
  ABS_in: "(abs_fun a x)∈ABS_set"

typedef (ABS) ('x,'a) ABS = "ABS_set::('x=>('a noption)) set"
proof 
  fix x::"'a" and a::"'x"
  show "(abs_fun a x)∈ ABS_set" by (rule ABS_in)
qed

syntax ABS :: "type => type => type" ("«_»_" [1000,1000] 1000)


section {* lemmas for deciding permutation equations *}
(*===================================================*)

lemma perm_aux_fold:
  shows "perm_aux pi x = pi•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•(pi1•x) = perm_aux (pi2•pi1) (pi2•x)" 
proof -
  have "(pi2@pi1) \<triangleq> ((pi2•pi1)@pi2)" by (rule at_ds8[OF at])
  hence "(pi2@pi1)•x = ((pi2•pi1)@pi2)•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•(pi2•x) = perm_aux (pi1•pi2) (pi1•x)"
  using cp by (simp add: cp_def perm_aux_def)

lemma perm_eq_app:
  fixes f  :: "'a=>'b"
  and   x  :: "'a"
  and   pi :: "'x prm"
  assumes pt: "pt TYPE('a) TYPE('x)"
  and     at: "at TYPE('x)"
  shows "(pi•(f x)=y) = ((pi•f)(pi•x)=y)"
  by (simp add: pt_fun_app_eq[OF pt, OF at])

lemma perm_eq_lam:
  fixes f  :: "'a=>'b"
  and   x  :: "'a"
  and   pi :: "'x prm"
  shows "((pi•(λx. f x))=y) = ((λx. (pi•(f ((rev pi)•x))))=y)"
  by (simp add: perm_fun_def)

section {* test *}
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•pi1) \<triangleq> (pi3•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
    apply -
    apply(auto simp add: prm_eq_def)
    apply(rule_tac pi="rev pi3" in pt_bij4[OF pt, OF at])
    apply(rule trans)
    apply(rule pt_perm_compose[OF pt, OF at])
    apply(simp add: pt_rev_pi[OF pt_prm, OF at])
    apply(rule sym)
    apply(rule trans)
    apply(rule pt_perm_compose[OF pt, OF at])
    apply(simp add: pt_rev_pi[OF pt_prm, OF at])
    done
qed

(************************)
(* Various eqvt-lemmas  *)

lemma Zero_nat_eqvt:
  shows "pi•(0::nat) = 0" 
by (auto simp add: perm_nat_def)

lemma One_nat_eqvt:
  shows "pi•(1::nat) = 1"
by (simp add: perm_nat_def)

lemma Suc_eqvt:
  shows "pi•(Suc x) = Suc (pi•x)" 
by (auto simp add: perm_nat_def)

lemma numeral_nat_eqvt: 
 shows "pi•((number_of n)::nat) = number_of n" 
by (simp add: perm_nat_def perm_int_def)

lemma max_nat_eqvt:
  fixes x::"nat"
  shows "pi•(max x y) = max (pi•x) (pi•y)" 
by (simp add:perm_nat_def) 

lemma min_nat_eqvt:
  fixes x::"nat"
  shows "pi•(min x y) = min (pi•x) (pi•y)" 
by (simp add:perm_nat_def) 

lemma plus_nat_eqvt:
  fixes x::"nat"
  shows "pi•(x + y) = (pi•x) + (pi•y)" 
by (simp add:perm_nat_def) 

lemma minus_nat_eqvt:
  fixes x::"nat"
  shows "pi•(x - y) = (pi•x) - (pi•y)" 
by (simp add:perm_nat_def) 

lemma mult_nat_eqvt:
  fixes x::"nat"
  shows "pi•(x * y) = (pi•x) * (pi•y)" 
by (simp add:perm_nat_def) 

lemma div_nat_eqvt:
  fixes x::"nat"
  shows "pi•(x div y) = (pi•x) div (pi•y)" 
by (simp add:perm_nat_def) 

lemma Zero_int_eqvt:
  shows "pi•(0::int) = 0" 
by (auto simp add: perm_int_def)

lemma One_int_eqvt:
  shows "pi•(1::int) = 1"
by (simp add: perm_int_def)

lemma numeral_int_eqvt: 
 shows "pi•((number_of n)::int) = number_of n" 
by (simp add: perm_int_def perm_int_def)

lemma max_int_eqvt:
  fixes x::"int"
  shows "pi•(max (x::int) y) = max (pi•x) (pi•y)" 
by (simp add:perm_int_def) 

lemma min_int_eqvt:
  fixes x::"int"
  shows "pi•(min x y) = min (pi•x) (pi•y)" 
by (simp add:perm_int_def) 

lemma plus_int_eqvt:
  fixes x::"int"
  shows "pi•(x + y) = (pi•x) + (pi•y)" 
by (simp add:perm_int_def) 

lemma minus_int_eqvt:
  fixes x::"int"
  shows "pi•(x - y) = (pi•x) - (pi•y)" 
by (simp add:perm_int_def) 

lemma mult_int_eqvt:
  fixes x::"int"
  shows "pi•(x * y) = (pi•x) * (pi•y)" 
by (simp add:perm_int_def) 

lemma div_int_eqvt:
  fixes x::"int"
  shows "pi•(x div y) = (pi•x) div (pi•y)" 
by (simp add:perm_int_def) 

(*******************************************************************)
(* Setup of the theorem attributes eqvt, eqvt_force, fresh and bij *)
use "nominal_thmdecls.ML"
setup "NominalThmDecls.setup"

lemmas [eqvt] = 
  (* connectives *)
  if_eqvt imp_eqvt disj_eqvt conj_eqvt neg_eqvt 
  true_eqvt false_eqvt
  imp_eqvt [folded 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

(***************************************)
(* setup for the individial atom-kinds *)
(* and nominal datatypes               *)
use "nominal_atoms.ML"

(************************************************************)
(* various tactics for analysing permutations, supports etc *)
use "nominal_permeq.ML";

method_setup perm_simp =
  {* NominalPermeq.perm_simp_meth *}
  {* simp rules and simprocs for analysing permutations *}

method_setup perm_simp_debug =
  {* NominalPermeq.perm_simp_meth_debug *}
  {* simp rules and simprocs for analysing permutations including debugging facilities *}

method_setup perm_full_simp =
  {* NominalPermeq.perm_full_simp_meth *}
  {* tactic for deciding equalities involving permutations *}

method_setup perm_full_simp_debug =
  {* NominalPermeq.perm_full_simp_meth_debug *}
  {* tactic for deciding equalities involving permutations including debugging facilities *}

method_setup supports_simp =
  {* NominalPermeq.supports_meth *}
  {* tactic for deciding whether something supports something else *}

method_setup supports_simp_debug =
  {* NominalPermeq.supports_meth_debug *}
  {* tactic for deciding whether something supports something else including debugging facilities *}

method_setup finite_guess =
  {* NominalPermeq.finite_guess_meth *}
  {* tactic for deciding whether something has finite support *}

method_setup finite_guess_debug =
  {* NominalPermeq.finite_guess_meth_debug *}
  {* tactic for deciding whether something has finite support including debugging facilities *}

method_setup fresh_guess =
  {* NominalPermeq.fresh_guess_meth *}
  {* tactic for deciding whether an atom is fresh for something*}

method_setup fresh_guess_debug =
  {* NominalPermeq.fresh_guess_meth_debug *}
  {* tactic for deciding whether an atom is fresh for something including debugging facilities *}

(*****************************************************************)
(* tactics for generating fresh names and simplifying fresh_funs *)
use "nominal_fresh_fun.ML";

method_setup generate_fresh = 
  {* setup_generate_fresh *} 
  {* tactic to generate a name fresh for all the variables in the goal *}

method_setup fresh_fun_simp = 
  {* setup_fresh_fun_simp *} 
  {* tactic to delete one inner occurence of fresh_fun *}


(************************************************)
(* main file for constructing nominal datatypes *)
use "nominal_package.ML"

(******************************************************)
(* primitive recursive functions on nominal datatypes *)
use "nominal_primrec.ML"

(****************************************************)
(* inductive definition involving nominal datatypes *)
use "nominal_inductive.ML"

(*****************************************)
(* setup for induction principles method *)
use "nominal_induct.ML";
method_setup nominal_induct =
  {* NominalInduct.nominal_induct_method *}
  {* nominal induction *}

end

Permutations

lemma empty_eqvt:

  pi • {} = {}

lemma union_eqvt:

  pi • (XY) = piXpiY

lemma insert_eqvt:

  pi • insert x X = insert (pix) (piX)

lemma fst_eqvt:

  pi • fst x = fst (pix)

lemma snd_eqvt:

  pi • snd x = snd (pix)

lemma append_eqvt:

  pi • (l1.0 @ l2.0) = pil1.0 @ pil2.0

lemma rev_eqvt:

  pi • rev l = rev (pil)

lemma set_eqvt:

  pi • set xs = set (pixs)

lemma perm_bool:

  pib = b

lemma perm_boolI:

  P ==> piP

lemma perm_boolE:

  piP ==> P

lemma if_eqvt:

  pi • (if b then c1.0 else c2.0) = (if pib then pic1.0 else pic2.0)

lemma imp_eqvt:

  pi • (A --> B) = (piA --> piB)

lemma conj_eqvt:

  pi • (AB) = (piApiB)

lemma disj_eqvt:

  pi • (AB) = (piApiB)

lemma neg_eqvt:

  pi • (¬ A) = (¬ piA)

lemma perm_string:

  pis = s

permutation equality

Support, Freshness and Supports

lemma supp_fresh_iff:

  supp x = {a. ¬ a \<sharp> x}

lemma supp_unit:

  supp () = {}

lemma supp_set_empty:

  supp {} = {}

lemma supp_singleton:

  supp {x} = supp x

lemma supp_prod:

  supp (x, y) = supp x ∪ supp y

lemma supp_nprod:

  supp (nPair x y) = supp x ∪ supp y

lemma supp_list_nil:

  supp [] = {}

lemma supp_list_cons:

  supp (x # xs) = supp x ∪ supp xs

lemma supp_list_append:

  supp (xs @ ys) = supp xs ∪ supp ys

lemma supp_list_rev:

  supp (rev xs) = supp xs

lemma supp_bool:

  supp x = {}

lemma supp_some:

  supp (Some x) = supp x

lemma supp_none:

  supp None = {}

lemma supp_int:

  supp i = {}

lemma supp_nat:

  supp n = {}

lemma supp_char:

  supp c = {}

lemma supp_string:

  supp s = {}

lemma fresh_set_empty:

  a \<sharp> {}

lemma fresh_singleton:

  a \<sharp> {x} = a \<sharp> x

lemma fresh_unit:

  a \<sharp> ()

lemma fresh_prod:

  a \<sharp> (x, y) = (a \<sharp> xa \<sharp> y)

lemma fresh_list_nil:

  a \<sharp> []

lemma fresh_list_cons:

  a \<sharp> (x # xs) = (a \<sharp> xa \<sharp> xs)

lemma fresh_list_append:

  a \<sharp> (xs @ ys) = (a \<sharp> xsa \<sharp> ys)

lemma fresh_list_rev:

  a \<sharp> rev xs = a \<sharp> xs

lemma fresh_none:

  a \<sharp> None

lemma fresh_some:

  a \<sharp> Some x = a \<sharp> x

lemma fresh_int:

  a \<sharp> i

lemma fresh_nat:

  a \<sharp> n

lemma fresh_char:

  a \<sharp> c

lemma fresh_string:

  a \<sharp> s

lemma fresh_bool:

  a \<sharp> b

lemma fresh_unit_elim:

  (a \<sharp> () ==> PROP C) == PROP C

lemma fresh_prod_elim:

  (a \<sharp> (x, y) ==> PROP C) == ([| a \<sharp> x; a \<sharp> y |] ==> PROP C)

lemma

  [| a \<sharp> x1.0; a \<sharp> x2.0 |] ==> a \<sharp> (x1.0, x2.0)

lemma fresh_prodD(1):

  a \<sharp> (x, y) ==> a \<sharp> x

and fresh_prodD(2):

  a \<sharp> (x, y) ==> a \<sharp> y

Abstract Properties for Permutations and Atoms

Lemmas about the atom-type properties

lemma at1:

  at TYPE('x) ==> [] • x = x

lemma at2:

  at TYPE('x) ==> ((a, b) # pi) • x = Nominal.swap (a, b) (pix)

lemma at3:

  at TYPE('x)
  ==> Nominal.swap (a, b) c = (if a = c then b else if b = c then a else c)

lemma at_calc:

  at TYPE('x) ==> ((a, b) # pi) • x = Nominal.swap (a, b) (pix)
  at TYPE('x) ==> [] • x = x
  at TYPE('x)
  ==> Nominal.swap (a, b) c = (if a = c then b else if b = c then a else c)

lemma at_swap_simps(1):

  at TYPE('x) ==> [(a, b)] • a = b

and at_swap_simps(2):

  at TYPE('x) ==> [(a, b)] • b = a

lemma at4:

  at TYPE('x) ==> infinite UNIV

lemma at_append:

  at TYPE('x) ==> (pi1.0 @ pi2.0) • c = pi1.0pi2.0c

lemma at_swap:

  at TYPE('x) ==> Nominal.swap (a, b) (Nominal.swap (a, b) c) = c

lemma at_rev_pi:

  at TYPE('x) ==> rev pipic = c

lemma at_pi_rev:

  at TYPE('x) ==> pi • rev pix = x

lemma at_bij1:

  [| at TYPE('x); pix = y |] ==> x = rev piy

lemma at_bij2:

  [| at TYPE('x); rev pix = y |] ==> x = piy

lemma at_bij:

  at TYPE('x) ==> (pix = piy) = (x = y)

lemma at_supp:

  at TYPE('x) ==> supp x = {x}

lemma at_fresh:

  at TYPE('x) ==> a \<sharp> b = (a  b)

lemma at_prm_fresh:

  [| at TYPE('x); c \<sharp> pi |] ==> pic = c

lemma at_prm_rev_eq:

  at TYPE('x) ==>  rev pi1.0 \<triangleq> rev pi2.0  =  pi1.0 \<triangleq> pi2.0 

lemma at_prm_eq_append:

  [| at TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==>  (pi3.0 @ pi1.0) \<triangleq> (pi3.0 @ pi2.0) 

lemma at_prm_eq_append':

  [| at TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==>  (pi1.0 @ pi3.0) \<triangleq> (pi2.0 @ pi3.0) 

lemma at_prm_eq_trans:

  [|  pi1.0 \<triangleq> pi2.0 ;  pi2.0 \<triangleq> pi3.0  |]
  ==>  pi1.0 \<triangleq> pi3.0 

lemma at_prm_eq_refl:

   pi \<triangleq> pi 

lemma at_prm_rev_eq1:

  [| at TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==>  rev pi1.0 \<triangleq> rev pi2.0 

lemma at_ds1:

  at TYPE('x) ==>  [(a, a)] \<triangleq> [] 

lemma at_ds2:

  at TYPE('x) ==>  ([(a, b)] @ pi) \<triangleq> (pi @ [(rev pia, rev pib)]) 

lemma at_ds3:

  [| at TYPE('x); distinct [a, b, c] |]
  ==>  [(a, c), (b, c), (a, c)] \<triangleq> [(a, b)] 

lemma at_ds4:

  at TYPE('x) ==>  (pi @ [(a, rev pib)]) \<triangleq> ([(pia, b)] @ pi) 

lemma at_ds5:

  at TYPE('x) ==>  [(a, b)] \<triangleq> [(b, a)] 

lemma at_ds5':

  at TYPE('x) ==>  [(a, b), (b, a)] \<triangleq> [] 

lemma at_ds6:

  [| at TYPE('x); distinct [a, b, c] |]
  ==>  [(a, c), (a, b)] \<triangleq> [(b, c), (a, c)] 

lemma at_ds7:

  at TYPE('x) ==>  (rev pi @ pi) \<triangleq> [] 

lemma at_ds8_aux:

  at TYPE('x)
  ==> pi • Nominal.swap (a, b) c = Nominal.swap (pia, pib) (pic)

lemma at_ds8:

  at TYPE('x) ==>  (pi1.0 @ pi2.0) \<triangleq> (pi1.0pi2.0 @ pi1.0) 

lemma at_ds9:

  at TYPE('x)
  ==>  (rev pi2.0 @ rev pi1.0) \<triangleq> (rev pi1.0 @ rev (pi1.0pi2.0)) 

lemma at_ds10:

  [| at TYPE('x); b \<sharp> rev pi |]
  ==>  ([(pia, b)] @ pi) \<triangleq> (pi @ [(a, b)]) 

lemma ex_in_inf:

  [| at TYPE('x); finite A; !!c. c  A ==> thesis |] ==> thesis

lemma at_exists_fresh':

  [| at TYPE('x); finite (supp x) |] ==> ∃c. c \<sharp> x

lemma at_exists_fresh:

  [| at TYPE('x); finite (supp x); !!c. c \<sharp> x ==> thesis |] ==> thesis

lemma at_finite_select:

  [| at TYPE('a); finite S |] ==> ∃x. x  S

lemma at_different:

  at TYPE('x) ==> ∃b. a  b

lemma at_pt_inst:

  at TYPE('x) ==> pt TYPE('x) TYPE('x)

finite support properties

lemma fs1:

  fs TYPE('a) TYPE('x) ==> finite (supp x)

lemma fs_at_inst:

  at TYPE('x) ==> fs TYPE('x) TYPE('x)

lemma fs_unit_inst:

  fs TYPE(unit) TYPE('x)

lemma fs_prod_inst:

  [| fs TYPE('a) TYPE('x); fs TYPE('b) TYPE('x) |] ==> fs TYPE('a × 'b) TYPE('x)

lemma fs_nprod_inst:

  [| fs TYPE('a) TYPE('x); fs TYPE('b) TYPE('x) |]
  ==> fs TYPE(('a, 'b) nprod) TYPE('x)

lemma fs_list_inst:

  fs TYPE('a) TYPE('x) ==> fs TYPE('a list) TYPE('x)

lemma fs_option_inst:

  fs TYPE('a) TYPE('x) ==> fs TYPE('a option) TYPE('x)

Lemmas about the permutation properties

lemma pt1:

  pt TYPE('a) TYPE('x) ==> [] • x = x

lemma pt2:

  pt TYPE('a) TYPE('x) ==> (pi1.0 @ pi2.0) • x = pi1.0pi2.0x

lemma pt3:

  [| pt TYPE('a) TYPE('x);  pi1.0 \<triangleq> pi2.0  |] ==> pi1.0x = pi2.0x

lemma pt3_rev:

  [| pt TYPE('a) TYPE('x); at TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==> rev pi1.0x = rev pi2.0x

composition properties

lemma cp1:

  cp TYPE('a) TYPE('x) TYPE('y)
  ==> pi1.0pi2.0x = (pi1.0pi2.0) • pi1.0x

lemma cp_pt_inst:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> cp TYPE('a) TYPE('x) TYPE('x)

disjointness properties

lemma dj_perm_forget:

  disjoint TYPE('x) TYPE('y) ==> pix = x

lemma dj_perm_perm_forget:

  disjoint TYPE('x) TYPE('y) ==> pi2.0pi1.0 = pi1.0

lemma dj_cp:

  [| cp TYPE('a) TYPE('x) TYPE('y); disjoint TYPE('y) TYPE('x) |]
  ==> pi1.0pi2.0x = pi2.0pi1.0x

lemma dj_supp:

  disjoint TYPE('x) TYPE('y) ==> supp a = {}

lemma at_fresh_ineq:

  disjoint TYPE('y) TYPE('x) ==> a \<sharp> b

permutation type instances

lemma pt_set_inst:

  pt TYPE('a) TYPE('x) ==> pt TYPE('a set) TYPE('x)

lemma pt_list_nil:

  pt TYPE('a) TYPE('x) ==> [] • xs = xs

lemma pt_list_append:

  pt TYPE('a) TYPE('x) ==> (pi1.0 @ pi2.0) • xs = pi1.0pi2.0xs

lemma pt_list_prm_eq:

  [| pt TYPE('a) TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==> pi1.0xs = pi2.0xs

lemma pt_list_inst:

  pt TYPE('a) TYPE('x) ==> pt TYPE('a list) TYPE('x)

lemma pt_unit_inst:

  pt TYPE(unit) TYPE('x)

lemma pt_prod_inst:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x) |] ==> pt TYPE('a × 'b) TYPE('x)

lemma pt_nprod_inst:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x) |]
  ==> pt TYPE(('a, 'b) nprod) TYPE('x)

lemma pt_fun_inst:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x) |]
  ==> pt TYPE('a => 'b) TYPE('x)

lemma pt_option_inst:

  pt TYPE('a) TYPE('x) ==> pt TYPE('a option) TYPE('x)

lemma pt_noption_inst:

  pt TYPE('a) TYPE('x) ==> pt TYPE('a noption) TYPE('x)

lemma pt_bool_inst:

  pt TYPE(bool) TYPE('x)

further lemmas for permutation types

lemma pt_rev_pi:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> rev pipix = x

lemma pt_pi_rev:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • rev pix = x

lemma pt_bij1:

  [| pt TYPE('a) TYPE('x); at TYPE('x); pix = y |] ==> x = rev piy

lemma pt_bij2:

  [| pt TYPE('a) TYPE('x); at TYPE('x); x = rev piy |] ==> pix = y

lemma pt_bij:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (pix = piy) = (x = y)

lemma pt_eq_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • (x = y) = (pix = piy)

lemma pt_bij3:

  x = y ==> pix = piy

lemma pt_bij4:

  [| pt TYPE('a) TYPE('x); at TYPE('x); pix = piy |] ==> x = y

lemma pt_swap_bij:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> [(a, b)] • [(a, b)] • x = x

lemma pt_swap_bij':

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> [(a, b)] • [(b, a)] • x = x

lemma pt_swap_bij'':

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> [(a, a)] • x = x

lemma pt_set_bij1:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (pixX) = (x ∈ rev piX)

lemma pt_set_bij1a:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (xpiX) = (rev pixX)

lemma pt_set_bij:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (pixpiX) = (xX)

lemma pt_in_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • (xX) = (pixpiX)

lemma pt_set_bij2:

  [| pt TYPE('a) TYPE('x); at TYPE('x); xX |] ==> pixpiX

lemma pt_set_bij2a:

  [| pt TYPE('a) TYPE('x); at TYPE('x); x ∈ rev piX |] ==> pixX

lemma pt_set_bij3:

  pi • (xX) = (xX)

lemma pt_subseteq_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (piX  piY) = (X  Y)

lemma pt_set_diff_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • (X - Y) = piX - piY

lemma pt_Collect_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • {x. P x} = {x. P (rev pix)}

lemma Collect_permI:

  x. P1.0 x = P2.0 x ==> {pix |x. P1.0 x} = {pix |x. P2.0 x}

lemma Infinite_cong:

  X = Y ==> infinite X = infinite Y

lemma pt_set_eq_ineq:

  [| pt TYPE('x) TYPE('y); at TYPE('y) |]
  ==> {pix |x. P x} = {x. P (rev pix)}

lemma pt_inject_on_ineq:

  [| pt TYPE('y) TYPE('x); at TYPE('x) |] ==> inj_on (op • pi) X

lemma pt_set_finite_ineq:

  [| pt TYPE('x) TYPE('y); at TYPE('y) |] ==> finite (piX) = finite X

lemma pt_set_infinite_ineq:

  [| pt TYPE('x) TYPE('y); at TYPE('y) |] ==> infinite (piX) = infinite X

lemma pt_perm_supp_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y) |]
  ==> pi • supp x = supp (pix)

lemma pt_perm_supp:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • supp x = supp (pix)

lemma pt_supp_finite_pi:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x) |]
  ==> finite (supp (pix))

lemma pt_fresh_left_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y) |]
  ==> a \<sharp> pix = rev pia \<sharp> x

lemma pt_fresh_right_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y) |]
  ==> pia \<sharp> x = a \<sharp> rev pix

lemma pt_fresh_bij_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y) |]
  ==> pia \<sharp> pix = a \<sharp> x

lemma pt_fresh_left:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> a \<sharp> pix = rev pia \<sharp> x

lemma pt_fresh_right:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pia \<sharp> x = a \<sharp> rev pix

lemma pt_fresh_bij:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pia \<sharp> pix = a \<sharp> x

lemma pt_fresh_bij1:

  [| pt TYPE('a) TYPE('x); at TYPE('x); a \<sharp> x |] ==> pia \<sharp> pix

lemma pt_fresh_bij2:

  [| pt TYPE('a) TYPE('x); at TYPE('x); pia \<sharp> pix |] ==> a \<sharp> x

lemma pt_fresh_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pia \<sharp> x = pia \<sharp> pix

lemma pt_perm_fresh1:

  [| pt TYPE('a) TYPE('x); at TYPE('x); ¬ a \<sharp> x; b \<sharp> x |]
  ==> [(a, b)] • x  x

lemma pt_fresh_aux:

  [| pt TYPE('a) TYPE('x); at TYPE('x); c  a; a \<sharp> x; c \<sharp> x |]
  ==> c \<sharp> [(a, b)] • x

lemma pt_fresh_perm_app:

  [| pt TYPE('y) TYPE('x); at TYPE('x); a \<sharp> pi; a \<sharp> x |]
  ==> a \<sharp> pix

lemma pt_fresh_perm_app_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y); disjoint TYPE('y) TYPE('x); c \<sharp> x |]
  ==> c \<sharp> pix

lemma pt_fresh_eqvt_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y); disjoint TYPE('y) TYPE('x) |]
  ==> pic \<sharp> x = pic \<sharp> pix

lemma comprehension_neg_UNIV:

  {b. ¬ P b} = UNIV - {b. P b}

lemma infinite_or_neg_infinite:

  infinite UNIV ==> infinite {b. P b} ∨ infinite {b. ¬ P b}

lemma finite_infinite:

  [| finite {b. P b}; infinite UNIV |] ==> infinite {b. ¬ P b}

lemma pt_fresh_fresh:

  [| pt TYPE('a) TYPE('x); at TYPE('x); a \<sharp> x; b \<sharp> x |]
  ==> [(a, b)] • x = x

lemma pt_perm_compose:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi2.0pi1.0x = (pi2.0pi1.0) • pi2.0x

lemma pt_perm_compose':

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> (pi2.0pi1.0) • x = pi2.0pi1.0 • rev pi2.0x

lemma pt_perm_compose_rev:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> rev pi2.0 • rev pi1.0x = rev pi1.0 • rev (pi1.0pi2.0) • x

equivaraince for some connectives

lemma pt_all_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi • (∀x. P x) = (∀x. piP (rev pix))

lemma pt_ex_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi • (∃x. P x) = (∃x. piP (rev pix))

facts about supports

lemma supports_subset:

  [| S1.0 supports x; S1.0  S2.0 |] ==> S2.0 supports x

lemma supp_is_subset:

  [| S supports x; finite S |] ==> supp x  S

lemma supp_supports:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> supp x supports x

lemma supports_finite:

  [| S supports x; finite S |] ==> finite (supp x)

lemma supp_is_inter:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x) |]
  ==> supp x = Inter {S. finite SS supports x}

lemma supp_is_least_supports:

  [| pt TYPE('a) TYPE('x); at TYPE('x); S supports x; finite S;
     ∀S'. S' supports x --> S  S' |]
  ==> S = supp x

lemma supports_set:

  [| pt TYPE('a) TYPE('x); at TYPE('x);
     ∀xX. ∀a b. a  Sb  S --> [(a, b)] • xX |]
  ==> S supports X

lemma supports_fresh:

  [| S supports x; finite S; a  S |] ==> a \<sharp> x

lemma at_fin_set_supports:

  at TYPE('x) ==> X supports X

lemma infinite_Collection:

  [| infinite X; ∀bX. P b |] ==> infinite {b : X. P b}

lemma at_fin_set_supp:

  [| at TYPE('x); finite X |] ==> supp X = X

Permutations acting on Functions

lemma pt_fun_app_eq:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pif x = (pif) (pix)

lemma pt_perm:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> (pi1.0 • op • pi2.0) (pi1.0x) = pi1.0pi2.0x

lemma pt_fun_eq:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> (pif = f) = (∀x. pif x = f (pix))

lemma pt_swap_eq_aux:

  [| pt TYPE('a) TYPE('x); ∀a b. [(a, b)] • y = y |] ==> piy = y

lemma pt_swap_eq:

  pt TYPE('a) TYPE('x) ==> (∀a b. [(a, b)] • y = y) = (∀pi. piy = y)

lemma pt_eqvt_fun1a:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x); supp f = {} |]
  ==> ∀pi. pif = f

lemma pt_eqvt_fun1b:

  pi. pif = f ==> supp f = {}

lemma pt_eqvt_fun1:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x) |]
  ==> (supp f = {}) = (∀pi. pif = f)

lemma pt_eqvt_fun2a:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x); supp f = {} |]
  ==> ∀pi x. pif x = f (pix)

lemma pt_eqvt_fun2b:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x);
     ∀pi x. pif x = f (pix) |]
  ==> supp f = {}

lemma pt_eqvt_fun2:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x) |]
  ==> (supp f = {}) = (∀pi x. pif x = f (pix))

lemma pt_supp_fun_subset:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x); finite (supp f);
     finite (supp x) |]
  ==> supp (f x)  supp f ∪ supp x

lemma pt_empty_supp_fun_subset:

  [| pt TYPE('a) TYPE('x); pt TYPE('b) TYPE('x); at TYPE('x); supp f = {} |]
  ==> supp (f x)  supp x

Facts about the support of finite sets of finitely supported things

lemma UNION_f_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi • (UN x:X. f x) = (UN x:piX. (pif) x)

lemma X_to_Un_supp_eqvt:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi • X_to_Un_supp X = X_to_Un_supp (piX)

lemma Union_supports_set:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> (UN x:X. supp x) supports X

lemma Union_of_fin_supp_sets:

  [| fs TYPE('a) TYPE('x); finite X |] ==> finite (UN x:X. supp x)

lemma Union_included_in_supp:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X |]
  ==> (UN x:X. supp x)  supp X

lemma supp_of_fin_sets:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X |]
  ==> supp X = (UN x:X. supp x)

lemma supp_fin_union:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X;
     finite Y |]
  ==> supp (XY) = supp X ∪ supp Y

lemma supp_fin_insert:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X |]
  ==> supp (insert x X) = supp x ∪ supp X

lemma fresh_fin_union:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X;
     finite Y |]
  ==> a \<sharp> (XY) = (a \<sharp> Xa \<sharp> Y)

lemma fresh_fin_insert:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X |]
  ==> a \<sharp> insert x X = (a \<sharp> xa \<sharp> X)

lemma fresh_fin_insert1:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x); finite X;
     a \<sharp> x; a \<sharp> X |]
  ==> a \<sharp> insert x X

lemma pt_list_set_supp:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x) |]
  ==> supp (set xs) = supp xs

lemma pt_list_set_fresh:

  [| pt TYPE('a) TYPE('x); at TYPE('x); fs TYPE('a) TYPE('x) |]
  ==> a \<sharp> set xs = a \<sharp> xs

composition instances

lemma cp_list_inst:

  cp TYPE('a) TYPE('x) TYPE('y) ==> cp TYPE('a list) TYPE('x) TYPE('y)

lemma cp_set_inst:

  cp TYPE('a) TYPE('x) TYPE('y) ==> cp TYPE('a set) TYPE('x) TYPE('y)

lemma cp_option_inst:

  cp TYPE('a) TYPE('x) TYPE('y) ==> cp TYPE('a option) TYPE('x) TYPE('y)

lemma cp_noption_inst:

  cp TYPE('a) TYPE('x) TYPE('y) ==> cp TYPE('a noption) TYPE('x) TYPE('y)

lemma cp_unit_inst:

  cp TYPE(unit) TYPE('x) TYPE('y)

lemma cp_bool_inst:

  cp TYPE(bool) TYPE('x) TYPE('y)

lemma cp_prod_inst:

  [| cp TYPE('a) TYPE('x) TYPE('y); cp TYPE('b) TYPE('x) TYPE('y) |]
  ==> cp TYPE('a × 'b) TYPE('x) TYPE('y)

lemma cp_fun_inst:

  [| cp TYPE('a) TYPE('x) TYPE('y); cp TYPE('b) TYPE('x) TYPE('y);
     pt TYPE('y) TYPE('x); at TYPE('x) |]
  ==> cp TYPE('a => 'b) TYPE('x) TYPE('y)

Andy's freshness lemma

lemma freshness_lemma:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h);
     ∃a. a \<sharp> (h, h a) |]
  ==> ∃fr. ∀a. a \<sharp> h --> h a = fr

lemma freshness_lemma_unique:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h);
     ∃a. a \<sharp> (h, h a) |]
  ==> ∃!fr. ∀a. a \<sharp> h --> h a = fr

lemma fresh_fun_app:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h); ∃a. a \<sharp> (h, h a);
     a \<sharp> h |]
  ==> fresh_fun h = h a

lemma fresh_fun_app':

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h); a \<sharp> h;
     a \<sharp> h a |]
  ==> fresh_fun h = h a

lemma fresh_fun_equiv_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); pt TYPE('a) TYPE('y);
     at TYPE('x); at TYPE('y); cp TYPE('a) TYPE('x) TYPE('y);
     cp TYPE('y) TYPE('x) TYPE('y); finite (supp h); ∃a. a \<sharp> (h, h a) |]
  ==> pi • fresh_fun h = fresh_fun (pih)

lemma fresh_fun_equiv:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h);
     ∃a. a \<sharp> (h, h a) |]
  ==> pi • fresh_fun h = fresh_fun (pih)

lemma fresh_fun_supports:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp h);
     ∃a. a \<sharp> (h, h a) |]
  ==> supp h supports fresh_fun h

Abstraction function

lemma pt_abs_fun_inst:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pt TYPE('x => 'a noption) TYPE('x)

lemma abs_fun_if:

  pi • (if c then x else y) = (if c then pix else piy)

lemma abs_fun_pi_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y) |]
  ==> pi • [a].x = [(pia)].(pix)

lemma abs_fun_pi:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> pi • [a].x = [(pia)].(pix)

lemma abs_fun_eq1:

  ([a].x = [a].y) = (x = y)

lemma abs_fun_eq2:

  [| pt TYPE('a) TYPE('x); at TYPE('x); a  b; [a].x = [b].y |]
  ==> x = [(a, b)] • ya \<sharp> y

lemma abs_fun_eq3:

  [| pt TYPE('a) TYPE('x); at TYPE('x); a  b; x = [(a, b)] • y; a \<sharp> y |]
  ==> [a].x = [b].y

lemma abs_fun_eq:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> ([a].x = [b].y) = (a = bx = ya  bx = [(a, b)] • ya \<sharp> y)

lemma abs_fun_eq':

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> ([a].x = [b].y) = (a = bx = ya  b ∧ [(b, a)] • x = yb \<sharp> x)

lemma abs_fun_fresh:

  [| pt TYPE('a) TYPE('x); at TYPE('x); c  a; c  b; c \<sharp> x;
     c \<sharp> y |]
  ==> ([a].x = [b].y) = ([(a, c)] • x = [(b, c)] • y)

lemma abs_fun_fresh':

  [| pt TYPE('a) TYPE('x); at TYPE('x); [a].x = [b].y; c  a; c  b; c \<sharp> x;
     c \<sharp> y |]
  ==> x = [(a, c)] • [(b, c)] • y

lemma abs_fun_supp_approx:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |] ==> supp ([a].x)  supp (x, a)

lemma abs_fun_finite_supp:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x) |]
  ==> finite (supp ([a].x))

lemma fresh_abs_funI1:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x); b \<sharp> x; a  b |]
  ==> b \<sharp> [a].x

lemma fresh_abs_funE:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x); b \<sharp> [a].x;
     b  a |]
  ==> b \<sharp> x

lemma fresh_abs_funI2:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x) |] ==> a \<sharp> [a].x

lemma fresh_abs_fun_iff:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x) |]
  ==> b \<sharp> [a].x = (b = ab \<sharp> x)

lemma abs_fun_supp:

  [| pt TYPE('a) TYPE('x); at TYPE('x); finite (supp x) |]
  ==> supp ([a].x) = supp x - {a}

lemma abs_fun_supp_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y); disjoint TYPE('y) TYPE('x) |]
  ==> supp ([a].x) = supp x

lemma fresh_abs_fun_iff_ineq:

  [| pt TYPE('a) TYPE('x); pt TYPE('y) TYPE('x); at TYPE('x);
     cp TYPE('a) TYPE('x) TYPE('y); disjoint TYPE('y) TYPE('x) |]
  ==> b \<sharp> [a].x = b \<sharp> x

abstraction type for the parsing in nominal datatype

lemmas for deciding permutation equations

lemma perm_aux_fold:

  perm_aux pi x = pix

lemma pt_perm_compose_aux:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> pi2.0pi1.0x = perm_aux (pi2.0pi1.0) (pi2.0x)

lemma cp1_aux:

  cp TYPE('a) TYPE('x) TYPE('y)
  ==> pi1.0pi2.0x = perm_aux (pi1.0pi2.0) (pi1.0x)

lemma perm_eq_app:

  [| pt TYPE('a) TYPE('x); at TYPE('x) |]
  ==> (pif x = y) = ((pif) (pix) = y)

lemma perm_eq_lam:

  (pif = y) = ((λx. pif (rev pix)) = y)

test

lemma at_prm_eq_compose:

  [| at TYPE('x);  pi1.0 \<triangleq> pi2.0  |]
  ==>  pi3.0pi1.0 \<triangleq> pi3.0pi2.0 

lemma Zero_nat_eqvt:

  pi0 = 0

lemma One_nat_eqvt:

  pi1 = 1

lemma Suc_eqvt:

  pi • Suc x = Suc (pix)

lemma numeral_nat_eqvt:

  pinumber_of n = number_of n

lemma max_nat_eqvt:

  pimax x y = max (pix) (piy)

lemma min_nat_eqvt:

  pimin x y = min (pix) (piy)

lemma plus_nat_eqvt:

  pi • (x + y) = pix + piy

lemma minus_nat_eqvt:

  pi • (x - y) = pix - piy

lemma mult_nat_eqvt:

  pi • (x * y) = pix * piy

lemma div_nat_eqvt:

  pi • (x div y) = pix div piy

lemma Zero_int_eqvt:

  pi0 = 0

lemma One_int_eqvt:

  pi1 = 1

lemma numeral_int_eqvt:

  pinumber_of n = number_of n

lemma max_int_eqvt:

  pimax x y = max (pix) (piy)

lemma min_int_eqvt:

  pimin x y = min (pix) (piy)

lemma plus_int_eqvt:

  pi • (x + y) = pix + piy

lemma minus_int_eqvt:

  pi • (x - y) = pix - piy

lemma mult_int_eqvt:

  pi • (x * y) = pix * piy

lemma div_int_eqvt:

  pi • (x div y) = pix div piy

lemma

  pi • (if b then c1.0 else c2.0) = (if pib then pic1.0 else pic2.0)
  pi • (A --> B) = (piA --> piB)
  pi • (AB) = (piApiB)
  pi • (AB) = (piApiB)
  pi • (¬ A) = (¬ piA)
  pi • True = True
  pi • False = False
  pi • ??.HOL.induct_implies A B = ??.HOL.induct_implies (piA) (piB)
  pi() = ()
  pi • [] = []
  pi • (x # xs) = pix # pixs
  pi • (l1.0 @ l2.0) = pil1.0 @ pil2.0
  pi • (x, y) = (pix, piy)
  pi • fst x = fst (pix)
  pi • snd x = snd (pix)
  pi • Some x = Some (pix)
  pi • None = None
  pi • Suc x = Suc (pix)
  pi0 = 0
  pi1 = 1
  pimin x y = min (pix) (piy)
  pimax x y = max (pix) (piy)
  pi • (x + y) = pix + piy
  pi • (x - y) = pix - piy
  pi • (x * y) = pix * piy
  pi • (x div y) = pix div piy
  pi0 = 0
  pi1 = 1
  pimin x y = min (pix) (piy)
  pimax x y = max (pix) (piy)
  pi • (x + y) = pix + piy
  pi • (x - y) = pix - piy
  pi • (x * y) = pix * piy
  pi • (x div y) = pix div piy
  pi • (XY) = piXpiY
  pi • {} = {}
  pi • insert x X = insert (pix) (piX)
  pi • set xs = set (pixs)

lemma

  pinumber_of n = number_of n
  pinumber_of n = number_of n