210 "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))"; |
210 "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))"; |
211 by (res_inst_tac [("P", "%x.?t(x) = (?u::i)")] (isrec RS ssubst) 1); |
211 by (res_inst_tac [("P", "%x.?t(x) = (?u::i)")] (isrec RS ssubst) 1); |
212 by (rtac (rel RS underI RS beta) 1); |
212 by (rtac (rel RS underI RS beta) 1); |
213 qed "apply_recfun"; |
213 qed "apply_recfun"; |
214 |
214 |
215 (*eresolve_tac transD solves <a,b>:r using transitivity AT MOST ONCE |
|
216 spec RS mp instantiates induction hypotheses*) |
|
217 fun indhyp_tac hyps = |
|
218 resolve_tac (TrueI::refl::reflexive_thm::hyps) ORELSE' |
|
219 (cut_facts_tac hyps THEN' |
|
220 DEPTH_SOLVE_1 o (ares_tac [TrueI, ballI] ORELSE' |
|
221 eresolve_tac [underD, transD, spec RS mp])); |
|
222 |
|
223 (*** NOTE! some simplifications need a different solver!! ***) |
|
224 val wf_super_ss = simpset() setSolver (mk_solver "WF" indhyp_tac); |
|
225 |
|
226 Goalw [is_recfun_def] |
215 Goalw [is_recfun_def] |
227 "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,b,H,g) |] ==> \ |
216 "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,b,H,g) |] ==> \ |
228 \ <x,a>:r --> <x,b>:r --> f`x=g`x"; |
217 \ <x,a>:r --> <x,b>:r --> f`x=g`x"; |
229 by (wf_ind_tac "x" [] 1); |
218 by (wf_ind_tac "x" [] 1); |
230 by (REPEAT (rtac impI 1 ORELSE etac ssubst 1)); |
219 by (REPEAT (rtac impI 1 ORELSE etac ssubst 1)); |
231 by (rewtac restrict_def); |
220 by (asm_simp_tac (simpset() addsimps [vimage_singleton_iff, restrict_def]) 1); |
232 by (asm_simp_tac (wf_super_ss addsimps [vimage_singleton_iff]) 1); |
221 by (subgoal_tac "ALL y. y : r-``{x1} --> f`y = g`y" 1); |
|
222 by (Asm_simp_tac 1); |
|
223 by (blast_tac (claset() addDs [transD]) 1); |
233 qed_spec_mp "is_recfun_equal"; |
224 qed_spec_mp "is_recfun_equal"; |
234 |
225 |
235 val prems as [wfr,transr,recf,recg,_] = goal (the_context ()) |
226 Goal "[| wf(r); trans(r); \ |
236 "[| wf(r); trans(r); \ |
227 \ is_recfun(r,a,H,f); is_recfun(r,b,H,g); <b,a>:r |] \ |
237 \ is_recfun(r,a,H,f); is_recfun(r,b,H,g); <b,a>:r |] ==> \ |
228 \ ==> restrict(f, r-``{b}) = g"; |
238 \ restrict(f, r-``{b}) = g"; |
|
239 by (cut_facts_tac prems 1); |
|
240 by (rtac (consI1 RS restrict_type RS fun_extension) 1); |
229 by (rtac (consI1 RS restrict_type RS fun_extension) 1); |
241 by (etac is_recfun_type 1); |
230 by (etac is_recfun_type 1); |
242 by (ALLGOALS |
231 by (asm_full_simp_tac (simpset() addsimps [vimage_singleton_iff]) 1); |
243 (asm_simp_tac (wf_super_ss addsimps |
232 by (blast_tac (claset() addDs [transD] |
244 [ [wfr,transr,recf,recg] MRS is_recfun_equal ]))); |
233 addIs [is_recfun_equal]) 1); |
245 qed "is_recfun_cut"; |
234 qed "is_recfun_cut"; |
246 |
235 |
247 (*** Main Existence Lemma ***) |
236 (*** Main Existence Lemma ***) |
248 |
237 |
249 Goal "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |] ==> f=g"; |
238 Goal "[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |] ==> f=g"; |
267 by (rewrite_goals_tac [is_recfun_def, wftrec_def]); |
256 by (rewrite_goals_tac [is_recfun_def, wftrec_def]); |
268 (*Applying the substitution: must keep the quantified assumption!!*) |
257 (*Applying the substitution: must keep the quantified assumption!!*) |
269 by (REPEAT (dtac underD 1 ORELSE resolve_tac [refl, lam_cong] 1)); |
258 by (REPEAT (dtac underD 1 ORELSE resolve_tac [refl, lam_cong] 1)); |
270 by (fold_tac [is_recfun_def]); |
259 by (fold_tac [is_recfun_def]); |
271 by (rtac (consI1 RS restrict_type RSN (2,fun_extension) RS subst_context) 1); |
260 by (rtac (consI1 RS restrict_type RSN (2,fun_extension) RS subst_context) 1); |
272 by (rtac is_recfun_type 1); |
261 by (blast_tac (claset() addIs [is_recfun_type]) 1); |
273 by (ALLGOALS |
262 by (ftac (spec RS mp) 1 THEN assume_tac 1); |
274 (asm_simp_tac |
263 by (subgoal_tac "<xa,a1> : r" 1); |
275 (wf_super_ss addsimps [underI RS beta, apply_recfun, is_recfun_cut]))); |
264 by (dres_inst_tac [("x1","xa")] (spec RS mp) 1 THEN assume_tac 1); |
|
265 by (asm_full_simp_tac |
|
266 (simpset() addsimps [vimage_singleton_iff, underI RS beta, apply_recfun, |
|
267 is_recfun_cut]) 1); |
|
268 by (blast_tac (claset() addDs [transD]) 1); |
276 qed "unfold_the_recfun"; |
269 qed "unfold_the_recfun"; |
277 |
270 |
278 |
271 |
279 (*** Unfolding wftrec ***) |
272 (*** Unfolding wftrec ***) |
280 |
273 |
329 \ wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))"; |
322 \ wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))"; |
330 by (etac (wfrec RS trans) 1); |
323 by (etac (wfrec RS trans) 1); |
331 by (asm_simp_tac (simpset() addsimps [vimage_Int_square, cons_subset_iff]) 1); |
324 by (asm_simp_tac (simpset() addsimps [vimage_Int_square, cons_subset_iff]) 1); |
332 qed "wfrec_on"; |
325 qed "wfrec_on"; |
333 |
326 |
334 (*---------------------------------------------------------------------------- |
327 (*Minimal-element characterization of well-foundedness*) |
335 * Minimal-element characterization of well-foundedness |
328 Goalw [wf_def] |
336 *---------------------------------------------------------------------------*) |
329 "wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))"; |
337 |
330 by (Blast_tac 1); |
338 Goalw [wf_def] "wf(r) ==> x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q)"; |
|
339 by (dtac spec 1); |
|
340 by (Blast_tac 1); |
|
341 val lemma1 = result(); |
|
342 |
|
343 Goalw [wf_def] |
|
344 "(ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q)) ==> wf(r)"; |
|
345 by (Clarify_tac 1); |
|
346 by (Blast_tac 1); |
|
347 val lemma2 = result(); |
|
348 |
|
349 Goal "wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))"; |
|
350 by (blast_tac (claset() addSIs [lemma1, lemma2]) 1); |
|
351 qed "wf_eq_minimal"; |
331 qed "wf_eq_minimal"; |
352 |
332 |