--- 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 \<Longrightarrow> True"
+  and   "alpha_assg_raw x2 y2 \<Longrightarrow> alpha_bn_raw x2 y2"
+  and   "alpha_bn_raw x3 y3 \<Longrightarrow> 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 \<Longrightarrow> fv_trm_raw x1 = fv_trm_raw y1"
+  and   "alpha_assg_raw x2 y2 \<Longrightarrow> fv_assg_raw x2 = fv_assg_raw y2 \<and> bn_raw x2 = bn_raw y2"
+  and   "alpha_bn_raw x3 y3 \<Longrightarrow>  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 \<bullet> Var name = Var (p \<bullet> name)"
+  "p \<bullet> App trm1 trm2 = App (p \<bullet> trm1) (p \<bullet> trm2)"
+  "p \<bullet> Lam name trm = Lam (p \<bullet> name) (p \<bullet> trm)"
+  "p \<bullet> Let assg trm = Let (p \<bullet> assg) (p \<bullet> trm)"
+  "p \<bullet> Foo name1 name2 trm1 trm2 trm3 =
+     Foo (p \<bullet> name1) (p \<bullet> name2) (p \<bullet> trm1) (p \<bullet> trm2) (p \<bullet> trm3)"
+  "p \<bullet> Bar name1 name2 trm = Bar (p \<bullet> name1) (p \<bullet> name2) (p \<bullet> trm)"
+  "p \<bullet> Baz name trm1 trm2 = Baz (p \<bullet> name) (p \<bullet> trm1) (p \<bullet> trm2)"
+  "p \<bullet> As name1 name2 trm = As (p \<bullet> name1) (p \<bullet> name2) (p \<bullet> 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 \<noteq> App y1 y2"