248 abbreviation "mono_tailrec \<equiv> monotone (fun_ord tailrec_ord) tailrec_ord" |
248 abbreviation "mono_tailrec \<equiv> monotone (fun_ord tailrec_ord) tailrec_ord" |
249 |
249 |
250 lemma tailrec_admissible: |
250 lemma tailrec_admissible: |
251 "ccpo.admissible (fun_lub (flat_lub undefined)) (fun_ord tailrec_ord) |
251 "ccpo.admissible (fun_lub (flat_lub undefined)) (fun_ord tailrec_ord) |
252 (\<lambda>a. \<forall>x. a x \<noteq> undefined \<longrightarrow> P x (a x))" |
252 (\<lambda>a. \<forall>x. a x \<noteq> undefined \<longrightarrow> P x (a x))" |
253 proof(intro ccpo.admissibleI[OF tailrec.ccpo] strip) |
253 proof(intro ccpo.admissibleI strip) |
254 fix A x |
254 fix A x |
255 assume chain: "Complete_Partial_Order.chain (fun_ord tailrec_ord) A" |
255 assume chain: "Complete_Partial_Order.chain (fun_ord tailrec_ord) A" |
256 and P [rule_format]: "\<forall>f\<in>A. \<forall>x. f x \<noteq> undefined \<longrightarrow> P x (f x)" |
256 and P [rule_format]: "\<forall>f\<in>A. \<forall>x. f x \<noteq> undefined \<longrightarrow> P x (f x)" |
257 and defined: "fun_lub (flat_lub undefined) A x \<noteq> undefined" |
257 and defined: "fun_lub (flat_lub undefined) A x \<noteq> undefined" |
258 from defined obtain f where f: "f \<in> A" "f x \<noteq> undefined" |
258 from defined obtain f where f: "f \<in> A" "f x \<noteq> undefined" |
288 assumes pfun: "partial_function_definitions le lub" |
288 assumes pfun: "partial_function_definitions le lub" |
289 assumes adm: "ccpo.admissible lub le (P o g)" |
289 assumes adm: "ccpo.admissible lub le (P o g)" |
290 assumes inj: "\<And>x y. f x = f y \<Longrightarrow> x = y" |
290 assumes inj: "\<And>x y. f x = f y \<Longrightarrow> x = y" |
291 assumes inv: "\<And>x. f (g x) = x" |
291 assumes inv: "\<And>x. f (g x) = x" |
292 shows "ccpo.admissible (img_lub f g lub) (img_ord f le) P" |
292 shows "ccpo.admissible (img_lub f g lub) (img_ord f le) P" |
293 proof (rule ccpo.admissibleI, rule ccpo, rule partial_function_image, fact pfun, fact inj, fact inv) |
293 proof (rule ccpo.admissibleI) |
294 fix A assume "chain (img_ord f le) A" |
294 fix A assume "chain (img_ord f le) A" |
295 then have ch': "chain le (f ` A)" |
295 then have ch': "chain le (f ` A)" |
296 by (auto simp: img_ord_def intro: chainI dest: chainD) |
296 by (auto simp: img_ord_def intro: chainI dest: chainD) |
297 assume P_A: "\<forall>x\<in>A. P x" |
297 assume P_A: "\<forall>x\<in>A. P x" |
298 have "(P o g) (lub (f ` A))" |
298 have "(P o g) (lub (f ` A))" using adm ch' |
299 proof (rule ccpo.admissibleD[OF ccpo, OF pfun adm ch']) |
299 proof (rule ccpo.admissibleD) |
300 fix x assume "x \<in> f ` A" |
300 fix x assume "x \<in> f ` A" |
301 with P_A show "(P o g) x" by (auto simp: inj[OF inv]) |
301 with P_A show "(P o g) x" by (auto simp: inj[OF inv]) |
302 qed |
302 qed |
303 thus "P (img_lub f g lub A)" unfolding img_lub_def by simp |
303 thus "P (img_lub f g lub A)" unfolding img_lub_def by simp |
304 qed |
304 qed |
305 |
305 |
306 lemma admissible_fun: |
306 lemma admissible_fun: |
307 assumes pfun: "partial_function_definitions le lub" |
307 assumes pfun: "partial_function_definitions le lub" |
308 assumes adm: "\<And>x. ccpo.admissible lub le (Q x)" |
308 assumes adm: "\<And>x. ccpo.admissible lub le (Q x)" |
309 shows "ccpo.admissible (fun_lub lub) (fun_ord le) (\<lambda>f. \<forall>x. Q x (f x))" |
309 shows "ccpo.admissible (fun_lub lub) (fun_ord le) (\<lambda>f. \<forall>x. Q x (f x))" |
310 proof (rule ccpo.admissibleI, rule ccpo, rule partial_function_lift, rule pfun) |
310 proof (rule ccpo.admissibleI) |
311 fix A :: "('b \<Rightarrow> 'a) set" |
311 fix A :: "('b \<Rightarrow> 'a) set" |
312 assume Q: "\<forall>f\<in>A. \<forall>x. Q x (f x)" |
312 assume Q: "\<forall>f\<in>A. \<forall>x. Q x (f x)" |
313 assume ch: "chain (fun_ord le) A" |
313 assume ch: "chain (fun_ord le) A" |
314 show "\<forall>x. Q x (fun_lub lub A x)" |
314 show "\<forall>x. Q x (fun_lub lub A x)" |
315 unfolding fun_lub_def |
315 unfolding fun_lub_def |
316 by (rule allI, rule ccpo.admissibleD[OF ccpo, OF pfun adm chain_fun[OF ch]]) |
316 by (rule allI, rule ccpo.admissibleD[OF adm chain_fun[OF ch]]) |
317 (auto simp: Q) |
317 (auto simp: Q) |
318 qed |
318 qed |
319 |
319 |
320 |
320 |
321 abbreviation "option_ord \<equiv> flat_ord None" |
321 abbreviation "option_ord \<equiv> flat_ord None" |
358 with `c \<in> A` lub show ?thesis by simp |
358 with `c \<in> A` lub show ?thesis by simp |
359 qed |
359 qed |
360 |
360 |
361 lemma option_admissible: "option.admissible (%(f::'a \<Rightarrow> 'b option). |
361 lemma option_admissible: "option.admissible (%(f::'a \<Rightarrow> 'b option). |
362 (\<forall>x y. f x = Some y \<longrightarrow> P x y))" |
362 (\<forall>x y. f x = Some y \<longrightarrow> P x y))" |
363 proof (rule ccpo.admissibleI[OF option.ccpo]) |
363 proof (rule ccpo.admissibleI) |
364 fix A :: "('a \<Rightarrow> 'b option) set" |
364 fix A :: "('a \<Rightarrow> 'b option) set" |
365 assume ch: "chain option.le_fun A" |
365 assume ch: "chain option.le_fun A" |
366 and IH: "\<forall>f\<in>A. \<forall>x y. f x = Some y \<longrightarrow> P x y" |
366 and IH: "\<forall>f\<in>A. \<forall>x y. f x = Some y \<longrightarrow> P x y" |
367 from ch have ch': "\<And>x. chain option_ord {y. \<exists>f\<in>A. y = f x}" by (rule chain_fun) |
367 from ch have ch': "\<And>x. chain option_ord {y. \<exists>f\<in>A. y = f x}" by (rule chain_fun) |
368 show "\<forall>x y. option.lub_fun A x = Some y \<longrightarrow> P x y" |
368 show "\<forall>x y. option.lub_fun A x = Some y \<longrightarrow> P x y" |