# HG changeset patch # User urbanc # Date 1133408777 -3600 # Node ID b83b00cbaecf366f6be9cc542a0577130c10afed # Parent b00c9120f6bdebff63c4d5bebed74c8cb2e1a421 changed "fresh:" to "avoiding:" and cleaned up the weakening example diff -r b00c9120f6bd -r b83b00cbaecf src/HOL/Nominal/Examples/Weakening.thy --- a/src/HOL/Nominal/Examples/Weakening.thy Wed Nov 30 22:52:50 2005 +0100 +++ b/src/HOL/Nominal/Examples/Weakening.thy Thu Dec 01 04:46:17 2005 +0100 @@ -94,85 +94,6 @@ ultimately show "(pi\\) \ (pi\Lam [a].t) :\\\" by force qed (auto) - -lemma typing_induct_weak[THEN spec, case_names t1 t2 t3]: - fixes P :: "'a\(name\ty) list \ lam \ ty \bool" - and \ :: "(name\ty) list" - and t :: "lam" - and \ :: "ty" - assumes a: "\ \ t : \" - and a1: "\\ (a::name) \ x. valid \ \ (a,\) \ set \ \ P x \ (Var a) \" - and a2: "\\ \ \ t1 t2 x. - \ \ t1 : \\\ \ (\z. P z \ t1 (\\\)) \ \ \ t2 : \ \ (\z. P z \ t2 \) - \ P x \ (App t1 t2) \" - and a3: "\(a::name) \ \ \ t x. - a\\ \ ((a,\) # \) \ t : \ \ (\z. P z ((a,\)#\) t \) - \ P x \ (Lam [a].t) (\\\)" - shows "\x. P x \ t \" -using a by (induct, simp_all add: a1 a2 a3) - -lemma typing_induct_aux[rule_format]: - fixes P :: "'a::fs_name \ (name\ty) list \ lam \ ty \bool" - and \ :: "(name\ty) list" - and t :: "lam" - and \ :: "ty" - assumes a: "\ \ t : \" - and a1: "\\ (a::name) \ x. valid \ \ (a,\) \ set \ \ P x \ (Var a) \" - and a2: "\\ \ \ t1 t2 x. - \ \ t1 : \\\ \ (\z. P z \ t1 (\\\)) \ \ \ t2 : \ \ (\z. P z \ t2 \) - \ P x \ (App t1 t2) \" - and a3: "\(a::name) \ \ \ t x. - a\x \ a\\ \ ((a,\) # \) \ t : \ \ (\z. P z ((a,\)#\) t \) - \ P x \ (Lam [a].t) (\\\)" - shows "\(pi::name prm) (x::'a::fs_name). P x (pi\\) (pi\t) \" -using a -proof (induct) - case (t1 \ \ a) - have j1: "valid \" by fact - have j2: "(a,\)\set \" by fact - show ?case - proof (intro strip, simp) - fix pi::"name prm" and x::"'a::fs_name" - from j1 have j3: "valid (pi\\)" by (rule eqvt_valid) - from j2 have "pi\(a,\)\pi\(set \)" by (simp only: pt_set_bij[OF pt_name_inst, OF at_name_inst]) - hence j4: "(pi\a,\)\set (pi\\)" by (simp add: pt_list_set_pi[OF pt_name_inst]) - show "P x (pi\\) (Var (pi\a)) \" using a1 j3 j4 by force - qed -next - case (t2 \ \ \ t1 t2) - thus ?case using a2 by (simp, blast intro: eqvt_typing) -next - case (t3 \ \ \ a t) - have k1: "a\\" by fact - have k2: "((a,\)#\)\t:\" by fact - have k3: "\(pi::name prm) (x::'a::fs_name). P x (pi \((a,\)#\)) (pi\t) \" by fact - show ?case - proof (intro strip, simp) - fix pi::"name prm" and x::"'a::fs_name" - have f: "\c::name. c\(pi\a,pi\t,pi\\,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\t)" and f4: "c\(pi\\)" - by (force simp add: fresh_prod at_fresh[OF at_name_inst]) - from k1 have k1a: "(pi\a)\(pi\\)" - by (simp add: pt_fresh_left[OF pt_name_inst, OF at_name_inst] - pt_rev_pi[OF pt_name_inst, OF at_name_inst]) - have l1: "(([(c,pi\a)]@pi)\\) = (pi\\)" using f4 k1a - by (simp only: pt2[OF pt_name_inst], rule pt_fresh_fresh[OF pt_name_inst, OF at_name_inst]) - have "\x. P x (([(c,pi\a)]@pi)\((a,\)#\)) (([(c,pi\a)]@pi)\t) \" using k3 by force - hence l2: "\x. P x ((c, \)#(pi\\)) (([(c,pi\a)]@pi)\t) \" using f1 l1 - by (force simp add: pt2[OF pt_name_inst] at_calc[OF at_name_inst] split: if_splits) - have "(([(c,pi\a)]@pi)\((a,\)#\)) \ (([(c,pi\a)]@pi)\t) : \" using k2 by (rule eqvt_typing) - hence l3: "((c, \)#(pi\\)) \ (([(c,pi\a)]@pi)\t) : \" using l1 f1 - by (force simp add: pt2[OF pt_name_inst] at_calc[OF at_name_inst] split: if_splits) - have l4: "P x (pi\\) (Lam [c].(([(c,pi\a)]@pi)\t)) (\ \ \)" using f2 f4 l2 l3 a3 by auto - have alpha: "(Lam [c].([(c,pi\a)]\(pi\t))) = (Lam [(pi\a)].(pi\t))" using f1 f3 - by (simp add: lam.inject alpha) - show "P x (pi\\) (Lam [(pi\a)].(pi\t)) (\ \ \)" using l4 alpha - by (simp only: pt2[OF pt_name_inst]) - qed -qed - lemma typing_induct[consumes 1, case_names t1 t2 t3]: fixes P :: "'a::fs_name\(name\ty) list \ lam \ ty \bool" and \ :: "(name\ty) list" @@ -184,12 +105,52 @@ and a2: "\\ \ \ t1 t2 x. \ \ t1 : \\\ \ (\z. P z \ t1 (\\\)) \ \ \ t2 : \ \ (\z. P z \ t2 \) \ P x \ (App t1 t2) \" - and a3: "\(a::name) \ \ \ t x. - a\x \ a\\ \ ((a,\) # \) \ t : \ \ (\z. P z ((a,\)#\) t \) + and a3: "\a \ \ \ t x. a\x \ a\\ \ ((a,\) # \) \ t : \ \ (\z. P z ((a,\)#\) t \) \ P x \ (Lam [a].t) (\\\)" shows "P x \ t \" -using a a1 a2 a3 typing_induct_aux[of "\" "t" "\" "P" "x" "[]", simplified] by force - +proof - + from a have "\(pi::name prm) x. P x (pi\\) (pi\t) \" + proof (induct) + case (t1 \ \ a) + have j1: "valid \" by fact + have j2: "(a,\)\set \" by fact + from j1 have j3: "valid (pi\\)" by (rule eqvt_valid) + from j2 have "pi\(a,\)\pi\(set \)" by (simp only: pt_set_bij[OF pt_name_inst, OF at_name_inst]) + hence j4: "(pi\a,\)\set (pi\\)" by (simp add: pt_list_set_pi[OF pt_name_inst]) + show "P x (pi\\) (pi\(Var a)) \" using a1 j3 j4 by simp + next + case (t2 \ \ \ t1 t2) + thus ?case using a2 by (simp, blast intro: eqvt_typing) + next + case (t3 \ \ \ a t) + have k1: "a\\" by fact + have k2: "((a,\)#\)\t:\" by fact + have k3: "\(pi::name prm) (x::'a::fs_name). P x (pi \((a,\)#\)) (pi\t) \" by fact + have f: "\c::name. c\(pi\a,pi\t,pi\\,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\t)" and f4: "c\(pi\\)" + by (force simp add: fresh_prod at_fresh[OF at_name_inst]) + from k1 have k1a: "(pi\a)\(pi\\)" + by (simp add: pt_fresh_left[OF pt_name_inst, OF at_name_inst] + pt_rev_pi[OF pt_name_inst, OF at_name_inst]) + have l1: "(([(c,pi\a)]@pi)\\) = (pi\\)" using f4 k1a + by (simp only: pt2[OF pt_name_inst], rule pt_fresh_fresh[OF pt_name_inst, OF at_name_inst]) + have "\x. P x (([(c,pi\a)]@pi)\((a,\)#\)) (([(c,pi\a)]@pi)\t) \" using k3 by force + hence l2: "\x. P x ((c, \)#(pi\\)) (([(c,pi\a)]@pi)\t) \" using f1 l1 + by (force simp add: pt2[OF pt_name_inst] at_calc[OF at_name_inst]) + have "(([(c,pi\a)]@pi)\((a,\)#\)) \ (([(c,pi\a)]@pi)\t) : \" using k2 by (rule eqvt_typing) + hence l3: "((c, \)#(pi\\)) \ (([(c,pi\a)]@pi)\t) : \" using l1 f1 + by (force simp add: pt2[OF pt_name_inst] at_calc[OF at_name_inst]) + have l4: "P x (pi\\) (Lam [c].(([(c,pi\a)]@pi)\t)) (\ \ \)" using f2 f4 l2 l3 a3 by auto + have alpha: "(Lam [c].([(c,pi\a)]\(pi\t))) = (Lam [(pi\a)].(pi\t))" using f1 f3 + by (simp add: lam.inject alpha) + show "P x (pi\\) (pi\(Lam [a].t)) (\ \ \)" using l4 alpha + by (simp only: pt2[OF pt_name_inst], simp) + qed + hence "P x (([]::name prm)\\) (([]::name prm)\t) \" by blast + thus "P x \ t \" by simp +qed (* Now it comes: The Weakening Lemma *) @@ -197,114 +158,92 @@ "sub" :: "(name\ty) list \ (name\ty) list \ bool" (" _ \ _ " [80,80] 80) "\1 \ \2 \ \a \. (a,\)\set \1 \ (a,\)\set \2" -lemma weakening_version1[rule_format]: - assumes "\1 \ t : \" - and "valid \2" - and "\1 \ \2" +lemma weakening_version1: + assumes a: "\1 \ t : \" + and b: "valid \2" + and c: "\1 \ \2" shows "\2 \ t:\" -using prems -apply(nominal_induct \1 t \ fresh: \2 rule: typing_induct) +using a b c +apply(nominal_induct \1 t \ avoiding: \2 rule: typing_induct) apply(auto simp add: sub_def) -apply(atomize) (* FIXME: earlier this was completely automatic :o( *) +(* FIXME: before using meta-connectives and the new induction *) +(* method, this was completely automatic *) +apply(atomize) apply(auto) done -lemma weakening_version2[rule_format]: +lemma weakening_version2: fixes \1::"(name\ty) list" and t ::"lam" and \ ::"ty" assumes a: "\1 \ t:\" - shows "valid \2 \ \1 \ \2 \ \2 \ t:\" -using prems -proof (nominal_induct \1 t \ fresh: \2 rule: typing_induct, auto) - case (t1 \1 a \ \2) (* variable case *) - assume "\1 \ \2" - and "valid \2" - and "(a,\)\ set \1" - thus "\2 \ Var a : \" by (force simp add: sub_def) + and b: "valid \2" + and c: "\1 \ \2" + shows "\2 \ t:\" +using a b c +proof (nominal_induct \1 t \ avoiding: \2 rule: typing_induct, auto) + case (t1 \1 a \) (* variable case *) + have "\1 \ \2" + and "valid \2" + and "(a,\)\ set \1" by fact+ + thus "\2 \ Var a : \" by (force simp add: sub_def) next - case (t3 a \1 \ \ t \2) (* lambda case *) - assume a1: "\1 \ \2" - and a2: "valid \2" - and a3: "a\\2" - have i: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" by fact + case (t3 a \1 \ \ t) (* lambda case *) + have a1: "\1 \ \2" by fact + have a2: "valid \2" by fact + have a3: "a\\2" by fact + have ih: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" by fact have "((a,\)#\1) \ ((a,\)#\2)" using a1 by (simp add: sub_def) moreover have "valid ((a,\)#\2)" using a2 a3 v2 by force - ultimately have "((a,\)#\2) \ t:\" using i by force + ultimately have "((a,\)#\2) \ t:\" using ih by force with a3 show "\2 \ (Lam [a].t) : \ \ \" by force qed -lemma weakening_version3[rule_format]: - fixes \1::"(name\ty) list" - and t ::"lam" - and \ ::"ty" - assumes "\1 \ t:\" - shows "valid \2 \ \1 \ \2 \ \2 \ t:\" -using prems -proof (nominal_induct \1 t \ fresh: \2 rule: typing_induct) - case (t1 \1 a \ \2) (* variable case *) - thus "valid \2 \ \1 \ \2 \ \2 \ Var a : \" by (force simp add: sub_def) -next - case (t2 \1 \ \ t1 t2 \2) (* variable case *) - thus "valid \2 \ \1 \ \2 \ \2 \ App t1 t2 : \" by force -next - case (t3 a \1 \ \ t \2) (* lambda case *) - have a3: "a\\2" by fact - have ih: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" by fact - show "valid \2 \ \1 \ \2 \ \2 \ (Lam [a].t) : \ \ \" - proof (intro strip) - assume a1: "\1 \ \2" - and a2: "valid \2" - have "((a,\)#\1) \ ((a,\)#\2)" using a1 by (simp add: sub_def) - moreover - have "valid ((a,\)#\2)" using a2 a3 v2 by force - ultimately have "((a,\)#\2) \ t:\" using ih by force - with a3 show "\2 \ (Lam [a].t) : \ \ \" by force - qed -qed +lemma weakening_version3: + assumes a: "\1 \ t:\" + and b: "valid \2" + and c: "\1 \ \2" + shows "\2 \ t:\" +using a b c +proof (nominal_induct \1 t \ avoiding: \2 rule: typing_induct) + case (t3 a \1 \ \ t) (* lambda case *) + have fc: "a\\2" by fact + have ih: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" by fact + have a1: "\1 \ \2" by fact + have a2: "valid \2" by fact + have "((a,\)#\1) \ ((a,\)#\2)" using a1 sub_def by simp + moreover + have "valid ((a,\)#\2)" using a2 fc by force + ultimately have "((a,\)#\2) \ t:\" using ih by force + with fc show "\2 \ (Lam [a].t) : \ \ \" by force +qed (auto simp add: sub_def) (* app and var case *) -lemma weakening_version4[rule_format]: - assumes "\1 \ t:\" - shows "valid \2 \ \1 \ \2 \ \2 \ t:\" -using prems -proof (nominal_induct \1 t \ fresh: \2 rule: typing_induct) - case (t3 a \1 \ \ t \2) (* lambda case *) - have fc: "a\\2" by fact - have ih: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" by fact - show "valid \2 \ \1 \ \2 \ \2 \ (Lam [a].t) : \ \ \" - proof (intro strip) - assume a1: "\1 \ \2" - and a2: "valid \2" - have "((a,\)#\1) \ ((a,\)#\2)" using a1 sub_def by simp - moreover - have "valid ((a,\)#\2)" using a2 fc by force - ultimately have "((a,\)#\2) \ t:\" using ih by force - with fc show "\2 \ (Lam [a].t) : \ \ \" by force - qed -qed (auto simp add: sub_def) (* lam and var case *) - - -(* original induction principle is not strong *) -(* enough - so the simple proof fails *) -lemma weakening_too_weak[rule_format]: - assumes "\1 \ t:\" - shows "valid \2 \ \1 \ \2 \ \2 \ t:\" -using prems -proof (induct, auto) +text{* The original induction principle for typing + is not strong enough - so the simple proof fails *} +lemma weakening_too_weak: + assumes a: "\1 \ t:\" + and b: "valid \2" + and c: "\1 \ \2" + shows "\2 \ t:\" +using a b c +proof (induct fixing: \2) case (t1 \1 \ a) (* variable case *) - assume "\1 \ \2" - and "valid \2" - and "(a,\) \ (set \1)" + have "\1 \ \2" + and "valid \2" + and "(a,\) \ (set \1)" by fact+ thus "\2 \ Var a : \" by (force simp add: sub_def) next - case (t3 \1 \ \ a t) (* lambda case *) - assume a1: "\1 \ \2" - and a2: "valid \2" - and i: "\\3. valid \3 \ ((a,\)#\1) \ \3 \ \3 \ t:\" - have "((a,\)#\1) \ ((a,\)#\2)" using a1 by (simp add: sub_def) + case (t3 \1 \ \ a t) (* lambda case *) + (* all assumption in this case*) + have a0: "a\\1" by fact + have a1: "((a,\)#\1) \ t : \" 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 add: sub_def) moreover - have "valid ((a,\)#\2)" using v2 (* fails *) + have "valid ((a,\)#\2)" using v2 (* fails *) diff -r b00c9120f6bd -r b83b00cbaecf src/HOL/Nominal/nominal_induct.ML --- a/src/HOL/Nominal/nominal_induct.ML Wed Nov 30 22:52:50 2005 +0100 +++ b/src/HOL/Nominal/nominal_induct.ML Thu Dec 01 04:46:17 2005 +0100 @@ -106,7 +106,7 @@ local -val freshN = "fresh"; +val freshN = "avoiding"; val fixingN = "fixing"; val ruleN = "rule";