# HG changeset patch # User Christian Urban # Date 1269249674 -3600 # Node ID 1d70813ae6749b469b71aa78ca24b9abf592c1b3 # Parent 014ddf0d7271bf009cc41aaf5ab34f80877dfeb4# Parent 2311a9fc46243d8d5faaf78a9669a60108a183b8 merged diff -r 014ddf0d7271 -r 1d70813ae674 Nominal/Nominal2_FSet.thy --- a/Nominal/Nominal2_FSet.thy Mon Mar 22 10:20:57 2010 +0100 +++ b/Nominal/Nominal2_FSet.thy Mon Mar 22 10:21:14 2010 +0100 @@ -147,10 +147,22 @@ apply (simp add: supp_fset_to_set) done +lemma supp_fempty: + "supp {||} = {}" + by (simp add: supp_def eqvts) + instance fset :: (at) fs apply (default) apply (induct_tac x rule: fset_induct) - apply (simp add: supp_def eqvts) + apply (simp add: supp_fempty) + apply (simp add: supp_at_finsert) + apply (simp add: supp_at_base) + done + +lemma supp_at_fset: + "supp (fset :: 'a :: at fset) = fset_to_set (fmap atom fset)" + apply (induct fset) + apply (simp add: supp_fempty) apply (simp add: supp_at_finsert) apply (simp add: supp_at_base) done diff -r 014ddf0d7271 -r 1d70813ae674 Nominal/Nominal2_Supp.thy --- a/Nominal/Nominal2_Supp.thy Mon Mar 22 10:20:57 2010 +0100 +++ b/Nominal/Nominal2_Supp.thy Mon Mar 22 10:21:14 2010 +0100 @@ -468,7 +468,7 @@ section {* at_set_avoiding2 *} -lemma at_set_avoiding2 +lemma at_set_avoiding2: assumes "finite xs" and "finite (supp c)" "finite (supp x)" and "xs \* x" @@ -483,4 +483,4 @@ apply(auto simp add: fresh_star_def fresh_def) done -end \ No newline at end of file +end diff -r 014ddf0d7271 -r 1d70813ae674 Nominal/TySch.thy --- a/Nominal/TySch.thy Mon Mar 22 10:20:57 2010 +0100 +++ b/Nominal/TySch.thy Mon Mar 22 10:21:14 2010 +0100 @@ -14,8 +14,12 @@ and tyS = All xs::"name fset" ty::"t" bind xs in ty -lemma size_eqvt: "size (pi \ x) = size x" -sorry (* Can this be shown? *) +lemma size_eqvt_raw: + "size (pi \ t :: t_raw) = size t" + "size (pi \ ts :: tyS_raw) = size ts" + apply (induct rule: t_raw_tyS_raw.inducts) + apply simp_all + done instantiation t and tyS :: size begin @@ -36,7 +40,7 @@ apply (simp_all only: t_raw_tyS_raw.size) apply (simp_all only: alpha_gen) apply clarify - apply (simp_all only: size_eqvt) + apply (simp_all only: size_eqvt_raw) done lemma [quot_respect]: @@ -73,7 +77,7 @@ assumes a1: "\name b. P b (Var name)" and a2: "\t1 t2 b. \\c. P c t1; \c. P c t2\ \ P b (Fun t1 t2)" and a3: "\fset t b. \\c. P c t; fset_to_set (fmap atom fset) \* b\ \ P' b (All fset t)" - shows "P (a :: 'a :: pt) t \ P' d ts " + shows "P (a :: 'a :: pt) t \ P' (d :: 'b :: {fs}) ts " proof - have " (\p a. P a (p \ t)) \ (\p d. P' d (p \ ts))" apply (rule t_tyS.induct) @@ -85,14 +89,30 @@ apply simp apply (rule allI) apply (rule allI) - apply(subgoal_tac "\new::name fset. fset_to_set (fmap atom new) \* (d, All (p \ fset) (p \ t)) - \ fcard new = fcard fset") + apply(subgoal_tac "\pa. ((pa \ (fset_to_set (fmap atom (p \ fset)))) \* d \ supp (p \ TySch.All fset t) \* pa)") apply clarify - (*apply(rule_tac t="p \ All fset t" and - s="(((p \ fset) \ new) + p) \ All fset t" in subst) + apply(rule_tac t="p \ TySch.All fset t" and + s="pa \ (p \ TySch.All fset t)" in subst) + apply (rule supp_perm_eq) + apply assumption + apply (simp only: t_tyS.perm) apply (rule a3) - apply simp_all*) - sorry + apply(erule_tac x="(pa + p)" in allE) + apply simp + apply (simp add: eqvts eqvts_raw) + apply (rule at_set_avoiding2) + apply (simp add: fin_fset_to_set) + apply (simp add: finite_supp) + apply (simp add: eqvts finite_supp) + apply (subst atom_eqvt_raw[symmetric]) + apply (subst fmap_eqvt[symmetric]) + apply (subst fset_to_set_eqvt[symmetric]) + apply (simp only: fresh_star_permute_iff) + apply (simp add: fresh_star_def) + apply clarify + apply (simp add: fresh_def) + apply (simp add: t_tyS_supp) + done then have "P a (0 \ t) \ P' d (0 \ ts)" by blast then show ?thesis by simp qed