# HG changeset patch # User Cezary Kaliszyk # Date 1257156926 -3600 # Node ID 68bd5c2a1b96b7e4d450b98ff266328ca017e7c2 # Parent 53d7477a1f94da1a2a0e89abc006c8243a07d4c7 Fixed quotdata_lookup. diff -r 53d7477a1f94 -r 68bd5c2a1b96 FSet.thy --- a/FSet.thy Mon Nov 02 09:47:49 2009 +0100 +++ b/FSet.thy Mon Nov 02 11:15:26 2009 +0100 @@ -343,12 +343,17 @@ apply (atomize(full)) apply (tactic {* tac @{context} 1 *}) *) ML {* val ind_r_r = regularize ind_r_a rty rel rel_eqv rel_refl @{context} *} -ML {* +(* ML {* val rt = build_repabs_term @{context} ind_r_r consts rty qty val rg = Logic.mk_equals ((Thm.prop_of ind_r_r), rt); *} -(*prove rg +prove rg apply(atomize(full)) +ML_prf {* fun r_mk_comb_tac_fset lthy = r_mk_comb_tac lthy rty quot rel_refl trans2 rsp_thms *} +apply (tactic {* (r_mk_comb_tac_fset @{context}) 1 *}) +apply (tactic {* (r_mk_comb_tac_fset @{context}) 1 *}) +apply (tactic {* (r_mk_comb_tac_fset @{context}) 1 *}) + apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_fset @{context}) 1 *}) done*) ML {* val ind_r_t = diff -r 53d7477a1f94 -r 68bd5c2a1b96 LamEx.thy --- a/LamEx.thy Mon Nov 02 09:47:49 2009 +0100 +++ b/LamEx.thy Mon Nov 02 11:15:26 2009 +0100 @@ -240,6 +240,75 @@ *} apply (tactic {* tac @{context} 1 *}) *) ML {* val t_r = regularize t_a rty rel rel_eqv rel_refl @{context} *} +ML {* + val rt = build_repabs_term @{context} t_r consts rty qty + val rg = Logic.mk_equals ((Thm.prop_of t_r), rt); +*} +prove rg +apply(atomize(full)) +ML_prf {* +fun r_mk_comb_tac ctxt rty quot_thm reflex_thm trans_thm rsp_thms = + (FIRST' [ + rtac trans_thm, + LAMBDA_RES_TAC ctxt, + res_forall_rsp_tac ctxt, + res_exists_rsp_tac ctxt, + ( + (simp_tac ((Simplifier.context ctxt HOL_ss) addsimps rsp_thms)) + THEN_ALL_NEW (fn _ => no_tac) + ), + (instantiate_tac @{thm REP_ABS_RSP(1)} ctxt THEN' (RANGE [quotient_tac quot_thm])), + rtac refl, +(* rtac @{thm arg_cong2[of _ _ _ _ "op ="]},*) + (APPLY_RSP_TAC rty ctxt THEN' (RANGE [quotient_tac quot_thm, quotient_tac quot_thm])), + Cong_Tac.cong_tac @{thm cong}, + rtac @{thm ext}, + rtac reflex_thm, + atac, + ( + (simp_tac ((Simplifier.context ctxt HOL_ss) addsimps @{thms FUN_REL.simps})) + THEN_ALL_NEW (fn _ => no_tac) + ), + WEAK_LAMBDA_RES_TAC ctxt + ]); + fun r_mk_comb_tac_lam lthy = r_mk_comb_tac lthy rty quot rel_refl trans2 rsp_thms +*} +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +prefer 2 +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* REPEAT_ALL_NEW (r_mk_comb_tac_lam @{context}) 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) +apply (tactic {* r_mk_comb_tac_lam @{context} 1 *}) + + ML {* val t_t = repabs @{context} t_r consts rty qty quot rel_refl trans2 rsp_thms *} ML {* val abs = findabs rty (prop_of (atomize_thm @{thm alpha.induct})) *} diff -r 53d7477a1f94 -r 68bd5c2a1b96 QuotMain.thy --- a/QuotMain.thy Mon Nov 02 09:47:49 2009 +0100 +++ b/QuotMain.thy Mon Nov 02 11:15:26 2009 +0100 @@ -416,8 +416,11 @@ text {* tyRel takes a type and builds a relation that a quantifier over this type needs to respect. *} ML {* +fun matches (ty1, ty2) = + Type.raw_instance (ty1, Logic.varifyT ty2); + fun tyRel ty rty rel lthy = - if ty = rty + if matches (rty, ty) then rel else (case ty of Type (s, tys) => @@ -892,8 +895,8 @@ ML {* fun lookup_quot_data lthy qty = let - val SOME quotdata = find_first (fn x => #qtyp x = qty) (quotdata_lookup lthy) - val rty = #rtyp quotdata + val SOME quotdata = find_first (fn x => matches ((#qtyp x), qty)) (quotdata_lookup lthy) + val rty = Logic.unvarifyT (#rtyp quotdata) val rel = #rel quotdata val rel_eqv = #equiv_thm quotdata val rel_refl_pre = @{thm EQUIV_REFL} OF [rel_eqv]