51 |
49 |
52 subsection {* Properties of @{term iterate} and @{term fix} *} |
50 subsection {* Properties of @{term iterate} and @{term fix} *} |
53 |
51 |
54 text {* derive inductive properties of iterate from primitive recursion *} |
52 text {* derive inductive properties of iterate from primitive recursion *} |
55 |
53 |
56 lemma iterate_Suc2: "iterate (Suc n) F x = iterate n F (F$x)" |
54 lemma iterate_Suc2: "iterate (Suc n) F x = iterate n F (F\<cdot>x)" |
57 by (induct_tac "n", auto) |
55 by (induct_tac n, auto) |
58 |
56 |
59 text {* |
57 text {* |
60 The sequence of function iterations is a chain. |
58 The sequence of function iterations is a chain. |
61 This property is essential since monotonicity of iterate makes no sense. |
59 This property is essential since monotonicity of iterate makes no sense. |
62 *} |
60 *} |
63 |
61 |
64 lemma chain_iterate2: "x << F$x ==> chain (%i. iterate i F x)" |
62 lemma chain_iterate2: "x \<sqsubseteq> F\<cdot>x \<Longrightarrow> chain (\<lambda>i. iterate i F x)" |
65 by (rule chainI, induct_tac "i", auto elim: monofun_cfun_arg) |
63 by (rule chainI, induct_tac i, auto elim: monofun_cfun_arg) |
66 |
64 |
67 lemma chain_iterate: "chain (%i. iterate i F UU)" |
65 lemma chain_iterate: "chain (\<lambda>i. iterate i F \<bottom>)" |
68 by (rule chain_iterate2 [OF minimal]) |
66 by (rule chain_iterate2 [OF minimal]) |
69 |
67 |
70 text {* |
68 text {* |
71 Kleene's fixed point theorems for continuous functions in pointed |
69 Kleene's fixed point theorems for continuous functions in pointed |
72 omega cpo's |
70 omega cpo's |
73 *} |
71 *} |
74 |
72 |
75 lemma Ifix_eq: "Ifix F = F$(Ifix F)" |
73 lemma Ifix_eq: "Ifix F = F\<cdot>(Ifix F)" |
76 apply (unfold Ifix_def) |
74 apply (unfold Ifix_def) |
77 apply (subst lub_range_shift [of _ 1, symmetric]) |
75 apply (subst lub_range_shift [of _ 1, symmetric]) |
78 apply (rule chain_iterate) |
76 apply (rule chain_iterate) |
79 apply (subst contlub_cfun_arg) |
77 apply (subst contlub_cfun_arg) |
80 apply (rule chain_iterate) |
78 apply (rule chain_iterate) |
81 apply simp |
79 apply simp |
82 done |
80 done |
83 |
81 |
84 lemma Ifix_least: "F$x=x ==> Ifix(F) << x" |
82 lemma Ifix_least: "F\<cdot>x = x \<Longrightarrow> Ifix F \<sqsubseteq> x" |
85 apply (unfold Ifix_def) |
83 apply (unfold Ifix_def) |
86 apply (rule is_lub_thelub) |
84 apply (rule is_lub_thelub) |
87 apply (rule chain_iterate) |
85 apply (rule chain_iterate) |
88 apply (rule ub_rangeI) |
86 apply (rule ub_rangeI) |
89 apply (induct_tac "i") |
87 apply (induct_tac i) |
90 apply (simp (no_asm_simp)) |
88 apply simp |
91 apply (simp (no_asm_simp)) |
89 apply simp |
92 apply (erule_tac t = "x" in subst) |
90 apply (erule subst) |
93 apply (erule monofun_cfun_arg) |
91 apply (erule monofun_cfun_arg) |
94 done |
92 done |
95 |
93 |
96 text {* monotonicity and continuity of @{term iterate} *} |
94 text {* continuity of @{term iterate} *} |
97 |
95 |
98 lemma cont_iterate: "cont(iterate(i))" |
96 lemma cont_iterate1: "cont (\<lambda>F. iterate n F x)" |
99 apply (induct_tac i) |
97 by (induct_tac n, simp_all) |
100 apply simp |
98 |
101 apply simp |
99 lemma cont_iterate2: "cont (\<lambda>x. iterate n F x)" |
102 apply (rule cont2cont_CF1L_rev) |
100 by (induct_tac n, simp_all) |
103 apply (rule allI) |
101 |
104 apply (rule cont2cont_Rep_CFun) |
102 lemma cont_iterate: "cont (iterate n)" |
105 apply (rule cont_id) |
103 by (rule cont_iterate1 [THEN cont2cont_CF1L_rev2]) |
106 apply (erule cont2cont_CF1L) |
104 |
107 done |
105 lemmas monofun_iterate2 = cont_iterate2 [THEN cont2mono, standard] |
108 |
106 lemmas contlub_iterate2 = cont_iterate2 [THEN cont2contlub, standard] |
109 lemma monofun_iterate: "monofun(iterate(i))" |
107 |
110 by (rule cont_iterate [THEN cont2mono]) |
108 text {* continuity of @{term Ifix} *} |
111 |
109 |
112 lemma contlub_iterate: "contlub(iterate(i))" |
110 lemma cont_Ifix: "cont Ifix" |
113 by (rule cont_iterate [THEN cont2contlub]) |
|
114 |
|
115 text {* a lemma about continuity of @{term iterate} in its third argument *} |
|
116 |
|
117 lemma cont_iterate2: "cont (iterate n F)" |
|
118 by (induct_tac "n", simp_all) |
|
119 |
|
120 lemma monofun_iterate2: "monofun(iterate n F)" |
|
121 by (rule cont_iterate2 [THEN cont2mono]) |
|
122 |
|
123 lemma contlub_iterate2: "contlub(iterate n F)" |
|
124 by (rule cont_iterate2 [THEN cont2contlub]) |
|
125 |
|
126 text {* monotonicity and continuity of @{term Ifix} *} |
|
127 |
|
128 text {* better access to definitions *} |
|
129 |
|
130 lemma Ifix_def2: "Ifix=(%x. lub(range(%i. iterate i x UU)))" |
|
131 apply (rule ext) |
|
132 apply (unfold Ifix_def) |
111 apply (unfold Ifix_def) |
133 apply (rule refl) |
112 apply (rule cont2cont_lub) |
134 done |
113 apply (rule ch2ch_fun_rev) |
135 |
114 apply (rule chain_iterate) |
136 lemma cont_Ifix: "cont(Ifix)" |
115 apply (rule cont_iterate1) |
137 apply (subst Ifix_def2) |
116 done |
138 apply (subst cont_iterate [THEN cont2cont_CF1L, THEN beta_cfun, symmetric]) |
|
139 apply (rule cont_lubcfun) |
|
140 apply (rule chainI) |
|
141 apply (rule less_cfun2) |
|
142 apply (simp add: cont_iterate [THEN cont2cont_CF1L] del: iterate_Suc) |
|
143 apply (rule chainE) |
|
144 apply (rule chain_iterate) |
|
145 done |
|
146 |
|
147 lemma monofun_Ifix: "monofun(Ifix)" |
|
148 by (rule cont_Ifix [THEN cont2mono]) |
|
149 |
|
150 lemma contlub_Ifix: "contlub(Ifix)" |
|
151 by (rule cont_Ifix [THEN cont2contlub]) |
|
152 |
117 |
153 text {* propagate properties of @{term Ifix} to its continuous counterpart *} |
118 text {* propagate properties of @{term Ifix} to its continuous counterpart *} |
154 |
119 |
155 lemma fix_eq: "fix$F = F$(fix$F)" |
120 lemma fix_eq: "fix\<cdot>F = F\<cdot>(fix\<cdot>F)" |
156 apply (unfold fix_def) |
121 apply (unfold fix_def) |
157 apply (simp add: cont_Ifix) |
122 apply (simp add: cont_Ifix) |
158 apply (rule Ifix_eq) |
123 apply (rule Ifix_eq) |
159 done |
124 done |
160 |
125 |
161 lemma fix_least: "F$x = x ==> fix$F << x" |
126 lemma fix_least: "F\<cdot>x = x \<Longrightarrow> fix\<cdot>F \<sqsubseteq> x" |
162 apply (unfold fix_def) |
127 apply (unfold fix_def) |
163 apply (simp add: cont_Ifix) |
128 apply (simp add: cont_Ifix) |
164 apply (erule Ifix_least) |
129 apply (erule Ifix_least) |
165 done |
130 done |
166 |
131 |
167 lemma fix_eqI: |
132 lemma fix_eqI: "\<lbrakk>F\<cdot>x = x; \<forall>z. F\<cdot>z = z \<longrightarrow> x \<sqsubseteq> z\<rbrakk> \<Longrightarrow> x = fix\<cdot>F" |
168 "[| F$x = x; !z. F$z = z --> x << z |] ==> x = fix$F" |
|
169 apply (rule antisym_less) |
133 apply (rule antisym_less) |
170 apply (erule allE) |
134 apply (erule allE) |
171 apply (erule mp) |
135 apply (erule mp) |
172 apply (rule fix_eq [symmetric]) |
136 apply (rule fix_eq [symmetric]) |
173 apply (erule fix_least) |
137 apply (erule fix_least) |
174 done |
138 done |
175 |
139 |
176 lemma fix_eq2: "f == fix$F ==> f = F$f" |
140 lemma fix_eq2: "f \<equiv> fix\<cdot>F \<Longrightarrow> f = F\<cdot>f" |
177 by (simp add: fix_eq [symmetric]) |
141 by (simp add: fix_eq [symmetric]) |
178 |
142 |
179 lemma fix_eq3: "f == fix$F ==> f$x = F$f$x" |
143 lemma fix_eq3: "f \<equiv> fix\<cdot>F \<Longrightarrow> f\<cdot>x = F\<cdot>f\<cdot>x" |
180 by (erule fix_eq2 [THEN cfun_fun_cong]) |
144 by (erule fix_eq2 [THEN cfun_fun_cong]) |
181 |
145 |
182 (* fun fix_tac3 thm i = ((rtac trans i) THEN (rtac (thm RS fix_eq3) i)) *) |
146 lemma fix_eq4: "f = fix\<cdot>F \<Longrightarrow> f = F\<cdot>f" |
183 |
|
184 lemma fix_eq4: "f = fix$F ==> f = F$f" |
|
185 apply (erule ssubst) |
147 apply (erule ssubst) |
186 apply (rule fix_eq) |
148 apply (rule fix_eq) |
187 done |
149 done |
188 |
150 |
189 lemma fix_eq5: "f = fix$F ==> f$x = F$f$x" |
151 lemma fix_eq5: "f = fix\<cdot>F \<Longrightarrow> f\<cdot>x = F\<cdot>f\<cdot>x" |
190 apply (rule trans) |
152 by (erule fix_eq4 [THEN cfun_fun_cong]) |
191 apply (erule fix_eq4 [THEN cfun_fun_cong]) |
153 |
192 apply (rule refl) |
|
193 done |
|
194 |
|
195 (* fun fix_tac5 thm i = ((rtac trans i) THEN (rtac (thm RS fix_eq5) i)) *) |
|
196 |
|
197 (* proves the unfolding theorem for function equations f = fix$... *) |
|
198 (* |
|
199 fun fix_prover thy fixeq s = prove_goal thy s (fn prems => [ |
|
200 (rtac trans 1), |
|
201 (rtac (fixeq RS fix_eq4) 1), |
|
202 (rtac trans 1), |
|
203 (rtac beta_cfun 1), |
|
204 (Simp_tac 1) |
|
205 ]) |
|
206 *) |
|
207 (* proves the unfolding theorem for function definitions f == fix$... *) |
|
208 (* |
|
209 fun fix_prover2 thy fixdef s = prove_goal thy s (fn prems => [ |
|
210 (rtac trans 1), |
|
211 (rtac (fix_eq2) 1), |
|
212 (rtac fixdef 1), |
|
213 (rtac beta_cfun 1), |
|
214 (Simp_tac 1) |
|
215 ]) |
|
216 *) |
|
217 (* proves an application case for a function from its unfolding thm *) |
|
218 (* |
|
219 fun case_prover thy unfold s = prove_goal thy s (fn prems => [ |
|
220 (cut_facts_tac prems 1), |
|
221 (rtac trans 1), |
|
222 (stac unfold 1), |
|
223 Auto_tac |
|
224 ]) |
|
225 *) |
|
226 text {* direct connection between @{term fix} and iteration without @{term Ifix} *} |
154 text {* direct connection between @{term fix} and iteration without @{term Ifix} *} |
227 |
155 |
228 lemma fix_def2: "fix$F = lub(range(%i. iterate i F UU))" |
156 lemma fix_def2: "fix\<cdot>F = (\<Squnion>i. iterate i F \<bottom>)" |
229 apply (unfold fix_def) |
157 apply (unfold fix_def) |
230 apply (fold Ifix_def) |
158 apply (simp add: cont_Ifix) |
231 apply (simp (no_asm_simp) add: cont_Ifix) |
159 apply (simp add: Ifix_def) |
232 done |
160 done |
233 |
161 |
234 subsection {* Admissibility and fixed point induction *} |
162 subsection {* Admissibility and fixed point induction *} |
235 |
163 |
236 lemma admw_def2: "admw(P) = (!F.(!n. P(iterate n F UU)) --> |
|
237 P (lub(range(%i. iterate i F UU))))" |
|
238 apply (unfold admw_def) |
|
239 apply (rule refl) |
|
240 done |
|
241 |
|
242 text {* an admissible formula is also weak admissible *} |
164 text {* an admissible formula is also weak admissible *} |
243 |
165 |
244 lemma adm_impl_admw: "adm(P)==>admw(P)" |
166 lemma adm_impl_admw: "adm P \<Longrightarrow> admw P" |
245 apply (unfold admw_def) |
167 apply (unfold admw_def) |
246 apply (intro strip) |
168 apply (intro strip) |
247 apply (erule admD) |
169 apply (erule admD) |
248 apply (rule chain_iterate) |
170 apply (rule chain_iterate) |
249 apply assumption |
171 apply assumption |
250 done |
172 done |
251 |
173 |
252 text {* some lemmata for functions with flat/chfin domain/range types *} |
174 text {* some lemmata for functions with flat/chfin domain/range types *} |
253 |
175 |
254 lemma adm_chfindom: "adm (%(u::'a::cpo->'b::chfin). P(u$s))" |
176 lemma adm_chfindom: "adm (\<lambda>(u::'a::cpo \<rightarrow> 'b::chfin). P(u\<cdot>s))" |
255 apply (unfold adm_def) |
177 apply (unfold adm_def) |
256 apply (intro strip) |
178 apply (intro strip) |
257 apply (drule chfin_Rep_CFunR) |
179 apply (drule chfin_Rep_CFunR) |
258 apply (erule_tac x = "s" in allE) |
180 apply (erule_tac x = "s" in allE) |
259 apply clarsimp |
181 apply clarsimp |