24 fun mk_meta_prems ctxt = |
24 fun mk_meta_prems ctxt = |
25 rule_by_tactic ctxt |
25 rule_by_tactic ctxt |
26 (REPEAT_FIRST (resolve_tac [@{thm meta_eq_to_obj_eq}, @{thm def_imp_iff}])); |
26 (REPEAT_FIRST (resolve_tac [@{thm meta_eq_to_obj_eq}, @{thm def_imp_iff}])); |
27 |
27 |
28 (*Congruence rules for = or <-> (instead of ==)*) |
28 (*Congruence rules for = or <-> (instead of ==)*) |
29 fun mk_meta_cong ss rl = |
29 fun mk_meta_cong ctxt rl = |
30 Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems (Simplifier.the_context ss) rl)) |
30 Drule.zero_var_indexes (mk_meta_eq (mk_meta_prems ctxt rl)) |
31 handle THM _ => |
31 handle THM _ => |
32 error("Premises and conclusion of congruence rules must use =-equality or <->"); |
32 error("Premises and conclusion of congruence rules must use =-equality or <->"); |
33 |
33 |
34 val mksimps_pairs = |
34 val mksimps_pairs = |
35 [(@{const_name imp}, [@{thm mp}]), (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]), |
35 [(@{const_name imp}, [@{thm mp}]), (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]), |
104 |
104 |
105 (*** Standard simpsets ***) |
105 (*** Standard simpsets ***) |
106 |
106 |
107 val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}]; |
107 val triv_rls = [@{thm TrueI}, @{thm refl}, reflexive_thm, @{thm iff_refl}, @{thm notFalseI}]; |
108 |
108 |
109 fun unsafe_solver ss = |
109 fun unsafe_solver ctxt = |
110 FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ss), atac, etac @{thm FalseE}]; |
110 FIRST' [resolve_tac (triv_rls @ Simplifier.prems_of ctxt), atac, etac @{thm FalseE}]; |
111 |
111 |
112 (*No premature instantiation of variables during simplification*) |
112 (*No premature instantiation of variables during simplification*) |
113 fun safe_solver ss = |
113 fun safe_solver ctxt = |
114 FIRST' [match_tac (triv_rls @ Simplifier.prems_of ss), eq_assume_tac, ematch_tac @{thms FalseE}]; |
114 FIRST' [match_tac (triv_rls @ Simplifier.prems_of ctxt), eq_assume_tac, ematch_tac @{thms FalseE}]; |
115 |
115 |
116 (*No simprules, but basic infastructure for simplification*) |
116 (*No simprules, but basic infastructure for simplification*) |
117 val FOL_basic_ss = |
117 val FOL_basic_ss = |
118 Simplifier.global_context @{theory} empty_ss |
118 empty_simpset @{context} |
119 setSSolver (mk_solver "FOL safe" safe_solver) |
119 setSSolver (mk_solver "FOL safe" safe_solver) |
120 setSolver (mk_solver "FOL unsafe" unsafe_solver) |
120 setSolver (mk_solver "FOL unsafe" unsafe_solver) |
121 |> Simplifier.set_subgoaler asm_simp_tac |
121 |> Simplifier.set_subgoaler asm_simp_tac |
122 |> Simplifier.set_mksimps (mksimps mksimps_pairs) |
122 |> Simplifier.set_mksimps (mksimps mksimps_pairs) |
123 |> Simplifier.set_mkcong mk_meta_cong; |
123 |> Simplifier.set_mkcong mk_meta_cong |
|
124 |> simpset_of; |
124 |
125 |
125 fun unfold_tac ths = |
126 fun unfold_tac ths ctxt = |
126 let val ss0 = Simplifier.clear_ss FOL_basic_ss addsimps ths |
127 ALLGOALS (full_simp_tac (clear_simpset (put_simpset FOL_basic_ss ctxt) addsimps ths)); |
127 in fn ss => ALLGOALS (full_simp_tac (Simplifier.inherit_context ss ss0)) end; |
|
128 |
128 |
129 |
129 |
130 (*** integration of simplifier with classical reasoner ***) |
130 (*** integration of simplifier with classical reasoner ***) |
131 |
131 |
132 structure Clasimp = Clasimp |
132 structure Clasimp = Clasimp |