author | kleing |
Sun, 03 Mar 2002 16:59:08 +0100 | |
changeset 13006 | 51c5f3f11d16 |
parent 12911 | 704713ca07ea |
child 13062 | 4b1edf2f6bd2 |
permissions | -rw-r--r-- |
12516 | 1 |
(* Title: HOL/MicroJava/BV/Kildall.thy |
10496 | 2 |
ID: $Id$ |
12516 | 3 |
Author: Tobias Nipkow, Gerwin Klein |
10496 | 4 |
Copyright 2000 TUM |
5 |
||
6 |
Kildall's algorithm |
|
7 |
*) |
|
8 |
||
12911 | 9 |
header {* \isaheader{Kildall's Algorithm}\label{sec:Kildall} *} |
10496 | 10 |
|
12516 | 11 |
theory Kildall = Typing_Framework + While_Combinator + Product: |
12 |
||
13 |
||
13006 | 14 |
syntax "@lesubstep_type" :: "(nat \<times> 's) list \<Rightarrow> 's ord \<Rightarrow> (nat \<times> 's) list \<Rightarrow> bool" |
12516 | 15 |
("(_ /<=|_| _)" [50, 0, 51] 50) |
16 |
translations |
|
17 |
"x <=|r| y" == "x <=[(Product.le (op =) r)] y" |
|
18 |
||
10496 | 19 |
|
20 |
constdefs |
|
13006 | 21 |
pres_type :: "'s step_type \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool" |
12516 | 22 |
"pres_type step n A == \<forall>s\<in>A. \<forall>p<n. \<forall>(q,s')\<in>set (step p s). s' \<in> A" |
10496 | 23 |
|
13006 | 24 |
mono :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> nat \<Rightarrow> 's set \<Rightarrow> bool" |
10496 | 25 |
"mono r step n A == |
13006 | 26 |
\<forall>s p t. s \<in> A \<and> p < n \<and> s <=_r t \<longrightarrow> step p s <=|r| step p t" |
10496 | 27 |
|
28 |
consts |
|
12516 | 29 |
iter :: "'s binop \<Rightarrow> 's step_type \<Rightarrow> |
11298 | 30 |
's list \<Rightarrow> nat set \<Rightarrow> 's list \<times> nat set" |
13006 | 31 |
propa :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> nat set \<Rightarrow> 's list * nat set" |
10496 | 32 |
|
33 |
primrec |
|
12516 | 34 |
"propa f [] ss w = (ss,w)" |
35 |
"propa f (q'#qs) ss w = (let (q,t) = q'; |
|
36 |
u = t +_f ss!q; |
|
37 |
w' = (if u = ss!q then w else insert q w) |
|
38 |
in propa f qs (ss[q := u]) w')" |
|
10496 | 39 |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
40 |
defs iter_def: |
12516 | 41 |
"iter f step ss w == |
11298 | 42 |
while (%(ss,w). w \<noteq> {}) |
12516 | 43 |
(%(ss,w). let p = SOME p. p \<in> w |
44 |
in propa f (step p (ss!p)) ss (w-{p})) |
|
11298 | 45 |
(ss,w)" |
10496 | 46 |
|
47 |
constdefs |
|
13006 | 48 |
unstables :: "'s ord \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> nat set" |
12516 | 49 |
"unstables r step ss == {p. p < size ss \<and> \<not>stable r step ss p}" |
10496 | 50 |
|
13006 | 51 |
kildall :: "'s ord \<Rightarrow> 's binop \<Rightarrow> 's step_type \<Rightarrow> 's list \<Rightarrow> 's list" |
12516 | 52 |
"kildall r f step ss == fst(iter f step ss (unstables r step ss))" |
10496 | 53 |
|
13006 | 54 |
consts merges :: "'s binop \<Rightarrow> (nat \<times> 's) list \<Rightarrow> 's list \<Rightarrow> 's list" |
10496 | 55 |
primrec |
12516 | 56 |
"merges f [] ss = ss" |
57 |
"merges f (p'#ps) ss = (let (p,s) = p' in merges f ps (ss[p := s +_f ss!p]))" |
|
10496 | 58 |
|
59 |
||
10774 | 60 |
lemmas [simp] = Let_def le_iff_plus_unchanged [symmetric] |
10496 | 61 |
|
62 |
||
12516 | 63 |
consts |
13006 | 64 |
"@plusplussub" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" ("(_ /++'__ _)" [65, 1000, 66] 65) |
12516 | 65 |
primrec |
66 |
"[] ++_f y = y" |
|
67 |
"(x#xs) ++_f y = xs ++_f (x +_f y)" |
|
68 |
||
69 |
lemma nth_merges: |
|
13006 | 70 |
"\<And>ss. \<lbrakk> semilat (A, r, f); p < length ss; ss \<in> list n A; |
71 |
\<forall>(p,t)\<in>set ps. p<n \<and> t\<in>A \<rbrakk> \<Longrightarrow> |
|
12516 | 72 |
(merges f ps ss)!p = map snd [(p',t') \<in> ps. p'=p] ++_f ss!p" |
13006 | 73 |
(is "\<And>ss. _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?steptype ps \<Longrightarrow> ?P ss ps") |
12516 | 74 |
proof (induct ps) |
75 |
show "\<And>ss. ?P ss []" by simp |
|
76 |
||
77 |
fix ss p' ps' |
|
78 |
assume sl: "semilat (A, r, f)" |
|
79 |
assume ss: "ss \<in> list n A" |
|
80 |
assume l: "p < length ss" |
|
81 |
assume "?steptype (p'#ps')" |
|
82 |
then obtain a b where |
|
83 |
p': "p'=(a,b)" and ab: "a<n" "b\<in>A" and "?steptype ps'" |
|
84 |
by (cases p', auto) |
|
85 |
assume "\<And>ss. semilat (A,r,f) \<Longrightarrow> p < length ss \<Longrightarrow> ss \<in> list n A \<Longrightarrow> ?steptype ps' \<Longrightarrow> ?P ss ps'" |
|
86 |
hence IH: "\<And>ss. ss \<in> list n A \<Longrightarrow> p < length ss \<Longrightarrow> ?P ss ps'" . |
|
87 |
||
88 |
from sl ss ab |
|
89 |
have "ss[a := b +_f ss!a] \<in> list n A" by (simp add: closedD) |
|
90 |
moreover |
|
91 |
from calculation |
|
92 |
have "p < length (ss[a := b +_f ss!a])" by simp |
|
93 |
ultimately |
|
94 |
have "?P (ss[a := b +_f ss!a]) ps'" by (rule IH) |
|
95 |
with p' l |
|
96 |
show "?P ss (p'#ps')" by simp |
|
97 |
qed |
|
98 |
||
99 |
||
10496 | 100 |
lemma pres_typeD: |
13006 | 101 |
"\<lbrakk> pres_type step n A; s\<in>A; p<n; (q,s')\<in>set (step p s) \<rbrakk> \<Longrightarrow> s' \<in> A" |
10496 | 102 |
by (unfold pres_type_def, blast) |
103 |
||
12516 | 104 |
lemma boundedD: |
13006 | 105 |
"\<lbrakk> bounded step n; p < n; (q,t) : set (step p xs) \<rbrakk> \<Longrightarrow> q < n" |
10496 | 106 |
by (unfold bounded_def, blast) |
107 |
||
108 |
lemma monoD: |
|
13006 | 109 |
"\<lbrakk> mono r step n A; p < n; s\<in>A; s <=_r t \<rbrakk> \<Longrightarrow> step p s <=|r| step p t" |
10496 | 110 |
by (unfold mono_def, blast) |
111 |
||
112 |
(** merges **) |
|
113 |
||
114 |
lemma length_merges [rule_format, simp]: |
|
12516 | 115 |
"\<forall>ss. size(merges f ps ss) = size ss" |
10496 | 116 |
by (induct_tac ps, auto) |
117 |
||
12516 | 118 |
|
119 |
lemma merges_preserves_type_lemma: |
|
13006 | 120 |
"semilat(A,r,f) \<Longrightarrow> |
121 |
\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A) |
|
122 |
\<longrightarrow> merges f ps xs \<in> list n A" |
|
12516 | 123 |
apply (frule semilatDclosedI) |
124 |
apply (unfold closed_def) |
|
10496 | 125 |
apply (induct_tac ps) |
12516 | 126 |
apply simp |
127 |
apply clarsimp |
|
10496 | 128 |
done |
129 |
||
12516 | 130 |
lemma merges_preserves_type [simp]: |
13006 | 131 |
"\<lbrakk> semilat(A,r,f); xs \<in> list n A; \<forall>(p,x) \<in> set ps. p<n \<and> x\<in>A \<rbrakk> |
132 |
\<Longrightarrow> merges f ps xs \<in> list n A" |
|
12516 | 133 |
by (simp add: merges_preserves_type_lemma) |
134 |
||
135 |
lemma merges_incr_lemma: |
|
13006 | 136 |
"semilat(A,r,f) \<Longrightarrow> |
137 |
\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A) \<longrightarrow> xs <=[r] merges f ps xs" |
|
10496 | 138 |
apply (induct_tac ps) |
139 |
apply simp |
|
140 |
apply simp |
|
141 |
apply clarify |
|
142 |
apply (rule order_trans) |
|
143 |
apply simp |
|
144 |
apply (erule list_update_incr) |
|
145 |
apply assumption |
|
146 |
apply simp |
|
147 |
apply simp |
|
148 |
apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in]) |
|
149 |
done |
|
150 |
||
12516 | 151 |
lemma merges_incr: |
13006 | 152 |
"\<lbrakk> semilat(A,r,f); xs \<in> list n A; \<forall>(p,x)\<in>set ps. p<size xs \<and> x \<in> A \<rbrakk> |
153 |
\<Longrightarrow> xs <=[r] merges f ps xs" |
|
12516 | 154 |
by (simp add: merges_incr_lemma) |
155 |
||
156 |
||
10496 | 157 |
lemma merges_same_conv [rule_format]: |
13006 | 158 |
"semilat(A,r,f) \<Longrightarrow> |
159 |
(\<forall>xs. xs \<in> list n A \<longrightarrow> (\<forall>(p,x)\<in>set ps. p<size xs \<and> x\<in>A) \<longrightarrow> |
|
12516 | 160 |
(merges f ps xs = xs) = (\<forall>(p,x)\<in>set ps. x <=_r xs!p))" |
10496 | 161 |
apply (induct_tac ps) |
162 |
apply simp |
|
163 |
apply clarsimp |
|
12516 | 164 |
apply (rename_tac p x ps xs) |
10496 | 165 |
apply (rule iffI) |
166 |
apply (rule context_conjI) |
|
167 |
apply (subgoal_tac "xs[p := x +_f xs!p] <=[r] xs") |
|
168 |
apply (force dest!: le_listD simp add: nth_list_update) |
|
169 |
apply (erule subst, rule merges_incr) |
|
170 |
apply assumption |
|
171 |
apply (blast intro!: listE_set intro: closedD listE_length [THEN nth_in]) |
|
12516 | 172 |
apply clarify |
173 |
apply (rule conjI) |
|
174 |
apply simp |
|
175 |
apply (blast dest: boundedD) |
|
176 |
apply blast |
|
10496 | 177 |
apply clarify |
178 |
apply (rotate_tac -2) |
|
179 |
apply (erule allE) |
|
180 |
apply (erule impE) |
|
181 |
apply assumption |
|
182 |
apply (erule impE) |
|
183 |
apply assumption |
|
184 |
apply (drule bspec) |
|
185 |
apply assumption |
|
186 |
apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2]) |
|
12516 | 187 |
apply blast |
10496 | 188 |
apply clarify |
189 |
apply (simp add: le_iff_plus_unchanged [THEN iffD1] list_update_same_conv [THEN iffD2]) |
|
190 |
done |
|
191 |
||
192 |
||
193 |
lemma list_update_le_listI [rule_format]: |
|
13006 | 194 |
"set xs <= A \<longrightarrow> set ys <= A \<longrightarrow> xs <=[r] ys \<longrightarrow> p < size xs \<longrightarrow> |
195 |
x <=_r ys!p \<longrightarrow> semilat(A,r,f) \<longrightarrow> x\<in>A \<longrightarrow> |
|
10496 | 196 |
xs[p := x +_f xs!p] <=[r] ys" |
197 |
apply (unfold Listn.le_def lesub_def semilat_def) |
|
198 |
apply (simp add: list_all2_conv_all_nth nth_list_update) |
|
199 |
done |
|
200 |
||
201 |
lemma merges_pres_le_ub: |
|
13006 | 202 |
"\<lbrakk> semilat(A,r,f); set ts <= A; set ss <= A; |
12516 | 203 |
\<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p < size ts; |
13006 | 204 |
ss <=[r] ts \<rbrakk> |
205 |
\<Longrightarrow> merges f ps ss <=[r] ts" |
|
10496 | 206 |
proof - |
207 |
{ fix A r f t ts ps |
|
208 |
have |
|
13006 | 209 |
"\<And>qs. \<lbrakk> semilat(A,r,f); set ts <= A; |
210 |
\<forall>(p,t)\<in>set ps. t <=_r ts!p \<and> t \<in> A \<and> p < size ts \<rbrakk> \<Longrightarrow> |
|
211 |
set qs <= set ps \<longrightarrow> |
|
212 |
(\<forall>ss. set ss <= A \<longrightarrow> ss <=[r] ts \<longrightarrow> merges f qs ss <=[r] ts)" |
|
10496 | 213 |
apply (induct_tac qs) |
214 |
apply simp |
|
215 |
apply (simp (no_asm_simp)) |
|
216 |
apply clarify |
|
217 |
apply (rotate_tac -2) |
|
218 |
apply simp |
|
219 |
apply (erule allE, erule impE, erule_tac [2] mp) |
|
12516 | 220 |
apply (drule bspec, assumption) |
221 |
apply (simp add: closedD) |
|
222 |
apply (drule bspec, assumption) |
|
10496 | 223 |
apply (simp add: list_update_le_listI) |
12516 | 224 |
done |
10496 | 225 |
} note this [dest] |
226 |
||
11549 | 227 |
case rule_context |
10496 | 228 |
thus ?thesis by blast |
229 |
qed |
|
230 |
||
231 |
||
12516 | 232 |
(** propa **) |
10496 | 233 |
|
234 |
||
12516 | 235 |
lemma decomp_propa: |
13006 | 236 |
"\<And>ss w. (\<forall>(q,t)\<in>set qs. q < size ss) \<Longrightarrow> |
12516 | 237 |
propa f qs ss w = |
238 |
(merges f qs ss, {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un w)" |
|
239 |
apply (induct qs) |
|
240 |
apply simp |
|
10496 | 241 |
apply (simp (no_asm)) |
12516 | 242 |
apply clarify |
243 |
apply simp |
|
244 |
apply (rule conjI) |
|
10496 | 245 |
apply (simp add: nth_list_update) |
246 |
apply blast |
|
247 |
apply (simp add: nth_list_update) |
|
248 |
apply blast |
|
249 |
done |
|
250 |
||
251 |
(** iter **) |
|
252 |
||
12516 | 253 |
lemma plusplus_closed: |
254 |
"\<And>y. \<lbrakk>semilat (A, r, f); set x \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> x ++_f y \<in> A" |
|
255 |
proof (induct x) |
|
256 |
show "\<And>y. y \<in> A \<Longrightarrow> [] ++_f y \<in> A" by simp |
|
257 |
fix y x xs |
|
258 |
assume sl: "semilat (A, r, f)" and y: "y \<in> A" and xs: "set (x#xs) \<subseteq> A" |
|
259 |
assume IH: "\<And>y. \<lbrakk>semilat (A, r, f); set xs \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> xs ++_f y \<in> A" |
|
260 |
from xs obtain x: "x \<in> A" and "set xs \<subseteq> A" by simp |
|
261 |
from sl x y have "(x +_f y) \<in> A" by (simp add: closedD) |
|
262 |
with sl xs have "xs ++_f (x +_f y) \<in> A" by - (rule IH) |
|
263 |
thus "(x#xs) ++_f y \<in> A" by simp |
|
264 |
qed |
|
265 |
||
13006 | 266 |
lemma ub2: "\<And>y. \<lbrakk>semilat (A, r, f); set x \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> y <=_r x ++_f y" |
12516 | 267 |
proof (induct x) |
268 |
show "\<And>y. semilat(A, r, f) \<Longrightarrow> y <=_r [] ++_f y" by simp |
|
269 |
||
270 |
fix y a l |
|
271 |
assume sl: "semilat (A, r, f)" |
|
272 |
assume y: "y \<in> A" |
|
273 |
assume "set (a#l) \<subseteq> A" |
|
274 |
then obtain a: "a \<in> A" and x: "set l \<subseteq> A" by simp |
|
275 |
assume "\<And>y. \<lbrakk>semilat (A, r, f); set l \<subseteq> A; y \<in> A\<rbrakk> \<Longrightarrow> y <=_r l ++_f y" |
|
276 |
hence IH: "\<And>y. y \<in> A \<Longrightarrow> y <=_r l ++_f y" . |
|
277 |
||
278 |
from sl have "order r" .. note order_trans [OF this, trans] |
|
279 |
||
280 |
from sl a y have "y <=_r a +_f y" by (rule semilat_ub2) |
|
281 |
also |
|
282 |
from sl a y have "a +_f y \<in> A" by (simp add: closedD) |
|
283 |
hence "(a +_f y) <=_r l ++_f (a +_f y)" by (rule IH) |
|
284 |
finally |
|
285 |
have "y <=_r l ++_f (a +_f y)" . |
|
286 |
thus "y <=_r (a#l) ++_f y" by simp |
|
287 |
qed |
|
288 |
||
289 |
||
13006 | 290 |
lemma ub1: |
291 |
"\<And>y. \<lbrakk>semilat (A, r, f); set ls \<subseteq> A; y \<in> A; x \<in> set ls\<rbrakk> \<Longrightarrow> x <=_r ls ++_f y" |
|
12516 | 292 |
proof (induct ls) |
293 |
show "\<And>y. x \<in> set [] \<Longrightarrow> x <=_r [] ++_f y" by simp |
|
294 |
||
295 |
fix y s ls |
|
296 |
assume sl: "semilat (A, r, f)" |
|
297 |
hence "order r" .. note order_trans [OF this, trans] |
|
298 |
assume "set (s#ls) \<subseteq> A" |
|
299 |
then obtain s: "s \<in> A" and ls: "set ls \<subseteq> A" by simp |
|
300 |
assume y: "y \<in> A" |
|
301 |
||
13006 | 302 |
assume |
303 |
"\<And>y. \<lbrakk>semilat (A, r, f); set ls \<subseteq> A; y \<in> A; x \<in> set ls\<rbrakk> \<Longrightarrow> x <=_r ls ++_f y" |
|
12516 | 304 |
hence IH: "\<And>y. x \<in> set ls \<Longrightarrow> y \<in> A \<Longrightarrow> x <=_r ls ++_f y" . |
305 |
||
306 |
assume "x \<in> set (s#ls)" |
|
307 |
then obtain xls: "x = s \<or> x \<in> set ls" by simp |
|
308 |
moreover { |
|
309 |
assume xs: "x = s" |
|
310 |
from sl s y have "s <=_r s +_f y" by (rule semilat_ub1) |
|
311 |
also |
|
312 |
from sl s y have "s +_f y \<in> A" by (simp add: closedD) |
|
313 |
with sl ls have "(s +_f y) <=_r ls ++_f (s +_f y)" by (rule ub2) |
|
314 |
finally |
|
315 |
have "s <=_r ls ++_f (s +_f y)" . |
|
316 |
with xs have "x <=_r ls ++_f (s +_f y)" by simp |
|
317 |
} |
|
318 |
moreover { |
|
319 |
assume "x \<in> set ls" |
|
320 |
hence "\<And>y. y \<in> A \<Longrightarrow> x <=_r ls ++_f y" by (rule IH) |
|
321 |
moreover |
|
322 |
from sl s y |
|
323 |
have "s +_f y \<in> A" by (simp add: closedD) |
|
324 |
ultimately |
|
325 |
have "x <=_r ls ++_f (s +_f y)" . |
|
326 |
} |
|
327 |
ultimately |
|
328 |
have "x <=_r ls ++_f (s +_f y)" by blast |
|
329 |
thus "x <=_r (s#ls) ++_f y" by simp |
|
330 |
qed |
|
331 |
||
332 |
||
333 |
lemma ub1': |
|
334 |
"\<lbrakk>semilat (A, r, f); \<forall>(p,s) \<in> set S. s \<in> A; y \<in> A; (a,b) \<in> set S\<rbrakk> |
|
335 |
\<Longrightarrow> b <=_r map snd [(p', t')\<in>S. p' = a] ++_f y" |
|
336 |
proof - |
|
337 |
let "b <=_r ?map ++_f y" = ?thesis |
|
338 |
||
339 |
assume "semilat (A, r, f)" "y \<in> A" |
|
340 |
moreover |
|
341 |
assume "\<forall>(p,s) \<in> set S. s \<in> A" |
|
342 |
hence "set ?map \<subseteq> A" by auto |
|
343 |
moreover |
|
344 |
assume "(a,b) \<in> set S" |
|
345 |
hence "b \<in> set ?map" by (induct S, auto) |
|
346 |
ultimately |
|
347 |
show ?thesis by - (rule ub1) |
|
348 |
qed |
|
349 |
||
350 |
||
351 |
||
352 |
lemma plusplus_empty: |
|
353 |
"\<forall>s'. (q, s') \<in> set S \<longrightarrow> s' +_f ss ! q = ss ! q \<Longrightarrow> |
|
354 |
(map snd [(p', t')\<in> S. p' = q] ++_f ss ! q) = ss ! q" |
|
355 |
apply (induct S) |
|
356 |
apply auto |
|
357 |
done |
|
358 |
||
359 |
||
10496 | 360 |
lemma stable_pres_lemma: |
13006 | 361 |
"\<lbrakk> semilat (A,r,f); pres_type step n A; bounded step n; |
12516 | 362 |
ss \<in> list n A; p \<in> w; \<forall>q\<in>w. q < n; |
363 |
\<forall>q. q < n \<longrightarrow> q \<notin> w \<longrightarrow> stable r step ss q; q < n; |
|
364 |
\<forall>s'. (q,s') \<in> set (step p (ss ! p)) \<longrightarrow> s' +_f ss ! q = ss ! q; |
|
13006 | 365 |
q \<notin> w \<or> q = p \<rbrakk> |
366 |
\<Longrightarrow> stable r step (merges f (step p (ss!p)) ss) q" |
|
10496 | 367 |
apply (unfold stable_def) |
12516 | 368 |
apply (subgoal_tac "\<forall>s'. (q,s') \<in> set (step p (ss!p)) \<longrightarrow> s' : A") |
369 |
prefer 2 |
|
370 |
apply clarify |
|
371 |
apply (erule pres_typeD) |
|
372 |
prefer 3 apply assumption |
|
373 |
apply (rule listE_nth_in) |
|
374 |
apply assumption |
|
375 |
apply simp |
|
376 |
apply simp |
|
10496 | 377 |
apply simp |
378 |
apply clarify |
|
12516 | 379 |
apply (subst nth_merges) |
380 |
apply assumption |
|
381 |
apply simp |
|
382 |
apply (blast dest: boundedD) |
|
10496 | 383 |
apply assumption |
12516 | 384 |
apply clarify |
385 |
apply (rule conjI) |
|
386 |
apply (blast dest: boundedD) |
|
387 |
apply (erule pres_typeD) |
|
388 |
prefer 3 apply assumption |
|
389 |
apply simp |
|
390 |
apply simp |
|
391 |
apply (frule nth_merges [of _ _ _ q _ _ "step p (ss!p)"]) (* fixme: why does method subst not work?? *) |
|
392 |
prefer 2 apply assumption |
|
393 |
apply simp |
|
394 |
apply clarify |
|
10496 | 395 |
apply (rule conjI) |
12516 | 396 |
apply (blast dest: boundedD) |
397 |
apply (erule pres_typeD) |
|
398 |
prefer 3 apply assumption |
|
399 |
apply simp |
|
400 |
apply simp |
|
401 |
apply (drule_tac P = "\<lambda>x. (a, b) \<in> set (step q x)" in subst) |
|
402 |
apply assumption |
|
403 |
||
404 |
apply (simp add: plusplus_empty) |
|
405 |
apply (cases "q \<in> w") |
|
406 |
apply simp |
|
407 |
apply (rule ub1') |
|
408 |
apply assumption |
|
409 |
apply clarify |
|
410 |
apply (rule pres_typeD) |
|
411 |
apply assumption |
|
412 |
prefer 3 apply assumption |
|
413 |
apply (blast intro: listE_nth_in dest: boundedD) |
|
414 |
apply (blast intro: pres_typeD dest: boundedD) |
|
415 |
apply (blast intro: listE_nth_in dest: boundedD) |
|
416 |
apply assumption |
|
10496 | 417 |
|
12516 | 418 |
apply simp |
419 |
apply (erule allE, erule impE, assumption, erule impE, assumption) |
|
420 |
apply (rule order_trans) |
|
421 |
apply simp |
|
422 |
defer |
|
423 |
apply (rule ub2) |
|
424 |
apply assumption |
|
425 |
apply simp |
|
426 |
apply clarify |
|
427 |
apply simp |
|
428 |
apply (rule pres_typeD) |
|
429 |
apply assumption |
|
430 |
prefer 3 apply assumption |
|
431 |
apply (blast intro: listE_nth_in dest: boundedD) |
|
432 |
apply (blast intro: pres_typeD dest: boundedD) |
|
433 |
apply (blast intro: listE_nth_in dest: boundedD) |
|
434 |
apply blast |
|
435 |
done |
|
436 |
||
437 |
||
438 |
lemma lesub_step_type: |
|
13006 | 439 |
"\<And>b x y. a <=|r| b \<Longrightarrow> (x,y) \<in> set a \<Longrightarrow> \<exists>y'. (x, y') \<in> set b \<and> y <=_r y'" |
12516 | 440 |
apply (induct a) |
441 |
apply simp |
|
442 |
apply simp |
|
443 |
apply (case_tac b) |
|
444 |
apply simp |
|
445 |
apply simp |
|
446 |
apply (erule disjE) |
|
447 |
apply clarify |
|
448 |
apply (simp add: lesub_def) |
|
449 |
apply blast |
|
450 |
apply clarify |
|
451 |
apply blast |
|
452 |
done |
|
453 |
||
454 |
||
455 |
lemma merges_bounded_lemma: |
|
13006 | 456 |
"\<lbrakk> semilat (A,r,f); mono r step n A; bounded step n; |
12516 | 457 |
\<forall>(p',s') \<in> set (step p (ss!p)). s' \<in> A; ss \<in> list n A; ts \<in> list n A; p < n; |
13006 | 458 |
ss <=[r] ts; ! p. p < n \<longrightarrow> stable r step ts p \<rbrakk> |
459 |
\<Longrightarrow> merges f (step p (ss!p)) ss <=[r] ts" |
|
10496 | 460 |
apply (unfold stable_def) |
12516 | 461 |
apply (rule merges_pres_le_ub) |
462 |
apply assumption |
|
463 |
apply simp |
|
464 |
apply simp |
|
465 |
prefer 2 apply assumption |
|
466 |
||
467 |
apply clarsimp |
|
468 |
apply (drule boundedD, assumption+) |
|
469 |
apply (erule allE, erule impE, assumption) |
|
470 |
apply (drule bspec, assumption) |
|
471 |
apply simp |
|
472 |
||
473 |
apply (drule monoD [of _ _ _ _ p "ss!p" "ts!p"]) |
|
474 |
apply assumption |
|
475 |
apply simp |
|
476 |
apply (simp add: le_listD) |
|
477 |
||
478 |
apply (drule lesub_step_type, assumption) |
|
479 |
apply clarify |
|
480 |
apply (drule bspec, assumption) |
|
481 |
apply simp |
|
482 |
apply (blast intro: order_trans) |
|
10496 | 483 |
done |
484 |
||
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
485 |
lemma termination_lemma: |
13006 | 486 |
"\<lbrakk> semilat(A,r,f); ss \<in> list n A; \<forall>(q,t)\<in>set qs. q<n \<and> t\<in>A; p\<in>w \<rbrakk> \<Longrightarrow> |
12516 | 487 |
ss <[r] merges f qs ss \<or> |
488 |
merges f qs ss = ss \<and> {q. \<exists>t. (q,t)\<in>set qs \<and> t +_f ss!q \<noteq> ss!q} Un (w-{p}) < w" |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
489 |
apply (unfold lesssub_def) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
490 |
apply (simp (no_asm_simp) add: merges_incr) |
10496 | 491 |
apply (rule impI) |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
492 |
apply (rule merges_same_conv [THEN iffD1, elim_format]) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
493 |
apply assumption+ |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
494 |
defer |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
495 |
apply (rule sym, assumption) |
12516 | 496 |
defer apply simp |
497 |
apply (subgoal_tac "\<forall>q t. \<not>((q, t) \<in> set qs \<and> t +_f ss ! q \<noteq> ss ! q)") |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
498 |
apply (blast intro!: psubsetI elim: equalityE) |
12516 | 499 |
apply clarsimp |
500 |
apply (drule bspec, assumption) |
|
501 |
apply (drule bspec, assumption) |
|
502 |
apply clarsimp |
|
503 |
done |
|
10496 | 504 |
|
11298 | 505 |
lemma iter_properties[rule_format]: |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
506 |
"\<lbrakk> semilat(A,r,f); acc r ; pres_type step n A; mono r step n A; |
12516 | 507 |
bounded step n; \<forall>p\<in>w0. p < n; ss0 \<in> list n A; |
508 |
\<forall>p<n. p \<notin> w0 \<longrightarrow> stable r step ss0 p \<rbrakk> \<Longrightarrow> |
|
509 |
iter f step ss0 w0 = (ss',w') |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
510 |
\<longrightarrow> |
12516 | 511 |
ss' \<in> list n A \<and> stables r step ss' \<and> ss0 <=[r] ss' \<and> |
512 |
(\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss' <=[r] ts)" |
|
11298 | 513 |
apply (unfold iter_def stables_def) |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
514 |
apply (rule_tac P = "%(ss,w). |
12516 | 515 |
ss \<in> list n A \<and> (\<forall>p<n. p \<notin> w \<longrightarrow> stable r step ss p) \<and> ss0 <=[r] ss \<and> |
516 |
(\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> ss <=[r] ts) \<and> |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
517 |
(\<forall>p\<in>w. p < n)" and |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
518 |
r = "{(ss',ss) . ss <[r] ss'} <*lex*> finite_psubset" |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
519 |
in while_rule) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
520 |
|
12516 | 521 |
-- "Invariant holds initially:" |
522 |
apply (simp add:stables_def) |
|
523 |
||
524 |
-- "Invariant is preserved:" |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
525 |
apply(simp add: stables_def split_paired_all) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
526 |
apply(rename_tac ss w) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
527 |
apply(subgoal_tac "(SOME p. p \<in> w) \<in> w") |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
528 |
prefer 2; apply (fast intro: someI) |
12516 | 529 |
apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A") |
530 |
prefer 2 |
|
531 |
apply clarify |
|
532 |
apply (rule conjI) |
|
533 |
apply(clarsimp, blast dest!: boundedD) |
|
534 |
apply (erule pres_typeD) |
|
535 |
prefer 3 |
|
536 |
apply assumption |
|
537 |
apply (erule listE_nth_in) |
|
538 |
apply blast |
|
539 |
apply blast |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
540 |
apply (subst decomp_propa) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
541 |
apply blast |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
542 |
apply simp |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
543 |
apply (rule conjI) |
12516 | 544 |
apply (erule merges_preserves_type) |
545 |
apply blast |
|
546 |
apply clarify |
|
547 |
apply (rule conjI) |
|
548 |
apply(clarsimp, blast dest!: boundedD) |
|
549 |
apply (erule pres_typeD) |
|
550 |
prefer 3 |
|
551 |
apply assumption |
|
552 |
apply (erule listE_nth_in) |
|
553 |
apply blast |
|
554 |
apply blast |
|
555 |
apply (rule conjI) |
|
556 |
apply clarify |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
557 |
apply (blast intro!: stable_pres_lemma) |
12516 | 558 |
apply (rule conjI) |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
559 |
apply (blast intro!: merges_incr intro: le_list_trans) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
560 |
apply (rule conjI) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
561 |
apply clarsimp |
12516 | 562 |
apply (blast intro!: merges_bounded_lemma) |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
563 |
apply (blast dest!: boundedD) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
564 |
|
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
565 |
|
12516 | 566 |
-- "Postcondition holds upon termination:" |
567 |
apply(clarsimp simp add: stables_def split_paired_all) |
|
568 |
||
569 |
-- "Well-foundedness of the termination relation:" |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
570 |
apply (rule wf_lex_prod) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
571 |
apply (drule (1) semilatDorderI [THEN acc_le_listI]) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
572 |
apply (simp only: acc_def lesssub_def) |
12516 | 573 |
apply (rule wf_finite_psubset) |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
574 |
|
12516 | 575 |
-- "Loop decreases along termination relation:" |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
576 |
apply(simp add: stables_def split_paired_all) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
577 |
apply(rename_tac ss w) |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
578 |
apply(subgoal_tac "(SOME p. p \<in> w) \<in> w") |
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
579 |
prefer 2; apply (fast intro: someI) |
12516 | 580 |
apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A") |
581 |
prefer 2 |
|
582 |
apply clarify |
|
583 |
apply (rule conjI) |
|
584 |
apply(clarsimp, blast dest!: boundedD) |
|
585 |
apply (erule pres_typeD) |
|
586 |
prefer 3 |
|
587 |
apply assumption |
|
588 |
apply (erule listE_nth_in) |
|
589 |
apply blast |
|
590 |
apply blast |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
591 |
apply (subst decomp_propa) |
12516 | 592 |
apply blast |
593 |
apply clarify |
|
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
594 |
apply (simp del: listE_length |
12516 | 595 |
add: lex_prod_def finite_psubset_def |
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
596 |
bounded_nat_set_is_finite) |
12516 | 597 |
apply (rule termination_lemma) |
598 |
apply assumption+ |
|
599 |
defer |
|
600 |
apply assumption |
|
601 |
apply clarsimp |
|
602 |
apply (blast dest!: boundedD) |
|
603 |
done |
|
604 |
||
11175
56ab6a5ba351
recoded function iter with the help of the while-combinator.
nipkow
parents:
10774
diff
changeset
|
605 |
|
11229 | 606 |
lemma kildall_properties: |
607 |
"\<lbrakk> semilat(A,r,f); acc r; pres_type step n A; mono r step n A; |
|
12516 | 608 |
bounded step n; ss0 \<in> list n A \<rbrakk> \<Longrightarrow> |
609 |
kildall r f step ss0 \<in> list n A \<and> |
|
610 |
stables r step (kildall r f step ss0) \<and> |
|
611 |
ss0 <=[r] kildall r f step ss0 \<and> |
|
612 |
(\<forall>ts\<in>list n A. ss0 <=[r] ts \<and> stables r step ts \<longrightarrow> |
|
613 |
kildall r f step ss0 <=[r] ts)" |
|
11229 | 614 |
apply (unfold kildall_def) |
12516 | 615 |
apply(case_tac "iter f step ss0 (unstables r step ss0)") |
11298 | 616 |
apply(simp) |
11229 | 617 |
apply (rule iter_properties) |
618 |
apply (simp_all add: unstables_def stable_def) |
|
619 |
done |
|
10496 | 620 |
|
621 |
lemma is_bcv_kildall: |
|
13006 | 622 |
"\<lbrakk> semilat(A,r,f); acc r; top r T; |
12516 | 623 |
pres_type step n A; bounded step n; |
13006 | 624 |
mono r step n A \<rbrakk> |
625 |
\<Longrightarrow> is_bcv r T step n A (kildall r f step)" |
|
11299 | 626 |
apply(unfold is_bcv_def wt_step_def) |
11229 | 627 |
apply(insert kildall_properties[of A]) |
628 |
apply(simp add:stables_def) |
|
629 |
apply clarify |
|
12516 | 630 |
apply(subgoal_tac "kildall r f step ss \<in> list n A") |
11229 | 631 |
prefer 2 apply (simp(no_asm_simp)) |
632 |
apply (rule iffI) |
|
12516 | 633 |
apply (rule_tac x = "kildall r f step ss" in bexI) |
11229 | 634 |
apply (rule conjI) |
635 |
apply blast |
|
636 |
apply (simp (no_asm_simp)) |
|
637 |
apply assumption |
|
638 |
apply clarify |
|
12516 | 639 |
apply(subgoal_tac "kildall r f step ss!p <=_r ts!p") |
11229 | 640 |
apply simp |
641 |
apply (blast intro!: le_listD less_lengthI) |
|
642 |
done |
|
10496 | 643 |
|
12516 | 644 |
end |