diff -r 99134763d03e -r d73d4d151cce Nominal/Ex/SingleLet.thy --- a/Nominal/Ex/SingleLet.thy Thu Jul 15 09:40:05 2010 +0100 +++ b/Nominal/Ex/SingleLet.thy Fri Jul 16 02:38:19 2010 +0100 @@ -29,17 +29,154 @@ term bn term fv_trm +lemma a1: + shows "alpha_trm_raw x1 y1 \ True" + and "alpha_assg_raw x2 y2 \ alpha_bn_raw x2 y2" + and "alpha_bn_raw x3 y3 \ True" +apply(induct rule: alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.inducts) +apply(simp_all) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(assumption) +done + +lemma a2: + shows "alpha_trm_raw x1 y1 \ fv_trm_raw x1 = fv_trm_raw y1" + and "alpha_assg_raw x2 y2 \ fv_assg_raw x2 = fv_assg_raw y2 \ bn_raw x2 = bn_raw y2" + and "alpha_bn_raw x3 y3 \ fv_bn_raw x3 = fv_bn_raw y3" +apply(induct rule: alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.inducts) +apply(simp_all add: alphas a1 prod_alpha_def) +apply(auto) +done + lemma [quot_respect]: - "(op = ===> alpha_trm_raw) Var_raw Var_raw" + "(op= ===> alpha_trm_raw) Var_raw Var_raw" "(alpha_trm_raw ===> alpha_trm_raw ===> alpha_trm_raw) App_raw App_raw" + "(op= ===> alpha_trm_raw ===> alpha_trm_raw) Lam_raw Lam_raw" + "(alpha_assg_raw ===> alpha_trm_raw ===> alpha_trm_raw) Let_raw Let_raw" + "(op= ===> op= ===> alpha_trm_raw ===> alpha_trm_raw ===> alpha_trm_raw ===> alpha_trm_raw) + Foo_raw Foo_raw" + "(op= ===> op= ===> alpha_trm_raw ===> alpha_trm_raw) Bar_raw Bar_raw" + "(op= ===> alpha_trm_raw ===> alpha_trm_raw ===> alpha_trm_raw) Baz_raw Baz_raw" + "(op = ===> op = ===> alpha_trm_raw ===> alpha_assg_raw) As_raw As_raw" apply(auto) apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) apply(rule refl) apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) apply(assumption) apply(assumption) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2) +apply(simp add: a1) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2 prod_alpha_def) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2 prod_alpha_def) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2 prod_alpha_def) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2 prod_alpha_def) +apply(rule alpha_trm_raw_alpha_assg_raw_alpha_bn_raw.intros) +apply(rule_tac x="0" in exI) +apply(simp add: alphas fresh_star_def fresh_zero_perm a2 prod_alpha_def) +apply(rule refl) done +lemma [quot_respect]: + "(alpha_trm_raw ===> op =) fv_trm_raw fv_trm_raw" + "(alpha_assg_raw ===> op =) fv_bn_raw fv_bn_raw" + "(alpha_assg_raw ===> op =) bn_raw bn_raw" + "(alpha_assg_raw ===> op =) fv_assg_raw fv_assg_raw" + "(op = ===> alpha_trm_raw ===> alpha_trm_raw) permute permute" +apply(simp_all add: a2 a1) +sorry + +ML {* + val thms_d = map (lift_thm [@{typ trm}, @{typ assg}] @{context}) @{thms distinct} +*} + +ML {* + val thms_i = map (lift_thm [@{typ trm}, @{typ assg}] @{context}) @{thms trm_raw_assg_raw.inducts} +*} + +ML {* + val thms_f = map (lift_thm [@{typ trm}, @{typ assg}] @{context}) @{thms fv_defs} +*} + +thm perm_defs[no_vars] + +instance trm :: pt sorry +instance assg :: pt sorry + +lemma + "p \ Var name = Var (p \ name)" + "p \ App trm1 trm2 = App (p \ trm1) (p \ trm2)" + "p \ Lam name trm = Lam (p \ name) (p \ trm)" + "p \ Let assg trm = Let (p \ assg) (p \ trm)" + "p \ Foo name1 name2 trm1 trm2 trm3 = + Foo (p \ name1) (p \ name2) (p \ trm1) (p \ trm2) (p \ trm3)" + "p \ Bar name1 name2 trm = Bar (p \ name1) (p \ name2) (p \ trm)" + "p \ Baz name trm1 trm2 = Baz (p \ name) (p \ trm1) (p \ trm2)" + "p \ As name1 name2 trm = As (p \ name1) (p \ name2) (p \ trm)" +sorry + + +(* +ML {* + val thms_p = map (lift_thm [@{typ trm}, @{typ assg}] @{context}) @{thms perm_defs} +*} +*) + +local_setup {* Local_Theory.note ((@{binding d1}, []), thms_d) #> snd *} +local_setup {* Local_Theory.note ((@{binding i1}, []), thms_i) #> snd *} +local_setup {* Local_Theory.note ((@{binding f1}, []), thms_f) #> snd *} + +thm perm_defs +thm perm_simps + +instance trm :: pt sorry +instance assg :: pt sorry + +lemma supp_fv: + "supp t = fv_trm t" + "supp b = fv_bn b" +apply(induct t and b rule: i1) +apply(simp_all add: f1) +apply(simp_all add: supp_def) +apply(simp add: supp_def permute_trm1 alpha1_INJ fv_trm1) +apply(simp only: supp_at_base[simplified supp_def]) +apply(simp add: supp_def permute_trm1 alpha1_INJ fv_trm1) +apply(simp add: Collect_imp_eq Collect_neg_eq Un_commute) +apply(subgoal_tac "supp (Lm1 name rtrm1) = supp (Abs {atom name} rtrm1)") +apply(simp add: supp_Abs fv_trm1) +apply(simp (no_asm) add: supp_def permute_set_eq atom_eqvt permute_trm1) +apply(simp add: alpha1_INJ) +apply(simp add: Abs_eq_iff) +apply(simp add: alpha_gen.simps) +apply(simp add: supp_eqvt[symmetric] fv_trm1_eqvt[symmetric]) +apply(simp add: supp_fv_let fv_trm1 fv_eq_bv supp_Pair) +apply blast +apply(simp add: supp_def permute_trm1 alpha1_INJ fv_trm1) +apply(simp add: supp_def permute_trm1 alpha1_INJ fv_trm1) +apply(simp only: supp_at_base[simplified supp_def]) +apply(simp (no_asm) only: supp_def permute_set_eq atom_eqvt permute_trm1 alpha1_INJ[simplified alpha_bp_eq]) +apply(simp add: Collect_imp_eq Collect_neg_eq[symmetric]) +apply(fold supp_def) +apply simp +done + +ML {* + map (lift_thm [@{typ trm}, @{typ assg}] @{context}) @{thms eq_iff} +*} + + + lemma "Var x \ App y1 y2"