kleing@12951
|
1 |
(* Title: HOL/MicroJava/BV/BVExample.thy
|
kleing@12951
|
2 |
Author: Gerwin Klein
|
kleing@12951
|
3 |
*)
|
kleing@12951
|
4 |
|
kleing@12972
|
5 |
header {* \isaheader{Example Welltypings}\label{sec:BVExample} *}
|
kleing@12951
|
6 |
|
haftmann@23022
|
7 |
theory BVExample
|
wenzelm@24351
|
8 |
imports "../JVM/JVMListExample" BVSpecTypeSafe JVM Executable_Set
|
haftmann@23022
|
9 |
begin
|
kleing@12951
|
10 |
|
kleing@12972
|
11 |
text {*
|
kleing@12972
|
12 |
This theory shows type correctness of the example program in section
|
kleing@12972
|
13 |
\ref{sec:JVMListExample} (p. \pageref{sec:JVMListExample}) by
|
kleing@12972
|
14 |
explicitly providing a welltyping. It also shows that the start
|
kleing@12972
|
15 |
state of the program conforms to the welltyping; hence type safe
|
kleing@12972
|
16 |
execution is guaranteed.
|
kleing@12972
|
17 |
*}
|
kleing@12972
|
18 |
|
kleing@12951
|
19 |
section "Setup"
|
kleing@12951
|
20 |
text {*
|
kleing@12951
|
21 |
Since the types @{typ cnam}, @{text vnam}, and @{text mname} are
|
kleing@12951
|
22 |
anonymous, we describe distinctness of names in the example by axioms:
|
kleing@12951
|
23 |
*}
|
kleing@12951
|
24 |
axioms
|
kleing@12951
|
25 |
distinct_classes: "list_nam \<noteq> test_nam"
|
kleing@12951
|
26 |
distinct_fields: "val_nam \<noteq> next_nam"
|
kleing@12951
|
27 |
|
kleing@13101
|
28 |
text {* Abbreviations for definitions we will have to use often in the
|
kleing@12951
|
29 |
proofs below: *}
|
kleing@13101
|
30 |
lemmas name_defs = list_name_def test_name_def val_name_def next_name_def
|
kleing@12951
|
31 |
lemmas system_defs = SystemClasses_def ObjectC_def NullPointerC_def
|
kleing@12951
|
32 |
OutOfMemoryC_def ClassCastC_def
|
kleing@12951
|
33 |
lemmas class_defs = list_class_def test_class_def
|
kleing@12951
|
34 |
|
kleing@12951
|
35 |
text {* These auxiliary proofs are for efficiency: class lookup,
|
kleing@12951
|
36 |
subclass relation, method and field lookup are computed only once:
|
kleing@12951
|
37 |
*}
|
kleing@12951
|
38 |
lemma class_Object [simp]:
|
haftmann@28520
|
39 |
"class E Object = Some (undefined, [],[])"
|
kleing@12951
|
40 |
by (simp add: class_def system_defs E_def)
|
kleing@12951
|
41 |
|
kleing@12951
|
42 |
lemma class_NullPointer [simp]:
|
kleing@12951
|
43 |
"class E (Xcpt NullPointer) = Some (Object, [], [])"
|
kleing@12951
|
44 |
by (simp add: class_def system_defs E_def)
|
kleing@12951
|
45 |
|
kleing@12951
|
46 |
lemma class_OutOfMemory [simp]:
|
kleing@12951
|
47 |
"class E (Xcpt OutOfMemory) = Some (Object, [], [])"
|
kleing@12951
|
48 |
by (simp add: class_def system_defs E_def)
|
kleing@12951
|
49 |
|
kleing@12951
|
50 |
lemma class_ClassCast [simp]:
|
kleing@12951
|
51 |
"class E (Xcpt ClassCast) = Some (Object, [], [])"
|
kleing@12951
|
52 |
by (simp add: class_def system_defs E_def)
|
kleing@12951
|
53 |
|
kleing@12951
|
54 |
lemma class_list [simp]:
|
kleing@12951
|
55 |
"class E list_name = Some list_class"
|
kleing@12951
|
56 |
by (simp add: class_def system_defs E_def name_defs distinct_classes [symmetric])
|
kleing@12951
|
57 |
|
kleing@12951
|
58 |
lemma class_test [simp]:
|
kleing@12951
|
59 |
"class E test_name = Some test_class"
|
kleing@12951
|
60 |
by (simp add: class_def system_defs E_def name_defs distinct_classes [symmetric])
|
kleing@12951
|
61 |
|
kleing@12951
|
62 |
lemma E_classes [simp]:
|
kleing@12951
|
63 |
"{C. is_class E C} = {list_name, test_name, Xcpt NullPointer,
|
kleing@12951
|
64 |
Xcpt ClassCast, Xcpt OutOfMemory, Object}"
|
kleing@12951
|
65 |
by (auto simp add: is_class_def class_def system_defs E_def name_defs class_defs)
|
kleing@12951
|
66 |
|
kleing@12951
|
67 |
text {* The subclass releation spelled out: *}
|
kleing@12951
|
68 |
lemma subcls1:
|
haftmann@33953
|
69 |
"subcls1 E = {(list_name,Object), (test_name,Object), (Xcpt NullPointer, Object),
|
haftmann@33953
|
70 |
(Xcpt ClassCast, Object), (Xcpt OutOfMemory, Object)}"
|
nipkow@31197
|
71 |
apply (simp add: subcls1_def2)
|
nipkow@31166
|
72 |
apply (simp add: name_defs class_defs system_defs E_def class_def)
|
haftmann@33953
|
73 |
apply (simp add: Sigma_def)
|
haftmann@33953
|
74 |
apply auto
|
nipkow@31166
|
75 |
done
|
kleing@12951
|
76 |
|
kleing@12951
|
77 |
text {* The subclass relation is acyclic; hence its converse is well founded: *}
|
kleing@12951
|
78 |
lemma notin_rtrancl:
|
haftmann@33953
|
79 |
"(a, b) \<in> r\<^sup>* \<Longrightarrow> a \<noteq> b \<Longrightarrow> (\<And>y. (a, y) \<notin> r) \<Longrightarrow> False"
|
haftmann@33953
|
80 |
by (auto elim: converse_rtranclE)
|
kleing@12951
|
81 |
|
haftmann@33953
|
82 |
lemma acyclic_subcls1_E: "acyclic (subcls1 E)"
|
haftmann@33953
|
83 |
apply (rule acyclicI)
|
kleing@12951
|
84 |
apply (simp add: subcls1)
|
haftmann@33953
|
85 |
apply (auto dest!: tranclD)
|
kleing@12951
|
86 |
apply (auto elim!: notin_rtrancl simp add: name_defs distinct_classes)
|
kleing@12951
|
87 |
done
|
kleing@12951
|
88 |
|
haftmann@33953
|
89 |
lemma wf_subcls1_E: "wf ((subcls1 E)\<inverse>)"
|
haftmann@33953
|
90 |
apply (rule finite_acyclic_wf_converse)
|
berghofe@23757
|
91 |
apply (simp add: subcls1 del: insert_iff)
|
kleing@12951
|
92 |
apply (rule acyclic_subcls1_E)
|
kleing@12951
|
93 |
done
|
kleing@12951
|
94 |
|
kleing@12951
|
95 |
text {* Method and field lookup: *}
|
kleing@12951
|
96 |
lemma method_Object [simp]:
|
haftmann@31852
|
97 |
"method (E, Object) = Map.empty"
|
kleing@12951
|
98 |
by (simp add: method_rec_lemma [OF class_Object wf_subcls1_E])
|
kleing@12951
|
99 |
|
kleing@12951
|
100 |
lemma method_append [simp]:
|
kleing@12951
|
101 |
"method (E, list_name) (append_name, [Class list_name]) =
|
kleing@12951
|
102 |
Some (list_name, PrimT Void, 3, 0, append_ins, [(1, 2, 8, Xcpt NullPointer)])"
|
kleing@12951
|
103 |
apply (insert class_list)
|
kleing@12951
|
104 |
apply (unfold list_class_def)
|
kleing@12951
|
105 |
apply (drule method_rec_lemma [OF _ wf_subcls1_E])
|
kleing@12951
|
106 |
apply simp
|
kleing@12951
|
107 |
done
|
kleing@12951
|
108 |
|
kleing@12951
|
109 |
lemma method_makelist [simp]:
|
kleing@12951
|
110 |
"method (E, test_name) (makelist_name, []) =
|
kleing@12951
|
111 |
Some (test_name, PrimT Void, 3, 2, make_list_ins, [])"
|
kleing@12951
|
112 |
apply (insert class_test)
|
kleing@12951
|
113 |
apply (unfold test_class_def)
|
kleing@12951
|
114 |
apply (drule method_rec_lemma [OF _ wf_subcls1_E])
|
kleing@12951
|
115 |
apply simp
|
kleing@12951
|
116 |
done
|
kleing@12951
|
117 |
|
kleing@12951
|
118 |
lemma field_val [simp]:
|
kleing@12951
|
119 |
"field (E, list_name) val_name = Some (list_name, PrimT Integer)"
|
haftmann@23022
|
120 |
apply (unfold TypeRel.field_def)
|
kleing@12951
|
121 |
apply (insert class_list)
|
kleing@12951
|
122 |
apply (unfold list_class_def)
|
kleing@12951
|
123 |
apply (drule fields_rec_lemma [OF _ wf_subcls1_E])
|
kleing@12951
|
124 |
apply simp
|
kleing@12951
|
125 |
done
|
kleing@12951
|
126 |
|
kleing@12951
|
127 |
lemma field_next [simp]:
|
kleing@12951
|
128 |
"field (E, list_name) next_name = Some (list_name, Class list_name)"
|
haftmann@23022
|
129 |
apply (unfold TypeRel.field_def)
|
kleing@12951
|
130 |
apply (insert class_list)
|
kleing@12951
|
131 |
apply (unfold list_class_def)
|
kleing@12951
|
132 |
apply (drule fields_rec_lemma [OF _ wf_subcls1_E])
|
kleing@12951
|
133 |
apply (simp add: name_defs distinct_fields [symmetric])
|
kleing@12951
|
134 |
done
|
kleing@12951
|
135 |
|
kleing@12951
|
136 |
lemma [simp]: "fields (E, Object) = []"
|
kleing@12951
|
137 |
by (simp add: fields_rec_lemma [OF class_Object wf_subcls1_E])
|
kleing@12951
|
138 |
|
kleing@12951
|
139 |
lemma [simp]: "fields (E, Xcpt NullPointer) = []"
|
kleing@12951
|
140 |
by (simp add: fields_rec_lemma [OF class_NullPointer wf_subcls1_E])
|
kleing@12951
|
141 |
|
kleing@12951
|
142 |
lemma [simp]: "fields (E, Xcpt ClassCast) = []"
|
kleing@12951
|
143 |
by (simp add: fields_rec_lemma [OF class_ClassCast wf_subcls1_E])
|
kleing@12951
|
144 |
|
kleing@12951
|
145 |
lemma [simp]: "fields (E, Xcpt OutOfMemory) = []"
|
kleing@12951
|
146 |
by (simp add: fields_rec_lemma [OF class_OutOfMemory wf_subcls1_E])
|
kleing@12951
|
147 |
|
kleing@12951
|
148 |
lemma [simp]: "fields (E, test_name) = []"
|
kleing@12951
|
149 |
apply (insert class_test)
|
kleing@12951
|
150 |
apply (unfold test_class_def)
|
kleing@12951
|
151 |
apply (drule fields_rec_lemma [OF _ wf_subcls1_E])
|
kleing@12951
|
152 |
apply simp
|
kleing@12951
|
153 |
done
|
kleing@12951
|
154 |
|
kleing@12951
|
155 |
lemmas [simp] = is_class_def
|
kleing@12951
|
156 |
|
kleing@12951
|
157 |
text {*
|
kleing@12951
|
158 |
The next definition and three proof rules implement an algorithm to
|
kleing@12951
|
159 |
enumarate natural numbers. The command @{text "apply (elim pc_end pc_next pc_0"}
|
kleing@12951
|
160 |
transforms a goal of the form
|
kleing@12951
|
161 |
@{prop [display] "pc < n \<Longrightarrow> P pc"}
|
kleing@12951
|
162 |
into a series of goals
|
kleing@12951
|
163 |
@{prop [display] "P 0"}
|
kleing@12951
|
164 |
@{prop [display] "P (Suc 0)"}
|
kleing@12951
|
165 |
|
kleing@12951
|
166 |
@{text "\<dots>"}
|
kleing@12951
|
167 |
|
kleing@12951
|
168 |
@{prop [display] "P n"}
|
kleing@12951
|
169 |
*}
|
haftmann@35413
|
170 |
definition intervall :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" ("_ \<in> [_, _')") where
|
kleing@12951
|
171 |
"x \<in> [a, b) \<equiv> a \<le> x \<and> x < b"
|
kleing@12951
|
172 |
|
kleing@12951
|
173 |
lemma pc_0: "x < n \<Longrightarrow> (x \<in> [0, n) \<Longrightarrow> P x) \<Longrightarrow> P x"
|
kleing@12951
|
174 |
by (simp add: intervall_def)
|
kleing@12951
|
175 |
|
kleing@12951
|
176 |
lemma pc_next: "x \<in> [n0, n) \<Longrightarrow> P n0 \<Longrightarrow> (x \<in> [Suc n0, n) \<Longrightarrow> P x) \<Longrightarrow> P x"
|
kleing@12951
|
177 |
apply (cases "x=n0")
|
nipkow@13187
|
178 |
apply (auto simp add: intervall_def)
|
kleing@12951
|
179 |
done
|
kleing@12951
|
180 |
|
kleing@12951
|
181 |
lemma pc_end: "x \<in> [n,n) \<Longrightarrow> P x"
|
kleing@12951
|
182 |
by (unfold intervall_def) arith
|
kleing@12951
|
183 |
|
kleing@12951
|
184 |
|
kleing@12951
|
185 |
section "Program structure"
|
kleing@12951
|
186 |
|
kleing@12951
|
187 |
text {*
|
kleing@12951
|
188 |
The program is structurally wellformed:
|
kleing@12951
|
189 |
*}
|
streckem@14045
|
190 |
|
kleing@12951
|
191 |
lemma wf_struct:
|
kleing@12951
|
192 |
"wf_prog (\<lambda>G C mb. True) E" (is "wf_prog ?mb E")
|
kleing@12951
|
193 |
proof -
|
kleing@12951
|
194 |
have "unique E"
|
kleing@12951
|
195 |
by (simp add: system_defs E_def class_defs name_defs distinct_classes)
|
kleing@12951
|
196 |
moreover
|
kleing@12951
|
197 |
have "set SystemClasses \<subseteq> set E" by (simp add: system_defs E_def)
|
kleing@12951
|
198 |
hence "wf_syscls E" by (rule wf_syscls)
|
kleing@12951
|
199 |
moreover
|
kleing@12951
|
200 |
have "wf_cdecl ?mb E ObjectC" by (simp add: wf_cdecl_def ObjectC_def)
|
kleing@12951
|
201 |
moreover
|
kleing@12951
|
202 |
have "wf_cdecl ?mb E NullPointerC"
|
kleing@12951
|
203 |
by (auto elim: notin_rtrancl
|
kleing@12951
|
204 |
simp add: wf_cdecl_def name_defs NullPointerC_def subcls1)
|
kleing@12951
|
205 |
moreover
|
kleing@12951
|
206 |
have "wf_cdecl ?mb E ClassCastC"
|
kleing@12951
|
207 |
by (auto elim: notin_rtrancl
|
kleing@12951
|
208 |
simp add: wf_cdecl_def name_defs ClassCastC_def subcls1)
|
kleing@12951
|
209 |
moreover
|
kleing@12951
|
210 |
have "wf_cdecl ?mb E OutOfMemoryC"
|
kleing@12951
|
211 |
by (auto elim: notin_rtrancl
|
kleing@12951
|
212 |
simp add: wf_cdecl_def name_defs OutOfMemoryC_def subcls1)
|
kleing@12951
|
213 |
moreover
|
kleing@12951
|
214 |
have "wf_cdecl ?mb E (list_name, list_class)"
|
kleing@12951
|
215 |
apply (auto elim!: notin_rtrancl
|
kleing@12951
|
216 |
simp add: wf_cdecl_def wf_fdecl_def list_class_def
|
kleing@12951
|
217 |
wf_mdecl_def wf_mhead_def subcls1)
|
kleing@12951
|
218 |
apply (auto simp add: name_defs distinct_classes distinct_fields)
|
kleing@12951
|
219 |
done
|
kleing@12951
|
220 |
moreover
|
kleing@12951
|
221 |
have "wf_cdecl ?mb E (test_name, test_class)"
|
kleing@12951
|
222 |
apply (auto elim!: notin_rtrancl
|
kleing@12951
|
223 |
simp add: wf_cdecl_def wf_fdecl_def test_class_def
|
kleing@12951
|
224 |
wf_mdecl_def wf_mhead_def subcls1)
|
kleing@12951
|
225 |
apply (auto simp add: name_defs distinct_classes distinct_fields)
|
kleing@12951
|
226 |
done
|
kleing@12951
|
227 |
ultimately
|
streckem@14045
|
228 |
show ?thesis
|
streckem@14045
|
229 |
by (simp add: wf_prog_def ws_prog_def wf_cdecl_mrT_cdecl_mdecl E_def SystemClasses_def)
|
kleing@12951
|
230 |
qed
|
kleing@12951
|
231 |
|
kleing@12951
|
232 |
section "Welltypings"
|
kleing@12951
|
233 |
text {*
|
kleing@12951
|
234 |
We show welltypings of the methods @{term append_name} in class @{term list_name},
|
kleing@12951
|
235 |
and @{term makelist_name} in class @{term test_name}:
|
kleing@12951
|
236 |
*}
|
kleing@12951
|
237 |
lemmas eff_simps [simp] = eff_def norm_eff_def xcpt_eff_def
|
kleing@12951
|
238 |
declare appInvoke [simp del]
|
kleing@12951
|
239 |
|
haftmann@35413
|
240 |
definition phi_append :: method_type ("\<phi>\<^sub>a") where
|
kleing@12951
|
241 |
"\<phi>\<^sub>a \<equiv> map (\<lambda>(x,y). Some (x, map OK y)) [
|
kleing@12951
|
242 |
( [], [Class list_name, Class list_name]),
|
kleing@12951
|
243 |
( [Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
244 |
( [Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
245 |
( [Class list_name, Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
246 |
([NT, Class list_name, Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
247 |
( [Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
248 |
( [Class list_name, Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
249 |
( [PrimT Void], [Class list_name, Class list_name]),
|
kleing@12951
|
250 |
( [Class Object], [Class list_name, Class list_name]),
|
kleing@12951
|
251 |
( [], [Class list_name, Class list_name]),
|
kleing@12951
|
252 |
( [Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
253 |
( [Class list_name, Class list_name], [Class list_name, Class list_name]),
|
kleing@12951
|
254 |
( [], [Class list_name, Class list_name]),
|
kleing@12951
|
255 |
( [PrimT Void], [Class list_name, Class list_name])]"
|
kleing@12951
|
256 |
|
kleing@13214
|
257 |
|
kleing@13214
|
258 |
lemma bounded_append [simp]:
|
kleing@13214
|
259 |
"check_bounded append_ins [(Suc 0, 2, 8, Xcpt NullPointer)]"
|
kleing@13214
|
260 |
apply (simp add: check_bounded_def)
|
kleing@13214
|
261 |
apply (simp add: nat_number append_ins_def)
|
kleing@13214
|
262 |
apply (rule allI, rule impI)
|
kleing@13214
|
263 |
apply (elim pc_end pc_next pc_0)
|
kleing@13214
|
264 |
apply auto
|
kleing@13214
|
265 |
done
|
kleing@13214
|
266 |
|
kleing@13214
|
267 |
lemma types_append [simp]: "check_types E 3 (Suc (Suc 0)) (map OK \<phi>\<^sub>a)"
|
kleing@13214
|
268 |
apply (auto simp add: check_types_def phi_append_def JVM_states_unfold)
|
kleing@13214
|
269 |
apply (unfold list_def)
|
kleing@13214
|
270 |
apply auto
|
kleing@13214
|
271 |
done
|
kleing@13214
|
272 |
|
kleing@12951
|
273 |
lemma wt_append [simp]:
|
kleing@12951
|
274 |
"wt_method E list_name [Class list_name] (PrimT Void) 3 0 append_ins
|
kleing@12951
|
275 |
[(Suc 0, 2, 8, Xcpt NullPointer)] \<phi>\<^sub>a"
|
kleing@13214
|
276 |
apply (simp add: wt_method_def wt_start_def wt_instr_def)
|
kleing@13214
|
277 |
apply (simp add: phi_append_def append_ins_def)
|
kleing@12951
|
278 |
apply clarify
|
kleing@12951
|
279 |
apply (elim pc_end pc_next pc_0)
|
kleing@12951
|
280 |
apply simp
|
kleing@12951
|
281 |
apply (fastsimp simp add: match_exception_entry_def sup_state_conv subcls1)
|
kleing@12951
|
282 |
apply simp
|
kleing@12951
|
283 |
apply simp
|
kleing@12951
|
284 |
apply (fastsimp simp add: sup_state_conv subcls1)
|
kleing@12951
|
285 |
apply simp
|
kleing@12951
|
286 |
apply (simp add: app_def xcpt_app_def)
|
kleing@12951
|
287 |
apply simp
|
kleing@12951
|
288 |
apply simp
|
kleing@12951
|
289 |
apply simp
|
kleing@12951
|
290 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
291 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
292 |
apply simp
|
kleing@12951
|
293 |
apply simp
|
kleing@12951
|
294 |
done
|
kleing@12951
|
295 |
|
kleing@13006
|
296 |
text {* Some abbreviations for readability *}
|
wenzelm@35102
|
297 |
abbreviation Clist :: ty
|
wenzelm@35102
|
298 |
where "Clist == Class list_name"
|
wenzelm@35102
|
299 |
abbreviation Ctest :: ty
|
wenzelm@35102
|
300 |
where "Ctest == Class test_name"
|
kleing@12951
|
301 |
|
haftmann@35413
|
302 |
definition phi_makelist :: method_type ("\<phi>\<^sub>m") where
|
kleing@12951
|
303 |
"\<phi>\<^sub>m \<equiv> map (\<lambda>(x,y). Some (x, y)) [
|
kleing@13214
|
304 |
( [], [OK Ctest, Err , Err ]),
|
kleing@13214
|
305 |
( [Clist], [OK Ctest, Err , Err ]),
|
kleing@13214
|
306 |
( [Clist, Clist], [OK Ctest, Err , Err ]),
|
kleing@13214
|
307 |
( [Clist], [OK Clist, Err , Err ]),
|
kleing@13214
|
308 |
( [PrimT Integer, Clist], [OK Clist, Err , Err ]),
|
kleing@13214
|
309 |
( [], [OK Clist, Err , Err ]),
|
kleing@13214
|
310 |
( [Clist], [OK Clist, Err , Err ]),
|
kleing@13214
|
311 |
( [Clist, Clist], [OK Clist, Err , Err ]),
|
kleing@13214
|
312 |
( [Clist], [OK Clist, OK Clist, Err ]),
|
kleing@13214
|
313 |
( [PrimT Integer, Clist], [OK Clist, OK Clist, Err ]),
|
kleing@13214
|
314 |
( [], [OK Clist, OK Clist, Err ]),
|
kleing@13214
|
315 |
( [Clist], [OK Clist, OK Clist, Err ]),
|
kleing@13214
|
316 |
( [Clist, Clist], [OK Clist, OK Clist, Err ]),
|
kleing@13214
|
317 |
( [Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
318 |
( [PrimT Integer, Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
319 |
( [], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
320 |
( [Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
321 |
( [Clist, Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
322 |
( [PrimT Void], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
323 |
( [], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
324 |
( [Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
325 |
( [Clist, Clist], [OK Clist, OK Clist, OK Clist]),
|
kleing@13214
|
326 |
( [PrimT Void], [OK Clist, OK Clist, OK Clist])]"
|
kleing@13214
|
327 |
|
kleing@13214
|
328 |
lemma bounded_makelist [simp]: "check_bounded make_list_ins []"
|
kleing@13214
|
329 |
apply (simp add: check_bounded_def)
|
kleing@13214
|
330 |
apply (simp add: nat_number make_list_ins_def)
|
kleing@13214
|
331 |
apply (rule allI, rule impI)
|
kleing@13214
|
332 |
apply (elim pc_end pc_next pc_0)
|
kleing@13214
|
333 |
apply auto
|
kleing@13214
|
334 |
done
|
kleing@13214
|
335 |
|
kleing@13214
|
336 |
lemma types_makelist [simp]: "check_types E 3 (Suc (Suc (Suc 0))) (map OK \<phi>\<^sub>m)"
|
kleing@13214
|
337 |
apply (auto simp add: check_types_def phi_makelist_def JVM_states_unfold)
|
kleing@13214
|
338 |
apply (unfold list_def)
|
kleing@13214
|
339 |
apply auto
|
kleing@13214
|
340 |
done
|
kleing@12951
|
341 |
|
kleing@12951
|
342 |
lemma wt_makelist [simp]:
|
kleing@12951
|
343 |
"wt_method E test_name [] (PrimT Void) 3 2 make_list_ins [] \<phi>\<^sub>m"
|
kleing@13214
|
344 |
apply (simp add: wt_method_def)
|
kleing@13214
|
345 |
apply (simp add: make_list_ins_def phi_makelist_def)
|
wenzelm@13043
|
346 |
apply (simp add: wt_start_def nat_number)
|
kleing@12951
|
347 |
apply (simp add: wt_instr_def)
|
kleing@12951
|
348 |
apply clarify
|
kleing@12951
|
349 |
apply (elim pc_end pc_next pc_0)
|
kleing@12951
|
350 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
351 |
apply simp
|
kleing@12951
|
352 |
apply simp
|
kleing@12951
|
353 |
apply simp
|
kleing@12951
|
354 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
355 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
356 |
apply simp
|
kleing@12951
|
357 |
apply simp
|
kleing@12951
|
358 |
apply simp
|
kleing@12951
|
359 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
360 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
361 |
apply simp
|
kleing@12951
|
362 |
apply simp
|
kleing@12951
|
363 |
apply simp
|
kleing@12951
|
364 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
365 |
apply (simp add: match_exception_entry_def)
|
kleing@12951
|
366 |
apply simp
|
kleing@12951
|
367 |
apply (simp add: app_def xcpt_app_def)
|
kleing@13101
|
368 |
apply simp
|
kleing@12951
|
369 |
apply simp
|
kleing@12951
|
370 |
apply simp
|
kleing@13101
|
371 |
apply (simp add: app_def xcpt_app_def)
|
kleing@12951
|
372 |
apply simp
|
kleing@12951
|
373 |
done
|
kleing@12951
|
374 |
|
kleing@12951
|
375 |
text {* The whole program is welltyped: *}
|
haftmann@35413
|
376 |
definition Phi :: prog_type ("\<Phi>") where
|
kleing@13101
|
377 |
"\<Phi> C sg \<equiv> if C = test_name \<and> sg = (makelist_name, []) then \<phi>\<^sub>m else
|
kleing@13101
|
378 |
if C = list_name \<and> sg = (append_name, [Class list_name]) then \<phi>\<^sub>a else []"
|
kleing@13139
|
379 |
|
kleing@12951
|
380 |
lemma wf_prog:
|
kleing@13101
|
381 |
"wt_jvm_prog E \<Phi>"
|
kleing@12951
|
382 |
apply (unfold wt_jvm_prog_def)
|
kleing@12951
|
383 |
apply (rule wf_mb'E [OF wf_struct])
|
kleing@12951
|
384 |
apply (simp add: E_def)
|
kleing@12951
|
385 |
apply clarify
|
kleing@12951
|
386 |
apply (fold E_def)
|
kleing@13101
|
387 |
apply (simp add: system_defs class_defs Phi_def)
|
kleing@12951
|
388 |
apply auto
|
kleing@13101
|
389 |
done
|
kleing@12951
|
390 |
|
kleing@12951
|
391 |
|
kleing@12951
|
392 |
section "Conformance"
|
kleing@12951
|
393 |
text {* Execution of the program will be typesafe, because its
|
kleing@12951
|
394 |
start state conforms to the welltyping: *}
|
kleing@12951
|
395 |
|
kleing@13052
|
396 |
lemma "E,\<Phi> \<turnstile>JVM start_state E test_name makelist_name \<surd>"
|
kleing@13052
|
397 |
apply (rule BV_correct_initial)
|
kleing@13052
|
398 |
apply (rule wf_prog)
|
kleing@13052
|
399 |
apply simp
|
kleing@13052
|
400 |
apply simp
|
kleing@12951
|
401 |
done
|
kleing@12951
|
402 |
|
berghofe@13092
|
403 |
|
berghofe@13092
|
404 |
section "Example for code generation: inferring method types"
|
berghofe@13092
|
405 |
|
haftmann@28520
|
406 |
definition test_kil :: "jvm_prog \<Rightarrow> cname \<Rightarrow> ty list \<Rightarrow> ty \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
|
haftmann@28520
|
407 |
exception_table \<Rightarrow> instr list \<Rightarrow> JVMType.state list" where
|
haftmann@28520
|
408 |
"test_kil G C pTs rT mxs mxl et instr =
|
berghofe@13092
|
409 |
(let first = Some ([],(OK (Class C))#((map OK pTs))@(replicate mxl Err));
|
berghofe@13092
|
410 |
start = OK first#(replicate (size instr - 1) (OK None))
|
berghofe@13092
|
411 |
in kiljvm G mxs (1+size pTs+mxl) rT et instr start)"
|
berghofe@13092
|
412 |
|
berghofe@13092
|
413 |
lemma [code]:
|
nipkow@15045
|
414 |
"unstables r step ss = (UN p:{..<size ss}. if \<not>stable r step ss p then {p} else {})"
|
berghofe@13092
|
415 |
apply (unfold unstables_def)
|
berghofe@13092
|
416 |
apply (rule equalityI)
|
berghofe@13092
|
417 |
apply (rule subsetI)
|
berghofe@13092
|
418 |
apply (erule CollectE)
|
berghofe@13092
|
419 |
apply (erule conjE)
|
berghofe@13092
|
420 |
apply (rule UN_I)
|
berghofe@13092
|
421 |
apply simp
|
berghofe@13092
|
422 |
apply simp
|
berghofe@13092
|
423 |
apply (rule subsetI)
|
berghofe@13092
|
424 |
apply (erule UN_E)
|
berghofe@13092
|
425 |
apply (case_tac "\<not> stable r step ss p")
|
berghofe@13092
|
426 |
apply simp+
|
berghofe@13092
|
427 |
done
|
berghofe@13092
|
428 |
|
haftmann@28520
|
429 |
definition some_elem :: "'a set \<Rightarrow> 'a" where
|
haftmann@28520
|
430 |
"some_elem = (%S. SOME x. x : S)"
|
berghofe@13092
|
431 |
|
berghofe@13092
|
432 |
consts_code
|
haftmann@31852
|
433 |
"some_elem" ("(case/ _ of/ {*Set*}/ xs/ =>/ hd/ xs)")
|
berghofe@13092
|
434 |
|
haftmann@28520
|
435 |
text {* This code setup is just a demonstration and \emph{not} sound! *}
|
haftmann@28520
|
436 |
|
haftmann@28520
|
437 |
lemma False
|
haftmann@28520
|
438 |
proof -
|
haftmann@28520
|
439 |
have "some_elem (set [False, True]) = False"
|
haftmann@28520
|
440 |
by evaluation
|
haftmann@28520
|
441 |
moreover have "some_elem (set [True, False]) = True"
|
haftmann@28520
|
442 |
by evaluation
|
haftmann@28520
|
443 |
ultimately show False
|
haftmann@28520
|
444 |
by (simp add: some_elem_def)
|
haftmann@28520
|
445 |
qed
|
haftmann@28520
|
446 |
|
haftmann@28520
|
447 |
lemma [code]:
|
haftmann@31866
|
448 |
"iter f step ss w = while (\<lambda>(ss, w). \<not> is_empty w)
|
haftmann@28520
|
449 |
(\<lambda>(ss, w).
|
haftmann@28520
|
450 |
let p = some_elem w in propa f (step p (ss ! p)) ss (w - {p}))
|
haftmann@28520
|
451 |
(ss, w)"
|
haftmann@37016
|
452 |
unfolding iter_def More_Set.is_empty_def some_elem_def ..
|
haftmann@20593
|
453 |
|
berghofe@13092
|
454 |
lemma JVM_sup_unfold [code]:
|
berghofe@13092
|
455 |
"JVMType.sup S m n = lift2 (Opt.sup
|
berghofe@13092
|
456 |
(Product.sup (Listn.sup (JType.sup S))
|
berghofe@13092
|
457 |
(\<lambda>x y. OK (map2 (lift2 (JType.sup S)) x y))))"
|
berghofe@13092
|
458 |
apply (unfold JVMType.sup_def JVMType.sl_def Opt.esl_def Err.sl_def
|
berghofe@13092
|
459 |
stk_esl_def reg_sl_def Product.esl_def
|
berghofe@13092
|
460 |
Listn.sl_def upto_esl_def JType.esl_def Err.esl_def)
|
berghofe@13092
|
461 |
by simp
|
berghofe@13092
|
462 |
|
haftmann@28520
|
463 |
lemmas [code] = JType.sup_def [unfolded exec_lub_def] JVM_le_unfold
|
berghofe@13092
|
464 |
|
haftmann@31998
|
465 |
lemmas [code_ind] = rtranclp.rtrancl_refl converse_rtranclp_into_rtranclp
|
berghofe@13092
|
466 |
|
berghofe@17145
|
467 |
code_module BV
|
berghofe@17145
|
468 |
contains
|
berghofe@13092
|
469 |
test1 = "test_kil E list_name [Class list_name] (PrimT Void) 3 0
|
berghofe@13092
|
470 |
[(Suc 0, 2, 8, Xcpt NullPointer)] append_ins"
|
berghofe@13092
|
471 |
test2 = "test_kil E test_name [] (PrimT Void) 3 2 [] make_list_ins"
|
berghofe@17145
|
472 |
ML BV.test1
|
berghofe@17145
|
473 |
ML BV.test2
|
berghofe@13092
|
474 |
|
kleing@13006
|
475 |
end
|