# HG changeset patch # User Cezary Kaliszyk # Date 1273675150 -7200 # Node ID 9b109ef7bf471bf790d2d8470943d52cb0bc35a6 # Parent 3201a8c3456b0312ac5e93a26d81583bad0b5e0a Move alpha_eqvt to unused. diff -r 3201a8c3456b -r 9b109ef7bf47 Nominal/NewParser.thy --- a/Nominal/NewParser.thy Wed May 12 16:32:44 2010 +0200 +++ b/Nominal/NewParser.thy Wed May 12 16:39:10 2010 +0200 @@ -275,7 +275,6 @@ end *} -ML {* val cheat_alpha_eqvt = Unsynchronized.ref false *} ML {* val cheat_equivp = Unsynchronized.ref false *} ML {* val cheat_fv_rsp = Unsynchronized.ref false *} ML {* val cheat_alpha_bn_rsp = Unsynchronized.ref false *} diff -r 3201a8c3456b -r 9b109ef7bf47 Nominal/Rsp.thy --- a/Nominal/Rsp.thy Wed May 12 16:32:44 2010 +0200 +++ b/Nominal/Rsp.thy Wed May 12 16:39:10 2010 +0200 @@ -86,51 +86,6 @@ )) *} - -lemma exi: "\(pi :: perm). P pi \ (\(p :: perm). P p \ Q (pi \ p)) \ \pi. Q pi" -apply (erule exE) -apply (rule_tac x="pi \ pia" in exI) -by auto - - -ML {* -fun alpha_eqvt_tac induct simps ctxt = - rtac induct THEN_ALL_NEW - simp_tac (HOL_basic_ss addsimps simps) THEN_ALL_NEW split_conj_tac THEN_ALL_NEW - REPEAT o etac @{thm exi[of _ _ "p"]} THEN' split_conj_tac THEN_ALL_NEW - asm_full_simp_tac (HOL_ss addsimps (all_eqvts ctxt @ simps)) THEN_ALL_NEW - asm_full_simp_tac (HOL_ss addsimps - @{thms supp_eqvt[symmetric] inter_eqvt[symmetric] empty_eqvt alphas prod_rel.simps prod_fv.simps}) THEN_ALL_NEW - (split_conj_tac THEN_ALL_NEW TRY o resolve_tac - @{thms fresh_star_permute_iff[of "- p", THEN iffD1] permute_eq_iff[of "- p", THEN iffD1]}) - THEN_ALL_NEW - asm_full_simp_tac (HOL_ss addsimps (@{thms split_conv permute_minus_cancel permute_plus permute_eqvt[symmetric]} @ all_eqvts ctxt @ simps)) -*} - -ML {* -fun build_alpha_eqvt alpha names = -let - val pi = Free ("p", @{typ perm}); - val (tys, _) = strip_type (fastype_of alpha) - val indnames = Name.variant_list names (Datatype_Prop.make_tnames (map body_type tys)); - val args = map Free (indnames ~~ tys); - val perm_args = map (fn x => mk_perm pi x) args -in - (HOLogic.mk_imp (list_comb (alpha, args), list_comb (alpha, perm_args)), indnames @ names) -end -*} - -ML {* -fun build_alpha_eqvts funs tac ctxt = -let - val (gls, names) = fold_map build_alpha_eqvt funs ["p"] - val gl = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj gls) - val thm = Goal.prove ctxt names [] gl tac -in - map (fn x => mp OF [x]) (HOLogic.conj_elims thm) -end -*} - ML {* fun prove_fv_rsp fv_alphas_lst all_alphas tac ctxt = let diff -r 3201a8c3456b -r 9b109ef7bf47 Nominal/Unused.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Nominal/Unused.thy Wed May 12 16:39:10 2010 +0200 @@ -0,0 +1,43 @@ +lemma exi: "\(pi :: perm). P pi \ (\(p :: perm). P p \ Q (pi \ p)) \ \pi. Q pi" +apply (erule exE) +apply (rule_tac x="pi \ pia" in exI) +by auto + +ML {* +fun alpha_eqvt_tac induct simps ctxt = + rtac induct THEN_ALL_NEW + simp_tac (HOL_basic_ss addsimps simps) THEN_ALL_NEW split_conj_tac THEN_ALL_NEW + REPEAT o etac @{thm exi[of _ _ "p"]} THEN' split_conj_tac THEN_ALL_NEW + asm_full_simp_tac (HOL_ss addsimps (all_eqvts ctxt @ simps)) THEN_ALL_NEW + asm_full_simp_tac (HOL_ss addsimps + @{thms supp_eqvt[symmetric] inter_eqvt[symmetric] empty_eqvt alphas prod_rel.simps prod_fv.simps}) THEN_ALL_NEW + (split_conj_tac THEN_ALL_NEW TRY o resolve_tac + @{thms fresh_star_permute_iff[of "- p", THEN iffD1] permute_eq_iff[of "- p", THEN iffD1]}) + THEN_ALL_NEW + asm_full_simp_tac (HOL_ss addsimps (@{thms split_conv permute_minus_cancel permute_plus permute_eqvt[symmetric]} @ all_eqvts ctxt @ simps)) +*} + +ML {* +fun build_alpha_eqvt alpha names = +let + val pi = Free ("p", @{typ perm}); + val (tys, _) = strip_type (fastype_of alpha) + val indnames = Name.variant_list names (Datatype_Prop.make_tnames (map body_type tys)); + val args = map Free (indnames ~~ tys); + val perm_args = map (fn x => mk_perm pi x) args +in + (HOLogic.mk_imp (list_comb (alpha, args), list_comb (alpha, perm_args)), indnames @ names) +end +*} + +ML {* +fun build_alpha_eqvts funs tac ctxt = +let + val (gls, names) = fold_map build_alpha_eqvt funs ["p"] + val gl = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj gls) + val thm = Goal.prove ctxt names [] gl tac +in + map (fn x => mp OF [x]) (HOLogic.conj_elims thm) +end +*} +