diff -r 4ccb7e6be929 -r 51a80e238b29 src/HOL/Nominal/Examples/SN.thy --- a/src/HOL/Nominal/Examples/SN.thy Wed Feb 07 17:41:11 2007 +0100 +++ b/src/HOL/Nominal/Examples/SN.thy Wed Feb 07 17:44:07 2007 +0100 @@ -45,21 +45,16 @@ apply(simp_all add: fresh_atm) done -consts - Beta :: "(lam\lam) set" -syntax - "_Beta" :: "lam\lam\bool" (" _ \\<^isub>\ _" [80,80] 80) - "_Beta_star" :: "lam\lam\bool" (" _ \\<^isub>\\<^sup>* _" [80,80] 80) -translations - "t1 \\<^isub>\ t2" \ "(t1,t2) \ Beta" - "t1 \\<^isub>\\<^sup>* t2" \ "(t1,t2) \ Beta\<^sup>*" -inductive Beta - intros +inductive2 Beta :: "lam\lam\bool" (" _ \\<^isub>\ _" [80,80] 80) +where b1[intro!]: "s1\\<^isub>\s2 \ (App s1 t)\\<^isub>\(App s2 t)" - b2[intro!]: "s1\\<^isub>\s2 \ (App t s1)\\<^isub>\(App t s2)" - b3[intro!]: "s1\\<^isub>\s2 \ (Lam [a].s1)\\<^isub>\ (Lam [(a::name)].s2)" - b4[intro!]: "(App (Lam [(a::name)].s1) s2)\\<^isub>\(s1[a::=s2])" +| b2[intro!]: "s1\\<^isub>\s2 \ (App t s1)\\<^isub>\(App t s2)" +| b3[intro!]: "s1\\<^isub>\s2 \ (Lam [a].s1)\\<^isub>\ (Lam [(a::name)].s2)" +| b4[intro!]: "(App (Lam [(a::name)].s1) s2)\\<^isub>\(s1[a::=s2])" +abbreviation "Beta_star" :: "lam\lam\bool" (" _ \\<^isub>\\<^sup>* _" [80,80] 80) where + "t1 \\<^isub>\\<^sup>* t2 \ Beta\<^sup>*\<^sup>* t1 t2" + lemma eqvt_beta: fixes pi :: "name prm" and t :: "lam" @@ -86,7 +81,7 @@ next case b2 thus ?case using a2 by (simp, blast intro: eqvt_beta) next - case (b3 a s1 s2) + case (b3 s1 s2 a) have j1: "s1 \\<^isub>\ s2" by fact have j2: "\x (pi::name prm). P x (pi\s1) (pi\s2)" by fact show ?case @@ -137,7 +132,7 @@ lemma beta_abs: "Lam [a].t\\<^isub>\ t'\\t''. t'=Lam [a].t'' \ t\\<^isub>\ t''" -apply(ind_cases "Lam [a].t \\<^isub>\ t'") +apply(ind_cases2 "Lam [a].t \\<^isub>\ t'") apply(auto simp add: lam.distinct lam.inject) apply(auto simp add: alpha) apply(rule_tac x="[(a,aa)]\s2" in exI) @@ -201,15 +196,10 @@ "dom_ty [] = []" "dom_ty (x#\) = (fst x)#(dom_ty \)" -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,\)#\)" +inductive2 valid :: "(name\ty) list \ bool" +where + v1[intro]: "valid []" +| v2[intro]: "\valid \;a\\\\ valid ((a,\)#\)" lemma valid_eqvt: fixes pi:: "name prm" @@ -238,7 +228,7 @@ and a :: "name" and \ :: "ty" shows "valid ((a,\)#\) \ valid \ \ a\\" -apply(ind_cases "valid ((a,\)#\)", simp) +apply(ind_cases2 "valid ((a,\)#\)", simp) done lemma valid_unicity[rule_format]: @@ -251,18 +241,11 @@ apply(auto dest!: valid_elim fresh_context) done -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 : \\\" +inductive2 typing :: "(name\ty) list\lam\ty\bool" (" _ \ _ : _ " [80,80,80] 80) +where + 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" @@ -273,14 +256,14 @@ shows "(pi\\) \ (pi\t) : \" using a proof (induct) - case (t1 \ \ a) + case (t1 \ a \) have "valid (pi\\)" by (rule valid_eqvt) 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.t1 by (force simp add: pt_list_set_pi[OF pt_name_inst, symmetric]) next - case (t3 \ \ \ a t) + case (t3 a \ \ t \) moreover have "(pi\a)\(pi\\)" by (simp add: fresh_bij) ultimately show "(pi\\) \ (pi\Lam [a].t) :\\\" by force qed (auto) @@ -302,7 +285,7 @@ proof - from a have "\(pi::name prm) x. P x (pi\\) (pi\t) \" proof (induct) - case (t1 \ \ a) + case (t1 \ a \) have j1: "valid \" by fact have j2: "(a,\)\set \" by fact from j1 have j3: "valid (pi\\)" by (rule valid_eqvt) @@ -310,10 +293,10 @@ 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) + case (t2 \ t1 \ \ t2) thus ?case using a2 by (simp, blast intro: eqvt_typing) next - case (t3 \ \ \ a t) + 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 @@ -375,17 +358,17 @@ done lemma t1_elim: "\ \ Var a : \ \ valid \ \ (a,\) \ set \" -apply(ind_cases "\ \ Var a : \") +apply(ind_cases2 "\ \ Var a : \") apply(auto simp add: lam.inject lam.distinct) done lemma t2_elim: "\ \ App t1 t2 : \ \ \\. (\ \ t1 : \\\ \ \ \ t2 : \)" -apply(ind_cases "\ \ App t1 t2 : \") +apply(ind_cases2 "\ \ App t1 t2 : \") apply(auto simp add: lam.inject lam.distinct) done lemma t3_elim: "\\ \ Lam [a].t : \;a\\\\ \\ \'. \=\\\' \ ((a,\)#\) \ t : \'" -apply(ind_cases "\ \ Lam [a].t : \") +apply(ind_cases2 "\ \ Lam [a].t : \") apply(auto simp add: lam.distinct lam.inject alpha) apply(drule_tac pi="[(a,aa)]::name prm" in eqvt_typing) apply(simp) @@ -534,7 +517,7 @@ constdefs "SN" :: "lam \ bool" - "SN t \ t\termi Beta" + "SN t \ termi Beta t" lemma SN_preserved: "\SN(t1);t1\\<^isub>\ t2\\SN(t2)" apply(simp add: SN_def) @@ -561,30 +544,24 @@ "NEUT t \ (\a. t=Var a)\(\t1 t2. t=App t1 t2)" (* a slight hack to get the first element of applications *) -consts - FST :: "(lam\lam) set" -syntax - "FST_judge" :: "lam\lam\bool" (" _ \ _" [80,80] 80) -translations - "t1 \ t2" \ "(t1,t2) \ FST" -inductive FST - intros +inductive2 FST :: "lam\lam\bool" (" _ \ _" [80,80] 80) +where fst[intro!]: "(App t s) \ t" lemma fst_elim[elim!]: shows "(App t s) \ t' \ t=t'" -apply(ind_cases "App t s \ t'") +apply(ind_cases2 "App t s \ t'") apply(simp add: lam.inject) done lemma qq3: "SN(App t s)\SN(t)" apply(simp add: SN_def) -apply(subgoal_tac "\z. (App t s \ z) \ z\termi Beta")(*A*) +apply(subgoal_tac "\z. (App t s \ z) \ termi Beta z")(*A*) apply(force) (*A*) apply(erule acc_induct) apply(clarify) -apply(ind_cases "x \ z") +apply(ind_cases2 "x \ z" for x z) apply(clarify) apply(rule accI) apply(auto intro: b1) @@ -626,7 +603,7 @@ apply(force simp only: NEUT_def) apply(simp (no_asm) add: CR3_RED_def) apply(clarify) -apply(ind_cases "App t x \\<^isub>\ t'") +apply(ind_cases2 "App t x \\<^isub>\ t'" for x t t') apply(simp_all add: lam.inject) apply(simp only: CR3_RED_def) apply(drule_tac x="s2" in spec) @@ -701,21 +678,21 @@ qed lemma double_acc_aux: - assumes a_acc: "a \ acc r" - and b_acc: "b \ acc r" + assumes a_acc: "acc r a" + and b_acc: "acc r b" and hyp: "\x z. - (\y. (y, x) \ r \ y \ acc r) \ - (\y. (y, x) \ r \ P y z) \ - (\u. (u, z) \ r \ u \ acc r) \ - (\u. (u, z) \ r \ P x u) \ P x z" + (\y. r y x \ acc r y) \ + (\y. r y x \ P y z) \ + (\u. r u z \ acc r u) \ + (\u. r u z \ P x u) \ P x z" shows "P a b" proof - from a_acc - have r: "\b. b \ acc r \ P a b" + have r: "\b. acc r b \ P a b" proof (induct a rule: acc.induct) case (accI x) note accI' = accI - have "b \ acc r" . + have "acc r b" . thus ?case proof (induct b rule: acc.induct) case (accI y) @@ -734,7 +711,7 @@ qed lemma double_acc: - "\a \ acc r; b \ acc r; \x z. ((\y. (y, x)\r\P y z)\(\u. (u, z)\r\P x u))\P x z\\P a b" + "\acc r a; acc r b; \x z. ((\y. r y x \ P y z) \ (\u. r u z \ P x u)) \ P x z\ \ P a b" apply(rule_tac r="r" in double_acc_aux) apply(assumption)+ apply(blast) @@ -743,7 +720,7 @@ lemma abs_RED: "(\s\RED \. t[x::=s]\RED \)\Lam [x].t\RED (\\\)" apply(simp) apply(clarify) -apply(subgoal_tac "t\termi Beta")(*1*) +apply(subgoal_tac "termi Beta t")(*1*) apply(erule rev_mp) apply(subgoal_tac "u \ RED \")(*A*) apply(erule rev_mp) @@ -764,7 +741,7 @@ apply(force simp add: NEUT_def) apply(simp add: CR3_RED_def) apply(clarify) -apply(ind_cases "App(Lam[x].xa) z \\<^isub>\ t'") +apply(ind_cases2 "App(Lam[x].xa) z \\<^isub>\ t'" for xa z t') apply(auto simp add: lam.inject lam.distinct) apply(drule beta_abs) apply(auto) @@ -813,7 +790,7 @@ apply(force simp add: NEUT_def) apply(simp add: NORMAL_def) apply(clarify) -apply(ind_cases "Var x \\<^isub>\ t'") +apply(ind_cases2 "Var x \\<^isub>\ t'" for t') apply(auto simp add: lam.inject lam.distinct) apply(force simp add: RED_props) apply(simp add: id_subs)