diff -r d959bc9c800c -r a190b2b79cc8 Nominal/Nominal2_Abs.thy --- a/Nominal/Nominal2_Abs.thy Wed Nov 30 14:58:19 2011 +0000 +++ b/Nominal/Nominal2_Abs.thy Mon Dec 05 15:34:12 2011 +0000 @@ -451,6 +451,10 @@ apply(auto simp add: alphas_abs)[1] done +lemma alpha_res_alpha_set: + "(bs, x) \res op = supp p (cs, y) \ (bs \ supp x, x) \set op = supp p (cs \ supp y, y)" + using alpha_abs_set_abs_res alpha_abs_res_abs_set by blast + section {* Quotient types *} quotient_type @@ -497,38 +501,34 @@ by (auto intro: alphas_abs_eqvt simp only: Pair_eqvt) lemma Abs_eq_iff: - shows "Abs_set bs x = Abs_set cs y \ (\p. (bs, x) \set (op =) supp p (cs, y))" - and "Abs_res bs x = Abs_res cs y \ (\p. (bs, x) \res (op =) supp p (cs, y))" - and "Abs_lst bsl x = Abs_lst csl y \ (\p. (bsl, x) \lst (op =) supp p (csl, y))" + shows "[bs]set. x = [bs']set. y \ (\p. (bs, x) \set (op =) supp p (bs', y))" + and "[bs]res. x = [bs']res. y \ (\p. (bs, x) \res (op =) supp p (bs', y))" + and "[cs]lst. x = [cs']lst. y \ (\p. (cs, x) \lst (op =) supp p (cs', y))" by (lifting alphas_abs) lemma Abs_eq_iff2: - shows "Abs_set bs x = Abs_set cs y \ (\p. (bs, x) \set (op =) supp p (cs, y) \ supp p \ bs \ cs)" - and "Abs_res bs x = Abs_res cs y \ (\p. (bs, x) \res (op =) supp p (cs, y) \ supp p \ bs \ cs)" - and "Abs_lst bsl x = Abs_lst csl y \ - (\p. (bsl, x) \lst (op =) supp p (csl, y) \ supp p \ set bsl \ set csl)" + shows "[bs]set. x = [bs']set. y \ (\p. (bs, x) \set (op=) supp p (bs', y) \ supp p \ bs \ bs')" + and "[bs]res. x = [bs']res. y \ (\p. (bs, x) \res (op=) supp p (bs', y) \ supp p \ bs \ bs')" + and "[cs]lst. x = [cs']lst. y \ (\p. (cs, x) \lst (op=) supp p (cs', y) \ supp p \ set cs \ set cs')" by (lifting alphas_abs_stronger) -lemma alpha_res_alpha_set: - "(bs, x) \res op = supp p (cs, y) \ (bs \ supp x, x) \set op = supp p (cs \ supp y, y)" - using alpha_abs_set_abs_res alpha_abs_res_abs_set by blast lemma Abs_eq_res_set: - "(([bs]res. x) = ([cs]res. y)) = (([(bs \ supp x)]set. x) = ([(cs \ supp y)]set. y))" + shows "[bs]res. x = [cs]res. y \ [bs \ supp x]set. x = [cs \ supp y]set. y" unfolding Abs_eq_iff alpha_res_alpha_set by rule lemma Abs_eq_res_supp: assumes asm: "supp x \ bs" - shows "([as]res. x) = ([as \ bs]res. x)" + shows "[as]res. x = [as \ bs]res. x" unfolding Abs_eq_iff alphas apply (rule_tac x="0::perm" in exI) apply (simp add: fresh_star_zero) using asm by blast lemma Abs_exhausts: - shows "(\as (x::'a::pt). y1 = Abs_set as x \ P1) \ P1" - and "(\as (x::'a::pt). y2 = Abs_res as x \ P2) \ P2" - and "(\as (x::'a::pt). y3 = Abs_lst as x \ P3) \ P3" + shows "(\as (x::'a::pt). y1 = [as]set. x \ P1) \ P1" + and "(\as (x::'a::pt). y2 = [as]res. x \ P2) \ P2" + and "(\bs (x::'a::pt). y3 = [bs]lst. x \ P3) \ P3" by (lifting prod.exhaust[where 'a="atom set" and 'b="'a"] prod.exhaust[where 'a="atom set" and 'b="'a"] prod.exhaust[where 'a="atom list" and 'b="'a"]) @@ -544,7 +544,7 @@ lemma permute_Abs_set[simp]: fixes x::"'a::pt" - shows "(p \ (Abs_set as x)) = Abs_set (p \ as) (p \ x)" + shows "(p \ ([as]set. x)) = [p \ as]set. (p \ x)" by (lifting permute_prod.simps[where 'a="atom set" and 'b="'a"]) instance @@ -565,7 +565,7 @@ lemma permute_Abs_res[simp]: fixes x::"'a::pt" - shows "(p \ (Abs_res as x)) = Abs_res (p \ as) (p \ x)" + shows "(p \ ([as]res. x)) = [p \ as]res. (p \ x)" by (lifting permute_prod.simps[where 'a="atom set" and 'b="'a"]) instance @@ -586,7 +586,7 @@ lemma permute_Abs_lst[simp]: fixes x::"'a::pt" - shows "(p \ (Abs_lst as x)) = Abs_lst (p \ as) (p \ x)" + shows "(p \ ([as]lst. x)) = [p \ as]lst. (p \ x)" by (lifting permute_prod.simps[where 'a="atom list" and 'b="'a"]) instance @@ -603,8 +603,8 @@ lemma Abs_swap1: assumes a1: "a \ (supp x) - bs" and a2: "b \ (supp x) - bs" - shows "Abs_set bs x = Abs_set ((a \ b) \ bs) ((a \ b) \ x)" - and "Abs_res bs x = Abs_res ((a \ b) \ bs) ((a \ b) \ x)" + shows "[bs]set. x = [(a \ b) \ bs]set. ((a \ b) \ x)" + and "[bs]res. x = [(a \ b) \ bs]res. ((a \ b) \ x)" unfolding Abs_eq_iff unfolding alphas unfolding supp_eqvt[symmetric] Diff_eqvt[symmetric] @@ -617,7 +617,7 @@ lemma Abs_swap2: assumes a1: "a \ (supp x) - (set bs)" and a2: "b \ (supp x) - (set bs)" - shows "Abs_lst bs x = Abs_lst ((a \ b) \ bs) ((a \ b) \ x)" + shows "[bs]lst. x = [(a \ b) \ bs]lst. ((a \ b) \ x)" unfolding Abs_eq_iff unfolding alphas unfolding supp_eqvt[symmetric] Diff_eqvt[symmetric] set_eqvt[symmetric] @@ -628,9 +628,9 @@ (auto simp add: supp_perm swap_atom) lemma Abs_supports: - shows "((supp x) - as) supports (Abs_set as x)" - and "((supp x) - as) supports (Abs_res as x)" - and "((supp x) - set bs) supports (Abs_lst bs x)" + shows "((supp x) - as) supports ([as]set. x)" + and "((supp x) - as) supports ([as]res. x)" + and "((supp x) - set bs) supports ([bs]lst. x)" unfolding supports_def unfolding permute_Abs by (simp_all add: Abs_swap1[symmetric] Abs_swap2[symmetric]) @@ -638,26 +638,26 @@ function supp_set :: "('a::pt) abs_set \ atom set" where - "supp_set (Abs_set as x) = supp x - as" + "supp_set ([as]set. x) = supp x - as" apply(case_tac x rule: Abs_exhausts(1)) apply(simp) apply(simp add: Abs_eq_iff alphas_abs alphas) done termination supp_set - by (auto intro!: local.termination) + by lexicographic_order function supp_res :: "('a::pt) abs_res \ atom set" where - "supp_res (Abs_res as x) = supp x - as" + "supp_res ([as]res. x) = supp x - as" apply(case_tac x rule: Abs_exhausts(2)) apply(simp) apply(simp add: Abs_eq_iff alphas_abs alphas) done termination supp_res - by (auto intro!: local.termination) + by lexicographic_order function supp_lst :: "('a::pt) abs_lst \ atom set" @@ -668,8 +668,8 @@ apply(simp add: Abs_eq_iff alphas_abs alphas) done -termination supp_lst - by (auto intro!: local.termination) +termination supp_lst + by lexicographic_order lemma supp_funs_eqvt[eqvt]: shows "(p \ supp_set x) = supp_set (p \ x)" @@ -684,44 +684,43 @@ done lemma Abs_fresh_aux: - shows "a \ Abs bs x \ a \ supp_set (Abs bs x)" - and "a \ Abs_res bs x \ a \ supp_res (Abs_res bs x)" - and "a \ Abs_lst cs x \ a \ supp_lst (Abs_lst cs x)" + shows "a \ [bs]set. x \ a \ supp_set ([bs]set. x)" + and "a \ [bs]res. x \ a \ supp_res ([bs]res. x)" + and "a \ [cs]lst. x \ a \ supp_lst ([cs]lst. x)" by (rule_tac [!] fresh_fun_eqvt_app) (auto simp only: eqvt_def eqvts_raw) lemma Abs_supp_subset1: assumes a: "finite (supp x)" - shows "(supp x) - as \ supp (Abs_set as x)" - and "(supp x) - as \ supp (Abs_res as x)" - and "(supp x) - (set bs) \ supp (Abs_lst bs x)" + shows "(supp x) - as \ supp ([as]set. x)" + and "(supp x) - as \ supp ([as]res. x)" + and "(supp x) - (set bs) \ supp ([bs]lst. x)" unfolding supp_conv_fresh by (auto dest!: Abs_fresh_aux) (simp_all add: fresh_def supp_finite_atom_set a) lemma Abs_supp_subset2: assumes a: "finite (supp x)" - shows "supp (Abs_set as x) \ (supp x) - as" - and "supp (Abs_res as x) \ (supp x) - as" - and "supp (Abs_lst bs x) \ (supp x) - (set bs)" + shows "supp ([as]set. x) \ (supp x) - as" + and "supp ([as]res. x) \ (supp x) - as" + and "supp ([bs]lst. x) \ (supp x) - (set bs)" by (rule_tac [!] supp_is_subset) (simp_all add: Abs_supports a) lemma Abs_finite_supp: assumes a: "finite (supp x)" - shows "supp (Abs_set as x) = (supp x) - as" - and "supp (Abs_res as x) = (supp x) - as" - and "supp (Abs_lst bs x) = (supp x) - (set bs)" - by (rule_tac [!] subset_antisym) - (simp_all add: Abs_supp_subset1[OF a] Abs_supp_subset2[OF a]) + shows "supp ([as]set. x) = (supp x) - as" + and "supp ([as]res. x) = (supp x) - as" + and "supp ([bs]lst. x) = (supp x) - (set bs)" +using Abs_supp_subset1[OF a] Abs_supp_subset2[OF a] + by blast+ lemma supp_Abs: fixes x::"'a::fs" - shows "supp (Abs_set as x) = (supp x) - as" - and "supp (Abs_res as x) = (supp x) - as" - and "supp (Abs_lst bs x) = (supp x) - (set bs)" - by (rule_tac [!] Abs_finite_supp) - (simp_all add: finite_supp) + shows "supp ([as]set. x) = (supp x) - as" + and "supp ([as]res. x) = (supp x) - as" + and "supp ([bs]lst. x) = (supp x) - (set bs)" +by (simp_all add: Abs_finite_supp finite_supp) instance abs_set :: (fs) fs apply(default) @@ -743,38 +742,40 @@ lemma Abs_fresh_iff: fixes x::"'a::fs" - shows "a \ Abs_set bs x \ a \ bs \ (a \ bs \ a \ x)" - and "a \ Abs_res bs x \ a \ bs \ (a \ bs \ a \ x)" - and "a \ Abs_lst cs x \ a \ (set cs) \ (a \ (set cs) \ a \ x)" + shows "a \ [bs]set. x \ a \ bs \ (a \ bs \ a \ x)" + and "a \ [bs]res. x \ a \ bs \ (a \ bs \ a \ x)" + and "a \ [cs]lst. x \ a \ (set cs) \ (a \ (set cs) \ a \ x)" unfolding fresh_def unfolding supp_Abs by auto lemma Abs_fresh_star_iff: fixes x::"'a::fs" - shows "as \* Abs_set bs x \ (as - bs) \* x" - and "as \* Abs_res bs x \ (as - bs) \* x" - and "as \* Abs_lst cs x \ (as - set cs) \* x" + shows "as \* ([bs]set. x) \ (as - bs) \* x" + and "as \* ([bs]res. x) \ (as - bs) \* x" + and "as \* ([cs]lst. x) \ (as - set cs) \* x" unfolding fresh_star_def by (auto simp add: Abs_fresh_iff) lemma Abs_fresh_star: fixes x::"'a::fs" - shows "as \ as' \ as \* Abs_set as' x" - and "as \ as' \ as \* Abs_res as' x" - and "bs \ set bs' \ bs \* Abs_lst bs' x" + shows "as \ as' \ as \* ([as']set. x)" + and "as \ as' \ as \* ([as']res. x)" + and "bs \ set bs' \ bs \* ([bs']lst. x)" unfolding fresh_star_def by(auto simp add: Abs_fresh_iff) lemma Abs_fresh_star2: fixes x::"'a::fs" - shows "as \ bs = {} \ as \* Abs_set bs x \ as \* x" - and "as \ bs = {} \ as \* Abs_res bs x \ as \* x" - and "cs \ set ds = {} \ cs \* Abs_lst ds x \ cs \* x" + shows "as \ bs = {} \ as \* ([bs]set. x) \ as \* x" + and "as \ bs = {} \ as \* ([bs]res. x) \ as \* x" + and "cs \ set ds = {} \ cs \* ([ds]lst. x) \ cs \* x" unfolding fresh_star_def Abs_fresh_iff by auto +section {* Abstractions of single atoms *} + lemma Abs1_eq: fixes x::"'a::fs" shows "Abs_set {a} x = Abs_set {a} y \ x = y" @@ -886,7 +887,7 @@ and b: "finite bs" shows "\q. [bs]set. x = [p \ bs]set. (q \ x) \ q \ bs = p \ bs" proof - - from b set_renaming_perm + from set_renaming_perm2 obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) have "[bs]set. x = q \ ([bs]set. x)" @@ -906,7 +907,7 @@ and b: "finite bs" shows "\q. [bs]res. x = [p \ bs]res. (q \ x) \ q \ bs = p \ bs" proof - - from b set_renaming_perm + from set_renaming_perm2 obtain q where *: "\b \ bs. q \ b = p \ b" and **: "supp q \ bs \ (p \ bs)" by blast have ***: "q \ bs = p \ bs" using b * by (induct) (simp add: permute_set_eq, simp add: insert_eqvt) have "[bs]res. x = q \ ([bs]res. x)" @@ -925,7 +926,7 @@ assumes a: "(p \ (set bs)) \* x" shows "\q. [bs]lst. x = [p \ bs]lst. (q \ x) \ q \ bs = p \ bs" proof - - from a list_renaming_perm + from list_renaming_perm obtain q where *: "\b \ set bs. q \ b = p \ b" and **: "supp q \ set bs \ (p \ set bs)" by blast have ***: "q \ bs = p \ bs" using * by (induct bs) (simp_all add: insert_eqvt) have "[bs]lst. x = q \ ([bs]lst. x)"