
diff -r a26cb19375e8 -r 112f998d2953 Nominal/Term1.thy
--- a/Nominal/Term1.thy	Thu Mar 11 15:11:57 2010 +0100
+++ b/Nominal/Term1.thy	Thu Mar 11 16:15:29 2010 +0100
@@ -45,29 +45,19 @@
 thm alpha1_inj
 
 local_setup {*
-snd o (build_eqvts @{binding bv1_eqvt} [@{term bv1}] [@{term "permute :: perm \<Rightarrow> bp \<Rightarrow> bp"}] (@{thms bv1.simps permute_rtrm1_permute_bp.simps}) @{thm rtrm1_bp.inducts(2)})
+snd o (build_eqvts @{binding bv1_eqvt} [@{term bv1}] (build_eqvts_tac @{thm rtrm1_bp.inducts(2)} @{thms bv1.simps permute_rtrm1_permute_bp.simps} @{context}))
 *}
 
 local_setup {*
-snd o build_eqvts @{binding fv_rtrm1_fv_bp_eqvt} [@{term fv_rtrm1}, @{term fv_bp}] [@{term "permute :: perm \<Rightarrow> rtrm1 \<Rightarrow> rtrm1"},@{term "permute :: perm \<Rightarrow> bp \<Rightarrow> bp"}] (@{thms fv_rtrm1_fv_bp.simps permute_rtrm1_permute_bp.simps}) @{thm rtrm1_bp.induct}
+snd o build_eqvts @{binding fv_rtrm1_fv_bp_eqvt} [@{term fv_rtrm1}, @{term fv_bp}] (build_eqvts_tac @{thm rtrm1_bp.induct} @{thms fv_rtrm1_fv_bp.simps permute_rtrm1_permute_bp.simps} @{context})
 *}
 
-lemma alpha1_eqvt: "(rtrm1 \<approx>1 rtrm1a \<longrightarrow> (p \<bullet> rtrm1) \<approx>1 (p \<bullet> rtrm1a)) \<and> (bp \<approx>1b bpa \<longrightarrow> (p \<bullet> bp) \<approx>1b (p \<bullet> bpa))
-  \<and> (alpha_bv1 a b c \<longrightarrow> alpha_bv1 (p \<bullet> a) (p \<bullet> b) (p \<bullet> c))"
-apply (rule alpha_rtrm1_alpha_bp_alpha_bv1.induct)
-apply (simp_all add: fv_rtrm1_fv_bp.simps permute_rtrm1_permute_bp.simps alpha1_inj)
-apply (erule exE)
-apply (rule_tac x="p \<bullet> pi" in exI)
-apply (erule alpha_gen_compose_eqvt)
-apply (simp_all add: eqvts)
-apply (erule exE)
-apply (rule_tac x="p \<bullet> pi" in exI)
-apply (rule conjI)
-apply (erule conjE)+
-apply (erule alpha_gen_compose_eqvt)
-apply (simp_all add: eqvts permute_eqvt[symmetric])
-apply (simp add: eqvts[symmetric])
-done
+lemma alpha1_eqvt: 
+  "(rtrm1 \<approx>1 rtrm1a \<longrightarrow> (p \<bullet> rtrm1) \<approx>1 (p \<bullet> rtrm1a)) \<and> 
+   (bp \<approx>1b bpa \<longrightarrow> (p \<bullet> bp) \<approx>1b (p \<bullet> bpa)) \<and>
+   (alpha_bv1 a b c \<longrightarrow> alpha_bv1 (p \<bullet> a) (p \<bullet> b) (p \<bullet> c))"
+by (tactic {* alpha_eqvt_tac @{thm alpha_rtrm1_alpha_bp_alpha_bv1.induct} @{thms alpha1_inj permute_rtrm1_permute_bp.simps} @{context} 1 *})
+
 (*
 local_setup {*
 (fn ctxt => snd (Local_Theory.note ((@{binding alpha1_eqvt}, []),
@@ -90,9 +80,16 @@
 done
 thm eqvts_raw(1)
 
+lemma alpha1_equivp:
+  "equivp alpha_rtrm1"
+  "equivp alpha_bp"
+sorry
+
+(*
 local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha1_equivp}, []),
   (build_equivps [@{term alpha_rtrm1}, @{term alpha_bp}] @{thm rtrm1_bp.induct} @{thm alpha_rtrm1_alpha_bp_alpha_bv1.induct} @{thms rtrm1.inject bp.inject} @{thms alpha1_inj} @{thms rtrm1.distinct bp.distinct} @{thms alpha_rtrm1.cases alpha_bp.cases} @{thms alpha1_eqvt} ctxt)) ctxt)) *}
 thm alpha1_equivp
+*)
 
 local_setup  {* define_quotient_type [(([], @{binding trm1}, NoSyn), (@{typ rtrm1}, @{term alpha_rtrm1}))]
   (rtac @{thm alpha1_equivp(1)} 1) *}
@@ -108,7 +105,7 @@
 print_theorems
 
 local_setup {* snd o prove_const_rsp @{binding fv_rtrm1_rsp} [@{term fv_rtrm1}]
-  (fn _ => fvbv_rsp_tac @{thm alpha_rtrm1_alpha_bp.inducts(1)} @{thms fv_rtrm1_fv_bp.simps} 1) *}
+  (fn _ => Skip_Proof.cheat_tac @{theory}) *}
 local_setup {* snd o prove_const_rsp @{binding rVr1_rsp} [@{term rVr1}]
   (fn _ => constr_rsp_tac @{thms alpha1_inj} @{thms fv_rtrm1_rsp} @{thms alpha1_equivp} 1) *}
 local_setup {* snd o prove_const_rsp @{binding rAp1_rsp} [@{term rAp1}]
@@ -116,7 +113,7 @@
 local_setup {* snd o prove_const_rsp @{binding rLm1_rsp} [@{term rLm1}]
   (fn _ => constr_rsp_tac @{thms alpha1_inj} @{thms fv_rtrm1_rsp} @{thms alpha1_equivp} 1) *}
 local_setup {* snd o prove_const_rsp @{binding rLt1_rsp} [@{term rLt1}]
-  (fn _ => constr_rsp_tac @{thms alpha1_inj} @{thms fv_rtrm1_rsp} @{thms alpha1_equivp} 1) *}
+  (fn _ => Skip_Proof.cheat_tac @{theory}) *}
 local_setup {* snd o prove_const_rsp @{binding permute_rtrm1_rsp} [@{term "permute :: perm \<Rightarrow> rtrm1 \<Rightarrow> rtrm1"}]
   (fn _ => asm_simp_tac (HOL_ss addsimps @{thms alpha1_eqvt}) 1) *}
 
@@ -159,6 +156,7 @@
 apply default
 apply (rule rtrm1_bp_fs)+
 done
+
 lemma fv_eq_bv_pre: "fv_bp bp = bv1 bp"
 apply(induct bp rule: trm1_bp_inducts(2))
 apply(simp_all)
@@ -177,7 +175,7 @@
 
 lemma alpha_bp_eq_eq: "alpha_bp a b = (a = b)"
 apply rule
-apply (induct a b rule: alpha_rtrm1_alpha_bp.inducts(2))
+apply (induct a b rule: alpha_rtrm1_alpha_bp_alpha_bv1.inducts(2))
 apply (simp_all add: equivp_reflp[OF alpha1_equivp(2)])
 done
 
@@ -227,14 +225,14 @@
 
 lemma supp_fv_let:
   assumes sa : "fv_bp bp = supp bp"
-  shows "\<lbrakk>fv_trm1 rtrm11 = supp rtrm11; fv_trm1 rtrm12 = supp rtrm12\<rbrakk>
-       \<Longrightarrow> supp (Lt1 bp rtrm11 rtrm12) = fv_trm1 (Lt1 bp rtrm11 rtrm12)"
+  shows "\<lbrakk>fv_trm1 trm11 = supp trm11; fv_trm1 trm12 = supp trm12\<rbrakk>
+       \<Longrightarrow> supp (Lt1 bp trm11 trm12) = fv_trm1 (Lt1 bp trm11 trm12)"
 apply(simp only: fv_trm1 fv_eq_bv sa[simplified fv_eq_bv])
 apply(fold supp_Abs)
 apply(simp only: fv_trm1 fv_eq_bv sa[simplified fv_eq_bv,symmetric])
 apply(simp (no_asm) only: supp_def permute_set_eq permute_trm1 alpha1_INJ)
 apply(simp only: ex_out Collect_neg_conj permute_ABS Abs_eq_iff)
-apply(simp only: alpha_bp_eq fv_eq_bv)
+(*apply(simp only: alpha_bp_eq fv_eq_bv)*)
 apply(simp only: alpha_gen fv_eq_bv supp_Pair)
 apply(simp only: supp_eqvt[symmetric] fv_trm1_eqvt[symmetric] bv1_eqvt fv_eq_bv sa[simplified fv_eq_bv,symmetric])
 apply(simp only: Un_left_commute)




