diff -r 2311a9fc4624 -r b39108f42638 Nominal/Parser.thy --- a/Nominal/Parser.thy Mon Mar 22 10:15:46 2010 +0100 +++ b/Nominal/Parser.thy Mon Mar 22 14:07:07 2010 +0100 @@ -265,13 +265,11 @@ end *} -(* These 2 are critical, we don't know how to do it in term5 *) -ML {* val cheat_fv_rsp = Unsynchronized.ref true *} ML {* val cheat_alpha_bn_rsp = Unsynchronized.ref true *} - ML {* val cheat_equivp = Unsynchronized.ref true *} -(* These 2 are not needed any more *) +(* These 3 are not needed any more *) +ML {* val cheat_fv_rsp = Unsynchronized.ref false *} ML {* val cheat_fv_eqvt = Unsynchronized.ref false *} ML {* val cheat_alpha_eqvt = Unsynchronized.ref false *} @@ -332,7 +330,8 @@ else alpha_eqvt_tac alpha_induct (raw_perm_def @ alpha_eq_iff @ raw_fv_bv_eqvt) lthy6a 1 val alpha_eqvt = build_alpha_eqvts alpha_ts alpha_eqvt_tac' lthy6a; val _ = tracing "Proving equivalence"; - val fv_alpha_all = combine_fv_alpha_bns (fv_ts_nobn, fv_ts_bn) (alpha_ts_nobn, alpha_ts_bn) bn_nos; + val (rfv_ts_nobn, rfv_ts_bn) = chop (length perms) ordered_fv_ts; + val fv_alpha_all = combine_fv_alpha_bns (rfv_ts_nobn, rfv_ts_bn) (alpha_ts_nobn, alpha_ts_bn) bn_nos; val reflps = build_alpha_refl fv_alpha_all induct alpha_eq_iff lthy6a; val alpha_equivp = if !cheat_equivp then map (equivp_hack lthy6a) alpha_ts_nobn @@ -356,11 +355,15 @@ val _ = tracing "Proving respects"; val (bns_rsp_pre, lthy9) = fold_map ( fn (bn_t, i) => prove_const_rsp Binding.empty [bn_t] - (fn _ => fvbv_rsp_tac (nth alpha_inducts i) raw_bn_eqs 1)) bns lthy8; + (fn _ => fvbv_rsp_tac (nth alpha_inducts i) raw_bn_eqs lthy8 1)) bns lthy8; val bns_rsp = flat (map snd bns_rsp_pre); fun fv_rsp_tac _ = if !cheat_fv_rsp then Skip_Proof.cheat_tac thy - else fvbv_rsp_tac alpha_induct fv_def 1; - val ((_, fv_rsp), lthy10) = prove_const_rsp Binding.empty fv_ts fv_rsp_tac lthy9 + else fvbv_rsp_tac alpha_induct fv_def lthy8 1; + val fv_rsps = prove_fv_rsp fv_alpha_all alpha_ts fv_rsp_tac lthy9; + val (fv_rsp_pre, lthy10) = fold_map + (fn fv => fn ctxt => prove_const_rsp Binding.empty [fv] + (fn _ => asm_simp_tac (HOL_ss addsimps fv_rsps) 1) ctxt) fv_ts lthy9; + val fv_rsp = flat (map snd fv_rsp_pre); val (perms_rsp, lthy11) = prove_const_rsp Binding.empty perms (fn _ => asm_simp_tac (HOL_ss addsimps alpha_eqvt) 1) lthy10; val alpha_alphabn = build_alpha_alphabn fv_alpha_all alpha_inducts alpha_eq_iff lthy11;