diff -r dd7490fdd998 -r e44551d067e6 Nominal/Ex/Lambda.thy --- a/Nominal/Ex/Lambda.thy Tue Dec 21 10:28:08 2010 +0000 +++ b/Nominal/Ex/Lambda.thy Wed Dec 22 09:13:25 2010 +0000 @@ -3,7 +3,6 @@ begin atom_decl name -declare [[STEPS = 100]] nominal_datatype lam = Var "name" @@ -12,53 +11,27 @@ thm lam.distinct thm lam.induct -thm lam.exhaust +thm lam.exhaust lam.strong_exhaust thm lam.fv_defs thm lam.bn_defs thm lam.perm_simps thm lam.eq_iff -thm lam.eq_iff[folded alphas] thm lam.fv_bn_eqvt thm lam.size_eqvt -section {* Strong Exhausts Lemma and Strong Induction Lemma via Induct_schema *} - -lemma strong_exhaust: - fixes c::"'a::fs" - assumes "\name. \y = Var name\ \ P" - and "\lam1 lam2. \y = App lam1 lam2\ \ P" - and "\name lam. \atom name \ c; y = Lam name lam\ \ P" - shows "P" -apply(rule_tac y="y" in lam.exhaust) -apply(rule assms(1)) -apply(assumption) -apply(rule assms(2)) -apply(assumption) -apply(subgoal_tac "\q. (q \ (atom name)) \ c \ supp (Lam name lam) \* q") -apply(erule exE) -apply(erule conjE) -apply(rule assms(3)) -apply(simp add: atom_eqvt) -apply(clarify) -apply(drule supp_perm_eq[symmetric]) -apply(simp) -apply(rule at_set_avoiding2_atom) -apply(simp add: finite_supp) -apply(simp add: finite_supp) -apply(simp add: lam.fresh) -done +section {* Strong Induction Lemma via Induct_schema *} lemma strong_induct: fixes c::"'a::fs" assumes a1: "\name c. P c (Var name)" and a2: "\lam1 lam2 c. \\d. P d lam1; \d. P d lam2\ \ P c (App lam1 lam2)" - and a3: "\name lam c. \atom name \ c; \d. P d lam\ \ P c (Lam name lam)" + and a3: "\name lam c. \{atom name} \* c; \d. P d lam\ \ P c (Lam name lam)" shows "P c lam" using assms apply(induction_schema) -apply(rule_tac y="lam" in strong_exhaust) +apply(rule_tac y="lam" in lam.strong_exhaust) apply(blast) apply(blast) apply(blast) @@ -66,99 +39,6 @@ apply(simp_all add: lam.size) done -section {* Strong Induction Principles*} - -(* - Old way of establishing strong induction - principles by chosing a fresh name. -*) -(* -lemma - fixes c::"'a::fs" - assumes a1: "\name c. P c (Var name)" - and a2: "\lam1 lam2 c. \\d. P d lam1; \d. P d lam2\ \ P c (App lam1 lam2)" - and a3: "\name lam c. \atom name \ c; \d. P d lam\ \ P c (Lam name lam)" - shows "P c lam" -proof - - have "\p. P c (p \ lam)" - apply(induct lam arbitrary: c rule: lam.induct) - apply(perm_simp) - apply(rule a1) - apply(perm_simp) - apply(rule a2) - apply(assumption) - apply(assumption) - apply(subgoal_tac "\new::name. (atom new) \ (c, Lam (p \ name) (p \ lam))") - defer - apply(simp add: fresh_def) - apply(rule_tac X="supp (c, Lam (p \ name) (p \ lam))" in obtain_at_base) - apply(simp add: supp_Pair finite_supp) - apply(blast) - apply(erule exE) - apply(rule_tac t="p \ Lam name lam" and - s="(((p \ name) \ new) + p) \ Lam name lam" in subst) - apply(simp del: lam.perm) - apply(subst lam.perm) - apply(subst (2) lam.perm) - apply(rule flip_fresh_fresh) - apply(simp add: fresh_def) - apply(simp only: supp_fn') - apply(simp) - apply(simp add: fresh_Pair) - apply(simp) - apply(rule a3) - apply(simp add: fresh_Pair) - apply(drule_tac x="((p \ name) \ new) + p" in meta_spec) - apply(simp) - done - then have "P c (0 \ lam)" by blast - then show "P c lam" by simp -qed -*) -(* - New way of establishing strong induction - principles by using a appropriate permutation. -*) -(* -lemma - fixes c::"'a::fs" - assumes a1: "\name c. P c (Var name)" - and a2: "\lam1 lam2 c. \\d. P d lam1; \d. P d lam2\ \ P c (App lam1 lam2)" - and a3: "\name lam c. \atom name \ c; \d. P d lam\ \ P c (Lam name lam)" - shows "P c lam" -proof - - have "\p. P c (p \ lam)" - apply(induct lam arbitrary: c rule: lam.induct) - apply(perm_simp) - apply(rule a1) - apply(perm_simp) - apply(rule a2) - apply(assumption) - apply(assumption) - apply(subgoal_tac "\q. (q \ {p \ atom name}) \* c \ supp (p \ Lam name lam) \* q") - apply(erule exE) - apply(rule_tac t="p \ Lam name lam" and - s="q \ p \ Lam name lam" in subst) - defer - apply(simp) - apply(rule a3) - apply(simp add: eqvts fresh_star_def) - apply(drule_tac x="q + p" in meta_spec) - apply(simp) - apply(rule at_set_avoiding2) - apply(simp add: finite_supp) - apply(simp add: finite_supp) - apply(simp add: finite_supp) - apply(perm_simp) - apply(simp add: fresh_star_def fresh_def supp_fn') - apply(rule supp_perm_eq) - apply(simp) - done - then have "P c (0 \ lam)" by blast - then show "P c lam" by simp -qed -*) - section {* Typing *} nominal_datatype ty =