diff -r 3750c08f627e -r c95afd0dc594 Nominal/Ex/SFT/Consts.thy --- a/Nominal/Ex/SFT/Consts.thy Wed Dec 21 14:25:05 2011 +0900 +++ b/Nominal/Ex/SFT/Consts.thy Wed Dec 21 15:43:58 2011 +0900 @@ -4,77 +4,82 @@ fun Umn :: "nat \ nat \ lam" where - [simp del]: "Umn 0 n = \(cn 0). V (cn n)" + [simp del]: "Umn 0 n = \(cn 0). Var (cn n)" | [simp del]: "Umn (Suc m) n = \(cn (Suc m)). Umn m n" lemma [simp]: "2 = Suc 1" by auto +lemma split_lemma: + "(a = b \ X) \ (a \ b \ Y) \ (a = b \ X) \ (a \ b \ Y)" + by blast + lemma Lam_U: - "x \ y \ y \ z \ x \ z \ Umn 2 0 = \x. \y. \z. V z" - "x \ y \ y \ z \ x \ z \ Umn 2 1 = \x. \y. \z. V y" - "x \ y \ y \ z \ x \ z \ Umn 2 2 = \x. \y. \z. V x" - apply (simp_all add: Umn.simps Abs1_eq_iff lam.fresh fresh_at_base flip_def[symmetric] Umn.simps) - apply (smt Zero_not_Suc cnd flip_at_base_simps flip_at_simps)+ + assumes "x \ y" "y \ z" "x \ z" + shows "Umn 2 0 = \x. \y. \z. Var z" + "Umn 2 1 = \x. \y. \z. Var y" + "Umn 2 2 = \x. \y. \z. Var x" + apply (simp_all add: Umn.simps Abs1_eq_iff lam.fresh fresh_at_base flip_def[symmetric] Umn.simps cnd permute_flip_at assms assms[symmetric] split_lemma) + apply (intro impI conjI) + apply (metis assms)+ done -lemma a: "n \ m \ atom (cn n) \ supp (Umn m n)" - apply (induct m) - apply (auto simp add: lam.supp supp_at_base Umn.simps) - by smt +lemma supp_U1: "n \ m \ atom (cn n) \ supp (Umn m n)" + by (induct m) + (auto simp add: lam.supp supp_at_base Umn.simps le_Suc_eq) -lemma b: "supp (Umn m n) \ {atom (cn n)}" +lemma supp_U2: "supp (Umn m n) \ {atom (cn n)}" by (induct m) (auto simp add: lam.supp supp_at_base Umn.simps) lemma supp_U[simp]: "n \ m \ supp (Umn m n) = {}" - using a b + using supp_U1 supp_U2 by blast lemma U_eqvt: "n \ m \ p \ (Umn m n) = Umn m n" by (rule_tac [!] perm_supp_eq) (simp_all add: fresh_star_def fresh_def) -definition Var where "Var \ \cx. \cy. (V cy \ (Umn 2 2) \ V cx \ V cy)" -definition "App \ \cx. \cy. \cz. (V cz \ Umn 2 1 \ V cx \ V cy \ V cz)" -definition "Abs \ \cx. \cy. (V cy \ Umn 2 0 \ V cx \ V cy)" +definition VAR where "VAR \ \cx. \cy. (Var cy \ (Umn 2 2) \ Var cx \ Var cy)" +definition "APP \ \cx. \cy. \cz. (Var cz \ Umn 2 1 \ Var cx \ Var cy \ Var cz)" +definition "Abs \ \cx. \cy. (Var cy \ Umn 2 0 \ Var cx \ Var cy)" -lemma Var_App_Abs: - "x \ e \ Var = \x. \e. (V e \ Umn 2 2 \ V x \ V e)" - "e \ x \ e \ y \ x \ y \ App = \x. \y. \e. (V e \ Umn 2 1 \ V x \ V y \ V e)" - "x \ e \ Abs = \x. \e. (V e \ Umn 2 0 \ V x \ V e)" - unfolding Var_def App_def Abs_def - by (simp_all add: Abs1_eq_iff lam.fresh flip_def[symmetric] U_eqvt fresh_def lam.supp supp_at_base) - (smt cx_cy_cz permute_flip_at Zero_not_Suc cnd flip_at_base_simps flip_at_simps)+ +lemma VAR_APP_Abs: + "x \ e \ VAR = \x. \e. (Var e \ Umn 2 2 \ Var x \ Var e)" + "e \ x \ e \ y \ x \ y \ APP = \x. \y. \e. (Var e \ Umn 2 1 \ Var x \ Var y \ Var e)" + "x \ e \ Abs = \x. \e. (Var e \ Umn 2 0 \ Var x \ Var e)" + unfolding VAR_def APP_def Abs_def + by (simp_all add: Abs1_eq_iff lam.fresh flip_def[symmetric] U_eqvt fresh_def lam.supp supp_at_base split_lemma permute_flip_at) + (auto simp only: cx_cy_cz cx_cy_cz[symmetric]) -lemma Var_app: - "Var \ x \ e \ e \ Umn 2 2 \ x \ e" - by (rule lam2_fast_app) (simp_all add: Var_App_Abs) +lemma VAR_app: + "VAR \ x \ e \ e \ Umn 2 2 \ x \ e" + by (rule lam2_fast_app[OF VAR_APP_Abs(1)]) simp_all -lemma App_app: - "App \ x \ y \ e \ e \ Umn 2 1 \ x \ y \ e" - by (rule lam3_fast_app[OF Var_App_Abs(2)]) (simp_all) +lemma APP_app: + "APP \ x \ y \ e \ e \ Umn 2 1 \ x \ y \ e" + by (rule lam3_fast_app[OF VAR_APP_Abs(2)]) (simp_all) lemma Abs_app: "Abs \ x \ e \ e \ Umn 2 0 \ x \ e" - by (rule lam2_fast_app) (simp_all add: Var_App_Abs) + by (rule lam2_fast_app[OF VAR_APP_Abs(3)]) simp_all -lemma supp_Var_App_Abs[simp]: - "supp Var = {}" "supp App = {}" "supp Abs = {}" - by (simp_all add: Var_def App_def Abs_def lam.supp supp_at_base) blast+ +lemma supp_VAR_APP_Abs[simp]: + "supp VAR = {}" "supp APP = {}" "supp Abs = {}" + by (simp_all add: VAR_def APP_def Abs_def lam.supp supp_at_base) blast+ -lemma Var_App_Abs_eqvt[eqvt]: - "p \ Var = Var" "p \ App = App" "p \ Abs = Abs" +lemma VAR_APP_Abs_eqvt[eqvt]: + "p \ VAR = VAR" "p \ APP = APP" "p \ Abs = Abs" by (rule_tac [!] perm_supp_eq) (simp_all add: fresh_star_def fresh_def) nominal_primrec Numeral :: "lam \ lam" ("\_\" 1000) where - "\V x\ = Var \ (V x)" -| Ap: "\M \ N\ = App \ \M\ \ \N\" + "\Var x\ = VAR \ (Var x)" +| Ap: "\M \ N\ = APP \ \M\ \ \N\" | "\\x. M\ = Abs \ (\x. \M\)" proof auto fix x :: lam and P - assume "\xa. x = V xa \ P" "\M N. x = M \ N \ P" "\xa M. x = \ xa. M \ P" + assume "\xa. x = Var xa \ P" "\M N. x = M \ N \ P" "\xa M. x = \ xa. M \ P" then show "P" by (rule_tac y="x" and c="0 :: perm" in lam.strong_exhaust) (auto simp add: Abs1_eq_iff fresh_star_def)[3] @@ -106,8 +111,8 @@ unfolding fresh_def by simp fun app_lst :: "var \ lam list \ lam" where - "app_lst n [] = V n" -| "app_lst n (h # t) = Ap (app_lst n t) h" + "app_lst n [] = Var n" +| "app_lst n (h # t) = (app_lst n t) \ h" lemma app_lst_eqvt[eqvt]: "p \ (app_lst t ts) = app_lst (p \ t) (p \ ts)" by (induct ts arbitrary: t p) (simp_all add: eqvts) @@ -164,7 +169,7 @@ proof - obtain x :: var where "atom x \ (M, N, P, R)" using obtain_fresh by auto then have *: "atom x \ (M,N,P)" "atom x \ R" using fresh_Pair by simp_all - then have s: "V x \ M \ N \ P [x ::= R] \ R \ M \ N \ P" using b1 by simp + then have s: "Var x \ M \ N \ P [x ::= R] \ R \ M \ N \ P" using b1 by simp show ?thesis using * apply (subst Ltgt.simps) apply (simp add: fresh_Cons fresh_Nil fresh_Pair_elim) @@ -205,18 +210,17 @@ by (rule b3, rule Ltgt3_app, rule lam3_fast_app, rule Lam_U, simp_all) (rule b3, rule Ltgt3_app, rule lam3_fast_app, rule Lam_U[simplified], simp_all)+ -definition "F1 \ \cx. (App \ \Var\ \ (Var \ V cx))" -definition "F2 \ \cx. \cy. \cz. ((App \ (App \ \App\ \ (V cz \ V cx))) \ (V cz \ V cy))" -definition "F3 \ \cx. \cy. (App \ \Abs\ \ (Abs \ (\cz. (V cy \ (V cx \ V cz)))))" +definition "F1 \ \cx. (APP \ \VAR\ \ (VAR \ Var cx))" +definition "F2 \ \cx. \cy. \cz. ((APP \ (APP \ \APP\ \ (Var cz \ Var cx))) \ (Var cz \ Var cy))" +definition "F3 \ \cx. \cy. (APP \ \Abs\ \ (Abs \ (\cz. (Var cy \ (Var cx \ Var cz)))))" lemma Lam_F: - "F1 = \x. (App \ \Var\ \ (Var \ V x))" - "a \ b \ a \ c \ c \ b \ F2 = \a. \b. \c. ((App \ (App \ \App\ \ (V c \ V a))) \ (V c \ V b))" - "a \ b \ a \ x \ x \ b \ F3 = \a. \b. (App \ \Abs\ \ (Abs \ (\x. (V b \ (V a \ V x)))))" - apply (simp_all add: F1_def F2_def F3_def Abs1_eq_iff lam.fresh supp_at_base Var_App_Abs_eqvt Numeral.eqvt flip_def[symmetric] fresh_at_base) - apply (smt cx_cy_cz permute_flip_at)+ - done + "F1 = \x. (APP \ \VAR\ \ (VAR \ Var x))" + "a \ b \ a \ c \ c \ b \ F2 = \a. \b. \c. ((APP \ (APP \ \APP\ \ (Var c \ Var a))) \ (Var c \ Var b))" + "a \ b \ a \ x \ x \ b \ F3 = \a. \b. (APP \ \Abs\ \ (Abs \ (\x. (Var b \ (Var a \ Var x)))))" + by (simp_all add: F1_def F2_def F3_def Abs1_eq_iff lam.fresh supp_at_base VAR_APP_Abs_eqvt Numeral.eqvt flip_def[symmetric] fresh_at_base split_lemma permute_flip_at) + (auto simp add: cx_cy_cz cx_cy_cz[symmetric]) lemma supp_F[simp]: "supp F1 = {}" "supp F2 = {}" "supp F3 = {}" @@ -229,14 +233,14 @@ (simp_all add: fresh_star_def fresh_def) lemma F_app: - "F1 \ A \ App \ \Var\ \ (Var \ A)" - "F2 \ A \ B \ C \ (App \ (App \ \App\ \ (C \ A))) \ (C \ B)" + "F1 \ A \ APP \ \VAR\ \ (VAR \ A)" + "F2 \ A \ B \ C \ (APP \ (APP \ \APP\ \ (C \ A))) \ (C \ B)" by (rule lam1_fast_app, rule Lam_F, simp_all) (rule lam3_fast_app, rule Lam_F, simp_all) lemma F3_app: assumes f: "atom x \ A" "atom x \ B" (* or A and B have empty support *) - shows "F3 \ A \ B \ App \ \Abs\ \ (Abs \ (\x. (B \ (A \ V x))))" + shows "F3 \ A \ B \ APP \ \Abs\ \ (Abs \ (\x. (B \ (A \ Var x))))" proof - obtain y :: var where b: "atom y \ (x, A, B)" using obtain_fresh by blast obtain z :: var where c: "atom z \ (x, y, A, B)" using obtain_fresh by blast @@ -258,16 +262,15 @@ done qed -definition Lam_A1_pre : "A1 \ \cx. \cy. (F1 \ V cx)" -definition Lam_A2_pre : "A2 \ \cx. \cy. \cz. (F2 \ V cx \ V cy \ \[V cz]\)" -definition Lam_A3_pre : "A3 \ \cx. \cy. (F3 \ V cx \ \[V cy]\)" +definition Lam_A1_pre : "A1 \ \cx. \cy. (F1 \ Var cx)" +definition Lam_A2_pre : "A2 \ \cx. \cy. \cz. (F2 \ Var cx \ Var cy \ \[Var cz]\)" +definition Lam_A3_pre : "A3 \ \cx. \cy. (F3 \ Var cx \ \[Var cy]\)" lemma Lam_A: - "x \ y \ A1 = \x. \y. (F1 \ V x)" - "a \ b \ a \ c \ c \ b \ A2 = \a. \b. \c. (F2 \ V a \ V b \ \[V c]\)" - "a \ b \ A3 = \a. \b. (F3 \ V a \ \[V b]\)" - apply (simp_all add: Lam_A1_pre Lam_A2_pre Lam_A3_pre Abs1_eq_iff lam.fresh supp_at_base Var_App_Abs_eqvt Numeral.eqvt flip_def[symmetric] fresh_at_base F_eqvt Ltgt.eqvt) - apply (smt cx_cy_cz permute_flip_at)+ - done + "x \ y \ A1 = \x. \y. (F1 \ Var x)" + "a \ b \ a \ c \ c \ b \ A2 = \a. \b. \c. (F2 \ Var a \ Var b \ \[Var c]\)" + "a \ b \ A3 = \a. \b. (F3 \ Var a \ \[Var b]\)" + by (simp_all add: Lam_A1_pre Lam_A2_pre Lam_A3_pre Abs1_eq_iff lam.fresh supp_at_base VAR_APP_Abs_eqvt Numeral.eqvt flip_def[symmetric] fresh_at_base F_eqvt Ltgt.eqvt split_lemma permute_flip_at cx_cy_cz cx_cy_cz[symmetric]) + auto lemma supp_A[simp]: "supp A1 = {}" "supp A2 = {}" "supp A3 = {}"