86 bytecode \<Rightarrow> |
85 bytecode \<Rightarrow> |
87 aheap \<Rightarrow> opstack \<Rightarrow> locvars \<Rightarrow> |
86 aheap \<Rightarrow> opstack \<Rightarrow> locvars \<Rightarrow> |
88 bool" |
87 bool" |
89 ("{_,_,_} \<turnstile> {_, _, _} >- _ \<rightarrow> {_, _, _}" [61,61,61,61,61,61,90,61,61,61]60) where |
88 ("{_,_,_} \<turnstile> {_, _, _} >- _ \<rightarrow> {_, _, _}" [61,61,61,61,61,61,90,61,61,61]60) where |
90 "{G,C,S} \<turnstile> {hp0, os0, lvars0} >- instrs \<rightarrow> {hp1, os1, lvars1} == |
89 "{G,C,S} \<turnstile> {hp0, os0, lvars0} >- instrs \<rightarrow> {hp1, os1, lvars1} == |
91 \<forall> pre post frs. |
90 \<forall>pre post frs. |
92 (gis (gmb G C S) = pre @ instrs @ post) \<longrightarrow> |
91 (gis (gmb G C S) = pre @ instrs @ post) \<longrightarrow> |
93 G \<turnstile> (None,hp0,(os0,lvars0,C,S,length pre)#frs) \<midarrow>jvm\<rightarrow> |
92 G \<turnstile> (None,hp0,(os0,lvars0,C,S,length pre)#frs) \<midarrow>jvm\<rightarrow> |
94 (None,hp1,(os1,lvars1,C,S,(length pre) + (length instrs))#frs)" |
93 (None,hp1,(os1,lvars1,C,S,(length pre) + (length instrs))#frs)" |
95 |
94 |
96 |
95 |
97 |
96 |
98 lemma progression_call: |
97 lemma progression_call: |
99 "\<lbrakk> \<forall> pc frs. |
98 "\<lbrakk> \<forall>pc frs. |
100 exec_instr instr G hp0 os0 lvars0 C S pc frs = |
99 exec_instr instr G hp0 os0 lvars0 C S pc frs = |
101 (None, hp', (os', lvars', C', S', 0) # (fr pc) # frs) \<and> |
100 (None, hp', (os', lvars', C', S', 0) # (fr pc) # frs) \<and> |
102 gis (gmb G C' S') = instrs' @ [Return] \<and> |
101 gis (gmb G C' S') = instrs' @ [Return] \<and> |
103 {G, C', S'} \<turnstile> {hp', os', lvars'} >- instrs' \<rightarrow> {hp'', os'', lvars''} \<and> |
102 {G, C', S'} \<turnstile> {hp', os', lvars'} >- instrs' \<rightarrow> {hp'', os'', lvars''} \<and> |
104 exec_instr Return G hp'' os'' lvars'' C' S' (length instrs') |
103 exec_instr Return G hp'' os'' lvars'' C' S' (length instrs') |
105 ((fr pc) # frs) = |
104 ((fr pc) # frs) = |
106 (None, hp2, (os2, lvars2, C, S, Suc pc) # frs) \<rbrakk> \<Longrightarrow> |
105 (None, hp2, (os2, lvars2, C, S, Suc pc) # frs) \<rbrakk> \<Longrightarrow> |
107 {G, C, S} \<turnstile> {hp0, os0, lvars0} >-[instr]\<rightarrow> {hp2,os2,lvars2}" |
106 {G, C, S} \<turnstile> {hp0, os0, lvars0} >-[instr]\<rightarrow> {hp2,os2,lvars2}" |
108 apply (simp only: progression_def) |
107 apply (simp only: progression_def) |
109 apply (intro strip) |
108 apply (intro strip) |
110 apply (drule_tac x="length pre" in spec) |
109 apply (drule_tac x="length pre" in spec) |
111 apply (drule_tac x="frs" in spec) |
110 apply (drule_tac x="frs" in spec) |
112 apply clarify |
111 apply clarify |
113 apply (rule exec_all_trans) |
112 apply (rule exec_all_trans) |
114 apply (rule exec_instr_in_exec_all) apply simp |
113 apply (rule exec_instr_in_exec_all) |
115 apply simp |
114 apply simp |
116 apply (rule exec_all_trans) |
115 apply simp |
117 apply (simp only: append_Nil) |
116 apply (rule exec_all_trans) |
118 apply (drule_tac x="[]" in spec) |
117 apply (simp only: append_Nil) |
119 apply (simp only: list.simps list.size) |
118 apply (drule_tac x="[]" in spec) |
120 apply blast |
119 apply (simp only: list.simps list.size) |
121 apply (rule exec_instr_in_exec_all) |
120 apply blast |
122 apply auto |
121 apply (rule exec_instr_in_exec_all) |
123 done |
122 apply auto |
|
123 done |
124 |
124 |
125 |
125 |
126 lemma progression_transitive: |
126 lemma progression_transitive: |
127 "\<lbrakk> instrs_comb = instrs0 @ instrs1; |
127 "\<lbrakk> instrs_comb = instrs0 @ instrs1; |
128 {G, C, S} \<turnstile> {hp0, os0, lvars0} >- instrs0 \<rightarrow> {hp1, os1, lvars1}; |
128 {G, C, S} \<turnstile> {hp0, os0, lvars0} >- instrs0 \<rightarrow> {hp1, os1, lvars1}; |
129 {G, C, S} \<turnstile> {hp1, os1, lvars1} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
129 {G, C, S} \<turnstile> {hp1, os1, lvars1} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
130 \<Longrightarrow> |
130 \<Longrightarrow> |
131 {G, C, S} \<turnstile> {hp0, os0, lvars0} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
131 {G, C, S} \<turnstile> {hp0, os0, lvars0} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
132 apply (simp only: progression_def) |
132 apply (simp only: progression_def) |
133 apply (intro strip) |
133 apply (intro strip) |
134 apply (rule_tac ?s1.0 = "Norm (hp1, (os1, lvars1, C, S, |
134 apply (rule_tac ?s1.0 = "Norm (hp1, (os1, lvars1, C, S, |
135 length pre + length instrs0) # frs)" |
135 length pre + length instrs0) # frs)" |
136 in exec_all_trans) |
136 in exec_all_trans) |
137 apply (simp only: append_assoc) |
137 apply (simp only: append_assoc) |
138 apply (erule thin_rl, erule thin_rl) |
138 apply (erule thin_rl, erule thin_rl) |
139 apply (drule_tac x="pre @ instrs0" in spec) |
139 apply (drule_tac x="pre @ instrs0" in spec) |
140 apply (simp add: add.assoc) |
140 apply (simp add: add.assoc) |
141 done |
141 done |
142 |
142 |
143 lemma progression_refl: |
143 lemma progression_refl: |
144 "{G, C, S} \<turnstile> {hp0, os0, lvars0} >- [] \<rightarrow> {hp0, os0, lvars0}" |
144 "{G, C, S} \<turnstile> {hp0, os0, lvars0} >- [] \<rightarrow> {hp0, os0, lvars0}" |
145 apply (simp add: progression_def) |
145 apply (simp add: progression_def) |
146 apply (intro strip) |
146 apply (intro strip) |
147 apply (rule exec_all_refl) |
147 apply (rule exec_all_refl) |
148 done |
148 done |
149 |
149 |
150 lemma progression_one_step: " |
150 lemma progression_one_step: " |
151 \<forall> pc frs. |
151 \<forall>pc frs. |
152 (exec_instr i G hp0 os0 lvars0 C S pc frs) = |
152 (exec_instr i G hp0 os0 lvars0 C S pc frs) = |
153 (None, hp1, (os1,lvars1,C,S, Suc pc)#frs) |
153 (None, hp1, (os1,lvars1,C,S, Suc pc)#frs) |
154 \<Longrightarrow> {G, C, S} \<turnstile> {hp0, os0, lvars0} >- [i] \<rightarrow> {hp1, os1, lvars1}" |
154 \<Longrightarrow> {G, C, S} \<turnstile> {hp0, os0, lvars0} >- [i] \<rightarrow> {hp1, os1, lvars1}" |
155 apply (unfold progression_def) |
155 apply (unfold progression_def) |
156 apply (intro strip) |
156 apply (intro strip) |
157 apply simp |
157 apply simp |
158 apply (rule exec_all_one_step) |
158 apply (rule exec_all_one_step) |
159 apply auto |
159 apply auto |
160 done |
160 done |
161 |
161 |
162 (*****) |
162 (*****) |
163 definition jump_fwd :: "jvm_prog \<Rightarrow> cname \<Rightarrow> sig \<Rightarrow> |
163 definition jump_fwd :: "jvm_prog \<Rightarrow> cname \<Rightarrow> sig \<Rightarrow> |
164 aheap \<Rightarrow> locvars \<Rightarrow> opstack \<Rightarrow> opstack \<Rightarrow> |
164 aheap \<Rightarrow> locvars \<Rightarrow> opstack \<Rightarrow> opstack \<Rightarrow> |
165 instr \<Rightarrow> bytecode \<Rightarrow> bool" where |
165 instr \<Rightarrow> bytecode \<Rightarrow> bool" where |
166 "jump_fwd G C S hp lvars os0 os1 instr instrs == |
166 "jump_fwd G C S hp lvars os0 os1 instr instrs == |
167 \<forall> pre post frs. |
167 \<forall>pre post frs. |
168 (gis (gmb G C S) = pre @ instr # instrs @ post) \<longrightarrow> |
168 (gis (gmb G C S) = pre @ instr # instrs @ post) \<longrightarrow> |
169 exec_all G (None,hp,(os0,lvars,C,S, length pre)#frs) |
169 exec_all G (None,hp,(os0,lvars,C,S, length pre)#frs) |
170 (None,hp,(os1,lvars,C,S,(length pre) + (length instrs) + 1)#frs)" |
170 (None,hp,(os1,lvars,C,S,(length pre) + (length instrs) + 1)#frs)" |
171 |
171 |
172 |
172 |
173 lemma jump_fwd_one_step: |
173 lemma jump_fwd_one_step: |
174 "\<forall> pc frs. |
174 "\<forall>pc frs. |
175 exec_instr instr G hp os0 lvars C S pc frs = |
175 exec_instr instr G hp os0 lvars C S pc frs = |
176 (None, hp, (os1, lvars, C, S, pc + (length instrs) + 1)#frs) |
176 (None, hp, (os1, lvars, C, S, pc + (length instrs) + 1)#frs) |
177 \<Longrightarrow> jump_fwd G C S hp lvars os0 os1 instr instrs" |
177 \<Longrightarrow> jump_fwd G C S hp lvars os0 os1 instr instrs" |
178 apply (unfold jump_fwd_def) |
178 apply (unfold jump_fwd_def) |
179 apply (intro strip) |
179 apply (intro strip) |
180 apply (rule exec_instr_in_exec_all) |
180 apply (rule exec_instr_in_exec_all) |
181 apply auto |
181 apply auto |
182 done |
182 done |
183 |
183 |
184 |
184 |
185 lemma jump_fwd_progression_aux: |
185 lemma jump_fwd_progression_aux: |
186 "\<lbrakk> instrs_comb = instr # instrs0 @ instrs1; |
186 "\<lbrakk> instrs_comb = instr # instrs0 @ instrs1; |
187 jump_fwd G C S hp lvars os0 os1 instr instrs0; |
187 jump_fwd G C S hp lvars os0 os1 instr instrs0; |
188 {G, C, S} \<turnstile> {hp, os1, lvars} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
188 {G, C, S} \<turnstile> {hp, os1, lvars} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
189 \<Longrightarrow> {G, C, S} \<turnstile> {hp, os0, lvars} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
189 \<Longrightarrow> {G, C, S} \<turnstile> {hp, os0, lvars} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
190 apply (simp only: progression_def jump_fwd_def) |
190 apply (simp only: progression_def jump_fwd_def) |
191 apply (intro strip) |
191 apply (intro strip) |
192 apply (rule_tac ?s1.0 = "Norm(hp, (os1, lvars, C, S, length pre + length instrs0 + 1) # frs)" in exec_all_trans) |
192 apply (rule_tac ?s1.0 = "Norm(hp, (os1, lvars, C, S, length pre + length instrs0 + 1) # frs)" in exec_all_trans) |
193 apply (simp only: append_assoc) |
193 apply (simp only: append_assoc) |
194 apply (subgoal_tac "pre @ (instr # instrs0 @ instrs1) @ post = pre @ instr # instrs0 @ (instrs1 @ post)") |
194 apply (subgoal_tac "pre @ (instr # instrs0 @ instrs1) @ post = pre @ instr # instrs0 @ (instrs1 @ post)") |
195 apply blast |
195 apply blast |
196 apply simp |
196 apply simp |
197 apply (erule thin_rl, erule thin_rl) |
197 apply (erule thin_rl, erule thin_rl) |
198 apply (drule_tac x="pre @ instr # instrs0" in spec) |
198 apply (drule_tac x="pre @ instr # instrs0" in spec) |
199 apply (simp add: add.assoc) |
199 apply (simp add: add.assoc) |
200 done |
200 done |
201 |
201 |
202 |
202 |
203 lemma jump_fwd_progression: |
203 lemma jump_fwd_progression: |
204 "\<lbrakk> instrs_comb = instr # instrs0 @ instrs1; |
204 "\<lbrakk> instrs_comb = instr # instrs0 @ instrs1; |
205 \<forall> pc frs. |
205 \<forall> pc frs. |
206 exec_instr instr G hp os0 lvars C S pc frs = |
206 exec_instr instr G hp os0 lvars C S pc frs = |
207 (None, hp, (os1, lvars, C, S, pc + (length instrs0) + 1)#frs); |
207 (None, hp, (os1, lvars, C, S, pc + (length instrs0) + 1)#frs); |
208 {G, C, S} \<turnstile> {hp, os1, lvars} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
208 {G, C, S} \<turnstile> {hp, os1, lvars} >- instrs1 \<rightarrow> {hp2, os2, lvars2} \<rbrakk> |
209 \<Longrightarrow> {G, C, S} \<turnstile> {hp, os0, lvars} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
209 \<Longrightarrow> {G, C, S} \<turnstile> {hp, os0, lvars} >- instrs_comb \<rightarrow> {hp2, os2, lvars2}" |
210 apply (rule jump_fwd_progression_aux) |
210 apply (rule jump_fwd_progression_aux) |
211 apply assumption |
211 apply assumption |
212 apply (rule jump_fwd_one_step) apply assumption+ |
212 apply (rule jump_fwd_one_step, assumption+) |
213 done |
213 done |
214 |
214 |
215 |
215 |
216 (* note: instrs and instr reversed wrt. jump_fwd *) |
216 (* note: instrs and instr reversed wrt. jump_fwd *) |
217 definition jump_bwd :: "jvm_prog \<Rightarrow> cname \<Rightarrow> sig \<Rightarrow> |
217 definition jump_bwd :: "jvm_prog \<Rightarrow> cname \<Rightarrow> sig \<Rightarrow> |
218 aheap \<Rightarrow> locvars \<Rightarrow> opstack \<Rightarrow> opstack \<Rightarrow> |
218 aheap \<Rightarrow> locvars \<Rightarrow> opstack \<Rightarrow> opstack \<Rightarrow> |
336 |
338 |
337 definition wtpd_stmt :: "java_mb env \<Rightarrow> stmt \<Rightarrow> bool" where |
339 definition wtpd_stmt :: "java_mb env \<Rightarrow> stmt \<Rightarrow> bool" where |
338 "wtpd_stmt E c == (E\<turnstile>c \<surd>)" |
340 "wtpd_stmt E c == (E\<turnstile>c \<surd>)" |
339 |
341 |
340 lemma wtpd_expr_newc: "wtpd_expr E (NewC C) \<Longrightarrow> is_class (prg E) C" |
342 lemma wtpd_expr_newc: "wtpd_expr E (NewC C) \<Longrightarrow> is_class (prg E) C" |
341 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
343 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
342 |
344 |
343 lemma wtpd_expr_cast: "wtpd_expr E (Cast cn e) \<Longrightarrow> (wtpd_expr E e)" |
345 lemma wtpd_expr_cast: "wtpd_expr E (Cast cn e) \<Longrightarrow> (wtpd_expr E e)" |
344 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
346 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
345 |
347 |
346 lemma wtpd_expr_lacc: "\<lbrakk> wtpd_expr (env_of_jmb G C S) (LAcc vn); |
348 lemma wtpd_expr_lacc: |
347 class_sig_defined G C S \<rbrakk> |
349 "\<lbrakk> wtpd_expr (env_of_jmb G C S) (LAcc vn); class_sig_defined G C S \<rbrakk> |
348 \<Longrightarrow> vn \<in> set (gjmb_plns (gmb G C S)) \<or> vn = This" |
350 \<Longrightarrow> vn \<in> set (gjmb_plns (gmb G C S)) \<or> vn = This" |
349 apply (simp only: wtpd_expr_def env_of_jmb_def class_sig_defined_def galldefs) |
351 apply (clarsimp simp: wtpd_expr_def env_of_jmb_def class_sig_defined_def galldefs) |
350 apply clarify |
352 apply (case_tac S) |
351 apply (case_tac S) |
353 apply (erule ty_expr.cases; fastforce dest: map_upds_SomeD map_of_SomeD fst_in_set_lemma) |
352 apply simp |
354 done |
353 apply (erule ty_expr.cases) |
|
354 apply (auto dest: map_upds_SomeD map_of_SomeD fst_in_set_lemma) |
|
355 apply (drule map_upds_SomeD) |
|
356 apply (erule disjE) |
|
357 apply assumption |
|
358 apply (drule map_of_SomeD) apply (auto dest: fst_in_set_lemma) |
|
359 done |
|
360 |
355 |
361 lemma wtpd_expr_lass: "wtpd_expr E (vn::=e) |
356 lemma wtpd_expr_lass: "wtpd_expr E (vn::=e) |
362 \<Longrightarrow> (vn \<noteq> This) & (wtpd_expr E (LAcc vn)) & (wtpd_expr E e)" |
357 \<Longrightarrow> (vn \<noteq> This) & (wtpd_expr E (LAcc vn)) & (wtpd_expr E e)" |
363 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
358 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
364 |
359 |
365 lemma wtpd_expr_facc: "wtpd_expr E ({fd}a..fn) |
360 lemma wtpd_expr_facc: "wtpd_expr E ({fd}a..fn) |
366 \<Longrightarrow> (wtpd_expr E a)" |
361 \<Longrightarrow> (wtpd_expr E a)" |
367 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
362 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
368 |
363 |
369 lemma wtpd_expr_fass: "wtpd_expr E ({fd}a..fn:=v) |
364 lemma wtpd_expr_fass: "wtpd_expr E ({fd}a..fn:=v) |
370 \<Longrightarrow> (wtpd_expr E ({fd}a..fn)) & (wtpd_expr E v)" |
365 \<Longrightarrow> (wtpd_expr E ({fd}a..fn)) & (wtpd_expr E v)" |
371 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
366 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
372 |
367 |
373 |
368 |
374 lemma wtpd_expr_binop: "wtpd_expr E (BinOp bop e1 e2) |
369 lemma wtpd_expr_binop: "wtpd_expr E (BinOp bop e1 e2) |
375 \<Longrightarrow> (wtpd_expr E e1) & (wtpd_expr E e2)" |
370 \<Longrightarrow> (wtpd_expr E e1) & (wtpd_expr E e2)" |
376 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
371 by (simp only: wtpd_expr_def, erule exE, erule ty_expr.cases, auto) |
377 |
372 |
378 lemma wtpd_exprs_cons: "wtpd_exprs E (e # es) |
373 lemma wtpd_exprs_cons: "wtpd_exprs E (e # es) |
379 \<Longrightarrow> (wtpd_expr E e) & (wtpd_exprs E es)" |
374 \<Longrightarrow> (wtpd_expr E e) & (wtpd_exprs E es)" |
380 by (simp only: wtpd_exprs_def wtpd_expr_def, erule exE, erule ty_exprs.cases, auto) |
375 by (simp only: wtpd_exprs_def wtpd_expr_def, erule exE, erule ty_exprs.cases, auto) |
381 |
376 |
382 lemma wtpd_stmt_expr: "wtpd_stmt E (Expr e) \<Longrightarrow> (wtpd_expr E e)" |
377 lemma wtpd_stmt_expr: "wtpd_stmt E (Expr e) \<Longrightarrow> (wtpd_expr E e)" |
383 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
378 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
384 |
379 |
385 lemma wtpd_stmt_comp: "wtpd_stmt E (s1;; s2) \<Longrightarrow> |
380 lemma wtpd_stmt_comp: "wtpd_stmt E (s1;; s2) \<Longrightarrow> |
386 (wtpd_stmt E s1) & (wtpd_stmt E s2)" |
381 (wtpd_stmt E s1) & (wtpd_stmt E s2)" |
387 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
382 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
388 |
383 |
389 lemma wtpd_stmt_cond: "wtpd_stmt E (If(e) s1 Else s2) \<Longrightarrow> |
384 lemma wtpd_stmt_cond: "wtpd_stmt E (If(e) s1 Else s2) \<Longrightarrow> |
390 (wtpd_expr E e) & (wtpd_stmt E s1) & (wtpd_stmt E s2) |
385 (wtpd_expr E e) & (wtpd_stmt E s1) & (wtpd_stmt E s2) |
391 & (E\<turnstile>e::PrimT Boolean)" |
386 & (E\<turnstile>e::PrimT Boolean)" |
392 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
387 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
393 |
388 |
394 lemma wtpd_stmt_loop: "wtpd_stmt E (While(e) s) \<Longrightarrow> |
389 lemma wtpd_stmt_loop: "wtpd_stmt E (While(e) s) \<Longrightarrow> |
395 (wtpd_expr E e) & (wtpd_stmt E s) & (E\<turnstile>e::PrimT Boolean)" |
390 (wtpd_expr E e) & (wtpd_stmt E s) & (E\<turnstile>e::PrimT Boolean)" |
396 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
391 by (simp only: wtpd_stmt_def wtpd_expr_def, erule wt_stmt.cases, auto) |
397 |
392 |
398 lemma wtpd_expr_call: "wtpd_expr E ({C}a..mn({pTs'}ps)) |
393 lemma wtpd_expr_call: "wtpd_expr E ({C}a..mn({pTs'}ps)) |
399 \<Longrightarrow> (wtpd_expr E a) & (wtpd_exprs E ps) |
394 \<Longrightarrow> (wtpd_expr E a) & (wtpd_exprs E ps) |
400 & (length ps = length pTs') & (E\<turnstile>a::Class C) |
395 & (length ps = length pTs') & (E\<turnstile>a::Class C) |
401 & (\<exists> pTs md rT. |
396 & (\<exists> pTs md rT. |
402 E\<turnstile>ps[::]pTs & max_spec (prg E) C (mn, pTs) = {((md,rT),pTs')})" |
397 E\<turnstile>ps[::]pTs & max_spec (prg E) C (mn, pTs) = {((md,rT),pTs')})" |
403 apply (simp only: wtpd_expr_def wtpd_exprs_def) |
398 apply (simp only: wtpd_expr_def wtpd_exprs_def) |
404 apply (erule exE) |
399 apply (erule exE) |
405 apply (ind_cases "E \<turnstile> {C}a..mn( {pTs'}ps) :: T" for T) |
400 apply (ind_cases "E \<turnstile> {C}a..mn( {pTs'}ps) :: T" for T) |
406 apply (auto simp: max_spec_preserves_length) |
401 apply (auto simp: max_spec_preserves_length) |
407 done |
402 done |
408 |
403 |
409 lemma wtpd_blk: |
404 lemma wtpd_blk: |
410 "\<lbrakk> method (G, D) (md, pTs) = Some (D, rT, (pns, lvars, blk, res)); |
405 "\<lbrakk> method (G, D) (md, pTs) = Some (D, rT, (pns, lvars, blk, res)); |
411 wf_prog wf_java_mdecl G; is_class G D \<rbrakk> |
406 wf_prog wf_java_mdecl G; is_class G D \<rbrakk> |
412 \<Longrightarrow> wtpd_stmt (env_of_jmb G D (md, pTs)) blk" |
407 \<Longrightarrow> wtpd_stmt (env_of_jmb G D (md, pTs)) blk" |
413 apply (simp add: wtpd_stmt_def env_of_jmb_def) |
408 apply (simp add: wtpd_stmt_def env_of_jmb_def) |
414 apply (frule_tac P="%D (md, pTs) (rT, (pns, lvars, blk, res)). (G, map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class D)) \<turnstile> blk \<surd> " in method_preserves) |
409 apply (frule_tac P="%D (md, pTs) (rT, (pns, lvars, blk, res)). (G, map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class D)) \<turnstile> blk \<surd> " in method_preserves) |
415 apply (auto simp: wf_mdecl_def wf_java_mdecl_def) |
410 apply (auto simp: wf_mdecl_def wf_java_mdecl_def) |
416 done |
411 done |
417 |
412 |
418 lemma wtpd_res: |
413 lemma wtpd_res: |
419 "\<lbrakk> method (G, D) (md, pTs) = Some (D, rT, (pns, lvars, blk, res)); |
414 "\<lbrakk> method (G, D) (md, pTs) = Some (D, rT, (pns, lvars, blk, res)); |
420 wf_prog wf_java_mdecl G; is_class G D \<rbrakk> |
415 wf_prog wf_java_mdecl G; is_class G D \<rbrakk> |
421 \<Longrightarrow> wtpd_expr (env_of_jmb G D (md, pTs)) res" |
416 \<Longrightarrow> wtpd_expr (env_of_jmb G D (md, pTs)) res" |
422 apply (simp add: wtpd_expr_def env_of_jmb_def) |
417 apply (simp add: wtpd_expr_def env_of_jmb_def) |
423 apply (frule_tac P="%D (md, pTs) (rT, (pns, lvars, blk, res)). \<exists>T. (G, map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class D)) \<turnstile> res :: T " in method_preserves) |
418 apply (frule_tac P="%D (md, pTs) (rT, (pns, lvars, blk, res)). \<exists>T. (G, map_of lvars(pns[\<mapsto>]pTs)(This\<mapsto>Class D)) \<turnstile> res :: T " in method_preserves) |
424 apply (auto simp: wf_mdecl_def wf_java_mdecl_def) |
419 apply (auto simp: wf_mdecl_def wf_java_mdecl_def) |
425 done |
420 done |
426 |
421 |
427 |
422 |
428 (**********************************************************************) |
423 (**********************************************************************) |
429 |
424 |
430 |
425 |
431 (* Is there a more elegant proof? *) |
426 (* Is there a more elegant proof? *) |
432 lemma evals_preserves_length: |
427 lemma evals_preserves_length: |
433 "G\<turnstile> xs -es[\<succ>]vs-> (None, s) \<Longrightarrow> length es = length vs" |
428 "G\<turnstile> xs -es[\<succ>]vs-> (None, s) \<Longrightarrow> length es = length vs" |
434 apply (subgoal_tac |
429 apply (subgoal_tac |
435 "\<forall> xs'. (G \<turnstile> xk -xj\<succ>xi-> xh \<longrightarrow> True) & |
430 "\<forall> xs'. (G \<turnstile> xk -xj\<succ>xi-> xh \<longrightarrow> True) & |
436 (G\<turnstile> xs -es[\<succ>]vs-> xs' \<longrightarrow> (\<exists> s. (xs' = (None, s))) \<longrightarrow> |
431 (G\<turnstile> xs -es[\<succ>]vs-> xs' \<longrightarrow> (\<exists> s. (xs' = (None, s))) \<longrightarrow> |
437 length es = length vs) & |
432 length es = length vs) & |
438 (G \<turnstile> xc -xb-> xa \<longrightarrow> True)") |
433 (G \<turnstile> xc -xb-> xa \<longrightarrow> True)") |
439 apply blast |
434 apply blast |
440 apply (rule allI) |
435 apply (rule allI) |
441 apply (rule Eval.eval_evals_exec.induct) |
436 apply (rule Eval.eval_evals_exec.induct; simp) |
442 apply auto |
437 done |
443 done |
|
444 |
438 |
445 (***********************************************************************) |
439 (***********************************************************************) |
446 |
440 |
447 (* required for translation of BinOp *) |
441 (* required for translation of BinOp *) |
448 |
442 |
449 |
443 |
450 lemma progression_Eq : "{G, C, S} \<turnstile> |
444 lemma progression_Eq : "{G, C, S} \<turnstile> |
451 {hp, (v2 # v1 # os), lvars} |
445 {hp, (v2 # v1 # os), lvars} |
452 >- [Ifcmpeq 3, LitPush (Bool False), Goto 2, LitPush (Bool True)] \<rightarrow> |
446 >- [Ifcmpeq 3, LitPush (Bool False), Goto 2, LitPush (Bool True)] \<rightarrow> |
453 {hp, (Bool (v1 = v2) # os), lvars}" |
447 {hp, (Bool (v1 = v2) # os), lvars}" |
454 apply (case_tac "v1 = v2") |
448 apply (case_tac "v1 = v2") |
455 |
449 |
456 (* case v1 = v2 *) |
450 (* case v1 = v2 *) |
457 apply (rule_tac ?instrs1.0 = "[LitPush (Bool True)]" in jump_fwd_progression) |
451 apply (rule_tac ?instrs1.0 = "[LitPush (Bool True)]" in jump_fwd_progression) |
458 apply (auto simp: nat_add_distrib) |
452 apply (auto simp: nat_add_distrib) |
459 apply (rule progression_one_step) apply simp |
453 apply (rule progression_one_step) |
460 |
454 apply simp |
461 (* case v1 \<noteq> v2 *) |
455 |
462 apply (rule progression_one_step [THEN HOL.refl [THEN progression_transitive], simplified]) |
456 (* case v1 \<noteq> v2 *) |
463 apply auto |
457 apply (rule progression_one_step [THEN HOL.refl [THEN progression_transitive], simplified]) |
464 apply (rule progression_one_step [THEN HOL.refl [THEN progression_transitive], simplified]) |
458 apply auto |
465 apply auto |
459 apply (rule progression_one_step [THEN HOL.refl [THEN progression_transitive], simplified]) |
466 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
460 apply auto |
467 apply (auto simp: nat_add_distrib intro: progression_refl) |
461 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
468 done |
462 apply (auto simp: nat_add_distrib intro: progression_refl) |
|
463 done |
469 |
464 |
470 |
465 |
471 (**********************************************************************) |
466 (**********************************************************************) |
472 |
467 |
473 |
468 |
474 (* to avoid automatic pair splits *) |
469 (* to avoid automatic pair splits *) |
475 |
470 |
476 declare split_paired_All [simp del] split_paired_Ex [simp del] |
471 declare split_paired_All [simp del] split_paired_Ex [simp del] |
477 |
472 |
478 lemma distinct_method: "\<lbrakk> wf_java_prog G; is_class G C; |
473 lemma distinct_method: |
479 method (G, C) S = Some (D, rT, pns, lvars, blk, res) \<rbrakk> \<Longrightarrow> |
474 "\<lbrakk> wf_java_prog G; is_class G C; method (G, C) S = Some (D, rT, pns, lvars, blk, res) \<rbrakk> \<Longrightarrow> |
480 distinct (gjmb_plns (gmb G C S))" |
475 distinct (gjmb_plns (gmb G C S))" |
481 apply (frule method_wf_mdecl [THEN conjunct2], assumption, assumption) |
476 apply (frule method_wf_mdecl [THEN conjunct2], assumption, assumption) |
482 apply (case_tac S) |
477 apply (case_tac S) |
483 apply (simp add: wf_mdecl_def wf_java_mdecl_def galldefs) |
478 apply (simp add: wf_mdecl_def wf_java_mdecl_def galldefs) |
484 apply (simp add: unique_def map_of_in_set) |
479 apply (simp add: unique_def map_of_in_set) |
485 apply blast |
480 apply blast |
486 done |
481 done |
487 |
482 |
488 lemma distinct_method_if_class_sig_defined : |
483 lemma distinct_method_if_class_sig_defined : |
489 "\<lbrakk> wf_java_prog G; class_sig_defined G C S \<rbrakk> \<Longrightarrow> |
484 "\<lbrakk> wf_java_prog G; class_sig_defined G C S \<rbrakk> \<Longrightarrow> distinct (gjmb_plns (gmb G C S))" |
490 distinct (gjmb_plns (gmb G C S))" |
485 by (auto intro: distinct_method simp: class_sig_defined_def) |
491 by (auto intro: distinct_method simp: class_sig_defined_def) |
|
492 |
486 |
493 |
487 |
494 lemma method_yields_wf_java_mdecl: "\<lbrakk> wf_java_prog G; is_class G C; |
488 lemma method_yields_wf_java_mdecl: "\<lbrakk> wf_java_prog G; is_class G C; |
495 method (G, C) S = Some (D, rT, pns, lvars, blk, res) \<rbrakk> \<Longrightarrow> |
489 method (G, C) S = Some (D, rT, pns, lvars, blk, res) \<rbrakk> \<Longrightarrow> |
496 wf_java_mdecl G D (S,rT,(pns,lvars,blk,res))" |
490 wf_java_mdecl G D (S,rT,(pns,lvars,blk,res))" |
497 apply (frule method_wf_mdecl) |
491 apply (frule method_wf_mdecl) |
498 apply (auto simp: wf_mdecl_def) |
492 apply (auto simp: wf_mdecl_def) |
499 done |
493 done |
500 |
494 |
501 (**********************************************************************) |
495 (**********************************************************************) |
502 |
496 |
503 |
497 |
504 lemma progression_lvar_init_aux [rule_format (no_asm)]: " |
498 lemma progression_lvar_init_aux [rule_format (no_asm)]: " |
542 length lvars = length lvals \<longrightarrow> |
538 length lvars = length lvals \<longrightarrow> |
543 {cG, D, S} \<turnstile> |
539 {cG, D, S} \<turnstile> |
544 {h, os, (a' # pvs @ lvals)} |
540 {h, os, (a' # pvs @ lvals)} |
545 >- (compInitLvars (pns, lvars, blk, res) lvars) \<rightarrow> |
541 >- (compInitLvars (pns, lvars, blk, res) lvars) \<rightarrow> |
546 {h, os, (locvars_xstate G C S (Norm (h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))))})" |
542 {h, os, (locvars_xstate G C S (Norm (h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))))})" |
547 apply (simp only: compInitLvars_def) |
543 apply (simp only: compInitLvars_def) |
548 apply (frule method_yields_wf_java_mdecl, assumption, assumption) |
544 apply (frule method_yields_wf_java_mdecl, assumption, assumption) |
549 |
545 |
550 apply (simp only: wf_java_mdecl_def) |
546 apply (simp only: wf_java_mdecl_def) |
551 apply (subgoal_tac "(\<forall>y\<in>set pns. y \<notin> set (map fst lvars))") |
547 apply (subgoal_tac "(\<forall>y\<in>set pns. y \<notin> set (map fst lvars))") |
552 apply (simp add: init_vars_def locvars_xstate_def locvars_locals_def galldefs unique_def split_def map_of_map_as_map_upd del: map_map) |
548 apply (simp add: init_vars_def locvars_xstate_def locvars_locals_def galldefs unique_def split_def map_of_map_as_map_upd del: map_map) |
553 apply (intro strip) |
549 apply (intro strip) |
554 apply (simp (no_asm_simp) only: append_Cons [symmetric]) |
550 apply (simp (no_asm_simp) only: append_Cons [symmetric]) |
555 apply (rule progression_lvar_init_aux) |
551 apply (rule progression_lvar_init_aux) |
556 apply (auto simp: unique_def map_of_in_set disjoint_varnames_def) |
552 apply (auto simp: unique_def map_of_in_set disjoint_varnames_def) |
557 done |
553 done |
558 |
554 |
559 |
555 |
560 |
556 |
561 |
557 |
562 (**********************************************************************) |
558 (**********************************************************************) |
563 |
559 |
564 lemma state_ok_eval: "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_expr E e; |
560 lemma state_ok_eval: |
565 (prg E)\<turnstile>xs -e\<succ>v -> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
561 "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_expr E e; (prg E)\<turnstile>xs -e\<succ>v -> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
566 apply (simp only: wtpd_expr_def) |
562 apply (simp only: wtpd_expr_def) |
567 apply (erule exE) |
563 apply (erule exE) |
568 apply (case_tac xs', case_tac xs) |
564 apply (case_tac xs', case_tac xs) |
569 apply (auto intro: eval_type_sound [THEN conjunct1]) |
565 apply (auto intro: eval_type_sound [THEN conjunct1]) |
570 done |
566 done |
571 |
567 |
572 lemma state_ok_evals: "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_exprs E es; |
568 lemma state_ok_evals: |
573 prg E \<turnstile> xs -es[\<succ>]vs-> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
569 "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_exprs E es; prg E \<turnstile> xs -es[\<succ>]vs-> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
574 apply (simp only: wtpd_exprs_def) |
570 apply (simp only: wtpd_exprs_def) |
575 apply (erule exE) |
571 apply (erule exE) |
576 apply (case_tac xs) apply (case_tac xs') |
572 apply (case_tac xs) |
577 apply (auto intro: evals_type_sound [THEN conjunct1]) |
573 apply (case_tac xs') |
578 done |
574 apply (auto intro: evals_type_sound [THEN conjunct1]) |
579 |
575 done |
580 lemma state_ok_exec: "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_stmt E st; |
576 |
581 prg E \<turnstile> xs -st-> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
577 lemma state_ok_exec: |
582 apply (simp only: wtpd_stmt_def) |
578 "\<lbrakk>xs::\<preceq>E; wf_java_prog (prg E); wtpd_stmt E st; prg E \<turnstile> xs -st-> xs'\<rbrakk> \<Longrightarrow> xs'::\<preceq>E" |
583 apply (case_tac xs', case_tac xs) |
579 apply (simp only: wtpd_stmt_def) |
584 apply (auto dest: exec_type_sound) |
580 apply (case_tac xs', case_tac xs) |
585 done |
581 apply (auto dest: exec_type_sound) |
586 |
582 done |
587 |
583 |
588 lemma state_ok_init: |
584 lemma state_ok_init: |
589 "\<lbrakk> wf_java_prog G; (x, h, l)::\<preceq>(env_of_jmb G C S); |
585 "\<lbrakk> wf_java_prog G; (x, h, l)::\<preceq>(env_of_jmb G C S); |
590 is_class G dynT; |
586 is_class G dynT; |
591 method (G, dynT) (mn, pTs) = Some (md, rT, pns, lvars, blk, res); |
587 method (G, dynT) (mn, pTs) = Some (md, rT, pns, lvars, blk, res); |
592 list_all2 (conf G h) pvs pTs; G,h \<turnstile> a' ::\<preceq> Class md\<rbrakk> |
588 list_all2 (conf G h) pvs pTs; G,h \<turnstile> a' ::\<preceq> Class md\<rbrakk> |
593 \<Longrightarrow> |
589 \<Longrightarrow> |
594 (np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))::\<preceq>(env_of_jmb G md (mn, pTs))" |
590 (np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))::\<preceq>(env_of_jmb G md (mn, pTs))" |
595 apply (frule wf_prog_ws_prog) |
591 apply (frule wf_prog_ws_prog) |
596 apply (frule method_in_md [THEN conjunct2], assumption+) |
592 apply (frule method_in_md [THEN conjunct2], assumption+) |
597 apply (frule method_yields_wf_java_mdecl, assumption, assumption) |
593 apply (frule method_yields_wf_java_mdecl, assumption, assumption) |
598 apply (simp add: env_of_jmb_def gs_def conforms_def split_beta) |
594 apply (simp add: env_of_jmb_def gs_def conforms_def split_beta) |
599 apply (simp add: wf_java_mdecl_def) |
595 apply (simp add: wf_java_mdecl_def) |
600 apply (rule conjI) |
596 apply (rule conjI) |
601 apply (rule lconf_ext) |
597 apply (rule lconf_ext) |
602 apply (rule lconf_ext_list) |
598 apply (rule lconf_ext_list) |
603 apply (rule lconf_init_vars) |
599 apply (rule lconf_init_vars) |
604 apply (auto dest: Ball_set_table) |
600 apply (auto dest: Ball_set_table) |
605 apply (simp add: np_def xconf_raise_if) |
601 apply (simp add: np_def xconf_raise_if) |
606 done |
602 done |
607 |
603 |
608 |
604 |
609 lemma ty_exprs_list_all2 [rule_format (no_asm)]: |
605 lemma ty_exprs_list_all2 [rule_format (no_asm)]: |
610 "(\<forall> Ts. (E \<turnstile> es [::] Ts) = list_all2 (\<lambda>e T. E \<turnstile> e :: T) es Ts)" |
606 "(\<forall> Ts. (E \<turnstile> es [::] Ts) = list_all2 (\<lambda>e T. E \<turnstile> e :: T) es Ts)" |
611 apply (rule list.induct) |
607 apply (rule list.induct) |
612 apply simp |
608 apply simp |
613 apply (rule allI) |
609 apply (rule allI) |
614 apply (rule iffI) |
610 apply (rule iffI) |
615 apply (ind_cases "E \<turnstile> [] [::] Ts" for Ts, assumption) |
611 apply (ind_cases "E \<turnstile> [] [::] Ts" for Ts, assumption) |
616 apply simp apply (rule WellType.Nil) |
612 apply simp apply (rule WellType.Nil) |
617 apply (simp add: list_all2_Cons1) |
613 apply (simp add: list_all2_Cons1) |
618 apply (rule allI) |
614 apply (rule allI) |
619 apply (rule iffI) |
615 apply (rule iffI) |
620 apply (rename_tac a exs Ts) |
616 apply (rename_tac a exs Ts) |
621 apply (ind_cases "E \<turnstile> a # exs [::] Ts" for a exs Ts) apply blast |
617 apply (ind_cases "E \<turnstile> a # exs [::] Ts" for a exs Ts) apply blast |
622 apply (auto intro: WellType.Cons) |
618 apply (auto intro: WellType.Cons) |
623 done |
619 done |
624 |
620 |
625 |
621 |
626 lemma conf_bool: "G,h \<turnstile> v::\<preceq>PrimT Boolean \<Longrightarrow> \<exists> b. v = Bool b" |
622 lemma conf_bool: "G,h \<turnstile> v::\<preceq>PrimT Boolean \<Longrightarrow> \<exists> b. v = Bool b" |
627 apply (simp add: conf_def) |
623 apply (simp add: conf_def) |
628 apply (erule exE) |
624 apply (erule exE) |
629 apply (case_tac v) |
625 apply (case_tac v) |
630 apply (auto elim: widen.cases) |
626 apply (auto elim: widen.cases) |
631 done |
627 done |
632 |
|
633 |
|
634 lemma class_expr_is_class: "\<lbrakk>E \<turnstile> e :: Class C; ws_prog (prg E)\<rbrakk> |
|
635 \<Longrightarrow> is_class (prg E) C" |
|
636 by (case_tac E, auto dest: ty_expr_is_type) |
|
637 |
628 |
638 |
629 |
639 lemma max_spec_widen: "max_spec G C (mn, pTs) = {((md,rT),pTs')} \<Longrightarrow> |
630 lemma max_spec_widen: "max_spec G C (mn, pTs) = {((md,rT),pTs')} \<Longrightarrow> |
640 list_all2 (\<lambda> T T'. G \<turnstile> T \<preceq> T') pTs pTs'" |
631 list_all2 (\<lambda> T T'. G \<turnstile> T \<preceq> T') pTs pTs'" |
641 by (blast dest: singleton_in_set max_spec2appl_meths appl_methsD) |
632 by (blast dest: singleton_in_set max_spec2appl_meths appl_methsD) |
642 |
633 |
643 |
634 |
644 lemma eval_conf: "\<lbrakk>G \<turnstile> s -e\<succ>v-> s'; wf_java_prog G; s::\<preceq>E; |
635 lemma eval_conf: "\<lbrakk>G \<turnstile> s -e\<succ>v-> s'; wf_java_prog G; s::\<preceq>E; |
645 E\<turnstile>e::T; gx s' = None; prg E = G \<rbrakk> |
636 E\<turnstile>e::T; gx s' = None; prg E = G \<rbrakk> |
646 \<Longrightarrow> G,gh s'\<turnstile>v::\<preceq>T" |
637 \<Longrightarrow> G,gh s'\<turnstile>v::\<preceq>T" |
647 apply (simp add: gh_def) |
638 apply (simp add: gh_def) |
648 apply (rule_tac x3="fst s" and s3="snd s"and x'3="fst s'" |
639 apply (rule_tac x3="fst s" and s3="snd s"and x'3="fst s'" |
649 in eval_type_sound [THEN conjunct2 [THEN conjunct1 [THEN mp]], simplified]) |
640 in eval_type_sound [THEN conjunct2 [THEN conjunct1 [THEN mp]], simplified]) |
650 apply assumption+ |
641 apply assumption+ |
651 apply (simp (no_asm_use) add: surjective_pairing [symmetric]) |
642 apply (simp (no_asm_use)) |
652 apply (simp only: surjective_pairing [symmetric]) |
643 apply (simp only: surjective_pairing [symmetric]) |
653 apply (auto simp add: gs_def gx_def) |
644 apply (auto simp add: gs_def gx_def) |
654 done |
645 done |
655 |
646 |
656 lemma evals_preserves_conf: |
647 lemma evals_preserves_conf: |
657 "\<lbrakk> G\<turnstile> s -es[\<succ>]vs-> s'; G,gh s \<turnstile> t ::\<preceq> T; E \<turnstile>es[::]Ts; |
648 "\<lbrakk> G\<turnstile> s -es[\<succ>]vs-> s'; G,gh s \<turnstile> t ::\<preceq> T; E \<turnstile>es[::]Ts; |
658 wf_java_prog G; s::\<preceq>E; |
649 wf_java_prog G; s::\<preceq>E; |
659 prg E = G \<rbrakk> \<Longrightarrow> G,gh s' \<turnstile> t ::\<preceq> T" |
650 prg E = G \<rbrakk> \<Longrightarrow> G,gh s' \<turnstile> t ::\<preceq> T" |
660 apply (subgoal_tac "gh s\<le>| gh s'") |
651 apply (subgoal_tac "gh s\<le>| gh s'") |
661 apply (frule conf_hext, assumption, assumption) |
652 apply (frule conf_hext, assumption, assumption) |
662 apply (frule eval_evals_exec_type_sound [THEN conjunct2 [THEN conjunct1 [THEN mp]]]) |
653 apply (frule eval_evals_exec_type_sound [THEN conjunct2 [THEN conjunct1 [THEN mp]]]) |
663 apply (subgoal_tac "G \<turnstile> (gx s, (gh s, gl s)) -es[\<succ>]vs-> (gx s', (gh s', gl s'))") |
654 apply (subgoal_tac "G \<turnstile> (gx s, (gh s, gl s)) -es[\<succ>]vs-> (gx s', (gh s', gl s'))") |
664 apply assumption |
655 apply assumption |
665 apply (simp add: gx_def gh_def gl_def surjective_pairing [symmetric]) |
656 apply (simp add: gx_def gh_def gl_def) |
666 apply (case_tac E) |
657 apply (case_tac E) |
667 apply (simp add: gx_def gs_def gh_def gl_def surjective_pairing [symmetric]) |
658 apply (simp add: gx_def gs_def gh_def gl_def) |
668 done |
659 done |
669 |
660 |
670 lemma eval_of_class: "\<lbrakk> G \<turnstile> s -e\<succ>a'-> s'; E \<turnstile> e :: Class C; |
661 lemma eval_of_class: |
671 wf_java_prog G; s::\<preceq>E; gx s'=None; a' \<noteq> Null; G=prg E\<rbrakk> |
662 "\<lbrakk> G \<turnstile> s -e\<succ>a'-> s'; E \<turnstile> e :: Class C; wf_java_prog G; s::\<preceq>E; gx s'=None; a' \<noteq> Null; G=prg E\<rbrakk> |
672 \<Longrightarrow> (\<exists> lc. a' = Addr lc)" |
663 \<Longrightarrow> (\<exists> lc. a' = Addr lc)" |
673 apply (case_tac s, case_tac s', simp) |
664 apply (case_tac s, case_tac s', simp) |
674 apply (frule eval_type_sound, (simp add: gs_def)+) |
665 apply (frule eval_type_sound, (simp add: gs_def)+) |
675 apply (case_tac a') |
666 apply (case_tac a') |
676 apply (auto simp: conf_def) |
667 apply (auto simp: conf_def) |
677 done |
668 done |
678 |
669 |
679 |
670 |
680 lemma dynT_subcls: |
671 lemma dynT_subcls: |
681 "\<lbrakk> a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C; dynT = fst (the (h (the_Addr a'))); |
672 "\<lbrakk> a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C; dynT = fst (the (h (the_Addr a'))); |
682 is_class G dynT; ws_prog G \<rbrakk> \<Longrightarrow> G\<turnstile>dynT \<preceq>C C" |
673 is_class G dynT; ws_prog G \<rbrakk> \<Longrightarrow> G\<turnstile>dynT \<preceq>C C" |
683 apply (case_tac "C = Object") |
674 apply (case_tac "C = Object") |
684 apply (simp, rule subcls_C_Object, assumption+) |
675 apply (simp, rule subcls_C_Object, assumption+) |
685 apply simp |
676 apply simp |
686 apply (frule non_np_objD, auto) |
677 apply (frule non_np_objD, auto) |
687 done |
678 done |
688 |
679 |
689 |
680 |
690 lemma method_defined: "\<lbrakk> |
681 lemma method_defined: "\<lbrakk> |
691 m = the (method (G, dynT) (mn, pTs)); |
682 m = the (method (G, dynT) (mn, pTs)); |
692 dynT = fst (the (h a)); is_class G dynT; wf_java_prog G; |
683 dynT = fst (the (h a)); is_class G dynT; wf_java_prog G; |
693 a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C; a = the_Addr a'; |
684 a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C; a = the_Addr a'; |
694 \<exists>pTsa md rT. max_spec G C (mn, pTsa) = {((md, rT), pTs)} \<rbrakk> |
685 \<exists>pTsa md rT. max_spec G C (mn, pTsa) = {((md, rT), pTs)} \<rbrakk> |
695 \<Longrightarrow> (method (G, dynT) (mn, pTs)) = Some m" |
686 \<Longrightarrow> (method (G, dynT) (mn, pTs)) = Some m" |
696 apply (erule exE)+ |
687 apply (erule exE)+ |
697 apply (drule singleton_in_set, drule max_spec2appl_meths) |
688 apply (drule singleton_in_set, drule max_spec2appl_meths) |
698 apply (simp add: appl_methds_def) |
689 apply (simp add: appl_methds_def) |
699 apply ((erule exE)+, (erule conjE)+, (erule exE)+) |
690 apply (elim exE conjE) |
700 apply (drule widen_methd) |
691 apply (drule widen_methd) |
701 apply assumption |
692 apply (auto intro!: dynT_subcls) |
702 apply (rule dynT_subcls) apply assumption+ apply simp apply simp |
693 done |
703 apply (erule exE)+ apply simp |
|
704 done |
|
705 |
694 |
706 |
695 |
707 |
696 |
708 (**********************************************************************) |
697 (**********************************************************************) |
709 |
698 |
742 (xs::\<preceq>(env_of_jmb G CL S)) \<longrightarrow> |
731 (xs::\<preceq>(env_of_jmb G CL S)) \<longrightarrow> |
743 ( {TranslComp.comp G, CL, S} \<turnstile> |
732 ( {TranslComp.comp G, CL, S} \<turnstile> |
744 {gh xs, os, (locvars_xstate G CL S xs)} |
733 {gh xs, os, (locvars_xstate G CL S xs)} |
745 >- (compStmt (gmb G CL S) st) \<rightarrow> |
734 >- (compStmt (gmb G CL S) st) \<rightarrow> |
746 {gh xs', os, (locvars_xstate G CL S xs')})))" |
735 {gh xs', os, (locvars_xstate G CL S xs')})))" |
747 apply (rule Eval.eval_evals_exec.induct) |
736 apply (rule Eval.eval_evals_exec.induct) |
748 |
737 |
749 (* case XcptE *) |
738 (* case XcptE *) |
750 apply simp |
739 apply simp |
751 |
740 |
752 (* case NewC *) |
741 (* case NewC *) |
753 apply clarify |
742 apply clarify |
754 apply (frule wf_prog_ws_prog [THEN wf_subcls1]) (* establish wf ((subcls1 G)^-1) *) |
743 apply (frule wf_prog_ws_prog [THEN wf_subcls1]) (* establish wf ((subcls1 G)^-1) *) |
755 apply (simp add: c_hupd_hp_invariant) |
744 apply (simp add: c_hupd_hp_invariant) |
756 apply (rule progression_one_step) |
745 apply (rule progression_one_step) |
757 apply (rotate_tac 1, drule sym) (* reverse equation (a, None) = new_Addr (fst s) *) |
746 apply (rotate_tac 1, drule sym) (* reverse equation (a, None) = new_Addr (fst s) *) |
758 apply (simp add: locvars_xstate_def locvars_locals_def comp_fields) |
747 apply (simp add: locvars_xstate_def locvars_locals_def comp_fields) |
759 |
748 |
760 |
749 |
761 (* case Cast *) |
750 (* case Cast *) |
762 apply (intro allI impI) |
751 apply (intro allI impI) |
763 apply simp |
752 apply simp |
764 apply (frule raise_if_NoneD) |
753 apply (frule raise_if_NoneD) |
765 apply (frule wtpd_expr_cast) |
754 apply (frule wtpd_expr_cast) |
766 apply simp |
755 apply simp |
767 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, simp) |
756 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, simp) |
768 apply blast |
757 apply blast |
769 apply (rule progression_one_step) |
758 apply (rule progression_one_step) |
770 apply (simp add: raise_system_xcpt_def gh_def comp_cast_ok) |
759 apply (simp add: raise_system_xcpt_def gh_def comp_cast_ok) |
771 |
760 |
772 |
761 |
773 (* case Lit *) |
762 (* case Lit *) |
774 apply simp |
763 apply simp |
775 apply (intro strip) |
764 apply (intro strip) |
776 apply (rule progression_one_step) |
765 apply (rule progression_one_step) |
777 apply simp |
766 apply simp |
778 |
767 |
779 |
768 |
780 (* case BinOp *) |
769 (* case BinOp *) |
781 apply (intro allI impI) |
770 apply (intro allI impI) |
782 apply (frule_tac xs=s1 in eval_xcpt, assumption) (* establish (gx s1 = None) *) |
771 apply (frule_tac xs=s1 in eval_xcpt, assumption) (* establish (gx s1 = None) *) |
783 apply (frule wtpd_expr_binop) |
772 apply (frule wtpd_expr_binop) |
784 (* establish (s1::\<preceq> \<dots>) *) |
773 (* establish (s1::\<preceq> \<dots>) *) |
785 apply (frule_tac e=e1 in state_ok_eval) apply (simp (no_asm_simp)) apply simp apply (simp (no_asm_use) only: env_of_jmb_fst) |
774 apply (frule_tac e=e1 in state_ok_eval) apply (simp (no_asm_simp)) |
786 |
775 apply simp |
787 |
776 apply (simp (no_asm_use) only: env_of_jmb_fst) |
788 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
777 |
789 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e1" in progression_transitive, simp) apply blast |
778 |
790 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e2" in progression_transitive, simp) apply blast |
779 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
791 apply (case_tac bop) |
780 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e1" in progression_transitive, simp) apply blast |
792 (*subcase bop = Eq *) apply simp apply (rule progression_Eq) |
781 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e2" in progression_transitive, simp) apply blast |
793 (*subcase bop = Add *) apply simp apply (rule progression_one_step) apply simp |
782 apply (case_tac bop) |
794 |
783 (*subcase bop = Eq *) |
795 |
784 apply simp |
796 (* case LAcc *) |
785 apply (rule progression_Eq) |
797 apply simp |
786 (*subcase bop = Add *) |
798 apply (intro strip) |
787 apply simp |
799 apply (rule progression_one_step) |
788 apply (rule progression_one_step) |
800 apply (simp add: locvars_xstate_def locvars_locals_def) |
789 apply simp |
801 apply (frule wtpd_expr_lacc) |
790 |
802 apply assumption |
791 |
803 apply (simp add: gl_def) |
792 (* case LAcc *) |
804 apply (erule select_at_index) |
793 apply simp |
805 |
794 apply (intro strip) |
806 |
795 apply (rule progression_one_step) |
807 (* case LAss *) |
796 apply (simp add: locvars_xstate_def locvars_locals_def) |
808 apply (intro allI impI) |
797 apply (frule wtpd_expr_lacc) |
809 apply (frule wtpd_expr_lass, erule conjE, erule conjE) |
798 apply assumption |
810 apply simp |
799 apply (simp add: gl_def) |
811 |
800 apply (erule select_at_index) |
812 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
801 |
813 apply blast |
802 |
814 |
803 (* case LAss *) |
815 apply (rule_tac ?instrs0.0 = "[Dup]" in progression_transitive, simp) |
804 apply (intro allI impI) |
816 apply (rule progression_one_step) |
805 apply (frule wtpd_expr_lass, erule conjE, erule conjE) |
817 apply (simp add: gh_def) |
806 apply simp |
818 apply simp |
807 |
819 apply (rule progression_one_step) |
808 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
820 apply (simp add: gh_def) |
809 apply blast |
821 (* the following falls out of the general scheme *) |
810 |
822 apply (frule wtpd_expr_lacc) apply assumption |
811 apply (rule_tac ?instrs0.0 = "[Dup]" in progression_transitive, simp) |
823 apply (rule update_at_index) |
812 apply (rule progression_one_step) |
824 apply (rule distinct_method_if_class_sig_defined) apply assumption |
813 apply (simp add: gh_def) |
825 apply assumption apply simp apply assumption |
814 apply simp |
826 |
815 apply (rule progression_one_step) |
827 |
816 apply (simp add: gh_def) |
828 (* case FAcc *) |
817 (* the following falls out of the general scheme *) |
829 apply (intro allI impI) |
818 apply (frule wtpd_expr_lacc) apply assumption |
830 (* establish x1 = None \<and> a' \<noteq> Null *) |
819 apply (rule update_at_index) |
831 apply (simp (no_asm_use) only: gx_conv, frule np_NoneD) |
820 apply (rule distinct_method_if_class_sig_defined) |
832 apply (frule wtpd_expr_facc) |
821 apply assumption |
833 |
822 apply assumption |
834 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
823 apply simp |
835 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
824 apply assumption |
836 apply blast |
825 |
837 apply (rule progression_one_step) |
826 |
838 apply (simp add: gh_def) |
827 (* case FAcc *) |
839 apply (case_tac "(the (fst s1 (the_Addr a')))") |
828 apply (intro allI impI) |
840 apply (simp add: raise_system_xcpt_def) |
829 (* establish x1 = None \<and> a' \<noteq> Null *) |
841 |
830 apply (simp (no_asm_use) only: gx_conv, frule np_NoneD) |
842 |
831 apply (frule wtpd_expr_facc) |
843 (* case FAss *) |
832 |
844 apply (intro allI impI) |
833 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
845 apply (frule wtpd_expr_fass) apply (erule conjE) apply (frule wtpd_expr_facc) |
834 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
846 apply (simp only: c_hupd_xcpt_invariant) (* establish x2 = None *) |
835 apply blast |
847 (* establish x1 = None and a' \<noteq> Null *) |
836 apply (rule progression_one_step) |
848 apply (frule_tac xs="(np a' x1, s1)" in eval_xcpt) |
837 apply (simp add: gh_def) |
849 apply (simp only: gx_conv, simp only: gx_conv, frule np_NoneD, erule conjE) |
838 apply (case_tac "(the (fst s1 (the_Addr a')))") |
850 |
839 apply (simp add: raise_system_xcpt_def) |
851 |
840 |
852 (* establish ((Norm s1)::\<preceq> \<dots>) *) |
841 |
853 apply (frule_tac e=e1 in state_ok_eval) apply (simp (no_asm_simp) only: env_of_jmb_fst) |
842 (* case FAss *) |
854 apply assumption apply (simp (no_asm_use) only: env_of_jmb_fst) |
843 apply (intro allI impI) |
855 |
844 apply (frule wtpd_expr_fass) apply (erule conjE) apply (frule wtpd_expr_facc) |
856 apply (simp only: compExpr.simps compExprs.simps) |
845 apply (simp only: c_hupd_xcpt_invariant) (* establish x2 = None *) |
857 |
846 (* establish x1 = None and a' \<noteq> Null *) |
858 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e1)" in progression_transitive, rule HOL.refl) |
847 apply (frule_tac xs="(np a' x1, s1)" in eval_xcpt) |
859 apply fast (* blast does not seem to work - why? *) |
848 apply (simp only: gx_conv, simp only: gx_conv, frule np_NoneD, erule conjE) |
860 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e2)" in progression_transitive, rule HOL.refl) |
849 |
861 apply fast |
850 |
862 apply (rule_tac ?instrs0.0 = "[Dup_x1]" and ?instrs1.0 = "[Putfield fn T]" in progression_transitive, simp) |
851 (* establish ((Norm s1)::\<preceq> \<dots>) *) |
863 |
852 apply (frule_tac e=e1 in state_ok_eval) |
864 (* Dup_x1 *) |
853 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
865 apply (rule progression_one_step) |
854 apply assumption |
866 apply (simp add: gh_def) |
855 apply (simp (no_asm_use) only: env_of_jmb_fst) |
867 |
856 |
868 (* Putfield \<longrightarrow> still looks nasty*) |
857 apply (simp only: compExpr.simps compExprs.simps) |
869 apply (rule progression_one_step) |
858 |
|
859 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e1)" in progression_transitive, rule HOL.refl) |
|
860 apply fast (* blast does not seem to work - why? *) |
|
861 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e2)" in progression_transitive, rule HOL.refl) |
|
862 apply fast |
|
863 apply (rule_tac ?instrs0.0 = "[Dup_x1]" and ?instrs1.0 = "[Putfield fn T]" in progression_transitive, simp) |
|
864 |
|
865 (* Dup_x1 *) |
|
866 apply (rule progression_one_step) |
|
867 apply (simp add: gh_def) |
|
868 |
|
869 (* Putfield \<longrightarrow> still looks nasty*) |
|
870 apply (rule progression_one_step) |
|
871 apply simp |
|
872 apply (case_tac "(the (fst s2 (the_Addr a')))") |
|
873 apply (simp add: c_hupd_hp_invariant) |
|
874 apply (case_tac s2) |
|
875 apply (simp add: c_hupd_conv raise_system_xcpt_def) |
|
876 apply (rule locvars_xstate_par_dep, rule HOL.refl) |
|
877 |
|
878 defer (* method call *) |
|
879 |
|
880 (* case XcptEs *) |
|
881 apply simp |
|
882 |
|
883 (* case Nil *) |
|
884 apply simp |
|
885 apply (intro strip) |
|
886 apply (rule progression_refl) |
|
887 |
|
888 (* case Cons *) |
|
889 apply (intro allI impI) |
|
890 apply (frule_tac xs=s1 in evals_xcpt, simp only: gx_conv) (* establish gx s1 = None *) |
|
891 apply (frule wtpd_exprs_cons) |
|
892 (* establish ((Norm s0)::\<preceq> \<dots>) *) |
|
893 apply (frule_tac e=e in state_ok_eval) |
|
894 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
895 apply simp |
|
896 apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
897 |
|
898 apply simp |
|
899 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
|
900 apply fast |
|
901 apply fast |
|
902 |
|
903 |
|
904 (* case Statement: exception *) |
|
905 apply simp |
|
906 |
|
907 (* case Skip *) |
|
908 apply (intro allI impI) |
|
909 apply simp |
|
910 apply (rule progression_refl) |
|
911 |
|
912 (* case Expr *) |
|
913 apply (intro allI impI) |
|
914 apply (frule wtpd_stmt_expr) |
|
915 apply simp |
|
916 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
|
917 apply fast |
|
918 apply (rule progression_one_step) |
|
919 apply simp |
|
920 |
|
921 (* case Comp *) |
|
922 apply (intro allI impI) |
|
923 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
|
924 apply (frule wtpd_stmt_comp) |
|
925 |
|
926 (* establish (s1::\<preceq> \<dots>) *) |
|
927 apply (frule_tac st=c1 in state_ok_exec) |
|
928 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
929 apply simp apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
930 |
|
931 apply simp |
|
932 apply (rule_tac ?instrs0.0 = "(compStmt (gmb G CL S) c1)" in progression_transitive, rule HOL.refl) |
|
933 apply fast |
|
934 apply fast |
|
935 |
|
936 |
|
937 (* case Cond *) |
|
938 apply (intro allI impI) |
|
939 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
|
940 apply (frule wtpd_stmt_cond, (erule conjE)+) |
|
941 (* establish (s1::\<preceq> \<dots>) *) |
|
942 apply (frule_tac e=e in state_ok_eval) |
|
943 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
944 apply assumption |
|
945 apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
946 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
|
947 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
|
948 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
|
949 apply (erule exE) |
|
950 |
|
951 apply simp |
|
952 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
|
953 apply (rule progression_one_step, simp) |
|
954 |
|
955 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
|
956 apply fast |
|
957 |
|
958 apply (case_tac b) |
|
959 (* case b= True *) |
|
960 apply simp |
|
961 apply (rule_tac ?instrs0.0 = "[Ifcmpeq (2 + int (length (compStmt (gmb G CL S) c1)))]" in progression_transitive, simp) |
|
962 apply (rule progression_one_step) |
|
963 apply simp |
|
964 apply (rule_tac ?instrs0.0 = "(compStmt (gmb G CL S) c1)" in progression_transitive, simp) |
|
965 apply fast |
|
966 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
|
967 apply (simp) |
|
968 apply simp |
|
969 apply (rule conjI, simp) |
|
970 apply (simp add: nat_add_distrib) |
|
971 apply (rule progression_refl) |
|
972 |
|
973 (* case b= False *) |
|
974 apply simp |
|
975 apply (rule_tac ?instrs1.0 = "compStmt (gmb G CL S) c2" in jump_fwd_progression) |
|
976 apply (simp) |
|
977 apply (simp, rule conjI, rule HOL.refl, simp add: nat_add_distrib) |
|
978 apply fast |
|
979 |
|
980 (* case exit Loop *) |
|
981 apply (intro allI impI) |
|
982 apply (frule wtpd_stmt_loop, (erule conjE)+) |
|
983 |
|
984 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
|
985 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
|
986 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
|
987 apply (erule exE) |
|
988 apply (case_tac b) |
|
989 |
|
990 (* case b= True \<longrightarrow> contradiction *) |
|
991 apply simp |
|
992 |
|
993 (* case b= False *) |
|
994 apply simp |
|
995 |
|
996 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
|
997 apply (rule progression_one_step) |
|
998 apply simp |
|
999 |
|
1000 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
|
1001 apply fast |
|
1002 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
|
1003 apply (simp) |
|
1004 apply (simp, rule conjI, rule HOL.refl, simp add: nat_add_distrib) |
|
1005 apply (rule progression_refl) |
|
1006 |
|
1007 |
|
1008 (* case continue Loop *) |
|
1009 apply (intro allI impI) |
|
1010 apply (frule_tac xs=s2 in exec_xcpt, assumption) (* establish (gx s2 = None) *) |
|
1011 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
|
1012 apply (frule wtpd_stmt_loop, (erule conjE)+) |
|
1013 |
|
1014 (* establish (s1::\<preceq> \<dots>) *) |
|
1015 apply (frule_tac e=e in state_ok_eval) |
|
1016 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
1017 apply simp |
|
1018 apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
1019 (* establish (s2::\<preceq> \<dots>) *) |
|
1020 apply (frule_tac xs=s1 and st=c in state_ok_exec) |
|
1021 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
1022 apply assumption |
|
1023 apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
1024 |
|
1025 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
|
1026 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
|
1027 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
|
1028 apply (erule exE) |
|
1029 |
870 apply simp |
1030 apply simp |
871 apply (case_tac "(the (fst s2 (the_Addr a')))") |
1031 apply (rule jump_bwd_progression) |
872 apply (simp add: c_hupd_hp_invariant) |
1032 apply simp |
873 apply (case_tac s2) |
1033 |
874 apply (simp add: c_hupd_conv raise_system_xcpt_def) |
1034 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
875 apply (rule locvars_xstate_par_dep, rule HOL.refl) |
1035 apply (rule progression_one_step) |
876 |
1036 apply simp |
877 defer (* method call *) |
1037 |
878 |
1038 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
879 (* case XcptEs *) |
1039 apply fast |
880 apply simp |
1040 |
881 |
1041 apply (case_tac b) |
882 (* case Nil *) |
1042 (* case b= True *) |
883 apply simp |
1043 apply simp |
884 apply (intro strip) |
1044 |
885 apply (rule progression_refl) |
1045 apply (rule_tac ?instrs0.0 = "[Ifcmpeq (2 + int (length (compStmt (gmb G CL S) c)))]" in progression_transitive, simp) |
886 |
1046 apply (rule progression_one_step) |
887 (* case Cons *) |
1047 apply simp |
888 apply (intro allI impI) |
1048 apply fast |
889 apply (frule_tac xs=s1 in evals_xcpt, simp only: gx_conv) (* establish gx s1 = None *) |
1049 |
890 apply (frule wtpd_exprs_cons) |
1050 (* case b= False \<longrightarrow> contradiction*) |
891 (* establish ((Norm s0)::\<preceq> \<dots>) *) |
1051 apply simp |
892 apply (frule_tac e=e in state_ok_eval) apply (simp (no_asm_simp) only: env_of_jmb_fst) apply simp apply (simp (no_asm_use) only: env_of_jmb_fst) |
1052 |
893 |
1053 apply (rule jump_bwd_one_step) |
894 apply simp |
1054 apply simp |
895 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
1055 apply blast |
896 apply fast |
1056 |
897 apply fast |
1057 (*****) |
898 |
1058 (* case method call *) |
899 |
1059 |
900 (* case Statement: exception *) |
1060 apply (intro allI impI) |
901 apply simp |
1061 |
902 |
1062 apply (frule_tac xs=s3 in eval_xcpt, simp only: gx_conv) (* establish gx s3 = None *) |
903 (* case Skip *) |
1063 apply (frule exec_xcpt, assumption, simp (no_asm_use) only: gx_conv, frule np_NoneD) (* establish x = None \<and> a' \<noteq> Null *) |
904 apply (intro allI impI) |
1064 apply (frule evals_xcpt, simp only: gx_conv) (* establish gx s1 = None *) |
905 apply simp |
1065 |
906 apply (rule progression_refl) |
1066 apply (frule wtpd_expr_call, (erule conjE)+) |
907 |
1067 |
908 (* case Expr *) |
1068 |
909 apply (intro allI impI) |
1069 (* assumptions about state_ok and is_class *) |
910 apply (frule wtpd_stmt_expr) |
1070 |
911 apply simp |
1071 (* establish s1::\<preceq> (env_of_jmb G CL S) *) |
912 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
1072 apply (frule_tac xs="Norm s0" and e=e in state_ok_eval) |
913 apply fast |
1073 apply (simp (no_asm_simp) only: env_of_jmb_fst, assumption, simp (no_asm_use) only: env_of_jmb_fst) |
914 apply (rule progression_one_step) |
1074 |
915 apply simp |
1075 (* establish (x, h, l)::\<preceq>(env_of_jmb G CL S) *) |
916 |
1076 apply (frule_tac xs=s1 and xs'="(x, h, l)" in state_ok_evals) |
917 (* case Comp *) |
1077 apply (simp (no_asm_simp) only: env_of_jmb_fst, assumption, simp only: env_of_jmb_fst) |
918 apply (intro allI impI) |
1078 |
919 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
1079 (* establish \<exists> lc. a' = Addr lc *) |
920 apply (frule wtpd_stmt_comp) |
1080 apply (frule (5) eval_of_class, rule env_of_jmb_fst [symmetric]) |
921 |
1081 apply (subgoal_tac "G,h \<turnstile> a' ::\<preceq> Class C") |
922 (* establish (s1::\<preceq> \<dots>) *) |
1082 apply (subgoal_tac "is_class G dynT") |
923 apply (frule_tac st=c1 in state_ok_exec) apply (simp (no_asm_simp) only: env_of_jmb_fst) apply simp apply (simp (no_asm_use) only: env_of_jmb_fst) |
1083 |
924 |
1084 (* establish method (G, dynT) (mn, pTs) = Some(md, rT, pns, lvars, blk, res) *) |
925 apply simp |
1085 apply (drule method_defined, assumption+) |
926 apply (rule_tac ?instrs0.0 = "(compStmt (gmb G CL S) c1)" in progression_transitive, rule HOL.refl) |
1086 apply (simp only: env_of_jmb_fst) |
927 apply fast |
1087 apply ((erule exE)+, erule conjE, (rule exI)+, assumption) |
928 apply fast |
1088 |
929 |
1089 apply (subgoal_tac "is_class G md") |
930 |
1090 apply (subgoal_tac "G\<turnstile>Class dynT \<preceq> Class md") |
931 (* case Cond *) |
1091 apply (subgoal_tac " method (G, md) (mn, pTs) = Some (md, rT, pns, lvars, blk, res)") |
932 apply (intro allI impI) |
1092 apply (subgoal_tac "list_all2 (conf G h) pvs pTs") |
933 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
1093 |
934 apply (frule wtpd_stmt_cond, (erule conjE)+) |
1094 (* establish (np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))::\<preceq>(env_of_jmb G md (mn, pTs)) *) |
935 (* establish (s1::\<preceq> \<dots>) *) |
1095 apply (subgoal_tac "G,h \<turnstile> a' ::\<preceq> Class dynT") |
936 apply (frule_tac e=e in state_ok_eval) |
1096 apply (frule (2) conf_widen) |
937 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
1097 apply (frule state_ok_init, assumption+) |
938 apply assumption |
1098 |
939 apply (simp (no_asm_use) only: env_of_jmb_fst) |
1099 apply (subgoal_tac "class_sig_defined G md (mn, pTs)") |
940 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
1100 apply (frule wtpd_blk, assumption, assumption) |
941 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
1101 apply (frule wtpd_res, assumption, assumption) |
942 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
1102 apply (subgoal_tac "s3::\<preceq>(env_of_jmb G md (mn, pTs))") |
943 apply (erule exE) |
1103 |
944 |
1104 apply (subgoal_tac "method (TranslComp.comp G, md) (mn, pTs) = |
945 apply simp |
1105 Some (md, rT, snd (snd (compMethod G md ((mn, pTs), rT, pns, lvars, blk, res))))") |
946 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
1106 prefer 2 |
947 apply (rule progression_one_step, simp) |
1107 apply (simp add: wf_prog_ws_prog [THEN comp_method]) |
948 |
1108 apply (subgoal_tac "method (TranslComp.comp G, dynT) (mn, pTs) = |
949 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
1109 Some (md, rT, snd (snd (compMethod G md ((mn, pTs), rT, pns, lvars, blk, res))))") |
950 apply fast |
1110 prefer 2 |
951 |
1111 apply (simp add: wf_prog_ws_prog [THEN comp_method]) |
952 apply (case_tac b) |
1112 apply (simp only: fst_conv snd_conv) |
953 (* case b= True *) |
1113 |
954 apply simp |
1114 (* establish length pns = length pTs *) |
955 apply (rule_tac ?instrs0.0 = "[Ifcmpeq (2 + int (length (compStmt (gmb G CL S) c1)))]" in progression_transitive, simp) |
1115 apply (frule method_preserves_length, assumption, assumption) |
956 apply (rule progression_one_step) apply simp |
1116 (* establish length pvs = length ps *) |
957 apply (rule_tac ?instrs0.0 = "(compStmt (gmb G CL S) c1)" in progression_transitive, simp) |
1117 apply (frule evals_preserves_length [symmetric]) |
958 apply fast |
1118 |
959 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
1119 (** start evaluating subexpressions **) |
960 apply (simp) |
1120 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
961 apply simp apply (rule conjI, simp) apply (simp add: nat_add_distrib) |
1121 |
962 apply (rule progression_refl) |
1122 (* evaluate e *) |
963 |
1123 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
964 (* case b= False *) |
1124 apply fast |
965 apply simp |
1125 |
966 apply (rule_tac ?instrs1.0 = "compStmt (gmb G CL S) c2" in jump_fwd_progression) |
1126 (* evaluate parameters *) |
967 apply (simp) |
1127 apply (rule_tac ?instrs0.0 = "compExprs (gmb G CL S) ps" in progression_transitive, rule HOL.refl) |
968 apply (simp, rule conjI, rule HOL.refl, simp add: nat_add_distrib) |
1128 apply fast |
969 apply fast |
1129 |
970 |
1130 (* invokation *) |
971 (* case exit Loop *) |
1131 apply (rule progression_call) |
972 apply (intro allI impI) |
1132 apply (intro allI impI conjI) |
973 apply (frule wtpd_stmt_loop, (erule conjE)+) |
1133 (* execute Invoke statement *) |
974 |
1134 apply (simp (no_asm_use) only: exec_instr.simps) |
975 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
1135 apply (erule thin_rl, erule thin_rl, erule thin_rl) |
976 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
1136 apply (simp add: compMethod_def raise_system_xcpt_def) |
977 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
1137 |
978 apply (erule exE) |
1138 (* get instructions of invoked method *) |
979 apply (case_tac b) |
1139 apply (simp (no_asm_simp) add: gis_def gmb_def compMethod_def) |
980 |
1140 |
981 (* case b= True \<longrightarrow> contradiction *) |
1141 (* var. initialization *) |
982 apply simp |
1142 apply (rule_tac ?instrs0.0 = "(compInitLvars (pns, lvars, blk, res) lvars)" in progression_transitive, rule HOL.refl) |
983 |
1143 apply (rule_tac C=md in progression_lvar_init, assumption, assumption, assumption) |
984 (* case b= False *) |
1144 apply (simp (no_asm_simp)) (* length pns = length pvs *) |
985 apply simp |
1145 apply (simp (no_asm_simp)) (* length lvars = length (replicate (length lvars) undefined) *) |
986 |
1146 |
987 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
1147 |
988 apply (rule progression_one_step) |
1148 (* body statement *) |
989 apply simp |
1149 apply (rule_tac ?instrs0.0 = "compStmt (pns, lvars, blk, res) blk" in progression_transitive, rule HOL.refl) |
990 |
1150 apply (subgoal_tac "(pns, lvars, blk, res) = gmb G md (mn, pTs)") |
991 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
1151 apply (simp (no_asm_simp)) |
992 apply fast |
1152 apply (simp only: gh_conv) |
993 apply (rule_tac ?instrs1.0 = "[]" in jump_fwd_progression) |
1153 apply (drule mp [OF _ TrueI])+ |
994 apply (simp) |
1154 apply (erule allE, erule allE, erule allE, erule impE, assumption)+ |
995 apply (simp, rule conjI, rule HOL.refl, simp add: nat_add_distrib) |
1155 apply ((erule impE, assumption)+, assumption) |
996 apply (rule progression_refl) |
1156 |
997 |
1157 apply (simp (no_asm_use)) |
998 |
1158 apply (simp (no_asm_simp) add: gmb_def) |
999 (* case continue Loop *) |
1159 |
1000 apply (intro allI impI) |
1160 (* return expression *) |
1001 apply (frule_tac xs=s2 in exec_xcpt, assumption) (* establish (gx s2 = None) *) |
1161 apply (subgoal_tac "(pns, lvars, blk, res) = gmb G md (mn, pTs)") |
1002 apply (frule_tac xs=s1 in exec_xcpt, assumption) (* establish (gx s1 = None) *) |
1162 apply (simp (no_asm_simp)) |
1003 apply (frule wtpd_stmt_loop, (erule conjE)+) |
1163 apply (simp only: gh_conv) |
1004 |
1164 apply ((drule mp, rule TrueI)+, (drule spec)+, (drule mp, assumption)+, assumption) |
1005 (* establish (s1::\<preceq> \<dots>) *) |
1165 apply (simp (no_asm_use)) |
1006 apply (frule_tac e=e in state_ok_eval) apply (simp (no_asm_simp) only: env_of_jmb_fst) apply simp apply (simp (no_asm_use) only: env_of_jmb_fst) |
1166 apply (simp (no_asm_simp) add: gmb_def) |
1007 (* establish (s2::\<preceq> \<dots>) *) |
1167 |
1008 apply (frule_tac xs=s1 and st=c in state_ok_exec) |
1168 (* execute return statement *) |
1009 apply (simp (no_asm_simp) only: env_of_jmb_fst) apply assumption apply (simp (no_asm_use) only: env_of_jmb_fst) |
1169 apply (simp (no_asm_use) add: gh_def locvars_xstate_def gl_def del: drop_append) |
1010 |
1170 apply (subgoal_tac "rev pvs @ a' # os = (rev (a' # pvs)) @ os") |
1011 (* establish G,gh s1\<turnstile>v::\<preceq>PrimT Boolean *) |
1171 apply (simp only: drop_append) |
1012 apply (frule eval_conf, assumption+, rule env_of_jmb_fst) |
1172 apply (simp (no_asm_simp)) |
1013 apply (frule conf_bool) (* establish \<exists>b. v = Bool b *) |
1173 apply (simp (no_asm_simp)) |
1014 apply (erule exE) |
1174 |
1015 |
1175 (* show s3::\<preceq>\<dots> *) |
1016 apply simp |
1176 apply (rule_tac xs = "(np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))" and st=blk in state_ok_exec) |
1017 apply (rule jump_bwd_progression) |
1177 apply assumption |
1018 apply simp |
1178 apply (simp (no_asm_simp) only: env_of_jmb_fst) |
1019 |
1179 apply assumption |
1020 apply (rule_tac ?instrs0.0 = "[LitPush (Bool False)]" in progression_transitive, simp (no_asm_simp)) |
1180 apply (simp (no_asm_use) only: env_of_jmb_fst) |
1021 apply (rule progression_one_step) |
1181 |
1022 apply simp |
1182 (* show class_sig_defined G md (mn, pTs) *) |
1023 |
1183 apply (simp (no_asm_simp) add: class_sig_defined_def) |
1024 apply (rule_tac ?instrs0.0 = "compExpr (gmb G CL S) e" in progression_transitive, rule HOL.refl) |
1184 |
1025 apply fast |
1185 (* show G,h \<turnstile> a' ::\<preceq> Class dynT *) |
1026 |
1186 apply (frule non_npD) |
1027 apply (case_tac b) |
1187 apply assumption |
1028 (* case b= True *) |
1188 apply (erule exE)+ |
1029 apply simp |
1189 apply simp |
1030 |
1190 apply (rule conf_obj_AddrI) |
1031 apply (rule_tac ?instrs0.0 = "[Ifcmpeq (2 + int (length (compStmt (gmb G CL S) c)))]" in progression_transitive, simp) |
1191 apply simp |
1032 apply (rule progression_one_step) apply simp |
1192 apply (rule widen_Class_Class [THEN iffD1], rule widen.refl) |
1033 apply fast |
1193 |
1034 |
1194 |
1035 (* case b= False \<longrightarrow> contradiction*) |
1195 (* show list_all2 (conf G h) pvs pTs *) |
1036 apply simp |
1196 apply (erule exE)+ apply (erule conjE)+ |
1037 |
1197 apply (rule_tac Ts="pTsa" in conf_list_gext_widen) |
1038 apply (rule jump_bwd_one_step) |
1198 apply assumption |
1039 apply simp |
1199 apply (subgoal_tac "G \<turnstile> (gx s1, gs s1) -ps[\<succ>]pvs-> (x, h, l)") |
1040 apply blast |
1200 apply (frule_tac E="env_of_jmb G CL S" in evals_type_sound) |
1041 |
1201 apply assumption+ |
1042 (*****) |
1202 apply (simp only: env_of_jmb_fst) |
1043 (* case method call *) |
1203 apply (simp add: conforms_def xconf_def gs_def) |
1044 |
1204 apply simp |
1045 apply (intro allI impI) |
1205 apply (simp (no_asm_use) only: gx_def gs_def surjective_pairing [symmetric]) |
1046 |
1206 apply (simp (no_asm_use) only: ty_exprs_list_all2) |
1047 apply (frule_tac xs=s3 in eval_xcpt, simp only: gx_conv) (* establish gx s3 = None *) |
1207 apply simp |
1048 apply (frule exec_xcpt, assumption, simp (no_asm_use) only: gx_conv, frule np_NoneD) (* establish x = None \<and> a' \<noteq> Null *) |
1208 apply simp |
1049 apply (frule evals_xcpt, simp only: gx_conv) (* establish gx s1 = None *) |
1209 apply (simp (no_asm_use) only: gx_def gs_def surjective_pairing [symmetric]) |
1050 |
1210 (* list_all2 (\<lambda>T T'. G \<turnstile> T \<preceq> T') pTsa pTs *) |
1051 apply (frule wtpd_expr_call, (erule conjE)+) |
1211 apply (rule max_spec_widen, simp only: env_of_jmb_fst) |
1052 |
1212 |
1053 |
1213 |
1054 (* assumptions about state_ok and is_class *) |
1214 (* show method (G, md) (mn, pTs) = Some (md, rT, pns, lvars, blk, res) *) |
1055 |
1215 apply (frule wf_prog_ws_prog [THEN method_in_md [THEN conjunct2]], assumption+) |
1056 (* establish s1::\<preceq> (env_of_jmb G CL S) *) |
1216 |
1057 apply (frule_tac xs="Norm s0" and e=e in state_ok_eval) |
1217 (* show G\<turnstile>Class dynT \<preceq> Class md *) |
1058 apply (simp (no_asm_simp) only: env_of_jmb_fst, assumption, simp (no_asm_use) only: env_of_jmb_fst) |
1218 apply (simp (no_asm_use) only: widen_Class_Class) |
1059 |
1219 apply (rule method_wf_mdecl [THEN conjunct1], assumption+) |
1060 (* establish (x, h, l)::\<preceq>(env_of_jmb G CL S) *) |
1220 |
1061 apply (frule_tac xs=s1 and xs'="(x, h, l)" in state_ok_evals) |
1221 (* is_class G md *) |
1062 apply (simp (no_asm_simp) only: env_of_jmb_fst, assumption, simp only: env_of_jmb_fst) |
1222 apply (rule wf_prog_ws_prog [THEN method_in_md [THEN conjunct1]], assumption+) |
1063 |
1223 |
1064 (* establish \<exists> lc. a' = Addr lc *) |
1224 (* show is_class G dynT *) |
1065 apply (frule (5) eval_of_class, rule env_of_jmb_fst [symmetric]) |
1225 apply (frule non_npD) |
1066 apply (subgoal_tac "G,h \<turnstile> a' ::\<preceq> Class C") |
1226 apply assumption |
1067 apply (subgoal_tac "is_class G dynT") |
1227 apply (erule exE)+ |
1068 |
1228 apply (erule conjE)+ |
1069 (* establish method (G, dynT) (mn, pTs) = Some(md, rT, pns, lvars, blk, res) *) |
1229 apply simp |
1070 apply (drule method_defined, assumption+) |
1230 apply (rule subcls_is_class2) |
1071 apply (simp only: env_of_jmb_fst) |
1231 apply assumption |
1072 apply ((erule exE)+, erule conjE, (rule exI)+, assumption) |
1232 apply (frule expr_class_is_class [rotated]) |
1073 |
1233 apply (simp only: env_of_jmb_fst) |
1074 apply (subgoal_tac "is_class G md") |
1234 apply (rule wf_prog_ws_prog, assumption) |
1075 apply (subgoal_tac "G\<turnstile>Class dynT \<preceq> Class md") |
1235 apply (simp only: env_of_jmb_fst) |
1076 apply (subgoal_tac " method (G, md) (mn, pTs) = Some (md, rT, pns, lvars, blk, res)") |
1236 |
1077 apply (subgoal_tac "list_all2 (conf G h) pvs pTs") |
1237 (* show G,h \<turnstile> a' ::\<preceq> Class C *) |
1078 |
1238 apply (simp only: wtpd_exprs_def, erule exE) |
1079 (* establish (np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))::\<preceq>(env_of_jmb G md (mn, pTs)) *) |
1239 apply (frule evals_preserves_conf) |
1080 apply (subgoal_tac "G,h \<turnstile> a' ::\<preceq> Class dynT") |
1240 apply (rule eval_conf, assumption+) |
1081 apply (frule (2) conf_widen) |
1241 apply (rule env_of_jmb_fst, assumption+) |
1082 apply (frule state_ok_init, assumption+) |
1242 apply (rule env_of_jmb_fst) |
1083 |
1243 apply (simp only: gh_conv) |
1084 apply (subgoal_tac "class_sig_defined G md (mn, pTs)") |
1244 done |
1085 apply (frule wtpd_blk, assumption, assumption) |
|
1086 apply (frule wtpd_res, assumption, assumption) |
|
1087 apply (subgoal_tac "s3::\<preceq>(env_of_jmb G md (mn, pTs))") |
|
1088 |
|
1089 apply (subgoal_tac "method (TranslComp.comp G, md) (mn, pTs) = |
|
1090 Some (md, rT, snd (snd (compMethod G md ((mn, pTs), rT, pns, lvars, blk, res))))") |
|
1091 prefer 2 apply (simp add: wf_prog_ws_prog [THEN comp_method]) |
|
1092 apply (subgoal_tac "method (TranslComp.comp G, dynT) (mn, pTs) = |
|
1093 Some (md, rT, snd (snd (compMethod G md ((mn, pTs), rT, pns, lvars, blk, res))))") |
|
1094 prefer 2 apply (simp add: wf_prog_ws_prog [THEN comp_method]) |
|
1095 apply (simp only: fst_conv snd_conv) |
|
1096 |
|
1097 (* establish length pns = length pTs *) |
|
1098 apply (frule method_preserves_length, assumption, assumption) |
|
1099 (* establish length pvs = length ps *) |
|
1100 apply (frule evals_preserves_length [symmetric]) |
|
1101 |
|
1102 (** start evaluating subexpressions **) |
|
1103 apply (simp (no_asm_use) only: compExpr.simps compExprs.simps) |
|
1104 |
|
1105 (* evaluate e *) |
|
1106 apply (rule_tac ?instrs0.0 = "(compExpr (gmb G CL S) e)" in progression_transitive, rule HOL.refl) |
|
1107 apply fast |
|
1108 |
|
1109 (* evaluate parameters *) |
|
1110 apply (rule_tac ?instrs0.0 = "compExprs (gmb G CL S) ps" in progression_transitive, rule HOL.refl) |
|
1111 apply fast |
|
1112 |
|
1113 (* invokation *) |
|
1114 apply (rule progression_call) |
|
1115 apply (intro allI impI conjI) |
|
1116 (* execute Invoke statement *) |
|
1117 apply (simp (no_asm_use) only: exec_instr.simps) |
|
1118 apply (erule thin_rl, erule thin_rl, erule thin_rl) |
|
1119 apply (simp add: compMethod_def raise_system_xcpt_def) |
|
1120 |
|
1121 (* get instructions of invoked method *) |
|
1122 apply (simp (no_asm_simp) add: gis_def gmb_def compMethod_def) |
|
1123 |
|
1124 (* var. initialization *) |
|
1125 apply (rule_tac ?instrs0.0 = "(compInitLvars (pns, lvars, blk, res) lvars)" in progression_transitive, rule HOL.refl) |
|
1126 apply (rule_tac C=md in progression_lvar_init, assumption, assumption, assumption) |
|
1127 apply (simp (no_asm_simp)) (* length pns = length pvs *) |
|
1128 apply (simp (no_asm_simp)) (* length lvars = length (replicate (length lvars) undefined) *) |
|
1129 |
|
1130 |
|
1131 (* body statement *) |
|
1132 apply (rule_tac ?instrs0.0 = "compStmt (pns, lvars, blk, res) blk" in progression_transitive, rule HOL.refl) |
|
1133 apply (subgoal_tac "(pns, lvars, blk, res) = gmb G md (mn, pTs)") |
|
1134 apply (simp (no_asm_simp)) |
|
1135 apply (simp only: gh_conv) |
|
1136 apply (drule mp [OF _ TrueI])+ |
|
1137 apply (erule allE, erule allE, erule allE, erule impE, assumption)+ |
|
1138 apply ((erule impE, assumption)+, assumption) |
|
1139 |
|
1140 apply (simp (no_asm_use)) |
|
1141 apply (simp (no_asm_simp) add: gmb_def) |
|
1142 |
|
1143 (* return expression *) |
|
1144 apply (subgoal_tac "(pns, lvars, blk, res) = gmb G md (mn, pTs)") |
|
1145 apply (simp (no_asm_simp)) |
|
1146 apply (simp only: gh_conv) |
|
1147 apply ((drule mp, rule TrueI)+, (drule spec)+, (drule mp, assumption)+, assumption) |
|
1148 apply (simp (no_asm_use)) |
|
1149 apply (simp (no_asm_simp) add: gmb_def) |
|
1150 |
|
1151 (* execute return statement *) |
|
1152 apply (simp (no_asm_use) add: gh_def locvars_xstate_def gl_def del: drop_append) |
|
1153 apply (subgoal_tac "rev pvs @ a' # os = (rev (a' # pvs)) @ os") |
|
1154 apply (simp only: drop_append) |
|
1155 apply (simp (no_asm_simp)) |
|
1156 apply (simp (no_asm_simp)) |
|
1157 |
|
1158 (* show s3::\<preceq>\<dots> *) |
|
1159 apply (rule_tac xs = "(np a' x, h, init_vars lvars(pns[\<mapsto>]pvs)(This\<mapsto>a'))" and st=blk in state_ok_exec) |
|
1160 apply assumption apply (simp (no_asm_simp) only: env_of_jmb_fst) |
|
1161 apply assumption apply (simp (no_asm_use) only: env_of_jmb_fst) |
|
1162 |
|
1163 (* show class_sig_defined G md (mn, pTs) *) |
|
1164 apply (simp (no_asm_simp) add: class_sig_defined_def) |
|
1165 |
|
1166 (* show G,h \<turnstile> a' ::\<preceq> Class dynT *) |
|
1167 apply (frule non_npD) apply assumption |
|
1168 apply (erule exE)+ apply simp |
|
1169 apply (rule conf_obj_AddrI) apply simp |
|
1170 apply (rule widen_Class_Class [THEN iffD1], rule widen.refl) |
|
1171 |
|
1172 |
|
1173 (* show list_all2 (conf G h) pvs pTs *) |
|
1174 apply (erule exE)+ apply (erule conjE)+ |
|
1175 apply (rule_tac Ts="pTsa" in conf_list_gext_widen) apply assumption |
|
1176 apply (subgoal_tac "G \<turnstile> (gx s1, gs s1) -ps[\<succ>]pvs-> (x, h, l)") |
|
1177 apply (frule_tac E="env_of_jmb G CL S" in evals_type_sound) |
|
1178 apply assumption+ |
|
1179 apply (simp only: env_of_jmb_fst) |
|
1180 apply (simp add: conforms_def xconf_def gs_def) |
|
1181 apply simp |
|
1182 apply (simp (no_asm_use) only: gx_def gs_def surjective_pairing [symmetric]) |
|
1183 apply (simp (no_asm_use) only: ty_exprs_list_all2) apply simp |
|
1184 apply simp |
|
1185 apply (simp (no_asm_use) only: gx_def gs_def surjective_pairing [symmetric]) |
|
1186 (* list_all2 (\<lambda>T T'. G \<turnstile> T \<preceq> T') pTsa pTs *) |
|
1187 apply (rule max_spec_widen, simp only: env_of_jmb_fst) |
|
1188 |
|
1189 |
|
1190 (* show method (G, md) (mn, pTs) = Some (md, rT, pns, lvars, blk, res) *) |
|
1191 apply (frule wf_prog_ws_prog [THEN method_in_md [THEN conjunct2]], assumption+) |
|
1192 |
|
1193 (* show G\<turnstile>Class dynT \<preceq> Class md *) |
|
1194 apply (simp (no_asm_use) only: widen_Class_Class) |
|
1195 apply (rule method_wf_mdecl [THEN conjunct1], assumption+) |
|
1196 |
|
1197 (* is_class G md *) |
|
1198 apply (rule wf_prog_ws_prog [THEN method_in_md [THEN conjunct1]], assumption+) |
|
1199 |
|
1200 (* show is_class G dynT *) |
|
1201 apply (frule non_npD) apply assumption |
|
1202 apply (erule exE)+ apply (erule conjE)+ |
|
1203 apply simp |
|
1204 apply (rule subcls_is_class2) apply assumption |
|
1205 apply (frule class_expr_is_class) apply (simp only: env_of_jmb_fst) |
|
1206 apply (rule wf_prog_ws_prog, assumption) |
|
1207 apply (simp only: env_of_jmb_fst) |
|
1208 |
|
1209 (* show G,h \<turnstile> a' ::\<preceq> Class C *) |
|
1210 apply (simp only: wtpd_exprs_def, erule exE) |
|
1211 apply (frule evals_preserves_conf) |
|
1212 apply (rule eval_conf, assumption+) |
|
1213 apply (rule env_of_jmb_fst, assumption+) |
|
1214 apply (rule env_of_jmb_fst) |
|
1215 apply (simp only: gh_conv) |
|
1216 done |
|
1217 |
1245 |
1218 |
1246 |
1219 theorem compiler_correctness_eval: " |
1247 theorem compiler_correctness_eval: " |
1220 \<lbrakk> G \<turnstile> (None,hp,loc) -ex \<succ> val-> (None,hp',loc'); |
1248 \<lbrakk> G \<turnstile> (None,hp,loc) -ex \<succ> val-> (None,hp',loc'); |
1221 wf_java_prog G; |
1249 wf_java_prog G; |