diff -r 1dd7f7f98040 -r c770f36f9459 QuotMain.thy --- a/QuotMain.thy Fri Oct 30 16:37:09 2009 +0100 +++ b/QuotMain.thy Fri Oct 30 18:31:06 2009 +0100 @@ -501,6 +501,10 @@ else Const (@{const_name "Ex"}, ty) $ apply_subt (my_reg lthy rel rty) t end + | Const (@{const_name "op ="}, ty) $ t => + if needs_lift rty (fastype_of t) then + (tyRel (fastype_of t) rty rel lthy) $ t + else Const (@{const_name "op ="}, ty) $ (my_reg lthy rel rty t) | t1 $ t2 => (my_reg lthy rel rty t1) $ (my_reg lthy rel rty t2) | _ => trm *} @@ -513,16 +517,25 @@ (my_reg lthy rel rty (prop_of thm))) *} +lemma eq_rr: "(\x. R x x) \ a = b \ R a b" +by (auto) + ML {* -fun regularize thm rty rel rel_eqv lthy = +fun regularize thm rty rel rel_eqv rel_refl lthy = let val g = build_regularize_goal thm rty rel lthy; fun tac ctxt = - (asm_full_simp_tac ((Simplifier.context ctxt HOL_ss) addsimps + REPEAT_ALL_NEW (FIRST' [ + rtac rel_refl, + atac, + (rtac @{thm allI} THEN' dtac @{thm spec}), + (fn i => CHANGED (asm_full_simp_tac ((Simplifier.context ctxt HOL_ss) addsimps [(@{thm equiv_res_forall} OF [rel_eqv]), - (@{thm equiv_res_exists} OF [rel_eqv])])) THEN_ALL_NEW - (((rtac @{thm RIGHT_RES_FORALL_REGULAR}) THEN' (RANGE [fn _ => all_tac, atac]) THEN' - (MetisTools.metis_tac ctxt [])) ORELSE' (MetisTools.metis_tac ctxt [])); + (@{thm equiv_res_exists} OF [rel_eqv])]) i)), + MetisTools.metis_tac ctxt [], + rtac (@{thm eq_rr} OF [rel_refl]), + ((rtac @{thm RIGHT_RES_FORALL_REGULAR}) THEN' (RANGE [fn _ => all_tac, atac])) + ]); val cthm = Goal.prove lthy [] [] g (fn x => tac (#context x) 1); in cthm OF [thm] @@ -907,7 +920,7 @@ val (trans2, reps_same, quot) = lookup_quot_thms lthy qty_name; val consts = lookup_quot_consts defs; val t_a = atomize_thm t; - val t_r = regularize t_a rty rel rel_eqv lthy; + val t_r = regularize t_a rty rel rel_eqv rel_refl lthy; val t_t = repabs lthy t_r consts rty qty quot rel_refl trans2 rsp_thms; val abs = findabs rty (prop_of t_a); val simp_lam_prs_thms = map (make_simp_lam_prs_thm lthy quot) abs;