author | wenzelm |
Sat, 14 Jun 2008 23:19:51 +0200 | |
changeset 27208 | 5fe899199f85 |
parent 26359 | 6d437bde2f1d |
child 35174 | e15040ae75d7 |
permissions | -rw-r--r-- |
3071 | 1 |
(* Title: HOLCF/IOA/meta_theory/ShortExecutions.thy |
3275 | 2 |
ID: $Id$ |
12218 | 3 |
Author: Olaf Müller |
17256 | 4 |
*) |
3071 | 5 |
|
17256 | 6 |
theory ShortExecutions |
7 |
imports Traces |
|
8 |
begin |
|
3071 | 9 |
|
17256 | 10 |
text {* |
11 |
Some properties about @{text "Cut ex"}, defined as follows: |
|
3071 | 12 |
|
17256 | 13 |
For every execution ex there is another shorter execution @{text "Cut ex"} |
14 |
that has the same trace as ex, but its schedule ends with an external action. |
|
15 |
*} |
|
3071 | 16 |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
17 |
definition |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
18 |
oraclebuild :: "('a => bool) => 'a Seq -> 'a Seq -> 'a Seq" where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
19 |
"oraclebuild P = (fix$(LAM h s t. case t of |
3275 | 20 |
nil => nil |
17256 | 21 |
| x##xs => |
22 |
(case x of |
|
12028 | 23 |
UU => UU |
10835 | 24 |
| Def y => (Takewhile (%x.~P x)$s) |
25 |
@@ (y>>(h$(TL$(Dropwhile (%x.~ P x)$s))$xs)) |
|
3275 | 26 |
) |
27 |
))" |
|
28 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
29 |
definition |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
30 |
Cut :: "('a => bool) => 'a Seq => 'a Seq" where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
31 |
"Cut P s = oraclebuild P$s$(Filter P$s)" |
3071 | 32 |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
33 |
definition |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
34 |
LastActExtsch :: "('a,'s)ioa => 'a Seq => bool" where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
35 |
"LastActExtsch A sch = (Cut (%x. x: ext A) sch = sch)" |
3071 | 36 |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
37 |
(* LastActExtex ::"('a,'s)ioa => ('a,'s) pairs => bool"*) |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
38 |
(* LastActExtex_def: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
39 |
"LastActExtex A ex == LastActExtsch A (filter_act$ex)" *) |
3071 | 40 |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
41 |
axiomatization where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
42 |
Cut_prefixcl_Finite: "Finite s ==> (? y. s = Cut P s @@ y)" |
3071 | 43 |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
44 |
axiomatization where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
45 |
LastActExtsmall1: "LastActExtsch A sch ==> LastActExtsch A (TL$(Dropwhile P$sch))" |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
46 |
|
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
47 |
axiomatization where |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
48 |
LastActExtsmall2: "[| Finite sch1; LastActExtsch A (sch1 @@ sch2) |] ==> LastActExtsch A sch2" |
19741 | 49 |
|
50 |
||
51 |
ML {* |
|
52 |
fun thin_tac' j = |
|
53 |
rotate_tac (j - 1) THEN' |
|
54 |
etac thin_rl THEN' |
|
55 |
rotate_tac (~ (j - 1)) |
|
56 |
*} |
|
57 |
||
58 |
||
59 |
subsection "oraclebuild rewrite rules" |
|
60 |
||
61 |
||
62 |
lemma oraclebuild_unfold: |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
63 |
"oraclebuild P = (LAM s t. case t of |
19741 | 64 |
nil => nil |
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
65 |
| x##xs => |
19741 | 66 |
(case x of |
67 |
UU => UU |
|
68 |
| Def y => (Takewhile (%a.~ P a)$s) |
|
69 |
@@ (y>>(oraclebuild P$(TL$(Dropwhile (%a.~ P a)$s))$xs)) |
|
70 |
) |
|
71 |
)" |
|
72 |
apply (rule trans) |
|
73 |
apply (rule fix_eq2) |
|
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
74 |
apply (simp only: oraclebuild_def) |
19741 | 75 |
apply (rule beta_cfun) |
76 |
apply simp |
|
77 |
done |
|
78 |
||
79 |
lemma oraclebuild_UU: "oraclebuild P$sch$UU = UU" |
|
80 |
apply (subst oraclebuild_unfold) |
|
81 |
apply simp |
|
82 |
done |
|
83 |
||
84 |
lemma oraclebuild_nil: "oraclebuild P$sch$nil = nil" |
|
85 |
apply (subst oraclebuild_unfold) |
|
86 |
apply simp |
|
87 |
done |
|
88 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
89 |
lemma oraclebuild_cons: "oraclebuild P$s$(x>>t) = |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
90 |
(Takewhile (%a.~ P a)$s) |
19741 | 91 |
@@ (x>>(oraclebuild P$(TL$(Dropwhile (%a.~ P a)$s))$t))" |
92 |
apply (rule trans) |
|
93 |
apply (subst oraclebuild_unfold) |
|
94 |
apply (simp add: Consq_def) |
|
95 |
apply (simp add: Consq_def) |
|
96 |
done |
|
97 |
||
98 |
||
99 |
subsection "Cut rewrite rules" |
|
100 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
101 |
lemma Cut_nil: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
102 |
"[| Forall (%a.~ P a) s; Finite s|] |
19741 | 103 |
==> Cut P s =nil" |
104 |
apply (unfold Cut_def) |
|
105 |
apply (subgoal_tac "Filter P$s = nil") |
|
106 |
apply (simp (no_asm_simp) add: oraclebuild_nil) |
|
107 |
apply (rule ForallQFilterPnil) |
|
108 |
apply assumption+ |
|
109 |
done |
|
110 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
111 |
lemma Cut_UU: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
112 |
"[| Forall (%a.~ P a) s; ~Finite s|] |
19741 | 113 |
==> Cut P s =UU" |
114 |
apply (unfold Cut_def) |
|
115 |
apply (subgoal_tac "Filter P$s= UU") |
|
116 |
apply (simp (no_asm_simp) add: oraclebuild_UU) |
|
117 |
apply (rule ForallQFilterPUU) |
|
118 |
apply assumption+ |
|
119 |
done |
|
120 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
121 |
lemma Cut_Cons: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
122 |
"[| P t; Forall (%x.~ P x) ss; Finite ss|] |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
123 |
==> Cut P (ss @@ (t>> rs)) |
19741 | 124 |
= ss @@ (t >> Cut P rs)" |
125 |
apply (unfold Cut_def) |
|
126 |
apply (simp add: ForallQFilterPnil oraclebuild_cons TakewhileConc DropwhileConc) |
|
127 |
done |
|
128 |
||
129 |
||
130 |
subsection "Cut lemmas for main theorem" |
|
131 |
||
132 |
lemma FilterCut: "Filter P$s = Filter P$(Cut P s)" |
|
133 |
apply (rule_tac A1 = "%x. True" and Q1 = "%x.~ P x" and x1 = "s" in take_lemma_induct [THEN mp]) |
|
134 |
prefer 3 apply (fast) |
|
135 |
apply (case_tac "Finite s") |
|
136 |
apply (simp add: Cut_nil ForallQFilterPnil) |
|
137 |
apply (simp add: Cut_UU ForallQFilterPUU) |
|
138 |
(* main case *) |
|
139 |
apply (simp add: Cut_Cons ForallQFilterPnil) |
|
140 |
done |
|
141 |
||
142 |
||
143 |
lemma Cut_idemp: "Cut P (Cut P s) = (Cut P s)" |
|
144 |
apply (rule_tac A1 = "%x. True" and Q1 = "%x.~ P x" and x1 = "s" in |
|
145 |
take_lemma_less_induct [THEN mp]) |
|
146 |
prefer 3 apply (fast) |
|
147 |
apply (case_tac "Finite s") |
|
148 |
apply (simp add: Cut_nil ForallQFilterPnil) |
|
149 |
apply (simp add: Cut_UU ForallQFilterPUU) |
|
150 |
(* main case *) |
|
151 |
apply (simp add: Cut_Cons ForallQFilterPnil) |
|
152 |
apply (rule take_reduction) |
|
153 |
apply auto |
|
154 |
done |
|
155 |
||
156 |
||
157 |
lemma MapCut: "Map f$(Cut (P o f) s) = Cut P (Map f$s)" |
|
158 |
apply (rule_tac A1 = "%x. True" and Q1 = "%x.~ P (f x) " and x1 = "s" in |
|
159 |
take_lemma_less_induct [THEN mp]) |
|
160 |
prefer 3 apply (fast) |
|
161 |
apply (case_tac "Finite s") |
|
162 |
apply (simp add: Cut_nil) |
|
163 |
apply (rule Cut_nil [symmetric]) |
|
164 |
apply (simp add: ForallMap o_def) |
|
165 |
apply (simp add: Map2Finite) |
|
166 |
(* csae ~ Finite s *) |
|
167 |
apply (simp add: Cut_UU) |
|
168 |
apply (rule Cut_UU) |
|
169 |
apply (simp add: ForallMap o_def) |
|
170 |
apply (simp add: Map2Finite) |
|
171 |
(* main case *) |
|
172 |
apply (simp add: Cut_Cons MapConc ForallMap FiniteMap1 o_def) |
|
173 |
apply (rule take_reduction) |
|
174 |
apply auto |
|
175 |
done |
|
176 |
||
177 |
||
178 |
lemma Cut_prefixcl_nFinite [rule_format (no_asm)]: "~Finite s --> Cut P s << s" |
|
179 |
apply (intro strip) |
|
180 |
apply (rule take_lemma_less [THEN iffD1]) |
|
181 |
apply (intro strip) |
|
182 |
apply (rule mp) |
|
183 |
prefer 2 apply (assumption) |
|
184 |
apply (tactic "thin_tac' 1 1") |
|
185 |
apply (rule_tac x = "s" in spec) |
|
186 |
apply (rule nat_less_induct) |
|
187 |
apply (intro strip) |
|
188 |
apply (rename_tac na n s) |
|
189 |
apply (case_tac "Forall (%x. ~ P x) s") |
|
190 |
apply (rule take_lemma_less [THEN iffD2, THEN spec]) |
|
191 |
apply (simp add: Cut_UU) |
|
192 |
(* main case *) |
|
193 |
apply (drule divide_Seq3) |
|
194 |
apply (erule exE)+ |
|
195 |
apply (erule conjE)+ |
|
196 |
apply hypsubst |
|
197 |
apply (simp add: Cut_Cons) |
|
198 |
apply (rule take_reduction_less) |
|
199 |
(* auto makes also reasoning about Finiteness of parts of s ! *) |
|
200 |
apply auto |
|
201 |
done |
|
202 |
||
203 |
||
204 |
lemma execThruCut: "!!ex .is_exec_frag A (s,ex) ==> is_exec_frag A (s,Cut P ex)" |
|
205 |
apply (case_tac "Finite ex") |
|
206 |
apply (cut_tac s = "ex" and P = "P" in Cut_prefixcl_Finite) |
|
207 |
apply assumption |
|
208 |
apply (erule exE) |
|
209 |
apply (rule exec_prefix2closed) |
|
210 |
apply (erule_tac s = "ex" and t = "Cut P ex @@ y" in subst) |
|
211 |
apply assumption |
|
212 |
apply (erule exec_prefixclosed) |
|
213 |
apply (erule Cut_prefixcl_nFinite) |
|
214 |
done |
|
215 |
||
216 |
||
217 |
subsection "Main Cut Theorem" |
|
218 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
219 |
lemma exists_LastActExtsch: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
220 |
"[|sch : schedules A ; tr = Filter (%a. a:ext A)$sch|] |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
221 |
==> ? sch. sch : schedules A & |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
222 |
tr = Filter (%a. a:ext A)$sch & |
19741 | 223 |
LastActExtsch A sch" |
224 |
||
225 |
apply (unfold schedules_def has_schedule_def) |
|
26359 | 226 |
apply auto |
19741 | 227 |
apply (rule_tac x = "filter_act$ (Cut (%a. fst a:ext A) (snd ex))" in exI) |
228 |
apply (simp add: executions_def) |
|
27208
5fe899199f85
proper context for tactics derived from res_inst_tac;
wenzelm
parents:
26359
diff
changeset
|
229 |
apply (tactic {* pair_tac @{context} "ex" 1 *}) |
26359 | 230 |
apply auto |
19741 | 231 |
apply (rule_tac x = " (x,Cut (%a. fst a:ext A) y) " in exI) |
232 |
apply (simp (no_asm_simp)) |
|
233 |
||
234 |
(* Subgoal 1: Lemma: propagation of execution through Cut *) |
|
235 |
||
236 |
apply (simp add: execThruCut) |
|
237 |
||
238 |
(* Subgoal 2: Lemma: Filter P s = Filter P (Cut P s) *) |
|
239 |
||
240 |
apply (simp (no_asm) add: filter_act_def) |
|
241 |
apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) y) = Cut (%a. a:ext A) (Map fst$y) ") |
|
242 |
||
243 |
apply (rule_tac [2] MapCut [unfolded o_def]) |
|
244 |
apply (simp add: FilterCut [symmetric]) |
|
245 |
||
246 |
(* Subgoal 3: Lemma: Cut idempotent *) |
|
247 |
||
248 |
apply (simp (no_asm) add: LastActExtsch_def filter_act_def) |
|
249 |
apply (subgoal_tac "Map fst$ (Cut (%a. fst a: ext A) y) = Cut (%a. a:ext A) (Map fst$y) ") |
|
250 |
apply (rule_tac [2] MapCut [unfolded o_def]) |
|
251 |
apply (simp add: Cut_idemp) |
|
252 |
done |
|
253 |
||
254 |
||
255 |
subsection "Further Cut lemmas" |
|
256 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
257 |
lemma LastActExtimplnil: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
258 |
"[| LastActExtsch A sch; Filter (%x. x:ext A)$sch = nil |] |
19741 | 259 |
==> sch=nil" |
260 |
apply (unfold LastActExtsch_def) |
|
261 |
apply (drule FilternPnilForallP) |
|
262 |
apply (erule conjE) |
|
263 |
apply (drule Cut_nil) |
|
264 |
apply assumption |
|
265 |
apply simp |
|
266 |
done |
|
267 |
||
25135
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
268 |
lemma LastActExtimplUU: |
4f8176c940cf
modernized specifications ('definition', 'axiomatization');
wenzelm
parents:
19741
diff
changeset
|
269 |
"[| LastActExtsch A sch; Filter (%x. x:ext A)$sch = UU |] |
19741 | 270 |
==> sch=UU" |
271 |
apply (unfold LastActExtsch_def) |
|
272 |
apply (drule FilternPUUForallP) |
|
273 |
apply (erule conjE) |
|
274 |
apply (drule Cut_UU) |
|
275 |
apply assumption |
|
276 |
apply simp |
|
277 |
done |
|
17256 | 278 |
|
3071 | 279 |
end |