# HG changeset patch # User wenzelm # Date 1132942184 -3600 # Node ID 2124b24454dd91aef840fca256131e666c8a7f39 # Parent 8de262a22f23cf7bae6615d8b28a2302bf60a7bf tuned induct proofs; diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/Eta.thy --- a/src/HOL/Lambda/Eta.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/Eta.thy Fri Nov 25 19:09:44 2005 +0100 @@ -67,16 +67,16 @@ apply (simp add: diff_Suc subst_Var split: nat.split) done -lemma free_eta: "s -e> t ==> (!!i. free t i = free s i)" - by (induct set: eta) (simp_all cong: conj_cong) +lemma free_eta: "s -e> t ==> free t i = free s i" + by (induct fixing: i set: eta) (simp_all cong: conj_cong) lemma not_free_eta: "[| s -e> t; \ free s i |] ==> \ free t i" by (simp add: free_eta) lemma eta_subst [simp]: - "s -e> t ==> (!!u i. s[u/i] -e> t[u/i])" - by (induct set: eta) (simp_all add: subst_subst [symmetric]) + "s -e> t ==> s[u/i] -e> t[u/i]" + by (induct fixing: u i set: eta) (simp_all add: subst_subst [symmetric]) theorem lift_subst_dummy: "\ free s i \ lift (s[dummy/i]) i = s" by (induct s fixing: i dummy) simp_all @@ -122,17 +122,17 @@ subsection "Commutation of beta and eta" lemma free_beta: - "s -> t ==> (!!i. free t i \ free s i)" - by (induct set: beta) auto + "s -> t ==> free t i \ free s i" + by (induct fixing: i set: beta) auto -lemma beta_subst [intro]: "s -> t ==> (!!u i. s[u/i] -> t[u/i])" - by (induct set: beta) (simp_all add: subst_subst [symmetric]) +lemma beta_subst [intro]: "s -> t ==> s[u/i] -> t[u/i]" + by (induct fixing: u i set: beta) (simp_all add: subst_subst [symmetric]) lemma subst_Var_Suc [simp]: "t[Var i/i] = t[Var(i)/i + 1]" by (induct t fixing: i) (auto elim!: linorder_neqE simp: subst_Var) -lemma eta_lift [simp]: "s -e> t ==> (!!i. lift s i -e> lift t i)" - by (induct set: eta) simp_all +lemma eta_lift [simp]: "s -e> t ==> lift s i -e> lift t i" + by (induct fixing: i set: eta) simp_all lemma rtrancl_eta_subst: "s -e> t \ u[s/i] -e>> u[t/i]" apply (induct u fixing: s t i) diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/Lambda.thy --- a/src/HOL/Lambda/Lambda.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/Lambda.thy Fri Nov 25 19:09:44 2005 +0100 @@ -159,8 +159,8 @@ Normalization. \medskip *} theorem subst_preserves_beta [simp]: - "r \\<^sub>\ s ==> (\t i. r[t/i] \\<^sub>\ s[t/i])" - by (induct set: beta) (simp_all add: subst_subst [symmetric]) + "r \\<^sub>\ s ==> r[t/i] \\<^sub>\ s[t/i]" + by (induct fixing: t i set: beta) (simp_all add: subst_subst [symmetric]) theorem subst_preserves_beta': "r \\<^sub>\\<^sup>* s ==> r[t/i] \\<^sub>\\<^sup>* s[t/i]" apply (induct set: rtrancl) @@ -170,8 +170,8 @@ done theorem lift_preserves_beta [simp]: - "r \\<^sub>\ s ==> (\i. lift r i \\<^sub>\ lift s i)" - by (induct set: beta) auto + "r \\<^sub>\ s ==> lift r i \\<^sub>\ lift s i" + by (induct fixing: i set: beta) auto theorem lift_preserves_beta': "r \\<^sub>\\<^sup>* s ==> lift r i \\<^sub>\\<^sup>* lift s i" apply (induct set: rtrancl) diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/ListApplication.thy --- a/src/HOL/Lambda/ListApplication.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/ListApplication.thy Fri Nov 25 19:09:44 2005 +0100 @@ -53,11 +53,11 @@ done lemma Abs_App_neq_Var_apps [iff]: - "Abs s \ t ~= Var n \\ ss" + "Abs s \ t \ Var n \\ ss" by (induct ss fixing: s t rule: rev_induct) auto lemma Var_apps_neq_Abs_apps [iff]: - "Var n \\ ts ~= Abs r \\ ss" + "Var n \\ ts \ Abs r \\ ss" apply (induct ss fixing: ts rule: rev_induct) apply simp apply (induct_tac ts rule: rev_induct) diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/ListOrder.thy --- a/src/HOL/Lambda/ListOrder.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/ListOrder.thy Fri Nov 25 19:09:44 2005 +0100 @@ -64,12 +64,13 @@ apply (blast intro: append_eq_appendI) done -lemma Cons_step1E [rule_format, elim!]: - "[| (ys, x # xs) \ step1 r; - \y. ys = y # xs --> (y, x) \ r --> R; - \zs. ys = x # zs --> (zs, xs) \ step1 r --> R - |] ==> R" - apply (case_tac ys) +lemma Cons_step1E [elim!]: + assumes "(ys, x # xs) \ step1 r" + and "!!y. ys = y # xs \ (y, x) \ r \ R" + and "!!zs. ys = x # zs \ (zs, xs) \ step1 r \ R" + shows R + using prems + apply (cases ys) apply (simp add: step1_def) apply blast done @@ -88,8 +89,8 @@ done lemma Cons_acc_step1I [intro!]: - "x \ acc r ==> (!!xs. xs \ acc (step1 r) \ x # xs \ acc (step1 r))" - apply (induct set: acc) + "x \ acc r ==> xs \ acc (step1 r) \ x # xs \ acc (step1 r)" + apply (induct fixing: xs set: acc) apply (erule thin_rl) apply (erule acc_induct) apply (rule accI) diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/StrongNorm.thy --- a/src/HOL/Lambda/StrongNorm.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/StrongNorm.thy Fri Nov 25 19:09:44 2005 +0100 @@ -16,8 +16,8 @@ subsection {* Properties of @{text IT} *} -lemma lift_IT [intro!]: "t \ IT \ (\i. lift t i \ IT)" - apply (induct set: IT) +lemma lift_IT [intro!]: "t \ IT \ lift t i \ IT" + apply (induct fixing: i set: IT) apply (simp (no_asm)) apply (rule conjI) apply @@ -37,8 +37,8 @@ lemma lifts_IT: "ts \ lists IT \ map (\t. lift t 0) ts \ lists IT" by (induct ts) auto -lemma subst_Var_IT: "r \ IT \ (\i j. r[Var i/j] \ IT)" - apply (induct set: IT) +lemma subst_Var_IT: "r \ IT \ r[Var i/j] \ IT" + apply (induct fixing: i j set: IT) txt {* Case @{term Var}: *} apply (simp (no_asm) add: subst_Var) apply @@ -249,34 +249,33 @@ subsection {* Well-typed terms are strongly normalizing *} -lemma type_implies_IT: "e \ t : T \ t \ IT" -proof - - assume "e \ t : T" - thus ?thesis - proof induct - case Var - show ?case by (rule Var_IT) - next - case Abs - show ?case by (rule IT.Lambda) - next - case (App T U e s t) - have "(Var 0 \ lift t 0)[s/0] \ IT" - proof (rule subst_type_IT) - have "lift t 0 \ IT" by (rule lift_IT) - hence "[lift t 0] \ lists IT" by (rule lists.Cons) (rule lists.Nil) - hence "Var 0 \\ [lift t 0] \ IT" by (rule IT.Var) - also have "Var 0 \\ [lift t 0] = Var 0 \ lift t 0" by simp - finally show "\ \ IT" . - have "e\0:T \ U\ \ Var 0 : T \ U" - by (rule typing.Var) simp - moreover have "e\0:T \ U\ \ lift t 0 : T" - by (rule lift_type) - ultimately show "e\0:T \ U\ \ Var 0 \ lift t 0 : U" - by (rule typing.App) - qed - thus ?case by simp +lemma type_implies_IT: + assumes "e \ t : T" + shows "t \ IT" + using prems +proof induct + case Var + show ?case by (rule Var_IT) +next + case Abs + show ?case by (rule IT.Lambda) +next + case (App T U e s t) + have "(Var 0 \ lift t 0)[s/0] \ IT" + proof (rule subst_type_IT) + have "lift t 0 \ IT" by (rule lift_IT) + hence "[lift t 0] \ lists IT" by (rule lists.Cons) (rule lists.Nil) + hence "Var 0 \\ [lift t 0] \ IT" by (rule IT.Var) + also have "Var 0 \\ [lift t 0] = Var 0 \ lift t 0" by simp + finally show "\ \ IT" . + have "e\0:T \ U\ \ Var 0 : T \ U" + by (rule typing.Var) simp + moreover have "e\0:T \ U\ \ lift t 0 : T" + by (rule lift_type) + ultimately show "e\0:T \ U\ \ Var 0 \ lift t 0 : U" + by (rule typing.App) qed + thus ?case by simp qed theorem type_implies_termi: "e \ t : T \ t \ termi beta" diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/Type.thy --- a/src/HOL/Lambda/Type.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/Type.thy Fri Nov 25 19:09:44 2005 +0100 @@ -288,8 +288,8 @@ subsection {* Lifting preserves well-typedness *} -lemma lift_type [intro!]: "e \ t : T \ (\i U. e\i:U\ \ lift t i : T)" - by (induct set: typing) auto +lemma lift_type [intro!]: "e \ t : T \ e\i:U\ \ lift t i : T" + by (induct fixing: i U set: typing) auto lemma lift_types: "e \ ts : Ts \ e\i:U\ \ (map (\t. lift t i) ts) : Ts" @@ -303,8 +303,8 @@ subsection {* Substitution lemmas *} lemma subst_lemma: - "e \ t : T \ (\e' i U u. e' \ u : U \ e = e'\i:U\ \ e' \ t[u/i] : T)" - apply (induct set: typing) + "e \ t : T \ e' \ u : U \ e = e'\i:U\ \ e' \ t[u/i] : T" + apply (induct fixing: e' i U u set: typing) apply (rule_tac x = x and y = i in linorder_cases) apply auto apply blast @@ -329,8 +329,8 @@ subsection {* Subject reduction *} -lemma subject_reduction: "e \ t : T \ (\t'. t -> t' \ e \ t' : T)" - apply (induct set: typing) +lemma subject_reduction: "e \ t : T \ t -> t' \ e \ t' : T" + apply (induct fixing: t' set: typing) apply blast apply blast apply atomize diff -r 8de262a22f23 -r 2124b24454dd src/HOL/Lambda/WeakNorm.thy --- a/src/HOL/Lambda/WeakNorm.thy Fri Nov 25 18:58:43 2005 +0100 +++ b/src/HOL/Lambda/WeakNorm.thy Fri Nov 25 19:09:44 2005 +0100 @@ -113,8 +113,8 @@ listall (\t. t \ NF) (map (\t. t[Var i/j]) ts)" by (induct ts) simp+ -lemma subst_Var_NF: "t \ NF \ (\i j. t[Var i/j] \ NF)" - apply (induct set: NF) +lemma subst_Var_NF: "t \ NF \ t[Var i/j] \ NF" + apply (induct fixing: i j set: NF) apply simp apply (frule listall_conj1) apply (drule listall_conj2) @@ -153,10 +153,10 @@ lemma lift_terms_NF: "listall (\t. t \ NF) ts \ listall (\t. \i. lift t i \ NF) ts \ listall (\t. t \ NF) (map (\t. lift t i) ts)" - by (induct ts) simp+ + by (induct ts) simp_all -lemma lift_NF: "t \ NF \ (\i. lift t i \ NF)" - apply (induct set: NF) +lemma lift_NF: "t \ NF \ lift t i \ NF" + apply (induct fixing: i set: NF) apply (frule listall_conj1) apply (drule listall_conj2) apply (drule_tac i=i in lift_terms_NF)