diff -r dbe58b104cb9 -r 4c9c081a416b src/HOL/Nominal/Examples/Weakening.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Nominal/Examples/Weakening.thy Mon Nov 07 15:12:13 2005 +0100 @@ -0,0 +1,305 @@ + +theory lam_public +imports "../nominal" +begin + +(* WEAKENING EXAMPLE*) + +section {* Simply-Typed Lambda-Calculus *} +(*======================================*) + +atom_decl name + +nominal_datatype lam = Var "name" + | App "lam" "lam" + | Lam "\name\lam" ("Lam [_]._" [100,100] 100) + +datatype ty = + TVar "string" + | TArr "ty" "ty" (infix "\" 200) + +primrec + "pi\(TVar s) = TVar s" + "pi\(\ \ \) = (\ \ \)" + +lemma perm_ty[simp]: + fixes pi ::"name prm" + and \ ::"ty" + shows "pi\\ = \" + by (cases \, simp_all) + +instance ty :: pt_name +apply(intro_classes) +apply(simp_all) +done + +instance ty :: fs_name +apply(intro_classes) +apply(simp add: supp_def) +done + +(* valid contexts *) +consts + ctxts :: "((name\ty) list) set" + valid :: "(name\ty) list \ bool" +translations + "valid \" \ "\ \ ctxts" +inductive ctxts +intros +v1[intro]: "valid []" +v2[intro]: "\valid \;a\\\\ valid ((a,\)#\)" + +lemma eqvt_valid: + fixes pi:: "name prm" + assumes a: "valid \" + shows "valid (pi\\)" +using a +apply(induct) +apply(auto simp add: pt_fresh_bij[OF pt_name_inst, OF at_name_inst]) +done + +(* typing judgements *) +consts + typing :: "(((name\ty) list)\lam\ty) set" +syntax + "_typing_judge" :: "(name\ty) list\lam\ty\bool" (" _ \ _ : _ " [80,80,80] 80) +translations + "\ \ t : \" \ "(\,t,\) \ typing" + +inductive typing +intros +t1[intro]: "\valid \; (a,\)\set \\\ \ \ Var a : \" +t2[intro]: "\\ \ t1 : \\\; \ \ t2 : \\\ \ \ App t1 t2 : \" +t3[intro]: "\a\\;((a,\)#\) \ t : \\ \ \ \ Lam [a].t : \\\" + +lemma eqvt_typing: + fixes \ :: "(name\ty) list" + and t :: "lam" + and \ :: "ty" + and pi:: "name prm" + assumes a: "\ \ t : \" + shows "(pi\\) \ (pi\t) : \" +using a +proof (induct) + case (t1 \ \ a) + have "valid (pi\\)" by (rule eqvt_valid) + moreover + have "(pi\(a,\))\((pi::name prm)\set \)" by (rule pt_set_bij2[OF pt_name_inst, OF at_name_inst]) + ultimately show "(pi\\) \ ((pi::name prm)\Var a) : \" + using typing.intros by (force simp add: pt_list_set_pi[OF pt_name_inst, symmetric]) +next + case (t3 \ \ \ a t) + moreover have "(pi\a)\(pi\\)" by (rule pt_fresh_bij1[OF pt_name_inst, OF at_name_inst]) + ultimately show "(pi\\) \ (pi\Lam [a].t) :\\\" by force +qed (auto) + + +lemma typing_induct_weak[THEN spec, case_names t1 t2 t3]: + fixes P :: "(name\ty) list \ lam \ ty \'a\bool" + and \ :: "(name\ty) list" + and t :: "lam" + and \ :: "ty" + assumes a: "\ \ t : \" + and a1: "\x \ (a::name) \. valid \ \ (a,\) \ set \ \ P \ (Var a) \ x" + and a2: "\x \ \ \ t1 t2. + \ \ t1 : \\\ \ (\z. P \ t1 (\\\) z) \ \ \ t2 : \ \ (\z. P \ t2 \ z) + \ P \ (App t1 t2) \ x" + and a3: "\x (a::name) \ \ \ t. + a\\ \ ((a,\) # \) \ t : \ \ (\z. P ((a,\)#\) t \ z) + \ P \ (Lam [a].t) (\\\) x" + shows "\x. P \ t \ x" +using a by (induct, simp_all add: a1 a2 a3) + +lemma typing_induct_aux[rule_format]: + fixes P :: "(name\ty) list \ lam \ ty \'a::fs_name\bool" + and \ :: "(name\ty) list" + and t :: "lam" + and \ :: "ty" + assumes a: "\ \ t : \" + and a1: "\x \ (a::name) \. valid \ \ (a,\) \ set \ \ P \ (Var a) \ x" + and a2: "\x \ \ \ t1 t2. + \ \ t1 : \\\ \ (\z. P \ t1 (\\\) z) \ \ \ t2 : \ \ (\z. P \ t2 \ z) + \ P \ (App t1 t2) \ x" + and a3: "\x (a::name) \ \ \ t. + a\x \ a\\ \ ((a,\) # \) \ t : \ \ (\z. P ((a,\)#\) t \ z) + \ P \ (Lam [a].t) (\\\) x" + shows "\(pi::name prm) (x::'a::fs_name). P (pi\\) (pi\t) \ x" +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 (pi\\) (Var (pi\a)) \ x" 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 (pi \ ((a,\)#\)) (pi\t) \ x" 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 (([(c,pi\a)]@pi)\((a,\)#\)) (([(c,pi\a)]@pi)\t) \ x" using k3 by force + hence l2: "\x. P ((c, \)#(pi\\)) (([(c,pi\a)]@pi)\t) \ x" 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 (pi\\) (Lam [c].(([(c,pi\a)]@pi)\t)) (\ \ \) x" 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 (pi\\) (Lam [(pi\a)].(pi\t)) (\ \ \) x" using l4 alpha + by (simp only: pt2[OF pt_name_inst]) + qed +qed + +lemma typing_induct[case_names t1 t2 t3]: + fixes P :: "(name\ty) list \ lam \ ty \'a::fs_name\bool" + and \ :: "(name\ty) list" + and t :: "lam" + and \ :: "ty" + and x :: "'a::fs_name" + assumes a: "\ \ t : \" + and a1: "\x \ (a::name) \. valid \ \ (a,\) \ set \ \ P \ (Var a) \ x" + and a2: "\x \ \ \ t1 t2. + \ \ t1 : \\\ \ (\z. P \ t1 (\\\) z) \ \ \ t2 : \ \ (\z. P \ t2 \ z) + \ P \ (App t1 t2) \ x" + and a3: "\x (a::name) \ \ \ t. + a\x \ a\\ \ ((a,\) # \) \ t : \ \ (\z. P ((a,\)#\) t \ z) + \ P \ (Lam [a].t) (\\\) x" + shows "P \ t \ x" +using a a1 a2 a3 typing_induct_aux[of "\" "t" "\" "P" "[]" "x", simplified] by force + + +(* Now it comes: The Weakening Lemma *) + +constdefs + "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 a: "\1 \ t : \" + shows "valid \2 \ \1 \ \2 \ \2 \ t:\" +using a +apply(nominal_induct \1 t \ rule: typing_induct) +apply(auto simp add: sub_def) +done + +lemma weakening_version2[rule_format]: + fixes \1::"(name\ty) list" + and t ::"lam" + and \ ::"ty" + assumes a: "\1 \ t:\" + shows "valid \2 \ \1 \ \2 \ \2 \ t:\" +using a +proof (nominal_induct \1 t \ rule: typing_induct, auto) + case (t1 \2 \1 a \) (* variable case *) + assume "\1 \ \2" + and "valid \2" + and "(a,\)\ set \1" + thus "\2 \ Var a : \" by (force simp add: sub_def) +next + case (t3 \2 a \1 \ \ t) (* 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 + 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 + 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 a: "\1 \ t:\" + shows "valid \2 \ \1 \ \2 \ \2 \ t:\" +using a +proof (nominal_induct \1 t \ rule: typing_induct) + case (t1 \2 \1 a \) (* variable case *) + thus "valid \2 \ \1 \ \2 \ \2 \ Var a : \" by (force simp add: sub_def) +next + case (t2 \2 \1 \ \ t1 t2) (* variable case *) + thus "valid \2 \ \1 \ \2 \ \2 \ App t1 t2 : \" by force +next + case (t3 \2 a \1 \ \ t) (* lambda case *) + have a3: "a\\2" + and i: "\\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 i by force + with a3 show "\2 \ (Lam [a].t) : \ \ \" by force + qed +qed + +lemma weakening_version4[rule_format]: + assumes a: "\1 \ t:\" + shows "valid \2 \ \1 \ \2 \ \2 \ t:\" +using a +proof (nominal_induct \1 t \ rule: typing_induct) + case (t3 \2 a \1 \ \ t) (* lambda case *) + have fc: "a\\2" + and 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 a: "\1 \ t:\" + shows "valid \2 \ \1 \ \2 \ \2 \ t:\" +using a +proof (nominal_induct \1 t \ rule: typing_induct_weak, auto) + case (t1 \2 \1 a \) (* variable case *) + assume "\1 \ \2" + and "valid \2" + and "(a,\)\ set \1" + thus "\2 \ Var a : \" by (force simp add: sub_def) +next + case (t3 \2 a \1 \ \ 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) + moreover + have "valid ((a,\)#\2)" using v2 (* fails *) + + +