94 fun int_uniq_mp_tac i = eresolve_tac [notE,impE] i THEN uniq_assume_tac i; |
94 fun int_uniq_mp_tac i = eresolve_tac [notE,impE] i THEN uniq_assume_tac i; |
95 |
95 |
96 |
96 |
97 (*** If-and-only-if ***) |
97 (*** If-and-only-if ***) |
98 |
98 |
99 val iffI = prove_goalw (the_context ()) [iff_def] |
99 bind_thm ("iffI", prove_goalw (the_context ()) [iff_def] |
100 "[| !!x. x:P ==> q(x):Q; !!x. x:Q ==> r(x):P |] ==> ?p:P<->Q" |
100 "[| !!x. x:P ==> q(x):Q; !!x. x:Q ==> r(x):P |] ==> ?p:P<->Q" |
101 (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ]); |
101 (fn prems=> [ (REPEAT (ares_tac (prems@[conjI, impI]) 1)) ])); |
102 |
102 |
103 |
103 |
104 (*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *) |
104 (*Observe use of rewrite_rule to unfold "<->" in meta-assumptions (prems) *) |
105 val iffE = prove_goalw (the_context ()) [iff_def] |
105 bind_thm ("iffE", prove_goalw (the_context ()) [iff_def] |
106 "[| p:P <-> Q; !!x y.[| x:P-->Q; y:Q-->P |] ==> q(x,y):R |] ==> ?p:R" |
106 "[| p:P <-> Q; !!x y.[| x:P-->Q; y:Q-->P |] ==> q(x,y):R |] ==> ?p:R" |
107 (fn prems => [ (rtac conjE 1), (REPEAT (ares_tac prems 1)) ]); |
107 (fn prems => [ (rtac conjE 1), (REPEAT (ares_tac prems 1)) ])); |
108 |
108 |
109 (* Destruct rules for <-> similar to Modus Ponens *) |
109 (* Destruct rules for <-> similar to Modus Ponens *) |
110 |
110 |
111 val iffD1 = prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q; q:P |] ==> ?p:Q" |
111 bind_thm ("iffD1", prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q; q:P |] ==> ?p:Q" |
112 (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); |
112 (fn prems => [ (rtac (conjunct1 RS mp) 1), (REPEAT (ares_tac prems 1)) ])); |
113 |
113 |
114 val iffD2 = prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q; q:Q |] ==> ?p:P" |
114 bind_thm ("iffD2", prove_goalw (the_context ()) [iff_def] "[| p:P <-> Q; q:Q |] ==> ?p:P" |
115 (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ]); |
115 (fn prems => [ (rtac (conjunct2 RS mp) 1), (REPEAT (ares_tac prems 1)) ])); |
116 |
116 |
117 Goal "?p:P <-> P"; |
117 Goal "?p:P <-> P"; |
118 by (REPEAT (ares_tac [iffI] 1)) ; |
118 by (REPEAT (ares_tac [iffI] 1)) ; |
119 qed "iff_refl"; |
119 qed "iff_refl"; |
120 |
120 |
155 (*Use iffE on a premise. For conj_cong, imp_cong, all_cong, ex_cong*) |
155 (*Use iffE on a premise. For conj_cong, imp_cong, all_cong, ex_cong*) |
156 fun iff_tac prems i = |
156 fun iff_tac prems i = |
157 resolve_tac (prems RL [iffE]) i THEN |
157 resolve_tac (prems RL [iffE]) i THEN |
158 REPEAT1 (eresolve_tac [asm_rl,mp] i); |
158 REPEAT1 (eresolve_tac [asm_rl,mp] i); |
159 |
159 |
160 val conj_cong = prove_goal (the_context ()) |
160 bind_thm ("conj_cong", prove_goal (the_context ()) |
161 "[| p:P <-> P'; !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P&Q) <-> (P'&Q')" |
161 "[| p:P <-> P'; !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P&Q) <-> (P'&Q')" |
162 (fn prems => |
162 (fn prems => |
163 [ (cut_facts_tac prems 1), |
163 [ (cut_facts_tac prems 1), |
164 (REPEAT (ares_tac [iffI,conjI] 1 |
164 (REPEAT (ares_tac [iffI,conjI] 1 |
165 ORELSE eresolve_tac [iffE,conjE,mp] 1 |
165 ORELSE eresolve_tac [iffE,conjE,mp] 1 |
166 ORELSE iff_tac prems 1)) ]); |
166 ORELSE iff_tac prems 1)) ])); |
167 |
167 |
168 val disj_cong = prove_goal (the_context ()) |
168 bind_thm ("disj_cong", prove_goal (the_context ()) |
169 "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P|Q) <-> (P'|Q')" |
169 "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P|Q) <-> (P'|Q')" |
170 (fn prems => |
170 (fn prems => |
171 [ (cut_facts_tac prems 1), |
171 [ (cut_facts_tac prems 1), |
172 (REPEAT (eresolve_tac [iffE,disjE,disjI1,disjI2] 1 |
172 (REPEAT (eresolve_tac [iffE,disjE,disjI1,disjI2] 1 |
173 ORELSE ares_tac [iffI] 1 |
173 ORELSE ares_tac [iffI] 1 |
174 ORELSE mp_tac 1)) ]); |
174 ORELSE mp_tac 1)) ])); |
175 |
175 |
176 val imp_cong = prove_goal (the_context ()) |
176 bind_thm ("imp_cong", prove_goal (the_context ()) |
177 "[| p:P <-> P'; !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P-->Q) <-> (P'-->Q')" |
177 "[| p:P <-> P'; !!x. x:P' ==> q(x):Q <-> Q' |] ==> ?p:(P-->Q) <-> (P'-->Q')" |
178 (fn prems => |
178 (fn prems => |
179 [ (cut_facts_tac prems 1), |
179 [ (cut_facts_tac prems 1), |
180 (REPEAT (ares_tac [iffI,impI] 1 |
180 (REPEAT (ares_tac [iffI,impI] 1 |
181 ORELSE etac iffE 1 |
181 ORELSE etac iffE 1 |
182 ORELSE mp_tac 1 ORELSE iff_tac prems 1)) ]); |
182 ORELSE mp_tac 1 ORELSE iff_tac prems 1)) ])); |
183 |
183 |
184 val iff_cong = prove_goal (the_context ()) |
184 bind_thm ("iff_cong", prove_goal (the_context ()) |
185 "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P<->Q) <-> (P'<->Q')" |
185 "[| p:P <-> P'; q:Q <-> Q' |] ==> ?p:(P<->Q) <-> (P'<->Q')" |
186 (fn prems => |
186 (fn prems => |
187 [ (cut_facts_tac prems 1), |
187 [ (cut_facts_tac prems 1), |
188 (REPEAT (etac iffE 1 |
188 (REPEAT (etac iffE 1 |
189 ORELSE ares_tac [iffI] 1 |
189 ORELSE ares_tac [iffI] 1 |
190 ORELSE mp_tac 1)) ]); |
190 ORELSE mp_tac 1)) ])); |
191 |
191 |
192 val not_cong = prove_goal (the_context ()) |
192 bind_thm ("not_cong", prove_goal (the_context ()) |
193 "p:P <-> P' ==> ?p:~P <-> ~P'" |
193 "p:P <-> P' ==> ?p:~P <-> ~P'" |
194 (fn prems => |
194 (fn prems => |
195 [ (cut_facts_tac prems 1), |
195 [ (cut_facts_tac prems 1), |
196 (REPEAT (ares_tac [iffI,notI] 1 |
196 (REPEAT (ares_tac [iffI,notI] 1 |
197 ORELSE mp_tac 1 |
197 ORELSE mp_tac 1 |
198 ORELSE eresolve_tac [iffE,notE] 1)) ]); |
198 ORELSE eresolve_tac [iffE,notE] 1)) ])); |
199 |
199 |
200 val all_cong = prove_goal (the_context ()) |
200 bind_thm ("all_cong", prove_goal (the_context ()) |
201 "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(ALL x. P(x)) <-> (ALL x. Q(x))" |
201 "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(ALL x. P(x)) <-> (ALL x. Q(x))" |
202 (fn prems => |
202 (fn prems => |
203 [ (REPEAT (ares_tac [iffI,allI] 1 |
203 [ (REPEAT (ares_tac [iffI,allI] 1 |
204 ORELSE mp_tac 1 |
204 ORELSE mp_tac 1 |
205 ORELSE etac allE 1 ORELSE iff_tac prems 1)) ]); |
205 ORELSE etac allE 1 ORELSE iff_tac prems 1)) ])); |
206 |
206 |
207 val ex_cong = prove_goal (the_context ()) |
207 bind_thm ("ex_cong", prove_goal (the_context ()) |
208 "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(EX x. P(x)) <-> (EX x. Q(x))" |
208 "(!!x. f(x):P(x) <-> Q(x)) ==> ?p:(EX x. P(x)) <-> (EX x. Q(x))" |
209 (fn prems => |
209 (fn prems => |
210 [ (REPEAT (etac exE 1 ORELSE ares_tac [iffI,exI] 1 |
210 [ (REPEAT (etac exE 1 ORELSE ares_tac [iffI,exI] 1 |
211 ORELSE mp_tac 1 |
211 ORELSE mp_tac 1 |
212 ORELSE iff_tac prems 1)) ]); |
212 ORELSE iff_tac prems 1)) ])); |
213 |
213 |
214 (*NOT PROVED |
214 (*NOT PROVED |
215 val ex1_cong = prove_goal (the_context ()) |
215 bind_thm ("ex1_cong", prove_goal (the_context ()) |
216 "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX! x.P(x)) <-> (EX! x.Q(x))" |
216 "(!!x.f(x):P(x) <-> Q(x)) ==> ?p:(EX! x.P(x)) <-> (EX! x.Q(x))" |
217 (fn prems => |
217 (fn prems => |
218 [ (REPEAT (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1 |
218 [ (REPEAT (eresolve_tac [ex1E, spec RS mp] 1 ORELSE ares_tac [iffI,ex1I] 1 |
219 ORELSE mp_tac 1 |
219 ORELSE mp_tac 1 |
220 ORELSE iff_tac prems 1)) ]); |
220 ORELSE iff_tac prems 1)) ])); |
221 *) |
221 *) |
222 |
222 |
223 (*** Equality rules ***) |
223 (*** Equality rules ***) |
224 |
224 |
225 val refl = ieqI; |
225 bind_thm ("refl", ieqI); |
226 |
226 |
227 val subst = prove_goal (the_context ()) "[| p:a=b; q:P(a) |] ==> ?p : P(b)" |
227 bind_thm ("subst", prove_goal (the_context ()) "[| p:a=b; q:P(a) |] ==> ?p : P(b)" |
228 (fn [prem1,prem2] => [ rtac (prem2 RS rev_mp) 1, (rtac (prem1 RS ieqE) 1), |
228 (fn [prem1,prem2] => [ rtac (prem2 RS rev_mp) 1, (rtac (prem1 RS ieqE) 1), |
229 rtac impI 1, atac 1 ]); |
229 rtac impI 1, atac 1 ])); |
230 |
230 |
231 Goal "q:a=b ==> ?c:b=a"; |
231 Goal "q:a=b ==> ?c:b=a"; |
232 by (etac subst 1); |
232 by (etac subst 1); |
233 by (rtac refl 1) ; |
233 by (rtac refl 1) ; |
234 qed "sym"; |
234 qed "sym"; |
306 by (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ; |
306 by (DEPTH_SOLVE (eresolve_tac [asm_rl, subst, ssubst] 1)) ; |
307 qed "pred3_cong"; |
307 qed "pred3_cong"; |
308 |
308 |
309 (*special cases for free variables P, Q, R, S -- up to 3 arguments*) |
309 (*special cases for free variables P, Q, R, S -- up to 3 arguments*) |
310 |
310 |
311 val pred_congs = |
311 bind_thms ("pred_congs", |
312 List.concat (map (fn c => |
312 List.concat (map (fn c => |
313 map (fn th => read_instantiate [("P",c)] th) |
313 map (fn th => read_instantiate [("P",c)] th) |
314 [pred1_cong,pred2_cong,pred3_cong]) |
314 [pred1_cong,pred2_cong,pred3_cong]) |
315 (explode"PQRS")); |
315 (explode"PQRS"))); |
316 |
316 |
317 (*special case for the equality predicate!*) |
317 (*special case for the equality predicate!*) |
318 val eq_cong = read_instantiate [("P","op =")] pred2_cong; |
318 bind_thm ("eq_cong", read_instantiate [("P","op =")] pred2_cong); |
319 |
319 |
320 |
320 |
321 (*** Simplifications of assumed implications. |
321 (*** Simplifications of assumed implications. |
322 Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE |
322 Roy Dyckhoff has proved that conj_impE, disj_impE, and imp_impE |
323 used with mp_tac (restricted to atomic formulae) is COMPLETE for |
323 used with mp_tac (restricted to atomic formulae) is COMPLETE for |