Modified abs_gen_sym and abs_gen_trans so it becomes usable in the proofs.
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Fri, 26 Mar 2010 22:22:41 +0100
changeset 1664 aa999d263b10
parent 1660 d1293d30c657
child 1665 d00dd828f7af
Modified abs_gen_sym and abs_gen_trans so it becomes usable in the proofs.
Nominal/Abs.thy
Nominal/Manual/Term5.thy
Nominal/Manual/Term5n.thy
--- a/Nominal/Abs.thy	Fri Mar 26 17:22:17 2010 +0100
+++ b/Nominal/Abs.thy	Fri Mar 26 22:22:41 2010 +0100
@@ -587,24 +587,36 @@
   by (simp_all add: fresh_zero_perm)
 
 lemma alpha_gen_sym:
-  assumes a: "R (p \<bullet> x) y \<Longrightarrow> R (- p \<bullet> y) x"
+  assumes a: "R (p \<bullet> x) y \<Longrightarrow> R y (p \<bullet> x)"
+  and     b: "\<And>x y p. R x y \<Longrightarrow> R (p \<bullet> x) (p \<bullet> y)"
   shows "(bs, x) \<approx>gen R f p (cs, y) \<Longrightarrow> (cs, y) \<approx>gen R f (- p) (bs, x)"
   and   "(bs, x) \<approx>res R f p (cs, y) \<Longrightarrow> (cs, y) \<approx>res R f (- p) (bs, x)"
   and   "(ds, x) \<approx>lst R f p (es, y) \<Longrightarrow> (es, y) \<approx>lst R f (- p) (ds, x)"
+  unfolding alphas fresh_star_def
+  apply (erule_tac [1] conjE)+
+  apply (erule_tac [2] conjE)+
+  apply (erule_tac [3] conjE)+
   using a
-  unfolding alphas
-  unfolding fresh_star_def
-  by (auto simp add:  fresh_minus_perm)
-
+  apply (simp_all add: fresh_minus_perm)
+  apply (rotate_tac [!] -1)
+  apply (drule_tac [!] p="-p" in b)
+  apply (simp_all)
+  apply (metis permute_minus_cancel(2))
+  apply (metis permute_minus_cancel(2))
+  done
 lemma alpha_gen_trans:
-  assumes a: "\<lbrakk>R (p \<bullet> x) y; R (q \<bullet> y) z\<rbrakk> \<Longrightarrow> R ((q + p) \<bullet> x) z"
+  assumes a: "(\<forall>c. R y c \<longrightarrow> R (p \<bullet> x) c)"
+  and b: "R (p \<bullet> x) y"
+  and c: "R (q \<bullet> y) z"
+  and d: "\<And>x y p. R x y \<Longrightarrow> R (p \<bullet> x) (p \<bullet> y)"
   shows "\<lbrakk>(bs, x) \<approx>gen R f p (cs, y); (cs, y) \<approx>gen R f q (ds, z)\<rbrakk> \<Longrightarrow> (bs, x) \<approx>gen R f (q + p) (ds, z)"
   and   "\<lbrakk>(bs, x) \<approx>res R f p (cs, y); (cs, y) \<approx>res R f q (ds, z)\<rbrakk> \<Longrightarrow> (bs, x) \<approx>res R f (q + p) (ds, z)"
   and   "\<lbrakk>(es, x) \<approx>lst R f p (gs, y); (gs, y) \<approx>lst R f q (hs, z)\<rbrakk> \<Longrightarrow> (es, x) \<approx>lst R f (q + p) (hs, z)"
-  using a 
   unfolding alphas
   unfolding fresh_star_def
-  by (simp_all add: fresh_plus_perm)
+  apply (simp_all add: fresh_plus_perm)
+  apply (metis a c d permute_minus_cancel(2))+
+  done
 
 lemma alpha_gen_eqvt:
   assumes a: "R (q \<bullet> x) y \<Longrightarrow> R (p \<bullet> (q \<bullet> x)) (p \<bullet> y)"
--- a/Nominal/Manual/Term5.thy	Fri Mar 26 17:22:17 2010 +0100
+++ b/Nominal/Manual/Term5.thy	Fri Mar 26 22:22:41 2010 +0100
@@ -1,5 +1,5 @@
 theory Term5
-imports "Nominal2_Atoms" "Nominal2_Eqvt" "Nominal2_Supp" "Abs" "Perm" "Fv" "Rsp" "../Attic/Prove"
+imports "../Nominal2_Atoms" "../Nominal2_Eqvt" "../Nominal2_Supp" "../Abs" "../Perm" "../Fv" "../Rsp"
 begin
 
 atom_decl name
@@ -23,7 +23,7 @@
 print_theorems
 
 local_setup {* snd o define_fv_alpha (Datatype.the_info @{theory} "Term5.rtrm5")
-  [[[], [], [(SOME (@{term rbv5}, true), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [0, 2]])] *}
+  [[[], [], [(SOME (@{term rbv5}, true), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [(0,NONE), (2,SOME @{term rbv5})]])] *}
 print_theorems
 
 notation
@@ -31,7 +31,7 @@
   alpha_rlts ("_ \<approx>l _" [100, 100] 100)
 thm alpha_rtrm5_alpha_rlts_alpha_rbv5.intros
 
-local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_alpha_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *}
+local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_rel_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *}
 thm alpha5_inj
 
 lemma rbv5_eqvt[eqvt]:
@@ -71,7 +71,17 @@
 "(a \<approx>5 b \<longrightarrow> b \<approx>5 a) \<and>
 (x \<approx>l y \<longrightarrow> y \<approx>l x) \<and>
 (alpha_rbv5 x y \<longrightarrow> alpha_rbv5 y x)"
-apply (tactic {* symp_tac @{thm alpha_rtrm5_alpha_rlts_alpha_rbv5.induct} @{thms alpha5_inj} @{thms alpha5_eqvt} @{context} 1 *})
+apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct)
+apply (simp_all add: alpha5_inj)
+apply (erule exE)
+apply (rule_tac x="-pi" in exI)
+apply (rule alpha_gen_sym)
+apply (simp_all add: alphas)
+apply (case_tac x)
+apply (case_tac y)
+apply (simp add: alpha5_eqvt)
+apply clarify
+apply simp
 done
 
 lemma alpha5_symp1:
--- a/Nominal/Manual/Term5n.thy	Fri Mar 26 17:22:17 2010 +0100
+++ b/Nominal/Manual/Term5n.thy	Fri Mar 26 22:22:41 2010 +0100
@@ -1,5 +1,5 @@
 theory Term5
-imports "Nominal2_Atoms" "Nominal2_Eqvt" "Nominal2_Supp" "Abs" "Perm" "Fv" "Rsp" "../Attic/Prove"
+imports "../Nominal2_Atoms" "../Nominal2_Eqvt" "../Nominal2_Supp" "../Abs" "../Perm" "../Fv" "../Rsp"
 begin
 
 atom_decl name
@@ -23,7 +23,7 @@
 print_theorems
 
 local_setup {* snd o define_fv_alpha (Datatype.the_info @{theory} "Term5.rtrm5")
-  [[[], [], [(SOME (@{term rbv5}, false), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [0, 2]])] *}
+  [[[], [], [(SOME (@{term rbv5}, false), 0, 1)]], [[], []]] [(@{term rbv5}, 1, [[], [(0,NONE), (2,SOME @{term rbv5})]])] *}
 print_theorems
 
 notation
@@ -31,7 +31,7 @@
   alpha_rlts ("_ \<approx>l _" [100, 100] 100)
 thm alpha_rtrm5_alpha_rlts_alpha_rbv5.intros
 
-local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_alpha_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *}
+local_setup {* (fn ctxt => snd (Local_Theory.note ((@{binding alpha5_inj}, []), (build_rel_inj @{thms alpha_rtrm5_alpha_rlts_alpha_rbv5.intros} @{thms rtrm5.distinct rtrm5.inject rlts.distinct rlts.inject} @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} ctxt)) ctxt)) *}
 thm alpha5_inj
 
 lemma rbv5_eqvt[eqvt]:
@@ -65,13 +65,45 @@
 "(a \<approx>5 b \<longrightarrow> b \<approx>5 a) \<and>
 (x \<approx>l y \<longrightarrow> y \<approx>l x) \<and>
 (alpha_rbv5 x y \<longrightarrow> alpha_rbv5 y x)"
-sorry
+apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct)
+apply (simp_all add: alpha5_inj)
+apply (erule conjE)+
+apply (erule exE)
+apply (rule_tac x="-pi" in exI)
+apply (rule alpha_gen_sym)
+apply (simp add: alphas)
+apply (simp add: alpha5_eqvt)
+apply (simp add: alphas)
+apply clarify
+apply simp
+done
 
 lemma alpha5_transp:
 "(a \<approx>5 b \<longrightarrow> (\<forall>c. b \<approx>5 c \<longrightarrow> a \<approx>5 c)) \<and>
 (x \<approx>l y \<longrightarrow> (\<forall>z. y \<approx>l z \<longrightarrow> x \<approx>l z)) \<and>
 (alpha_rbv5 k l \<longrightarrow> (\<forall>m. alpha_rbv5 l m \<longrightarrow> alpha_rbv5 k m))"
-sorry
+apply (rule alpha_rtrm5_alpha_rlts_alpha_rbv5.induct)
+apply (rule_tac [!] allI)
+apply (simp_all add: alpha5_inj)
+apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *})
+apply (simp_all add: alpha5_inj)
+defer
+apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *})
+apply (simp_all add: alpha5_inj)
+apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *})
+apply (simp_all add: alpha5_inj)
+apply (tactic {* (imp_elim_tac @{thms alpha_rtrm5.cases alpha_rlts.cases alpha_rbv5.cases} @{context}) 1 *})
+apply (simp_all add: alpha5_inj)
+apply (erule conjE)+
+apply (erule exE)+
+apply (rule_tac x="pi + pia" in exI)
+apply (rule alpha_gen_trans)
+prefer 6
+apply assumption
+apply (simp_all add: alphas alpha5_eqvt)
+apply (clarify)
+apply simp
+done
 
 lemma alpha5_equivp:
   "equivp alpha_rtrm5"