diff -r 014e7696ac6b -r 49e2d9744ae1 src/HOL/Nominal/Examples/Weakening.thy --- a/src/HOL/Nominal/Examples/Weakening.thy Tue Mar 06 08:09:43 2007 +0100 +++ b/src/HOL/Nominal/Examples/Weakening.thy Tue Mar 06 15:28:22 2007 +0100 @@ -1,7 +1,7 @@ (* $Id$ *) theory Weakening -imports "Nominal" +imports "../Nominal" begin section {* Weakening Example for the Simply-Typed Lambda-Calculus *} @@ -20,9 +20,9 @@ lemma ty_perm[simp]: fixes pi ::"name prm" - and \ ::"ty" - shows "pi\\ = \" -by (induct \ rule: ty.induct_weak) + and T ::"ty" + shows "pi\T = T" +by (induct T rule: ty.induct_weak) (simp_all add: perm_nat_def) text {* valid contexts *} @@ -37,35 +37,32 @@ assumes a: "valid \" shows "valid (pi\\)" using a -by (induct) - (auto simp add: fresh_bij) - -thm eqvt +by (induct) (auto simp add: fresh_bij) text{* typing judgements *} inductive2 typing :: "(name\ty) list\lam\ty\bool" (" _ \ _ : _ " [80,80,80] 80) where - t_Var[intro]: "\valid \; (a,\)\set \\\ \ \ Var a : \" - | t_App[intro]: "\\ \ t1 : \\\; \ \ t2 : \\\ \ \ App t1 t2 : \" - | t_Lam[intro]: "\a\\;((a,\)#\) \ t : \\ \ \ \ Lam [a].t : \\\" + t_Var[intro]: "\valid \; (a,T)\set \\\ \ \ Var a : T" + | t_App[intro]: "\\ \ t1 : T1\T2; \ \ t2 : T1\\ \ \ App t1 t2 : T2" + | t_Lam[intro]: "\a\\;((a,T1)#\) \ t : T2\ \ \ \ Lam [a].t : T1\T2" lemma eqvt_typing[eqvt]: fixes pi:: "name prm" - assumes a: "\ \ t : \" - shows "(pi\\) \ (pi\t) : (pi\\)" + assumes a: "\ \ t : T" + shows "(pi\\) \ (pi\t) : (pi\T)" using a proof (induct) - case (t_Var \ a \) + case (t_Var \ a T) have "valid (pi\\)" by (rule eqvt_valid) moreover - have "(pi\(a,\))\(pi\set \)" by (rule pt_set_bij2[OF pt_name_inst, OF at_name_inst]) - ultimately show "(pi\\) \ (pi\Var a) : (pi\\)" - using typing.intros by (force simp add: pt_list_set_pi[OF pt_name_inst, symmetric]) + have "(pi\(a,T))\(pi\set \)" by (rule pt_set_bij2[OF pt_name_inst, OF at_name_inst]) + ultimately show "(pi\\) \ (pi\Var a) : (pi\T)" + using typing.intros by (force simp add: set_eqvt) next - case (t_Lam a \ \ t \) + case (t_Lam a \ T1 t T2) moreover have "(pi\a)\(pi\\)" by (simp add: fresh_bij) - ultimately show "(pi\\) \ (pi\Lam [a].t) :(pi\\\\)" by force + ultimately show "(pi\\) \ (pi\Lam [a].t) :(pi\T1\T2)" by force qed (auto) text {* the strong induction principle needs to be derived manually *} @@ -74,51 +71,51 @@ fixes P :: "'a::fs_name\(name\ty) list \ lam \ ty \bool" and \ :: "(name\ty) list" and t :: "lam" - and \ :: "ty" + and T :: "ty" and x :: "'a::fs_name" - assumes a: "\ \ t : \" - and a1: "\\ a \ x. \valid \; (a,\) \ set \\ \ P x \ (Var a) \" - and a2: "\\ \ \ t1 t2 x. \\z. P z \ t1 (\\\); \z. P z \ t2 \\ - \ P x \ (App t1 t2) \" - and a3: "\a \ \ \ t x. \a\x; a\\; \z. P z ((a,\)#\) t \\ - \ P x \ (Lam [a].t) (\\\)" - shows "P x \ t \" + assumes a: "\ \ t : T" + and a1: "\\ a T x. \valid \; (a,T) \ set \\ \ P x \ (Var a) T" + and a2: "\\ T1 T2 t1 t2 x. \\z. P z \ t1 (T1\T2); \z. P z \ t2 T1\ + \ P x \ (App t1 t2) T2" + and a3: "\a \ T1 T2 t x. \a\x; a\\; \z. P z ((a,T1)#\) t T2\ + \ P x \ (Lam [a].t) (T1\T2)" + shows "P x \ t T" proof - - from a have "\(pi::name prm) x. P x (pi\\) (pi\t) (pi\\)" + from a have "\(pi::name prm) x. P x (pi\\) (pi\t) (pi\T)" proof (induct) - case (t_Var \ a \) + case (t_Var \ a T) have "valid \" by fact then have "valid (pi\\)" by (rule eqvt) moreover - have "(a,\)\set \" by fact - then have "pi\(a,\)\pi\(set \)" by (simp only: pt_set_bij[OF pt_name_inst, OF at_name_inst]) - then have "(pi\a,\)\set (pi\\)" by (simp add: pt_list_set_pi[OF pt_name_inst]) - ultimately show "P x (pi\\) (pi\(Var a)) (pi\\)" using a1 by simp + have "(a,T)\set \" by fact + then have "pi\(a,T)\pi\(set \)" by (simp only: pt_set_bij[OF pt_name_inst, OF at_name_inst]) + then have "(pi\a,T)\set (pi\\)" by (simp add: set_eqvt) + ultimately show "P x (pi\\) (pi\(Var a)) (pi\T)" using a1 by simp next - case (t_App \ t1 \ \ t2) - thus "P x (pi\\) (pi\(App t1 t2)) (pi\\)" using a2 + case (t_App \ t1 T1 T2 t2) + thus "P x (pi\\) (pi\(App t1 t2)) (pi\T2)" using a2 by (simp only: eqvt) (blast) next - case (t_Lam a \ \ t \) + case (t_Lam a \ T1 t T2) obtain c::"name" where fs: "c\(pi\a,pi\t,pi\\,x)" by (rule exists_fresh[OF fs_name1]) let ?sw="[(pi\a,c)]" let ?pi'="?sw@pi" have f1: "a\\" by fact have f2: "(pi\a)\(pi\\)" using f1 by (simp add: fresh_bij) have f3: "c\?pi'\\" using f1 by (auto simp add: pt_name2 fresh_left calc_atm perm_pi_simp) - have ih1: "\x. P x (?pi'\((a,\)#\)) (?pi'\t) (?pi'\\)" by fact - then have "\x. P x ((c,\)#(?pi'\\)) (?pi'\t) (?pi'\\)" by (simp add: calc_atm) - then have "P x (?pi'\\) (Lam [c].(?pi'\t)) (\\\)" using a3 f3 fs by simp - then have "P x (?sw\pi\\) (?sw\(Lam [(pi\a)].(pi\t))) (\\\)" + have ih1: "\x. P x (?pi'\((a,T1)#\)) (?pi'\t) (?pi'\T2)" by fact + then have "\x. P x ((c,T1)#(?pi'\\)) (?pi'\t) (?pi'\T2)" by (simp add: calc_atm) + then have "P x (?pi'\\) (Lam [c].(?pi'\t)) (T1\T2)" using a3 f3 fs by simp + then have "P x (?sw\pi\\) (?sw\(Lam [(pi\a)].(pi\t))) (T1\T2)" by (simp del: append_Cons add: calc_atm pt_name2) moreover have "(?sw\(pi\\)) = (pi\\)" by (rule perm_fresh_fresh) (simp_all add: fs f2) moreover have "(?sw\(Lam [(pi\a)].(pi\t))) = Lam [(pi\a)].(pi\t)" by (rule perm_fresh_fresh) (simp_all add: fs f2 abs_fresh) - ultimately show "P x (pi\\) (pi\(Lam [a].t)) (pi\\\\)" by (simp) + ultimately show "P x (pi\\) (pi\(Lam [a].t)) (pi\T1\T2)" by (simp) qed - hence "P x (([]::name prm)\\) (([]::name prm)\t) (([]::name prm)\\)" by blast - thus "P x \ t \" by simp + hence "P x (([]::name prm)\\) (([]::name prm)\t) (([]::name prm)\T)" by blast + thus "P x \ t T" by simp qed text {* definition of a subcontext *} @@ -130,92 +127,91 @@ text {* now it comes: The Weakening Lemma *} lemma weakening_version1: - assumes a: "\1 \ t : \" + assumes a: "\1 \ t : T" and b: "valid \2" and c: "\1 \ \2" - shows "\2 \ t:\" + shows "\2 \ t : T" using a b c -apply(nominal_induct \1 t \ avoiding: \2 rule: typing_induct) -apply(auto | atomize)+ +by (nominal_induct \1 t T avoiding: \2 rule: typing_induct) + (auto | atomize)+ (* FIXME: meta-quantifiers seem to be not as "automatic" as object-quantifiers *) -done lemma weakening_version2: fixes \1::"(name\ty) list" and t ::"lam" and \ ::"ty" - assumes a: "\1 \ t:\" + assumes a: "\1 \ t:T" and b: "valid \2" and c: "\1 \ \2" - shows "\2 \ t:\" + shows "\2 \ t:T" using a b c -proof (nominal_induct \1 t \ avoiding: \2 rule: typing_induct) - case (t_Var \1 a \) (* variable case *) +proof (nominal_induct \1 t T avoiding: \2 rule: typing_induct) + case (t_Var \1 a T) (* variable case *) have "\1 \ \2" by fact moreover have "valid \2" by fact moreover - have "(a,\)\ set \1" by fact - ultimately show "\2 \ Var a : \" by auto + have "(a,T)\ set \1" by fact + ultimately show "\2 \ Var a : T" by auto next - case (t_Lam a \1 \ \ t) (* lambda case *) + case (t_Lam a \1 T1 T2 t) (* lambda case *) have vc: "a\\2" by fact (* variable convention *) - have ih: "\\3. \valid \3; ((a,\)#\1) \ \3\ \ \3 \ t:\" by fact + have ih: "\\3. \valid \3; ((a,T1)#\1) \ \3\ \ \3 \ t:T2" by fact have "\1 \ \2" by fact - then have "((a,\)#\1) \ ((a,\)#\2)" by simp + then have "((a,T1)#\1) \ ((a,T1)#\2)" by simp moreover have "valid \2" by fact - then have "valid ((a,\)#\2)" using vc by (simp add: v2) - ultimately have "((a,\)#\2) \ t:\" using ih by simp - with vc show "\2 \ (Lam [a].t) : \ \ \" by auto + then have "valid ((a,T1)#\2)" using vc by (simp add: v2) + ultimately have "((a,T1)#\2) \ t:T2" using ih by simp + with vc show "\2 \ (Lam [a].t) : T1\T2" by auto qed (auto) (* app case *) lemma weakening_version3: - assumes a: "\1 \ t:\" + assumes a: "\1 \ t : T" and b: "valid \2" and c: "\1 \ \2" - shows "\2 \ t:\" + shows "\2 \ t : T" using a b c -proof (nominal_induct \1 t \ avoiding: \2 rule: typing_induct) - case (t_Lam a \1 \ \ t) (* lambda case *) +proof (nominal_induct \1 t T avoiding: \2 rule: typing_induct) + case (t_Lam a \1 T1 T2 t) (* lambda case *) have vc: "a\\2" by fact (* variable convention *) - have ih: "\\3. \valid \3; ((a,\)#\1) \ \3\ \ \3 \ t:\" by fact + have ih: "\\3. \valid \3; ((a,T1)#\1) \ \3\ \ \3 \ t : T2" by fact have "\1 \ \2" by fact - then have "((a,\)#\1) \ ((a,\)#\2)" by simp + then have "((a,T1)#\1) \ ((a,T1)#\2)" by simp moreover have "valid \2" by fact - then have "valid ((a,\)#\2)" using vc by (simp add: v2) - ultimately have "((a,\)#\2) \ t:\" using ih by simp - with vc show "\2 \ (Lam [a].t) : \ \ \" by auto + then have "valid ((a,T1)#\2)" using vc by (simp add: v2) + ultimately have "((a,T1)#\2) \ t : T2" using ih by simp + with vc show "\2 \ (Lam [a].t) : T1 \ T2" by auto qed (auto) (* app and var case *) text{* The original induction principle for the typing relation is not strong enough - even this simple lemma fails: *} lemma weakening_too_weak: - assumes a: "\1 \ t:\" + assumes a: "\1 \ t : T" and b: "valid \2" and c: "\1 \ \2" - shows "\2 \ t:\" + shows "\2 \ t : T" using a b c proof (induct arbitrary: \2) - case (t_Var \1 a \) (* variable case *) + case (t_Var \1 a T) (* variable case *) have "\1 \ \2" by fact moreover have "valid \2" by fact moreover - have "(a,\) \ (set \1)" by fact - ultimately show "\2 \ Var a : \" by auto + have "(a,T) \ (set \1)" by fact + ultimately show "\2 \ Var a : T" by auto next - case (t_Lam a \1 \ t \) (* lambda case *) + case (t_Lam a \1 T1 t T2) (* lambda case *) (* all assumptions available in this case*) have a0: "a\\1" by fact - have a1: "((a,\)#\1) \ t : \" by fact + have a1: "((a,T1)#\1) \ t : T2" by fact have a2: "\1 \ \2" by fact have a3: "valid \2" by fact - have ih: "\\3. \valid \3; ((a,\)#\1) \ \3\ \ \3 \ t:\" by fact - have "((a,\)#\1) \ ((a,\)#\2)" using a2 by simp + have ih: "\\3. \valid \3; ((a,T1)#\1) \ \3\ \ \3 \ t : T2" by fact + have "((a,T1)#\1) \ ((a,T1)#\2)" using a2 by simp moreover - have "valid ((a,\)#\2)" using v2 (* fails *) + have "valid ((a,T1)#\2)" using v2 (* fails *) oops end \ No newline at end of file