diff -r 577e5d19b33c -r b18fabea0fd0 src/HOL/Nominal/Examples/CR.thy --- a/src/HOL/Nominal/Examples/CR.thy Wed Nov 30 16:59:19 2005 +0100 +++ b/src/HOL/Nominal/Examples/CR.thy Wed Nov 30 17:56:08 2005 +0100 @@ -8,21 +8,22 @@ lemma forget[rule_format]: shows "a\t1 \ t1[a::=t2] = t1" -proof (nominal_induct t1 rule: lam_induct) +proof (nominal_induct t1 fresh: a t2 rule: lam_induct) case (Var a t2 b) show ?case by (simp, simp add: fresh_atm) next case App thus ?case by (simp add: fresh_prod) next - case (Lam a t2 c t) - have i: "\a b. a\t \ t[a::=b] = t" by fact - have "c\(a,t2)" by fact - hence a: "a\c" and b: "c\t2" by (auto simp add: fresh_prod fresh_atm) + case (Lam c t a t2) + have i: "\c t2. c\t \ t[c::=t2] = t" by fact + have a: "c\t2" by fact + have "c\a" by fact + hence b: "a\c" by (simp add: fresh_atm) show ?case proof assume "a\Lam [c].t" - hence "a\t" using a by (force simp add: abs_fresh) + hence "a\t" using b by (simp add: abs_fresh) hence "t[a::=t2] = t" using i by simp thus "(Lam [c].t)[a::=t2] = Lam [c].t" using a b by (simp add: alpha) qed @@ -30,8 +31,8 @@ lemma forget[rule_format]: shows "a\t1 \ t1[a::=t2] = t1" -apply (nominal_induct t1 rule: lam_induct) -apply(auto simp add: abs_fresh fresh_atm fresh_prod) +apply (nominal_induct t1 fresh: a t2 rule: lam_induct) +apply(auto simp add: abs_fresh fresh_atm) done lemma fresh_fact[rule_format]: @@ -40,24 +41,23 @@ and t1 :: "lam" and t2 :: "lam" shows "a\t1\a\t2\a\(t1[b::=t2])" -proof (nominal_induct t1 rule: lam_induct) - case (Var a b t2 c) - show ?case by (simp) +proof (nominal_induct t1 fresh: a b t2 rule: lam_induct) + case (Var c a b t2) + show ?case by simp next - case App - thus ?case by (simp add: fresh_prod) + case App thus ?case by simp next - case (Lam a b t2 c t) - have i: "\(a::name) b t2. a\t\a\t2\a\(t[b::=t2])" by fact - have "c\(a,b,t2)" by fact - hence b: "c\a \ c\b \ c\t2" by (simp add: fresh_prod fresh_atm) + case (Lam c t a b t2) + have i: "\(a::name) b t2. a\t\a\t2\a\(t[b::=t2])" by fact + have fr: "c\a" "c\b" "c\t2" by fact+ + hence fr': "c\a" by (simp add: fresh_atm) show ?case proof (intro strip) assume a1: "a\t2" assume a2: "a\Lam [c].t" - hence "a\t" using b by (force simp add: abs_fresh) + hence "a\t" using fr' by (simp add: abs_fresh) hence "a\t[b::=t2]" using a1 i by simp - thus "a\(Lam [c].t)[b::=t2]" using b by (simp add: abs_fresh) + thus "a\(Lam [c].t)[b::=t2]" using fr by (simp add: abs_fresh) qed qed @@ -67,7 +67,7 @@ and t1 :: "lam" and t2 :: "lam" shows "a\t1\a\t2\a\(t1[b::=t2])" -apply(nominal_induct t1 rule: lam_induct) +apply(nominal_induct t1 fresh: a b t2 rule: lam_induct) apply(auto simp add: abs_fresh fresh_prod fresh_atm) done @@ -77,101 +77,57 @@ and L::"lam" and M::"lam" and N::"lam" - shows "x\y\x\L\M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" -proof (nominal_induct M rule: lam_induct) - case (Var L N x y z) (* case 1: Variables*) - show ?case - proof (intro strip) - assume a1: "x\y" - and a2: "x\L" - show "Var z[x::=N][y::=L] = Var z[y::=L][x::=N[y::=L]]" (is "?LHS = ?RHS") - proof - - have "z=x \ (z\x \ z=y) \ (z\x \ z\y)" by force - moreover (*Case 1.1*) - { assume c1: "z=x" - have c1l: "?LHS = N[y::=L]" using c1 by simp - have c1r: "?RHS = N[y::=L]" using c1 a1 by simp - from c1l and c1r have "?LHS = ?RHS" by simp - } - moreover (*Case 1.2*) - { assume c2: "z\x \ z=y" - have c2l: "?LHS = L" using c2 by force - have c2r: "?RHS = L[x::=N[y::=L]]" using c2 by force - have c2x: "L[x::=N[y::=L]] = L" using a2 by (simp add: forget) - from c2l and c2r and c2x have "?LHS = ?RHS" by simp - } - moreover (*Case 1.3*) - { assume c3: "z\x \ z\y" - have c3l: "?LHS = Var z" using c3 by force - have c3r: "?RHS = Var z" using c3 by force - from c3l and c3r have "?LHS = ?RHS" by simp - } - ultimately show "?LHS = ?RHS" by blast - qed + assumes a: "x\y" + and b: "x\L" + shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" +using a b +proof (nominal_induct M fresh: x y N L rule: lam_induct) + case (Var z) (* case 1: Variables*) + have "x\y" by fact + have "x\L" by fact + show "Var z[x::=N][y::=L] = Var z[y::=L][x::=N[y::=L]]" (is "?LHS = ?RHS") + proof - + { (*Case 1.1*) + assume "z=x" + have "(1)": "?LHS = N[y::=L]" using `z=x` by simp + have "(2)": "?RHS = N[y::=L]" using `z=x` `x\y` by simp + from "(1)" "(2)" have "?LHS = ?RHS" by simp + } + moreover + { (*Case 1.2*) + assume "z\x" and "z=y" + have "(1)": "?LHS = L" using `z\x` `z=y` by force + have "(2)": "?RHS = L[x::=N[y::=L]]" using `z=y` by force + have "(3)": "L[x::=N[y::=L]] = L" using `x\L` by (simp add: forget) + from "(1)" "(2)" "(3)" have "?LHS = ?RHS" by simp + } + moreover + { (*Case 1.3*) + assume "z\x" and "z\y" + have "(1)": "?LHS = Var z" using `z\x` `z\y` by force + have "(2)": "?RHS = Var z" using `z\x` `z\y` by force + from "(1)" "(2)" have "?LHS = ?RHS" by simp + } + ultimately show "?LHS = ?RHS" by blast qed next - case (Lam L N x y z M1) (* case 2: lambdas *) - assume f1: "z\(L,N,x,y)" - from f1 have f2: "z \ N[y::=L]" by (simp add: fresh_fact fresh_prod) - show ?case - proof (intro strip) - assume a1: "x\y" - and a2: "x\L" - show "(Lam [z].M1)[x::=N][y::=L] = (Lam [z].M1)[y::=L][x::=N[y::=L]]" (is "?LHS=?RHS") - proof - - have "?LHS = Lam [z].(M1[x::=N][y::=L])" using f1 - by (simp add: fresh_prod fresh_atm) - also have "\ = Lam [z].(M1[y::=L][x::=N[y::=L]])" using a1 a2 Lam(2) by simp - also have "\ = (Lam [z].(M1[y::=L]))[x::=N[y::=L]]" using f1 f2 - by (simp add: fresh_prod fresh_atm) - also have "\ = ?RHS" using f1 by (simp add: fresh_prod fresh_atm) - finally show "?LHS = ?RHS" . - qed + case (Lam z M1) (* case 2: lambdas *) + have ih: "\x y N L. x\y \ x\L \ M1[x::=N][y::=L] = M1[y::=L][x::=N[y::=L]]" by fact + have "x\y" by fact + have "x\L" by fact + have "z\x" "z\y" "z\N" "z\L" by fact + hence "z\N[y::=L]" by (simp add: fresh_fact) + show "(Lam [z].M1)[x::=N][y::=L] = (Lam [z].M1)[y::=L][x::=N[y::=L]]" (is "?LHS=?RHS") + proof - + have "?LHS = Lam [z].(M1[x::=N][y::=L])" using `z\x` `z\y` `z\N` `z\L` by simp + also from ih have "\ = Lam [z].(M1[y::=L][x::=N[y::=L]])" using `x\y` `x\L` by simp + also have "\ = (Lam [z].(M1[y::=L]))[x::=N[y::=L]]" using `z\x` `z\N[y::=L]` by simp + also have "\ = ?RHS" using `z\y` `z\L` by simp + finally show "?LHS = ?RHS" . qed next - case (App L N x y M1 M2) (* case 3: applications *) - show ?case - proof (intro strip) - assume a1: "x\y" - and a2: "x\L" - from a1 a2 App show "(App M1 M2)[x::=N][y::=L] = (App M1 M2)[y::=L][x::=N[y::=L]]" by simp - qed -qed - -lemma subs_lemma: - fixes x::"name" - and y::"name" - and L::"lam" - and M::"lam" - and N::"lam" - shows "x\y\x\L\M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" -proof (nominal_induct M rule: lam_induct) - case (Var L N x y z) (* case 1: Variables*) - show ?case - proof - - have "z=x \ (z\x \ z=y) \ (z\x \ z\y)" by force - thus "x\y\x\L\Var z[x::=N][y::=L] = Var z[y::=L][x::=N[y::=L]]" - using forget by force - qed -next - case (Lam L N x y z M1) (* case 2: lambdas *) - assume f1: "z\(L,N,x,y)" - hence f2: "z\N[y::=L]" by (simp add: fresh_fact fresh_prod) - show ?case - proof (intro strip) - assume a1: "x\y" - and a2: "x\L" - show "(Lam [z].M1)[x::=N][y::=L] = (Lam [z].M1)[y::=L][x::=N[y::=L]]" (is "?LHS=?RHS") - proof - - have "?LHS = Lam [z].(M1[x::=N][y::=L])" using f1 by (simp add: fresh_prod fresh_atm) - also have "\ = Lam [z].(M1[y::=L][x::=N[y::=L]])" using a1 a2 Lam(2) by simp - also have "\ = ?RHS" using f1 f2 by (simp add: fresh_prod fresh_atm) - finally show "?LHS = ?RHS" . - qed - qed -next - case (App L N x y M1 M2) (* case 3: applications *) - thus "x\y\x\L\(App M1 M2)[x::=N][y::=L] = (App M1 M2)[y::=L][x::=N[y::=L]]" by simp + case (App M1 M2) (* case 3: applications *) + thus ?case by simp qed lemma subs_lemma: @@ -180,10 +136,12 @@ and L::"lam" and M::"lam" and N::"lam" - shows "x\y\x\L\M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" -apply(nominal_induct M rule: lam_induct) -apply(auto simp add: fresh_fact forget fresh_prod fresh_atm) -done + assumes "x\y" + and "x\L" + shows "M[x::=N][y::=L] = M[y::=L][x::=N[y::=L]]" +using prems +by (nominal_induct M fresh: x y N L rule: lam_induct) + (auto simp add: fresh_fact forget) lemma subst_rename[rule_format]: fixes c :: "name" @@ -191,25 +149,25 @@ and t1 :: "lam" and t2 :: "lam" shows "c\t1 \ (t1[a::=t2] = ([(c,a)]\t1)[c::=t2])" -proof (nominal_induct t1 rule: lam_induct) - case (Var a c t2 b) +proof (nominal_induct t1 fresh: a c t2 rule: lam_induct) + case (Var b) show "c\(Var b) \ (Var b)[a::=t2] = ([(c,a)]\(Var b))[c::=t2]" by (simp add: calc_atm fresh_atm) next - case App thus ?case by (force simp add: fresh_prod) + case App thus ?case by force next - case (Lam a c t2 b s) - have i: "\a c t2. c\s \ (s[a::=t2] = ([(c,a)]\s)[c::=t2])" by fact - have f: "b\(a,c,t2)" by fact - from f have a:"b\c" and b: "b\a" and c: "b\t2" by (simp add: fresh_prod fresh_atm)+ + case (Lam b s) + have i: "\a c t2. c\s \ (s[a::=t2] = ([(c,a)]\s)[c::=t2])" by fact + have f: "b\a" "b\c" "b\t2" by fact + from f have a:"b\c" and b: "b\a" and c: "b\t2" by (simp add: fresh_atm)+ show "c\Lam [b].s \ (Lam [b].s)[a::=t2] = ([(c,a)]\(Lam [b].s))[c::=t2]" (is "_ \ ?LHS = ?RHS") proof assume "c\Lam [b].s" - hence "c\s" using a by (force simp add: abs_fresh) + hence "c\s" using a by (simp add: abs_fresh) hence d: "s[a::=t2] = ([(c,a)]\s)[c::=t2]" using i by simp have "?LHS = Lam [b].(s[a::=t2])" using b c by simp also have "\ = Lam [b].(([(c,a)]\s)[c::=t2])" using d by simp also have "\ = (Lam [b].([(c,a)]\s))[c::=t2]" using a c by simp - also have "\ = ?RHS" using a b by (force simp add: calc_atm) + also have "\ = ?RHS" using a b by (simp add: calc_atm) finally show "?LHS = ?RHS" by simp qed qed @@ -220,8 +178,8 @@ and t1 :: "lam" and t2 :: "lam" shows "c\t1 \ (t1[a::=t2] = ([(c,a)]\t1)[c::=t2])" -apply(nominal_induct t1 rule: lam_induct) -apply(auto simp add: calc_atm fresh_atm fresh_prod abs_fresh) +apply(nominal_induct t1 fresh: a c t2 rule: lam_induct) +apply(auto simp add: calc_atm fresh_atm abs_fresh) done section {* Beta Reduction *} @@ -245,89 +203,69 @@ fixes pi :: "name prm" and t :: "lam" and s :: "lam" - shows "t\\<^isub>\s \ (pi\t)\\<^isub>\(pi\s)" - apply(erule Beta.induct) - apply(auto) - done + assumes a: "t\\<^isub>\s" + shows "(pi\t)\\<^isub>\(pi\s)" + using a by (induct, auto) -lemma beta_induct_aux[rule_format]: - fixes P :: "lam \ lam \'a::fs_name\bool" - and t :: "lam" - and s :: "lam" - assumes a: "t\\<^isub>\s" - and a1: "\x t s1 s2. - s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (App s1 t) (App s2 t) x" - and a2: "\x t s1 s2. - s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (App t s1) (App t s2) x" - and a3: "\x (a::name) s1 s2. - a\x \ s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (Lam [a].s1) (Lam [a].s2) x" - and a4: "\x (a::name) t1 s1. a\(s1,x) \ P (App (Lam [a].t1) s1) (t1[a::=s1]) x" - shows "\x (pi::name prm). P (pi\t) (pi\s) x" -using a -proof (induct) - case b1 thus ?case using a1 by (simp, blast intro: eqvt_beta) -next - case b2 thus ?case using a2 by (simp, blast intro: eqvt_beta) -next - case (b3 a s1 s2) - assume j1: "s1 \\<^isub>\ s2" - assume j2: "\x (pi::name prm). P (pi\s1) (pi\s2) x" - show ?case - proof (simp, intro strip) - fix pi::"name prm" and x::"'a::fs_name" - have f: "\c::name. c\(pi\a,pi\s1,pi\s2,x)" - by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) - then obtain c::"name" - where f1: "c\(pi\a)" and f2: "c\x" and f3: "c\(pi\s1)" and f4: "c\(pi\s2)" - by (force simp add: fresh_prod fresh_atm) - have x: "P (Lam [c].(([(c,pi\a)]@pi)\s1)) (Lam [c].(([(c,pi\a)]@pi)\s2)) x" - using a3 f2 j1 j2 by (simp, blast intro: eqvt_beta) - have alpha1: "(Lam [c].([(c,pi\a)]\(pi\s1))) = (Lam [(pi\a)].(pi\s1))" using f1 f3 - by (simp add: lam.inject alpha) - have alpha2: "(Lam [c].([(c,pi\a)]\(pi\s2))) = (Lam [(pi\a)].(pi\s2))" using f1 f3 - by (simp add: lam.inject alpha) - show " P (Lam [(pi\a)].(pi\s1)) (Lam [(pi\a)].(pi\s2)) x" - using x alpha1 alpha2 by (simp only: pt_name2) - qed -next - case (b4 a s1 s2) - show ?case - proof (simp add: subst_eqvt, intro strip) - fix pi::"name prm" and x::"'a::fs_name" - have f: "\c::name. c\(pi\a,pi\s1,pi\s2,x)" - by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) - then obtain c::"name" - where f1: "c\(pi\a)" and f2: "c\(pi\s2,x)" and f3: "c\(pi\s1)" and f4: "c\(pi\s2)" - by (force simp add: fresh_prod fresh_atm) - have x: "P (App (Lam [c].(([(c,pi\a)]@pi)\s1)) (pi\s2)) ((([(c,pi\a)]@pi)\s1)[c::=(pi\s2)]) x" - using a4 f2 by (blast intro!: eqvt_beta) - have alpha1: "(Lam [c].([(c,pi\a)]\(pi\s1))) = (Lam [(pi\a)].(pi\s1))" using f1 f3 - by (simp add: lam.inject alpha) - have alpha2: "(([(c,pi\a)]@pi)\s1)[c::=(pi\s2)] = (pi\s1)[(pi\a)::=(pi\s2)]" - using f3 by (simp only: subst_rename[symmetric] pt_name2) - show "P (App (Lam [(pi\a)].(pi\s1)) (pi\s2)) ((pi\s1)[(pi\a)::=(pi\s2)]) x" - using x alpha1 alpha2 by (simp only: pt_name2) - qed -qed - - -lemma beta_induct[case_names b1 b2 b3 b4]: - fixes P :: "lam \ lam \'a::fs_name\bool" +lemma beta_induct[consumes 1, case_names b1 b2 b3 b4]: + fixes P :: "'a::fs_name\lam \ lam \bool" and t :: "lam" and s :: "lam" and x :: "'a::fs_name" assumes a: "t\\<^isub>\s" - and a1: "\x t s1 s2. - s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (App s1 t) (App s2 t) x" - and a2: "\x t s1 s2. - s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (App t s1) (App t s2) x" - and a3: "\x (a::name) s1 s2. - a\x \ s1\\<^isub>\s2 \ (\z. P s1 s2 z) \ P (Lam [a].s1) (Lam [a].s2) x" - and a4: "\x (a::name) t1 s1. - a\(s1,x) \ P (App (Lam [a].t1) s1) (t1[a::=s1]) x" - shows "P t s x" -using a a1 a2 a3 a4 -by (auto intro!: beta_induct_aux[of "t" "s" "P" "[]" "x", simplified]) + and a1: "\t s1 s2 x. s1\\<^isub>\s2 \ (\z. P z s1 s2) \ P x (App s1 t) (App s2 t)" + and a2: "\t s1 s2 x. s1\\<^isub>\s2 \ (\z. P z s1 s2) \ P x (App t s1) (App t s2)" + and a3: "\a s1 s2 x. a\x \ s1\\<^isub>\s2 \ (\z. P z s1 s2) \ P x (Lam [a].s1) (Lam [a].s2)" + and a4: "\a t1 s1 x. a\(s1,x) \ P x (App (Lam [a].t1) s1) (t1[a::=s1])" + shows "P x t s" +proof - + from a have "\(pi::name prm) x. P x (pi\t) (pi\s)" + proof (induct) + case b1 thus ?case using a1 by (simp, blast intro: eqvt_beta) + next + case b2 thus ?case using a2 by (simp, blast intro: eqvt_beta) + next + case (b3 a s1 s2) + have j1: "s1 \\<^isub>\ s2" by fact + have j2: "\x (pi::name prm). P x (pi\s1) (pi\s2)" by fact + show ?case + proof (simp) + have f: "\c::name. c\(pi\a,pi\s1,pi\s2,x)" + by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) + then obtain c::"name" + where f1: "c\(pi\a)" and f2: "c\x" and f3: "c\(pi\s1)" and f4: "c\(pi\s2)" + by (force simp add: fresh_prod fresh_atm) + have x: "P x (Lam [c].(([(c,pi\a)]@pi)\s1)) (Lam [c].(([(c,pi\a)]@pi)\s2))" + using a3 f2 j1 j2 by (simp, blast intro: eqvt_beta) + have alpha1: "(Lam [c].([(c,pi\a)]\(pi\s1))) = (Lam [(pi\a)].(pi\s1))" using f1 f3 + by (simp add: lam.inject alpha) + have alpha2: "(Lam [c].([(c,pi\a)]\(pi\s2))) = (Lam [(pi\a)].(pi\s2))" using f1 f3 + by (simp add: lam.inject alpha) + show " P x (Lam [(pi\a)].(pi\s1)) (Lam [(pi\a)].(pi\s2))" + using x alpha1 alpha2 by (simp only: pt_name2) + qed + next + case (b4 a s1 s2) + show ?case + proof (simp add: subst_eqvt) + have f: "\c::name. c\(pi\a,pi\s1,pi\s2,x)" + by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) + then obtain c::"name" + where f1: "c\(pi\a)" and f2: "c\(pi\s2,x)" and f3: "c\(pi\s1)" and f4: "c\(pi\s2)" + by (force simp add: fresh_prod fresh_atm) + have x: "P x (App (Lam [c].(([(c,pi\a)]@pi)\s1)) (pi\s2)) ((([(c,pi\a)]@pi)\s1)[c::=(pi\s2)])" + using a4 f2 by (blast intro!: eqvt_beta) + have alpha1: "(Lam [c].([(c,pi\a)]\(pi\s1))) = (Lam [(pi\a)].(pi\s1))" using f1 f3 + by (simp add: lam.inject alpha) + have alpha2: "(([(c,pi\a)]@pi)\s1)[c::=(pi\s2)] = (pi\s1)[(pi\a)::=(pi\s2)]" + using f3 by (simp only: subst_rename[symmetric] pt_name2) + show "P x (App (Lam [(pi\a)].(pi\s1)) (pi\s2)) ((pi\s1)[(pi\a)::=(pi\s2)])" + using x alpha1 alpha2 by (simp only: pt_name2) + qed + qed + hence "P x (([]::name prm)\t) (([]::name prm)\s)" by blast + thus ?thesis by simp +qed section {* One-Reduction *} @@ -350,109 +288,93 @@ fixes pi :: "name prm" and t :: "lam" and s :: "lam" - shows "t\\<^isub>1s \ (pi\t)\\<^isub>1(pi\s)" - apply(erule One.induct) - apply(auto) - done + assumes a: "t\\<^isub>1s" + shows "(pi\t)\\<^isub>1(pi\s)" + using a by (induct, auto) -lemma one_induct_aux[rule_format]: - fixes P :: "lam \ lam \'a::fs_name\bool" - and t :: "lam" - and s :: "lam" - assumes a: "t\\<^isub>1s" - and a1: "\x t. P t t x" - and a2: "\x t1 t2 s1 s2. - (t1\\<^isub>1t2 \ (\z. P t1 t2 z) \ s1\\<^isub>1s2 \ (\z. P s1 s2 z)) - \ P (App t1 s1) (App t2 s2) x" - and a3: "\x (a::name) s1 s2. (a\x \ s1\\<^isub>1s2 \ (\z. P s1 s2 z)) - \ P (Lam [a].s1) (Lam [a].s2) x" - and a4: "\x (a::name) t1 t2 s1 s2. - (a\(s1,s2,x) \ t1\\<^isub>1t2 \ (\z. P t1 t2 z) \ s1\\<^isub>1s2 \ (\z. P s1 s2 z)) - \ P (App (Lam [a].t1) s1) (t2[a::=s2]) x" - shows "\x (pi::name prm). P (pi\t) (pi\s) x" -using a -proof (induct) - case o1 show ?case using a1 by force -next - case (o2 s1 s2 t1 t2) - thus ?case using a2 by (simp, blast intro: eqvt_one) -next - case (o3 a t1 t2) - assume j1: "t1 \\<^isub>1 t2" - assume j2: "\x (pi::name prm). P (pi\t1) (pi\t2) x" - show ?case - proof (simp, intro strip) - fix pi::"name prm" and x::"'a::fs_name" - have f: "\c::name. c\(pi\a,pi\t1,pi\t2,x)" - by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) - then obtain c::"name" - where f1: "c\(pi\a)" and f2: "c\x" and f3: "c\(pi\t1)" and f4: "c\(pi\t2)" - by (force simp add: fresh_prod fresh_atm) - have x: "P (Lam [c].(([(c,pi\a)]@pi)\t1)) (Lam [c].(([(c,pi\a)]@pi)\t2)) x" - using a3 f2 j1 j2 by (simp, blast intro: eqvt_one) - have alpha1: "(Lam [c].([(c,pi\a)]\(pi\t1))) = (Lam [(pi\a)].(pi\t1))" using f1 f3 - by (simp add: lam.inject alpha) - have alpha2: "(Lam [c].([(c,pi\a)]\(pi\t2))) = (Lam [(pi\a)].(pi\t2))" using f1 f3 - by (simp add: lam.inject alpha) - show " P (Lam [(pi\a)].(pi\t1)) (Lam [(pi\a)].(pi\t2)) x" - using x alpha1 alpha2 by (simp only: pt_name2) - qed -next -case (o4 a s1 s2 t1 t2) - assume j0: "t1 \\<^isub>1 t2" - assume j1: "s1 \\<^isub>1 s2" - assume j2: "\x (pi::name prm). P (pi\t1) (pi\t2) x" - assume j3: "\x (pi::name prm). P (pi\s1) (pi\s2) x" - show ?case - proof (simp, intro strip) - fix pi::"name prm" and x::"'a::fs_name" - have f: "\c::name. c\(pi\a,pi\t1,pi\t2,pi\s1,pi\s2,x)" - by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) - then obtain c::"name" - where f1: "c\(pi\a)" and f2: "c\(pi\s1,pi\s2,x)" and f3: "c\(pi\t1)" and f4: "c\(pi\t2)" - by (force simp add: fresh_prod at_fresh[OF at_name_inst]) - have x: "P (App (Lam [c].(([(c,pi\a)]@pi)\t1)) (pi\s1)) ((([(c,pi\a)]@pi)\t2)[c::=(pi\s2)]) x" - using a4 f2 j0 j1 j2 j3 by (simp, blast intro!: eqvt_one) - have alpha1: "(Lam [c].([(c,pi\a)]\(pi\t1))) = (Lam [(pi\a)].(pi\t1))" using f1 f3 - by (simp add: lam.inject alpha) - have alpha2: "(([(c,pi\a)]@pi)\t2)[c::=(pi\s2)] = (pi\t2)[(pi\a)::=(pi\s2)]" - using f4 by (simp only: subst_rename[symmetric] pt_name2) - show "P (App (Lam [(pi\a)].(pi\t1)) (pi\s1)) ((pi\t2)[(pi\a)::=(pi\s2)]) x" - using x alpha1 alpha2 by (simp only: pt_name2) - qed -qed - -lemma one_induct[rule_format, case_names o1 o2 o3 o4]: - fixes P :: "lam \ lam \'a::fs_name\bool" +lemma one_induct[consumes 1, case_names o1 o2 o3 o4]: + fixes P :: "'a::fs_name\lam \ lam \bool" and t :: "lam" and s :: "lam" and x :: "'a::fs_name" assumes a: "t\\<^isub>1s" - and a1: "\x t. P t t x" - and a2: "\x t1 t2 s1 s2. - t1\\<^isub>1t2 \ (\z. P t1 t2 z) \ s1\\<^isub>1s2 \ (\z. P s1 s2 z) \ - P (App t1 s1) (App t2 s2) x" - and a3: "\x (a::name) s1 s2. a\x \ s1\\<^isub>1s2 \ (\z. P s1 s2 z) - \ P (Lam [a].s1) (Lam [a].s2) x" - and a4: "\x (a::name) t1 t2 s1 s2. - a\(s1,s2,x) \ t1\\<^isub>1t2 \ (\z. P t1 t2 z) \ s1\\<^isub>1s2 \ (\z. P s1 s2 z) - \ P (App (Lam [a].t1) s1) (t2[a::=s2]) x" - shows "P t s x" -using a a1 a2 a3 a4 -by (auto intro!: one_induct_aux[of "t" "s" "P" "[]" "x", simplified]) + and a1: "\t x. P x t t" + and a2: "\t1 t2 s1 s2 x. t1\\<^isub>1t2 \ (\z. P z t1 t2) \ s1\\<^isub>1s2 \ (\z. P z s1 s2) \ + P x (App t1 s1) (App t2 s2)" + and a3: "\a s1 s2 x. a\x \ s1\\<^isub>1s2 \ (\z. P z s1 s2) \ P x (Lam [a].s1) (Lam [a].s2)" + and a4: "\a t1 t2 s1 s2 x. + a\(s1,s2,x) \ t1\\<^isub>1t2 \ (\z. P z t1 t2) \ s1\\<^isub>1s2 \ (\z. P z s1 s2) + \ P x (App (Lam [a].t1) s1) (t2[a::=s2])" + shows "P x t s" +proof - + from a have "\(pi::name prm) x. P x (pi\t) (pi\s)" + proof (induct) + case o1 show ?case using a1 by force + next + case (o2 s1 s2 t1 t2) + thus ?case using a2 by (simp, blast intro: eqvt_one) + next + case (o3 a t1 t2) + have j1: "t1 \\<^isub>1 t2" by fact + have j2: "\(pi::name prm) x. P x (pi\t1) (pi\t2)" by fact + show ?case + proof (simp) + have f: "\c::name. c\(pi\a,pi\t1,pi\t2,x)" + by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) + then obtain c::"name" + where f1: "c\(pi\a)" and f2: "c\x" and f3: "c\(pi\t1)" and f4: "c\(pi\t2)" + by (force simp add: fresh_prod fresh_atm) + have x: "P x (Lam [c].(([(c,pi\a)]@pi)\t1)) (Lam [c].(([(c,pi\a)]@pi)\t2))" + using a3 f2 j1 j2 by (simp, blast intro: eqvt_one) + have alpha1: "(Lam [c].([(c,pi\a)]\(pi\t1))) = (Lam [(pi\a)].(pi\t1))" using f1 f3 + by (simp add: lam.inject alpha) + have alpha2: "(Lam [c].([(c,pi\a)]\(pi\t2))) = (Lam [(pi\a)].(pi\t2))" using f1 f3 + by (simp add: lam.inject alpha) + show " P x (Lam [(pi\a)].(pi\t1)) (Lam [(pi\a)].(pi\t2))" + using x alpha1 alpha2 by (simp only: pt_name2) + qed + next + case (o4 a s1 s2 t1 t2) + have j0: "t1 \\<^isub>1 t2" by fact + have j1: "s1 \\<^isub>1 s2" by fact + have j2: "\(pi::name prm) x. P x (pi\t1) (pi\t2)" by fact + have j3: "\(pi::name prm) x. P x (pi\s1) (pi\s2)" by fact + show ?case + proof (simp) + have f: "\c::name. c\(pi\a,pi\t1,pi\t2,pi\s1,pi\s2,x)" + by (rule at_exists_fresh[OF at_name_inst], simp add: fs_name1) + then obtain c::"name" + where f1: "c\(pi\a)" and f2: "c\(pi\s1,pi\s2,x)" and f3: "c\(pi\t1)" and f4: "c\(pi\t2)" + by (force simp add: fresh_prod at_fresh[OF at_name_inst]) + have x: "P x (App (Lam [c].(([(c,pi\a)]@pi)\t1)) (pi\s1)) ((([(c,pi\a)]@pi)\t2)[c::=(pi\s2)])" + using a4 f2 j0 j1 j2 j3 by (simp, blast intro!: eqvt_one) + have alpha1: "(Lam [c].([(c,pi\a)]\(pi\t1))) = (Lam [(pi\a)].(pi\t1))" using f1 f3 + by (simp add: lam.inject alpha) + have alpha2: "(([(c,pi\a)]@pi)\t2)[c::=(pi\s2)] = (pi\t2)[(pi\a)::=(pi\s2)]" + using f4 by (simp only: subst_rename[symmetric] pt_name2) + show "P x (App (Lam [(pi\a)].(pi\t1)) (pi\s1)) ((pi\t2)[(pi\a)::=(pi\s2)])" + using x alpha1 alpha2 by (simp only: pt_name2) + qed + qed + hence "P x (([]::name prm)\t) (([]::name prm)\s)" by blast + thus ?thesis by simp +qed -lemma fresh_fact'[rule_format]: - shows "a\t2 \ a\(t1[a::=t2])" -proof (nominal_induct t1 rule: lam_induct) - case (Var a t2 b) - show ?case by (cases "b=a") (force simp add: at_fresh[OF at_name_inst])+ +lemma fresh_fact': + assumes a: "a\t2" + shows "a\(t1[a::=t2])" +using a +proof (nominal_induct t1 fresh: a t2 rule: lam_induct) + case (Var b) + thus ?case by (simp add: fresh_atm) next - case App - thus ?case by (simp add: fresh_prod) + case App thus ?case by simp next - case (Lam a t2 c t) - from Lam(1) have "c\a \ c\t2" by (simp add: fresh_prod fresh_atm) - thus ?case using Lam(2) by (force simp add: abs_fresh) + case (Lam c t) + have "a\t2" "c\a" "c\t2" by fact + moreover + have ih: "\a t2. a\t2 \ a\(t[a::=t2])" by fact + ultimately show ?case by (simp add: abs_fresh) qed lemma one_fresh_preserv[rule_format]: @@ -561,33 +483,36 @@ apply(force intro: eqvt_one) done -(* first case in Lemma 3.2.4*) +text {* first case in Lemma 3.2.4*} -lemma one_subst_aux[rule_format]: +lemma one_subst_aux: fixes M :: "lam" and N :: "lam" and N':: "lam" and x :: "name" - shows "N\\<^isub>1N'\M[x::=N] \\<^isub>1 M[x::=N']" -proof (nominal_induct M rule: lam_induct) - case (Var N N' x y) - show "N\\<^isub>1N' \ Var y[x::=N] \\<^isub>1 Var y[x::=N']" by (cases "x=y", auto) + assumes a: "N\\<^isub>1N'" + shows "M[x::=N] \\<^isub>1 M[x::=N']" +using a +proof (nominal_induct M fresh: x N N' rule: lam_induct) + case (Var y) + show "Var y[x::=N] \\<^isub>1 Var y[x::=N']" by (cases "x=y", auto) next - case (App N N' x P Q) (* application case - third line *) - thus "N\\<^isub>1N' \ (App P Q)[x::=N] \\<^isub>1 (App P Q)[x::=N']" using o2 by simp + case (App P Q) (* application case - third line *) + thus "(App P Q)[x::=N] \\<^isub>1 (App P Q)[x::=N']" using o2 by simp next - case (Lam N N' x y P) (* abstraction case - fourth line *) - thus "N\\<^isub>1N' \ (Lam [y].P)[x::=N] \\<^isub>1 (Lam [y].P)[x::=N']" using o3 - by (simp add: fresh_prod fresh_atm) + case (Lam y P) (* abstraction case - fourth line *) + thus "(Lam [y].P)[x::=N] \\<^isub>1 (Lam [y].P)[x::=N']" using o3 by simp qed -lemma one_subst_aux[rule_format]: +lemma one_subst_aux: fixes M :: "lam" and N :: "lam" and N':: "lam" and x :: "name" - shows "N\\<^isub>1N'\M[x::=N] \\<^isub>1 M[x::=N']" -apply(nominal_induct M rule: lam_induct) + assumes a: "N\\<^isub>1N'" + shows "M[x::=N] \\<^isub>1 M[x::=N']" +using a +apply(nominal_induct M fresh: x N N' rule: lam_induct) apply(auto simp add: fresh_prod fresh_atm) done @@ -597,40 +522,40 @@ and N :: "lam" and N':: "lam" and x :: "name" - assumes a: "M\\<^isub>1M'" - shows "N\\<^isub>1N' \ M[x::=N]\\<^isub>1M'[x::=N']" -using a -proof (nominal_induct M M' rule: one_induct) - case (o1 x N N' M) - show ?case by (simp add: one_subst_aux) + assumes a: "M\\<^isub>1M'" + and b: "N\\<^isub>1N'" + shows "M[x::=N]\\<^isub>1M'[x::=N']" +using prems +proof (nominal_induct M M' fresh: N N' x rule: one_induct) + case (o1 M) + thus ?case by (simp add: one_subst_aux) next - case (o2 x N N' M1 M2 N1 N2) + case (o2 M1 M2 N1 N2) thus ?case by simp next - case (o3 x N N' a M1 M2) - thus ?case by (simp add: fresh_prod fresh_atm) + case (o3 a M1 M2) + thus ?case by simp next - case (o4 N N' x a M1 M2 N1 N2) - assume e3: "a\(N1,N2,N,N',x)" + case (o4 a M1 M2 N1 N2) + have e3: "a\N1" "a\N2" "a\N" "a\N'" "a\x" by fact show ?case - proof - assume a1: "N\\<^isub>1N'" - have "(App (Lam [a].M1) N1)[x::=N] = App (Lam [a].(M1[x::=N])) (N1[x::=N])" - using e3 by (simp add: fresh_prod fresh_atm) + proof - + have "(App (Lam [a].M1) N1)[x::=N] = App (Lam [a].(M1[x::=N])) (N1[x::=N])" using e3 by simp also have "App (Lam [a].(M1[x::=N])) (N1[x::=N]) \\<^isub>1 M2[x::=N'][a::=N2[x::=N']]" - using o4 a1 by force + using o4 b by force also have "M2[x::=N'][a::=N2[x::=N']] = M2[a::=N2][x::=N']" - using e3 by (simp add: subs_lemma fresh_prod fresh_atm) + using e3 by (simp add: subs_lemma fresh_atm) ultimately show "(App (Lam [a].M1) N1)[x::=N] \\<^isub>1 M2[a::=N2][x::=N']" by simp qed qed lemma one_subst[rule_format]: assumes a: "M\\<^isub>1M'" - shows "N\\<^isub>1N' \ M[x::=N]\\<^isub>1M'[x::=N']" -using a -apply(nominal_induct M M' rule: one_induct) -apply(auto simp add: one_subst_aux subs_lemma fresh_prod fresh_atm) + and b: "N\\<^isub>1N'" + shows "M[x::=N]\\<^isub>1M'[x::=N']" +using a b +apply(nominal_induct M M' fresh: N N' x rule: one_induct) +apply(auto simp add: one_subst_aux subs_lemma fresh_atm) done lemma diamond[rule_format]: