theory Nominal2_FSet

imports "../Nominal-General/Nominal2_Supp"

        FSet 

begin

lemma permute_rsp_fset[quot_respect]:

  "(op = ===> list_eq ===> list_eq) permute permute"

  apply (simp add: eqvts[symmetric])

  apply clarify

  apply (subst permute_minus_cancel(1)[symmetric, of "xb"])

  apply (subst mem_eqvt[symmetric])

  apply (subst (2) permute_minus_cancel(1)[symmetric, of "xb"])

  apply (subst mem_eqvt[symmetric])

  apply (erule_tac x="- x \<bullet> xb" in allE)

  apply simp

  done

instantiation fset :: (pt) pt

begin

quotient_definition

  "permute_fset :: perm \<Rightarrow> 'a fset \<Rightarrow> 'a fset"

is

  "permute :: perm \<Rightarrow> 'a list \<Rightarrow> 'a list"

instance 

proof

  fix x :: "'a fset" and p q :: "perm"

  show "0 \<bullet> x = x"

    by (lifting permute_zero [where 'a="'a list"])

  show "(p + q) \<bullet> x = p \<bullet> q \<bullet> x"

    by (lifting permute_plus [where 'a="'a list"])

qed

end

lemma permute_fset[simp, eqvt]:

  fixes S::"('a::pt) fset"

  shows "(p \<bullet> {||}) = ({||} ::('a::pt) fset)"

  and "p \<bullet> finsert x S = finsert (p \<bullet> x) (p \<bullet> S)"

  by (lifting permute_list.simps)

lemma fmap_eqvt[eqvt]: 

  shows "p \<bullet> (fmap f S) = fmap (p \<bullet> f) (p \<bullet> S)"

  by (lifting map_eqvt)

lemma fset_to_set_eqvt[eqvt]: 

  shows "p \<bullet> (fset_to_set S) = fset_to_set (p \<bullet> S)"

  by (lifting set_eqvt)

lemma fin_fset_to_set[simp]:

  shows "finite (fset_to_set S)"

  by (induct S) (simp_all)

lemma supp_fset_to_set:

  shows "supp (fset_to_set S) = supp S"

  apply (simp add: supp_def)

  apply (simp add: eqvts)

  apply (simp add: fset_cong)

  done

lemma supp_finsert:

  fixes x::"'a::fs"

  shows "supp (finsert x S) = supp x \<union> supp S"

  apply(subst supp_fset_to_set[symmetric])

  apply(simp add: supp_fset_to_set)

  apply(simp add: supp_of_fin_insert)

  apply(simp add: supp_fset_to_set)

  done

lemma supp_fempty:

  shows "supp {||} = {}"

  unfolding supp_def

  by simp

instance fset :: (fs) fs

  apply (default)

  apply (induct_tac x rule: fset_induct)

  apply (simp add: supp_fempty)

  apply (simp add: supp_finsert)

  apply (simp add: finite_supp)

  done

lemma atom_fmap_cong:

  shows "fmap atom x = fmap atom y \<longleftrightarrow> x = y"

  apply(rule inj_fmap_eq_iff)

  apply(simp add: inj_on_def)

  done

lemma supp_fmap_atom:

  shows "supp (fmap atom S) = supp S"

  unfolding supp_def

  apply(perm_simp)

  apply(simp add: atom_fmap_cong)

  done

lemma supp_at_fset:

  fixes S::"('a::at_base) fset"

  shows "supp S = fset_to_set (fmap atom S)"

  apply (induct S)

  apply (simp add: supp_fempty)

  apply (simp add: supp_finsert)

  apply (simp add: supp_at_base)

  done

end