export the reflp and symp tacs.
authorCezary Kaliszyk <kaliszyk@in.tum.de>
Mon, 22 Feb 2010 15:09:53 +0100
changeset 1211 05e5fcf9840b
parent 1210 10a0e3578507
child 1212 5a60977f932b
export the reflp and symp tacs.
Quot/Nominal/Terms.thy
--- a/Quot/Nominal/Terms.thy	Mon Feb 22 15:03:48 2010 +0100
+++ b/Quot/Nominal/Terms.thy	Mon Feb 22 15:09:53 2010 +0100
@@ -116,24 +116,30 @@
   apply(simp add: permute_eqvt[symmetric])
   done
 
-prove alpha1_reflp_aux: {* fst (build_alpha_refl_gl [@{term alpha_rtrm1}, @{term alpha_bp}]) *}
-by (tactic {*
-
- (indtac @{thm rtrm1_bp.induct} ["x", "x"] THEN_ALL_NEW
-  asm_full_simp_tac (HOL_ss addsimps @{thms alpha1_inj}) THEN_ALL_NEW
+ML {*
+fun reflp_tac induct inj =
+  rtac induct THEN_ALL_NEW
+  asm_full_simp_tac (HOL_ss addsimps inj) THEN_ALL_NEW
   TRY o REPEAT_ALL_NEW (CHANGED o rtac @{thm conjI}) THEN_ALL_NEW
   (rtac @{thm exI[of _ "0 :: perm"]} THEN'
-  asm_full_simp_tac (HOL_ss addsimps @{thms alpha_gen fresh_star_def fresh_zero_perm permute_zero ball_triv}))
- ) 1 *})
+   asm_full_simp_tac (HOL_ss addsimps
+     @{thms alpha_gen fresh_star_def fresh_zero_perm permute_zero ball_triv}))
+*}
+
+prove alpha1_reflp_aux: {* fst (build_alpha_refl_gl [@{term alpha_rtrm1}, @{term alpha_bp}]) *}
+by (tactic {* reflp_tac @{thm rtrm1_bp.induct} @{thms alpha1_inj} 1 *})
+
+ML {*
+fun symp_tac induct inj =
+  rtac induct THEN_ALL_NEW
+  asm_full_simp_tac (HOL_ss addsimps inj) THEN_ALL_NEW
+  TRY o REPEAT_ALL_NEW (CHANGED o rtac @{thm conjI}) THEN_ALL_NEW
+  (etac @{thm alpha_gen_compose_sym} THEN'
+   asm_full_simp_tac (HOL_ss addsimps @{thms alpha1_eqvt}))
+*}
 
 prove alpha1_symp_aux: {* (fst o snd) (build_alpha_refl_gl [@{term alpha_rtrm1}, @{term alpha_bp}]) *}
-by (tactic {*
- (rtac @{thm alpha_rtrm1_alpha_bp.induct} THEN_ALL_NEW
-  asm_full_simp_tac (HOL_ss addsimps @{thms alpha1_inj}) THEN_ALL_NEW
-  TRY o REPEAT_ALL_NEW (CHANGED o rtac @{thm conjI}) THEN_ALL_NEW
- (etac @{thm alpha_gen_compose_sym} THEN'
-  asm_full_simp_tac (HOL_ss addsimps @{thms alpha1_eqvt})
- )) 1 *})
+by (tactic {* symp_tac @{thm alpha_rtrm1_alpha_bp.induct} @{thms alpha1_inj} 1 *})
 
 prove alpha1_transp_aux: {* (snd o snd) (build_alpha_refl_gl [@{term alpha_rtrm1}, @{term alpha_bp}]) *}
 apply (rule alpha_rtrm1_alpha_bp.induct)