diff -r 480324a48a1c -r 66097fe4942a Quot/Nominal/Abs.thy --- a/Quot/Nominal/Abs.thy Mon Feb 08 13:13:20 2010 +0100 +++ b/Quot/Nominal/Abs.thy Mon Feb 08 13:50:52 2010 +0100 @@ -2,35 +2,37 @@ imports "Nominal2_Atoms" "Nominal2_Eqvt" "Nominal2_Supp" "../QuotMain" "../QuotProd" begin -(* lemmas that should be in Nominal \\must be cleaned *) +(* the next three lemmas that should be in Nominal \\must be cleaned *) +lemma ball_image: + shows "(\x \ p \ S. P x) = (\x \ S. P (p \ x))" +apply(auto) +apply(drule_tac x="p \ x" in bspec) +apply(simp add: mem_permute_iff) +apply(simp) +apply(drule_tac x="(- p) \ x" in bspec) +apply(rule_tac p1="p" in mem_permute_iff[THEN iffD1]) +apply(simp) +apply(simp) +done + lemma fresh_star_plus: fixes p q::perm shows "\a \* p; a \* q\ \ a \* (p + q)" unfolding fresh_star_def by (simp add: fresh_plus_perm) - lemma fresh_star_permute_iff: shows "(p \ a) \* (p \ x) \ a \* x" apply(simp add: fresh_star_def) -apply(auto) -apply(drule_tac x="p \ xa" in bspec) -apply(unfold mem_def permute_fun_def)[1] -apply(simp add: eqvts del: permute_eqvt) +apply(simp add: ball_image) apply(simp add: fresh_permute_iff) -apply(rule_tac ?p1="- p" in fresh_permute_iff[THEN iffD1]) -apply(simp) -apply(drule_tac x="- p \ xa" in bspec) -apply(rule_tac ?p1="p" in mem_permute_iff[THEN iffD1]) -apply(simp) -apply(simp) done fun alpha_gen where alpha_gen[simp del]: - "(alpha_gen (bs, x) R f pi (cs, y)) \ (f x - bs = f y - cs) \ ((f x - bs) \* pi) \ (R (pi \ x) y)" + "alpha_gen (bs, x) R f pi (cs, y) \ f x - bs = f y - cs \ (f x - bs) \* pi \ R (pi \ x) y" notation alpha_gen ("_ \gen _ _ _ _" [100, 100, 100, 100, 100] 100) @@ -129,7 +131,6 @@ apply(simp) done - fun alpha_abs where @@ -171,15 +172,18 @@ apply(rule equivpI) unfolding reflp_def symp_def transp_def apply(simp_all) + (* refl *) apply(clarify) apply(rule exI) apply(rule alpha_gen_refl) apply(simp) + (* symm *) apply(clarify) apply(rule exI) apply(rule alpha_gen_sym) apply(assumption) apply(clarsimp) + (* trans *) apply(clarify) apply(rule exI) apply(rule alpha_gen_trans) @@ -220,6 +224,11 @@ apply(lifting prod.induct[where 'a="atom set" and 'b="'a"]) done +(* TEST case *) +lemmas abs_induct2 = prod.induct[where 'a="atom set" and 'b="'a::pt", quot_lifted] + +thm abs_induct abs_induct2 + instantiation abs :: (pt) pt begin