Added check for field/method access to operational semantics and proved the acesses valid.
authorschirmer
Fri Feb 22 11:26:44 2002 +0100 (2002-02-22)
changeset 1292599131847fb93
parent 12924 02eb40cde931
child 12926 cd0dd6e0bf5c
Added check for field/method access to operational semantics and proved the acesses valid.
src/HOL/Bali/AxCompl.thy
src/HOL/Bali/AxExample.thy
src/HOL/Bali/AxSem.thy
src/HOL/Bali/AxSound.thy
src/HOL/Bali/Basis.thy
src/HOL/Bali/Conform.thy
src/HOL/Bali/Decl.thy
src/HOL/Bali/DeclConcepts.thy
src/HOL/Bali/Eval.thy
src/HOL/Bali/Evaln.thy
src/HOL/Bali/Example.thy
src/HOL/Bali/State.thy
src/HOL/Bali/Table.thy
src/HOL/Bali/Term.thy
src/HOL/Bali/Trans.thy
src/HOL/Bali/TypeSafe.thy
src/HOL/Bali/WellForm.thy
src/HOL/Bali/WellType.thy
     1.1 --- a/src/HOL/Bali/AxCompl.thy	Thu Feb 21 20:11:32 2002 +0100
     1.2 +++ b/src/HOL/Bali/AxCompl.thy	Fri Feb 22 11:26:44 2002 +0100
     1.3 @@ -16,6 +16,9 @@
     1.4  \item proof structured by Most General Formulas (-> Thomas Kleymann)
     1.5  \end{itemize}
     1.6  *}
     1.7 +
     1.8 +
     1.9 +
    1.10  section "set of not yet initialzed classes"
    1.11  
    1.12  constdefs
    1.13 @@ -155,11 +158,14 @@
    1.14    "{=:n} t\<succ> {G\<rightarrow>} \<equiv> {\<doteq> \<and>. G\<turnstile>init\<le>n} t\<succ> {G\<rightarrow>}"
    1.15  
    1.16  (* unused *)
    1.17 -lemma MGF_valid: "G,{}\<Turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
    1.18 +
    1.19 +lemma MGF_valid: "wf_prog G \<Longrightarrow> G,{}\<Turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
    1.20  apply (unfold MGF_def)
    1.21 -apply (force dest!: evaln_eval simp add: ax_valids_def triple_valid_def2)
    1.22 +apply (simp add:  ax_valids_def triple_valid_def2)
    1.23 +apply (auto elim: evaln_eval)
    1.24  done
    1.25  
    1.26 +
    1.27  lemma MGF_res_eq_lemma [simp]: 
    1.28    "(\<forall>Y' Y s. Y = Y' \<and> P s \<longrightarrow> Q s) = (\<forall>s. P s \<longrightarrow> Q s)"
    1.29  apply auto
    1.30 @@ -228,6 +234,25 @@
    1.31  apply (auto elim: conseq12 simp add: MGFn_def MGF_def)
    1.32  done
    1.33  
    1.34 +lemma MGFn_free_wt_NormalConformI: 
    1.35 +"(\<forall> T L C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T 
    1.36 +  \<longrightarrow> G,(A::state triple set)
    1.37 +      \<turnstile>{Normal((\<lambda>Y' s' s. s'=s \<and> normal s) \<and>. G\<turnstile>init\<le>n) \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))}
    1.38 +      t\<succ> 
    1.39 +      {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')}) 
    1.40 + \<Longrightarrow> G,A\<turnstile>{=:n}t\<succ>{G\<rightarrow>}"
    1.41 +apply (rule MGFn_NormalI)
    1.42 +apply (rule ax_no_hazard)
    1.43 +apply (rule ax_escape)
    1.44 +apply (intro strip)
    1.45 +apply (simp only: type_ok_def peek_and_def)
    1.46 +apply (erule conjE)+
    1.47 +apply (erule exE,erule exE, erule exE,erule conjE,drule (1) mp)
    1.48 +apply (drule spec,drule spec, drule spec, drule (1) mp)
    1.49 +apply (erule conseq12)
    1.50 +apply blast
    1.51 +done
    1.52 +
    1.53  
    1.54  section "main lemmas"
    1.55  
    1.56 @@ -250,6 +275,9 @@
    1.57      rtac (thm "MGFn_free_wt"),
    1.58      clarsimp_tac (claset() addSEs (thms "wt_elim_cases"), simpset())]
    1.59  val compl_prepare_tac = EVERY'[rtac (thm "MGFn_NormalI"), Simp_tac]
    1.60 +val wt_conf_prepare_tac = EVERY'[
    1.61 +    rtac (thm "MGFn_free_wt_NormalConformI"),
    1.62 +    clarsimp_tac (claset() addSEs (thms "wt_elim_cases"), simpset())]
    1.63  val forw_hyp_tac = EVERY'[etac (thm "MGFnD'" RS thm "conseq12"), Clarsimp_tac]
    1.64  val forw_hyp_eval_Force_tac = 
    1.65           EVERY'[TRY o rtac allI, forw_hyp_tac, eval_Force_tac]
    1.66 @@ -290,22 +318,64 @@
    1.67  done
    1.68  lemmas MGFn_InitD = MGFn_Init [THEN MGFnD, THEN ax_NormalD]
    1.69  
    1.70 +text {* For @{text MGFn_Call} we need the wellformedness of the program to
    1.71 +switch from the evaln-semantics to the eval-semantics *}
    1.72  lemma MGFn_Call: 
    1.73  "\<lbrakk>\<forall>C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>};  
    1.74 -  G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In3 ps\<succ> {G\<rightarrow>}\<rbrakk> \<Longrightarrow>  
    1.75 -  G,A\<turnstile>{=:n} In1l ({statT,mode}e\<cdot>mn({pTs'}ps))\<succ> {G\<rightarrow>}"
    1.76 -apply (tactic "wt_prepare_tac 1") (* required for equating mode = invmode m e *)
    1.77 -apply (tactic "compl_prepare_tac 1")
    1.78 -apply (rule_tac R = "\<lambda>a'. (\<lambda>Y (x2,s2) (x,s) . x = None \<and> (\<exists>s1 pvs. G\<turnstile>Norm s \<midarrow>e-\<succ>a'\<rightarrow> s1 \<and> Y = In3 pvs \<and> G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2,s2))) \<and>. G\<turnstile>init\<le>n" in ax_derivs.Call)
    1.79 -apply  (erule MGFnD [THEN ax_NormalD])
    1.80 -apply safe
    1.81 -apply  (erule_tac V = "All ?P" in thin_rl, tactic "forw_hyp_eval_Force_tac 1")
    1.82 +  G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In3 ps\<succ> {G\<rightarrow>};wf_prog G\<rbrakk> \<Longrightarrow>  
    1.83 +  G,A\<turnstile>{=:n} In1l ({accC,statT,mode}e\<cdot>mn({pTs'}ps))\<succ> {G\<rightarrow>}"
    1.84 +apply (tactic "wt_conf_prepare_tac 1")
    1.85 +apply (rule_tac  
    1.86 +  Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
    1.87 +        (\<exists>a. G\<turnstile>Norm s \<midarrow>e-\<succ>a\<rightarrow> s1 \<and> (normal s1 \<longrightarrow> G, store s1\<turnstile>a\<Colon>\<preceq>RefT statT)
    1.88 +         \<and> Y = In1 a)) 
    1.89 +    \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))" and 
    1.90 + R = "\<lambda>a'. (\<lambda>Y (x2,s2) (x,s) . x = None \<and> 
    1.91 +             (\<exists>s1 pvs. G\<turnstile>Norm s \<midarrow>e-\<succ>a'\<rightarrow> s1 \<and> 
    1.92 +                       (normal s1 \<longrightarrow> G, store s1\<turnstile>a'\<Colon>\<preceq>RefT statT)\<and> 
    1.93 +                       Y = In3 pvs \<and> G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2,s2))) 
    1.94 +            \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))" in ax_derivs.Call)
    1.95 +apply   (tactic "forw_hyp_tac 1")
    1.96 +apply   (tactic "clarsimp_tac eval_css 1")
    1.97 +apply   (frule (3) eval_type_sound)
    1.98 +apply   force
    1.99 +
   1.100 +apply   safe
   1.101 +apply   (tactic "forw_hyp_tac 1")
   1.102 +apply   (tactic "clarsimp_tac eval_css 1")
   1.103 +apply   (frule (3) eval_type_sound)
   1.104 +apply     (rule conjI)
   1.105 +apply       (rule exI,rule conjI)
   1.106 +apply         (assumption)
   1.107 +
   1.108 +apply         (rule conjI)
   1.109 +apply           simp
   1.110 +apply           assumption
   1.111 +apply      blast
   1.112 +
   1.113  apply (drule spec, drule spec)
   1.114  apply (erule MGFnD' [THEN conseq12])
   1.115  apply (tactic "clarsimp_tac eval_css 1")
   1.116  apply (erule (1) eval_Call)
   1.117 -apply   (rule HOL.refl)
   1.118 -apply  (simp (no_asm_simp))+
   1.119 +apply   (rule HOL.refl)+
   1.120 +apply   (subgoal_tac "check_method_access G C statT (invmode m e)
   1.121 +             \<lparr>name = mn, parTs = pTs'\<rparr> a
   1.122 +             (init_lvars G
   1.123 +               (invocation_declclass G (invmode m e) (snd (ab, ba)) a statT
   1.124 +                 \<lparr>name = mn, parTs = pTs'\<rparr>)
   1.125 +               \<lparr>name = mn, parTs = pTs'\<rparr> (invmode m e) a vs
   1.126 +               (ab,
   1.127 +                ba)) = (init_lvars G
   1.128 +               (invocation_declclass G (invmode m e) (snd (ab, ba)) a statT
   1.129 +                 \<lparr>name = mn, parTs = pTs'\<rparr>)
   1.130 +               \<lparr>name = mn, parTs = pTs'\<rparr> (invmode m e) a vs
   1.131 +               (ab,
   1.132 +                ba))")
   1.133 +apply    simp
   1.134 +defer 
   1.135 +apply simp
   1.136 +apply (erule (3) error_free_call_access) (* now showing the subgoal *)
   1.137 +apply auto
   1.138  done
   1.139  
   1.140  lemma MGF_altern: "G,A\<turnstile>{Normal (\<doteq> \<and>. p)} t\<succ> {G\<rightarrow>} =  
   1.141 @@ -356,9 +426,54 @@
   1.142    simpset() addsimps [split_paired_all] addsimprocs [eval_stmt_proc]) 1*})+)
   1.143  done
   1.144  
   1.145 +text {* For @{text MGFn_FVar} we need the wellformedness of the program to
   1.146 +switch from the evaln-semantics to the eval-semantics *}
   1.147 +lemma MGFn_FVar:
   1.148 + "\<lbrakk>G,A\<turnstile>{=:n} In1r (Init statDeclC)\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>}; wf_prog G\<rbrakk>
   1.149 +   \<Longrightarrow> G,(A\<Colon>state triple set)\<turnstile>{=:n} In2 ({accC,statDeclC,stat}e..fn)\<succ> {G\<rightarrow>}"
   1.150 +apply (tactic "wt_conf_prepare_tac 1")
   1.151 +apply (rule_tac  
   1.152 +  Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
   1.153 +        (G\<turnstile>Norm s \<midarrow>Init statDeclC\<rightarrow> s1 
   1.154 +         )) \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))"  
   1.155 + in ax_derivs.FVar)
   1.156 +apply (tactic "forw_hyp_tac 1")
   1.157 +apply (tactic "clarsimp_tac eval_css 1")
   1.158 +apply (subgoal_tac "is_class G statDeclC")
   1.159 +apply   (force dest: eval_type_sound)
   1.160 +apply   (force dest: ty_expr_is_type [THEN type_is_class] 
   1.161 +                      accfield_fields [THEN fields_declC])
   1.162 +apply (tactic "forw_hyp_tac 1")
   1.163 +apply (tactic "clarsimp_tac eval_css 1")
   1.164 +apply (subgoal_tac "(\<exists> v' s2' s3.   
   1.165 +        ( fvar statDeclC (is_static f) fn v (aa, ba) = (v',s2') ) \<and>
   1.166 +            (s3  = check_field_access G C statDeclC fn (is_static f) v s2') \<and>
   1.167 +            (s3 = s2'))")
   1.168 +apply   (erule exE)+
   1.169 +apply   (erule conjE)+
   1.170 +apply   (erule (1) eval.FVar)
   1.171 +apply     simp
   1.172 +apply     simp
   1.173 +
   1.174 +apply   (case_tac "fvar statDeclC (is_static f) fn v (aa, ba)")
   1.175 +apply   (rule exI)+
   1.176 +apply   (rule context_conjI)
   1.177 +apply      force
   1.178 +
   1.179 +apply   (rule context_conjI)
   1.180 +apply     simp
   1.181 +
   1.182 +apply     (erule (3) error_free_field_access)
   1.183 +apply       (auto dest: eval_type_sound)
   1.184 +done
   1.185 +
   1.186 +text {* For @{text MGFn_lemma} we need the wellformedness of the program to
   1.187 +switch from the evaln-semantics to the eval-semantics cf. @{text MGFn_call}, 
   1.188 +@{text MGFn_FVar}*}
   1.189  lemma MGFn_lemma [rule_format (no_asm)]: 
   1.190 - "\<forall>n C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>} \<Longrightarrow>  
   1.191 -  \<forall>t. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
   1.192 + "\<lbrakk>\<forall>n C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>};
   1.193 +   wf_prog G\<rbrakk> 
   1.194 +  \<Longrightarrow>  \<forall>t. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
   1.195  apply (rule full_nat_induct)
   1.196  apply (rule allI)
   1.197  apply (drule_tac x = n in spec)
   1.198 @@ -371,18 +486,15 @@
   1.199  apply (rule var_expr_stmt.induct)
   1.200  (* 28 subgoals *)
   1.201  prefer 14 apply fast (* Methd *)
   1.202 -prefer 13 apply (erule (2) MGFn_Call)
   1.203 +prefer 13 apply (erule (3) MGFn_Call)
   1.204 +prefer 2  apply (drule MGFn_Init,erule (2) MGFn_FVar)
   1.205  apply (erule_tac [!] V = "All ?P" in thin_rl) (* assumptions on Methd *)
   1.206 -apply (erule_tac [24] MGFn_Init)
   1.207 -prefer 19 apply (erule (1) MGFn_Loop)
   1.208 +apply (erule_tac [23] MGFn_Init)
   1.209 +prefer 18 apply (erule (1) MGFn_Loop)
   1.210  apply (tactic "ALLGOALS compl_prepare_tac")
   1.211  
   1.212  apply (rule ax_derivs.LVar [THEN conseq1], tactic "eval_Force_tac 1")
   1.213  
   1.214 -apply (rule ax_derivs.FVar)
   1.215 -apply  (erule MGFn_InitD)
   1.216 -apply (tactic "forw_hyp_eval_Force_tac 1")
   1.217 -
   1.218  apply (rule ax_derivs.AVar)
   1.219  apply  (erule MGFnD [THEN ax_NormalD])
   1.220  apply (tactic "forw_hyp_eval_Force_tac 1")
   1.221 @@ -480,14 +592,16 @@
   1.222  apply (tactic "forw_hyp_eval_Force_tac 1")
   1.223  done
   1.224  
   1.225 -lemma MGF_asm: "\<forall>C sig. is_methd G C sig \<longrightarrow> G,A\<turnstile>{\<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>} \<Longrightarrow>
   1.226 -  G,(A::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.227 +lemma MGF_asm: 
   1.228 +"\<lbrakk>\<forall>C sig. is_methd G C sig \<longrightarrow> G,A\<turnstile>{\<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>}; wf_prog G\<rbrakk>
   1.229 + \<Longrightarrow> G,(A::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.230  apply (simp (no_asm_use) add: MGF_MGFn_iff)
   1.231  apply (rule allI)
   1.232  apply (rule MGFn_lemma)
   1.233  apply (intro strip)
   1.234  apply (rule MGFn_free_wt)
   1.235  apply (force dest: wt_Methd_is_methd)
   1.236 +apply assumption (* wf_prog G *)
   1.237  done
   1.238  
   1.239  declare splitI2 [intro!]
   1.240 @@ -563,7 +677,7 @@
   1.241  apply (erule MethdI)
   1.242  done
   1.243  
   1.244 -lemma MGF_deriv: "ws_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.245 +lemma MGF_deriv: "wf_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.246  apply (rule MGFNormalI)
   1.247  apply (rule_tac mgf = "\<lambda>t. {Normal \<doteq>} t\<succ> {G\<rightarrow>}" and 
   1.248                  bdy = "\<lambda> (C,sig) .{In1l (body G C sig) }" and 
   1.249 @@ -571,11 +685,9 @@
   1.250  apply    (erule ax_derivs.asm)
   1.251  apply   (clarsimp simp add: split_tupled_all)
   1.252  apply   (erule MGF_nested_Methd)
   1.253 -apply  (erule_tac [2] finite_is_methd)
   1.254 +apply  (erule_tac [2] finite_is_methd [OF wf_ws_prog])
   1.255  apply (rule MGF_asm [THEN MGFNormalD])
   1.256 -apply clarify
   1.257 -apply (rule MGFNormalI)
   1.258 -apply force
   1.259 +apply (auto intro: MGFNormalI)
   1.260  done
   1.261  
   1.262  
   1.263 @@ -598,10 +710,10 @@
   1.264  apply (erule eval_Methd)
   1.265  done
   1.266  
   1.267 -lemma MGF_simult_Methd: "ws_prog G \<Longrightarrow> 
   1.268 +lemma MGF_simult_Methd: "wf_prog G \<Longrightarrow> 
   1.269     G,({}::state triple set)|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>}) 
   1.270     ` Collect (split (is_methd G)) "
   1.271 -apply (frule finite_is_methd)
   1.272 +apply (frule finite_is_methd [OF wf_ws_prog])
   1.273  apply (rule MGF_simult_Methd_lemma)
   1.274  apply  assumption
   1.275  apply (erule ax_finite_pointwise)
   1.276 @@ -610,36 +722,42 @@
   1.277  apply  blast
   1.278  apply clarsimp
   1.279  apply (rule MGF_asm [THEN MGFNormalD])
   1.280 -apply clarify
   1.281 -apply (rule MGFNormalI)
   1.282 -apply force
   1.283 +apply   (auto intro: MGFNormalI)
   1.284  done
   1.285  
   1.286 -lemma MGF_deriv: "ws_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.287 +lemma MGF_deriv: "wf_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.288  apply (rule MGF_asm)
   1.289  apply (intro strip)
   1.290  apply (rule MGFNormalI)
   1.291  apply (rule ax_derivs.weaken)
   1.292  apply  (erule MGF_simult_Methd)
   1.293 -apply force
   1.294 +apply auto
   1.295  done
   1.296  
   1.297  
   1.298  section "corollaries"
   1.299  
   1.300 -lemma MGF_complete: "G,{}\<Turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow>
   1.301 -  G,({}::state triple set)\<turnstile>{P::state assn} t\<succ> {Q}"
   1.302 +lemma eval_to_evaln: "\<lbrakk>G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y', s');type_ok G t s; wf_prog G\<rbrakk>
   1.303 + \<Longrightarrow>   \<exists>n. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y', s')"
   1.304 +apply (cases "normal s")
   1.305 +apply   (force simp add: type_ok_def intro: eval_evaln)
   1.306 +apply   (force intro: evaln.Abrupt)
   1.307 +done
   1.308 +
   1.309 +lemma MGF_complete: 
   1.310 + "\<lbrakk>G,{}\<Turnstile>{P} t\<succ> {Q}; G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}; wf_prog G\<rbrakk> 
   1.311 +  \<Longrightarrow> G,({}::state triple set)\<turnstile>{P::state assn} t\<succ> {Q}"
   1.312  apply (rule ax_no_hazard)
   1.313  apply (unfold MGF_def)
   1.314  apply (erule conseq12)
   1.315  apply (simp (no_asm_use) add: ax_valids_def triple_valid_def)
   1.316 -apply (fast dest!: eval_evaln)
   1.317 +apply (blast dest: eval_to_evaln)
   1.318  done
   1.319  
   1.320 -theorem ax_complete: "ws_prog G \<Longrightarrow>  
   1.321 +theorem ax_complete: "wf_prog G \<Longrightarrow>  
   1.322    G,{}\<Turnstile>{P::state assn} t\<succ> {Q} \<Longrightarrow> G,({}::state triple set)\<turnstile>{P} t\<succ> {Q}"
   1.323  apply (erule MGF_complete)
   1.324 -apply (erule MGF_deriv)
   1.325 +apply (erule (1) MGF_deriv)
   1.326  done
   1.327  
   1.328  end
     2.1 --- a/src/HOL/Bali/AxExample.thy	Thu Feb 21 20:11:32 2002 +0100
     2.2 +++ b/src/HOL/Bali/AxExample.thy	Fri Feb 22 11:26:44 2002 +0100
     2.3 @@ -3,6 +3,7 @@
     2.4      Author:     David von Oheimb
     2.5      License:    GPL (GNU GENERAL PUBLIC LICENSE)
     2.6  *)
     2.7 +
     2.8  header {* Example of a proof based on the Bali axiomatic semantics *}
     2.9  
    2.10  theory AxExample = AxSem + Example:
     3.1 --- a/src/HOL/Bali/AxSem.thy	Thu Feb 21 20:11:32 2002 +0100
     3.2 +++ b/src/HOL/Bali/AxSem.thy	Fri Feb 22 11:26:44 2002 +0100
     3.3 @@ -39,8 +39,6 @@
     3.4  \end{itemize}
     3.5  *}
     3.6  
     3.7 -
     3.8 -
     3.9  types  res = vals (* result entry *)
    3.10  syntax
    3.11    Val  :: "val      \<Rightarrow> res"
    3.12 @@ -514,7 +512,7 @@
    3.13  
    3.14    FVar: "\<lbrakk>G,A\<turnstile>{Normal P} .Init C. {Q};
    3.15            G,A\<turnstile>{Q} e-\<succ> {\<lambda>Val:a:. fvar C stat fn a ..; R}\<rbrakk> \<Longrightarrow>
    3.16 -                                 G,A\<turnstile>{Normal P} {C,stat}e..fn=\<succ> {R}"
    3.17 +                                 G,A\<turnstile>{Normal P} {accC,C,stat}e..fn=\<succ> {R}"
    3.18  
    3.19    AVar:  "\<lbrakk>G,A\<turnstile>{Normal P} e1-\<succ> {Q};
    3.20            \<forall>a. G,A\<turnstile>{Q\<leftarrow>Val a} e2-\<succ> {\<lambda>Val:i:. avar G i a ..; R}\<rbrakk> \<Longrightarrow>
    3.21 @@ -560,7 +558,7 @@
    3.22        init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> mode a vs) \<and>.
    3.23        (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}
    3.24   Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}\<rbrakk> \<Longrightarrow>
    3.25 -         G,A\<turnstile>{Normal P} {statT,mode}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.26 +         G,A\<turnstile>{Normal P} {accC,statT,mode}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.27  
    3.28    Methd:"\<lbrakk>G,A\<union> {{P} Methd-\<succ> {Q} | ms} |\<turnstile> {{P} body G-\<succ> {Q} | ms}\<rbrakk> \<Longrightarrow>
    3.29                                   G,A|\<turnstile>{{P} Methd-\<succ>  {Q} | ms}"
    3.30 @@ -1044,7 +1042,7 @@
    3.31                       C = invocation_declclass 
    3.32                              G IntVir (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr> )};  
    3.33         G,(A::'a triple set)\<turnstile>{Normal P} e-\<succ> {Q::'a assn}\<rbrakk>  
    3.34 -   \<Longrightarrow> G,A\<turnstile>{Normal P} {statT,IntVir}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.35 +   \<Longrightarrow> G,A\<turnstile>{Normal P} {accC,statT,IntVir}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.36  apply (erule ax_derivs.Call)
    3.37  apply  safe
    3.38  apply  (erule spec)
    3.39 @@ -1062,7 +1060,7 @@
    3.40    \<forall> a. G,(A::'a triple set)\<turnstile>{Q\<leftarrow>Val a} args\<doteq>\<succ> {(R::val \<Rightarrow> 'a assn)  a 
    3.41    \<and>. (\<lambda> s. C=invocation_declclass 
    3.42                  G Static (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr>)}
    3.43 -\<rbrakk>  \<Longrightarrow>  G,A\<turnstile>{Normal P} {statT,Static}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.44 +\<rbrakk>  \<Longrightarrow>  G,A\<turnstile>{Normal P} {accC,statT,Static}e\<cdot>mn({pTs}args)-\<succ> {S}"
    3.45  apply (erule ax_derivs.Call)
    3.46  apply  safe
    3.47  apply  (erule spec)
     4.1 --- a/src/HOL/Bali/AxSound.thy	Thu Feb 21 20:11:32 2002 +0100
     4.2 +++ b/src/HOL/Bali/AxSound.thy	Fri Feb 22 11:26:44 2002 +0100
     4.3 @@ -185,18 +185,18 @@
     4.4     init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> mode a vs) \<and>.  
     4.5     (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}  
     4.6     Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}}\<rbrakk> \<Longrightarrow>  
     4.7 -  G,A|\<Turnstile>\<Colon>{ {Normal P} {statT,mode}e\<cdot>mn({pTs}ps)-\<succ> {S}}"
     4.8 +  G,A|\<Turnstile>\<Colon>{ {Normal P} {accC,statT,mode}e\<cdot>mn({pTs}ps)-\<succ> {S}}"
     4.9  apply (tactic "EVERY'[sound_prepare_tac, sound_elim_tac, sound_valid2_tac] 1")
    4.10  apply (rename_tac x1 s1 x2 s2 ab bb v vs m pTsa statDeclC)
    4.11  apply (tactic "smp_tac 6 1")
    4.12  apply (tactic "sound_forw_hyp_tac 1")
    4.13  apply (tactic "sound_forw_hyp_tac 1")
    4.14  apply (drule max_spec2mheads)
    4.15 -apply (drule evaln_eval, drule (3) eval_ts)
    4.16 -apply (drule evaln_eval, frule (3) evals_ts)
    4.17 +apply (drule (3) evaln_eval, drule (3) eval_ts)
    4.18 +apply (drule (3) evaln_eval, frule (3) evals_ts)
    4.19  apply (drule spec,erule impE,rule exI, blast)
    4.20  (* apply (drule spec,drule spec,drule spec,erule impE,rule exI,blast) *)
    4.21 -apply (case_tac "if static m then x2 else (np a') x2")
    4.22 +apply (case_tac "if is_static m then x2 else (np a') x2")
    4.23  defer 1
    4.24  apply  (rename_tac x, subgoal_tac "(Some x, s2)\<Colon>\<preceq>(G, L)" (* used two times *))
    4.25  prefer 2 
    4.26 @@ -246,6 +246,19 @@
    4.27               del: impCE simp add: init_lvars_def2)
    4.28  done
    4.29  
    4.30 +corollary evaln_type_sound:
    4.31 +      (assumes evaln: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)" and
    4.32 +                  wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T" and
    4.33 +             conf_s0: "s0\<Colon>\<preceq>(G,L)" and
    4.34 +                  wf: "wf_prog G"                         
    4.35 +      ) "s1\<Colon>\<preceq>(G,L) \<and>  (normal s1 \<longrightarrow> G,L,store s1\<turnstile>t\<succ>v\<Colon>\<preceq>T) \<and> 
    4.36 +         (error_free s0 = error_free s1)"
    4.37 +proof -
    4.38 +  from evaln wt conf_s0 wf
    4.39 +  show ?thesis
    4.40 +    by (blast dest: evaln_eval eval_type_sound)
    4.41 +qed
    4.42 +
    4.43  lemma Init_sound: "\<lbrakk>wf_prog G; the (class G C) = c;  
    4.44        G,A|\<Turnstile>\<Colon>{ {Normal ((P \<and>. Not \<circ> initd C) ;. supd (init_class_obj G C))}  
    4.45               .(if C = Object then Skip else Init (super c)). {Q}};  
    4.46 @@ -260,7 +273,7 @@
    4.47  apply clarsimp
    4.48  apply (tactic "smp_tac 2 1", drule spec, erule impE, 
    4.49         erule (3) conforms_init_class_obj)
    4.50 -apply (drule (1) wf_prog_cdecl)
    4.51 +apply (frule (1) wf_prog_cdecl)
    4.52  apply (erule impE, rule exI,erule_tac V = "All ?P" in thin_rl,
    4.53         force dest: wf_cdecl_supD split add: split_if simp add: is_acc_class_def)
    4.54  apply clarify
    4.55 @@ -272,9 +285,25 @@
    4.56  apply (simp (no_asm_use) del: empty_def2)
    4.57  apply (tactic "smp_tac 2 1")
    4.58  apply (drule spec, erule impE, erule conforms_set_locals, rule lconf_empty)
    4.59 -apply (erule impE,rule impI,rule exI, erule wf_cdecl_wt_init)
    4.60 +apply (erule impE,rule impI,rule exI,erule wf_cdecl_wt_init)
    4.61  apply clarsimp
    4.62 -apply (erule (1) conforms_return, force dest: evaln_eval eval_gext')
    4.63 +apply (erule (1) conforms_return)
    4.64 +apply (frule wf_cdecl_wt_init)
    4.65 +apply (subgoal_tac "(a, set_locals empty b)\<Colon>\<preceq>(G, empty)")
    4.66 +apply   (frule (3) evaln_eval)
    4.67 +apply   (drule eval_gext') 
    4.68 +apply   force
    4.69 +
    4.70 +        (* refer to case Init in eval_type_sound proof, to see whats going on*)
    4.71 +apply   (subgoal_tac "(a,b)\<Colon>\<preceq>(G, L)")
    4.72 +apply     (blast intro: conforms_set_locals)
    4.73 +
    4.74 +apply     (drule evaln_type_sound)
    4.75 +apply       (cases "C=Object") 
    4.76 +apply         force 
    4.77 +apply         (force dest: wf_cdecl_supD is_acc_classD)
    4.78 +apply     (erule (4) conforms_init_class_obj)
    4.79 +apply     blast
    4.80  done
    4.81  
    4.82  lemma all_conjunct2: "\<forall>l. P' l \<and> P l \<Longrightarrow> \<forall>l. P l"
    4.83 @@ -301,10 +330,10 @@
    4.84  apply       fast (* asm *)
    4.85  (*apply    fast *) (* cut *)
    4.86  apply     fast (* weaken *)
    4.87 -apply    (tactic "smp_tac 3 1", clarify, tactic "smp_tac 1 1", frule evaln_eval,
    4.88 -(* conseq *)case_tac"fst s",clarsimp simp add: eval_type_sound [THEN conjunct1],
    4.89 -clarsimp)
    4.90 -apply   (simp (no_asm_use) add: type_ok_def, drule evaln_eval,fast) (* hazard *)
    4.91 +apply    (tactic "smp_tac 3 1", clarify, tactic "smp_tac 1 1",
    4.92 +          case_tac"fst s",clarsimp,erule (3) evaln_type_sound [THEN conjunct1],
    4.93 +          clarsimp) (* conseq *)
    4.94 +apply   (simp (no_asm_use) add: type_ok_def,fast)(* hazard *)
    4.95  apply  force (* Abrupt *)
    4.96  
    4.97  (* 25 subgoals *)
    4.98 @@ -359,17 +388,17 @@
    4.99  apply (case_tac "aa")
   4.100  prefer 2
   4.101  apply  clarsimp
   4.102 -apply (drule evaln_eval)+
   4.103 -apply (frule (3) eval_ts)
   4.104 +apply (drule (3) evaln_type_sound)
   4.105 +apply (drule (3) evaln_eval)
   4.106 +apply (frule (3) eval_type_sound)
   4.107  apply clarsimp
   4.108 -apply (frule (3) evar_ts [THEN conjunct2])
   4.109  apply (frule wf_ws_prog)
   4.110  apply (drule (2) conf_widen)
   4.111  apply (drule_tac "s1.0" = b in eval_gext')
   4.112  apply (clarsimp simp add: assign_conforms_def)
   4.113  
   4.114 +
   4.115  (* Cond *)
   4.116 -
   4.117  apply (tactic "smp_tac 3 1") apply (tactic "smp_tac 2 1") 
   4.118  apply (tactic "smp_tac 1 1") apply (erule impE) 
   4.119  apply (rule impI,rule exI) 
   4.120 @@ -391,7 +420,7 @@
   4.121  apply (force split add: split_if)
   4.122  
   4.123  (* Throw *)
   4.124 -apply (drule evaln_eval, drule (3) eval_ts)
   4.125 +apply (drule (3) evaln_type_sound)
   4.126  apply clarsimp
   4.127  apply (drule (3) Throw_lemma)
   4.128  apply clarsimp
   4.129 @@ -416,7 +445,7 @@
   4.130  apply (tactic "sound_forw_hyp_tac 1")
   4.131  apply (case_tac "x1", force)
   4.132  apply clarsimp
   4.133 -apply (drule evaln_eval, drule (4) Fin_lemma)
   4.134 +apply (drule (3) evaln_eval, drule (4) Fin_lemma)
   4.135  done
   4.136  
   4.137  
     5.1 --- a/src/HOL/Bali/Basis.thy	Thu Feb 21 20:11:32 2002 +0100
     5.2 +++ b/src/HOL/Bali/Basis.thy	Fri Feb 22 11:26:44 2002 +0100
     5.3 @@ -51,7 +51,7 @@
     5.4  done
     5.5  
     5.6  syntax
     5.7 -  "3" :: nat   ("3")
     5.8 +  "3" :: nat   ("3") 
     5.9    "4" :: nat   ("4")
    5.10  translations
    5.11   "3" == "Suc 2"
    5.12 @@ -75,7 +75,7 @@
    5.13  by (auto dest: tranclD rtrancl_trans rtrancl_into_trancl2)
    5.14  
    5.15  lemma rtrancl_into_trancl3:
    5.16 -"\<lbrakk>(a,b)\<in>r^*; a\<noteq>b\<rbrakk> \<Longrightarrow> (a,b)\<in>r^+"
    5.17 +"\<lbrakk>(a,b)\<in>r^*; a\<noteq>b\<rbrakk> \<Longrightarrow> (a,b)\<in>r^+" 
    5.18  apply (drule rtranclD)
    5.19  apply auto
    5.20  done
     6.1 --- a/src/HOL/Bali/Conform.thy	Thu Feb 21 20:11:32 2002 +0100
     6.2 +++ b/src/HOL/Bali/Conform.thy	Fri Feb 22 11:26:44 2002 +0100
     6.3 @@ -23,11 +23,19 @@
     6.4  
     6.5  section "extension of global store"
     6.6  
     6.7 +
     6.8  constdefs
     6.9  
    6.10    gext    :: "st \<Rightarrow> st \<Rightarrow> bool"              ("_\<le>|_"     [71,71]   70)
    6.11     "s\<le>|s' \<equiv> \<forall>r. \<forall>obj\<in>globs s r: \<exists>obj'\<in>globs s' r: tag obj'= tag obj"
    6.12  
    6.13 +text {* For the the proof of type soundness we will need the 
    6.14 +property that during execution, objects are not lost and moreover retain the 
    6.15 +values of their tags. So the object store grows conservatively. Note that if 
    6.16 +we considered garbage collection, we would have to restrict this property to 
    6.17 +accessible objects.
    6.18 +*}
    6.19 +
    6.20  lemma gext_objD: 
    6.21  "\<lbrakk>s\<le>|s'; globs s r = Some obj\<rbrakk> 
    6.22  \<Longrightarrow> \<exists>obj'. globs s' r = Some obj' \<and> tag obj' = tag obj"
    6.23 @@ -348,15 +356,21 @@
    6.24    "((Some (Xcpt (Std xn)), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
    6.25  by (auto simp: conforms_def)
    6.26  
    6.27 +lemma conforms_Err [iff]:
    6.28 +   "((Some (Error e), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
    6.29 +  by (auto simp: conforms_def)  
    6.30 +
    6.31  lemma conforms_raise_if [iff]: 
    6.32    "((raise_if c xn x, s)\<Colon>\<preceq>(G, L)) = ((x, s)\<Colon>\<preceq>(G, L))"
    6.33  by (auto simp: abrupt_if_def)
    6.34  
    6.35 +lemma conforms_error_if [iff]: 
    6.36 +  "((error_if c err x, s)\<Colon>\<preceq>(G, L)) = ((x, s)\<Colon>\<preceq>(G, L))"
    6.37 +by (auto simp: abrupt_if_def split: split_if)
    6.38  
    6.39  lemma conforms_NormI: "(x, s)\<Colon>\<preceq>(G, L) \<Longrightarrow> Norm s\<Colon>\<preceq>(G, L)"
    6.40  by (auto simp: conforms_def Let_def)
    6.41  
    6.42 -
    6.43  lemma conforms_absorb [rule_format]:
    6.44    "(a, b)\<Colon>\<preceq>(G, L) \<longrightarrow> (absorb j a, b)\<Colon>\<preceq>(G, L)"
    6.45  apply (rule impI)
    6.46 @@ -436,6 +450,11 @@
    6.47              elim!: conforms_XcptLocD simp add: oconf_def)
    6.48  done
    6.49  
    6.50 +lemma conforms_locals [rule_format]: 
    6.51 +  "(a,b)\<Colon>\<preceq>(G, L) \<longrightarrow> L x = Some T \<longrightarrow> G,b\<turnstile>the (locals b x)\<Colon>\<preceq>T"
    6.52 +apply (force simp: conforms_def Let_def lconf_def)
    6.53 +done
    6.54 +
    6.55  lemma conforms_return: "\<And>s'. \<lbrakk>(x,s)\<Colon>\<preceq>(G, L); (x',s')\<Colon>\<preceq>(G, L'); s\<le>|s'\<rbrakk> \<Longrightarrow>  
    6.56    (x',set_locals (locals s) s')\<Colon>\<preceq>(G, L)"
    6.57  apply (rule conforms_xconf)
    6.58 @@ -444,4 +463,5 @@
    6.59  apply (force dest: conforms_globsD)+
    6.60  done
    6.61  
    6.62 +
    6.63  end
     7.1 --- a/src/HOL/Bali/Decl.thy	Thu Feb 21 20:11:32 2002 +0100
     7.2 +++ b/src/HOL/Bali/Decl.thy	Fri Feb 22 11:26:44 2002 +0100
     7.3 @@ -1,6 +1,6 @@
     7.4  (*  Title:      HOL/Bali/Decl.thy
     7.5      ID:         $Id$
     7.6 -    Author:     David von Oheimb
     7.7 +    Author:     David von Oheimb and Norbert Schirmer
     7.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
     7.9  *)
    7.10  header {* Field, method, interface, and class declarations, whole Java programs
     8.1 --- a/src/HOL/Bali/DeclConcepts.thy	Thu Feb 21 20:11:32 2002 +0100
     8.2 +++ b/src/HOL/Bali/DeclConcepts.thy	Fri Feb 22 11:26:44 2002 +0100
     8.3 @@ -1,3 +1,8 @@
     8.4 +(*  Title:      HOL/Bali/DeclConcepts.thy
     8.5 +    ID:         $Id$
     8.6 +    Author:     Norbert Schirmer
     8.7 +    License:    GPL (GNU GENERAL PUBLIC LICENSE)
     8.8 +*)
     8.9  header {* Advanced concepts on Java declarations like overriding, inheritance,
    8.10  dynamic method lookup*}
    8.11  
    8.12 @@ -57,7 +62,7 @@
    8.13  by (simp add: is_acc_iface_def)
    8.14  
    8.15  lemma is_acc_typeD:
    8.16 - "is_acc_type  G P T \<equiv> is_type G T  \<and> G\<turnstile>T accessible_in P"
    8.17 + "is_acc_type  G P T \<Longrightarrow> is_type G T  \<and> G\<turnstile>T accessible_in P"
    8.18  by (simp add: is_acc_type_def)
    8.19  
    8.20  lemma is_acc_reftypeD:
    8.21 @@ -815,7 +820,8 @@
    8.22       | Package   \<Rightarrow> (pid (declclass membr) = pid accclass)
    8.23       | Protected \<Rightarrow> (pid (declclass membr) = pid accclass)
    8.24                      \<or>
    8.25 -                    (G\<turnstile>accclass \<prec>\<^sub>C declclass membr \<and> G\<turnstile>class \<preceq>\<^sub>C accclass) 
    8.26 +                    (G\<turnstile>accclass \<prec>\<^sub>C declclass membr 
    8.27 +                     \<and> (G\<turnstile>class \<preceq>\<^sub>C accclass \<or> is_static membr)) 
    8.28       | Public    \<Rightarrow> True)"
    8.29  text {*
    8.30  The subcondition of the @{term "Protected"} case: 
    8.31 @@ -881,12 +887,12 @@
    8.32   \<rightleftharpoons> "G\<turnstile>(fieldm fn f) of C accessible_from accclass" 
    8.33  
    8.34  inductive "accessible_fromR G accclass" intros
    8.35 -immediate:  "\<lbrakk>G\<turnstile>membr member_of class;
    8.36 +Immediate:  "\<lbrakk>G\<turnstile>membr member_of class;
    8.37                G\<turnstile>(Class class) accessible_in (pid accclass);
    8.38                G\<turnstile>membr in class permits_acc_to accclass 
    8.39               \<rbrakk> \<Longrightarrow> G\<turnstile>membr of class accessible_from accclass"
    8.40  
    8.41 -overriding: "\<lbrakk>G\<turnstile>membr member_of class;
    8.42 +Overriding: "\<lbrakk>G\<turnstile>membr member_of class;
    8.43                G\<turnstile>(Class class) accessible_in (pid accclass);
    8.44                membr=(C,mdecl new);
    8.45                G\<turnstile>(C,new) overrides\<^sub>S old; 
    8.46 @@ -934,16 +940,12 @@
    8.47  "G\<turnstile>Field fn f in dynC dyn_accessible_from accC"  
    8.48   \<rightleftharpoons> "G\<turnstile>(fieldm fn f) in dynC dyn_accessible_from accC"
    8.49    
    8.50 -(* #### Testet JVM noch ber den Bytecodeverifier hinaus ob der
    8.51 - statische Typ accessible ist bevor es den Zugriff erlaubt 
    8.52 - \<longrightarrow> Test mit Reflektion\<dots>
    8.53 -*)
    8.54  inductive "dyn_accessible_fromR G accclass" intros
    8.55 -immediate:  "\<lbrakk>G\<turnstile>membr member_in class;
    8.56 +Immediate:  "\<lbrakk>G\<turnstile>membr member_in class;
    8.57                G\<turnstile>membr in class permits_acc_to accclass 
    8.58               \<rbrakk> \<Longrightarrow> G\<turnstile>membr in class dyn_accessible_from accclass"
    8.59  
    8.60 -overriding: "\<lbrakk>G\<turnstile>membr member_in class;
    8.61 +Overriding: "\<lbrakk>G\<turnstile>membr member_in class;
    8.62                membr=(C,mdecl new);
    8.63                G\<turnstile>(C,new) overrides old; 
    8.64                G\<turnstile>class \<prec>\<^sub>C sup;
    8.65 @@ -955,10 +957,22 @@
    8.66   \<Longrightarrow> G\<turnstile>m member_of C \<and> G\<turnstile>(Class C) accessible_in (pid S)"
    8.67  by (auto elim: accessible_fromR.induct)
    8.68  
    8.69 +lemma unique_declaration: 
    8.70 + "\<lbrakk>G\<turnstile>m declared_in C;  G\<turnstile>n declared_in C; memberid m = memberid n \<rbrakk> 
    8.71 +  \<Longrightarrow> m = n"
    8.72 +apply (cases m)
    8.73 +apply (cases n,
    8.74 +        auto simp add: declared_in_def cdeclaredmethd_def cdeclaredfield_def)+
    8.75 +done
    8.76 +
    8.77  lemma declared_not_undeclared:
    8.78    "G\<turnstile>m declared_in C \<Longrightarrow> \<not> G\<turnstile> memberid m undeclared_in C"
    8.79  by (cases m) (auto simp add: declared_in_def undeclared_in_def)
    8.80  
    8.81 +lemma undeclared_not_declared:
    8.82 + "G\<turnstile> memberid m undeclared_in C \<Longrightarrow> \<not> G\<turnstile> m declared_in C" 
    8.83 +by (cases m) (auto simp add: declared_in_def undeclared_in_def)
    8.84 +
    8.85  lemma not_undeclared_declared:
    8.86    "\<not> G\<turnstile> membr_id undeclared_in C \<Longrightarrow> (\<exists> m. G\<turnstile>m declared_in C \<and> 
    8.87                                             membr_id = memberid m)"
    8.88 @@ -1115,86 +1129,30 @@
    8.89    qed
    8.90  qed
    8.91  
    8.92 +lemma member_in_declC: "G\<turnstile>m member_in C\<Longrightarrow> G\<turnstile>m member_in (declclass m)"
    8.93 +proof -
    8.94 +  assume member_in_C:  "G\<turnstile>m member_in C"
    8.95 +  from member_in_C
    8.96 +  obtain provC where
    8.97 +    subclseq_C_provC: "G\<turnstile> C \<preceq>\<^sub>C provC" and
    8.98 +     member_of_provC: "G \<turnstile> m member_of provC"
    8.99 +    by (auto simp add: member_in_def)
   8.100 +  from member_of_provC
   8.101 +  have "G \<turnstile> m member_of declclass m"
   8.102 +    by (rule member_of_member_of_declC)
   8.103 +  moreover
   8.104 +  from member_in_C
   8.105 +  have "G\<turnstile>C \<preceq>\<^sub>C declclass m"
   8.106 +    by (rule member_in_class_relation)
   8.107 +  ultimately
   8.108 +  show ?thesis
   8.109 +    by (auto simp add: member_in_def)
   8.110 +qed
   8.111 +
   8.112  lemma dyn_accessible_from_commonD: "G\<turnstile>m in C dyn_accessible_from S
   8.113   \<Longrightarrow> G\<turnstile>m member_in C"
   8.114  by (auto elim: dyn_accessible_fromR.induct)
   8.115  
   8.116 -(* ### Gilt nicht fr wf_progs!dynmaisches Override, 
   8.117 -  da die accmodi Bedingung nur fr stat override gilt! *)
   8.118 -(*
   8.119 -lemma override_Package:
   8.120 - "\<lbrakk>G\<turnstile>new overrides old; 
   8.121 -  \<And> new old. G\<turnstile>new overrides old \<Longrightarrow> accmodi old \<le> accmodi new;
   8.122 -  accmodi old = Package; accmodi new = Package\<rbrakk>
   8.123 -  \<Longrightarrow> pid (declclass old) = pid (declclass new)"
   8.124 -proof - 
   8.125 -  assume wf: "\<And> new old. G\<turnstile>new overrides old \<Longrightarrow> accmodi old \<le> accmodi new"
   8.126 -  assume ovverride: "G\<turnstile>new overrides old"
   8.127 -  then show "\<lbrakk>accmodi old = Package;accmodi new = Package\<rbrakk> \<Longrightarrow> ?thesis"
   8.128 -    (is "?Pack old \<Longrightarrow> ?Pack new \<Longrightarrow> ?EqPid old new")
   8.129 -  proof (induct rule: overridesR.induct)
   8.130 -    case Direct
   8.131 -    fix new old
   8.132 -    assume "accmodi old = Package"
   8.133 -           "G \<turnstile> methdMembr old inheritable_in pid (declclass new)"
   8.134 -    then show "pid (declclass old) =  pid (declclass new)"
   8.135 -      by (auto simp add: inheritable_in_def)
   8.136 -  next
   8.137 -    case (Indirect inter new old)
   8.138 -    assume accmodi_old: "accmodi old = Package" and
   8.139 -           accmodi_new: "accmodi new = Package" 
   8.140 -    assume "G \<turnstile> new overrides inter"
   8.141 -    with wf have le_inter_new: "accmodi inter \<le> accmodi new"
   8.142 -      by blast
   8.143 -    assume "G \<turnstile> inter overrides old"
   8.144 -    with wf have le_old_inter: "accmodi old \<le> accmodi inter"
   8.145 -      by blast
   8.146 -    from accmodi_old accmodi_new le_inter_new le_old_inter
   8.147 -    have "accmodi inter = Package"
   8.148 -      by(auto simp add: le_acc_def less_acc_def)
   8.149 -    with Indirect accmodi_old accmodi_new
   8.150 -    show "?EqPid old new"
   8.151 -      by auto
   8.152 -  qed
   8.153 -qed
   8.154 -
   8.155 -lemma stat_override_Package:
   8.156 - "\<lbrakk>G\<turnstile>new overrides\<^sub>S old; 
   8.157 -  \<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new;
   8.158 -  accmodi old = Package; accmodi new = Package\<rbrakk>
   8.159 -  \<Longrightarrow> pid (declclass old) = pid (declclass new)"
   8.160 -proof - 
   8.161 -  assume wf: "\<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new"
   8.162 -  assume ovverride: "G\<turnstile>new overrides\<^sub>S old"
   8.163 -  then show "\<lbrakk>accmodi old = Package;accmodi new = Package\<rbrakk> \<Longrightarrow> ?thesis"
   8.164 -    (is "?Pack old \<Longrightarrow> ?Pack new \<Longrightarrow> ?EqPid old new")
   8.165 -  proof (induct rule: stat_overridesR.induct)
   8.166 -    case Direct
   8.167 -    fix new old
   8.168 -    assume "accmodi old = Package"
   8.169 -           "G \<turnstile> methdMembr old inheritable_in pid (declclass new)"
   8.170 -    then show "pid (declclass old) =  pid (declclass new)"
   8.171 -      by (auto simp add: inheritable_in_def)
   8.172 -  next
   8.173 -    case (Indirect inter new old)
   8.174 -    assume accmodi_old: "accmodi old = Package" and
   8.175 -           accmodi_new: "accmodi new = Package" 
   8.176 -    assume "G \<turnstile> new overrides\<^sub>S inter"
   8.177 -    with wf have le_inter_new: "accmodi inter \<le> accmodi new"
   8.178 -      by blast
   8.179 -    assume "G \<turnstile> inter overrides\<^sub>S old"
   8.180 -    with wf have le_old_inter: "accmodi old \<le> accmodi inter"
   8.181 -      by blast
   8.182 -    from accmodi_old accmodi_new le_inter_new le_old_inter
   8.183 -    have "accmodi inter = Package"
   8.184 -      by(auto simp add: le_acc_def less_acc_def)
   8.185 -    with Indirect accmodi_old accmodi_new
   8.186 -    show "?EqPid old new"
   8.187 -      by auto
   8.188 -  qed
   8.189 -qed
   8.190 -
   8.191 -*)
   8.192  lemma no_Private_stat_override: 
   8.193   "\<lbrakk>G\<turnstile>new overrides\<^sub>S old\<rbrakk> \<Longrightarrow> accmodi old \<noteq> Private"
   8.194  by (induct set:  stat_overridesR) (auto simp add: inheritable_in_def)
   8.195 @@ -1209,6 +1167,34 @@
   8.196     (auto simp add: permits_acc_def
   8.197              intro: subclseq_trans) 
   8.198  
   8.199 +lemma permits_acc_static_declC:
   8.200 + "\<lbrakk>G\<turnstile>m in C permits_acc_to accC; G\<turnstile>m member_in C; is_static m
   8.201 +  \<rbrakk> \<Longrightarrow> G\<turnstile>m in (declclass m) permits_acc_to accC"
   8.202 +by (cases "accmodi m") (auto simp add: permits_acc_def)
   8.203 +
   8.204 +lemma dyn_accessible_from_static_declC: 
   8.205 +  (assumes  acc_C: "G\<turnstile>m in C dyn_accessible_from accC" and
   8.206 +           static: "is_static m"
   8.207 +  ) "G\<turnstile>m in (declclass m) dyn_accessible_from accC"
   8.208 +proof -
   8.209 +  from acc_C static
   8.210 +  show "G\<turnstile>m in (declclass m) dyn_accessible_from accC"
   8.211 +  proof (induct)
   8.212 +    case (Immediate C m)
   8.213 +    then show ?case 
   8.214 +      by (auto intro!: dyn_accessible_fromR.Immediate
   8.215 +                 dest: member_in_declC permits_acc_static_declC) 
   8.216 +  next 
   8.217 +    case (Overriding declCNew C m new old sup)
   8.218 +    then have "\<not> is_static m"
   8.219 +      by (auto dest: overrides_commonD)
   8.220 +    moreover
   8.221 +    assume "is_static m"
   8.222 +    ultimately show ?case 
   8.223 +      by contradiction
   8.224 +  qed
   8.225 +qed
   8.226 +
   8.227  lemma field_accessible_fromD:
   8.228   "\<lbrakk>G\<turnstile>membr of C accessible_from accC;is_field membr\<rbrakk> 
   8.229    \<Longrightarrow> G\<turnstile>membr member_of C \<and>
   8.230 @@ -1445,7 +1431,7 @@
   8.231    from stat_acc is_field subclseq 
   8.232    show ?thesis
   8.233      by (auto dest: accessible_fieldD 
   8.234 -            intro: dyn_accessible_fromR.immediate 
   8.235 +            intro: dyn_accessible_fromR.Immediate 
   8.236                     member_inI 
   8.237                     permits_acc_inheritance)
   8.238  qed
   8.239 @@ -1463,15 +1449,15 @@
   8.240    from stat_acc
   8.241    show ?thesis
   8.242    proof (cases)
   8.243 -    case immediate
   8.244 +    case Immediate
   8.245      with member_dynC member_statC subclseq dynC_acc
   8.246      show ?thesis
   8.247 -      by (auto intro: accessible_fromR.immediate permits_acc_inheritance)
   8.248 +      by (auto intro: accessible_fromR.Immediate permits_acc_inheritance)
   8.249    next
   8.250 -    case overriding
   8.251 +    case Overriding
   8.252      with member_dynC subclseq dynC_acc
   8.253      show ?thesis
   8.254 -      by (auto intro: accessible_fromR.overriding rtrancl_trancl_trancl)
   8.255 +      by (auto intro: accessible_fromR.Overriding rtrancl_trancl_trancl)
   8.256    qed
   8.257  qed
   8.258  
     9.1 --- a/src/HOL/Bali/Eval.thy	Thu Feb 21 20:11:32 2002 +0100
     9.2 +++ b/src/HOL/Bali/Eval.thy	Fri Feb 22 11:26:44 2002 +0100
     9.3 @@ -370,7 +370,14 @@
     9.4  	          n = Inl (fn,C); 
     9.5                    f = (\<lambda>v. supd (upd_gobj oref n v)) 
     9.6        in ((the (values (the (globs (store s) oref)) n),f),abupd xf s)"
     9.7 -
     9.8 +(*
     9.9 + "fvar C stat fn a' s 
    9.10 +    \<equiv> let (oref,xf) = if stat then (Stat C,id)
    9.11 +                              else (Heap (the_Addr a'),np a');
    9.12 +	          n = Inl (fn,C); 
    9.13 +                  f = (\<lambda>v. supd (upd_gobj oref n v)) 
    9.14 +      in ((the (values (the (globs (store s) oref)) n),f),abupd xf s)"
    9.15 +*)
    9.16    avar :: "prog \<Rightarrow> val \<Rightarrow> val \<Rightarrow> state \<Rightarrow> vvar \<times> state"
    9.17   "avar G i' a' s 
    9.18      \<equiv> let   oref = Heap (the_Addr a'); 
    9.19 @@ -412,7 +419,32 @@
    9.20  apply (simp (no_asm) add: Let_def split_beta)
    9.21  done
    9.22  
    9.23 +constdefs
    9.24 +check_field_access::
    9.25 +"prog \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> vname \<Rightarrow> bool \<Rightarrow> val \<Rightarrow> state \<Rightarrow> state"
    9.26 +"check_field_access G accC statDeclC fn stat a' s
    9.27 + \<equiv> let oref = if stat then Stat statDeclC
    9.28 +                      else Heap (the_Addr a');
    9.29 +       dynC = case oref of
    9.30 +                   Heap a \<Rightarrow> obj_class (the (globs (store s) oref))
    9.31 +                 | Stat C \<Rightarrow> C;
    9.32 +       f    = (the (table_of (DeclConcepts.fields G dynC) (fn,statDeclC)))
    9.33 +   in abupd 
    9.34 +        (error_if (\<not> G\<turnstile>Field fn (statDeclC,f) in dynC dyn_accessible_from accC)
    9.35 +                  AccessViolation)
    9.36 +        s"
    9.37  
    9.38 +constdefs
    9.39 +check_method_access:: 
    9.40 +  "prog \<Rightarrow> qtname \<Rightarrow> ref_ty \<Rightarrow> inv_mode \<Rightarrow>  sig \<Rightarrow> val \<Rightarrow> state \<Rightarrow> state"
    9.41 +"check_method_access G accC statT mode sig  a' s
    9.42 + \<equiv> let invC = invocation_class mode (store s) a' statT;
    9.43 +       dynM = the (dynlookup G statT invC sig)
    9.44 +   in abupd 
    9.45 +        (error_if (\<not> G\<turnstile>Methd sig dynM in invC dyn_accessible_from accC)
    9.46 +                  AccessViolation)
    9.47 +        s"
    9.48 +       
    9.49  section "evaluation judgments"
    9.50  
    9.51  consts
    9.52 @@ -552,7 +584,27 @@
    9.53  	       G\<turnstile>set_lvars empty s1 \<midarrow>init c\<rightarrow> s2 \<and> s3 = restore_lvars s1 s2)\<rbrakk> 
    9.54                \<Longrightarrow>
    9.55  		 G\<turnstile>Norm s0 \<midarrow>Init C\<rightarrow> s3"
    9.56 -
    9.57 +   (* This class initialisation rule is a little bit inaccurate. Look at the
    9.58 +      exact sequence:
    9.59 +      1. The current class object (the static fields) are initialised
    9.60 +         (init_class_obj)
    9.61 +      2. Then the superclasses are initialised
    9.62 +      3. The static initialiser of the current class is invoked
    9.63 +      More precisely we should expect another ordering, namely 2 1 3.
    9.64 +      But we can't just naively toggle 1 and 2. By calling init_class_obj 
    9.65 +      before initialising the superclasses we also implicitly record that
    9.66 +      we have started to initialise the current class (by setting an 
    9.67 +      value for the class object). This becomes 
    9.68 +      crucial for the completeness proof of the axiomatic semantics 
    9.69 +      (AxCompl.thy). Static initialisation requires an induction on the number 
    9.70 +      of classes not yet initialised (or to be more precise, classes where the
    9.71 +      initialisation has not yet begun). 
    9.72 +      So we could first assign a dummy value to the class before
    9.73 +      superclass initialisation and afterwards set the correct values.
    9.74 +      But as long as we don't take memory overflow into account 
    9.75 +      when allocating class objects, and don't model definite assignment in
    9.76 +      the static initialisers, we can leave things as they are for convenience. 
    9.77 +   *)
    9.78  (* evaluation of expressions *)
    9.79  
    9.80    (* cf. 15.8.1, 12.4.1 *)
    9.81 @@ -602,10 +654,15 @@
    9.82    Call:	
    9.83    "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1; G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2;
    9.84      D = invocation_declclass G mode (store s2) a' statT \<lparr>name=mn,parTs=pTs\<rparr>;
    9.85 -    G\<turnstile>init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' vs s2 
    9.86 -         \<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ>v\<rightarrow> s3\<rbrakk>
    9.87 +    s3=init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' vs s2;
    9.88 +    s3' = check_method_access G accC statT mode \<lparr>name=mn,parTs=pTs\<rparr> a' s3;
    9.89 +    G\<turnstile>s3' \<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ>v\<rightarrow> s4\<rbrakk>
    9.90     \<Longrightarrow>
    9.91 -       G\<turnstile>Norm s0 \<midarrow>{statT,mode}e\<cdot>mn({pTs}args)-\<succ>v\<rightarrow> (restore_lvars s2 s3)"
    9.92 +       G\<turnstile>Norm s0 \<midarrow>{accC,statT,mode}e\<cdot>mn({pTs}args)-\<succ>v\<rightarrow> (restore_lvars s2 s4)"
    9.93 +(* The accessibility check is after init_lvars, to keep it simple. Init_lvars 
    9.94 +   already tests for the absence of a null-pointer reference in case of an
    9.95 +   instance method invocation
    9.96 +*)
    9.97  
    9.98    Methd:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<rightarrow> s1\<rbrakk> \<Longrightarrow>
    9.99  				G\<turnstile>Norm s0 \<midarrow>Methd D sig-\<succ>v\<rightarrow> s1"
   9.100 @@ -620,9 +677,14 @@
   9.101    LVar:	"G\<turnstile>Norm s \<midarrow>LVar vn=\<succ>lvar vn s\<rightarrow> Norm s"
   9.102  
   9.103    (* cf. 15.10.1, 12.4.1 *)
   9.104 -  FVar:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init C\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2;
   9.105 -	  (v,s2') = fvar C stat fn a s2\<rbrakk> \<Longrightarrow>
   9.106 -	  G\<turnstile>Norm s0 \<midarrow>{C,stat}e..fn=\<succ>v\<rightarrow> s2'"
   9.107 +  FVar:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2;
   9.108 +	  (v,s2') = fvar statDeclC stat fn a s2;
   9.109 +          s3 = check_field_access G accC statDeclC fn stat a s2' \<rbrakk> \<Longrightarrow>
   9.110 +	  G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>v\<rightarrow> s3"
   9.111 + (* The accessibility check is after fvar, to keep it simple. Fvar already
   9.112 +    tests for the absence of a null-pointer reference in case of an instance
   9.113 +    field
   9.114 +  *)
   9.115  
   9.116    (* cf. 15.12.1, 15.25.1 *)
   9.117    AVar:	"\<lbrakk>G\<turnstile> Norm s0 \<midarrow>e1-\<succ>a\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e2-\<succ>i\<rightarrow> s2;
   9.118 @@ -688,35 +750,35 @@
   9.119  inductive_cases eval_cases: "G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> vs'"
   9.120  
   9.121  inductive_cases eval_elim_cases:
   9.122 -        "G\<turnstile>(Some xc,s) \<midarrow>t                         \<succ>\<rightarrow> vs'"
   9.123 -	"G\<turnstile>Norm s \<midarrow>In1r Skip                      \<succ>\<rightarrow> xs'"
   9.124 -        "G\<turnstile>Norm s \<midarrow>In1r (Do j)                    \<succ>\<rightarrow> xs'"
   9.125 -        "G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> c)                    \<succ>\<rightarrow> xs'"
   9.126 -	"G\<turnstile>Norm s \<midarrow>In3  ([])                      \<succ>\<rightarrow> vs'"
   9.127 -	"G\<turnstile>Norm s \<midarrow>In3  (e#es)                    \<succ>\<rightarrow> vs'"
   9.128 -	"G\<turnstile>Norm s \<midarrow>In1l (Lit w)                   \<succ>\<rightarrow> vs'"
   9.129 -	"G\<turnstile>Norm s \<midarrow>In2  (LVar vn)                 \<succ>\<rightarrow> vs'"
   9.130 -	"G\<turnstile>Norm s \<midarrow>In1l (Cast T e)                \<succ>\<rightarrow> vs'"
   9.131 -	"G\<turnstile>Norm s \<midarrow>In1l (e InstOf T)              \<succ>\<rightarrow> vs'"
   9.132 -	"G\<turnstile>Norm s \<midarrow>In1l (Super)                   \<succ>\<rightarrow> vs'"
   9.133 -	"G\<turnstile>Norm s \<midarrow>In1l (Acc va)                  \<succ>\<rightarrow> vs'"
   9.134 -	"G\<turnstile>Norm s \<midarrow>In1r (Expr e)                  \<succ>\<rightarrow> xs'"
   9.135 -	"G\<turnstile>Norm s \<midarrow>In1r (c1;; c2)                 \<succ>\<rightarrow> xs'"
   9.136 -	"G\<turnstile>Norm s \<midarrow>In1l (Methd C sig)             \<succ>\<rightarrow> xs'"
   9.137 -	"G\<turnstile>Norm s \<midarrow>In1l (Body D c)                \<succ>\<rightarrow> xs'"
   9.138 -	"G\<turnstile>Norm s \<midarrow>In1l (e0 ? e1 : e2)            \<succ>\<rightarrow> vs'"
   9.139 -	"G\<turnstile>Norm s \<midarrow>In1r (If(e) c1 Else c2)        \<succ>\<rightarrow> xs'"
   9.140 -	"G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> While(e) c)           \<succ>\<rightarrow> xs'"
   9.141 -	"G\<turnstile>Norm s \<midarrow>In1r (c1 Finally c2)           \<succ>\<rightarrow> xs'"
   9.142 -	"G\<turnstile>Norm s \<midarrow>In1r (Throw e)                 \<succ>\<rightarrow> xs'"
   9.143 -	"G\<turnstile>Norm s \<midarrow>In1l (NewC C)                  \<succ>\<rightarrow> vs'"
   9.144 -	"G\<turnstile>Norm s \<midarrow>In1l (New T[e])                \<succ>\<rightarrow> vs'"
   9.145 -	"G\<turnstile>Norm s \<midarrow>In1l (Ass va e)                \<succ>\<rightarrow> vs'"
   9.146 -	"G\<turnstile>Norm s \<midarrow>In1r (Try c1 Catch(tn vn) c2)  \<succ>\<rightarrow> xs'"
   9.147 -	"G\<turnstile>Norm s \<midarrow>In2  ({C,stat}e..fn)           \<succ>\<rightarrow> vs'"
   9.148 -	"G\<turnstile>Norm s \<midarrow>In2  (e1.[e2])                 \<succ>\<rightarrow> vs'"
   9.149 -	"G\<turnstile>Norm s \<midarrow>In1l ({statT,mode}e\<cdot>mn({pT}p)) \<succ>\<rightarrow> vs'"
   9.150 -	"G\<turnstile>Norm s \<midarrow>In1r (Init C)                  \<succ>\<rightarrow> xs'"
   9.151 +        "G\<turnstile>(Some xc,s) \<midarrow>t                              \<succ>\<rightarrow> vs'"
   9.152 +	"G\<turnstile>Norm s \<midarrow>In1r Skip                           \<succ>\<rightarrow> xs'"
   9.153 +        "G\<turnstile>Norm s \<midarrow>In1r (Do j)                         \<succ>\<rightarrow> xs'"
   9.154 +        "G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> c)                         \<succ>\<rightarrow> xs'"
   9.155 +	"G\<turnstile>Norm s \<midarrow>In3  ([])                           \<succ>\<rightarrow> vs'"
   9.156 +	"G\<turnstile>Norm s \<midarrow>In3  (e#es)                         \<succ>\<rightarrow> vs'"
   9.157 +	"G\<turnstile>Norm s \<midarrow>In1l (Lit w)                        \<succ>\<rightarrow> vs'"
   9.158 +	"G\<turnstile>Norm s \<midarrow>In2  (LVar vn)                      \<succ>\<rightarrow> vs'"
   9.159 +	"G\<turnstile>Norm s \<midarrow>In1l (Cast T e)                     \<succ>\<rightarrow> vs'"
   9.160 +	"G\<turnstile>Norm s \<midarrow>In1l (e InstOf T)                   \<succ>\<rightarrow> vs'"
   9.161 +	"G\<turnstile>Norm s \<midarrow>In1l (Super)                        \<succ>\<rightarrow> vs'"
   9.162 +	"G\<turnstile>Norm s \<midarrow>In1l (Acc va)                       \<succ>\<rightarrow> vs'"
   9.163 +	"G\<turnstile>Norm s \<midarrow>In1r (Expr e)                       \<succ>\<rightarrow> xs'"
   9.164 +	"G\<turnstile>Norm s \<midarrow>In1r (c1;; c2)                      \<succ>\<rightarrow> xs'"
   9.165 +	"G\<turnstile>Norm s \<midarrow>In1l (Methd C sig)                  \<succ>\<rightarrow> xs'"
   9.166 +	"G\<turnstile>Norm s \<midarrow>In1l (Body D c)                     \<succ>\<rightarrow> xs'"
   9.167 +	"G\<turnstile>Norm s \<midarrow>In1l (e0 ? e1 : e2)                 \<succ>\<rightarrow> vs'"
   9.168 +	"G\<turnstile>Norm s \<midarrow>In1r (If(e) c1 Else c2)             \<succ>\<rightarrow> xs'"
   9.169 +	"G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> While(e) c)                \<succ>\<rightarrow> xs'"
   9.170 +	"G\<turnstile>Norm s \<midarrow>In1r (c1 Finally c2)                \<succ>\<rightarrow> xs'"
   9.171 +	"G\<turnstile>Norm s \<midarrow>In1r (Throw e)                      \<succ>\<rightarrow> xs'"
   9.172 +	"G\<turnstile>Norm s \<midarrow>In1l (NewC C)                       \<succ>\<rightarrow> vs'"
   9.173 +	"G\<turnstile>Norm s \<midarrow>In1l (New T[e])                     \<succ>\<rightarrow> vs'"
   9.174 +	"G\<turnstile>Norm s \<midarrow>In1l (Ass va e)                     \<succ>\<rightarrow> vs'"
   9.175 +	"G\<turnstile>Norm s \<midarrow>In1r (Try c1 Catch(tn vn) c2)       \<succ>\<rightarrow> xs'"
   9.176 +	"G\<turnstile>Norm s \<midarrow>In2  ({accC,statDeclC,stat}e..fn)   \<succ>\<rightarrow> vs'"
   9.177 +	"G\<turnstile>Norm s \<midarrow>In2  (e1.[e2])                      \<succ>\<rightarrow> vs'"
   9.178 +	"G\<turnstile>Norm s \<midarrow>In1l ({accC,statT,mode}e\<cdot>mn({pT}p)) \<succ>\<rightarrow> vs'"
   9.179 +	"G\<turnstile>Norm s \<midarrow>In1r (Init C)                       \<succ>\<rightarrow> xs'"
   9.180  declare not_None_eq [simp]  (* IntDef.Zero_def [simp] *)
   9.181  declare split_paired_All [simp] split_paired_Ex [simp]
   9.182  ML_setup {*
   9.183 @@ -851,12 +913,14 @@
   9.184  apply (case_tac "s", case_tac "a = None")
   9.185  by (auto intro!: eval.Methd)
   9.186  
   9.187 -lemma eval_Call: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1; G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> s2;  
   9.188 -       D = invocation_declclass G mode (store s2) a' statT \<lparr>name=mn,parTs=pTs\<rparr>; 
   9.189 -       G\<turnstile>init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' pvs s2 
   9.190 -        \<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> v\<rightarrow> s3; 
   9.191 -       s3' = restore_lvars s2 s3\<rbrakk> \<Longrightarrow>  
   9.192 -       G\<turnstile>Norm s0 \<midarrow>{statT,mode}e\<cdot>mn({pTs}ps)-\<succ>v\<rightarrow> s3'"
   9.193 +lemma eval_Call: 
   9.194 +   "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1; G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> s2;  
   9.195 +     D = invocation_declclass G mode (store s2) a' statT \<lparr>name=mn,parTs=pTs\<rparr>;
   9.196 +     s3 = init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' pvs s2;
   9.197 +     s3' = check_method_access G accC statT mode \<lparr>name=mn,parTs=pTs\<rparr> a' s3;
   9.198 +     G\<turnstile>s3'\<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> v\<rightarrow> s4; 
   9.199 +       s4' = restore_lvars s2 s4\<rbrakk> \<Longrightarrow>  
   9.200 +       G\<turnstile>Norm s0 \<midarrow>{accC,statT,mode}e\<cdot>mn({pTs}ps)-\<succ>v\<rightarrow> s4'"
   9.201  apply (drule eval.Call, assumption)
   9.202  apply (rule HOL.refl)
   9.203  apply simp+
    10.1 --- a/src/HOL/Bali/Evaln.thy	Thu Feb 21 20:11:32 2002 +0100
    10.2 +++ b/src/HOL/Bali/Evaln.thy	Fri Feb 22 11:26:44 2002 +0100
    10.3 @@ -1,17 +1,19 @@
    10.4  (*  Title:      HOL/Bali/Evaln.thy
    10.5      ID:         $Id$
    10.6 -    Author:     David von Oheimb
    10.7 +    Author:     David von Oheimb and Norbert Schirmer
    10.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
    10.9  *)
   10.10  header {* Operational evaluation (big-step) semantics of Java expressions and 
   10.11            statements
   10.12  *}
   10.13  
   10.14 -theory Evaln = Eval:
   10.15 +theory Evaln = Eval + TypeSafe:
   10.16  
   10.17  text {*
   10.18 -Variant of eval relation with counter for bounded recursive depth
   10.19 -Evaln could completely replace Eval.
   10.20 +Variant of eval relation with counter for bounded recursive depth.
   10.21 +Evaln omits the technical accessibility tests @{term check_field_access}
   10.22 +and @{term check_method_access}, since we proved the absence of errors for
   10.23 +wellformed programs.
   10.24  *}
   10.25  
   10.26  consts
   10.27 @@ -70,9 +72,9 @@
   10.28  
   10.29    LVar:	"G\<turnstile>Norm s \<midarrow>LVar vn=\<succ>lvar vn s\<midarrow>n\<rightarrow> Norm s"
   10.30  
   10.31 -  FVar:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>a'\<midarrow>n\<rightarrow> s2;
   10.32 -	  (v,s2') = fvar C stat fn a' s2\<rbrakk> \<Longrightarrow>
   10.33 -	  G\<turnstile>Norm s0 \<midarrow>{C,stat}e..fn=\<succ>v\<midarrow>n\<rightarrow> s2'"
   10.34 +  FVar:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>a'\<midarrow>n\<rightarrow> s2;
   10.35 +	  (v,s2') = fvar statDeclC stat fn a' s2\<rbrakk> \<Longrightarrow>
   10.36 +	  G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>v\<midarrow>n\<rightarrow> s2'"
   10.37  
   10.38    AVar:	"\<lbrakk>G\<turnstile> Norm s0 \<midarrow>e1-\<succ>a\<midarrow>n\<rightarrow> s1 ; G\<turnstile>s1 \<midarrow>e2-\<succ>i\<midarrow>n\<rightarrow> s2; 
   10.39  	  (v,s2') = avar G i a s2\<rbrakk> \<Longrightarrow>
   10.40 @@ -119,7 +121,8 @@
   10.41      D = invocation_declclass G mode (store s2) a' statT \<lparr>name=mn,parTs=pTs\<rparr>; 
   10.42      G\<turnstile>init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' vs s2
   10.43              \<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ>v\<midarrow>n\<rightarrow> s3\<rbrakk>
   10.44 -   \<Longrightarrow> G\<turnstile>Norm s0 \<midarrow>{statT,mode}e\<cdot>mn({pTs}args)-\<succ>v\<midarrow>n\<rightarrow> (restore_lvars s2 s3)"
   10.45 +   \<Longrightarrow> 
   10.46 +    G\<turnstile>Norm s0 \<midarrow>{accC,statT,mode}e\<cdot>mn({pTs}args)-\<succ>v\<midarrow>n\<rightarrow> (restore_lvars s2 s3)"
   10.47  
   10.48    Methd:"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
   10.49  				G\<turnstile>Norm s0 \<midarrow>Methd D sig-\<succ>v\<midarrow>Suc n\<rightarrow> s1"
   10.50 @@ -187,56 +190,6 @@
   10.51  monos
   10.52    if_def2
   10.53  
   10.54 -lemma evaln_eval: "\<And>ws. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> ws \<Longrightarrow> G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> ws"
   10.55 -apply (simp (no_asm_simp) only: split_tupled_all)
   10.56 -apply (erule evaln.induct)
   10.57 -apply (rule eval.intros, (assumption+)?,(force split del: split_if)?)+
   10.58 -done
   10.59 -
   10.60 -
   10.61 -lemma Suc_le_D_lemma: "\<lbrakk>Suc n <= m'; (\<And>m. n <= m \<Longrightarrow> P (Suc m)) \<rbrakk> \<Longrightarrow> P m'"
   10.62 -apply (frule Suc_le_D)
   10.63 -apply fast
   10.64 -done
   10.65 -
   10.66 -lemma evaln_nonstrict [rule_format (no_asm), elim]: 
   10.67 -  "\<And>ws. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> ws \<Longrightarrow> \<forall>m. n\<le>m \<longrightarrow> G\<turnstile>s \<midarrow>t\<succ>\<midarrow>m\<rightarrow> ws"
   10.68 -apply (simp (no_asm_simp) only: split_tupled_all)
   10.69 -apply (erule evaln.induct)
   10.70 -apply (tactic {* ALLGOALS (EVERY'[strip_tac, TRY o etac (thm "Suc_le_D_lemma"),
   10.71 -  REPEAT o smp_tac 1, 
   10.72 -  resolve_tac (thms "evaln.intros") THEN_ALL_NEW TRY o atac]) *})
   10.73 -(* 3 subgoals *)
   10.74 -apply (auto split del: split_if)
   10.75 -done
   10.76 -
   10.77 -lemmas evaln_nonstrict_Suc = evaln_nonstrict [OF _ le_refl [THEN le_SucI]]
   10.78 -
   10.79 -lemma evaln_max2: "\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> ws1; G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> ws2\<rbrakk> \<Longrightarrow> 
   10.80 -             G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max n1 n2\<rightarrow> ws1 \<and> G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max n1 n2\<rightarrow> ws2"
   10.81 -apply (fast intro: le_maxI1 le_maxI2)
   10.82 -done
   10.83 -
   10.84 -lemma evaln_max3: 
   10.85 -"\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> ws1; G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> ws2; G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>n3\<rightarrow> ws3\<rbrakk> \<Longrightarrow>
   10.86 - G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws1 \<and>
   10.87 - G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws2 \<and> 
   10.88 - G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws3"
   10.89 -apply (drule (1) evaln_max2, erule thin_rl)
   10.90 -apply (fast intro!: le_maxI1 le_maxI2)
   10.91 -done
   10.92 -
   10.93 -lemma eval_evaln: "\<And>ws. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> ws \<Longrightarrow> (\<exists>n. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> ws)"
   10.94 -apply (simp (no_asm_simp) only: split_tupled_all)
   10.95 -apply (erule eval.induct)
   10.96 -apply (tactic {* ALLGOALS 
   10.97 -         (asm_full_simp_tac (HOL_basic_ss addsplits [split_if_asm])) *})
   10.98 -apply (tactic {* ALLGOALS (EVERY'[
   10.99 -   REPEAT o eresolve_tac [exE, conjE], rtac exI,
  10.100 -                     TRY o datac (thm "evaln_max3") 2, REPEAT o etac conjE,
  10.101 -  resolve_tac (thms "evaln.intros") THEN_ALL_NEW 
  10.102 -  force_tac (HOL_cs, HOL_ss)]) *})
  10.103 -done
  10.104  
  10.105  declare split_if     [split del] split_if_asm     [split del]
  10.106          option.split [split del] option.split_asm [split del]
  10.107 @@ -268,9 +221,9 @@
  10.108  	"G\<turnstile>Norm s \<midarrow>In1l (New T[e])                \<succ>\<midarrow>n\<rightarrow> vs'"
  10.109  	"G\<turnstile>Norm s \<midarrow>In1l (Ass va e)                \<succ>\<midarrow>n\<rightarrow> vs'"
  10.110  	"G\<turnstile>Norm s \<midarrow>In1r (Try c1 Catch(tn vn) c2)  \<succ>\<midarrow>n\<rightarrow> xs'"
  10.111 -	"G\<turnstile>Norm s \<midarrow>In2  ({C,stat}e..fn)           \<succ>\<midarrow>n\<rightarrow> vs'"
  10.112 +	"G\<turnstile>Norm s \<midarrow>In2  ({accC,statDeclC,stat}e..fn) \<succ>\<midarrow>n\<rightarrow> vs'"
  10.113  	"G\<turnstile>Norm s \<midarrow>In2  (e1.[e2])                 \<succ>\<midarrow>n\<rightarrow> vs'"
  10.114 -	"G\<turnstile>Norm s \<midarrow>In1l ({statT,mode}e\<cdot>mn({pT}p)) \<succ>\<midarrow>n\<rightarrow> vs'"
  10.115 +	"G\<turnstile>Norm s \<midarrow>In1l ({accC,statT,mode}e\<cdot>mn({pT}p)) \<succ>\<midarrow>n\<rightarrow> vs'"
  10.116  	"G\<turnstile>Norm s \<midarrow>In1r (Init C)                  \<succ>\<midarrow>n\<rightarrow> xs'"
  10.117  declare split_if     [split] split_if_asm     [split] 
  10.118          option.split [split] option.split_asm [split]
  10.119 @@ -370,4 +323,1401 @@
  10.120  apply auto
  10.121  done
  10.122  
  10.123 +lemma evaln_eval:  
  10.124 + (assumes evaln: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)" and
  10.125 +             wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T" and  
  10.126 +        conf_s0: "s0\<Colon>\<preceq>(G, L)" and
  10.127 +             wf: "wf_prog G" 
  10.128 +       
  10.129 + )  "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)"
  10.130 +proof -
  10.131 +  from evaln 
  10.132 +  show "\<And> L accC T. \<lbrakk>s0\<Colon>\<preceq>(G, L);\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T\<rbrakk>
  10.133 +                    \<Longrightarrow> G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)"
  10.134 +       (is "PROP ?EqEval s0 s1 t v")
  10.135 +  proof (induct)
  10.136 +    case Abrupt
  10.137 +    show ?case by (rule eval.Abrupt)
  10.138 +  next
  10.139 +    case LVar
  10.140 +    show ?case by (rule eval.LVar)
  10.141 +  next
  10.142 +    case (FVar a accC' e fn n s0 s1 s2 s2' stat statDeclC v L accC T)
  10.143 +    have eval_initn: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<midarrow>n\<rightarrow> s1" .
  10.144 +    have eval_en: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s2" .
  10.145 +    have hyp_init: "PROP ?EqEval (Norm s0) s1 (In1r (Init statDeclC)) \<diamondsuit>" .
  10.146 +    have hyp_e: "PROP ?EqEval s1 s2 (In1l e) (In1 a)" .
  10.147 +    have fvar: "(v, s2') = fvar statDeclC stat fn a s2" .
  10.148 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.149 +    have wt: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>In2 ({accC',statDeclC,stat}e..fn)\<Colon>T" .
  10.150 +    then obtain statC f where
  10.151 +                wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
  10.152 +            accfield: "accfield G accC statC fn = Some (statDeclC,f)" and
  10.153 +                stat: "stat=is_static f" and
  10.154 +               accC': "accC'=accC" and
  10.155 +	           T: "T=(Inl (type f))"
  10.156 +       by (rule wt_elim_cases) (auto simp add: member_is_static_simp)
  10.157 +    from wf wt_e 
  10.158 +    have iscls_statC: "is_class G statC"
  10.159 +      by (auto dest: ty_expr_is_type type_is_class)
  10.160 +    with wf accfield 
  10.161 +    have iscls_statDeclC: "is_class G statDeclC"
  10.162 +      by (auto dest!: accfield_fields dest: fields_declC)
  10.163 +    then 
  10.164 +    have wt_init: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>(Init statDeclC)\<Colon>\<surd>"
  10.165 +      by simp
  10.166 +    from conf_s0 wt_init
  10.167 +    have eval_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1"
  10.168 +      by (rule hyp_init)
  10.169 +    with wt_init conf_s0 wf 
  10.170 +    have conf_s1: "s1\<Colon>\<preceq>(G, L)"
  10.171 +      by (blast dest: exec_ts)
  10.172 +    with hyp_e wt_e
  10.173 +    have eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2"
  10.174 +      by blast
  10.175 +    with wf conf_s1 wt_e
  10.176 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and
  10.177 +            conf_a: "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
  10.178 +      by (auto dest!: eval_type_sound)
  10.179 +    obtain s3 where
  10.180 +      check: "s3 = check_field_access G accC statDeclC fn stat a s2'"
  10.181 +      by simp
  10.182 +    from accfield wt_e eval_init eval_e conf_s2 conf_a fvar stat check  wf
  10.183 +    have eq_s3_s2': "s3=s2'"  
  10.184 +      by (auto dest!: error_free_field_access)
  10.185 +    with eval_init eval_e fvar check accC'
  10.186 +    show "G\<turnstile>Norm s0 \<midarrow>{accC',statDeclC,stat}e..fn=\<succ>v\<rightarrow> s2'"
  10.187 +      by (auto intro: eval.FVar)
  10.188 +  next
  10.189 +    case AVar
  10.190 +    with wf show ?case
  10.191 +      apply -
  10.192 +      apply (erule wt_elim_cases)
  10.193 +      apply (blast intro!: eval.AVar dest: eval_type_sound)
  10.194 +      done
  10.195 +  next
  10.196 +    case NewC
  10.197 +    with wf show ?case
  10.198 +      apply - 
  10.199 +      apply (erule wt_elim_cases)
  10.200 +      apply (blast intro!: eval.NewC dest: eval_type_sound is_acc_classD)
  10.201 +      done
  10.202 +  next
  10.203 +    case (NewA T a e i n s0 s1 s2 s3 L accC Ta) 
  10.204 +    have hyp_init: "PROP ?EqEval (Norm s0) s1 (In1r (init_comp_ty T)) \<diamondsuit>" .
  10.205 +    have hyp_size: "PROP ?EqEval s1 s2 (In1l e) (In1 i)" .
  10.206 +    have "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (New T[e])\<Colon>Ta" .
  10.207 +    then obtain
  10.208 +       wt_init: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>init_comp_ty T\<Colon>\<surd>" and
  10.209 +       wt_size: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Integer"
  10.210 +      by (rule wt_elim_cases) (auto intro: wt_init_comp_ty dest: is_acc_typeD)
  10.211 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.212 +    from this wt_init 
  10.213 +    have eval_init: "G\<turnstile>Norm s0 \<midarrow>init_comp_ty T\<rightarrow> s1"
  10.214 +      by (rule hyp_init)
  10.215 +    moreover
  10.216 +    from eval_init wt_init wf conf_s0
  10.217 +    have "s1\<Colon>\<preceq>(G, L)"
  10.218 +      by (auto dest: eval_type_sound)
  10.219 +    from this wt_size 
  10.220 +    have "G\<turnstile>s1 \<midarrow>e-\<succ>i\<rightarrow> s2"
  10.221 +      by (rule hyp_size)
  10.222 +    moreover note NewA
  10.223 +    ultimately show ?case
  10.224 +      by (blast intro!: eval.NewA)
  10.225 +  next
  10.226 +    case Cast
  10.227 +    with wf show ?case
  10.228 +      by - (erule wt_elim_cases, rule eval.Cast,auto dest: eval_type_sound)
  10.229 +  next
  10.230 +    case Inst
  10.231 +    with wf show ?case
  10.232 +      by - (erule wt_elim_cases, rule eval.Inst,auto dest: eval_type_sound)
  10.233 +  next
  10.234 +    case Lit
  10.235 +    show ?case by (rule eval.Lit)
  10.236 +  next
  10.237 +    case Super
  10.238 +    show ?case by (rule eval.Super)
  10.239 +  next
  10.240 +    case Acc
  10.241 +    then show ?case
  10.242 +      by - (erule wt_elim_cases, rule eval.Acc,auto dest: eval_type_sound)
  10.243 +  next
  10.244 +    case Ass
  10.245 +    with wf show ?case
  10.246 +      by - (erule wt_elim_cases, blast intro!: eval.Ass dest: eval_type_sound) 
  10.247 +  next
  10.248 +    case (Cond b e0 e1 e2 n s0 s1 s2 v L accC T)
  10.249 +    have hyp_e0: "PROP ?EqEval (Norm s0) s1 (In1l e0) (In1 b)" .
  10.250 +    have hyp_if: "PROP ?EqEval s1 s2 
  10.251 +                              (In1l (if the_Bool b then e1 else e2)) (In1 v)" .
  10.252 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.253 +    have wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (e0 ? e1 : e2)\<Colon>T" .
  10.254 +    then obtain T1 T2 statT where
  10.255 +       wt_e0: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e0\<Colon>-PrimT Boolean" and
  10.256 +       wt_e1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e1\<Colon>-T1" and
  10.257 +       wt_e2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e2\<Colon>-T2" and 
  10.258 +       statT: "G\<turnstile>T1\<preceq>T2 \<and> statT = T2  \<or>  G\<turnstile>T2\<preceq>T1 \<and> statT =  T1" and
  10.259 +       T    : "T=Inl statT"
  10.260 +      by (rule wt_elim_cases) auto
  10.261 +    from conf_s0 wt_e0
  10.262 +    have eval_e0: "G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<rightarrow> s1"
  10.263 +      by (rule hyp_e0)
  10.264 +    moreover
  10.265 +    from eval_e0 conf_s0 wf wt_e0
  10.266 +    have "s1\<Colon>\<preceq>(G, L)"
  10.267 +      by (blast dest: eval_type_sound)
  10.268 +    with wt_e1 wt_e2 statT hyp_if
  10.269 +    have "G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<rightarrow> s2"
  10.270 +      by (cases "the_Bool b") auto
  10.271 +    ultimately
  10.272 +    show ?case
  10.273 +      by (rule eval.Cond)
  10.274 +  next
  10.275 +    case (Call invDeclC a' accC' args e mn mode n pTs' s0 s1 s2 s4 statT 
  10.276 +           v vs L accC T)
  10.277 +    (* Repeats large parts of the type soundness proof. One should factor
  10.278 +       out some lemmata about the relations and conformance of s2, s3 and s3'*)
  10.279 +    have evaln_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<midarrow>n\<rightarrow> s1" .
  10.280 +    have evaln_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s2" .
  10.281 +    have invDeclC: "invDeclC 
  10.282 +                      = invocation_declclass G mode (store s2) a' statT 
  10.283 +                           \<lparr>name = mn, parTs = pTs'\<rparr>" .
  10.284 +    let ?InitLvars 
  10.285 +         = "init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2"
  10.286 +    obtain s3 s3' where 
  10.287 +      init_lvars: "s3 = 
  10.288 +             init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2" and
  10.289 +      check: "s3' =
  10.290 +         check_method_access G accC' statT mode \<lparr>name = mn, parTs = pTs'\<rparr> a' s3"
  10.291 +      by simp
  10.292 +    have evaln_methd: 
  10.293 +           "G\<turnstile>?InitLvars \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<midarrow>n\<rightarrow> s4" .
  10.294 +    have     hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 a')" .
  10.295 +    have  hyp_args: "PROP ?EqEval s1 s2 (In3 args) (In3 vs)" .
  10.296 +    have hyp_methd: "PROP ?EqEval ?InitLvars s4 
  10.297 +                     (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)) (In1 v)".
  10.298 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.299 +    have      wt: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>
  10.300 +                    \<turnstile>In1l ({accC',statT,mode}e\<cdot>mn( {pTs'}args))\<Colon>T" .
  10.301 +    from wt obtain pTs statDeclT statM where
  10.302 +                 wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT" and
  10.303 +              wt_args: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>args\<Colon>\<doteq>pTs" and
  10.304 +                statM: "max_spec G accC statT \<lparr>name=mn,parTs=pTs\<rparr> 
  10.305 +                         = {((statDeclT,statM),pTs')}" and
  10.306 +                 mode: "mode = invmode statM e" and
  10.307 +                    T: "T =Inl (resTy statM)" and
  10.308 +        eq_accC_accC': "accC=accC'"
  10.309 +      by (rule wt_elim_cases) auto
  10.310 +    from conf_s0 wt_e hyp_e
  10.311 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1"
  10.312 +      by blast
  10.313 +    with wf conf_s0 wt_e
  10.314 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and
  10.315 +           conf_a': "normal s1 \<Longrightarrow> G, store s1\<turnstile>a'\<Colon>\<preceq>RefT statT" 
  10.316 +      by (auto dest!: eval_type_sound)
  10.317 +    from conf_s1 wt_args hyp_args
  10.318 +    have eval_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2"
  10.319 +      by blast
  10.320 +    with wt_args conf_s1 wf 
  10.321 +    obtain    conf_s2: "s2\<Colon>\<preceq>(G, L)" and
  10.322 +            conf_args: "normal s2 
  10.323 +                         \<Longrightarrow>  list_all2 (conf G (store s2)) vs pTs" 
  10.324 +      by (auto dest!: eval_type_sound)
  10.325 +    from statM 
  10.326 +    obtain
  10.327 +       statM': "(statDeclT,statM)\<in>mheads G accC statT \<lparr>name=mn,parTs=pTs'\<rparr>" and
  10.328 +       pTs_widen: "G\<turnstile>pTs[\<preceq>]pTs'"
  10.329 +      by (blast dest: max_spec2mheads)
  10.330 +    from check
  10.331 +    have eq_store_s3'_s3: "store s3'=store s3"
  10.332 +      by (cases s3) (simp add: check_method_access_def Let_def)
  10.333 +    obtain invC
  10.334 +      where invC: "invC = invocation_class mode (store s2) a' statT"
  10.335 +      by simp
  10.336 +    with init_lvars
  10.337 +    have invC': "invC = (invocation_class mode (store s3) a' statT)"
  10.338 +      by (cases s2,cases mode) (auto simp add: init_lvars_def2 )
  10.339 +    show "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)
  10.340 +             -\<succ>v\<rightarrow> (set_lvars (locals (store s2))) s4"
  10.341 +    proof (cases "normal s2")
  10.342 +      case False
  10.343 +      with init_lvars 
  10.344 +      obtain keep_abrupt: "abrupt s3 = abrupt s2" and
  10.345 +             "store s3 = store (init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> 
  10.346 +                                            mode a' vs s2)" 
  10.347 +	by (auto simp add: init_lvars_def2)
  10.348 +      moreover
  10.349 +      from keep_abrupt False check
  10.350 +      have eq_s3'_s3: "s3'=s3" 
  10.351 +	by (auto simp add: check_method_access_def Let_def)
  10.352 +      moreover
  10.353 +      from eq_s3'_s3 False keep_abrupt evaln_methd init_lvars
  10.354 +      obtain "s4=s3'"
  10.355 +	 "In1 v=arbitrary3 (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>))"
  10.356 +	by auto
  10.357 +      moreover note False
  10.358 +      ultimately have
  10.359 +	"G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<rightarrow> s4"
  10.360 +	by (auto)
  10.361 +      from eval_e eval_args invDeclC init_lvars check this
  10.362 +      show ?thesis
  10.363 +	by (rule eval.Call)
  10.364 +    next
  10.365 +      case True
  10.366 +      note normal_s2 = True
  10.367 +      with eval_args
  10.368 +      have normal_s1: "normal s1"
  10.369 +	by (cases "normal s1") auto
  10.370 +      with conf_a' eval_args 
  10.371 +      have conf_a'_s2: "G, store s2\<turnstile>a'\<Colon>\<preceq>RefT statT"
  10.372 +	by (auto dest: eval_gext intro: conf_gext)
  10.373 +      show ?thesis
  10.374 +      proof (cases "a'=Null \<longrightarrow> is_static statM")
  10.375 +	case False
  10.376 +	then obtain not_static: "\<not> is_static statM" and Null: "a'=Null" 
  10.377 +	  by blast
  10.378 +	with normal_s2 init_lvars mode
  10.379 +	obtain np: "abrupt s3 = Some (Xcpt (Std NullPointer))" and
  10.380 +                   "store s3 = store (init_lvars G invDeclC 
  10.381 +                                       \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2)"
  10.382 +	  by (auto simp add: init_lvars_def2)
  10.383 +	moreover
  10.384 +	from np check
  10.385 +	have eq_s3'_s3: "s3'=s3" 
  10.386 +	  by (auto simp add: check_method_access_def Let_def)
  10.387 +	moreover
  10.388 +	from eq_s3'_s3 np evaln_methd init_lvars
  10.389 +	obtain "s4=s3'"
  10.390 +	  "In1 v=arbitrary3 (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>))"
  10.391 +	  by auto
  10.392 +	moreover note np 
  10.393 +	ultimately have
  10.394 +	  "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<rightarrow> s4"
  10.395 +	  by (auto)
  10.396 +	from eval_e eval_args invDeclC init_lvars check this
  10.397 +	show ?thesis
  10.398 +	  by (rule eval.Call)
  10.399 +      next
  10.400 +	case True
  10.401 +	with mode have notNull: "mode = IntVir \<longrightarrow> a' \<noteq> Null"
  10.402 +	  by (auto dest!: Null_staticD)
  10.403 +	with conf_s2 conf_a'_s2 wf invC 
  10.404 +	have dynT_prop: "G\<turnstile>mode\<rightarrow>invC\<preceq>statT"
  10.405 +	  by (cases s2) (auto intro: DynT_propI)
  10.406 +	with wt_e statM' invC mode wf 
  10.407 +	obtain dynM where 
  10.408 +           dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  10.409 +           acc_dynM: "G \<turnstile>Methd  \<lparr>name=mn,parTs=pTs'\<rparr> dynM 
  10.410 +                          in invC dyn_accessible_from accC"
  10.411 +	  by (force dest!: call_access_ok)
  10.412 +	with invC' check eq_accC_accC'
  10.413 +	have eq_s3'_s3: "s3'=s3"
  10.414 +	  by (auto simp add: check_method_access_def Let_def)
  10.415 +	from dynT_prop wf wt_e statM' mode invC invDeclC dynM 
  10.416 +	obtain 
  10.417 +	   wf_dynM: "wf_mdecl G invDeclC (\<lparr>name=mn,parTs=pTs'\<rparr>,mthd dynM)" and
  10.418 +	     dynM': "methd G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  10.419 +           iscls_invDeclC: "is_class G invDeclC" and
  10.420 +	        invDeclC': "invDeclC = declclass dynM" and
  10.421 +	     invC_widen: "G\<turnstile>invC\<preceq>\<^sub>C invDeclC" and
  10.422 +	   is_static_eq: "is_static dynM = is_static statM" and
  10.423 +	   involved_classes_prop:
  10.424 +             "(if invmode statM e = IntVir
  10.425 +               then \<forall>statC. statT = ClassT statC \<longrightarrow> G\<turnstile>invC\<preceq>\<^sub>C statC
  10.426 +               else ((\<exists>statC. statT = ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C invDeclC) \<or>
  10.427 +                     (\<forall>statC. statT \<noteq> ClassT statC \<and> invDeclC = Object)) \<and>
  10.428 +                      statDeclT = ClassT invDeclC)"
  10.429 +	  by (auto dest: DynT_mheadsD)
  10.430 +	obtain L' where 
  10.431 +	   L':"L'=(\<lambda> k. 
  10.432 +                 (case k of
  10.433 +                    EName e
  10.434 +                    \<Rightarrow> (case e of 
  10.435 +                          VNam v 
  10.436 +                          \<Rightarrow>(table_of (lcls (mbody (mthd dynM)))
  10.437 +                             (pars (mthd dynM)[\<mapsto>]pTs')) v
  10.438 +                        | Res \<Rightarrow> Some (resTy dynM))
  10.439 +                  | This \<Rightarrow> if is_static statM 
  10.440 +                            then None else Some (Class invDeclC)))"
  10.441 +	  by simp
  10.442 +	from wf_dynM [THEN wf_mdeclD1, THEN conjunct1] normal_s2 conf_s2 wt_e
  10.443 +              wf eval_args conf_a' mode notNull wf_dynM involved_classes_prop
  10.444 +	have conf_s3: "s3\<Colon>\<preceq>(G,L')"
  10.445 +	   apply - 
  10.446 +          (*FIXME confomrs_init_lvars should be 
  10.447 +                adjusted to be more directy applicable *)
  10.448 +	   apply (drule conforms_init_lvars [of G invDeclC 
  10.449 +                  "\<lparr>name=mn,parTs=pTs'\<rparr>" dynM "store s2" vs pTs "abrupt s2" 
  10.450 +                  L statT invC a' "(statDeclT,statM)" e])
  10.451 +	     apply (rule wf)
  10.452 +	     apply (rule conf_args,assumption)
  10.453 +	     apply (simp add: pTs_widen)
  10.454 +	     apply (cases s2,simp)
  10.455 +	     apply (rule dynM')
  10.456 +	     apply (force dest: ty_expr_is_type)
  10.457 +	     apply (rule invC_widen)
  10.458 +	     apply (force intro: conf_gext dest: eval_gext)
  10.459 +	     apply simp
  10.460 +	     apply simp
  10.461 +	     apply (simp add: invC)
  10.462 +	     apply (simp add: invDeclC)
  10.463 +	     apply (force dest: wf_mdeclD1 is_acc_typeD)
  10.464 +	     apply (cases s2, simp add: L' init_lvars
  10.465 +	                      cong add: lname.case_cong ename.case_cong)
  10.466 +	   done
  10.467 +	from is_static_eq wf_dynM L'
  10.468 +	obtain mthdT where
  10.469 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
  10.470 +            \<turnstile>Body invDeclC (stmt (mbody (mthd dynM)))\<Colon>-mthdT" and
  10.471 +	   mthdT_widen: "G\<turnstile>mthdT\<preceq>resTy dynM"
  10.472 +	  by - (drule wf_mdecl_bodyD,
  10.473 +                simp cong add: lname.case_cong ename.case_cong)
  10.474 +	with dynM' iscls_invDeclC invDeclC'
  10.475 +	have
  10.476 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
  10.477 +            \<turnstile>(Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)\<Colon>-mthdT"
  10.478 +	  by (auto intro: wt.Methd)
  10.479 +	with conf_s3 hyp_methd init_lvars eq_s3'_s3
  10.480 +	have "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<rightarrow> s4"
  10.481 +	  by auto
  10.482 +	from eval_e eval_args invDeclC init_lvars check this
  10.483 +	show ?thesis
  10.484 +	  by (rule eval.Call)
  10.485 +      qed
  10.486 +    qed
  10.487 +  next
  10.488 +    case Methd
  10.489 +    with wf show ?case
  10.490 +      by - (erule wt_elim_cases, rule eval.Methd, 
  10.491 +            auto dest: eval_type_sound simp add: body_def2)
  10.492 +  next
  10.493 +    case Body
  10.494 +    with wf show ?case
  10.495 +       by - (erule wt_elim_cases, blast intro!: eval.Body dest: eval_type_sound)
  10.496 +  next
  10.497 +    case Nil
  10.498 +    show ?case by (rule eval.Nil)
  10.499 +  next
  10.500 +    case Cons
  10.501 +    with wf show ?case
  10.502 +      by - (erule wt_elim_cases, blast intro!: eval.Cons dest: eval_type_sound)
  10.503 +  next
  10.504 +    case Skip
  10.505 +    show ?case by (rule eval.Skip)
  10.506 +  next
  10.507 +    case Expr
  10.508 +    with wf show ?case
  10.509 +      by - (erule wt_elim_cases, rule eval.Expr,auto dest: eval_type_sound)
  10.510 +  next
  10.511 +    case Lab
  10.512 +    with wf show ?case
  10.513 +      by - (erule wt_elim_cases, rule eval.Lab,auto dest: eval_type_sound)
  10.514 +  next
  10.515 +    case Comp
  10.516 +    with wf show ?case
  10.517 +      by - (erule wt_elim_cases, blast intro!: eval.Comp dest: eval_type_sound)
  10.518 +  next
  10.519 +    case (If b c1 c2 e n s0 s1 s2 L accC T)
  10.520 +    have hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 b)" .
  10.521 +    have hyp_then_else: 
  10.522 +      "PROP ?EqEval s1 s2 (In1r (if the_Bool b then c1 else c2)) \<diamondsuit>" .
  10.523 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.524 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (If(e) c1 Else c2)\<Colon>T" .
  10.525 +    then obtain 
  10.526 +              wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
  10.527 +      wt_then_else: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>(if the_Bool b then c1 else c2)\<Colon>\<surd>"
  10.528 +      by (rule wt_elim_cases) (auto split add: split_if)
  10.529 +    from conf_s0 wt_e
  10.530 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1"
  10.531 +      by (rule hyp_e)
  10.532 +    moreover
  10.533 +    from eval_e wt_e conf_s0 wf
  10.534 +    have "s1\<Colon>\<preceq>(G, L)"
  10.535 +      by (blast dest: eval_type_sound)
  10.536 +    from this wt_then_else
  10.537 +    have "G\<turnstile>s1 \<midarrow>(if the_Bool b then c1 else c2)\<rightarrow> s2"
  10.538 +      by (rule hyp_then_else)
  10.539 +    ultimately
  10.540 +    show ?case
  10.541 +      by (rule eval.If)
  10.542 +  next
  10.543 +    case (Loop b c e l n s0 s1 s2 s3 L accC T)
  10.544 +    have hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 b)" .
  10.545 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.546 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (l\<bullet> While(e) c)\<Colon>T" .
  10.547 +    then obtain wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
  10.548 +                wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
  10.549 +      by (rule wt_elim_cases) (blast)
  10.550 +    from conf_s0 wt_e 
  10.551 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1"
  10.552 +      by (rule hyp_e)
  10.553 +    moreover
  10.554 +    from eval_e wt_e conf_s0 wf
  10.555 +    have conf_s1: "s1\<Colon>\<preceq>(G, L)"
  10.556 +      by (blast dest: eval_type_sound)
  10.557 +    have "if normal s1 \<and> the_Bool b 
  10.558 +             then (G\<turnstile>s1 \<midarrow>c\<rightarrow> s2 \<and> 
  10.559 +                   G\<turnstile>(abupd (absorb (Cont l)) s2) \<midarrow>l\<bullet> While(e) c\<rightarrow> s3)
  10.560 +	     else s3 = s1"
  10.561 +    proof (cases "normal s1 \<and> the_Bool b")
  10.562 +      case True 
  10.563 +      from Loop True have hyp_c: "PROP ?EqEval s1 s2 (In1r c) \<diamondsuit>"
  10.564 +	by (auto)
  10.565 +      from Loop True have hyp_w: "PROP ?EqEval (abupd (absorb (Cont l)) s2)
  10.566 +                                        s3 (In1r (l\<bullet> While(e) c)) \<diamondsuit>"
  10.567 +	by (auto)
  10.568 +      from conf_s1 wt_c
  10.569 +      have eval_c: "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2"
  10.570 +	by (rule hyp_c)
  10.571 +      moreover
  10.572 +      from eval_c conf_s1 wt_c wf
  10.573 +      have "s2\<Colon>\<preceq>(G, L)"
  10.574 +	by (blast dest: eval_type_sound)
  10.575 +      then
  10.576 +      have "abupd (absorb (Cont l)) s2 \<Colon>\<preceq>(G, L)"
  10.577 +	by (cases s2) (auto intro: conforms_absorb)
  10.578 +      from this and wt
  10.579 +      have "G\<turnstile>abupd (absorb (Cont l)) s2 \<midarrow>l\<bullet> While(e) c\<rightarrow> s3"
  10.580 +	by (rule hyp_w)
  10.581 +      moreover note True
  10.582 +      ultimately
  10.583 +      show ?thesis
  10.584 +	by simp
  10.585 +    next
  10.586 +      case False
  10.587 +      with Loop have "s3 = s1" by simp
  10.588 +      with False
  10.589 +      show ?thesis 
  10.590 +	by auto
  10.591 +    qed
  10.592 +    ultimately
  10.593 +    show ?case
  10.594 +      by (rule eval.Loop)
  10.595 +  next
  10.596 +    case Do
  10.597 +    show ?case by (rule eval.Do)
  10.598 +  next
  10.599 +    case Throw
  10.600 +    with wf show ?case
  10.601 +      by - (erule wt_elim_cases, rule eval.Throw,auto dest: eval_type_sound)
  10.602 +  next
  10.603 +    case (Try c1 c2 n s0 s1 s2 s3 catchC vn L accC T)
  10.604 +    have  hyp_c1: "PROP ?EqEval (Norm s0) s1 (In1r c1) \<diamondsuit>" .
  10.605 +    have conf_s0:"Norm s0\<Colon>\<preceq>(G, L)" .
  10.606 +    have      wt:"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>In1r (Try c1 Catch(catchC vn) c2)\<Colon>T" .
  10.607 +    then obtain 
  10.608 +      wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  10.609 +      wt_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<lparr>lcl := L(VName vn\<mapsto>Class catchC)\<rparr>\<turnstile>c2\<Colon>\<surd>"
  10.610 +      by (rule wt_elim_cases) (auto)
  10.611 +    from conf_s0 wt_c1
  10.612 +    have eval_c1: "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1"
  10.613 +      by (rule hyp_c1)
  10.614 +    moreover
  10.615 +    have sxalloc: "G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2" .
  10.616 +    moreover
  10.617 +    from eval_c1 wt_c1 conf_s0 wf
  10.618 +    have "s1\<Colon>\<preceq>(G, L)"
  10.619 +      by (blast dest: eval_type_sound)
  10.620 +    with sxalloc wf
  10.621 +    have conf_s2: "s2\<Colon>\<preceq>(G, L)" 
  10.622 +      by (auto dest: sxalloc_type_sound split: option.splits)
  10.623 +    have "if G,s2\<turnstile>catch catchC then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<rightarrow> s3 else s3 = s2"
  10.624 +    proof (cases "G,s2\<turnstile>catch catchC")
  10.625 +      case True
  10.626 +      note Catch = this
  10.627 +      with Try have hyp_c2: "PROP ?EqEval (new_xcpt_var vn s2) s3 (In1r c2) \<diamondsuit>"
  10.628 +	by auto
  10.629 +      show ?thesis
  10.630 +      proof (cases "normal s1")
  10.631 +	case True
  10.632 +	with sxalloc wf 
  10.633 +	have eq_s2_s1: "s2=s1"
  10.634 +	  by (auto dest: sxalloc_type_sound split: option.splits)
  10.635 +	with True 
  10.636 +	have "\<not>  G,s2\<turnstile>catch catchC"
  10.637 +	  by (simp add: catch_def)
  10.638 +	with Catch show ?thesis 
  10.639 +	  by (contradiction)
  10.640 +      next 
  10.641 +	case False
  10.642 +	with sxalloc wf
  10.643 +	obtain a 
  10.644 +	  where xcpt_s2: "abrupt s2 = Some (Xcpt (Loc a))"
  10.645 +	  by (auto dest!: sxalloc_type_sound split: option.splits)
  10.646 +	with Catch
  10.647 +	have "G\<turnstile>obj_ty (the (globs (store s2) (Heap a)))\<preceq>Class catchC"
  10.648 +	  by (cases s2) simp
  10.649 +	with xcpt_s2 conf_s2 wf 
  10.650 +	have "new_xcpt_var vn s2\<Colon>\<preceq>(G, L(VName vn\<mapsto>Class catchC))"
  10.651 +	  by (auto dest: Try_lemma)
  10.652 +	from this wt_c2
  10.653 +	have "G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<rightarrow> s3"
  10.654 +	  by (auto intro: hyp_c2)
  10.655 +	with Catch 
  10.656 +	show ?thesis
  10.657 +	  by simp
  10.658 +      qed
  10.659 +    next
  10.660 +      case False
  10.661 +      with Try
  10.662 +      have "s3=s2"
  10.663 +	by simp
  10.664 +      with False
  10.665 +      show ?thesis
  10.666 +	by simp
  10.667 +    qed
  10.668 +    ultimately
  10.669 +    show ?case
  10.670 +      by (rule eval.Try)
  10.671 +  next
  10.672 +    case Fin
  10.673 +    with wf show ?case
  10.674 +      by -(erule wt_elim_cases, blast intro!: eval.Fin
  10.675 +           dest: eval_type_sound intro: conforms_NormI)
  10.676 +  next
  10.677 +    case (Init C c n s0 s1 s2 s3 L accC T)
  10.678 +    have     cls: "the (class G C) = c" .
  10.679 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.680 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (Init C)\<Colon>T" .
  10.681 +    with cls
  10.682 +    have cls_C: "class G C = Some c"
  10.683 +      by - (erule wt_elim_cases,auto)
  10.684 +    have "if inited C (globs s0) then s3 = Norm s0
  10.685 +	  else (G\<turnstile>Norm (init_class_obj G C s0) 
  10.686 +		  \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1 \<and>
  10.687 +	       G\<turnstile>set_lvars empty s1 \<midarrow>init c\<rightarrow> s2 \<and> s3 = restore_lvars s1 s2)"
  10.688 +    proof (cases "inited C (globs s0)")
  10.689 +      case True
  10.690 +      with Init have "s3 = Norm s0"
  10.691 +	by simp
  10.692 +      with True show ?thesis 
  10.693 +	by simp
  10.694 +    next
  10.695 +      case False
  10.696 +      with Init
  10.697 +      obtain 
  10.698 +	hyp_init_super: 
  10.699 +        "PROP ?EqEval (Norm ((init_class_obj G C) s0)) s1
  10.700 +	               (In1r (if C = Object then Skip else Init (super c))) \<diamondsuit>"
  10.701 +	and 
  10.702 +        hyp_init_c:
  10.703 +	   "PROP ?EqEval ((set_lvars empty) s1) s2 (In1r (init c)) \<diamondsuit>" and
  10.704 +	s3: "s3 = (set_lvars (locals (store s1))) s2"
  10.705 +	by (simp only: if_False)
  10.706 +      from conf_s0 wf cls_C False
  10.707 +      have conf_s0': "(Norm ((init_class_obj G C) s0))\<Colon>\<preceq>(G, L)"
  10.708 +	by (auto dest: conforms_init_class_obj)
  10.709 +      moreover
  10.710 +      from wf cls_C 
  10.711 +      have wt_init_super:
  10.712 +           "\<lparr>prg = G, cls = accC, lcl = L\<rparr>
  10.713 +                  \<turnstile>(if C = Object then Skip else Init (super c))\<Colon>\<surd>"
  10.714 +	by (cases "C=Object")
  10.715 +           (auto dest: wf_prog_cdecl wf_cdecl_supD is_acc_classD)
  10.716 +      ultimately
  10.717 +      have eval_init_super: 
  10.718 +	   "G\<turnstile>Norm ((init_class_obj G C) s0) 
  10.719 +            \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1"
  10.720 +	by (rule hyp_init_super)
  10.721 +      with conf_s0' wt_init_super wf
  10.722 +      have "s1\<Colon>\<preceq>(G, L)"
  10.723 +	by (blast dest: eval_type_sound)
  10.724 +      then
  10.725 +      have "(set_lvars empty) s1\<Colon>\<preceq>(G, empty)"
  10.726 +	by (cases s1) (auto dest: conforms_set_locals )
  10.727 +      with wf cls_C 
  10.728 +      have eval_init_c: "G\<turnstile>(set_lvars empty) s1 \<midarrow>init c\<rightarrow> s2"
  10.729 +	by (auto intro!: hyp_init_c dest: wf_prog_cdecl wf_cdecl_wt_init)
  10.730 +      from False eval_init_super eval_init_c s3
  10.731 +      show ?thesis
  10.732 +	by simp
  10.733 +    qed
  10.734 +    from cls this
  10.735 +    show ?case
  10.736 +      by (rule eval.Init)
  10.737 +  qed 
  10.738 +qed
  10.739 +
  10.740 +lemma Suc_le_D_lemma: "\<lbrakk>Suc n <= m'; (\<And>m. n <= m \<Longrightarrow> P (Suc m)) \<rbrakk> \<Longrightarrow> P m'"
  10.741 +apply (frule Suc_le_D)
  10.742 +apply fast
  10.743 +done
  10.744 +
  10.745 +lemma evaln_nonstrict [rule_format (no_asm), elim]: 
  10.746 +  "\<And>ws. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> ws \<Longrightarrow> \<forall>m. n\<le>m \<longrightarrow> G\<turnstile>s \<midarrow>t\<succ>\<midarrow>m\<rightarrow> ws"
  10.747 +apply (simp (no_asm_simp) only: split_tupled_all)
  10.748 +apply (erule evaln.induct)
  10.749 +apply (tactic {* ALLGOALS (EVERY'[strip_tac, TRY o etac (thm "Suc_le_D_lemma"),
  10.750 +  REPEAT o smp_tac 1, 
  10.751 +  resolve_tac (thms "evaln.intros") THEN_ALL_NEW TRY o atac]) *})
  10.752 +(* 3 subgoals *)
  10.753 +apply (auto split del: split_if)
  10.754 +done
  10.755 +
  10.756 +lemmas evaln_nonstrict_Suc = evaln_nonstrict [OF _ le_refl [THEN le_SucI]]
  10.757 +
  10.758 +lemma evaln_max2: "\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> ws1; G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> ws2\<rbrakk> \<Longrightarrow> 
  10.759 +             G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max n1 n2\<rightarrow> ws1 \<and> G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max n1 n2\<rightarrow> ws2"
  10.760 +apply (fast intro: le_maxI1 le_maxI2)
  10.761 +done
  10.762 +
  10.763 +lemma evaln_max3: 
  10.764 +"\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> ws1; G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> ws2; G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>n3\<rightarrow> ws3\<rbrakk> \<Longrightarrow>
  10.765 + G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws1 \<and>
  10.766 + G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws2 \<and> 
  10.767 + G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> ws3"
  10.768 +apply (drule (1) evaln_max2, erule thin_rl)
  10.769 +apply (fast intro!: le_maxI1 le_maxI2)
  10.770 +done
  10.771 +
  10.772 +lemma le_max3I1: "(n2::nat) \<le> max n1 (max n2 n3)"
  10.773 +proof -
  10.774 +  have "n2 \<le> max n2 n3"
  10.775 +    by (rule le_maxI1)
  10.776 +  also
  10.777 +  have "max n2 n3 \<le> max n1 (max n2 n3)"
  10.778 +    by (rule le_maxI2)
  10.779 +  finally
  10.780 +  show ?thesis .
  10.781 +qed
  10.782 +
  10.783 +lemma le_max3I2: "(n3::nat) \<le> max n1 (max n2 n3)"
  10.784 +proof -
  10.785 +  have "n3 \<le> max n2 n3"
  10.786 +    by (rule le_maxI2)
  10.787 +  also
  10.788 +  have "max n2 n3 \<le> max n1 (max n2 n3)"
  10.789 +    by (rule le_maxI2)
  10.790 +  finally
  10.791 +  show ?thesis .
  10.792 +qed
  10.793 +
  10.794 +
  10.795 +lemma eval_evaln: 
  10.796 + (assumes eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)" and
  10.797 +          wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T" and  
  10.798 +     conf_s0: "s0\<Colon>\<preceq>(G, L)" and
  10.799 +          wf: "wf_prog G"  
  10.800 + )  "\<exists>n. G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)"
  10.801 +proof -
  10.802 +  from eval 
  10.803 +  show "\<And> L accC T. \<lbrakk>s0\<Colon>\<preceq>(G, L);\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T\<rbrakk>
  10.804 +                     \<Longrightarrow> \<exists> n. G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)"
  10.805 +       (is "PROP ?EqEval s0 s1 t v")
  10.806 +  proof (induct)
  10.807 +    case (Abrupt s t xc L accC T)
  10.808 +    obtain n where
  10.809 +      "G\<turnstile>(Some xc, s) \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (arbitrary3 t, Some xc, s)"
  10.810 +      by (rules intro: evaln.Abrupt)
  10.811 +    then show ?case ..
  10.812 +  next
  10.813 +    case Skip
  10.814 +    show ?case by (blast intro: evaln.Skip)
  10.815 +  next
  10.816 +    case (Expr e s0 s1 v L accC T)
  10.817 +    then obtain n where
  10.818 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
  10.819 +      by (rules elim!: wt_elim_cases)
  10.820 +    then have "G\<turnstile>Norm s0 \<midarrow>Expr e\<midarrow>n\<rightarrow> s1"
  10.821 +      by (rule evaln.Expr) 
  10.822 +    then show ?case ..
  10.823 +  next
  10.824 +    case (Lab c l s0 s1 L accC T)
  10.825 +    then obtain n where
  10.826 +      "G\<turnstile>Norm s0 \<midarrow>c\<midarrow>n\<rightarrow> s1"
  10.827 +      by (rules elim!: wt_elim_cases)
  10.828 +    then have "G\<turnstile>Norm s0 \<midarrow>l\<bullet> c\<midarrow>n\<rightarrow> abupd (absorb (Break l)) s1"
  10.829 +      by (rule evaln.Lab)
  10.830 +    then show ?case ..
  10.831 +  next
  10.832 +    case (Comp c1 c2 s0 s1 s2 L accC T)
  10.833 +    with wf obtain n1 n2 where
  10.834 +      "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> s1"
  10.835 +      "G\<turnstile>s1 \<midarrow>c2\<midarrow>n2\<rightarrow> s2"
  10.836 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
  10.837 +    then have "G\<turnstile>Norm s0 \<midarrow>c1;; c2\<midarrow>max n1 n2\<rightarrow> s2"
  10.838 +      by (blast intro: evaln.Comp dest: evaln_max2 )
  10.839 +    then show ?case ..
  10.840 +  next
  10.841 +    case (If b c1 c2 e s0 s1 s2 L accC T)
  10.842 +    with wf obtain
  10.843 +      "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean"
  10.844 +      "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>(if the_Bool b then c1 else c2)\<Colon>\<surd>"
  10.845 +      by (cases "the_Bool b") (auto elim!: wt_elim_cases)
  10.846 +    with If wf obtain n1 n2 where
  10.847 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n1\<rightarrow> s1"
  10.848 +      "G\<turnstile>s1 \<midarrow>(if the_Bool b then c1 else c2)\<midarrow>n2\<rightarrow> s2"
  10.849 +      by (blast dest: eval_type_sound)
  10.850 +    then have "G\<turnstile>Norm s0 \<midarrow>If(e) c1 Else c2\<midarrow>max n1 n2\<rightarrow> s2"
  10.851 +      by (blast intro: evaln.If dest: evaln_max2)
  10.852 +    then show ?case ..
  10.853 +  next
  10.854 +    case (Loop b c e l s0 s1 s2 s3 L accC T)
  10.855 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1" .
  10.856 +    have hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 b)" .
  10.857 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.858 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (l\<bullet> While(e) c)\<Colon>T" .
  10.859 +    then obtain wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
  10.860 +                wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
  10.861 +      by (rule wt_elim_cases) (blast)
  10.862 +    from conf_s0 wt_e 
  10.863 +    obtain n1 where
  10.864 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n1\<rightarrow> s1"
  10.865 +      by (rules dest: hyp_e)
  10.866 +    moreover
  10.867 +    from eval_e wt_e conf_s0 wf
  10.868 +    have conf_s1: "s1\<Colon>\<preceq>(G, L)"
  10.869 +      by (rules dest: eval_type_sound)
  10.870 +    obtain n2 where
  10.871 +      "if normal s1 \<and> the_Bool b 
  10.872 +             then (G\<turnstile>s1 \<midarrow>c\<midarrow>n2\<rightarrow> s2 \<and> 
  10.873 +                   G\<turnstile>(abupd (absorb (Cont l)) s2)\<midarrow>l\<bullet> While(e) c\<midarrow>n2\<rightarrow> s3)
  10.874 +	     else s3 = s1"
  10.875 +    proof (cases "normal s1 \<and> the_Bool b")
  10.876 +      case True
  10.877 +      from Loop True have hyp_c: "PROP ?EqEval s1 s2 (In1r c) \<diamondsuit>"
  10.878 +	by (auto)
  10.879 +      from Loop True have hyp_w: "PROP ?EqEval (abupd (absorb (Cont l)) s2)
  10.880 +                                        s3 (In1r (l\<bullet> While(e) c)) \<diamondsuit>"
  10.881 +	by (auto)
  10.882 +      from Loop True have eval_c: "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2"
  10.883 +	by simp
  10.884 +      from conf_s1 wt_c
  10.885 +      obtain m1 where 
  10.886 +	evaln_c: "G\<turnstile>s1 \<midarrow>c\<midarrow>m1\<rightarrow> s2"
  10.887 +	by (rules dest: hyp_c)
  10.888 +      moreover
  10.889 +      from eval_c conf_s1 wt_c wf
  10.890 +      have "s2\<Colon>\<preceq>(G, L)"
  10.891 +	by (rules dest: eval_type_sound)
  10.892 +      then
  10.893 +      have "abupd (absorb (Cont l)) s2 \<Colon>\<preceq>(G, L)"
  10.894 +	by (cases s2) (auto intro: conforms_absorb)
  10.895 +      from this and wt
  10.896 +      obtain m2 where 
  10.897 +	"G\<turnstile>abupd (absorb (Cont l)) s2 \<midarrow>l\<bullet> While(e) c\<midarrow>m2\<rightarrow> s3"
  10.898 +	by (blast dest: hyp_w)
  10.899 +      moreover note True and that
  10.900 +      ultimately show ?thesis
  10.901 +	by simp (rules intro: evaln_nonstrict le_maxI1 le_maxI2)
  10.902 +    next
  10.903 +      case False
  10.904 +      with Loop have "s3 = s1"
  10.905 +	by simp
  10.906 +      with False that
  10.907 +      show ?thesis
  10.908 +	by auto 
  10.909 +    qed
  10.910 +    ultimately
  10.911 +    have "G\<turnstile>Norm s0 \<midarrow>l\<bullet> While(e) c\<midarrow>max n1 n2\<rightarrow> s3"
  10.912 +      apply -
  10.913 +      apply (rule evaln.Loop)
  10.914 +      apply   (rules intro: evaln_nonstrict intro: le_maxI1)
  10.915 +
  10.916 +      apply   (auto intro: evaln_nonstrict intro: le_maxI2)
  10.917 +      done
  10.918 +    then show ?case ..
  10.919 +  next
  10.920 +    case (Do j s L accC T)
  10.921 +    have "G\<turnstile>Norm s \<midarrow>Do j\<midarrow>n\<rightarrow> (Some (Jump j), s)"
  10.922 +      by (rule evaln.Do)
  10.923 +    then show ?case ..
  10.924 +  next
  10.925 +    case (Throw a e s0 s1 L accC T)
  10.926 +    then obtain n where
  10.927 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s1"
  10.928 +      by (rules elim!: wt_elim_cases)
  10.929 +    then have "G\<turnstile>Norm s0 \<midarrow>Throw e\<midarrow>n\<rightarrow> abupd (throw a) s1"
  10.930 +      by (rule evaln.Throw)
  10.931 +    then show ?case ..
  10.932 +  next 
  10.933 +    case (Try catchC c1 c2 s0 s1 s2 s3 vn L accC T)
  10.934 +    have  hyp_c1: "PROP ?EqEval (Norm s0) s1 (In1r c1) \<diamondsuit>" .
  10.935 +    have eval_c1: "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1" .
  10.936 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
  10.937 +    have      wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>In1r (Try c1 Catch(catchC vn) c2)\<Colon>T" .
  10.938 +    then obtain 
  10.939 +      wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  10.940 +      wt_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<lparr>lcl := L(VName vn\<mapsto>Class catchC)\<rparr>\<turnstile>c2\<Colon>\<surd>"
  10.941 +      by (rule wt_elim_cases) (auto)
  10.942 +    from conf_s0 wt_c1
  10.943 +    obtain n1 where
  10.944 +      "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> s1"
  10.945 +      by (blast dest: hyp_c1)
  10.946 +    moreover 
  10.947 +    have sxalloc: "G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2" .
  10.948 +    moreover
  10.949 +    from eval_c1 wt_c1 conf_s0 wf
  10.950 +    have "s1\<Colon>\<preceq>(G, L)"
  10.951 +      by (blast dest: eval_type_sound)
  10.952 +    with sxalloc wf
  10.953 +    have conf_s2: "s2\<Colon>\<preceq>(G, L)" 
  10.954 +      by (auto dest: sxalloc_type_sound split: option.splits)
  10.955 +    obtain n2 where
  10.956 +      "if G,s2\<turnstile>catch catchC then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>n2\<rightarrow> s3 else s3 = s2"
  10.957 +    proof (cases "G,s2\<turnstile>catch catchC")
  10.958 +      case True
  10.959 +      note Catch = this
  10.960 +      with Try have hyp_c2: "PROP ?EqEval (new_xcpt_var vn s2) s3 (In1r c2) \<diamondsuit>"
  10.961 +	by auto
  10.962 +      show ?thesis
  10.963 +      proof (cases "normal s1")
  10.964 +	case True
  10.965 +	with sxalloc wf 
  10.966 +	have eq_s2_s1: "s2=s1"
  10.967 +	  by (auto dest: sxalloc_type_sound split: option.splits)
  10.968 +	with True 
  10.969 +	have "\<not>  G,s2\<turnstile>catch catchC"
  10.970 +	  by (simp add: catch_def)
  10.971 +	with Catch show ?thesis 
  10.972 +	  by (contradiction)
  10.973 +      next 
  10.974 +	case False
  10.975 +	with sxalloc wf
  10.976 +	obtain a 
  10.977 +	  where xcpt_s2: "abrupt s2 = Some (Xcpt (Loc a))"
  10.978 +	  by (auto dest!: sxalloc_type_sound split: option.splits)
  10.979 +	with Catch
  10.980 +	have "G\<turnstile>obj_ty (the (globs (store s2) (Heap a)))\<preceq>Class catchC"
  10.981 +	  by (cases s2) simp
  10.982 +	with xcpt_s2 conf_s2 wf 
  10.983 +	have "new_xcpt_var vn s2\<Colon>\<preceq>(G, L(VName vn\<mapsto>Class catchC))"
  10.984 +	  by (auto dest: Try_lemma)
  10.985 +	(* FIXME extract lemma for this conformance, also usefull for
  10.986 +               eval_type_sound and evaln_eval *)
  10.987 +	from this wt_c2
  10.988 +	obtain m where "G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>m\<rightarrow> s3"
  10.989 +	  by (auto dest: hyp_c2)
  10.990 +	with True that
  10.991 +	show ?thesis
  10.992 +	  by simp
  10.993 +      qed
  10.994 +    next
  10.995 +      case False
  10.996 +      with Try
  10.997 +      have "s3=s2"
  10.998 +	by simp
  10.999 +      with False and that
 10.1000 +      show ?thesis
 10.1001 +	by simp
 10.1002 +    qed
 10.1003 +    ultimately
 10.1004 +    have "G\<turnstile>Norm s0 \<midarrow>Try c1 Catch(catchC vn) c2\<midarrow>max n1 n2\<rightarrow> s3"
 10.1005 +      by (auto intro!: evaln.Try le_maxI1 le_maxI2)
 10.1006 +    then show ?case ..
 10.1007 +  next
 10.1008 +    case (Fin c1 c2 s0 s1 s2 x1 L accC T)
 10.1009 +    with wf obtain n1 n2 where 
 10.1010 +      "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> (x1, s1)"
 10.1011 +      "G\<turnstile>Norm s1 \<midarrow>c2\<midarrow>n2\<rightarrow> s2"
 10.1012 +      by (blast elim!: wt_elim_cases 
 10.1013 +	         dest: eval_type_sound intro: conforms_NormI)
 10.1014 +    then have 
 10.1015 +     "G\<turnstile>Norm s0 \<midarrow>c1 Finally c2\<midarrow>max n1 n2\<rightarrow> abupd (abrupt_if (x1 \<noteq> None) x1) s2"
 10.1016 +      by (blast intro: evaln.Fin dest: evaln_max2)
 10.1017 +    then show ?case ..
 10.1018 +  next
 10.1019 +    case (Init C c s0 s1 s2 s3 L accC T)
 10.1020 +    have     cls: "the (class G C) = c" .
 10.1021 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 10.1022 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (Init C)\<Colon>T" .
 10.1023 +    with cls
 10.1024 +    have cls_C: "class G C = Some c"
 10.1025 +      by - (erule wt_elim_cases,auto)
 10.1026 +    obtain n where
 10.1027 +      "if inited C (globs s0) then s3 = Norm s0
 10.1028 +       else (G\<turnstile>Norm (init_class_obj G C s0)
 10.1029 +	      \<midarrow>(if C = Object then Skip else Init (super c))\<midarrow>n\<rightarrow> s1 \<and>
 10.1030 +	           G\<turnstile>set_lvars empty s1 \<midarrow>init c\<midarrow>n\<rightarrow> s2 \<and> 
 10.1031 +                   s3 = restore_lvars s1 s2)"
 10.1032 +    proof (cases "inited C (globs s0)")
 10.1033 +      case True
 10.1034 +      with Init have "s3 = Norm s0"
 10.1035 +	by simp
 10.1036 +      with True that show ?thesis 
 10.1037 +	by simp
 10.1038 +    next
 10.1039 +      case False
 10.1040 +      with Init
 10.1041 +      obtain 
 10.1042 +	hyp_init_super: 
 10.1043 +        "PROP ?EqEval (Norm ((init_class_obj G C) s0)) s1
 10.1044 +	               (In1r (if C = Object then Skip else Init (super c))) \<diamondsuit>"
 10.1045 +	and 
 10.1046 +        hyp_init_c:
 10.1047 +	   "PROP ?EqEval ((set_lvars empty) s1) s2 (In1r (init c)) \<diamondsuit>" and
 10.1048 +	s3: "s3 = (set_lvars (locals (store s1))) s2" and
 10.1049 +	eval_init_super: 
 10.1050 +	"G\<turnstile>Norm ((init_class_obj G C) s0) 
 10.1051 +           \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1"
 10.1052 +	by (simp only: if_False)
 10.1053 +      from conf_s0 wf cls_C False
 10.1054 +      have conf_s0': "(Norm ((init_class_obj G C) s0))\<Colon>\<preceq>(G, L)"
 10.1055 +	by (auto dest: conforms_init_class_obj)
 10.1056 +      moreover
 10.1057 +      from wf cls_C 
 10.1058 +      have wt_init_super:
 10.1059 +           "\<lparr>prg = G, cls = accC, lcl = L\<rparr>
 10.1060 +                  \<turnstile>(if C = Object then Skip else Init (super c))\<Colon>\<surd>"
 10.1061 +	by (cases "C=Object")
 10.1062 +           (auto dest: wf_prog_cdecl wf_cdecl_supD is_acc_classD)
 10.1063 +      ultimately
 10.1064 +      obtain m1 where  
 10.1065 +	   "G\<turnstile>Norm ((init_class_obj G C) s0) 
 10.1066 +            \<midarrow>(if C = Object then Skip else Init (super c))\<midarrow>m1\<rightarrow> s1"
 10.1067 +	by (rules dest: hyp_init_super)
 10.1068 +      moreover
 10.1069 +      from eval_init_super conf_s0' wt_init_super wf
 10.1070 +      have "s1\<Colon>\<preceq>(G, L)"
 10.1071 +	by (rules dest: eval_type_sound)
 10.1072 +      then
 10.1073 +      have "(set_lvars empty) s1\<Colon>\<preceq>(G, empty)"
 10.1074 +	by (cases s1) (auto dest: conforms_set_locals )
 10.1075 +      with wf cls_C 
 10.1076 +      obtain m2 where
 10.1077 +	"G\<turnstile>(set_lvars empty) s1 \<midarrow>init c\<midarrow>m2\<rightarrow> s2"
 10.1078 +	by (blast dest!: hyp_init_c 
 10.1079 +                   dest: wf_prog_cdecl intro!: wf_cdecl_wt_init)
 10.1080 +      moreover note s3 and False and that
 10.1081 +      ultimately show ?thesis
 10.1082 +	by simp (rules intro: evaln_nonstrict le_maxI1 le_maxI2)
 10.1083 +    qed
 10.1084 +    from cls this have "G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s3"
 10.1085 +      by (rule evaln.Init)
 10.1086 +    then show ?case ..
 10.1087 +  next
 10.1088 +    case (NewC C a s0 s1 s2 L accC T)
 10.1089 +    with wf obtain n where 
 10.1090 +     "G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s1"
 10.1091 +      by (blast elim!: wt_elim_cases dest: is_acc_classD)
 10.1092 +    with NewC 
 10.1093 +    have "G\<turnstile>Norm s0 \<midarrow>NewC C-\<succ>Addr a\<midarrow>n\<rightarrow> s2"
 10.1094 +      by (rules intro: evaln.NewC)
 10.1095 +    then show ?case ..
 10.1096 +  next
 10.1097 +    case (NewA T a e i s0 s1 s2 s3 L accC Ta)
 10.1098 +    hence "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>init_comp_ty T\<Colon>\<surd>" 
 10.1099 +      by (auto elim!: wt_elim_cases 
 10.1100 +              intro!: wt_init_comp_ty dest: is_acc_typeD)
 10.1101 +    with NewA wf obtain n1 n2 where 
 10.1102 +      "G\<turnstile>Norm s0 \<midarrow>init_comp_ty T\<midarrow>n1\<rightarrow> s1"
 10.1103 +      "G\<turnstile>s1 \<midarrow>e-\<succ>i\<midarrow>n2\<rightarrow> s2"      
 10.1104 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
 10.1105 +    moreover
 10.1106 +    have "G\<turnstile>abupd (check_neg i) s2 \<midarrow>halloc Arr T (the_Intg i)\<succ>a\<rightarrow> s3" .
 10.1107 +    ultimately
 10.1108 +    have "G\<turnstile>Norm s0 \<midarrow>New T[e]-\<succ>Addr a\<midarrow>max n1 n2\<rightarrow> s3"
 10.1109 +      by (blast intro: evaln.NewA dest: evaln_max2)
 10.1110 +    then show ?case ..
 10.1111 +  next
 10.1112 +    case (Cast castT e s0 s1 s2 v L accC T)
 10.1113 +    with wf obtain n where
 10.1114 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
 10.1115 +      by (rules elim!: wt_elim_cases)
 10.1116 +    moreover 
 10.1117 +    have "s2 = abupd (raise_if (\<not> G,snd s1\<turnstile>v fits castT) ClassCast) s1" .
 10.1118 +    ultimately
 10.1119 +    have "G\<turnstile>Norm s0 \<midarrow>Cast castT e-\<succ>v\<midarrow>n\<rightarrow> s2"
 10.1120 +      by (rule evaln.Cast)
 10.1121 +    then show ?case ..
 10.1122 +  next
 10.1123 +    case (Inst T b e s0 s1 v L accC T')
 10.1124 +    with wf obtain n where
 10.1125 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
 10.1126 +      by (rules elim!: wt_elim_cases)
 10.1127 +    moreover 
 10.1128 +    have "b = (v \<noteq> Null \<and> G,snd s1\<turnstile>v fits RefT T)" .
 10.1129 +    ultimately
 10.1130 +    have "G\<turnstile>Norm s0 \<midarrow>e InstOf T-\<succ>Bool b\<midarrow>n\<rightarrow> s1"
 10.1131 +      by (rule evaln.Inst)
 10.1132 +    then show ?case ..
 10.1133 +  next
 10.1134 +    case (Lit s v L accC T)
 10.1135 +    have "G\<turnstile>Norm s \<midarrow>Lit v-\<succ>v\<midarrow>n\<rightarrow> Norm s"
 10.1136 +      by (rule evaln.Lit)
 10.1137 +    then show ?case ..
 10.1138 +  next
 10.1139 +    case (Super s L accC T)
 10.1140 +    have "G\<turnstile>Norm s \<midarrow>Super-\<succ>val_this s\<midarrow>n\<rightarrow> Norm s"
 10.1141 +      by (rule evaln.Super)
 10.1142 +    then show ?case ..
 10.1143 +  next
 10.1144 +    case (Acc f s0 s1 v va L accC T)
 10.1145 +    with wf obtain n where
 10.1146 +      "G\<turnstile>Norm s0 \<midarrow>va=\<succ>(v, f)\<midarrow>n\<rightarrow> s1"
 10.1147 +      by (rules elim!: wt_elim_cases)
 10.1148 +    then
 10.1149 +    have "G\<turnstile>Norm s0 \<midarrow>Acc va-\<succ>v\<midarrow>n\<rightarrow> s1"
 10.1150 +      by (rule evaln.Acc)
 10.1151 +    then show ?case ..
 10.1152 +  next
 10.1153 +    case (Ass e f s0 s1 s2 v var w L accC T)
 10.1154 +    with wf obtain n1 n2 where 
 10.1155 +      "G\<turnstile>Norm s0 \<midarrow>var=\<succ>(w, f)\<midarrow>n1\<rightarrow> s1"
 10.1156 +      "G\<turnstile>s1 \<midarrow>e-\<succ>v\<midarrow>n2\<rightarrow> s2"      
 10.1157 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
 10.1158 +    then
 10.1159 +    have "G\<turnstile>Norm s0 \<midarrow>var:=e-\<succ>v\<midarrow>max n1 n2\<rightarrow> assign f v s2"
 10.1160 +      by (blast intro: evaln.Ass dest: evaln_max2)
 10.1161 +    then show ?case ..
 10.1162 +  next
 10.1163 +    case (Cond b e0 e1 e2 s0 s1 s2 v L accC T)
 10.1164 +    have hyp_e0: "PROP ?EqEval (Norm s0) s1 (In1l e0) (In1 b)" .
 10.1165 +    have hyp_if: "PROP ?EqEval s1 s2 
 10.1166 +                              (In1l (if the_Bool b then e1 else e2)) (In1 v)" .
 10.1167 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 10.1168 +    have wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (e0 ? e1 : e2)\<Colon>T" .
 10.1169 +    then obtain T1 T2 statT where
 10.1170 +       wt_e0: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e0\<Colon>-PrimT Boolean" and
 10.1171 +       wt_e1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e1\<Colon>-T1" and
 10.1172 +       wt_e2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e2\<Colon>-T2" and 
 10.1173 +       statT: "G\<turnstile>T1\<preceq>T2 \<and> statT = T2  \<or>  G\<turnstile>T2\<preceq>T1 \<and> statT =  T1" and
 10.1174 +       T    : "T=Inl statT"
 10.1175 +      by (rule wt_elim_cases) auto
 10.1176 +    have eval_e0: "G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<rightarrow> s1" .
 10.1177 +    from conf_s0 wt_e0
 10.1178 +    obtain n1 where 
 10.1179 +      "G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<midarrow>n1\<rightarrow> s1"
 10.1180 +      by (rules dest: hyp_e0)
 10.1181 +    moreover
 10.1182 +    from eval_e0 conf_s0 wf wt_e0
 10.1183 +    have "s1\<Colon>\<preceq>(G, L)"
 10.1184 +      by (blast dest: eval_type_sound)
 10.1185 +    with wt_e1 wt_e2 statT hyp_if obtain n2 where
 10.1186 +      "G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<midarrow>n2\<rightarrow> s2"
 10.1187 +      by  (cases "the_Bool b") force+
 10.1188 +    ultimately
 10.1189 +    have "G\<turnstile>Norm s0 \<midarrow>e0 ? e1 : e2-\<succ>v\<midarrow>max n1 n2\<rightarrow> s2"
 10.1190 +      by (blast intro: evaln.Cond dest: evaln_max2)
 10.1191 +    then show ?case ..
 10.1192 +  next
 10.1193 +    case (Call invDeclC a' accC' args e mn mode pTs' s0 s1 s2 s3 s3' s4 statT 
 10.1194 +      v vs L accC T)
 10.1195 +    (* Repeats large parts of the type soundness proof. One should factor
 10.1196 +       out some lemmata about the relations and conformance of s2, s3 and s3'*)
 10.1197 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1" .
 10.1198 +    have eval_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2" .
 10.1199 +    have invDeclC: "invDeclC 
 10.1200 +                      = invocation_declclass G mode (store s2) a' statT 
 10.1201 +                           \<lparr>name = mn, parTs = pTs'\<rparr>" .
 10.1202 +    have
 10.1203 +      init_lvars: "s3 = 
 10.1204 +             init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2" .
 10.1205 +    have
 10.1206 +      check: "s3' =
 10.1207 +       check_method_access G accC' statT mode \<lparr>name = mn, parTs = pTs'\<rparr> a' s3" .
 10.1208 +    have eval_methd: 
 10.1209 +           "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<rightarrow> s4" .
 10.1210 +    have     hyp_e: "PROP ?EqEval (Norm s0) s1 (In1l e) (In1 a')" .
 10.1211 +    have  hyp_args: "PROP ?EqEval s1 s2 (In3 args) (In3 vs)" .
 10.1212 +    have hyp_methd: "PROP ?EqEval s3' s4 
 10.1213 +                     (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)) (In1 v)".
 10.1214 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 10.1215 +    have      wt: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>
 10.1216 +                    \<turnstile>In1l ({accC',statT,mode}e\<cdot>mn( {pTs'}args))\<Colon>T" .
 10.1217 +    from wt obtain pTs statDeclT statM where
 10.1218 +                 wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT" and
 10.1219 +              wt_args: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>args\<Colon>\<doteq>pTs" and
 10.1220 +                statM: "max_spec G accC statT \<lparr>name=mn,parTs=pTs\<rparr> 
 10.1221 +                         = {((statDeclT,statM),pTs')}" and
 10.1222 +                 mode: "mode = invmode statM e" and
 10.1223 +                    T: "T =Inl (resTy statM)" and
 10.1224 +        eq_accC_accC': "accC=accC'"
 10.1225 +      by (rule wt_elim_cases) auto
 10.1226 +    from conf_s0 wt_e
 10.1227 +    obtain n1 where
 10.1228 +      evaln_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<midarrow>n1\<rightarrow> s1"
 10.1229 +      by (rules dest: hyp_e)
 10.1230 +    from wf eval_e conf_s0 wt_e
 10.1231 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and
 10.1232 +           conf_a': "normal s1 \<Longrightarrow> G, store s1\<turnstile>a'\<Colon>\<preceq>RefT statT"  
 10.1233 +      by (auto dest!: eval_type_sound)
 10.1234 +    from conf_s1 wt_args
 10.1235 +    obtain n2 where
 10.1236 +      evaln_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<midarrow>n2\<rightarrow> s2"
 10.1237 +      by (blast dest: hyp_args)
 10.1238 +    from wt_args conf_s1 eval_args wf 
 10.1239 +    obtain    conf_s2: "s2\<Colon>\<preceq>(G, L)" and
 10.1240 +            conf_args: "normal s2 
 10.1241 +                         \<Longrightarrow>  list_all2 (conf G (store s2)) vs pTs"  
 10.1242 +      by (auto dest!: eval_type_sound)
 10.1243 +    from statM 
 10.1244 +    obtain
 10.1245 +       statM': "(statDeclT,statM)\<in>mheads G accC statT \<lparr>name=mn,parTs=pTs'\<rparr>" and
 10.1246 +       pTs_widen: "G\<turnstile>pTs[\<preceq>]pTs'"
 10.1247 +      by (blast dest: max_spec2mheads)
 10.1248 +    from check
 10.1249 +    have eq_store_s3'_s3: "store s3'=store s3"
 10.1250 +      by (cases s3) (simp add: check_method_access_def Let_def)
 10.1251 +    obtain invC
 10.1252 +      where invC: "invC = invocation_class mode (store s2) a' statT"
 10.1253 +      by simp
 10.1254 +    with init_lvars
 10.1255 +    have invC': "invC = (invocation_class mode (store s3) a' statT)"
 10.1256 +      by (cases s2,cases mode) (auto simp add: init_lvars_def2 )
 10.1257 +    obtain n3 where
 10.1258 +     "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>n3\<rightarrow> 
 10.1259 +          (set_lvars (locals (store s2))) s4"
 10.1260 +    proof (cases "normal s2")
 10.1261 +      case False
 10.1262 +      with init_lvars 
 10.1263 +      obtain keep_abrupt: "abrupt s3 = abrupt s2" and
 10.1264 +             "store s3 = store (init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> 
 10.1265 +                                            mode a' vs s2)" 
 10.1266 +	by (auto simp add: init_lvars_def2)
 10.1267 +      moreover
 10.1268 +      from keep_abrupt False check
 10.1269 +      have eq_s3'_s3: "s3'=s3" 
 10.1270 +	by (auto simp add: check_method_access_def Let_def)
 10.1271 +      moreover
 10.1272 +      from eq_s3'_s3 False keep_abrupt eval_methd init_lvars
 10.1273 +      obtain "s4=s3'"
 10.1274 +	 "In1 v=arbitrary3 (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>))"
 10.1275 +	by auto
 10.1276 +      moreover note False evaln.Abrupt
 10.1277 +      ultimately obtain m where 
 10.1278 +	"G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<midarrow>m\<rightarrow> s4"
 10.1279 +	by force
 10.1280 +      from evaln_e evaln_args invDeclC init_lvars eq_s3'_s3 this
 10.1281 +      have 
 10.1282 +       "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>max n1 (max n2 m)\<rightarrow> 
 10.1283 +            (set_lvars (locals (store s2))) s4"
 10.1284 +	by (auto intro!: evaln.Call le_maxI1 le_max3I1 le_max3I2)
 10.1285 +      with that show ?thesis 
 10.1286 +	by rules
 10.1287 +    next
 10.1288 +      case True
 10.1289 +      note normal_s2 = True
 10.1290 +      with eval_args
 10.1291 +      have normal_s1: "normal s1"
 10.1292 +	by (cases "normal s1") auto
 10.1293 +      with conf_a' eval_args 
 10.1294 +      have conf_a'_s2: "G, store s2\<turnstile>a'\<Colon>\<preceq>RefT statT"
 10.1295 +	by (auto dest: eval_gext intro: conf_gext)
 10.1296 +      show ?thesis
 10.1297 +      proof (cases "a'=Null \<longrightarrow> is_static statM")
 10.1298 +	case False
 10.1299 +	then obtain not_static: "\<not> is_static statM" and Null: "a'=Null" 
 10.1300 +	  by blast
 10.1301 +	with normal_s2 init_lvars mode
 10.1302 +	obtain np: "abrupt s3 = Some (Xcpt (Std NullPointer))" and
 10.1303 +                   "store s3 = store (init_lvars G invDeclC 
 10.1304 +                                       \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2)"
 10.1305 +	  by (auto simp add: init_lvars_def2)
 10.1306 +	moreover
 10.1307 +	from np check
 10.1308 +	have eq_s3'_s3: "s3'=s3" 
 10.1309 +	  by (auto simp add: check_method_access_def Let_def)
 10.1310 +	moreover
 10.1311 +	from eq_s3'_s3 np eval_methd init_lvars
 10.1312 +	obtain "s4=s3'"
 10.1313 +	  "In1 v=arbitrary3 (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>))"
 10.1314 +	  by auto
 10.1315 +	moreover note np
 10.1316 +	ultimately obtain m where 
 10.1317 +	  "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<midarrow>m\<rightarrow> s4"
 10.1318 +	  by force
 10.1319 +	from evaln_e evaln_args invDeclC init_lvars eq_s3'_s3 this
 10.1320 +	have 
 10.1321 +        "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>max n1 (max n2 m)\<rightarrow> 
 10.1322 +            (set_lvars (locals (store s2))) s4"
 10.1323 +	  by (auto intro!: evaln.Call le_maxI1 le_max3I1 le_max3I2)
 10.1324 +	with that show ?thesis 
 10.1325 +	  by rules
 10.1326 +      next
 10.1327 +	case True
 10.1328 +	with mode have notNull: "mode = IntVir \<longrightarrow> a' \<noteq> Null"
 10.1329 +	  by (auto dest!: Null_staticD)
 10.1330 +	with conf_s2 conf_a'_s2 wf invC 
 10.1331 +	have dynT_prop: "G\<turnstile>mode\<rightarrow>invC\<preceq>statT"
 10.1332 +	  by (cases s2) (auto intro: DynT_propI)
 10.1333 +	with wt_e statM' invC mode wf 
 10.1334 +	obtain dynM where 
 10.1335 +           dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
 10.1336 +           acc_dynM: "G \<turnstile>Methd  \<lparr>name=mn,parTs=pTs'\<rparr> dynM 
 10.1337 +                          in invC dyn_accessible_from accC"
 10.1338 +	  by (force dest!: call_access_ok)
 10.1339 +	with invC' check eq_accC_accC'
 10.1340 +	have eq_s3'_s3: "s3'=s3"
 10.1341 +	  by (auto simp add: check_method_access_def Let_def)
 10.1342 +	from dynT_prop wf wt_e statM' mode invC invDeclC dynM 
 10.1343 +	obtain 
 10.1344 +	   wf_dynM: "wf_mdecl G invDeclC (\<lparr>name=mn,parTs=pTs'\<rparr>,mthd dynM)" and
 10.1345 +	     dynM': "methd G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
 10.1346 +           iscls_invDeclC: "is_class G invDeclC" and
 10.1347 +	        invDeclC': "invDeclC = declclass dynM" and
 10.1348 +	     invC_widen: "G\<turnstile>invC\<preceq>\<^sub>C invDeclC" and
 10.1349 +	   is_static_eq: "is_static dynM = is_static statM" and
 10.1350 +	   involved_classes_prop:
 10.1351 +             "(if invmode statM e = IntVir
 10.1352 +               then \<forall>statC. statT = ClassT statC \<longrightarrow> G\<turnstile>invC\<preceq>\<^sub>C statC
 10.1353 +               else ((\<exists>statC. statT = ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C invDeclC) \<or>
 10.1354 +                     (\<forall>statC. statT \<noteq> ClassT statC \<and> invDeclC = Object)) \<and>
 10.1355 +                      statDeclT = ClassT invDeclC)"
 10.1356 +	  by (auto dest: DynT_mheadsD)
 10.1357 +	obtain L' where 
 10.1358 +	   L':"L'=(\<lambda> k. 
 10.1359 +                 (case k of
 10.1360 +                    EName e
 10.1361 +                    \<Rightarrow> (case e of 
 10.1362 +                          VNam v 
 10.1363 +                          \<Rightarrow>(table_of (lcls (mbody (mthd dynM)))
 10.1364 +                             (pars (mthd dynM)[\<mapsto>]pTs')) v
 10.1365 +                        | Res \<Rightarrow> Some (resTy dynM))
 10.1366 +                  | This \<Rightarrow> if is_static statM 
 10.1367 +                            then None else Some (Class invDeclC)))"
 10.1368 +	  by simp
 10.1369 +	from wf_dynM [THEN wf_mdeclD1, THEN conjunct1] normal_s2 conf_s2 wt_e
 10.1370 +              wf eval_args conf_a' mode notNull wf_dynM involved_classes_prop
 10.1371 +	have conf_s3: "s3\<Colon>\<preceq>(G,L')"
 10.1372 +	   apply - 
 10.1373 +          (*FIXME confomrs_init_lvars should be 
 10.1374 +                adjusted to be more directy applicable *)
 10.1375 +	   apply (drule conforms_init_lvars [of G invDeclC 
 10.1376 +                  "\<lparr>name=mn,parTs=pTs'\<rparr>" dynM "store s2" vs pTs "abrupt s2" 
 10.1377 +                  L statT invC a' "(statDeclT,statM)" e])
 10.1378 +	     apply (rule wf)
 10.1379 +	     apply (rule conf_args,assumption)
 10.1380 +	     apply (simp add: pTs_widen)
 10.1381 +	     apply (cases s2,simp)
 10.1382 +	     apply (rule dynM')
 10.1383 +	     apply (force dest: ty_expr_is_type)
 10.1384 +	     apply (rule invC_widen)
 10.1385 +	     apply (force intro: conf_gext dest: eval_gext)
 10.1386 +	     apply simp
 10.1387 +	     apply simp
 10.1388 +	     apply (simp add: invC)
 10.1389 +	     apply (simp add: invDeclC)
 10.1390 +	     apply (force dest: wf_mdeclD1 is_acc_typeD)
 10.1391 +	     apply (cases s2, simp add: L' init_lvars
 10.1392 +	                      cong add: lname.case_cong ename.case_cong)
 10.1393 +	   done
 10.1394 +	with is_static_eq wf_dynM L'
 10.1395 +	obtain mthdT where
 10.1396 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
 10.1397 +            \<turnstile>Body invDeclC (stmt (mbody (mthd dynM)))\<Colon>-mthdT" 
 10.1398 +	  by - (drule wf_mdecl_bodyD,
 10.1399 +                simp cong add: lname.case_cong ename.case_cong)
 10.1400 +	with dynM' iscls_invDeclC invDeclC'
 10.1401 +	have
 10.1402 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
 10.1403 +            \<turnstile>(Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)\<Colon>-mthdT"
 10.1404 +	  by (auto intro: wt.Methd)
 10.1405 +	with conf_s3 eq_s3'_s3 hyp_methd
 10.1406 +	obtain m where
 10.1407 +	   "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<midarrow>m\<rightarrow> s4"
 10.1408 +	  by (blast)
 10.1409 +	from evaln_e evaln_args invDeclC init_lvars  eq_s3'_s3 this
 10.1410 +	have 
 10.1411 +        "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>max n1 (max n2 m)\<rightarrow> 
 10.1412 +            (set_lvars (locals (store s2))) s4"
 10.1413 +	  by (auto intro!: evaln.Call le_maxI1 le_max3I1 le_max3I2)
 10.1414 +	with that show ?thesis 
 10.1415 +	  by rules
 10.1416 +      qed
 10.1417 +    qed
 10.1418 +    then show ?case ..
 10.1419 +  next
 10.1420 +    case (Methd D s0 s1 sig v L accC T)
 10.1421 +    then obtain n where
 10.1422 +      "G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<midarrow>n\<rightarrow> s1"
 10.1423 +      by - (erule wt_elim_cases, force simp add: body_def2)
 10.1424 +    then have "G\<turnstile>Norm s0 \<midarrow>Methd D sig-\<succ>v\<midarrow>Suc n\<rightarrow> s1"
 10.1425 +      by (rule evaln.Methd)
 10.1426 +    then show ?case ..
 10.1427 +  next
 10.1428 +    case (Body D c s0 s1 s2 L accC T)
 10.1429 +    with wf obtain n1 n2 where 
 10.1430 +      "G\<turnstile>Norm s0 \<midarrow>Init D\<midarrow>n1\<rightarrow> s1"
 10.1431 +      "G\<turnstile>s1 \<midarrow>c\<midarrow>n2\<rightarrow> s2"
 10.1432 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
 10.1433 +    then have 
 10.1434 +     "G\<turnstile>Norm s0 \<midarrow>Body D c-\<succ>the (locals (store s2) Result)\<midarrow>max n1 n2
 10.1435 +       \<rightarrow> abupd (absorb Ret) s2"
 10.1436 +      by (blast intro: evaln.Body dest: evaln_max2)
 10.1437 +    then show ?case ..
 10.1438 +  next
 10.1439 +    case (LVar s vn L accC T)
 10.1440 +    obtain n where
 10.1441 +      "G\<turnstile>Norm s \<midarrow>LVar vn=\<succ>lvar vn s\<midarrow>n\<rightarrow> Norm s"
 10.1442 +      by (rules intro: evaln.LVar)
 10.1443 +    then show ?case ..
 10.1444 +  next
 10.1445 +    case (FVar a accC e fn s0 s1 s2 s2' s3 stat statDeclC v L accC' T)
 10.1446 +    have eval_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1" .
 10.1447 +    have eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2" .
 10.1448 +    have check: "s3 = check_field_access G accC statDeclC fn stat a s2'" .
 10.1449 +    have hyp_init: "PROP ?EqEval (Norm s0) s1 (In1r (Init statDeclC)) \<diamondsuit>" .
 10.1450 +    have hyp_e: "PROP ?EqEval s1 s2 (In1l e) (In1 a)" .
 10.1451 +    have fvar: "(v, s2') = fvar statDeclC stat fn a s2" .
 10.1452 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 10.1453 +    have wt: "\<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile>In2 ({accC,statDeclC,stat}e..fn)\<Colon>T" .
 10.1454 +    then obtain statC f where
 10.1455 +                wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
 10.1456 +            accfield: "accfield G accC statC fn = Some (statDeclC,f)" and
 10.1457 +                stat: "stat=is_static f" and
 10.1458 +               accC': "accC'=accC" and
 10.1459 +	           T: "T=(Inl (type f))"
 10.1460 +       by (rule wt_elim_cases) (auto simp add: member_is_static_simp)
 10.1461 +    from wf wt_e 
 10.1462 +    have iscls_statC: "is_class G statC"
 10.1463 +      by (auto dest: ty_expr_is_type type_is_class)
 10.1464 +    with wf accfield 
 10.1465 +    have iscls_statDeclC: "is_class G statDeclC"
 10.1466 +      by (auto dest!: accfield_fields dest: fields_declC)
 10.1467 +    then 
 10.1468 +    have wt_init: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>(Init statDeclC)\<Colon>\<surd>"
 10.1469 +      by simp
 10.1470 +    from conf_s0 wt_init
 10.1471 +    obtain n1 where
 10.1472 +      evaln_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<midarrow>n1\<rightarrow> s1"
 10.1473 +      by (rules dest: hyp_init)
 10.1474 +    from eval_init wt_init conf_s0 wf 
 10.1475 +    have conf_s1: "s1\<Colon>\<preceq>(G, L)"
 10.1476 +      by (blast dest: eval_type_sound)
 10.1477 +    with wt_e
 10.1478 +    obtain n2 where
 10.1479 +      evaln_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<midarrow>n2\<rightarrow> s2"
 10.1480 +      by (blast dest: hyp_e)
 10.1481 +    from eval_e wf conf_s1 wt_e
 10.1482 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and
 10.1483 +            conf_a: "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
 10.1484 +      by (auto dest!: eval_type_sound)
 10.1485 +    from accfield wt_e eval_init eval_e conf_s2 conf_a fvar stat check  wf
 10.1486 +    have eq_s3_s2': "s3=s2'"  
 10.1487 +      by (auto dest!: error_free_field_access)
 10.1488 +    with evaln_init evaln_e fvar accC'
 10.1489 +    have "G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>v\<midarrow>max n1 n2\<rightarrow> s3"
 10.1490 +      by (auto intro: evaln.FVar dest: evaln_max2)
 10.1491 +    then show ?case ..
 10.1492 +  next
 10.1493 +    case (AVar a e1 e2 i s0 s1 s2 s2' v L accC T)
 10.1494 +    with wf obtain n1 n2 where 
 10.1495 +      "G\<turnstile>Norm s0 \<midarrow>e1-\<succ>a\<midarrow>n1\<rightarrow> s1"
 10.1496 +      "G\<turnstile>s1 \<midarrow>e2-\<succ>i\<midarrow>n2\<rightarrow> s2"      
 10.1497 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
 10.1498 +    moreover 
 10.1499 +    have "(v, s2') = avar G i a s2" .
 10.1500 +    ultimately 
 10.1501 +    have "G\<turnstile>Norm s0 \<midarrow>e1.[e2]=\<succ>v\<midarrow>max n1 n2\<rightarrow> s2'"
 10.1502 +      by (blast intro!: evaln.AVar dest: evaln_max2)
 10.1503 +    then show ?case ..
 10.1504 +  next
 10.1505 +    case (Nil s0 L accC T)
 10.1506 +    show ?case by (rules intro: evaln.Nil)
 10.1507 +  next
 10.1508 +    case (Cons e es s0 s1 s2 v vs L accC T)
 10.1509 +    with wf obtain n1 n2 where 
 10.1510 +      "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n1\<rightarrow> s1"
 10.1511 +      "G\<turnstile>s1 \<midarrow>es\<doteq>\<succ>vs\<midarrow>n2\<rightarrow> s2"      
 10.1512 +      by (blast elim!: wt_elim_cases dest: eval_type_sound)
 10.1513 +    then
 10.1514 +    have "G\<turnstile>Norm s0 \<midarrow>e # es\<doteq>\<succ>v # vs\<midarrow>max n1 n2\<rightarrow> s2"
 10.1515 +      by (blast intro!: evaln.Cons dest: evaln_max2)
 10.1516 +    then show ?case ..
 10.1517 +  qed
 10.1518 +qed
 10.1519 +
 10.1520  end
    11.1 --- a/src/HOL/Bali/Example.thy	Thu Feb 21 20:11:32 2002 +0100
    11.2 +++ b/src/HOL/Bali/Example.thy	Fri Feb 22 11:26:44 2002 +0100
    11.3 @@ -7,7 +7,6 @@
    11.4  
    11.5  theory Example = Eval + WellForm:
    11.6  
    11.7 -
    11.8  text {*
    11.9  The following example Bali program includes:
   11.10  \begin{itemize}
   11.11 @@ -43,7 +42,7 @@
   11.12    }
   11.13  }
   11.14  
   11.15 -public class Example {
   11.16 +public class Main {
   11.17    public static void main(String args[]) throws Throwable {
   11.18      Base e = new Ext();
   11.19      try {e.foo(null); }
   11.20 @@ -54,7 +53,6 @@
   11.21  }
   11.22  \end{verbatim}
   11.23  *}
   11.24 -
   11.25  declare widen.null [intro]
   11.26  
   11.27  lemma wf_fdecl_def2: "\<And>fd. wf_fdecl G P fd = is_acc_type G P (type (snd fd))"
   11.28 @@ -68,7 +66,7 @@
   11.29  section "type and expression names"
   11.30  
   11.31  (** unfortunately cannot simply instantiate tnam **)
   11.32 -datatype tnam_  = HasFoo_ | Base_ | Ext_
   11.33 +datatype tnam_  = HasFoo_ | Base_ | Ext_ | Main_
   11.34  datatype vnam_  = arr_ | vee_ | z_ | e_
   11.35  datatype label_ = lab1_
   11.36  
   11.37 @@ -94,6 +92,7 @@
   11.38    HasFoo :: qtname
   11.39    Base   :: qtname
   11.40    Ext    :: qtname
   11.41 +  Main   :: qtname
   11.42    arr :: ename
   11.43    vee :: ename
   11.44    z   :: ename
   11.45 @@ -104,6 +103,7 @@
   11.46    "HasFoo" == "\<lparr>pid=java_lang,tid=TName (tnam_ HasFoo_)\<rparr>"
   11.47    "Base"   == "\<lparr>pid=java_lang,tid=TName (tnam_ Base_)\<rparr>"
   11.48    "Ext"    == "\<lparr>pid=java_lang,tid=TName (tnam_ Ext_)\<rparr>"
   11.49 +  "Main"   == "\<lparr>pid=java_lang,tid=TName (tnam_ Main_)\<rparr>"
   11.50    "arr"    ==        "(vnam_ arr_)"
   11.51    "vee"    ==        "(vnam_ vee_)"
   11.52    "z"      ==        "(vnam_ z_)"
   11.53 @@ -117,12 +117,18 @@
   11.54  lemma neq_Ext_Object [simp]: "Ext\<noteq>Object"
   11.55  by (simp add: Object_def)
   11.56  
   11.57 +lemma neq_Main_Object [simp]: "Main\<noteq>Object"
   11.58 +by (simp add: Object_def)
   11.59 +
   11.60  lemma neq_Base_SXcpt [simp]: "Base\<noteq>SXcpt xn"
   11.61  by (simp add: SXcpt_def)
   11.62  
   11.63  lemma neq_Ext_SXcpt [simp]: "Ext\<noteq>SXcpt xn"
   11.64  by (simp add: SXcpt_def)
   11.65  
   11.66 +lemma neq_Main_Object [simp]: "Main\<noteq>SXcpt xn"
   11.67 +by (simp add: SXcpt_def)
   11.68 +
   11.69  section "classes and interfaces"
   11.70  
   11.71  defs
   11.72 @@ -147,26 +153,28 @@
   11.73    Base_foo :: mdecl
   11.74   "Base_foo \<equiv> (foo_sig, \<lparr>access=Public,static=False,pars=[z],resT=Class Base,
   11.75                          mbody=\<lparr>lcls=[],stmt=Return (!!z)\<rparr>\<rparr>)"
   11.76 -  
   11.77 +
   11.78 +constdefs
   11.79    Ext_foo  :: mdecl
   11.80   "Ext_foo  \<equiv> (foo_sig, 
   11.81                \<lparr>access=Public,static=False,pars=[z],resT=Class Ext,
   11.82  	       mbody=\<lparr>lcls=[]
   11.83 -                     ,stmt=Expr({Ext,False}Cast (Class Ext) (!!z)..vee := 
   11.84 +                     ,stmt=Expr({Ext,Ext,False}Cast (Class Ext) (!!z)..vee := 
   11.85         	                                                     Lit (Intg 1))\<rparr>
   11.86  	      \<rparr>)"
   11.87  
   11.88  constdefs
   11.89    
   11.90 -arr_viewed_from :: "qtname \<Rightarrow> var"
   11.91 -"arr_viewed_from C \<equiv> {Base,True}StatRef (ClassT C)..arr"
   11.92 +arr_viewed_from :: "qtname \<Rightarrow> qtname \<Rightarrow> var"
   11.93 +"arr_viewed_from accC C \<equiv> {accC,Base,True}StatRef (ClassT C)..arr"
   11.94  
   11.95  BaseCl :: class
   11.96  "BaseCl \<equiv> \<lparr>access=Public,
   11.97             cfields=[(arr, \<lparr>access=Public,static=True ,type=PrimT Boolean.[]\<rparr>),
   11.98  	            (vee, \<lparr>access=Public,static=False,type=Iface HasFoo    \<rparr>)],
   11.99             methods=[Base_foo],
  11.100 -           init=Expr(arr_viewed_from Base :=New (PrimT Boolean)[Lit (Intg 2)]),
  11.101 +           init=Expr(arr_viewed_from Base Base 
  11.102 +                     :=New (PrimT Boolean)[Lit (Intg 2)]),
  11.103             super=Object,
  11.104             superIfs=[HasFoo]\<rparr>"
  11.105    
  11.106 @@ -178,6 +186,15 @@
  11.107             super=Base,
  11.108             superIfs=[]\<rparr>"
  11.109  
  11.110 +MainCl :: class
  11.111 +"MainCl \<equiv> \<lparr>access=Public,
  11.112 +           cfields=[], 
  11.113 +           methods=[], 
  11.114 +           init=Skip,
  11.115 +           super=Object,
  11.116 +           superIfs=[]\<rparr>"
  11.117 +(* The "main" method is modeled seperately (see tprg) *)
  11.118 +
  11.119  constdefs
  11.120    
  11.121    HasFooInt :: iface
  11.122 @@ -187,7 +204,7 @@
  11.123   "Ifaces \<equiv> [(HasFoo,HasFooInt)]"
  11.124  
  11.125   "Classes" ::"cdecl list"
  11.126 - "Classes \<equiv> [(Base,BaseCl),(Ext,ExtCl)]@standard_classes"
  11.127 + "Classes \<equiv> [(Base,BaseCl),(Ext,ExtCl),(Main,MainCl)]@standard_classes"
  11.128  
  11.129  lemmas table_classes_defs = 
  11.130       Classes_def standard_classes_def ObjectC_def SXcptC_def
  11.131 @@ -231,6 +248,10 @@
  11.132  apply (simp (no_asm) add: Object_def SXcpt_def)
  11.133  done
  11.134  
  11.135 +lemma table_classes_Main [simp]: "table_of Classes Main = Some MainCl"
  11.136 +apply (unfold table_classes_defs )
  11.137 +apply (simp (no_asm) add: Object_def SXcpt_def)
  11.138 +done
  11.139  
  11.140  section "program"
  11.141  
  11.142 @@ -243,9 +264,10 @@
  11.143  constdefs
  11.144    test    :: "(ty)list \<Rightarrow> stmt"
  11.145   "test pTs \<equiv> e:==NewC Ext;; 
  11.146 -           \<spacespace> Try Expr({ClassT Base,IntVir}!!e\<cdot>foo({pTs}[Lit Null]))
  11.147 +           \<spacespace> Try Expr({Main,ClassT Base,IntVir}!!e\<cdot>foo({pTs}[Lit Null]))
  11.148             \<spacespace> Catch((SXcpt NullPointer) z)
  11.149 -           (lab1\<bullet> While(Acc (Acc (arr_viewed_from Ext).[Lit (Intg 2)])) Skip)"
  11.150 +           (lab1\<bullet> While(Acc 
  11.151 +                        (Acc (arr_viewed_from Main Ext).[Lit (Intg 2)])) Skip)"
  11.152  
  11.153  
  11.154  section "well-structuredness"
  11.155 @@ -278,7 +300,7 @@
  11.156  apply (erule ssubst)
  11.157  apply (rule tnam_.induct)
  11.158  apply  safe
  11.159 -apply (auto dest!: tranclD subcls1D simp add: BaseCl_def ExtCl_def)
  11.160 +apply (auto dest!: tranclD subcls1D simp add: BaseCl_def ExtCl_def MainCl_def)
  11.161  apply (drule rtranclD)
  11.162  apply auto
  11.163  done
  11.164 @@ -314,8 +336,13 @@
  11.165  apply auto
  11.166  done
  11.167  
  11.168 +lemma ws_cdecl_Main: "ws_cdecl tprg Main Object"
  11.169 +apply (unfold ws_cdecl_def)
  11.170 +apply auto
  11.171 +done
  11.172 +
  11.173  lemmas ws_cdecls = ws_cdecl_SXcpt ws_cdecl_Object ws_cdecl_Throwable
  11.174 -                   ws_cdecl_Base ws_cdecl_Ext
  11.175 +                   ws_cdecl_Base ws_cdecl_Ext ws_cdecl_Main
  11.176  
  11.177  declare not_Object_subcls_any [rule del]
  11.178            not_Throwable_subcls_SXcpt [rule del] 
  11.179 @@ -329,7 +356,7 @@
  11.180  done
  11.181  
  11.182  lemma ws_cdecl_all: "G=tprg \<Longrightarrow> (\<forall>(C,c)\<in>set Classes. ws_cdecl G C (super c))"
  11.183 -apply (simp (no_asm) add: Classes_def BaseCl_def ExtCl_def)
  11.184 +apply (simp (no_asm) add: Classes_def BaseCl_def ExtCl_def MainCl_def)
  11.185  apply (auto intro!: ws_cdecls simp add: standard_classes_def ObjectC_def 
  11.186          SXcptC_def)
  11.187  done
  11.188 @@ -438,12 +465,6 @@
  11.189  apply   (auto simp add: BaseCl_def)
  11.190  done
  11.191  
  11.192 -(* ### To Table *)
  11.193 -lemma filter_tab_all_False: 
  11.194 - "\<forall> k y. t k = Some y \<longrightarrow> \<not> p k y \<Longrightarrow>filter_tab p t = empty"
  11.195 -by (auto simp add: filter_tab_def expand_fun_eq)
  11.196 -
  11.197 -
  11.198  lemma memberid_Base_foo_simp [simp]:
  11.199   "memberid (mdecl Base_foo) = mid foo_sig"
  11.200  by (simp add: Base_foo_def)
  11.201 @@ -504,7 +525,7 @@
  11.202  lemma classesDefined: 
  11.203   "\<lbrakk>class tprg C = Some c; C\<noteq>Object\<rbrakk> \<Longrightarrow> \<exists> sc. class tprg (super c) = Some sc"
  11.204  apply (auto simp add: Classes_def standard_classes_def 
  11.205 -                      BaseCl_def ExtCl_def
  11.206 +                      BaseCl_def ExtCl_def MainCl_def
  11.207                        SXcptC_def ObjectC_def) 
  11.208  done
  11.209  
  11.210 @@ -522,6 +543,13 @@
  11.211      by (auto simp add: superclasses_rec  ExtCl_def BaseCl_def)
  11.212  qed
  11.213  
  11.214 +lemma superclassesMain [simp]: "superclasses tprg Main={Object}"
  11.215 +proof -
  11.216 +  have ws: "ws_prog tprg" by (rule ws_tprg)
  11.217 +  then show ?thesis
  11.218 +    by (auto simp add: superclasses_rec  MainCl_def)
  11.219 +qed
  11.220 +
  11.221  lemma HasFoo_accessible[simp]:"tprg\<turnstile>(Iface HasFoo) accessible_in P" 
  11.222  by (simp add: accessible_in_RefT_simp is_public_def HasFooInt_def)
  11.223  
  11.224 @@ -564,12 +592,6 @@
  11.225    "tprg\<turnstile>mid foo_sig undeclared_in Object"
  11.226  by (auto simp add: undeclared_in_def cdeclaredmethd_def Object_mdecls_def)
  11.227  
  11.228 -(* ### To DeclConcepts *)
  11.229 -lemma undeclared_not_declared:
  11.230 - "G\<turnstile> memberid m undeclared_in C \<Longrightarrow> \<not> G\<turnstile> m declared_in C" 
  11.231 -by (cases m) (auto simp add: declared_in_def undeclared_in_def)
  11.232 -
  11.233 -
  11.234  lemma unique_sig_Base_foo:
  11.235   "tprg\<turnstile> mdecl (sig, snd Base_foo) declared_in Base \<Longrightarrow> sig=foo_sig"
  11.236  by (auto simp add: declared_in_def cdeclaredmethd_def 
  11.237 @@ -617,16 +639,6 @@
  11.238  by (auto simp add: declared_in_def cdeclaredmethd_def 
  11.239                     Ext_foo_def ExtCl_def)
  11.240  
  11.241 -(* ### To DeclConcepts *)
  11.242 -lemma unique_declaration: 
  11.243 - "\<lbrakk>G\<turnstile>m declared_in C;  G\<turnstile>n declared_in C; memberid m = memberid n \<rbrakk> 
  11.244 -  \<Longrightarrow> m = n"
  11.245 -apply (cases m)
  11.246 -apply (cases n,
  11.247 -        auto simp add: declared_in_def cdeclaredmethd_def cdeclaredfield_def)+
  11.248 -done
  11.249 -
  11.250 -
  11.251  lemma Ext_foo_override:
  11.252   "tprg,sig\<turnstile>(Ext,(snd Ext_foo)) overrides old 
  11.253    \<Longrightarrow> old = (Base,(snd Base_foo))"
  11.254 @@ -667,25 +679,42 @@
  11.255             dest: declared_not_undeclared unique_declaration)
  11.256  done
  11.257  
  11.258 -(*### weiter hoch *)
  11.259  lemma Base_foo_member_of_Base: 
  11.260    "tprg\<turnstile>(Base,mdecl Base_foo) member_of Base"
  11.261  by (auto intro!: members.Immediate Base_declares_foo)
  11.262  
  11.263 -(*### weiter hoch *)
  11.264 +lemma Base_foo_member_in_Base: 
  11.265 +  "tprg\<turnstile>(Base,mdecl Base_foo) member_in Base"
  11.266 +by (rule member_of_to_member_in [OF Base_foo_member_of_Base])
  11.267 +
  11.268 +lemma Base_foo_member_of_Base: 
  11.269 +  "tprg\<turnstile>(Base,mdecl Base_foo) member_of Base"
  11.270 +by (auto intro!: members.Immediate Base_declares_foo)
  11.271 +
  11.272  lemma Ext_foo_member_of_Ext: 
  11.273    "tprg\<turnstile>(Ext,mdecl Ext_foo) member_of Ext"
  11.274  by (auto intro!: members.Immediate Ext_declares_foo)
  11.275  
  11.276 +lemma Ext_foo_member_in_Ext: 
  11.277 +  "tprg\<turnstile>(Ext,mdecl Ext_foo) member_in Ext"
  11.278 +by (rule member_of_to_member_in [OF Ext_foo_member_of_Ext])
  11.279 +
  11.280  lemma Base_foo_permits_acc:
  11.281   "tprg \<turnstile> (Base, mdecl Base_foo) in Base permits_acc_to S"
  11.282  by ( simp add: permits_acc_def Base_foo_def)
  11.283  
  11.284  lemma Base_foo_accessible [simp]:
  11.285   "tprg\<turnstile>(Base,mdecl Base_foo) of Base accessible_from S"
  11.286 -by (auto intro: accessible_fromR.immediate 
  11.287 +by (auto intro: accessible_fromR.Immediate 
  11.288                  Base_foo_member_of_Base Base_foo_permits_acc)
  11.289  
  11.290 +lemma Base_foo_dyn_accessible [simp]:
  11.291 + "tprg\<turnstile>(Base,mdecl Base_foo) in Base dyn_accessible_from S"
  11.292 +apply (rule dyn_accessible_fromR.Immediate)
  11.293 +apply   (rule Base_foo_member_in_Base)
  11.294 +apply   (rule Base_foo_permits_acc)
  11.295 +done
  11.296 +
  11.297  lemma accmethd_Base [simp]: 
  11.298    "accmethd tprg S Base = methd tprg Base"
  11.299  apply (simp add: accmethd_def)
  11.300 @@ -699,17 +728,15 @@
  11.301  
  11.302  lemma Ext_foo_accessible [simp]:
  11.303   "tprg\<turnstile>(Ext,mdecl Ext_foo) of Ext accessible_from S"
  11.304 -by (auto intro: accessible_fromR.immediate 
  11.305 +by (auto intro: accessible_fromR.Immediate 
  11.306                  Ext_foo_member_of_Ext Ext_foo_permits_acc)
  11.307  
  11.308 -(*
  11.309 -lemma Base_foo_accessible_through_inheritance_in_Ext [simp]:
  11.310 - "tprg\<turnstile>(Base,snd Base_foo) accessible_through_inheritance_in Ext"
  11.311 -apply (rule accessible_through_inheritance.Direct)
  11.312 -apply   simp
  11.313 -apply   (simp add: accessible_for_inheritance_in_def Base_foo_def)
  11.314 +lemma Ext_foo_dyn_accessible [simp]:
  11.315 + "tprg\<turnstile>(Ext,mdecl Ext_foo) in Ext dyn_accessible_from S"
  11.316 +apply (rule dyn_accessible_fromR.Immediate) 
  11.317 +apply   (rule Ext_foo_member_in_Ext)
  11.318 +apply   (rule Ext_foo_permits_acc)
  11.319  done
  11.320 -*)
  11.321  
  11.322  lemma Ext_foo_overrides_Base_foo:
  11.323   "tprg\<turnstile>(Ext,Ext_foo) overrides (Base,Base_foo)"
  11.324 @@ -732,29 +759,6 @@
  11.325      by (simp add: Ext_foo_def Base_foo_def mhead_resTy_simp)
  11.326  qed
  11.327  
  11.328 -(*
  11.329 -lemma Base_foo_of_Ext_accessible[simp]:
  11.330 - "tprg\<turnstile>(Base, mdecl Base_foo) of Ext accessible_from S"
  11.331 -apply (auto intro: accessible_fromR.immediate 
  11.332 -                Base_foo_member_of_Base Base_foo_permits_acc)
  11.333 -apply (rule accessible_fromR.immediate)
  11.334 -apply (rule_tac "old"="(Base,Base_foo)" and  sup="Base" 
  11.335 -       in accessible_fromR.overriding)
  11.336 -apply (auto intro!: Ext_foo_overrides_Base_foo)
  11.337 -apply (auto 
  11.338 -apply (insert Ext_foo_overrides_Base_foo)
  11.339 -apply (rule accessible_fromR.overriding, simp_all)
  11.340 -apply (auto intro!: Ext_foo_overrides_Base_foo)
  11.341 -apply (auto intro!: accessible_fromR.overriding
  11.342 -             intro:   Ext_foo_overrides_Base_foo)
  11.343 -by
  11.344 -                Ext_foo_member_of_Ext Ext_foo_permits_acc)
  11.345 -apply (auto intro!: accessible 
  11.346 -apply (auto simp add: method_accessible_from_def accessible_from_def) 
  11.347 -apply (simp add: Base_foo_def)
  11.348 -done 
  11.349 -*)
  11.350 -
  11.351  lemma accmethd_Ext [simp]: 
  11.352    "accmethd tprg S Ext = methd tprg Ext"
  11.353  apply (simp add: accmethd_def)
  11.354 @@ -762,7 +766,6 @@
  11.355  apply (auto simp add: snd_special_simp fst_special_simp)
  11.356  done
  11.357  
  11.358 -(* ### Weiter hoch *)
  11.359  lemma cls_Ext: "class tprg Ext = Some ExtCl"
  11.360  by simp
  11.361  lemma dynmethd_Ext_foo:
  11.362 @@ -790,7 +793,7 @@
  11.363                        declared_in_def 
  11.364                        cdeclaredfield_def
  11.365                 intro!: filter_tab_all_True_Some filter_tab_None
  11.366 -                       accessible_fromR.immediate
  11.367 +                       accessible_fromR.Immediate
  11.368                 intro: members.Immediate)
  11.369  done
  11.370  
  11.371 @@ -802,6 +805,12 @@
  11.372  by (auto intro: members.Immediate 
  11.373         simp add: declared_in_def cdeclaredfield_def BaseCl_def)
  11.374   
  11.375 +lemma arr_member_in_Base:
  11.376 +  "tprg\<turnstile>(Base, fdecl (arr, 
  11.377 +                 \<lparr>access = Public, static = True, type = PrimT Boolean.[]\<rparr>))
  11.378 +          member_in Base"
  11.379 +by (rule member_of_to_member_in [OF arr_member_of_Base])
  11.380 +
  11.381  lemma arr_member_of_Ext:
  11.382    "tprg\<turnstile>(Base, fdecl (arr, 
  11.383                      \<lparr>access = Public, static = True, type = PrimT Boolean.[]\<rparr>))
  11.384 @@ -812,6 +821,12 @@
  11.385  apply   (auto intro: arr_member_of_Base simp add: subcls1_def ExtCl_def)
  11.386  done
  11.387  
  11.388 +lemma arr_member_in_Ext:
  11.389 +  "tprg\<turnstile>(Base, fdecl (arr, 
  11.390 +                 \<lparr>access = Public, static = True, type = PrimT Boolean.[]\<rparr>))
  11.391 +          member_in Ext"
  11.392 +by (rule member_of_to_member_in [OF arr_member_of_Ext])
  11.393 +
  11.394  lemma Ext_fields_accessible[simp]:
  11.395  "accfield tprg S Ext 
  11.396    = table_of((map (\<lambda>((n,d),f).(n,(d,f)))) (DeclConcepts.fields tprg Ext))"
  11.397 @@ -822,11 +837,27 @@
  11.398                        ExtCl_def
  11.399                        permits_acc_def
  11.400                 intro!: filter_tab_all_True_Some filter_tab_None
  11.401 -                       accessible_fromR.immediate)
  11.402 +                       accessible_fromR.Immediate)
  11.403  apply (auto intro: members.Immediate arr_member_of_Ext
  11.404              simp add: declared_in_def cdeclaredfield_def ExtCl_def)
  11.405  done
  11.406  
  11.407 +lemma arr_Base_dyn_accessible [simp]:
  11.408 +"tprg\<turnstile>(Base, fdecl (arr, \<lparr>access=Public,static=True ,type=PrimT Boolean.[]\<rparr>)) 
  11.409 +       in Base dyn_accessible_from S"
  11.410 +apply (rule dyn_accessible_fromR.Immediate)
  11.411 +apply   (rule arr_member_in_Base)
  11.412 +apply   (simp add: permits_acc_def)
  11.413 +done
  11.414 +
  11.415 +lemma arr_Ext_dyn_accessible[simp]:
  11.416 +"tprg\<turnstile>(Base, fdecl (arr, \<lparr>access=Public,static=True ,type=PrimT Boolean.[]\<rparr>)) 
  11.417 +       in Ext dyn_accessible_from S"
  11.418 +apply (rule dyn_accessible_fromR.Immediate)
  11.419 +apply   (rule arr_member_in_Ext)
  11.420 +apply   (simp add: permits_acc_def)
  11.421 +done
  11.422 +
  11.423  lemma array_of_PrimT_acc [simp]:
  11.424   "is_acc_type tprg java_lang (PrimT t.[])"
  11.425  apply (simp add: is_acc_type_def accessible_in_RefT_simp)
  11.426 @@ -853,6 +884,8 @@
  11.427                        member_is_static_simp )
  11.428  done
  11.429  
  11.430 +
  11.431 +declare member_is_static_simp [simp]
  11.432  declare wt.Skip [rule del] wt.Init [rule del]
  11.433  lemmas Base_foo_defs = Base_foo_def foo_sig_def foo_mhead_def
  11.434  lemmas Ext_foo_defs  = Ext_foo_def  foo_sig_def
  11.435 @@ -903,6 +936,11 @@
  11.436  apply  blast+
  11.437  done
  11.438  
  11.439 +lemma wf_MainC: "wf_cdecl tprg (Main,MainCl)"
  11.440 +apply (unfold wf_cdecl_def MainCl_def)
  11.441 +apply (auto intro: ws_cdecl_Main)
  11.442 +done
  11.443 +
  11.444  lemma wf_idecl_all: "p=tprg \<Longrightarrow> Ball (set Ifaces) (wf_idecl p)"
  11.445  apply (simp (no_asm) add: Ifaces_def)
  11.446  apply (simp (no_asm_simp))
  11.447 @@ -922,8 +960,9 @@
  11.448  lemma wf_cdecl_all: "p=tprg \<Longrightarrow> Ball (set Classes) (wf_cdecl p)"
  11.449  apply (simp (no_asm) add: Classes_def)
  11.450  apply (simp (no_asm_simp))
  11.451 -apply   (rule wf_BaseC [THEN conjI])
  11.452 -apply  (rule wf_ExtC [THEN conjI])
  11.453 +apply    (rule wf_BaseC [THEN conjI])
  11.454 +apply   (rule wf_ExtC [THEN conjI])
  11.455 +apply  (rule wf_MainC [THEN conjI])
  11.456  apply (rule wf_cdecl_all_standard_classes)
  11.457  done
  11.458  
  11.459 @@ -966,7 +1005,7 @@
  11.460  
  11.461  section "well-typedness"
  11.462  
  11.463 -lemma wt_test: "\<lparr>prg=tprg,cls=S,lcl=empty(VName e\<mapsto>Class Base)\<rparr>\<turnstile>test ?pTs\<Colon>\<surd>"
  11.464 +lemma wt_test: "\<lparr>prg=tprg,cls=Main,lcl=empty(VName e\<mapsto>Class Base)\<rparr>\<turnstile>test ?pTs\<Colon>\<surd>"
  11.465  apply (unfold test_def arr_viewed_from_def)
  11.466  (* ?pTs = [Class Base] *)
  11.467  apply (rule wtIs (* ;; *))
  11.468 @@ -999,6 +1038,7 @@
  11.469  apply   (simp)
  11.470  apply  (simp)
  11.471  apply  (simp)
  11.472 +apply  (simp)
  11.473  apply (rule wtIs (* While *))
  11.474  apply  (rule wtIs (* Acc *))
  11.475  apply   (rule wtIs (* AVar *))
  11.476 @@ -1009,6 +1049,7 @@
  11.477  apply   (simp)
  11.478  apply   (simp )
  11.479  apply   (simp)
  11.480 +apply   (simp)
  11.481  apply  (rule wtIs (* LVar *))
  11.482  apply  (simp)
  11.483  apply (rule wtIs (* Skip *))
  11.484 @@ -1165,9 +1206,10 @@
  11.485  apply   (rule eval_Is (* Expr *))
  11.486  apply   (rule eval_Is (* Ass *))
  11.487  apply    (rule eval_Is (* FVar *))
  11.488 -apply      (rule init_done, simp)
  11.489 -apply     (rule eval_Is (* StatRef *))
  11.490 -apply    (simp)
  11.491 +apply         (rule init_done, simp)
  11.492 +apply        (rule eval_Is (* StatRef *))
  11.493 +apply       (simp)
  11.494 +apply     (simp add: check_field_access_def Let_def) 
  11.495  apply   (rule eval_Is (* NewA *))
  11.496  apply     (simp)
  11.497  apply    (rule eval_Is (* Lit *))
  11.498 @@ -1201,7 +1243,12 @@
  11.499  apply      (rule eval_Is (* Lit *))
  11.500  apply     (rule eval_Is (* Nil *))
  11.501  apply    (simp)
  11.502 -apply   (simp)
  11.503 +apply    (simp)
  11.504 +apply    (subgoal_tac
  11.505 +             "tprg\<turnstile>(Ext,mdecl Ext_foo) in Ext dyn_accessible_from Main")
  11.506 +apply      (simp add: check_method_access_def Let_def
  11.507 +                      invocation_declclass_def dynlookup_def dynmethd_Ext_foo)
  11.508 +apply      (rule Ext_foo_dyn_accessible)
  11.509  apply   (rule eval_Is (* Methd *))
  11.510  apply   (simp add: body_def Let_def)
  11.511  apply   (rule eval_Is (* Body *))
  11.512 @@ -1216,7 +1263,8 @@
  11.513  apply       (rule eval_Is (* Acc *))
  11.514  apply       (rule eval_Is (* LVar *))
  11.515  apply      (simp)
  11.516 -apply     (simp split del: split_if)
  11.517 +apply      (simp split del: split_if)
  11.518 +apply      (simp add: check_field_access_def Let_def)
  11.519  apply    (rule eval_Is (* XcptE *))
  11.520  apply   (simp)
  11.521        (* end method call *)
  11.522 @@ -1239,6 +1287,7 @@
  11.523  apply      (rule init_done, simp)
  11.524  apply     (rule eval_Is (* StatRef *))
  11.525  apply    (simp)
  11.526 +apply    (simp add: check_field_access_def Let_def)
  11.527  apply   (rule eval_Is (* Lit *))
  11.528  apply  (simp (no_asm_simp))
  11.529  apply (auto simp add: in_bounds_def)
    12.1 --- a/src/HOL/Bali/State.thy	Thu Feb 21 20:11:32 2002 +0100
    12.2 +++ b/src/HOL/Bali/State.thy	Fri Feb 22 11:26:44 2002 +0100
    12.3 @@ -22,8 +22,10 @@
    12.4  datatype  obj_tag =     (* tag for generic object   *)
    12.5  	  CInst qtname   (* class instance           *)
    12.6  	| Arr  ty int   (* array with component type and length *)
    12.7 -     (* | CStat            the tag is irrelevant for a class object,
    12.8 -			   i.e. the static fields of a class *)
    12.9 +     (* | CStat qtname     the tag is irrelevant for a class object,
   12.10 +			   i.e. the static fields of a class,
   12.11 +                           since its type is given already by the reference to 
   12.12 +                           it (see below) *)
   12.13  
   12.14  types	vn   = "fspec + int"                    (* variable name      *)
   12.15  record	obj  = 
   12.16 @@ -489,9 +491,14 @@
   12.17  	= Loc loc    (* location of allocated execption object *)
   12.18  	| Std xname  (* intermediate standard exception, see Eval.thy *)
   12.19  
   12.20 +datatype error
   12.21 +       = AccessViolation (* Access to a member that isn't permitted *)
   12.22 +
   12.23  datatype abrupt      (* abrupt completion *) 
   12.24          = Xcpt xcpt  (* exception *)
   12.25          | Jump jump  (* break, continue, return *)
   12.26 +        | Error error (* runtime errors, we wan't to detect and proof absent
   12.27 +                         in welltyped programms *)
   12.28  consts
   12.29  
   12.30    the_Xcpt :: "abrupt \<Rightarrow> xcpt"
   12.31 @@ -542,12 +549,14 @@
   12.32    raise_if :: "bool \<Rightarrow> xname \<Rightarrow> abopt \<Rightarrow> abopt"
   12.33    np       :: "val  \<spacespace>        \<Rightarrow> abopt \<Rightarrow> abopt"
   12.34    check_neg:: "val  \<spacespace>        \<Rightarrow> abopt \<Rightarrow> abopt"
   12.35 +  error_if :: "bool \<Rightarrow> error \<Rightarrow> abopt \<Rightarrow> abopt"
   12.36    
   12.37  translations
   12.38  
   12.39   "raise_if c xn" == "abrupt_if c (Some (Xcpt (Std xn)))"
   12.40   "np v"          == "raise_if (v = Null)      NullPointer"
   12.41   "check_neg i'"  == "raise_if (the_Intg i'<0) NegArrSize"
   12.42 + "error_if c e"  == "abrupt_if c (Some (Error e))"
   12.43  
   12.44  lemma raise_if_None [simp]: "(raise_if c x y = None) = (\<not>c \<and> y = None)"
   12.45  apply (simp add: abrupt_if_def)
   12.46 @@ -569,6 +578,26 @@
   12.47  apply auto
   12.48  done
   12.49  
   12.50 +lemma error_if_None [simp]: "(error_if c e y = None) = (\<not>c \<and> y = None)"
   12.51 +apply (simp add: abrupt_if_def)
   12.52 +by auto
   12.53 +declare error_if_None [THEN iffD1, dest!]
   12.54 +
   12.55 +lemma if_error_if_None [simp]: 
   12.56 +  "((if b then y else error_if c e y) = None) = ((c \<longrightarrow> b) \<and> y = None)"
   12.57 +apply (simp add: abrupt_if_def)
   12.58 +apply auto
   12.59 +done
   12.60 +
   12.61 +lemma raise_if_SomeD [dest!]:
   12.62 +  "error_if c e y = Some z \<Longrightarrow> c \<and> z=(Error e) \<and> y=None \<or> (y=Some z)"
   12.63 +apply (case_tac y)
   12.64 +apply (case_tac c)
   12.65 +apply (simp add: abrupt_if_def)
   12.66 +apply (simp add: abrupt_if_def)
   12.67 +apply auto
   12.68 +done
   12.69 +
   12.70  constdefs
   12.71     absorb :: "jump \<Rightarrow> abopt \<Rightarrow> abopt"
   12.72    "absorb j a \<equiv> if a=Some (Jump j) then None else a"
   12.73 @@ -733,7 +762,97 @@
   12.74  apply (simp (no_asm))
   12.75  done
   12.76  
   12.77 +section {* @{text error_free} *}
   12.78 +constdefs error_free:: "state \<Rightarrow> bool"
   12.79 +"error_free s \<equiv> \<not> (\<exists> err. abrupt s = Some (Error err))"
   12.80  
   12.81 +lemma error_free_Norm [simp,intro]: "error_free (Norm s)"
   12.82 +by (simp add: error_free_def)
   12.83 +
   12.84 +lemma error_free_normal [simp,intro]: "normal s \<Longrightarrow> error_free s"
   12.85 +by (simp add: error_free_def)
   12.86 +
   12.87 +lemma error_free_Xcpt [simp]: "error_free (Some (Xcpt x),s)"
   12.88 +by (simp add: error_free_def)
   12.89 +
   12.90 +lemma error_free_Jump [simp,intro]: "error_free (Some (Jump j),s)"
   12.91 +by (simp add: error_free_def)
   12.92 +
   12.93 +lemma error_free_Error [simp]: "error_free (Some (Error e),s) = False"
   12.94 +by (simp add: error_free_def)  
   12.95 +
   12.96 +lemma error_free_Some [simp,intro]: 
   12.97 + "\<not> (\<exists> err. x=Error err) \<Longrightarrow> error_free ((Some x),s)"
   12.98 +by (auto simp add: error_free_def)
   12.99 +
  12.100 +lemma error_free_absorb [simp,intro]: 
  12.101 + "error_free s \<Longrightarrow> error_free (abupd (absorb j) s)"
  12.102 +by (cases s) 
  12.103 +   (auto simp add: error_free_def absorb_def
  12.104 +         split: split_if_asm)
  12.105 +
  12.106 +lemma error_free_absorb [simp,intro]: 
  12.107 + "error_free (a,s) \<Longrightarrow> error_free (absorb j a, s)"
  12.108 +by (auto simp add: error_free_def absorb_def
  12.109 +            split: split_if_asm)
  12.110 +
  12.111 +lemma error_free_abrupt_if [simp,intro]:
  12.112 +"\<lbrakk>error_free s; \<not> (\<exists> err. x=Error err)\<rbrakk>
  12.113 + \<Longrightarrow> error_free (abupd (abrupt_if p (Some x)) s)"
  12.114 +by (cases s)
  12.115 +   (auto simp add: abrupt_if_def
  12.116 +            split: split_if)
  12.117 +
  12.118 +lemma error_free_abrupt_if1 [simp,intro]:
  12.119 +"\<lbrakk>error_free (a,s); \<not> (\<exists> err. x=Error err)\<rbrakk>
  12.120 + \<Longrightarrow> error_free (abrupt_if p (Some x) a, s)"
  12.121 +by  (auto simp add: abrupt_if_def
  12.122 +            split: split_if)
  12.123 +
  12.124 +lemma error_free_abrupt_if_Xcpt [simp,intro]:
  12.125 + "error_free s 
  12.126 +  \<Longrightarrow> error_free (abupd (abrupt_if p (Some (Xcpt x))) s)"
  12.127 +by simp 
  12.128 +
  12.129 +lemma error_free_abrupt_if_Xcpt1 [simp,intro]:
  12.130 + "error_free (a,s) 
  12.131 +  \<Longrightarrow> error_free (abrupt_if p (Some (Xcpt x)) a, s)" 
  12.132 +by simp 
  12.133 +
  12.134 +lemma error_free_abrupt_if_Jump [simp,intro]:
  12.135 + "error_free s 
  12.136 +  \<Longrightarrow> error_free (abupd (abrupt_if p (Some (Jump j))) s)" 
  12.137 +by simp
  12.138 +
  12.139 +lemma error_free_abrupt_if_Jump1 [simp,intro]:
  12.140 + "error_free (a,s) 
  12.141 +  \<Longrightarrow> error_free (abrupt_if p (Some (Jump j)) a, s)" 
  12.142 +by simp
  12.143 +
  12.144 +lemma error_free_raise_if [simp,intro]:
  12.145 + "error_free s \<Longrightarrow> error_free (abupd (raise_if p x) s)"
  12.146 +by simp 
  12.147 +
  12.148 +lemma error_free_raise_if1 [simp,intro]:
  12.149 + "error_free (a,s) \<Longrightarrow> error_free ((raise_if p x a), s)"
  12.150 +by simp 
  12.151 +
  12.152 +lemma error_free_supd [simp,intro]:
  12.153 + "error_free s \<Longrightarrow> error_free (supd f s)"
  12.154 +by (cases s) (simp add: error_free_def)
  12.155 +
  12.156 +lemma error_free_supd1 [simp,intro]:
  12.157 + "error_free (a,s) \<Longrightarrow> error_free (a,f s)"
  12.158 +by (simp add: error_free_def)
  12.159 +
  12.160 +lemma error_free_set_lvars [simp,intro]:
  12.161 +"error_free s \<Longrightarrow> error_free ((set_lvars l) s)"
  12.162 +by (cases s) simp
  12.163 +
  12.164 +lemma error_free_set_locals [simp,intro]: 
  12.165 +"error_free (x, s)
  12.166 +       \<Longrightarrow> error_free (x, set_locals l s')"
  12.167 +by (simp add: error_free_def)
  12.168  
  12.169  end
  12.170  
    13.1 --- a/src/HOL/Bali/Table.thy	Thu Feb 21 20:11:32 2002 +0100
    13.2 +++ b/src/HOL/Bali/Table.thy	Fri Feb 22 11:26:44 2002 +0100
    13.3 @@ -31,7 +31,6 @@
    13.4  \end{itemize}
    13.5  *}
    13.6  
    13.7 -
    13.8  types ('a, 'b) table    (* table with key type 'a and contents type 'b *)
    13.9        = "'a \<leadsto> 'b"
   13.10        ('a, 'b) tables   (* non-unique table with key 'a and contents 'b *)
   13.11 @@ -148,6 +147,10 @@
   13.12   "\<lbrakk>\<forall> k y. t k = Some y \<longrightarrow> p k y; t k = Some v\<rbrakk> \<Longrightarrow> filter_tab p t k = Some v"
   13.13  by (auto simp add: filter_tab_def expand_fun_eq)
   13.14  
   13.15 +lemma filter_tab_all_False: 
   13.16 + "\<forall> k y. t k = Some y \<longrightarrow> \<not> p k y \<Longrightarrow>filter_tab p t = empty"
   13.17 +by (auto simp add: filter_tab_def expand_fun_eq)
   13.18 +
   13.19  lemma filter_tab_None: "t k = None \<Longrightarrow> filter_tab p t k = None"
   13.20  apply (simp add: filter_tab_def expand_fun_eq)
   13.21  done
   13.22 @@ -180,6 +183,7 @@
   13.23      = filter_tab filterC (cond_override overC t s)"
   13.24  by (auto simp add: expand_fun_eq cond_override_def filter_tab_def )
   13.25  
   13.26 +
   13.27  section {* Misc. *}
   13.28  
   13.29  lemma Ball_set_table: "(\<forall> (x,y)\<in> set l. P x y) \<Longrightarrow> \<forall> x. \<forall> y\<in> map_of l x: P x y"
    14.1 --- a/src/HOL/Bali/Term.thy	Thu Feb 21 20:11:32 2002 +0100
    14.2 +++ b/src/HOL/Bali/Term.thy	Fri Feb 22 11:26:44 2002 +0100
    14.3 @@ -78,7 +78,8 @@
    14.4  
    14.5  datatype var
    14.6  	= LVar                  lname(* local variable (incl. parameters) *)
    14.7 -        | FVar qtname bool expr vname(*class field*)("{_,_}_.._"[10,10,85,99]90)
    14.8 +        | FVar qtname qtname bool expr vname
    14.9 +                                (*class field*)("{_,_,_}_.._"[10,10,10,85,99]90)
   14.10  	| AVar        expr expr      (* array component *) ("_.[_]"[90,10   ]90)
   14.11  
   14.12  and expr
   14.13 @@ -91,8 +92,8 @@
   14.14  	| Acc  var                 (* variable access *)
   14.15  	| Ass  var expr            (* variable assign *) ("_:=_"   [90,85   ]85)
   14.16  	| Cond expr expr expr      (* conditional *)  ("_ ? _ : _" [85,85,80]80)
   14.17 -        | Call ref_ty inv_mode expr mname "(ty list)" (* method call *)
   14.18 -                  "(expr list)" ("{_,_}_\<cdot>_'( {_}_')"[10,10,85,99,10,10]85)
   14.19 +        | Call qtname ref_ty inv_mode expr mname "(ty list)" (* method call *)
   14.20 +                  "(expr list)" ("{_,_,_}_\<cdot>_'( {_}_')"[10,10,10,85,99,10,10]85)
   14.21          | Methd qtname sig          (*   (folded) method (see below) *)
   14.22          | Body qtname stmt          (* (unfolded) method body *)
   14.23  and  stmt
   14.24 @@ -157,75 +158,4 @@
   14.25  *}
   14.26  
   14.27  declare is_stmt_rews [simp]
   14.28 -
   14.29 -
   14.30 -(* ############# Just testing syntax *)
   14.31 -(** unfortunately cannot simply instantiate tnam **)
   14.32 -(*
   14.33 -datatype tnam_  = HasFoo_ | Base_ | Ext_
   14.34 -datatype vnam_  = arr_ | vee_ | z_ | e_
   14.35 -datatype label_ = lab1_
   14.36 -
   14.37 -consts
   14.38 -
   14.39 -  tnam_ :: "tnam_  \<Rightarrow> tnam"
   14.40 -  vnam_ :: "vnam_  \<Rightarrow> vname"
   14.41 -  label_:: "label_ \<Rightarrow> label"
   14.42 -axioms  
   14.43 -
   14.44 -  inj_tnam_  [simp]: "(tnam_  x = tnam_  y) = (x = y)"
   14.45 -  inj_vnam_  [simp]: "(vnam_  x = vnam_  y) = (x = y)"
   14.46 -  inj_label_ [simp]: "(label_ x = label_ y) = (x = y)"
   14.47 -  
   14.48 -  
   14.49 -  surj_tnam_:  "\<exists>m. n = tnam_  m"
   14.50 -  surj_vnam_:  "\<exists>m. n = vnam_  m"
   14.51 -  surj_label_:" \<exists>m. n = label_ m"
   14.52 -
   14.53 -syntax
   14.54 -
   14.55 -  HasFoo :: qtname
   14.56 -  Base   :: qtname
   14.57 -  Ext    :: qtname
   14.58 -  arr :: ename
   14.59 -  vee :: ename
   14.60 -  z   :: ename
   14.61 -  e   :: ename
   14.62 -  lab1:: label
   14.63 -
   14.64 -consts
   14.65 -  
   14.66 -  foo    :: mname
   14.67 -translations
   14.68 -
   14.69 -  "HasFoo" == "\<lparr>pid=java_lang,tid=TName (tnam_ HasFoo_)\<rparr>"
   14.70 -  "Base"   == "\<lparr>pid=java_lang,tid=TName (tnam_ Base_)\<rparr>"
   14.71 -  "Ext"    == "\<lparr>pid=java_lang,tid=TName (tnam_ Ext_)\<rparr>"
   14.72 -  "arr"    ==        "(vnam_ arr_)"
   14.73 -  "vee"    ==        "(vnam_ vee_)"
   14.74 -  "z"      ==        "(vnam_ z_)"
   14.75 -  "e"      ==        "(vnam_ e_)"
   14.76 -  "lab1"   ==        "label_ lab1_"
   14.77 -
   14.78 -constdefs test::stmt
   14.79 -"test \<equiv>
   14.80 -(lab1@ While(Acc  
   14.81 -      (Acc ({Base,True}StatRef (ClassT Object).arr).[Lit (Intg #2)])) Skip)"
   14.82 -
   14.83 -consts
   14.84 - pTs :: "ty list"
   14.85 -   
   14.86 -constdefs 
   14.87 -
   14.88 -test1::stmt
   14.89 -"test1 \<equiv> 
   14.90 -  Expr({ClassT Base,IntVir}!!e\<cdot>foo({pTs}[Lit Null]))"
   14.91 -
   14.92 -
   14.93 -
   14.94 -constdefs test::stmt
   14.95 -"test \<equiv>
   14.96 -(lab1\<cdot> While(Acc 
   14.97 -      (Acc ({Base,True}StatRef (ClassT Object)..arr).[Lit (Intg #2)])) Skip)"
   14.98 -*)
   14.99  end
  14.100 \ No newline at end of file
    15.1 --- a/src/HOL/Bali/Trans.thy	Thu Feb 21 20:11:32 2002 +0100
    15.2 +++ b/src/HOL/Bali/Trans.thy	Fri Feb 22 11:26:44 2002 +0100
    15.3 @@ -8,118 +8,153 @@
    15.4  
    15.5  PRELIMINARY!!!!!!!!
    15.6  
    15.7 +improvements over Java Specification 1.0 (cf. 15.11.4.4):
    15.8 +* dynamic method lookup does not need to check the return type
    15.9 +* throw raises a NullPointer exception if a null reference is given, and each
   15.10 +  throw of a system exception yield a fresh exception object (was not specified)
   15.11 +* if there is not enough memory even to allocate an OutOfMemory exception,
   15.12 +  evaluation/execution fails, i.e. simply stops (was not specified)
   15.13 +
   15.14 +design issues:
   15.15 +* Lit expressions and Skip statements are considered completely evaluated.
   15.16 +* the expr entry in rules is redundant in case of exceptions, but its full
   15.17 +  inclusion helps to make the rule structure independent of exception occurence.
   15.18 +* the rule format is such that the start state may contain an exception.
   15.19 +  ++ faciliates exception handling (to be added later)
   15.20 +  +  symmetry
   15.21 +* the rules are defined carefully in order to be applicable even in not
   15.22 +  type-correct situations (yielding undefined values),
   15.23 +  e.g. the_Adr (Val (Bool b)) = arbitrary.
   15.24 +  ++ fewer rules 
   15.25 +  -  less readable because of auxiliary functions like the_Adr
   15.26 +  Alternative: "defensive" evaluation throwing some InternalError exception
   15.27 +               in case of (impossible, for correct programs) type mismatches
   15.28 +
   15.29 +simplifications:
   15.30 +* just simple handling (i.e. propagation) of exceptions so far
   15.31 +* dynamic method lookup does not check return type (should not be necessary)
   15.32  *)
   15.33  
   15.34  Trans = Eval +
   15.35  
   15.36  consts
   15.37 -  texpr_tstmt	:: "prog \<Rightarrow> (((expr \<times> state) \<times> (expr \<times> state)) +
   15.38 -		            ((stmt \<times> state) \<times> (stmt \<times> state))) set"
   15.39 +  texpr_tstmt	:: "prog  (((expr  state)  (expr  state)) +
   15.40 +		            ((stmt  state)  (stmt  state))) set"
   15.41  
   15.42  syntax (symbols)
   15.43 -  texpr :: "[prog, expr \<times> state, expr \<times> state] \<Rightarrow> bool "("_\<turnstile>_ \<rightarrow>1 _"[61,82,82] 81)
   15.44 -  tstmt :: "[prog, stmt \<times> state, stmt \<times> state] \<Rightarrow> bool "("_\<turnstile>_ \<mapsto>1 _"[61,82,82] 81)
   15.45 -  Ref   :: "loc \<Rightarrow> expr"
   15.46 +  texpr :: "[prog, expr  state, expr  state]  bool "("__ 1 _"[61,82,82] 81)
   15.47 +  tstmt :: "[prog, stmt  state, stmt  state]  bool "("__ 1 _"[61,82,82] 81)
   15.48 +  Ref   :: "loc  expr"
   15.49  
   15.50  translations
   15.51  
   15.52 -  "G\<turnstile>e_s \<rightarrow>1 ex_s'" == "Inl (e_s, ex_s') \<in> texpr_tstmt G"
   15.53 -  "G\<turnstile>s_s \<mapsto>1 s'_s'" == "Inr (s_s, s'_s') \<in> texpr_tstmt G"
   15.54 +  "Ge_s 1 ex_s'" == "Inl (e_s, ex_s')  texpr_tstmt G"
   15.55 +  "Gs_s 1 s'_s'" == "Inr (s_s, s'_s')  texpr_tstmt G"
   15.56    "Ref a" == "Lit (Addr a)"
   15.57  
   15.58 +constdefs
   15.59 +  
   15.60 +  sub_expr_expr :: "(expr  expr)  prop"
   15.61 +  "sub_expr_expr ef  (G e s e' s'. G(   e,s) 1 (   e',s') 
   15.62 +				     G(ef e,s) 1 (ef e',s'))"
   15.63 +
   15.64  inductive "texpr_tstmt G" intrs 
   15.65  
   15.66  (* evaluation of expression *)
   15.67    (* cf. 15.5 *)
   15.68 -  XcptE	"\<lbrakk>\<forall>v. e \<noteq> Lit v\<rbrakk> \\<Longrightarrow>
   15.69 -				  G\<turnstile>(e,Some xc,s) \<rightarrow>1 (Lit arbitrary,Some xc,s)"
   15.70 +  XcptE	"v. e  Lit v 
   15.71 +				  G(e,Some xc,s) 1 (Lit arbitrary,Some xc,s)"
   15.72  
   15.73 + CastXX "PROP sub_expr_expr (Cast T)"
   15.74 +
   15.75 +(*
   15.76    (* cf. 15.8.1 *)
   15.77 -  NewC	"\<lbrakk>new_Addr (heap s) = Some (a,x);
   15.78 -	  s' = assign (hupd[a\<mapsto>init_Obj G C]s) (x,s)\<rbrakk> \\<Longrightarrow>
   15.79 -				G\<turnstile>(NewC C,None,s) \<rightarrow>1 (Ref a,s')"
   15.80 +  NewC	"new_Addr (heap s) = Some (a,x);
   15.81 +	  s' = assign (hupd[ainit_Obj G C]s) (x,s) 
   15.82 +				G(NewC C,None,s) 1 (Ref a,s')"
   15.83  
   15.84    (* cf. 15.9.1 *)
   15.85 -  NewA1	"\<lbrakk>G\<turnstile>(e,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
   15.86 -			      G\<turnstile>(New T[e],None,s) \<rightarrow>1 (New T[e'],s')"
   15.87 -  NewA	"\<lbrakk>i = the_Intg i'; new_Addr (heap s) = Some (a, x);
   15.88 -	  s' = assign (hupd[a\<mapsto>init_Arr T i]s)(raise_if (i<#0) NegArrSize x,s)\<rbrakk> \\<Longrightarrow>
   15.89 -			G\<turnstile>(New T[Lit i'],None,s) \<rightarrow>1 (Ref a,s')"
   15.90 +(*NewA1	"sub_expr_expr (NewA T)"*)
   15.91 +  NewA1	"G(e,None,s) 1 (e',s') 
   15.92 +			      G(New T[e],None,s) 1 (New T[e'],s')"
   15.93 +  NewA	"i = the_Intg i'; new_Addr (heap s) = Some (a, x);
   15.94 +	  s' = assign (hupd[ainit_Arr T i]s)(raise_if (i<#0) NegArrSize x,s) 
   15.95 +			G(New T[Lit i'],None,s) 1 (Ref a,s')"
   15.96    (* cf. 15.15 *)
   15.97 -  Cast1	"\<lbrakk>G\<turnstile>(e,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
   15.98 -			      G\<turnstile>(Cast T e,None,s) \<rightarrow>1 (Cast T e',s')"
   15.99 -  Cast	"\<lbrakk>x'= raise_if (\<questiondown>G,s\<turnstile>v fits T) ClassCast None\<rbrakk> \\<Longrightarrow>
  15.100 -		        G\<turnstile>(Cast T (Lit v),None,s) \<rightarrow>1 (Lit v,x',s)"
  15.101 +  Cast1	"G(e,None,s) 1 (e',s') 
  15.102 +			      G(Cast T e,None,s) 1 (Cast T e',s')"
  15.103 +  Cast	"x'= raise_if (\<questiondown>G,sv fits T) ClassCast None 
  15.104 +		        G(Cast T (Lit v),None,s) 1 (Lit v,x',s)"
  15.105  
  15.106    (* cf. 15.7.1 *)
  15.107 -(*Lit				"G\<turnstile>(Lit v,None,s) \<rightarrow>1 (Lit v,None,s)"*)
  15.108 +(*Lit				"G(Lit v,None,s) 1 (Lit v,None,s)"*)
  15.109  
  15.110    (* cf. 15.13.1, 15.2 *)
  15.111 -  LAcc	"\<lbrakk>v = the (locals s vn)\<rbrakk> \\<Longrightarrow>
  15.112 -			       G\<turnstile>(LAcc vn,None,s) \<rightarrow>1 (Lit v,None,s)"
  15.113 +  LAcc	"v = the (locals s vn) 
  15.114 +			       G(LAcc vn,None,s) 1 (Lit v,None,s)"
  15.115  
  15.116    (* cf. 15.25.1 *)
  15.117 -  LAss1	"\<lbrakk>G\<turnstile>(e,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.118 -				 G\<turnstile>(f vn:=e,None,s) \<rightarrow>1 (vn:=e',s')"
  15.119 -  LAss			    "G\<turnstile>(f vn:=Lit v,None,s) \<rightarrow>1 (Lit v,None,lupd[vn\<mapsto>v]s)"
  15.120 +  LAss1	"G(e,None,s) 1 (e',s') 
  15.121 +				 G(f vn:=e,None,s) 1 (vn:=e',s')"
  15.122 +  LAss			    "G(f vn:=Lit v,None,s) 1 (Lit v,None,lupd[vnv]s)"
  15.123  
  15.124    (* cf. 15.10.1, 15.2 *)
  15.125 -  FAcc1	"\<lbrakk>G\<turnstile>(e,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.126 -			       G\<turnstile>({T}e..fn,None,s) \<rightarrow>1 ({T}e'..fn,s')"
  15.127 -  FAcc	"\<lbrakk>v = the (snd (the_Obj (heap s (the_Addr a'))) (fn,T))\<rbrakk> \\<Longrightarrow>
  15.128 -			  G\<turnstile>({T}Lit a'..fn,None,s) \<rightarrow>1 (Lit v,np a' None,s)"
  15.129 +  FAcc1	"G(e,None,s) 1 (e',s') 
  15.130 +			       G({T}e..fn,None,s) 1 ({T}e'..fn,s')"
  15.131 +  FAcc	"v = the (snd (the_Obj (heap s (the_Addr a'))) (fn,T)) 
  15.132 +			  G({T}Lit a'..fn,None,s) 1 (Lit v,np a' None,s)"
  15.133  
  15.134    (* cf. 15.25.1 *)
  15.135 -  FAss1	"\<lbrakk>G\<turnstile>(e1,None,s) \<rightarrow>1 (e1',s')\<rbrakk> \\<Longrightarrow>
  15.136 -			  G\<turnstile>(f ({T}e1..fn):=e2,None,s) \<rightarrow>1 (f({T}e1'..fn):=e2,s')"
  15.137 -  FAss2	"\<lbrakk>G\<turnstile>(e2,np a' None,s) \<rightarrow>1 (e2',s')\<rbrakk> \\<Longrightarrow>
  15.138 -		      G\<turnstile>(f({T}Lit a'..fn):=e2,None,s) \<rightarrow>1 (f({T}Lit a'..fn):=e2',s')"
  15.139 -  FAss	"\<lbrakk>a = the_Addr a'; (c,fs) = the_Obj (heap s a);
  15.140 -	  s'= assign (hupd[a\<mapsto>Obj c (fs[(fn,T)\<mapsto>v])]s) (None,s)\<rbrakk> \\<Longrightarrow>
  15.141 -		   G\<turnstile>(f({T}Lit a'..fn):=Lit v,None,s) \<rightarrow>1 (Lit v,s')"
  15.142 +  FAss1	"G(e1,None,s) 1 (e1',s') 
  15.143 +			  G(f ({T}e1..fn):=e2,None,s) 1 (f({T}e1'..fn):=e2,s')"
  15.144 +  FAss2	"G(e2,np a' None,s) 1 (e2',s') 
  15.145 +		      G(f({T}Lit a'..fn):=e2,None,s) 1 (f({T}Lit a'..fn):=e2',s')"
  15.146 +  FAss	"a = the_Addr a'; (c,fs) = the_Obj (heap s a);
  15.147 +	  s'= assign (hupd[aObj c (fs[(fn,T)v])]s) (None,s) 
  15.148 +		   G(f({T}Lit a'..fn):=Lit v,None,s) 1 (Lit v,s')"
  15.149  
  15.150  
  15.151  
  15.152  
  15.153  
  15.154    (* cf. 15.12.1 *)
  15.155 -  AAcc1	"\<lbrakk>G\<turnstile>(e1,None,s) \<rightarrow>1 (e1',s')\<rbrakk> \\<Longrightarrow>
  15.156 -				G\<turnstile>(e1[e2],None,s) \<rightarrow>1 (e1'[e2],s')"
  15.157 -  AAcc2	"\<lbrakk>G\<turnstile>(e2,None,s) \<rightarrow>1 (e2',s')\<rbrakk> \\<Longrightarrow>
  15.158 -			    G\<turnstile>(Lit a'[e2],None,s) \<rightarrow>1 (Lit a'[e2'],s')"
  15.159 -  AAcc	"\<lbrakk>vo = snd (the_Arr (heap s (the_Addr a'))) (the_Intg i');
  15.160 -	  x' = raise_if (vo = None) IndOutBound (np a' None)\<rbrakk> \\<Longrightarrow>
  15.161 -			G\<turnstile>(Lit a'[Lit i'],None,s) \<rightarrow>1 (Lit (the vo),x',s)"
  15.162 +  AAcc1	"G(e1,None,s) 1 (e1',s') 
  15.163 +				G(e1[e2],None,s) 1 (e1'[e2],s')"
  15.164 +  AAcc2	"G(e2,None,s) 1 (e2',s') 
  15.165 +			    G(Lit a'[e2],None,s) 1 (Lit a'[e2'],s')"
  15.166 +  AAcc	"vo = snd (the_Arr (heap s (the_Addr a'))) (the_Intg i');
  15.167 +	  x' = raise_if (vo = None) IndOutBound (np a' None) 
  15.168 +			G(Lit a'[Lit i'],None,s) 1 (Lit (the vo),x',s)"
  15.169  
  15.170  
  15.171    (* cf. 15.11.4.1, 15.11.4.2, 15.11.4.4, 15.11.4.5, 14.15 *)
  15.172 -  Call1	"\<lbrakk>G\<turnstile>(e,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.173 -			  G\<turnstile>(e..mn({pT}p),None,s) \<rightarrow>1 (e'..mn({pT}p),s')"
  15.174 -  Call2	"\<lbrakk>G\<turnstile>(p,None,s) \<rightarrow>1 (p',s')\<rbrakk> \\<Longrightarrow>
  15.175 -		     G\<turnstile>(Lit a'..mn({pT}p),None,s) \<rightarrow>1 (Lit a'..mn({pT}p'),s')"
  15.176 -  Call	"\<lbrakk>a = the_Addr a'; (md,(pn,rT),lvars,blk,res) = 
  15.177 - 			   the (cmethd G (fst (the_Obj (h a))) (mn,pT))\<rbrakk> \\<Longrightarrow>
  15.178 -	    G\<turnstile>(Lit a'..mn({pT}Lit pv),None,(h,l)) \<rightarrow>1 
  15.179 -      (Body blk res l,np a' x,(h,init_vals lvars[This\<mapsto>a'][Super\<mapsto>a'][pn\<mapsto>pv]))"
  15.180 -  Body1	"\<lbrakk>G\<turnstile>(s0,None,s) \<mapsto>1 (s0',s')\<rbrakk> \\<Longrightarrow>
  15.181 -		   G\<turnstile>(Body s0    e      l,None,s) \<rightarrow>1 (Body s0'  e  l,s')"
  15.182 -  Body2	"\<lbrakk>G\<turnstile>(e ,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.183 -		   G\<turnstile>(Body Skip  e      l,None,s) \<rightarrow>1 (Body Skip e' l,s')"
  15.184 -  Body		  "G\<turnstile>(Body Skip (Lit v) l,None,s) \<rightarrow>1 (Lit v,None,(heap s,l))"
  15.185 +  Call1	"G(e,None,s) 1 (e',s') 
  15.186 +			  G(e..mn({pT}p),None,s) 1 (e'..mn({pT}p),s')"
  15.187 +  Call2	"G(p,None,s) 1 (p',s') 
  15.188 +		     G(Lit a'..mn({pT}p),None,s) 1 (Lit a'..mn({pT}p'),s')"
  15.189 +  Call	"a = the_Addr a'; (md,(pn,rT),lvars,blk,res) = 
  15.190 + 			   the (cmethd G (fst (the_Obj (h a))) (mn,pT)) 
  15.191 +	    G(Lit a'..mn({pT}Lit pv),None,(h,l)) 1 
  15.192 +      (Body blk res l,np a' x,(h,init_vals lvars[Thisa'][Supera'][pnpv]))"
  15.193 +  Body1	"G(s0,None,s) 1 (s0',s') 
  15.194 +		   G(Body s0    e      l,None,s) 1 (Body s0'  e  l,s')"
  15.195 +  Body2	"G(e ,None,s) 1 (e',s') 
  15.196 +		   G(Body Skip  e      l,None,s) 1 (Body Skip e' l,s')"
  15.197 +  Body		  "G(Body Skip (Lit v) l,None,s) 1 (Lit v,None,(heap s,l))"
  15.198  
  15.199  (* execution of statements *)
  15.200  
  15.201    (* cf. 14.1 *)
  15.202 -  XcptS	"\<lbrakk>s0 \<noteq> Skip\<rbrakk> \\<Longrightarrow>
  15.203 -				 G\<turnstile>(s0,Some xc,s) \<mapsto>1 (Skip,Some xc,s)"
  15.204 +  XcptS	"s0  Skip 
  15.205 +				 G(s0,Some xc,s) 1 (Skip,Some xc,s)"
  15.206  
  15.207    (* cf. 14.5 *)
  15.208 -(*Skip	 			 "G\<turnstile>(Skip,None,s) \<mapsto>1 (Skip,None,s)"*)
  15.209 +(*Skip	 			 "G(Skip,None,s) 1 (Skip,None,s)"*)
  15.210  
  15.211    (* cf. 14.2 *)
  15.212 -  Comp1	"\<lbrakk>G\<turnstile>(s1,None,s) \<mapsto>1 (s1',s')\<rbrakk> \\<Longrightarrow>
  15.213 -			       G\<turnstile>(s1;; s2,None,s) \<mapsto>1 (s1';; s2,s')"
  15.214 -  Comp			    "G\<turnstile>(Skip;; s2,None,s) \<mapsto>1 (s2,None,s)"
  15.215 +  Comp1	"G(s1,None,s) 1 (s1',s') 
  15.216 +			       G(s1;; s2,None,s) 1 (s1';; s2,s')"
  15.217 +  Comp			    "G(Skip;; s2,None,s) 1 (s2,None,s)"
  15.218  
  15.219  
  15.220  
  15.221 @@ -127,18 +162,20 @@
  15.222  
  15.223  
  15.224    (* cf. 14.7 *)
  15.225 -  Expr1	"\<lbrakk>G\<turnstile>(e ,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.226 -				G\<turnstile>(Expr e,None,s) \<mapsto>1 (Expr e',s')"
  15.227 -  Expr			 "G\<turnstile>(Expr (Lit v),None,s) \<mapsto>1 (Skip,None,s)"
  15.228 +  Expr1	"G(e ,None,s) 1 (e',s') 
  15.229 +				G(Expr e,None,s) 1 (Expr e',s')"
  15.230 +  Expr			 "G(Expr (Lit v),None,s) 1 (Skip,None,s)"
  15.231  
  15.232    (* cf. 14.8.2 *)
  15.233 -  If1	"\<lbrakk>G\<turnstile>(e ,None,s) \<rightarrow>1 (e',s')\<rbrakk> \\<Longrightarrow>
  15.234 -		      G\<turnstile>(If(e) s1 Else s2,None,s) \<mapsto>1 (If(e') s1 Else s2,s')"
  15.235 -  If		 "G\<turnstile>(If(Lit v) s1 Else s2,None,s) \<mapsto>1 
  15.236 +  If1	"G(e ,None,s) 1 (e',s') 
  15.237 +		      G(If(e) s1 Else s2,None,s) 1 (If(e') s1 Else s2,s')"
  15.238 +  If		 "G(If(Lit v) s1 Else s2,None,s) 1 
  15.239  		    (if the_Bool v then s1 else s2,None,s)"
  15.240  
  15.241    (* cf. 14.10, 14.10.1 *)
  15.242 -  Loop			  "G\<turnstile>(While(e) s0,None,s) \<mapsto>1 
  15.243 +  Loop			  "G(While(e) s0,None,s) 1 
  15.244  			     (If(e) (s0;; While(e) s0) Else Skip,None,s)"
  15.245 +*)
  15.246 +  con_defs "[sub_expr_expr_def]"
  15.247  
  15.248  end
    16.1 --- a/src/HOL/Bali/TypeSafe.thy	Thu Feb 21 20:11:32 2002 +0100
    16.2 +++ b/src/HOL/Bali/TypeSafe.thy	Fri Feb 22 11:26:44 2002 +0100
    16.3 @@ -1,20 +1,105 @@
    16.4  (*  Title:      HOL/Bali/TypeSafe.thy
    16.5      ID:         $Id$
    16.6 -    Author:     David von Oheimb
    16.7 +    Author:     David von Oheimb and Norbert Schirmer
    16.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
    16.9  *)
   16.10  header {* The type soundness proof for Java *}
   16.11  
   16.12 +theory TypeSafe = Eval + WellForm + Conform:
   16.13  
   16.14 -theory TypeSafe = Eval + WellForm + Conform:
   16.15 +section "error free"
   16.16 + 
   16.17 +lemma error_free_halloc:
   16.18 + (assumes halloc: "G\<turnstile>s0 \<midarrow>halloc oi\<succ>a\<rightarrow> s1" and
   16.19 +          error_free_s0: "error_free s0"
   16.20 + ) "error_free s1"
   16.21 +proof -
   16.22 +  from halloc error_free_s0
   16.23 +  obtain abrupt0 store0 abrupt1 store1
   16.24 +    where eqs: "s0=(abrupt0,store0)" "s1=(abrupt1,store1)" and
   16.25 +          halloc': "G\<turnstile>(abrupt0,store0) \<midarrow>halloc oi\<succ>a\<rightarrow> (abrupt1,store1)" and
   16.26 +          error_free_s0': "error_free (abrupt0,store0)"
   16.27 +    by (cases s0,cases s1) auto
   16.28 +  from halloc' error_free_s0'
   16.29 +  have "error_free (abrupt1,store1)"
   16.30 +  proof (induct)
   16.31 +    case Abrupt 
   16.32 +    then show ?case
   16.33 +      .
   16.34 +  next
   16.35 +    case New
   16.36 +    then show ?case
   16.37 +      by (auto split: split_if_asm)
   16.38 +  qed
   16.39 +  with eqs 
   16.40 +  show ?thesis
   16.41 +    by simp
   16.42 +qed
   16.43 +
   16.44 +lemma error_free_sxalloc:
   16.45 + (assumes sxalloc: "G\<turnstile>s0 \<midarrow>sxalloc\<rightarrow> s1" and error_free_s0: "error_free s0") 
   16.46 + "error_free s1"
   16.47 +proof -
   16.48 +  from sxalloc error_free_s0
   16.49 +  obtain abrupt0 store0 abrupt1 store1
   16.50 +    where eqs: "s0=(abrupt0,store0)" "s1=(abrupt1,store1)" and
   16.51 +          sxalloc': "G\<turnstile>(abrupt0,store0) \<midarrow>sxalloc\<rightarrow> (abrupt1,store1)" and
   16.52 +          error_free_s0': "error_free (abrupt0,store0)"
   16.53 +    by (cases s0,cases s1) auto
   16.54 +  from sxalloc' error_free_s0'
   16.55 +  have "error_free (abrupt1,store1)"
   16.56 +  proof (induct)
   16.57 +  qed (auto)
   16.58 +  with eqs 
   16.59 +  show ?thesis 
   16.60 +    by simp
   16.61 +qed
   16.62 +
   16.63 +lemma error_free_check_field_access_eq:
   16.64 + "error_free (check_field_access G accC statDeclC fn stat a s)
   16.65 + \<Longrightarrow> (check_field_access G accC statDeclC fn stat a s) = s"
   16.66 +apply (cases s)
   16.67 +apply (auto simp add: check_field_access_def Let_def error_free_def 
   16.68 +                      abrupt_if_def 
   16.69 +            split: split_if_asm)
   16.70 +done
   16.71 +
   16.72 +lemma error_free_check_method_access_eq:
   16.73 +"error_free (check_method_access G accC statT mode sig a' s)
   16.74 + \<Longrightarrow> (check_method_access G accC statT mode sig a' s) = s"
   16.75 +apply (cases s)
   16.76 +apply (auto simp add: check_method_access_def Let_def error_free_def 
   16.77 +                      abrupt_if_def 
   16.78 +            split: split_if_asm)
   16.79 +done
   16.80 +
   16.81 +lemma error_free_FVar_lemma: 
   16.82 +     "error_free s 
   16.83 +       \<Longrightarrow> error_free (abupd (if stat then id else np a) s)"
   16.84 +  by (case_tac s) (auto split: split_if) 
   16.85 +
   16.86 +lemma error_free_init_lvars [simp,intro]:
   16.87 +"error_free s \<Longrightarrow> 
   16.88 +  error_free (init_lvars G C sig mode a pvs s)"
   16.89 +by (cases s) (auto simp add: init_lvars_def Let_def split: split_if)
   16.90 +
   16.91 +lemma error_free_LVar_lemma:   
   16.92 +"error_free s \<Longrightarrow> error_free (assign (\<lambda>v. supd lupd(vn\<mapsto>v)) w s)"
   16.93 +by (cases s) simp
   16.94 +
   16.95 +lemma error_free_throw [simp,intro]:
   16.96 +  "error_free s \<Longrightarrow> error_free (abupd (throw x) s)"
   16.97 +by (cases s) (simp add: throw_def)
   16.98 +
   16.99  
  16.100  section "result conformance"
  16.101  
  16.102  constdefs
  16.103    assign_conforms :: "st \<Rightarrow> (val \<Rightarrow> state \<Rightarrow> state) \<Rightarrow> ty \<Rightarrow> env_ \<Rightarrow> bool"
  16.104            ("_\<le>|_\<preceq>_\<Colon>\<preceq>_"                                        [71,71,71,71] 70)
  16.105 - "s\<le>|f\<preceq>T\<Colon>\<preceq>E \<equiv>
  16.106 -  \<forall>s' w. Norm s'\<Colon>\<preceq>E \<longrightarrow> fst E,s'\<turnstile>w\<Colon>\<preceq>T \<longrightarrow> s\<le>|s' \<longrightarrow> assign f w (Norm s')\<Colon>\<preceq>E"
  16.107 +"s\<le>|f\<preceq>T\<Colon>\<preceq>E \<equiv>
  16.108 + (\<forall>s' w. Norm s'\<Colon>\<preceq>E \<longrightarrow> fst E,s'\<turnstile>w\<Colon>\<preceq>T \<longrightarrow> s\<le>|s' \<longrightarrow> assign f w (Norm s')\<Colon>\<preceq>E) \<and>
  16.109 + (\<forall>s' w. error_free s' \<longrightarrow> (error_free (assign f w s')))"      
  16.110  
  16.111    rconf :: "prog \<Rightarrow> lenv \<Rightarrow> st \<Rightarrow> term \<Rightarrow> vals \<Rightarrow> tys \<Rightarrow> bool"
  16.112            ("_,_,_\<turnstile>_\<succ>_\<Colon>\<preceq>_"                               [71,71,71,71,71,71] 70)
  16.113 @@ -91,7 +176,8 @@
  16.114  prefer 24 
  16.115    apply (case_tac "inited C (globs s0)", clarsimp, erule thin_rl) (* Init *)
  16.116  apply (auto del: conjI  dest!: not_initedD gext_new sxalloc_gext halloc_gext
  16.117 - simp  add: lvar_def fvar_def2 avar_def2 init_lvars_def2
  16.118 + simp  add: lvar_def fvar_def2 avar_def2 init_lvars_def2 
  16.119 +            check_field_access_def check_method_access_def Let_def
  16.120   split del: split_if_asm split add: sum3.split)
  16.121  (* 6 subgoals *)
  16.122  apply force+
  16.123 @@ -162,7 +248,7 @@
  16.124  
  16.125  lemma fst_init_lvars[simp]: 
  16.126   "fst (init_lvars G C sig (invmode m e) a' pvs (x,s)) = 
  16.127 -  (if static m then x else (np a') x)"
  16.128 +  (if is_static m then x else (np a') x)"
  16.129  apply (simp (no_asm) add: init_lvars_def2)
  16.130  done
  16.131  
  16.132 @@ -175,7 +261,8 @@
  16.133         intro!: conforms_newG [THEN conforms_xconf] conf_AddrI)
  16.134  done
  16.135  
  16.136 -lemma halloc_type_sound: "\<And>s1. \<lbrakk>G\<turnstile>s1 \<midarrow>halloc oi\<succ>a\<rightarrow> (x,s); wf_prog G; s1\<Colon>\<preceq>(G, L);
  16.137 +lemma halloc_type_sound: 
  16.138 +"\<And>s1. \<lbrakk>G\<turnstile>s1 \<midarrow>halloc oi\<succ>a\<rightarrow> (x,s); wf_prog G; s1\<Colon>\<preceq>(G, L);
  16.139    T = obj_ty \<lparr>tag=oi,values=fs\<rparr>; is_type G T\<rbrakk> \<Longrightarrow>  
  16.140    (x,s)\<Colon>\<preceq>(G, L) \<and> (x = None \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq>T)"
  16.141  apply (auto elim!: halloc_conforms)
  16.142 @@ -348,38 +435,34 @@
  16.143      qed
  16.144    qed
  16.145  qed
  16.146 -   
  16.147 -declare split_paired_All [simp del] split_paired_Ex [simp del] 
  16.148 -ML_setup {*
  16.149 -simpset_ref() := simpset() delloop "split_all_tac";
  16.150 -claset_ref () := claset () delSWrapper "split_all_tac"
  16.151 -*}
  16.152 +
  16.153  lemma DynT_mheadsD: 
  16.154 -"\<lbrakk>G\<turnstile>invmode (mhd sm) e\<rightarrow>invC\<preceq>statT; 
  16.155 +"\<lbrakk>G\<turnstile>invmode sm e\<rightarrow>invC\<preceq>statT; 
  16.156    wf_prog G; \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT; 
  16.157 -  sm \<in> mheads G C statT sig; 
  16.158 -  invC = invocation_class (invmode (mhd sm) e) s a' statT;
  16.159 -  declC =invocation_declclass G (invmode (mhd sm) e) s a' statT sig
  16.160 +  (statDeclT,sm) \<in> mheads G C statT sig; 
  16.161 +  invC = invocation_class (invmode sm e) s a' statT;
  16.162 +  declC =invocation_declclass G (invmode sm e) s a' statT sig
  16.163   \<rbrakk> \<Longrightarrow> 
  16.164    \<exists> dm. 
  16.165 -  methd G declC sig = Some dm  \<and> G\<turnstile>resTy (mthd dm)\<preceq>resTy (mhd sm) \<and> 
  16.166 +  methd G declC sig = Some dm \<and> dynlookup G statT invC sig = Some dm  \<and> 
  16.167 +  G\<turnstile>resTy (mthd dm)\<preceq>resTy sm \<and> 
  16.168    wf_mdecl G declC (sig, mthd dm) \<and>
  16.169    declC = declclass dm \<and>
  16.170    is_static dm = is_static sm \<and>  
  16.171    is_class G invC \<and> is_class G declC  \<and> G\<turnstile>invC\<preceq>\<^sub>C declC \<and>  
  16.172 -  (if invmode (mhd sm) e = IntVir
  16.173 +  (if invmode sm e = IntVir
  16.174        then (\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>invC \<preceq>\<^sub>C statC)
  16.175        else (  (\<exists> statC. statT=ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C declC)
  16.176              \<or> (\<forall> statC. statT\<noteq>ClassT statC \<and> declC=Object)) \<and> 
  16.177 -           (declrefT sm) = ClassT (declclass dm))"
  16.178 +            statDeclT = ClassT (declclass dm))"
  16.179  proof -
  16.180 -  assume invC_prop: "G\<turnstile>invmode (mhd sm) e\<rightarrow>invC\<preceq>statT" 
  16.181 +  assume invC_prop: "G\<turnstile>invmode sm e\<rightarrow>invC\<preceq>statT" 
  16.182       and        wf: "wf_prog G" 
  16.183       and      wt_e: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT"
  16.184 -     and        sm: "sm \<in> mheads G C statT sig" 
  16.185 -     and      invC: "invC = invocation_class (invmode (mhd sm) e) s a' statT"
  16.186 +     and        sm: "(statDeclT,sm) \<in> mheads G C statT sig" 
  16.187 +     and      invC: "invC = invocation_class (invmode sm e) s a' statT"
  16.188       and     declC: "declC = 
  16.189 -                    invocation_declclass G (invmode (mhd sm) e) s a' statT sig"
  16.190 +                    invocation_declclass G (invmode sm e) s a' statT sig"
  16.191    from wt_e wf have type_statT: "is_type G (RefT statT)"
  16.192      by (auto dest: ty_expr_is_type)
  16.193    from sm have not_Null: "statT \<noteq> NullT" by auto
  16.194 @@ -388,13 +471,13 @@
  16.195      by (auto)
  16.196    from type_statT wt_e 
  16.197    have wf_I: "(\<forall>I. statT = IfaceT I \<longrightarrow> is_iface G I \<and> 
  16.198 -                                        invmode (mhd sm) e \<noteq> SuperM)"
  16.199 +                                        invmode sm e \<noteq> SuperM)"
  16.200      by (auto dest: invocationTypeExpr_noClassD)
  16.201    from wt_e
  16.202 -  have wf_A: "(\<forall>     T. statT = ArrayT T \<longrightarrow> invmode (mhd sm) e \<noteq> SuperM)"
  16.203 +  have wf_A: "(\<forall>     T. statT = ArrayT T \<longrightarrow> invmode sm e \<noteq> SuperM)"
  16.204      by (auto dest: invocationTypeExpr_noClassD)
  16.205    show ?thesis
  16.206 -  proof (cases "invmode (mhd sm) e = IntVir")
  16.207 +  proof (cases "invmode sm e = IntVir")
  16.208      case True
  16.209      with invC_prop not_Null
  16.210      have invC_prop': " is_class G invC \<and> 
  16.211 @@ -403,15 +486,15 @@
  16.212        by (auto simp add: DynT_prop_def) 
  16.213      from True 
  16.214      have "\<not> is_static sm"
  16.215 -      by (simp add: invmode_IntVir_eq)
  16.216 +      by (simp add: invmode_IntVir_eq member_is_static_simp)
  16.217      with invC_prop' not_Null
  16.218      have "G,statT \<turnstile> invC valid_lookup_cls_for (is_static sm)"
  16.219        by (cases statT) auto
  16.220      with sm wf type_statT obtain dm where
  16.221             dm: "dynlookup G statT invC sig = Some dm" and
  16.222 -      resT_dm: "G\<turnstile>resTy (mthd dm)\<preceq>resTy (mhd sm)"      and
  16.223 +      resT_dm: "G\<turnstile>resTy (mthd dm)\<preceq>resTy sm"      and
  16.224         static: "is_static dm = is_static sm"
  16.225 -      by - (drule dynamic_mheadsD,auto)
  16.226 +      by  - (drule dynamic_mheadsD,force+)
  16.227      with declC invC not_Null 
  16.228      have declC': "declC = (declclass dm)" 
  16.229        by (auto simp add: invocation_declclass_def)
  16.230 @@ -428,13 +511,14 @@
  16.231      have statC_prop: "(\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>invC \<preceq>\<^sub>C statC)"
  16.232        by auto
  16.233      from True dm' resT_dm wf_dm invC_prop' declC_prop statC_prop declC' static
  16.234 +         dm
  16.235      show ?thesis by auto
  16.236    next
  16.237      case False
  16.238      with type_statT wf invC not_Null wf_I wf_A
  16.239      have invC_prop': "is_class G invC \<and>  
  16.240                       ((\<exists> statC. statT=ClassT statC \<and> invC=statC) \<or>
  16.241 -                      (\<forall> statC. statT\<noteq>ClassT statC \<and> invC=Object)) "
  16.242 +                      (\<forall> statC. statT\<noteq>ClassT statC \<and> invC=Object))"
  16.243          by (case_tac "statT") (auto simp add: invocation_class_def 
  16.244                                         split: inv_mode.splits)
  16.245      with not_Null wf
  16.246 @@ -443,16 +527,19 @@
  16.247                                              dynimethd_def)
  16.248      from sm wf wt_e not_Null False invC_prop' obtain "dm" where
  16.249                      dm: "methd G invC sig = Some dm"          and
  16.250 -	eq_declC_sm_dm:"declrefT sm = ClassT (declclass dm)"  and
  16.251 -	     eq_mheads:"mhd sm=mhead (mthd dm) "
  16.252 -      by - (drule static_mheadsD, auto dest: accmethd_SomeD)
  16.253 -    then have static: "is_static dm = is_static sm" by - (case_tac "sm",auto)
  16.254 +	eq_declC_sm_dm:"statDeclT = ClassT (declclass dm)"  and
  16.255 +	     eq_mheads:"sm=mhead (mthd dm) "
  16.256 +      by - (drule static_mheadsD, (force dest: accmethd_SomeD)+)
  16.257 +    then have static: "is_static dm = is_static sm" by - (auto)
  16.258      with declC invC dynlookup_static dm
  16.259      have declC': "declC = (declclass dm)"  
  16.260        by (auto simp add: invocation_declclass_def)
  16.261      from invC_prop' wf declC' dm 
  16.262      have dm': "methd G declC sig = Some dm"
  16.263        by (auto intro: methd_declclass)
  16.264 +    from dynlookup_static dm 
  16.265 +    have dm'': "dynlookup G statT invC sig = Some dm"
  16.266 +      by simp
  16.267      from wf dm invC_prop' declC' type_statT 
  16.268      have declC_prop: "G\<turnstile>invC \<preceq>\<^sub>C declC \<and> is_class G declC"
  16.269        by (auto dest: methd_declC )
  16.270 @@ -464,126 +551,11 @@
  16.271      have statC_prop: "(   (\<exists> statC. statT=ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C declC)
  16.272                         \<or>  (\<forall> statC. statT\<noteq>ClassT statC \<and> declC=Object))" 
  16.273        by auto
  16.274 -    from False dm' wf_dm invC_prop' declC_prop statC_prop declC' 
  16.275 +    from False dm' dm'' wf_dm invC_prop' declC_prop statC_prop declC' 
  16.276           eq_declC_sm_dm eq_mheads static
  16.277      show ?thesis by auto
  16.278    qed
  16.279 -qed
  16.280 -
  16.281 -(*
  16.282 -lemma DynT_mheadsD: 
  16.283 -"\<lbrakk>G\<turnstile>invmode (mhd sm) e\<rightarrow>invC\<preceq>statT; 
  16.284 -  wf_prog G; \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT; 
  16.285 -  sm \<in> mheads G C statT sig; 
  16.286 -  invC = invocation_class (invmode (mhd sm) e) s a' statT;
  16.287 -  declC =invocation_declclass G (invmode (mhd sm) e) s a' statT sig
  16.288 - \<rbrakk> \<Longrightarrow> 
  16.289 -  \<exists> dm. 
  16.290 -  methd G declC sig = Some dm  \<and> G\<turnstile>resTy (mthd dm)\<preceq>resTy (mhd sm) \<and> 
  16.291 -  wf_mdecl G declC (sig, mthd dm) \<and>  
  16.292 -  is_class G invC \<and> is_class G declC  \<and> G\<turnstile>invC\<preceq>\<^sub>C declC \<and>  
  16.293 -  (if invmode (mhd sm) e = IntVir
  16.294 -      then (\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>invC \<preceq>\<^sub>C statC)
  16.295 -      else (\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>statC \<preceq>\<^sub>C declC) \<and> 
  16.296 -           (declrefT sm) = ClassT (declclass dm))"
  16.297 -proof -
  16.298 -  assume invC_prop: "G\<turnstile>invmode (mhd sm) e\<rightarrow>invC\<preceq>statT" 
  16.299 -     and        wf: "wf_prog G" 
  16.300 -     and      wt_e: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT"
  16.301 -     and        sm: "sm \<in> mheads G C statT sig" 
  16.302 -     and      invC: "invC = invocation_class (invmode (mhd sm) e) s a' statT"
  16.303 -     and     declC: "declC = 
  16.304 -                    invocation_declclass G (invmode (mhd sm) e) s a' statT sig"
  16.305 -  from wt_e wf have type_statT: "is_type G (RefT statT)"
  16.306 -    by (auto dest: ty_expr_is_type)
  16.307 -  from sm have not_Null: "statT \<noteq> NullT" by auto
  16.308 -  from type_statT 
  16.309 -  have wf_C: "(\<forall> statC. statT = ClassT statC \<longrightarrow> is_class G statC)"
  16.310 -    by (auto)
  16.311 -  from type_statT wt_e 
  16.312 -  have wf_I: "(\<forall>I. statT = IfaceT I \<longrightarrow> is_iface G I \<and> 
  16.313 -                                        invmode (mhd sm) e \<noteq> SuperM)"
  16.314 -    by (auto dest: invocationTypeExpr_noClassD)
  16.315 -  from wt_e
  16.316 -  have wf_A: "(\<forall>     T. statT = ArrayT T \<longrightarrow> invmode (mhd sm) e \<noteq> SuperM)"
  16.317 -    by (auto dest: invocationTypeExpr_noClassD)
  16.318 -  show ?thesis
  16.319 -  proof (cases "invmode (mhd sm) e = IntVir")
  16.320 -    case True
  16.321 -    with invC_prop not_Null
  16.322 -    have invC_prop': "is_class G invC \<and>  
  16.323 -                      (if (\<exists>T. statT=ArrayT T) then invC=Object 
  16.324 -                                              else G\<turnstile>Class invC\<preceq>RefT statT)"
  16.325 -      by (auto simp add: DynT_prop_def) 
  16.326 -    with sm wf type_statT not_Null obtain dm where
  16.327 -           dm: "dynlookup G statT invC sig = Some dm" and
  16.328 -      resT_dm: "G\<turnstile>resTy (mthd dm)\<preceq>resTy (mhd sm)"
  16.329 -      by - (clarify,drule dynamic_mheadsD,auto)
  16.330 -    with declC invC not_Null 
  16.331 -    have declC': "declC = (declclass dm)" 
  16.332 -      by (auto simp add: invocation_declclass_def)
  16.333 -    with wf invC declC not_Null wf_C wf_I wf_A invC_prop dm 
  16.334 -    have dm': "methd G declC sig = Some dm"
  16.335 -      by - (drule invocation_methd,auto)
  16.336 -    from wf dm invC_prop' declC' type_statT 
  16.337 -    have declC_prop: "G\<turnstile>invC \<preceq>\<^sub>C declC \<and> is_class G declC"
  16.338 -      by (auto dest: dynlookup_declC)
  16.339 -    from wf dm' declC_prop declC' 
  16.340 -    have wf_dm: "wf_mdecl G declC (sig,(mthd dm))"
  16.341 -      by (auto dest: methd_wf_mdecl)
  16.342 -    from invC_prop' 
  16.343 -    have statC_prop: "(\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>invC \<preceq>\<^sub>C statC)"
  16.344 -      by auto
  16.345 -    from True dm' resT_dm wf_dm invC_prop' declC_prop statC_prop
  16.346 -    show ?thesis by auto
  16.347 -  next
  16.348 -    case False
  16.349 -    
  16.350 -    with type_statT wf invC not_Null wf_I wf_A
  16.351 -    have invC_prop': "is_class G invC \<and>  
  16.352 -                     ((\<exists> statC. statT=ClassT statC \<and> invC=statC) \<or>
  16.353 -                      (\<forall> statC. statT\<noteq>ClassT statC \<and> invC=Object)) "
  16.354 -        
  16.355 -        by (case_tac "statT") (auto simp add: invocation_class_def 
  16.356 -                                       split: inv_mode.splits)
  16.357 -    with not_Null 
  16.358 -    have dynlookup_static: "dynlookup G statT invC sig = methd G invC sig"
  16.359 -      by (case_tac "statT") (auto simp add: dynlookup_def dynmethd_def 
  16.360 -                                            dynimethd_def)
  16.361 -    from sm wf wt_e not_Null False invC_prop' obtain "dm" where
  16.362 -                    dm: "methd G invC sig = Some dm"          and
  16.363 -	eq_declC_sm_dm:"declrefT sm = ClassT (declclass dm)"  and
  16.364 -	     eq_mheads:"mhd sm=mhead (mthd dm) "
  16.365 -      by - (drule static_mheadsD, auto dest: accmethd_SomeD)
  16.366 -    with declC invC dynlookup_static dm
  16.367 -    have declC': "declC = (declclass dm)"  
  16.368 -      by (auto simp add: invocation_declclass_def)
  16.369 -    from invC_prop' wf declC' dm 
  16.370 -    have dm': "methd G declC sig = Some dm"
  16.371 -      by (auto intro: methd_declclass)
  16.372 -    from wf dm invC_prop' declC' type_statT 
  16.373 -    have declC_prop: "G\<turnstile>invC \<preceq>\<^sub>C declC \<and> is_class G declC"
  16.374 -      by (auto dest: methd_declC )   
  16.375 -    from wf dm' declC_prop declC' 
  16.376 -    have wf_dm: "wf_mdecl G declC (sig,(mthd dm))"
  16.377 -      by (auto dest: methd_wf_mdecl)
  16.378 -    from invC_prop' declC_prop
  16.379 -    have statC_prop: "(\<forall> statC. statT=ClassT statC \<longrightarrow> G\<turnstile>statC \<preceq>\<^sub>C declC)" 
  16.380 -      by auto
  16.381 -    from False dm' wf_dm invC_prop' declC_prop statC_prop 
  16.382 -         eq_declC_sm_dm eq_mheads
  16.383 -    show ?thesis by auto
  16.384 -  qed
  16.385 -qed	
  16.386 -*)
  16.387 -
  16.388 -declare split_paired_All [simp del] split_paired_Ex [simp del] 
  16.389 -declare split_if     [split del] split_if_asm     [split del] 
  16.390 -        option.split [split del] option.split_asm [split del]
  16.391 -ML_setup {*
  16.392 -simpset_ref() := simpset() delloop "split_all_tac";
  16.393 -claset_ref () := claset () delSWrapper "split_all_tac"
  16.394 -*}
  16.395 +qed   
  16.396  
  16.397  lemma DynT_conf: "\<lbrakk>G\<turnstile>invocation_class mode s a' statT \<preceq>\<^sub>C declC; wf_prog G;
  16.398   isrtype G (statT);
  16.399 @@ -604,12 +576,11 @@
  16.400  apply    (erule (1) conf_widen) apply (erule wf_ws_prog)
  16.401  done
  16.402  
  16.403 -
  16.404 -lemma Ass_lemma: 
  16.405 - "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>va=\<succ>(w, f)\<rightarrow> Norm s1; G\<turnstile>Norm s1 \<midarrow>e-\<succ>v\<rightarrow> Norm s2; G,s2\<turnstile>v\<Colon>\<preceq>T'; 
  16.406 -   s1\<le>|s2 \<longrightarrow> assign f v (Norm s2)\<Colon>\<preceq>(G, L)
  16.407 -  \<rbrakk> \<Longrightarrow> assign f v (Norm s2)\<Colon>\<preceq>(G, L) \<and> 
  16.408 -        (\<lambda>(x',s'). x' = None \<longrightarrow> G,s'\<turnstile>v\<Colon>\<preceq>T') (assign f v (Norm s2))"
  16.409 +lemma Ass_lemma:
  16.410 +"\<lbrakk> G\<turnstile>Norm s0 \<midarrow>var=\<succ>(w, f)\<rightarrow> Norm s1; G\<turnstile>Norm s1 \<midarrow>e-\<succ>v\<rightarrow> Norm s2;
  16.411 +   G,s2\<turnstile>v\<Colon>\<preceq>eT;s1\<le>|s2 \<longrightarrow> assign f v (Norm s2)\<Colon>\<preceq>(G, L)\<rbrakk>
  16.412 +\<Longrightarrow> assign f v (Norm s2)\<Colon>\<preceq>(G, L) \<and>
  16.413 +      (normal (assign f v (Norm s2)) \<longrightarrow> G,store (assign f v (Norm s2))\<turnstile>v\<Colon>\<preceq>eT)"
  16.414  apply (drule_tac x = "None" and s = "s2" and v = "v" in evar_gext_f)
  16.415  apply (drule eval_gext', clarsimp)
  16.416  apply (erule conf_gext)
  16.417 @@ -639,14 +610,18 @@
  16.418  apply (force elim: eval_gext' conforms_xgext split add: split_abrupt_if)
  16.419  done
  16.420  
  16.421 -lemma FVar_lemma1: "\<lbrakk>table_of (DeclConcepts.fields G Ca) (fn, C) = Some f ; 
  16.422 -  x2 = None \<longrightarrow> G,s2\<turnstile>a\<Colon>\<preceq> Class Ca; wf_prog G; G\<turnstile>Ca\<preceq>\<^sub>C C; C \<noteq> Object; 
  16.423 -  class G C = Some y; (x2,s2)\<Colon>\<preceq>(G, L); s1\<le>|s2; inited C (globs s1); 
  16.424 +lemma FVar_lemma1: 
  16.425 +"\<lbrakk>table_of (DeclConcepts.fields G statC) (fn, statDeclC) = Some f ; 
  16.426 +  x2 = None \<longrightarrow> G,s2\<turnstile>a\<Colon>\<preceq> Class statC; wf_prog G; G\<turnstile>statC\<preceq>\<^sub>C statDeclC; 
  16.427 +  statDeclC \<noteq> Object; 
  16.428 +  class G statDeclC = Some y; (x2,s2)\<Colon>\<preceq>(G, L); s1\<le>|s2; 
  16.429 +  inited statDeclC (globs s1); 
  16.430    (if static f then id else np a) x2 = None\<rbrakk> 
  16.431   \<Longrightarrow>  
  16.432 -  \<exists>obj. globs s2 (if static f then Inr C else Inl (the_Addr a)) = Some obj \<and> 
  16.433 -  var_tys G (tag obj)  (if static f then Inr C else Inl(the_Addr a)) 
  16.434 -          (Inl(fn,C)) = Some (type f)"
  16.435 +  \<exists>obj. globs s2 (if static f then Inr statDeclC else Inl (the_Addr a)) 
  16.436 +                  = Some obj \<and> 
  16.437 +  var_tys G (tag obj)  (if static f then Inr statDeclC else Inl(the_Addr a)) 
  16.438 +          (Inl(fn,statDeclC)) = Some (type f)"
  16.439  apply (drule initedD)
  16.440  apply (frule subcls_is_class2, simp (no_asm_simp))
  16.441  apply (case_tac "static f")
  16.442 @@ -665,11 +640,39 @@
  16.443  apply (auto elim!: fields_mono subcls_is_class2)
  16.444  done
  16.445  
  16.446 +lemma FVar_lemma2: "error_free state
  16.447 +       \<Longrightarrow> error_free
  16.448 +           (assign
  16.449 +             (\<lambda>v. supd
  16.450 +                   (upd_gobj
  16.451 +                     (if static field then Inr statDeclC
  16.452 +                      else Inl (the_Addr a))
  16.453 +                     (Inl (fn, statDeclC)) v))
  16.454 +             w state)"
  16.455 +proof -
  16.456 +  assume error_free: "error_free state"
  16.457 +  obtain a s where "state=(a,s)"
  16.458 +    by (cases state) simp
  16.459 +  with error_free
  16.460 +  show ?thesis
  16.461 +    by (cases a) auto
  16.462 +qed
  16.463 +
  16.464 +declare split_paired_All [simp del] split_paired_Ex [simp del] 
  16.465 +declare split_if     [split del] split_if_asm     [split del] 
  16.466 +        option.split [split del] option.split_asm [split del]
  16.467 +ML_setup {*
  16.468 +simpset_ref() := simpset() delloop "split_all_tac";
  16.469 +claset_ref () := claset () delSWrapper "split_all_tac"
  16.470 +*}
  16.471  lemma FVar_lemma: 
  16.472 -"\<lbrakk>((v, f), Norm s2') = fvar C (static field) fn a (x2, s2); G\<turnstile>Ca\<preceq>\<^sub>C C;  
  16.473 -  table_of (DeclConcepts.fields G Ca) (fn, C) = Some field; wf_prog G;   
  16.474 -  x2 = None \<longrightarrow> G,s2\<turnstile>a\<Colon>\<preceq>Class Ca; C \<noteq> Object; class G C = Some y;   
  16.475 -  (x2, s2)\<Colon>\<preceq>(G, L); s1\<le>|s2; inited C (globs s1)\<rbrakk> \<Longrightarrow>  
  16.476 +"\<lbrakk>((v, f), Norm s2') = fvar statDeclC (static field) fn a (x2, s2); 
  16.477 +  G\<turnstile>statC\<preceq>\<^sub>C statDeclC;  
  16.478 +  table_of (DeclConcepts.fields G statC) (fn, statDeclC) = Some field; 
  16.479 +  wf_prog G;   
  16.480 +  x2 = None \<longrightarrow> G,s2\<turnstile>a\<Colon>\<preceq>Class statC; 
  16.481 +  statDeclC \<noteq> Object; class G statDeclC = Some y;   
  16.482 +  (x2, s2)\<Colon>\<preceq>(G, L); s1\<le>|s2; inited statDeclC (globs s1)\<rbrakk> \<Longrightarrow>  
  16.483    G,s2'\<turnstile>v\<Colon>\<preceq>type field \<and> s2'\<le>|f\<preceq>type field\<Colon>\<preceq>(G, L)"
  16.484  apply (unfold assign_conforms_def)
  16.485  apply (drule sym)
  16.486 @@ -678,9 +681,20 @@
  16.487  apply (clarsimp)
  16.488  apply (drule (2) conforms_globsD [THEN oconf_lconf, THEN lconfD])
  16.489  apply clarsimp
  16.490 -apply (drule (1) rev_gext_objD)
  16.491 -apply (auto elim!: conforms_upd_gobj)
  16.492 +apply (rule conjI)
  16.493 +apply   clarsimp
  16.494 +apply   (drule (1) rev_gext_objD)
  16.495 +apply   (force elim!: conforms_upd_gobj)
  16.496 +
  16.497 +apply   (blast intro: FVar_lemma2)
  16.498  done
  16.499 +declare split_paired_All [simp] split_paired_Ex [simp] 
  16.500 +declare split_if     [split] split_if_asm     [split] 
  16.501 +        option.split [split] option.split_asm [split]
  16.502 +ML_setup {*
  16.503 +claset_ref()  := claset() addSbefore ("split_all_tac", split_all_tac);
  16.504 +simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
  16.505 +*}
  16.506  
  16.507  
  16.508  lemma AVar_lemma1: "\<lbrakk>globs s (Inl a) = Some obj;tag obj=Arr ty i; 
  16.509 @@ -700,6 +714,22 @@
  16.510      by auto
  16.511  qed
  16.512   
  16.513 +lemma AVar_lemma2: "error_free state 
  16.514 +       \<Longrightarrow> error_free
  16.515 +           (assign
  16.516 +             (\<lambda>v (x, s').
  16.517 +                 ((raise_if (\<not> G,s'\<turnstile>v fits T) ArrStore) x,
  16.518 +                  upd_gobj (Inl a) (Inr (the_Intg i)) v s'))
  16.519 +             w state)"
  16.520 +proof -
  16.521 +  assume error_free: "error_free state"
  16.522 +  obtain a s where "state=(a,s)"
  16.523 +    by (cases state) simp
  16.524 +  with error_free
  16.525 +  show ?thesis
  16.526 +    by (cases a) auto
  16.527 +qed
  16.528 +
  16.529  lemma AVar_lemma: "\<lbrakk>wf_prog G; G\<turnstile>(x1, s1) \<midarrow>e2-\<succ>i\<rightarrow> (x2, s2);  
  16.530    ((v,f), Norm s2') = avar G i a (x2, s2); x1 = None \<longrightarrow> G,s1\<turnstile>a\<Colon>\<preceq>Ta.[];  
  16.531    (x2, s2)\<Colon>\<preceq>(G, L); s1\<le>|s2\<rbrakk> \<Longrightarrow> G,s2'\<turnstile>v\<Colon>\<preceq>Ta \<and> s2'\<le>|f\<preceq>Ta\<Colon>\<preceq>(G, L)"
  16.532 @@ -714,14 +744,14 @@
  16.533  apply clarify
  16.534  apply (frule obj_ty_widenD)
  16.535  apply (auto dest!: widen_Class)
  16.536 -apply  (force dest: AVar_lemma1)
  16.537 -apply (auto split add: split_if)
  16.538 -apply (force elim!: fits_Array dest: gext_objD 
  16.539 -       intro: var_tys_Some_eq [THEN iffD2] conforms_upd_gobj)
  16.540 +apply   (force dest: AVar_lemma1)
  16.541 +
  16.542 +apply   (force elim!: fits_Array dest: gext_objD 
  16.543 +         intro: var_tys_Some_eq [THEN iffD2] conforms_upd_gobj)
  16.544  done
  16.545  
  16.546 +section "Call"
  16.547  
  16.548 -section "Call"
  16.549  lemma conforms_init_lvars_lemma: "\<lbrakk>wf_prog G;  
  16.550    wf_mhead G P sig mh; 
  16.551    Ball (set lvars) (split (\<lambda>vn. is_type G)); 
  16.552 @@ -763,7 +793,13 @@
  16.553  apply (auto intro: prim_ty.induct)
  16.554  done
  16.555  
  16.556 -
  16.557 +declare split_paired_All [simp del] split_paired_Ex [simp del] 
  16.558 +declare split_if     [split del] split_if_asm     [split del] 
  16.559 +        option.split [split del] option.split_asm [split del]
  16.560 +ML_setup {*
  16.561 +simpset_ref() := simpset() delloop "split_all_tac";
  16.562 +claset_ref () := claset () delSWrapper "split_all_tac"
  16.563 +*}
  16.564  lemma conforms_init_lvars: 
  16.565  "\<lbrakk>wf_mhead G (pid declC) sig (mhead (mthd dm)); wf_prog G;  
  16.566    list_all2 (conf G s) pvs pTsa; G\<turnstile>pTsa[\<preceq>](parTs sig);  
  16.567 @@ -789,7 +825,7 @@
  16.568                                    \<Rightarrow> (table_of (lcls (mbody (mthd dm)))
  16.569                                          (pars (mthd dm)[\<mapsto>]parTs sig)) v
  16.570                                 | Res \<Rightarrow> Some (resTy (mthd dm)))
  16.571 -                 | This \<Rightarrow> if (static (mthd sm)) 
  16.572 +                 | This \<Rightarrow> if (is_static (mthd sm)) 
  16.573                                then None else Some (Class declC)))"
  16.574  apply (simp add: init_lvars_def2)
  16.575  apply (rule conforms_set_locals)
  16.576 @@ -806,103 +842,58 @@
  16.577  apply (case_tac "is_static sm")
  16.578  apply simp_all
  16.579  done
  16.580 -
  16.581 +declare split_paired_All [simp] split_paired_Ex [simp] 
  16.582 +declare split_if     [split] split_if_asm     [split] 
  16.583 +        option.split [split] option.split_asm [split]
  16.584 +ML_setup {*
  16.585 +claset_ref()  := claset() addSbefore ("split_all_tac", split_all_tac);
  16.586 +simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
  16.587 +*}
  16.588  
  16.589 -lemma Call_type_sound: "\<lbrakk>wf_prog G; G\<turnstile>(x1, s1) \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2, s2);  
  16.590 - declC 
  16.591 - = invocation_declclass G (invmode (mhd esm) e) s2 a' statT \<lparr>name=mn,parTs=pTs\<rparr>;
  16.592 -s2'=init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> (invmode (mhd esm) e) a' pvs (x2,s2);
  16.593 - G\<turnstile>s2' \<midarrow>Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ>v\<rightarrow> (x3, s3);    
  16.594 - \<forall>L. s2'\<Colon>\<preceq>(G, L) 
  16.595 -     \<longrightarrow> (\<forall>T. \<lparr>prg=G,cls=declC,lcl=L\<rparr>\<turnstile> Methd declC \<lparr>name=mn,parTs=pTs\<rparr>\<Colon>-T 
  16.596 -     \<longrightarrow> (x3, s3)\<Colon>\<preceq>(G, L) \<and> (x3 = None \<longrightarrow> G,s3\<turnstile>v\<Colon>\<preceq>T));  
  16.597 - Norm s0\<Colon>\<preceq>(G, L); 
  16.598 - \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT; \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>ps\<Colon>\<doteq>pTsa;  
  16.599 - max_spec G C statT \<lparr>name=mn,parTs=pTsa\<rparr> = {(esm, pTs)}; 
  16.600 - (x1, s1)\<Colon>\<preceq>(G, L); 
  16.601 - x1 = None \<longrightarrow> G,s1\<turnstile>a'\<Colon>\<preceq>RefT statT; (x2, s2)\<Colon>\<preceq>(G, L);  
  16.602 - x2 = None \<longrightarrow> list_all2 (conf G s2) pvs pTsa;
  16.603 - sm=(mhd esm)\<rbrakk> \<Longrightarrow>     
  16.604 - (x3, set_locals (locals s2) s3)\<Colon>\<preceq>(G, L) \<and> 
  16.605 - (x3 = None \<longrightarrow> G,s3\<turnstile>v\<Colon>\<preceq>resTy sm)"
  16.606 -apply clarify
  16.607 -apply (case_tac "x2")
  16.608 -defer
  16.609 -apply  (clarsimp split add: split_if_asm simp add: init_lvars_def2)
  16.610 -apply (case_tac "a' = Null \<and> \<not> (static (mhd esm)) \<and> e \<noteq> Super")
  16.611 -apply  (clarsimp simp add: init_lvars_def2)
  16.612 -apply clarsimp
  16.613 -apply (drule eval_gext')
  16.614 -apply (frule (1) conf_gext)
  16.615 -apply (drule max_spec2mheads, clarsimp)
  16.616 -apply (subgoal_tac "invmode (mhd esm) e = IntVir \<longrightarrow> a' \<noteq> Null")
  16.617 -defer  
  16.618 -apply  (clarsimp simp add: invmode_IntVir_eq)
  16.619 -apply (frule (6) DynT_mheadsD [OF DynT_propI,of _ "s2"],(rule HOL.refl)+)
  16.620 -apply clarify
  16.621 -apply (drule wf_mdeclD1, clarsimp) 
  16.622 -apply (frule  ty_expr_is_type) apply simp
  16.623 -apply (frule (2) conforms_init_lvars)
  16.624 -apply   simp
  16.625 -apply   assumption+
  16.626 -apply   simp
  16.627 -apply   assumption+
  16.628 -apply   clarsimp
  16.629 -apply   (rule HOL.refl)
  16.630 -apply   simp
  16.631 -apply   (rule Ball_weaken)
  16.632 -apply     assumption
  16.633 -apply     (force simp add: is_acc_type_def)
  16.634 -apply (tactic "smp_tac 1 1")
  16.635 -apply (frule (2) wt_MethdI, clarsimp)
  16.636 -apply (subgoal_tac "is_static dm = (static (mthd esm))") 
  16.637 -apply   (simp only:)
  16.638 -apply   (tactic "smp_tac 1 1")
  16.639 -apply   (rule conjI)
  16.640 -apply     (erule  conforms_return)
  16.641 -apply     blast
  16.642 -
  16.643 -apply     (force dest!: eval_gext del: impCE simp add: init_lvars_def2)
  16.644 -apply     clarsimp
  16.645 -apply     (drule (2) widen_trans, erule (1) conf_widen)
  16.646 -apply     (erule wf_ws_prog)
  16.647 -
  16.648 -apply   auto
  16.649 -done
  16.650  
  16.651  
  16.652  subsection "accessibility"
  16.653  
  16.654 +
  16.655 +(* #### stat raus und gleich is_static f schreiben *) 
  16.656  theorem dynamic_field_access_ok:
  16.657    (assumes wf: "wf_prog G" and
  16.658 -       eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2" and
  16.659 -     not_Null: "a\<noteq>Null" and
  16.660 -    conform_a: "G,(store s2)\<turnstile>a\<Colon>\<preceq> Class statC" and
  16.661 -   conform_s2: "s2\<Colon>\<preceq>(G, L)" and 
  16.662 -    normal_s2: "normal s2" and
  16.663 -         wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>,dt\<Turnstile>e\<Colon>-Class statC" and
  16.664 +     not_Null: "\<not> stat \<longrightarrow> a\<noteq>Null" and
  16.665 +    conform_a: "G,(store s)\<turnstile>a\<Colon>\<preceq> Class statC" and
  16.666 +    conform_s: "s\<Colon>\<preceq>(G, L)" and 
  16.667 +     normal_s: "normal s" and
  16.668 +         wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
  16.669              f: "accfield G accC statC fn = Some f" and
  16.670 -         dynC: "if stat then dynC=statC  
  16.671 -                        else dynC=obj_class (lookup_obj (store s2) a)"
  16.672 +         dynC: "if stat then dynC=declclass f  
  16.673 +                        else dynC=obj_class (lookup_obj (store s) a)" and
  16.674 +         stat: "if stat then (is_static f) else (\<not> is_static f)"
  16.675    ) "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f) \<and> 
  16.676       G\<turnstile>Field fn f in dynC dyn_accessible_from accC"
  16.677  proof (cases "stat")
  16.678    case True
  16.679 -  with dynC 
  16.680 -  have dynC': "dynC=statC" by simp
  16.681 +  with stat have static: "(is_static f)" by simp
  16.682 +  from True dynC 
  16.683 +  have dynC': "dynC=declclass f" by simp
  16.684    with f
  16.685 -  have "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f)"
  16.686 +  have "table_of (DeclConcepts.fields G statC) (fn,declclass f) = Some (fld f)"
  16.687      by (auto simp add: accfield_def Let_def intro!: table_of_remap_SomeD)
  16.688 -  with dynC' f
  16.689 +  moreover
  16.690 +  from wt_e wf have "is_class G statC"
  16.691 +    by (auto dest!: ty_expr_is_type)
  16.692 +  moreover note wf dynC'
  16.693 +  ultimately have
  16.694 +     "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f)"
  16.695 +    by (auto dest: fields_declC)
  16.696 +  with dynC' f static wf
  16.697    show ?thesis
  16.698 -    by (auto intro!: static_to_dynamic_accessible_from
  16.699 -         dest: accfield_accessibleD accessible_from_commonD)
  16.700 +    by (auto dest: static_to_dynamic_accessible_from_static
  16.701 +            dest!: accfield_accessibleD )
  16.702  next
  16.703    case False
  16.704 -  with wf conform_a not_Null conform_s2 dynC
  16.705 +  with wf conform_a not_Null conform_s dynC
  16.706    obtain subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  16.707      "is_class G dynC"
  16.708 -    by (auto dest!: conforms_RefTD [of _ _ _ _ "(fst s2)" L]
  16.709 +    by (auto dest!: conforms_RefTD [of _ _ _ _ "(fst s)" L]
  16.710                dest: obj_ty_obj_class1
  16.711            simp add: obj_ty_obj_class )
  16.712    with wf f
  16.713 @@ -919,12 +910,167 @@
  16.714      by blast
  16.715  qed
  16.716  
  16.717 -lemma call_access_ok: 
  16.718 -(assumes invC_prop: "G\<turnstile>invmode (mhd statM) e\<rightarrow>invC\<preceq>statT" 
  16.719 +(*
  16.720 +theorem dynamic_field_access_ok:
  16.721 +  (assumes wf: "wf_prog G" and
  16.722 +     not_Null: "\<not> is_static f \<longrightarrow> a\<noteq>Null" and
  16.723 +    conform_a: "G,(store s)\<turnstile>a\<Colon>\<preceq> Class statC" and
  16.724 +    conform_s: "s\<Colon>\<preceq>(G, L)" and 
  16.725 +     normal_s: "normal s" and
  16.726 +         wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
  16.727 +            f: "accfield G accC statC fn = Some f" and
  16.728 +         dynC: "if is_static f 
  16.729 +                   then dynC=declclass f  
  16.730 +                   else dynC=obj_class (lookup_obj (store s) a)" 
  16.731 +  ) "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f) \<and> 
  16.732 +     G\<turnstile>Field fn f in dynC dyn_accessible_from accC"
  16.733 +proof (cases "is_static f")
  16.734 +  case True
  16.735 +  from True dynC 
  16.736 +  have dynC': "dynC=declclass f" by simp
  16.737 +  with f
  16.738 +  have "table_of (DeclConcepts.fields G statC) (fn,declclass f) = Some (fld f)"
  16.739 +    by (auto simp add: accfield_def Let_def intro!: table_of_remap_SomeD)
  16.740 +  moreover
  16.741 +  from wt_e wf have "is_class G statC"
  16.742 +    by (auto dest!: ty_expr_is_type)
  16.743 +  moreover note wf dynC'
  16.744 +  ultimately have
  16.745 +     "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f)"
  16.746 +    by (auto dest: fields_declC)
  16.747 +  with dynC' f True wf
  16.748 +  show ?thesis
  16.749 +    by (auto dest: static_to_dynamic_accessible_from_static
  16.750 +            dest!: accfield_accessibleD )
  16.751 +next
  16.752 +  case False
  16.753 +  with wf conform_a not_Null conform_s dynC
  16.754 +  obtain subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  16.755 +    "is_class G dynC"
  16.756 +    by (auto dest!: conforms_RefTD [of _ _ _ _ "(fst s)" L]
  16.757 +              dest: obj_ty_obj_class1
  16.758 +          simp add: obj_ty_obj_class )
  16.759 +  with wf f
  16.760 +  have "table_of (DeclConcepts.fields G dynC) (fn,declclass f) = Some (fld f)"
  16.761 +    by (auto simp add: accfield_def Let_def
  16.762 +                 dest: fields_mono
  16.763 +                dest!: table_of_remap_SomeD)
  16.764 +  moreover
  16.765 +  from f subclseq
  16.766 +  have "G\<turnstile>Field fn f in dynC dyn_accessible_from accC"
  16.767 +    by (auto intro!: static_to_dynamic_accessible_from 
  16.768 +               dest: accfield_accessibleD)
  16.769 +  ultimately show ?thesis
  16.770 +    by blast
  16.771 +qed
  16.772 +*)
  16.773 +
  16.774 +
  16.775 +(* ### Einsetzen in case FVar des TypeSoundness Proofs *)
  16.776 +(*
  16.777 +lemma FVar_check_error_free:
  16.778 +(assumes fvar: "(v, s2') = fvar statDeclC stat fn a s2" and 
  16.779 +        check: "s3 = check_field_access G accC statDeclC fn stat a s2'" and
  16.780 +       conf_a: "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC" and
  16.781 +      conf_s2: "s2\<Colon>\<preceq>(G, L)" and
  16.782 +    initd_statDeclC_s2: "initd statDeclC s2" and
  16.783 +    wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
  16.784 +    accfield: "accfield G accC statC fn = Some (statDeclC,f)" and
  16.785 +    stat: "stat=is_static f" and
  16.786 +      wf: "wf_prog G"
  16.787 +)  "s3=s2'"
  16.788 +proof -
  16.789 +  from fvar 
  16.790 +  have store_s2': "store s2'=store s2"
  16.791 +    by (cases s2) (simp add: fvar_def2)
  16.792 +  with fvar conf_s2 
  16.793 +  have conf_s2': "s2'\<Colon>\<preceq>(G, L)"
  16.794 +    by (cases s2,cases stat) (auto simp add: fvar_def2)
  16.795 +  from initd_statDeclC_s2 store_s2' 
  16.796 +  have initd_statDeclC_s2': "initd statDeclC s2"
  16.797 +    by simp
  16.798 +  show ?thesis
  16.799 +  proof (cases "normal s2'")
  16.800 +    case False
  16.801 +    with check show ?thesis 
  16.802 +      by (auto simp add: check_field_access_def Let_def)
  16.803 +  next
  16.804 +    case True
  16.805 +    with fvar store_s2' 
  16.806 +    have not_Null: "\<not> stat \<longrightarrow> a\<noteq>Null" 
  16.807 +      by (cases s2) (auto simp add: fvar_def2)
  16.808 +    from True fvar store_s2'
  16.809 +    have "normal s2"
  16.810 +      by (cases s2,cases stat) (auto simp add: fvar_def2)
  16.811 +    with conf_a store_s2'
  16.812 +    have conf_a': "G,store s2'\<turnstile>a\<Colon>\<preceq>Class statC"
  16.813 +      by simp 
  16.814 +    from conf_a' conf_s2'  check True initd_statDeclC_s2' 
  16.815 +      dynamic_field_access_ok [OF wf not_Null conf_a' conf_s2' 
  16.816 +                                   True wt_e accfield ] stat
  16.817 +    show ?thesis
  16.818 +      by (cases stat)
  16.819 +         (auto dest!: initedD
  16.820 +           simp add: check_field_access_def Let_def)
  16.821 +  qed
  16.822 +qed
  16.823 +*)
  16.824 +
  16.825 +lemma error_free_field_access:
  16.826 + (assumes accfield: "accfield G accC statC fn = Some (statDeclC, f)" and
  16.827 +              wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-Class statC" and
  16.828 +         eval_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1" and
  16.829 +            eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2" and
  16.830 +           conf_s2: "s2\<Colon>\<preceq>(G, L)" and
  16.831 +            conf_a: "normal s2 \<Longrightarrow> G, store s2\<turnstile>a\<Colon>\<preceq>Class statC" and
  16.832 +              fvar: "(v,s2')=fvar statDeclC (is_static f) fn a s2" and
  16.833 +                wf: "wf_prog G"   
  16.834 + ) "check_field_access G accC statDeclC fn (is_static f) a s2' = s2'"
  16.835 +proof -
  16.836 +  from fvar
  16.837 +  have store_s2': "store s2'=store s2"
  16.838 +    by (cases s2) (simp add: fvar_def2)
  16.839 +  with fvar conf_s2 
  16.840 +  have conf_s2': "s2'\<Colon>\<preceq>(G, L)"
  16.841 +    by (cases s2,cases "is_static f") (auto simp add: fvar_def2)
  16.842 +  from eval_init 
  16.843 +  have initd_statDeclC_s1: "initd statDeclC s1"
  16.844 +    by (rule init_yields_initd)
  16.845 +  with eval_e store_s2'
  16.846 +  have initd_statDeclC_s2': "initd statDeclC s2'"
  16.847 +    by (auto dest: eval_gext intro: inited_gext)
  16.848 +  show ?thesis
  16.849 +  proof (cases "normal s2'")
  16.850 +    case False
  16.851 +    then show ?thesis 
  16.852 +      by (auto simp add: check_field_access_def Let_def)
  16.853 +  next
  16.854 +    case True
  16.855 +    with fvar store_s2' 
  16.856 +    have not_Null: "\<not> (is_static f) \<longrightarrow> a\<noteq>Null" 
  16.857 +      by (cases s2) (auto simp add: fvar_def2)
  16.858 +    from True fvar store_s2'
  16.859 +    have "normal s2"
  16.860 +      by (cases s2,cases "is_static f") (auto simp add: fvar_def2)
  16.861 +    with conf_a store_s2'
  16.862 +    have conf_a': "G,store s2'\<turnstile>a\<Colon>\<preceq>Class statC"
  16.863 +      by simp
  16.864 +    from conf_a' conf_s2' True initd_statDeclC_s2' 
  16.865 +      dynamic_field_access_ok [OF wf not_Null conf_a' conf_s2' 
  16.866 +                                   True wt_e accfield ] 
  16.867 +    show ?thesis
  16.868 +      by  (cases "is_static f")
  16.869 +          (auto dest!: initedD
  16.870 +           simp add: check_field_access_def Let_def)
  16.871 +  qed
  16.872 +qed
  16.873 +
  16.874 +lemma call_access_ok:
  16.875 +(assumes invC_prop: "G\<turnstile>invmode statM e\<rightarrow>invC\<preceq>statT" 
  16.876       and        wf: "wf_prog G" 
  16.877       and      wt_e: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT"
  16.878 -     and     statM: "statM \<in> mheads G accC statT sig" 
  16.879 -     and      invC: "invC = invocation_class (invmode (mhd statM) e) s a statT"
  16.880 +     and     statM: "(statDeclT,statM) \<in> mheads G accC statT sig" 
  16.881 +     and      invC: "invC = invocation_class (invmode statM e) s a statT"
  16.882  )"\<exists> dynM. dynlookup G statT invC sig = Some dynM \<and>
  16.883    G\<turnstile>Methd sig dynM in invC dyn_accessible_from accC"
  16.884  proof -
  16.885 @@ -933,13 +1079,13 @@
  16.886    from statM have not_Null: "statT \<noteq> NullT" by auto
  16.887    from type_statT wt_e 
  16.888    have wf_I: "(\<forall>I. statT = IfaceT I \<longrightarrow> is_iface G I \<and> 
  16.889 -                                        invmode (mhd statM) e \<noteq> SuperM)"
  16.890 +                                        invmode statM e \<noteq> SuperM)"
  16.891      by (auto dest: invocationTypeExpr_noClassD)
  16.892    from wt_e
  16.893 -  have wf_A: "(\<forall>     T. statT = ArrayT T \<longrightarrow> invmode (mhd statM) e \<noteq> SuperM)"
  16.894 +  have wf_A: "(\<forall>     T. statT = ArrayT T \<longrightarrow> invmode statM e \<noteq> SuperM)"
  16.895      by (auto dest: invocationTypeExpr_noClassD)
  16.896    show ?thesis
  16.897 -  proof (cases "invmode (mhd statM) e = IntVir")
  16.898 +  proof (cases "invmode statM e = IntVir")
  16.899      case True
  16.900      with invC_prop not_Null
  16.901      have invC_prop': "is_class G invC \<and>  
  16.902 @@ -948,8 +1094,7 @@
  16.903        by (auto simp add: DynT_prop_def)
  16.904      with True not_Null
  16.905      have "G,statT \<turnstile> invC valid_lookup_cls_for is_static statM"
  16.906 -     by (cases statT) (auto simp add: invmode_def 
  16.907 -                         split: split_if split_if_asm) (*  was deleted above *)
  16.908 +     by (cases statT) (auto simp add: invmode_def) 
  16.909      with statM type_statT wf 
  16.910      show ?thesis
  16.911        by - (rule dynlookup_access,auto)
  16.912 @@ -970,242 +1115,1227 @@
  16.913       by (auto dest!: static_mheadsD)
  16.914     from invC_prop' False not_Null wf_I
  16.915     have "G,statT \<turnstile> invC valid_lookup_cls_for is_static statM"
  16.916 -     by (cases statT) (auto simp add: invmode_def
  16.917 -                        split: split_if split_if_asm) (*  was deleted above *)
  16.918 +     by (cases statT) (auto simp add: invmode_def) 
  16.919     with statM type_statT wf 
  16.920      show ?thesis
  16.921        by - (rule dynlookup_access,auto)
  16.922    qed
  16.923  qed
  16.924  
  16.925 +lemma error_free_call_access:
  16.926 + (assumes     
  16.927 +   eval_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2" and
  16.928 +        wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-(RefT statT)" and  
  16.929 +       statM: "max_spec G accC statT \<lparr>name = mn, parTs = pTs\<rparr> 
  16.930 +               = {((statDeclT, statM), pTs')}" and
  16.931 +     conf_s2: "s2\<Colon>\<preceq>(G, L)" and
  16.932 +      conf_a: "normal s1 \<Longrightarrow> G, store s1\<turnstile>a\<Colon>\<preceq>RefT statT" and
  16.933 +     invProp: "normal s3 \<Longrightarrow>
  16.934 +                G\<turnstile>invmode statM e\<rightarrow>invC\<preceq>statT" and
  16.935 +          s3: "s3=init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> 
  16.936 +                        (invmode statM e) a vs s2" and
  16.937 +        invC: "invC = invocation_class (invmode statM e) (store s2) a statT"and
  16.938 +    invDeclC: "invDeclC = invocation_declclass G (invmode statM e) (store s2) 
  16.939 +                             a statT \<lparr>name = mn, parTs = pTs'\<rparr>" and
  16.940 +          wf: "wf_prog G"
  16.941 + )"check_method_access G accC statT (invmode statM e) \<lparr>name=mn,parTs=pTs'\<rparr> a s3
  16.942 +   = s3"
  16.943 +proof (cases "normal s2")
  16.944 +  case False
  16.945 +  with s3 
  16.946 +  have "abrupt s3 = abrupt s2"  
  16.947 +    by (auto simp add: init_lvars_def2)
  16.948 +  with False
  16.949 +  show ?thesis
  16.950 +    by (auto simp add: check_method_access_def Let_def)
  16.951 +next
  16.952 +  case True
  16.953 +  note normal_s2 = True
  16.954 +  with eval_args
  16.955 +  have normal_s1: "normal s1"
  16.956 +    by (cases "normal s1") auto
  16.957 +  with conf_a eval_args 
  16.958 +  have conf_a_s2: "G, store s2\<turnstile>a\<Colon>\<preceq>RefT statT"
  16.959 +    by (auto dest: eval_gext intro: conf_gext)
  16.960 +  show ?thesis
  16.961 +  proof (cases "a=Null \<longrightarrow> (is_static statM)")
  16.962 +    case False
  16.963 +    then obtain "\<not> is_static statM" "a=Null" 
  16.964 +      by blast
  16.965 +    with normal_s2 s3
  16.966 +    have "abrupt s3 = Some (Xcpt (Std NullPointer))" 
  16.967 +      by (auto simp add: init_lvars_def2)
  16.968 +    then show ?thesis
  16.969 +      by (auto simp add: check_method_access_def Let_def)
  16.970 +  next
  16.971 +    case True
  16.972 +    from statM 
  16.973 +    obtain
  16.974 +      statM': "(statDeclT,statM)\<in>mheads G accC statT \<lparr>name=mn,parTs=pTs'\<rparr>" 
  16.975 +      by (blast dest: max_spec2mheads)
  16.976 +    from True normal_s2 s3
  16.977 +    have "normal s3"
  16.978 +      by (auto simp add: init_lvars_def2)
  16.979 +    then have "G\<turnstile>invmode statM e\<rightarrow>invC\<preceq>statT"
  16.980 +      by (rule invProp)
  16.981 +    with wt_e statM' wf invC
  16.982 +    obtain dynM where 
  16.983 +      dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  16.984 +      acc_dynM: "G \<turnstile>Methd  \<lparr>name=mn,parTs=pTs'\<rparr> dynM 
  16.985 +                          in invC dyn_accessible_from accC"
  16.986 +      by (force dest!: call_access_ok)
  16.987 +    moreover
  16.988 +    from s3 invC
  16.989 +    have invC': "invC=(invocation_class (invmode statM e) (store s3) a statT)"
  16.990 +      by (cases s2,cases "invmode statM e") 
  16.991 +         (simp add: init_lvars_def2 del: invmode_Static_eq)+
  16.992 +    ultimately
  16.993 +    show ?thesis
  16.994 +      by (auto simp add: check_method_access_def Let_def)
  16.995 +  qed
  16.996 +qed
  16.997 +
  16.998  section "main proof of type safety"
  16.999  
 16.1000 -ML {*
 16.1001 -val forward_hyp_tac = EVERY' [smp_tac 1,
 16.1002 -	FIRST'[mp_tac,etac exI,smp_tac 2,smp_tac 1,EVERY'[etac impE,etac exI]],
 16.1003 -	REPEAT o (etac conjE)];
 16.1004 -val typD_tac = eresolve_tac (thms "wt_elim_cases") THEN_ALL_NEW 
 16.1005 -	EVERY' [full_simp_tac (simpset() setloop (K no_tac)), 
 16.1006 -         clarify_tac(claset() addSEs[])]
 16.1007 -*}
 16.1008 -
 16.1009 -lemma conforms_locals [rule_format]: 
 16.1010 -  "(a,b)\<Colon>\<preceq>(G, L) \<longrightarrow> L x = Some T \<longrightarrow> G,b\<turnstile>the (locals b x)\<Colon>\<preceq>T"
 16.1011 -apply (force simp: conforms_def Let_def lconf_def)
 16.1012 -done
 16.1013 -
 16.1014 -lemma eval_type_sound [rule_format (no_asm)]: 
 16.1015 - "wf_prog G \<Longrightarrow> G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1) \<Longrightarrow> (\<forall>L. s0\<Colon>\<preceq>(G,L) \<longrightarrow>    
 16.1016 -  (\<forall>C T. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T \<longrightarrow> s1\<Colon>\<preceq>(G,L) \<and>  
 16.1017 -  (let (x,s) = s1 in x = None \<longrightarrow> G,L,s\<turnstile>t\<succ>v\<Colon>\<preceq>T)))"
 16.1018 -apply (erule eval_induct)
 16.1019 -
 16.1020 -(* 29 subgoals *)
 16.1021 -(* Xcpt, Inst, Methd, Nil, Skip, Expr, Comp *)
 16.1022 -apply         (simp_all (no_asm_use) add: Let_def body_def)
 16.1023 -apply       (tactic "ALLGOALS (EVERY'[Clarify_tac, TRY o typD_tac, 
 16.1024 -                     TRY o forward_hyp_tac])")
 16.1025 -apply      (tactic"ALLGOALS(EVERY'[asm_simp_tac(simpset()),TRY o Clarify_tac])")
 16.1026 -
 16.1027 -(* 20 subgoals *)
 16.1028 -
 16.1029 -(* Break *)
 16.1030 -apply (erule conforms_absorb)
 16.1031 -
 16.1032 -(* Cons *)
 16.1033 -apply (erule_tac V = "G\<turnstile>Norm s0 \<midarrow>?ea\<succ>\<rightarrow> ?vs1" in thin_rl)
 16.1034 -apply (frule eval_gext')
 16.1035 -apply force
 16.1036 -
 16.1037 -(* LVar *)
 16.1038 -apply (force elim: conforms_localD [THEN lconfD] conforms_lupd 
 16.1039 -       simp add: assign_conforms_def lvar_def)
 16.1040 -
 16.1041 -(* Cast *)
 16.1042 -apply (force dest: fits_conf)
 16.1043 -
 16.1044 -(* Lit *)
 16.1045 -apply (rule conf_litval)
 16.1046 -apply (simp add: empty_dt_def)
 16.1047 -
 16.1048 -(* Super *)
 16.1049 -apply (rule conf_widen)
 16.1050 -apply   (erule (1) subcls_direct [THEN widen.subcls])
 16.1051 -apply  (erule (1) conforms_localD [THEN lconfD])
 16.1052 -apply (erule wf_ws_prog)
 16.1053 -
 16.1054 -(* Acc *)
 16.1055 -apply fast
 16.1056 -
 16.1057 -(* Body *)
 16.1058 -apply (rule conjI)
 16.1059 -apply (rule conforms_absorb)
 16.1060 -apply (fast)
 16.1061 -apply (fast intro: conforms_locals)
 16.1062 -
 16.1063 -(* Cond *)
 16.1064 -apply (simp split: split_if_asm)
 16.1065 -apply  (tactic "forward_hyp_tac 1", force)
 16.1066 -apply (tactic "forward_hyp_tac 1", force)
 16.1067 -
 16.1068 -(* If *)
 16.1069 -apply (force split add: split_if_asm)
 16.1070 -
 16.1071 -(* Loop *)
 16.1072 -apply (drule (1) wt.Loop)
 16.1073 -apply (clarsimp split: split_if_asm)
 16.1074 -apply (fast intro: conforms_absorb)
 16.1075 -
 16.1076 -(* Fin *)
 16.1077 -apply (case_tac "x1", force)
 16.1078 -apply (drule spec, erule impE, erule conforms_NormI)
 16.1079 -apply (erule impE)
 16.1080 -apply   blast
 16.1081 -apply (clarsimp)
 16.1082 -apply (erule (3) Fin_lemma)
 16.1083 -
 16.1084 -(* Throw *)
 16.1085 -apply (erule (3) Throw_lemma)
 16.1086 -
 16.1087 -(* NewC *)
 16.1088 -apply (clarsimp simp add: is_acc_class_def)
 16.1089 -apply (drule (1) halloc_type_sound,blast, rule HOL.refl, simp, simp)
 16.1090 -
 16.1091 -(* NewA *)
 16.1092 -apply (tactic "smp_tac 1 1",frule wt_init_comp_ty,erule impE,blast)
 16.1093 -apply (tactic "forward_hyp_tac 1")
 16.1094 -apply (case_tac "check_neg i' ab")
 16.1095 -apply  (clarsimp simp add: is_acc_type_def)
 16.1096 -apply  (drule (2) halloc_type_sound, rule HOL.refl, simp, simp)
 16.1097 -apply force
 16.1098 -
 16.1099 -(* Level 34, 6 subgoals *)
 16.1100 -
 16.1101 -(* Init *)
 16.1102 -apply (case_tac "inited C (globs s0)")
 16.1103 -apply  (clarsimp)
 16.1104 -apply (clarsimp)
 16.1105 -apply (frule (1) wf_prog_cdecl)
 16.1106 -apply (drule spec, erule impE, erule (3) conforms_init_class_obj)
 16.1107 -apply (drule_tac "psi" = "class G C = ?x" in asm_rl,erule impE,
 16.1108 -      force dest!: wf_cdecl_supD split add: split_if simp add: is_acc_class_def)
 16.1109 -apply (drule spec, erule impE, erule conforms_set_locals, rule lconf_empty)
 16.1110 -apply (erule impE) apply (rule exI) apply (erule wf_cdecl_wt_init)
 16.1111 -apply (drule (1) conforms_return, force dest: eval_gext', assumption)
 16.1112 -
 16.1113 -
 16.1114 -(* Ass *)
 16.1115 -apply (tactic "forward_hyp_tac 1")
 16.1116 -apply (rename_tac x1 s1 x2 s2 v va w L C Ta T', case_tac x1)
 16.1117 -prefer 2 apply force
 16.1118 -apply (case_tac x2)
 16.1119 -prefer 2 apply force
 16.1120 -apply (simp, drule conjunct2)
 16.1121 -apply (drule (1) conf_widen)
 16.1122 -apply  (erule wf_ws_prog)
 16.1123 -apply (erule (2) Ass_lemma)
 16.1124 -apply (clarsimp simp add: assign_conforms_def)
 16.1125 -
 16.1126 -(* Try *)
 16.1127 -apply (drule (1) sxalloc_type_sound, simp (no_asm_use))
 16.1128 -apply (case_tac a)
 16.1129 -apply  clarsimp
 16.1130 -apply clarsimp
 16.1131 -apply (tactic "smp_tac 1 1")
 16.1132 -apply (simp split add: split_if_asm)
 16.1133 -apply (fast dest: conforms_deallocL Try_lemma)
 16.1134 -
 16.1135 -(* FVar *)
 16.1136 -
 16.1137 -apply (frule accfield_fields)
 16.1138 -apply (frule ty_expr_is_type [THEN type_is_class],simp)
 16.1139 -apply simp
 16.1140 -apply (frule wf_ws_prog)
 16.1141 -apply (frule (1) fields_declC,simp)
 16.1142 -apply clarsimp 
 16.1143 -(*b y EVERY'[datac cfield_defpl_is_class 2, Clarsimp_tac] 1; not useful here*)
 16.1144 -apply (tactic "smp_tac 1 1")
 16.1145 -apply (tactic "forward_hyp_tac 1")
 16.1146 -apply (rule conjI, force split add: split_if simp add: fvar_def2)
 16.1147 -apply (drule init_yields_initd, frule eval_gext')
 16.1148 -apply clarsimp
 16.1149 -apply (case_tac "C=Object")
 16.1150 -apply  clarsimp
 16.1151 -apply (erule (9) FVar_lemma)
 16.1152 -
 16.1153 -(* AVar *)
 16.1154 -apply (tactic "forward_hyp_tac 1")
 16.1155 -apply (erule_tac V = "G\<turnstile>Norm s0 \<midarrow>?e1-\<succ>?a'\<rightarrow> (?x1 1, ?s1)" in thin_rl, 
 16.1156 -         frule eval_gext')
 16.1157 -apply (rule conjI)
 16.1158 -apply  (clarsimp simp add: avar_def2)
 16.1159 -apply clarsimp
 16.1160 -apply (erule (5) AVar_lemma)
 16.1161 -
 16.1162 -(* Call *)
 16.1163 -apply (tactic "forward_hyp_tac 1")
 16.1164 -apply (rule Call_type_sound)
 16.1165 -apply auto
 16.1166 -done
 16.1167 -
 16.1168 -
 16.1169 -declare fun_upd_apply [simp]
 16.1170 -declare split_paired_All [simp] split_paired_Ex [simp]
 16.1171 -declare split_if     [split] split_if_asm     [split] 
 16.1172 -        option.split [split] option.split_asm [split]
 16.1173 -ML_setup {* 
 16.1174 -simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac);
 16.1175 -claset_ref()  := claset () addSbefore ("split_all_tac", split_all_tac)
 16.1176 -*}
 16.1177 -
 16.1178 -theorem eval_ts: 
 16.1179 - "\<lbrakk>G\<turnstile>s \<midarrow>e-\<succ>v \<rightarrow> (x',s'); wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-T\<rbrakk> 
 16.1180 -\<Longrightarrow>  (x',s')\<Colon>\<preceq>(G,L) \<and> (x'=None \<longrightarrow> G,s'\<turnstile>v\<Colon>\<preceq>T)"
 16.1181 +lemma eval_type_sound:
 16.1182 +      (assumes eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)" and
 16.1183 +                 wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T" and
 16.1184 +                 wf: "wf_prog G" and 
 16.1185 +            conf_s0: "s0\<Colon>\<preceq>(G,L)"           
 16.1186 +      ) "s1\<Colon>\<preceq>(G,L) \<and>  (normal s1 \<longrightarrow> G,L,store s1\<turnstile>t\<succ>v\<Colon>\<preceq>T) \<and> 
 16.1187 +         (error_free s0 = error_free s1)"
 16.1188 +proof -
 16.1189 +  from eval 
 16.1190 +  have "\<And> L accC T. \<lbrakk>s0\<Colon>\<preceq>(G,L);\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T\<rbrakk>  
 16.1191 +        \<Longrightarrow> s1\<Colon>\<preceq>(G,L) \<and> (normal s1 \<longrightarrow> G,L,store s1\<turnstile>t\<succ>v\<Colon>\<preceq>T)
 16.1192 +            \<and> (error_free s0 = error_free s1)"
 16.1193 +   (is "PROP ?TypeSafe s0 s1 t v"
 16.1194 +    is "\<And> L accC T. ?Conform L s0 \<Longrightarrow> ?WellTyped L accC T t  
 16.1195 +                 \<Longrightarrow> ?Conform L s1 \<and> ?ValueTyped L T s1 t v \<and>
 16.1196 +                     ?ErrorFree s0 s1")
 16.1197 +  proof (induct)
 16.1198 +    case (Abrupt s t xc L accC T) 
 16.1199 +    have "(Some xc, s)\<Colon>\<preceq>(G,L)" .
 16.1200 +    then show "(Some xc, s)\<Colon>\<preceq>(G,L) \<and> 
 16.1201 +      (normal (Some xc, s) 
 16.1202 +      \<longrightarrow> G,L,store (Some xc,s)\<turnstile>t\<succ>arbitrary3 t\<Colon>\<preceq>T) \<and> 
 16.1203 +      (error_free (Some xc, s) = error_free (Some xc, s))"
 16.1204 +      by (simp)
 16.1205 +  next
 16.1206 +    case (Skip s L accC T)
 16.1207 +    have "Norm s\<Colon>\<preceq>(G, L)" and  
 16.1208 +           "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r Skip\<Colon>T" .
 16.1209 +    then show "Norm s\<Colon>\<preceq>(G, L) \<and>
 16.1210 +              (normal (Norm s) \<longrightarrow> G,L,store (Norm s)\<turnstile>In1r Skip\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and> 
 16.1211 +              (error_free (Norm s) = error_free (Norm s))"
 16.1212 +      by (simp)
 16.1213 +  next
 16.1214 +    case (Expr e s0 s1 v L accC T)
 16.1215 +    have "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<rightarrow> s1" .
 16.1216 +    have     hyp: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 v)" .
 16.1217 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1218 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (Expr e)\<Colon>T" .
 16.1219 +    then obtain eT 
 16.1220 +      where "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l e\<Colon>eT"
 16.1221 +      by (rule wt_elim_cases) (blast)
 16.1222 +    with conf_s0 hyp 
 16.1223 +    obtain "s1\<Colon>\<preceq>(G, L)" and "error_free s1"
 16.1224 +      by (blast)
 16.1225 +    with wt
 16.1226 +    show "s1\<Colon>\<preceq>(G, L) \<and>
 16.1227 +          (normal s1 \<longrightarrow> G,L,store s1\<turnstile>In1r (Expr e)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and> 
 16.1228 +          (error_free (Norm s0) = error_free s1)"
 16.1229 +      by (simp)
 16.1230 +  next
 16.1231 +    case (Lab c l s0 s1 L accC T)
 16.1232 +    have     hyp: "PROP ?TypeSafe (Norm s0) s1 (In1r c) \<diamondsuit>" .
 16.1233 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1234 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (l\<bullet> c)\<Colon>T" .
 16.1235 +    then have "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
 16.1236 +      by (rule wt_elim_cases) (blast)
 16.1237 +    with conf_s0 hyp
 16.1238 +    obtain       conf_s1: "s1\<Colon>\<preceq>(G, L)" and 
 16.1239 +           error_free_s1: "error_free s1" 
 16.1240 +      by (blast)
 16.1241 +    from conf_s1 have "abupd (absorb (Break l)) s1\<Colon>\<preceq>(G, L)"
 16.1242 +      by (cases s1) (auto intro: conforms_absorb)
 16.1243 +    with wt error_free_s1
 16.1244 +    show "abupd (absorb (Break l)) s1\<Colon>\<preceq>(G, L) \<and>
 16.1245 +          (normal (abupd (absorb (Break l)) s1)
 16.1246 +           \<longrightarrow> G,L,store (abupd (absorb (Break l)) s1)\<turnstile>In1r (l\<bullet> c)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1247 +          (error_free (Norm s0) = error_free (abupd (absorb (Break l)) s1))"
 16.1248 +      by (simp)
 16.1249 +  next
 16.1250 +    case (Comp c1 c2 s0 s1 s2 L accC T)
 16.1251 +    have "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1" .
 16.1252 +    have "G\<turnstile>s1 \<midarrow>c2\<rightarrow> s2" .
 16.1253 +    have  hyp_c1: "PROP ?TypeSafe (Norm s0) s1 (In1r c1) \<diamondsuit>" .
 16.1254 +    have  hyp_c2: "PROP ?TypeSafe s1        s2 (In1r c2) \<diamondsuit>" .
 16.1255 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1256 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (c1;; c2)\<Colon>T" .
 16.1257 +    then obtain wt_c1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
 16.1258 +                wt_c2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c2\<Colon>\<surd>"
 16.1259 +      by (rule wt_elim_cases) (blast)
 16.1260 +    with conf_s0 hyp_c1 hyp_c2
 16.1261 +    obtain "s2\<Colon>\<preceq>(G, L)" and "error_free s2"
 16.1262 +      by (blast)
 16.1263 +    with wt
 16.1264 +    show "s2\<Colon>\<preceq>(G, L) \<and>
 16.1265 +          (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In1r (c1;; c2)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1266 +          (error_free (Norm s0) = error_free s2)"
 16.1267 +      by (simp)
 16.1268 +  next
 16.1269 +    case (If b c1 c2 e s0 s1 s2 L accC T)
 16.1270 +    have "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1" .
 16.1271 +    have "G\<turnstile>s1 \<midarrow>(if the_Bool b then c1 else c2)\<rightarrow> s2" .
 16.1272 +    have hyp_e: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 b)" .
 16.1273 +    have hyp_then_else: 
 16.1274 +            "PROP ?TypeSafe s1 s2 (In1r (if the_Bool b then c1 else c2)) \<diamondsuit>" .
 16.1275 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1276 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (If(e) c1 Else c2)\<Colon>T" .
 16.1277 +    then obtain "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean"
 16.1278 +                "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>(if the_Bool b then c1 else c2)\<Colon>\<surd>"
 16.1279 +      by (rule wt_elim_cases) (auto split add: split_if)
 16.1280 +    with conf_s0 hyp_e hyp_then_else
 16.1281 +    obtain "s2\<Colon>\<preceq>(G, L)" and "error_free s2"
 16.1282 +      by (blast)
 16.1283 +    with wt
 16.1284 +    show "s2\<Colon>\<preceq>(G, L) \<and>
 16.1285 +           (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In1r (If(e) c1 Else c2)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1286 +           (error_free (Norm s0) = error_free s2)"
 16.1287 +      by (simp)
 16.1288 +  next
 16.1289 +    case (Loop b c e l s0 s1 s2 s3 L accC T)
 16.1290 +    have "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1" .
 16.1291 +    have hyp_e: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 b)" .
 16.1292 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1293 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (l\<bullet> While(e) c)\<Colon>T" .
 16.1294 +    then obtain wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
 16.1295 +                wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
 16.1296 +      by (rule wt_elim_cases) (blast)
 16.1297 +    from conf_s0 wt_e hyp_e
 16.1298 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1299 +      by blast
 16.1300 +    show "s3\<Colon>\<preceq>(G, L) \<and>
 16.1301 +          (normal s3 \<longrightarrow> G,L,store s3\<turnstile>In1r (l\<bullet> While(e) c)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1302 +          (error_free (Norm s0) = error_free s3)"
 16.1303 +    proof (cases "normal s1 \<and> the_Bool b")
 16.1304 +      case True
 16.1305 +      from Loop True have "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2" by auto
 16.1306 +      from Loop True have "G\<turnstile>abupd (absorb (Cont l)) s2 \<midarrow>l\<bullet> While(e) c\<rightarrow> s3"
 16.1307 +	by auto
 16.1308 +      from Loop True have hyp_c: "PROP ?TypeSafe s1 s2 (In1r c) \<diamondsuit>"
 16.1309 +	by (auto)
 16.1310 +      from Loop True have hyp_w: "PROP ?TypeSafe (abupd (absorb (Cont l)) s2)
 16.1311 +                                       s3 (In1r (l\<bullet> While(e) c)) \<diamondsuit>"
 16.1312 +	by (auto)
 16.1313 +      from conf_s1 error_free_s1 wt_c hyp_c
 16.1314 +      obtain conf_s2:  "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.1315 +	by blast
 16.1316 +      from conf_s2 have "abupd (absorb (Cont l)) s2 \<Colon>\<preceq>(G, L)"
 16.1317 +	by (cases s2) (auto intro: conforms_absorb)
 16.1318 +      moreover
 16.1319 +      from error_free_s2 have "error_free (abupd (absorb (Cont l)) s2)"
 16.1320 +	by simp
 16.1321 +      moreover note wt hyp_w
 16.1322 +      ultimately obtain "s3\<Colon>\<preceq>(G, L)" and "error_free s3"
 16.1323 +	by blast
 16.1324 +      with wt 
 16.1325 +      show ?thesis
 16.1326 +	by (simp)
 16.1327 +    next
 16.1328 +      case False
 16.1329 +      with Loop have "s3=s1" by simp
 16.1330 +      with conf_s1 error_free_s1 wt
 16.1331 +      show ?thesis
 16.1332 +	by (simp)
 16.1333 +    qed
 16.1334 +  next
 16.1335 +    case (Do j s L accC T)
 16.1336 +    have "Norm s\<Colon>\<preceq>(G, L)" .
 16.1337 +    then 
 16.1338 +    show "(Some (Jump j), s)\<Colon>\<preceq>(G, L) \<and>
 16.1339 +           (normal (Some (Jump j), s) 
 16.1340 +           \<longrightarrow> G,L,store (Some (Jump j), s)\<turnstile>In1r (Do j)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1341 +           (error_free (Norm s) = error_free (Some (Jump j), s))"
 16.1342 +      by simp
 16.1343 +  next
 16.1344 +    case (Throw a e s0 s1 L accC T)
 16.1345 +    have "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<rightarrow> s1" .
 16.1346 +    have hyp: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 a)" .
 16.1347 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1348 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (Throw e)\<Colon>T" .
 16.1349 +    then obtain tn 
 16.1350 +      where      wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-Class tn" and
 16.1351 +            throwable: "G\<turnstile>tn\<preceq>\<^sub>C SXcpt Throwable"
 16.1352 +      by (rule wt_elim_cases) (auto)
 16.1353 +    from conf_s0 wt_e hyp obtain
 16.1354 +      "s1\<Colon>\<preceq>(G, L)" and
 16.1355 +      "(normal s1 \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>Class tn)" and
 16.1356 +      error_free_s1: "error_free s1"
 16.1357 +      by force
 16.1358 +    with wf throwable
 16.1359 +    have "abupd (throw a) s1\<Colon>\<preceq>(G, L)" 
 16.1360 +      by (cases s1) (auto dest: Throw_lemma)
 16.1361 +    with wt error_free_s1
 16.1362 +    show "abupd (throw a) s1\<Colon>\<preceq>(G, L) \<and>
 16.1363 +            (normal (abupd (throw a) s1) \<longrightarrow>
 16.1364 +            G,L,store (abupd (throw a) s1)\<turnstile>In1r (Throw e)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1365 +            (error_free (Norm s0) = error_free (abupd (throw a) s1))"
 16.1366 +      by simp
 16.1367 +  next
 16.1368 +    case (Try catchC c1 c2 s0 s1 s2 s3 vn L accC T)
 16.1369 +    have "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1" .
 16.1370 +    have sx_alloc: "G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2" .
 16.1371 +    have hyp_c1: "PROP ?TypeSafe (Norm s0) s1 (In1r c1) \<diamondsuit>" .
 16.1372 +    have conf_s0:"Norm s0\<Colon>\<preceq>(G, L)" .
 16.1373 +    have      wt:"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>In1r (Try c1 Catch(catchC vn) c2)\<Colon>T" .
 16.1374 +    then obtain 
 16.1375 +      wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
 16.1376 +      wt_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<lparr>lcl := L(VName vn\<mapsto>Class catchC)\<rparr>\<turnstile>c2\<Colon>\<surd>" and
 16.1377 +      fresh_vn: "L(VName vn)=None"
 16.1378 +      by (rule wt_elim_cases) (auto)
 16.1379 +    with conf_s0 hyp_c1
 16.1380 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1381 +      by blast
 16.1382 +    from conf_s1 sx_alloc wf 
 16.1383 +    have conf_s2: "s2\<Colon>\<preceq>(G, L)" 
 16.1384 +      by (auto dest: sxalloc_type_sound split: option.splits)
 16.1385 +    from sx_alloc error_free_s1 
 16.1386 +    have error_free_s2: "error_free s2"
 16.1387 +      by (rule error_free_sxalloc)
 16.1388 +    show "s3\<Colon>\<preceq>(G, L) \<and>
 16.1389 +          (normal s3 \<longrightarrow> G,L,store s3\<turnstile>In1r (Try c1 Catch(catchC vn) c2)\<succ>\<diamondsuit>\<Colon>\<preceq>T)\<and>
 16.1390 +          (error_free (Norm s0) = error_free s3)"
 16.1391 +    proof (cases "normal s1")  
 16.1392 +      case True
 16.1393 +      with sx_alloc wf 
 16.1394 +      have eq_s2_s1: "s2=s1"
 16.1395 +	by (auto dest: sxalloc_type_sound split: option.splits)
 16.1396 +      with True 
 16.1397 +      have "\<not>  G,s2\<turnstile>catch catchC"
 16.1398 +	by (simp add: catch_def)
 16.1399 +      with Try
 16.1400 +      have "s3=s2"
 16.1401 +	by simp
 16.1402 +      with wt conf_s1 error_free_s1 eq_s2_s1
 16.1403 +      show ?thesis
 16.1404 +	by simp
 16.1405 +    next
 16.1406 +      case False
 16.1407 +      note exception_s1 = this
 16.1408 +      show ?thesis
 16.1409 +      proof (cases "G,s2\<turnstile>catch catchC") 
 16.1410 +	case False
 16.1411 +	with Try
 16.1412 +	have "s3=s2"
 16.1413 +	  by simp
 16.1414 +	with wt conf_s2 error_free_s2 
 16.1415 +	show ?thesis
 16.1416 +	  by simp
 16.1417 +      next
 16.1418 +	case True
 16.1419 +	with Try have "G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<rightarrow> s3" by simp
 16.1420 +	from True Try 
 16.1421 +	have hyp_c2: "PROP ?TypeSafe (new_xcpt_var vn s2) s3 (In1r c2) \<diamondsuit>"
 16.1422 +	  by auto
 16.1423 +	from exception_s1 sx_alloc wf
 16.1424 +	obtain a 
 16.1425 +	  where xcpt_s2: "abrupt s2 = Some (Xcpt (Loc a))"
 16.1426 +	  by (auto dest!: sxalloc_type_sound split: option.splits)
 16.1427 +	with True
 16.1428 +	have "G\<turnstile>obj_ty (the (globs (store s2) (Heap a)))\<preceq>Class catchC"
 16.1429 +	  by (cases s2) simp
 16.1430 +	with xcpt_s2 conf_s2 wf
 16.1431 +	have "Norm (lupd(VName vn\<mapsto>Addr a) (store s2))
 16.1432 +              \<Colon>\<preceq>(G, L(VName vn\<mapsto>Class catchC))"
 16.1433 +	  by (auto dest: Try_lemma)
 16.1434 +	with hyp_c2 wt_c2 xcpt_s2 error_free_s2
 16.1435 +	obtain       conf_s3: "s3\<Colon>\<preceq>(G, L(VName vn\<mapsto>Class catchC))" and
 16.1436 +               error_free_s3: "error_free s3"
 16.1437 +	  by (cases s2) auto
 16.1438 +	from conf_s3 fresh_vn 
 16.1439 +	have "s3\<Colon>\<preceq>(G,L)"
 16.1440 +	  by (blast intro: conforms_deallocL)
 16.1441 +	with wt error_free_s3
 16.1442 +	show ?thesis
 16.1443 +	  by simp
 16.1444 +      qed
 16.1445 +    qed
 16.1446 +  next
 16.1447 +    case (Fin c1 c2 s0 s1 s2 x1 L accC T)
 16.1448 +    have "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> (x1, s1)" .
 16.1449 +    have c2: "G\<turnstile>Norm s1 \<midarrow>c2\<rightarrow> s2" .
 16.1450 +    have  hyp_c1: "PROP ?TypeSafe (Norm s0) (x1,s1) (In1r c1) \<diamondsuit>" .
 16.1451 +    have  hyp_c2: "PROP ?TypeSafe (Norm s1) s2      (In1r c2) \<diamondsuit>" .
 16.1452 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1453 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (c1 Finally c2)\<Colon>T" .
 16.1454 +    then obtain
 16.1455 +      wt_c1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
 16.1456 +      wt_c2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c2\<Colon>\<surd>"
 16.1457 +      by (rule wt_elim_cases) blast
 16.1458 +    from conf_s0 wt_c1 hyp_c1  
 16.1459 +    obtain conf_s1: "(x1,s1)\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free (x1,s1)"
 16.1460 +      by blast
 16.1461 +    from conf_s1 have "Norm s1\<Colon>\<preceq>(G, L)"
 16.1462 +      by (rule conforms_NormI)
 16.1463 +    with wt_c2 hyp_c2
 16.1464 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.1465 +      by blast
 16.1466 +    show "abupd (abrupt_if (x1 \<noteq> None) x1) s2\<Colon>\<preceq>(G, L) \<and>
 16.1467 +          (normal (abupd (abrupt_if (x1 \<noteq> None) x1) s2) 
 16.1468 +           \<longrightarrow> G,L,store (abupd (abrupt_if (x1 \<noteq> None) x1) s2)
 16.1469 +               \<turnstile>In1r (c1 Finally c2)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and> 
 16.1470 +          (error_free (Norm s0) =
 16.1471 +              error_free (abupd (abrupt_if (x1 \<noteq> None) x1) s2))"
 16.1472 +    proof (cases x1)
 16.1473 +      case None with conf_s2 wt show ?thesis by auto
 16.1474 +    next
 16.1475 +      case (Some x) 
 16.1476 +      with c2 wf conf_s1 conf_s2
 16.1477 +      have conf: "(abrupt_if True (Some x) (abrupt s2), store s2)\<Colon>\<preceq>(G, L)"
 16.1478 +	by (cases s2) (auto dest: Fin_lemma)
 16.1479 +      from Some error_free_s1
 16.1480 +      have "\<not> (\<exists> err. x=Error err)"
 16.1481 +	by (simp add: error_free_def)
 16.1482 +      with error_free_s2
 16.1483 +      have "error_free (abrupt_if True (Some x) (abrupt s2), store s2)"
 16.1484 +	by (cases s2) simp
 16.1485 +      with Some wt conf show ?thesis
 16.1486 +	by (cases s2) auto
 16.1487 +    qed
 16.1488 +  next
 16.1489 +    case (Init C c s0 s1 s2 s3 L accC T)
 16.1490 +    have     cls: "the (class G C) = c" .
 16.1491 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1492 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1r (Init C)\<Colon>T" .
 16.1493 +    with cls
 16.1494 +    have cls_C: "class G C = Some c"
 16.1495 +      by - (erule wt_elim_cases,auto)
 16.1496 +    show "s3\<Colon>\<preceq>(G, L) \<and> (normal s3 \<longrightarrow> G,L,store s3\<turnstile>In1r (Init C)\<succ>\<diamondsuit>\<Colon>\<preceq>T) \<and>
 16.1497 +          (error_free (Norm s0) = error_free s3)"
 16.1498 +    proof (cases "inited C (globs s0)")
 16.1499 +      case True
 16.1500 +      with Init have "s3 = Norm s0"
 16.1501 +	by simp
 16.1502 +      with conf_s0 wt show ?thesis 
 16.1503 +	by simp
 16.1504 +    next
 16.1505 +      case False
 16.1506 +      with Init 
 16.1507 +      have "G\<turnstile>Norm ((init_class_obj G C) s0) 
 16.1508 +              \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1" and
 16.1509 +        eval_init: "G\<turnstile>(set_lvars empty) s1 \<midarrow>init c\<rightarrow> s2" and
 16.1510 +	s3: "s3 = (set_lvars (locals (store s1))) s2" 
 16.1511 +	by auto
 16.1512 +      from False Init 
 16.1513 +      have hyp_init_super: 
 16.1514 +             "PROP ?TypeSafe (Norm ((init_class_obj G C) s0)) s1
 16.1515 +	              (In1r (if C = Object then Skip else Init (super c))) \<diamondsuit>"
 16.1516 +	by auto
 16.1517 +      with False Init (* without chaining hyp_init_super, the simplifier will
 16.1518 +                          loop! *)
 16.1519 +      have hyp_init_c:
 16.1520 +	"PROP ?TypeSafe ((set_lvars empty) s1) s2 (In1r (init c)) \<diamondsuit>"
 16.1521 +	by auto
 16.1522 +      from conf_s0 wf cls_C False
 16.1523 +      have conf_s0': "(Norm ((init_class_obj G C) s0))\<Colon>\<preceq>(G, L)"
 16.1524 +	by (auto dest: conforms_init_class_obj)
 16.1525 +      from wf cls_C have
 16.1526 +	wt_super:"\<lparr>prg = G, cls = accC, lcl = L\<rparr>
 16.1527 +                   \<turnstile>(if C = Object then Skip else Init (super c))\<Colon>\<surd>"
 16.1528 +	by (cases "C=Object")
 16.1529 +           (auto dest: wf_prog_cdecl wf_cdecl_supD is_acc_classD)
 16.1530 +      with conf_s0' hyp_init_super
 16.1531 +      obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1532 +	by blast 
 16.1533 +      then
 16.1534 +      have "(set_lvars empty) s1\<Colon>\<preceq>(G, empty)"
 16.1535 +	by (cases s1) (auto dest: conforms_set_locals )
 16.1536 +      moreover from error_free_s1
 16.1537 +      have "error_free ((set_lvars empty) s1)"
 16.1538 +	by simp
 16.1539 +      moreover note hyp_init_c wf cls_C 
 16.1540 +      ultimately
 16.1541 +      obtain conf_s2: "s2\<Colon>\<preceq>(G, empty)" and error_free_s2: "error_free s2"
 16.1542 +	by (auto dest!: wf_prog_cdecl wf_cdecl_wt_init)
 16.1543 +      with s3 conf_s1 eval_init
 16.1544 +      have "s3\<Colon>\<preceq>(G, L)"
 16.1545 +	by (cases s2,cases s1) (force dest: conforms_return eval_gext')
 16.1546 +      moreover from error_free_s2 s3
 16.1547 +      have "error_free s3"
 16.1548 +	by simp
 16.1549 +      moreover note wt
 16.1550 +      ultimately show ?thesis
 16.1551 +	by simp
 16.1552 +    qed
 16.1553 +  next
 16.1554 +    case (NewC C a s0 s1 s2 L accC T)
 16.1555 +    have         "G\<turnstile>Norm s0 \<midarrow>Init C\<rightarrow> s1" .
 16.1556 +    have halloc: "G\<turnstile>s1 \<midarrow>halloc CInst C\<succ>a\<rightarrow> s2" .
 16.1557 +    have hyp: "PROP ?TypeSafe (Norm s0) s1 (In1r (Init C)) \<diamondsuit>" .
 16.1558 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1559 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (NewC C)\<Colon>T" .
 16.1560 +    then obtain is_cls_C: "is_class G C" and
 16.1561 +                       T: "T=Inl (Class C)"
 16.1562 +      by (rule wt_elim_cases) (auto dest: is_acc_classD)
 16.1563 +    with conf_s0 hyp
 16.1564 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1565 +      by auto
 16.1566 +    from conf_s1 halloc wf is_cls_C
 16.1567 +    obtain halloc_type_safe: "s2\<Colon>\<preceq>(G, L)" 
 16.1568 +                             "(normal s2 \<longrightarrow> G,store s2\<turnstile>Addr a\<Colon>\<preceq>Class C)"
 16.1569 +      by (cases s2) (auto dest!: halloc_type_sound)
 16.1570 +    from halloc error_free_s1 
 16.1571 +    have "error_free s2"
 16.1572 +      by (rule error_free_halloc)
 16.1573 +    with halloc_type_safe T
 16.1574 +    show "s2\<Colon>\<preceq>(G, L) \<and> 
 16.1575 +          (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In1l (NewC C)\<succ>In1 (Addr a)\<Colon>\<preceq>T)  \<and>
 16.1576 +          (error_free (Norm s0) = error_free s2)"
 16.1577 +      by auto
 16.1578 +  next
 16.1579 +    case (NewA T a e i s0 s1 s2 s3 L accC Ta)
 16.1580 +    have "G\<turnstile>Norm s0 \<midarrow>init_comp_ty T\<rightarrow> s1" .
 16.1581 +    have "G\<turnstile>s1 \<midarrow>e-\<succ>i\<rightarrow> s2" .
 16.1582 +    have halloc: "G\<turnstile>abupd (check_neg i) s2\<midarrow>halloc Arr T (the_Intg i)\<succ>a\<rightarrow> s3" .
 16.1583 +    have hyp_init: "PROP ?TypeSafe (Norm s0) s1 (In1r (init_comp_ty T)) \<diamondsuit>" .
 16.1584 +    have hyp_size: "PROP ?TypeSafe s1 s2 (In1l e) (In1 i)" .
 16.1585 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1586 +    have     wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (New T[e])\<Colon>Ta" .
 16.1587 +    then obtain
 16.1588 +      wt_init: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>init_comp_ty T\<Colon>\<surd>" and
 16.1589 +      wt_size: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-PrimT Integer" and
 16.1590 +            T: "is_type G T" and
 16.1591 +           Ta: "Ta=Inl (T.[])"
 16.1592 +      by (rule wt_elim_cases) (auto intro: wt_init_comp_ty dest: is_acc_typeD)
 16.1593 +    from conf_s0 wt_init hyp_init
 16.1594 +    obtain "s1\<Colon>\<preceq>(G, L)" "error_free s1"
 16.1595 +      by blast
 16.1596 +    with wt_size hyp_size
 16.1597 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.1598 +      by blast
 16.1599 +    from conf_s2 have "abupd (check_neg i) s2\<Colon>\<preceq>(G, L)"
 16.1600 +      by (cases s2) auto
 16.1601 +    with halloc wf T 
 16.1602 +    have halloc_type_safe:
 16.1603 +          "s3\<Colon>\<preceq>(G, L) \<and> (normal s3 \<longrightarrow> G,store s3\<turnstile>Addr a\<Colon>\<preceq>T.[])"
 16.1604 +      by (cases s3) (auto dest!: halloc_type_sound)
 16.1605 +    from halloc error_free_s2
 16.1606 +    have "error_free s3"
 16.1607 +      by (auto dest: error_free_halloc)
 16.1608 +    with halloc_type_safe Ta
 16.1609 +    show "s3\<Colon>\<preceq>(G, L) \<and> 
 16.1610 +          (normal s3 \<longrightarrow> G,L,store s3\<turnstile>In1l (New T[e])\<succ>In1 (Addr a)\<Colon>\<preceq>Ta) \<and>
 16.1611 +          (error_free (Norm s0) = error_free s3) "
 16.1612 +      by simp
 16.1613 +  next
 16.1614 +    case (Cast castT e s0 s1 s2 v L accC T)
 16.1615 +    have "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<rightarrow> s1" .
 16.1616 +    have s2:"s2 = abupd (raise_if (\<not> G,store s1\<turnstile>v fits castT) ClassCast) s1" .
 16.1617 +    have hyp: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 v)" .
 16.1618 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1619 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (Cast castT e)\<Colon>T" .
 16.1620 +    then obtain eT
 16.1621 +      where wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" and
 16.1622 +              eT: "G\<turnstile>eT\<preceq>? castT" and 
 16.1623 +               T: "T=Inl castT"
 16.1624 +      by (rule wt_elim_cases) auto
 16.1625 +    with conf_s0 hyp
 16.1626 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1627 +      by blast
 16.1628 +    from conf_s1 s2 
 16.1629 +    have conf_s2: "s2\<Colon>\<preceq>(G, L)"
 16.1630 +      by (cases s1) simp
 16.1631 +    from error_free_s1 s2
 16.1632 +    have error_free_s2: "error_free s2"
 16.1633 +      by simp
 16.1634 +    {
 16.1635 +      assume norm_s2: "normal s2"
 16.1636 +      have "G,L,store s2\<turnstile>In1l (Cast castT e)\<succ>In1 v\<Colon>\<preceq>T"
 16.1637 +      proof -
 16.1638 +	from s2 norm_s2 have "normal s1"
 16.1639 +	  by (cases s1) simp
 16.1640 +	with wt_e conf_s0 hyp 
 16.1641 +	have "G,store s1\<turnstile>v\<Colon>\<preceq>eT"
 16.1642 +	  by force
 16.1643 +	with eT wf s2 T norm_s2
 16.1644 +	show ?thesis
 16.1645 +	  by (cases s1) (auto dest: fits_conf)
 16.1646 +      qed
 16.1647 +    }
 16.1648 +    with conf_s2 error_free_s2
 16.1649 +    show "s2\<Colon>\<preceq>(G, L) \<and> 
 16.1650 +           (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In1l (Cast castT e)\<succ>In1 v\<Colon>\<preceq>T)  \<and>
 16.1651 +           (error_free (Norm s0) = error_free s2)"
 16.1652 +      by blast
 16.1653 +  next
 16.1654 +    case (Inst T b e s0 s1 v L accC T')
 16.1655 +    then show ?case
 16.1656 +      by (auto elim!: wt_elim_cases)
 16.1657 +  next
 16.1658 +    case (Lit s v L accC T)
 16.1659 +    then show ?case
 16.1660 +      by (auto elim!: wt_elim_cases 
 16.1661 +               intro: conf_litval simp add: empty_dt_def)
 16.1662 +  next
 16.1663 +    case (Super s L accC T)
 16.1664 +    have conf_s: "Norm s\<Colon>\<preceq>(G, L)" .
 16.1665 +    have     wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l Super\<Colon>T" .
 16.1666 +    then obtain C c where
 16.1667 +             C: "L This = Some (Class C)" and
 16.1668 +       neq_Obj: "C\<noteq>Object" and
 16.1669 +         cls_C: "class G C = Some c" and
 16.1670 +             T: "T=Inl (Class (super c))"
 16.1671 +      by (rule wt_elim_cases) auto
 16.1672 +    from C conf_s have "G,s\<turnstile>val_this s\<Colon>\<preceq>Class C"
 16.1673 +      by (blast intro: conforms_localD [THEN lconfD])
 16.1674 +    with neq_Obj cls_C wf
 16.1675 +    have "G,s\<turnstile>val_this s\<Colon>\<preceq>Class (super c)"
 16.1676 +      by (auto intro: conf_widen
 16.1677 +                dest: subcls_direct[THEN widen.subcls])
 16.1678 +    with T conf_s
 16.1679 +    show "Norm s\<Colon>\<preceq>(G, L) \<and>
 16.1680 +           (normal (Norm s) \<longrightarrow> 
 16.1681 +              G,L,store (Norm s)\<turnstile>In1l Super\<succ>In1 (val_this s)\<Colon>\<preceq>T) \<and>
 16.1682 +           (error_free (Norm s) = error_free (Norm s))"
 16.1683 +      by simp
 16.1684 +  next
 16.1685 +    case (Acc f s0 s1 v va L accC T)
 16.1686 +    then show ?case
 16.1687 +      by (force elim!: wt_elim_cases)
 16.1688 +  next
 16.1689 +    case (Ass e f s0 s1 s2 v var w L accC T)
 16.1690 +    have eval_var: "G\<turnstile>Norm s0 \<midarrow>var=\<succ>(w, f)\<rightarrow> s1" .
 16.1691 +    have   eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>v\<rightarrow> s2" .
 16.1692 +    have  hyp_var: "PROP ?TypeSafe (Norm s0) s1 (In2 var) (In2 (w,f))" .
 16.1693 +    have    hyp_e: "PROP ?TypeSafe s1 s2 (In1l e) (In1 v)" .
 16.1694 +    have  conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1695 +    have       wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (var:=e)\<Colon>T" .
 16.1696 +    then obtain varT eT where
 16.1697 +	 wt_var: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>var\<Colon>=varT" and
 16.1698 +	   wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" and
 16.1699 +	  widen: "G\<turnstile>eT\<preceq>varT" and
 16.1700 +              T: "T=Inl eT"
 16.1701 +      by (rule wt_elim_cases) auto
 16.1702 +    from conf_s0 wt_var hyp_var
 16.1703 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.1704 +      by blast
 16.1705 +    with wt_e hyp_e
 16.1706 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.1707 +      by blast
 16.1708 +    show "assign f v s2\<Colon>\<preceq>(G, L) \<and>
 16.1709 +           (normal (assign f v s2) \<longrightarrow>
 16.1710 +            G,L,store (assign f v s2)\<turnstile>In1l (var:=e)\<succ>In1 v\<Colon>\<preceq>T) \<and>
 16.1711 +            (error_free (Norm s0) = error_free (assign f v s2))"
 16.1712 +    proof (cases "normal s1")
 16.1713 +      case False
 16.1714 +      with eval_e 
 16.1715 +      have "s2=s1"
 16.1716 +	by auto
 16.1717 +      with False conf_s1 error_free_s1
 16.1718 +      show ?thesis
 16.1719 +	by auto
 16.1720 +    next
 16.1721 +      case True
 16.1722 +      note normal_s1=this
 16.1723 +      show ?thesis 
 16.1724 +      proof (cases "normal s2")
 16.1725 +	case False
 16.1726 +	with conf_s2 error_free_s2 
 16.1727 +	show ?thesis
 16.1728 +	  by auto
 16.1729 +      next
 16.1730 +	case True
 16.1731 +	from True normal_s1 conf_s1 wt_e hyp_e
 16.1732 +	have conf_v_eT: "G,store s2\<turnstile>v\<Colon>\<preceq>eT"
 16.1733 +	  by force
 16.1734 +	with widen wf
 16.1735 +	have conf_v_varT: "G,store s2\<turnstile>v\<Colon>\<preceq>varT"
 16.1736 +	  by (auto intro: conf_widen)
 16.1737 +	from conf_s0 normal_s1 wt_var hyp_var
 16.1738 +	have "G,L,store s1\<turnstile>In2 var\<succ>In2 (w, f)\<Colon>\<preceq>Inl varT"
 16.1739 +	  by blast
 16.1740 +	then 
 16.1741 +	have conf_assign:  "store s1\<le>|f\<preceq>varT\<Colon>\<preceq>(G, L)" 
 16.1742 +	  by auto
 16.1743 +	from conf_v_eT conf_v_varT conf_assign normal_s1 True wf eval_var 
 16.1744 +	  eval_e T conf_s2 error_free_s2
 16.1745 +	show ?thesis
 16.1746 +	  by (cases s1, cases s2) 
 16.1747 +	     (auto dest!: Ass_lemma simp add: assign_conforms_def)
 16.1748 +      qed
 16.1749 +    qed
 16.1750 +  next
 16.1751 +    case (Cond b e0 e1 e2 s0 s1 s2 v L accC T)
 16.1752 +    have eval_e0: "G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<rightarrow> s1" .
 16.1753 +    have "G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<rightarrow> s2" .
 16.1754 +    have hyp_e0: "PROP ?TypeSafe (Norm s0) s1 (In1l e0) (In1 b)" .
 16.1755 +    have hyp_if: "PROP ?TypeSafe s1 s2 
 16.1756 +                       (In1l (if the_Bool b then e1 else e2)) (In1 v)" .
 16.1757 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1758 +    have wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (e0 ? e1 : e2)\<Colon>T" .
 16.1759 +    then obtain T1 T2 statT where
 16.1760 +      wt_e0: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e0\<Colon>-PrimT Boolean" and
 16.1761 +      wt_e1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e1\<Colon>-T1" and
 16.1762 +      wt_e2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e2\<Colon>-T2" and 
 16.1763 +      statT: "G\<turnstile>T1\<preceq>T2 \<and> statT = T2  \<or>  G\<turnstile>T2\<preceq>T1 \<and> statT =  T1" and
 16.1764 +      T    : "T=Inl statT"
 16.1765 +      by (rule wt_elim_cases) auto
 16.1766 +    with wt_e0 conf_s0 hyp_e0
 16.1767 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1" 
 16.1768 +      by blast
 16.1769 +    with wt_e1 wt_e2 statT hyp_if
 16.1770 +    obtain dynT where
 16.1771 +      conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2" and
 16.1772 +      conf_res: 
 16.1773 +          "(normal s2 \<longrightarrow>
 16.1774 +        G,L,store s2\<turnstile>In1l (if the_Bool b then e1 else e2)\<succ>In1 v\<Colon>\<preceq>Inl dynT)" and
 16.1775 +      dynT: "dynT = (if the_Bool b then T1 else T2)"
 16.1776 +      by (cases "the_Bool b") force+
 16.1777 +    from statT dynT  
 16.1778 +    have "G\<turnstile>dynT\<preceq>statT"
 16.1779 +      by (cases "the_Bool b") auto
 16.1780 +    with conf_s2 conf_res error_free_s2 T wf
 16.1781 +    show "s2\<Colon>\<preceq>(G, L) \<and>
 16.1782 +           (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In1l (e0 ? e1 : e2)\<succ>In1 v\<Colon>\<preceq>T) \<and>
 16.1783 +           (error_free (Norm s0) = error_free s2)"
 16.1784 +      by (auto)
 16.1785 +  next
 16.1786 +    case (Call invDeclC a' accC' args e mn mode pTs' s0 s1 s2 s3 s3' s4 statT 
 16.1787 +           v vs L accC T)
 16.1788 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<rightarrow> s1" .
 16.1789 +    have eval_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2" .
 16.1790 +    have invDeclC: "invDeclC 
 16.1791 +                      = invocation_declclass G mode (store s2) a' statT 
 16.1792 +                           \<lparr>name = mn, parTs = pTs'\<rparr>" .
 16.1793 +    have init_lvars: 
 16.1794 +           "s3 = init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2".
 16.1795 +    have check: "s3' =
 16.1796 +       check_method_access G accC' statT mode \<lparr>name = mn, parTs = pTs'\<rparr> a' s3" .
 16.1797 +    have eval_methd: 
 16.1798 +           "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>-\<succ>v\<rightarrow> s4" .
 16.1799 +    have     hyp_e: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 a')" .
 16.1800 +    have  hyp_args: "PROP ?TypeSafe s1 s2 (In3 args) (In3 vs)" .
 16.1801 +    have hyp_methd: "PROP ?TypeSafe s3' s4 
 16.1802 +                     (In1l (Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)) (In1 v)".
 16.1803 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.1804 +    have      wt: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>
 16.1805 +                    \<turnstile>In1l ({accC',statT,mode}e\<cdot>mn( {pTs'}args))\<Colon>T" .
 16.1806 +    from wt obtain pTs statDeclT statM where
 16.1807 +                 wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT" and
 16.1808 +              wt_args: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>args\<Colon>\<doteq>pTs" and
 16.1809 +                statM: "max_spec G accC statT \<lparr>name=mn,parTs=pTs\<rparr> 
 16.1810 +                         = {((statDeclT,statM),pTs')}" and
 16.1811 +                 mode: "mode = invmode statM e" and
 16.1812 +                    T: "T =Inl (resTy statM)" and
 16.1813 +        eq_accC_accC': "accC=accC'"
 16.1814 +      by (rule wt_elim_cases) auto
 16.1815 +    from conf_s0 wt_e hyp_e 
 16.1816 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and
 16.1817 +           conf_a': "normal s1 \<Longrightarrow> G, store s1\<turnstile>a'\<Colon>\<preceq>RefT statT" and
 16.1818 +           error_free_s1: "error_free s1" 
 16.1819 +      by force
 16.1820 +    with wt_args hyp_args
 16.1821 +    obtain    conf_s2: "s2\<Colon>\<preceq>(G, L)" and
 16.1822 +            conf_args: "normal s2 
 16.1823 +                         \<Longrightarrow>  list_all2 (conf G (store s2)) vs pTs" and
 16.1824 +        error_free_s2: "error_free s2" 
 16.1825 +      by force
 16.1826 +    from error_free_s2 init_lvars
 16.1827 +    have error_free_s3: "error_free s3"
 16.1828 +      by (auto simp add: init_lvars_def2)
 16.1829 +    from statM 
 16.1830 +    obtain
 16.1831 +      statM': "(statDeclT,statM)\<in>mheads G accC statT \<lparr>name=mn,parTs=pTs'\<rparr>" and
 16.1832 +      pTs_widen: "G\<turnstile>pTs[\<preceq>]pTs'"
 16.1833 +      by (blast dest: max_spec2mheads)
 16.1834 +    from check
 16.1835 +    have eq_store_s3'_s3: "store s3'=store s3"
 16.1836 +      by (cases s3) (simp add: check_method_access_def Let_def)
 16.1837 +    obtain invC
 16.1838 +      where invC: "invC = invocation_class mode (store s2) a' statT"
 16.1839 +      by simp
 16.1840 +    with init_lvars
 16.1841 +    have invC': "invC = (invocation_class mode (store s3) a' statT)"
 16.1842 +      by (cases s2,cases mode) (auto simp add: init_lvars_def2 )
 16.1843 +    show "(set_lvars (locals (store s2))) s4\<Colon>\<preceq>(G, L) \<and>
 16.1844 +             (normal ((set_lvars (locals (store s2))) s4) \<longrightarrow>
 16.1845 +               G,L,store ((set_lvars (locals (store s2))) s4)
 16.1846 +               \<turnstile>In1l ({accC',statT,mode}e\<cdot>mn( {pTs'}args))\<succ>In1 v\<Colon>\<preceq>T) \<and>
 16.1847 +             (error_free (Norm s0) =
 16.1848 +                error_free ((set_lvars (locals (store s2))) s4))"
 16.1849 +    proof (cases "normal s2")
 16.1850 +      case False
 16.1851 +      with init_lvars 
 16.1852 +      obtain keep_abrupt: "abrupt s3 = abrupt s2" and
 16.1853 +             "store s3 = store (init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> 
 16.1854 +                                            mode a' vs s2)" 
 16.1855 +	by (auto simp add: init_lvars_def2)
 16.1856 +      moreover
 16.1857 +      from keep_abrupt False check
 16.1858 +      have eq_s3'_s3: "s3'=s3" 
 16.1859 +	by (auto simp add: check_method_access_def Let_def)
 16.1860 +      moreover
 16.1861 +      from eq_s3'_s3 False keep_abrupt eval_methd
 16.1862 +      have "s4=s3'"
 16.1863 +	by auto
 16.1864 +      ultimately have
 16.1865 +	"set_lvars (locals (store s2)) s4 = s2"
 16.1866 +	by (cases s2,cases s4) (simp add: init_lvars_def2)
 16.1867 +      with False conf_s2 error_free_s2
 16.1868 +      show ?thesis
 16.1869 +	by auto
 16.1870 +    next
 16.1871 +      case True
 16.1872 +      note normal_s2 = True
 16.1873 +      with eval_args
 16.1874 +      have normal_s1: "normal s1"
 16.1875 +	by (cases "normal s1") auto
 16.1876 +      with conf_a' eval_args 
 16.1877 +      have conf_a'_s2: "G, store s2\<turnstile>a'\<Colon>\<preceq>RefT statT"
 16.1878 +	by (auto dest: eval_gext intro: conf_gext)
 16.1879 +      show ?thesis
 16.1880 +      proof (cases "a'=Null \<longrightarrow> is_static statM")
 16.1881 +	case False
 16.1882 +	then obtain not_static: "\<not> is_static statM" and Null: "a'=Null" 
 16.1883 +	  by blast
 16.1884 +	with normal_s2 init_lvars mode
 16.1885 +	obtain np: "abrupt s3 = Some (Xcpt (Std NullPointer))" and
 16.1886 +                   "store s3 = store (init_lvars G invDeclC 
 16.1887 +                                       \<lparr>name = mn, parTs = pTs'\<rparr> mode a' vs s2)"
 16.1888 +	  by (auto simp add: init_lvars_def2)
 16.1889 +	moreover
 16.1890 +	from np check
 16.1891 +	have eq_s3'_s3: "s3'=s3" 
 16.1892 +	  by (auto simp add: check_method_access_def Let_def)
 16.1893 +	moreover
 16.1894 +	from eq_s3'_s3 np eval_methd
 16.1895 +	have "s4=s3'"
 16.1896 +	  by auto
 16.1897 +	ultimately have
 16.1898 +	  "set_lvars (locals (store s2)) s4 
 16.1899 +           = (Some (Xcpt (Std NullPointer)),store s2)"
 16.1900 +	  by (cases s2,cases s4) (simp add: init_lvars_def2)
 16.1901 +	with conf_s2 error_free_s2
 16.1902 +	show ?thesis
 16.1903 +	  by (cases s2) (auto dest: conforms_NormI)
 16.1904 +      next
 16.1905 +	case True
 16.1906 +	with mode have notNull: "mode = IntVir \<longrightarrow> a' \<noteq> Null"
 16.1907 +	  by (auto dest!: Null_staticD)
 16.1908 +	with conf_s2 conf_a'_s2 wf invC  
 16.1909 +	have dynT_prop: "G\<turnstile>mode\<rightarrow>invC\<preceq>statT"
 16.1910 +	  by (cases s2) (auto intro: DynT_propI)
 16.1911 +	with wt_e statM' invC mode wf 
 16.1912 +	obtain dynM where 
 16.1913 +          dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
 16.1914 +          acc_dynM: "G \<turnstile>Methd  \<lparr>name=mn,parTs=pTs'\<rparr> dynM 
 16.1915 +                          in invC dyn_accessible_from accC"
 16.1916 +	  by (force dest!: call_access_ok)
 16.1917 +	with invC' check eq_accC_accC'
 16.1918 +	have eq_s3'_s3: "s3'=s3"
 16.1919 +	  by (auto simp add: check_method_access_def Let_def)
 16.1920 +	from dynT_prop wf wt_e statM' mode invC invDeclC dynM 
 16.1921 +	obtain 
 16.1922 +	   wf_dynM: "wf_mdecl G invDeclC (\<lparr>name=mn,parTs=pTs'\<rparr>,mthd dynM)" and
 16.1923 +	     dynM': "methd G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
 16.1924 +           iscls_invDeclC: "is_class G invDeclC" and
 16.1925 +	        invDeclC': "invDeclC = declclass dynM" and
 16.1926 +	     invC_widen: "G\<turnstile>invC\<preceq>\<^sub>C invDeclC" and
 16.1927 +	    resTy_widen: "G\<turnstile>resTy dynM\<preceq>resTy statM" and
 16.1928 +	   is_static_eq: "is_static dynM = is_static statM" and
 16.1929 +	   involved_classes_prop:
 16.1930 +             "(if invmode statM e = IntVir
 16.1931 +               then \<forall>statC. statT = ClassT statC \<longrightarrow> G\<turnstile>invC\<preceq>\<^sub>C statC
 16.1932 +               else ((\<exists>statC. statT = ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C invDeclC) \<or>
 16.1933 +                     (\<forall>statC. statT \<noteq> ClassT statC \<and> invDeclC = Object)) \<and>
 16.1934 +                      statDeclT = ClassT invDeclC)"
 16.1935 +	  by (auto dest: DynT_mheadsD)
 16.1936 +	obtain L' where 
 16.1937 +	   L':"L'=(\<lambda> k. 
 16.1938 +                 (case k of
 16.1939 +                    EName e
 16.1940 +                    \<Rightarrow> (case e of 
 16.1941 +                          VNam v 
 16.1942 +                          \<Rightarrow>(table_of (lcls (mbody (mthd dynM)))
 16.1943 +                             (pars (mthd dynM)[\<mapsto>]pTs')) v
 16.1944 +                        | Res \<Rightarrow> Some (resTy dynM))
 16.1945 +                  | This \<Rightarrow> if is_static statM 
 16.1946 +                            then None else Some (Class invDeclC)))"
 16.1947 +	  by simp
 16.1948 +	from wf_dynM [THEN wf_mdeclD1, THEN conjunct1] normal_s2 conf_s2 wt_e
 16.1949 +             wf eval_args conf_a' mode notNull wf_dynM involved_classes_prop
 16.1950 +	have conf_s3: "s3\<Colon>\<preceq>(G,L')"
 16.1951 +	  apply - 
 16.1952 +             (* FIXME confomrs_init_lvars should be 
 16.1953 +                adjusted to be more directy applicable *)
 16.1954 +	  apply (drule conforms_init_lvars [of G invDeclC 
 16.1955 +                  "\<lparr>name=mn,parTs=pTs'\<rparr>" dynM "store s2" vs pTs "abrupt s2" 
 16.1956 +                  L statT invC a' "(statDeclT,statM)" e])
 16.1957 +	  apply (rule wf)
 16.1958 +	  apply (rule conf_args,assumption)
 16.1959 +	  apply (simp add: pTs_widen)
 16.1960 +	  apply (cases s2,simp)
 16.1961 +	  apply (rule dynM')
 16.1962 +	  apply (force dest: ty_expr_is_type)
 16.1963 +	  apply (rule invC_widen)
 16.1964 +	  apply (force intro: conf_gext dest: eval_gext)
 16.1965 +	  apply simp
 16.1966 +	  apply simp
 16.1967 +	  apply (simp add: invC)
 16.1968 +	  apply (simp add: invDeclC)
 16.1969 +	  apply (force dest: wf_mdeclD1 is_acc_typeD)
 16.1970 +	  apply (cases s2, simp add: L' init_lvars
 16.1971 +	                      cong add: lname.case_cong ename.case_cong)
 16.1972 +	  done 
 16.1973 +	from  is_static_eq wf_dynM L'
 16.1974 +	obtain mthdT where
 16.1975 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
 16.1976 +            \<turnstile>Body invDeclC (stmt (mbody (mthd dynM)))\<Colon>-mthdT" and
 16.1977 +	   mthdT_widen: "G\<turnstile>mthdT\<preceq>resTy dynM"
 16.1978 +	  by - (drule wf_mdecl_bodyD,
 16.1979 +                simp cong add: lname.case_cong ename.case_cong)
 16.1980 +	with dynM' iscls_invDeclC invDeclC'
 16.1981 +	have
 16.1982 +	   "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
 16.1983 +            \<turnstile>(Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)\<Colon>-mthdT"
 16.1984 +	  by (auto intro: wt.Methd)
 16.1985 +	with eq_s3'_s3 conf_s3 error_free_s3 
 16.1986 +             hyp_methd [of L' invDeclC "Inl mthdT"]
 16.1987 +	obtain  conf_s4: "s4\<Colon>\<preceq>(G, L')" and 
 16.1988 +	       conf_Res: "normal s4 \<longrightarrow> G,store s4\<turnstile>v\<Colon>\<preceq>mthdT" and
 16.1989 +	  error_free_s4: "error_free s4"
 16.1990 +	  by auto
 16.1991 +	from init_lvars eval_methd eq_s3'_s3 
 16.1992 +	have "store s2\<le>|store s4"
 16.1993 +	  by (cases s2) (auto dest!: eval_gext simp add: init_lvars_def2 )
 16.1994 +	with conf_s2 conf_s4
 16.1995 +	have "(set_lvars (locals (store s2))) s4\<Colon>\<preceq>(G, L)"
 16.1996 +	  by (cases s2,cases s4) (auto intro: conforms_return)
 16.1997 +	moreover 
 16.1998 +	from conf_Res mthdT_widen resTy_widen wf
 16.1999 +	have "normal s4 
 16.2000 +             \<longrightarrow> G,store s4\<turnstile>v\<Colon>\<preceq>(resTy statM)"
 16.2001 +	  by (auto dest: widen_trans)
 16.2002 +	then
 16.2003 +	have "normal ((set_lvars (locals (store s2))) s4)
 16.2004 +             \<longrightarrow> G,store((set_lvars (locals (store s2))) s4) \<turnstile>v\<Colon>\<preceq>(resTy statM)"
 16.2005 +	  by (cases s4) auto
 16.2006 +	moreover note error_free_s4 T
 16.2007 +	ultimately 
 16.2008 +	show ?thesis
 16.2009 +	  by simp
 16.2010 +      qed
 16.2011 +    qed
 16.2012 +  next
 16.2013 +    case (Methd D s0 s1 sig v L accC T)
 16.2014 +    have "G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<rightarrow> s1" .
 16.2015 +    have hyp: "PROP ?TypeSafe (Norm s0) s1 (In1l (body G D sig)) (In1 v)" .
 16.2016 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.2017 +    have      wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (Methd D sig)\<Colon>T" .
 16.2018 +    then obtain m bodyT where
 16.2019 +      D: "is_class G D" and
 16.2020 +      m: "methd G D sig = Some m" and
 16.2021 +      wt_body: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>
 16.2022 +                   \<turnstile>Body (declclass m) (stmt (mbody (mthd m)))\<Colon>-bodyT" and
 16.2023 +      T: "T=Inl bodyT"
 16.2024 +      by (rule wt_elim_cases) auto
 16.2025 +    with hyp [of _ _ "(Inl bodyT)"] conf_s0 
 16.2026 +    show "s1\<Colon>\<preceq>(G, L) \<and> 
 16.2027 +           (normal s1 \<longrightarrow> G,L,snd s1\<turnstile>In1l (Methd D sig)\<succ>In1 v\<Colon>\<preceq>T) \<and>
 16.2028 +           (error_free (Norm s0) = error_free s1)"
 16.2029 +      by (auto simp add: Let_def body_def)
 16.2030 +  next
 16.2031 +    case (Body D c s0 s1 s2 L accC T)
 16.2032 +    have "G\<turnstile>Norm s0 \<midarrow>Init D\<rightarrow> s1" .
 16.2033 +    have "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2" .
 16.2034 +    have hyp_init: "PROP ?TypeSafe (Norm s0) s1 (In1r (Init D)) \<diamondsuit>" .
 16.2035 +    have hyp_c: "PROP ?TypeSafe s1 s2 (In1r c) \<diamondsuit>" .
 16.2036 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.2037 +    have wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In1l (Body D c)\<Colon>T" .
 16.2038 +    then obtain bodyT where
 16.2039 +         iscls_D: "is_class G D" and
 16.2040 +            wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>" and
 16.2041 +         resultT: "L Result = Some bodyT" and
 16.2042 +      isty_bodyT: "is_type G bodyT" and (* ### not needed! remove from wt? *)
 16.2043 +               T: "T=Inl bodyT"
 16.2044 +      by (rule wt_elim_cases) auto
 16.2045 +    from conf_s0 iscls_D hyp_init
 16.2046 +    obtain "s1\<Colon>\<preceq>(G, L)" "error_free s1"
 16.2047 +      by auto
 16.2048 +    with wt_c hyp_c
 16.2049 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.2050 +      by blast
 16.2051 +    from conf_s2
 16.2052 +    have "abupd (absorb Ret) s2\<Colon>\<preceq>(G, L)"
 16.2053 +      by (cases s2) (auto intro: conforms_absorb)
 16.2054 +    moreover
 16.2055 +    from error_free_s2
 16.2056 +    have "error_free (abupd (absorb Ret) s2)"
 16.2057 +      by simp
 16.2058 +    moreover note T resultT
 16.2059 +    ultimately
 16.2060 +    show "abupd (absorb Ret) s2\<Colon>\<preceq>(G, L) \<and>
 16.2061 +           (normal (abupd (absorb Ret) s2) \<longrightarrow>
 16.2062 +             G,L,store (abupd (absorb Ret) s2)
 16.2063 +              \<turnstile>In1l (Body D c)\<succ>In1 (the (locals (store s2) Result))\<Colon>\<preceq>T) \<and>
 16.2064 +          (error_free (Norm s0) = error_free (abupd (absorb Ret) s2)) "
 16.2065 +      by (cases s2) (auto intro: conforms_locals)
 16.2066 +  next
 16.2067 +    case (LVar s vn L accC T)
 16.2068 +    have conf_s: "Norm s\<Colon>\<preceq>(G, L)" and 
 16.2069 +             wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In2 (LVar vn)\<Colon>T" .
 16.2070 +    then obtain vnT where
 16.2071 +      vnT: "L vn = Some vnT" and
 16.2072 +        T: "T=Inl vnT"
 16.2073 +      by (auto elim!: wt_elim_cases)
 16.2074 +    from conf_s vnT
 16.2075 +    have conf_fst: "G,s\<turnstile>fst (lvar vn s)\<Colon>\<preceq>vnT"  
 16.2076 +      by (auto elim: conforms_localD [THEN lconfD]  
 16.2077 +               simp add: lvar_def)
 16.2078 +    moreover
 16.2079 +    from conf_s conf_fst vnT 
 16.2080 +    have "s\<le>|snd (lvar vn s)\<preceq>vnT\<Colon>\<preceq>(G, L)"
 16.2081 +      by (auto elim: conforms_lupd simp add: assign_conforms_def lvar_def)
 16.2082 +    moreover note conf_s T
 16.2083 +    ultimately 
 16.2084 +    show "Norm s\<Colon>\<preceq>(G, L) \<and>
 16.2085 +                 (normal (Norm s) \<longrightarrow>
 16.2086 +                    G,L,store (Norm s)\<turnstile>In2 (LVar vn)\<succ>In2 (lvar vn s)\<Colon>\<preceq>T) \<and>
 16.2087 +                 (error_free (Norm s) = error_free (Norm s))"
 16.2088 +      by simp 
 16.2089 +  next
 16.2090 +    case (FVar a accC e fn s0 s1 s2 s2' s3 stat statDeclC v L accC' T)
 16.2091 +    have eval_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1" .
 16.2092 +    have eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2" .
 16.2093 +    have fvar: "(v, s2') = fvar statDeclC stat fn a s2" .
 16.2094 +    have check: "s3 = check_field_access G accC statDeclC fn stat a s2'" .
 16.2095 +    have hyp_init: "PROP ?TypeSafe (Norm s0) s1 (In1r (Init statDeclC)) \<diamondsuit>" .
 16.2096 +    have hyp_e: "PROP ?TypeSafe s1 s2 (In1l e) (In1 a)" .
 16.2097 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.2098 +    have wt: "\<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile>In2 ({accC,statDeclC,stat}e..fn)\<Colon>T" .
 16.2099 +    then obtain statC f where
 16.2100 +                wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
 16.2101 +            accfield: "accfield G accC statC fn = Some (statDeclC,f)" and
 16.2102 +       eq_accC_accC': "accC=accC'" and
 16.2103 +                stat: "stat=is_static f" and
 16.2104 +	           T: "T=(Inl (type f))"
 16.2105 +      by (rule wt_elim_cases) (auto simp add: member_is_static_simp)
 16.2106 +    from wf wt_e 
 16.2107 +    have iscls_statC: "is_class G statC"
 16.2108 +      by (auto dest: ty_expr_is_type type_is_class)
 16.2109 +    with wf accfield 
 16.2110 +    have iscls_statDeclC: "is_class G statDeclC"
 16.2111 +      by (auto dest!: accfield_fields dest: fields_declC)
 16.2112 +    with conf_s0 hyp_init
 16.2113 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1"
 16.2114 +      by auto
 16.2115 +    from conf_s1 wt_e hyp_e
 16.2116 +    obtain       conf_s2: "s2\<Colon>\<preceq>(G, L)" and
 16.2117 +                  conf_a: "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC" 
 16.2118 +      by force
 16.2119 +    from conf_s1 wt_e error_free_s1 hyp_e
 16.2120 +    have error_free_s2: "error_free s2"
 16.2121 +      by auto
 16.2122 +    from fvar 
 16.2123 +    have store_s2': "store s2'=store s2"
 16.2124 +      by (cases s2) (simp add: fvar_def2)
 16.2125 +    with fvar conf_s2 
 16.2126 +    have conf_s2': "s2'\<Colon>\<preceq>(G, L)"
 16.2127 +      by (cases s2,cases stat) (auto simp add: fvar_def2)
 16.2128 +    from eval_init 
 16.2129 +    have initd_statDeclC_s1: "initd statDeclC s1"
 16.2130 +      by (rule init_yields_initd)
 16.2131 +    from accfield wt_e eval_init eval_e conf_s2 conf_a fvar stat check  wf
 16.2132 +    have eq_s3_s2': "s3=s2'"  
 16.2133 +      by (auto dest!: error_free_field_access)
 16.2134 +    have conf_v: "normal s2' \<Longrightarrow> 
 16.2135 +           G,store s2'\<turnstile>fst v\<Colon>\<preceq>type f \<and> store s2'\<le>|snd v\<preceq>type f\<Colon>\<preceq>(G, L)"
 16.2136 +    proof - (*###FVar_lemma should be adjusted to be more directy applicable *)
 16.2137 +      assume normal: "normal s2'"
 16.2138 +      obtain vv vf x2 store2 store2'
 16.2139 +	where  v: "v=(vv,vf)" and
 16.2140 +              s2: "s2=(x2,store2)" and
 16.2141 +         store2': "store s2' = store2'"
 16.2142 +	by (cases v,cases s2,cases s2') blast
 16.2143 +      from iscls_statDeclC obtain c
 16.2144 +	where c: "class G statDeclC = Some c"
 16.2145 +	by auto
 16.2146 +      have "G,store2'\<turnstile>vv\<Colon>\<preceq>type f \<and> store2'\<le>|vf\<preceq>type f\<Colon>\<preceq>(G, L)"
 16.2147 +      proof (rule FVar_lemma [of vv vf store2' statDeclC f fn a x2 store2 
 16.2148 +                               statC G c L "store s1"])
 16.2149 +	from v normal s2 fvar stat store2' 
 16.2150 +	show "((vv, vf), Norm store2') = 
 16.2151 +               fvar statDeclC (static f) fn a (x2, store2)"
 16.2152 +	  by (auto simp add: member_is_static_simp)
 16.2153 +	from accfield iscls_statC wf
 16.2154 +	show "G\<turnstile>statC\<preceq>\<^sub>C statDeclC"
 16.2155 +	  by (auto dest!: accfield_fields dest: fields_declC)
 16.2156 +	from accfield
 16.2157 +	show fld: "table_of (fields G statC) (fn, statDeclC) = Some f"
 16.2158 +	  by (auto dest!: accfield_fields)
 16.2159 +	from wf show "wf_prog G" .
 16.2160 +	from conf_a s2 show "x2 = None \<longrightarrow> G,store2\<turnstile>a\<Colon>\<preceq>Class statC"
 16.2161 +	  by auto
 16.2162 +	from fld wf iscls_statC
 16.2163 +	show "statDeclC \<noteq> Object "
 16.2164 +	  by (cases "statDeclC=Object") (drule fields_declC,simp+)+
 16.2165 +	from c show "class G statDeclC = Some c" .
 16.2166 +	from conf_s2 s2 show "(x2, store2)\<Colon>\<preceq>(G, L)" by simp
 16.2167 +	from eval_e s2 show "snd s1\<le>|store2" by (auto dest: eval_gext)
 16.2168 +	from initd_statDeclC_s1 show "inited statDeclC (globs (snd s1))" 
 16.2169 +	  by simp
 16.2170 +      qed
 16.2171 +      with v s2 store2'  
 16.2172 +      show ?thesis
 16.2173 +	by simp
 16.2174 +    qed
 16.2175 +    from fvar error_free_s2
 16.2176 +    have "error_free s2'"
 16.2177 +      by (cases s2)
 16.2178 +         (auto simp add: fvar_def2 intro!: error_free_FVar_lemma)
 16.2179 +    with conf_v T conf_s2' eq_s3_s2'
 16.2180 +    show "s3\<Colon>\<preceq>(G, L) \<and>
 16.2181 +          (normal s3 
 16.2182 +           \<longrightarrow> G,L,store s3\<turnstile>In2 ({accC,statDeclC,stat}e..fn)\<succ>In2 v\<Colon>\<preceq>T) \<and>
 16.2183 +          (error_free (Norm s0) = error_free s3)"
 16.2184 +      by auto
 16.2185 +  next
 16.2186 +    case (AVar a e1 e2 i s0 s1 s2 s2' v L accC T)
 16.2187 +    have eval_e1: "G\<turnstile>Norm s0 \<midarrow>e1-\<succ>a\<rightarrow> s1" .
 16.2188 +    have eval_e2: "G\<turnstile>s1 \<midarrow>e2-\<succ>i\<rightarrow> s2" .
 16.2189 +    have hyp_e1: "PROP ?TypeSafe (Norm s0) s1 (In1l e1) (In1 a)" .
 16.2190 +    have hyp_e2: "PROP ?TypeSafe s1 s2 (In1l e2) (In1 i)" .
 16.2191 +    have avar: "(v, s2') = avar G i a s2" .
 16.2192 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.2193 +    have wt:  "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In2 (e1.[e2])\<Colon>T" .
 16.2194 +    then obtain elemT
 16.2195 +       where wt_e1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e1\<Colon>-elemT.[]" and
 16.2196 +             wt_e2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e2\<Colon>-PrimT Integer" and
 16.2197 +                 T: "T= Inl elemT"
 16.2198 +      by (rule wt_elim_cases) auto
 16.2199 +    from  conf_s0 wt_e1 hyp_e1 
 16.2200 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and
 16.2201 +            conf_a: "(normal s1 \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>elemT.[])" and
 16.2202 +            error_free_s1: "error_free s1"
 16.2203 +      by force
 16.2204 +    from conf_s1 error_free_s1 wt_e2 hyp_e2
 16.2205 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and error_free_s2: "error_free s2"
 16.2206 +      by blast
 16.2207 +    from avar 
 16.2208 +    have "store s2'=store s2"
 16.2209 +      by (cases s2) (simp add: avar_def2)
 16.2210 +    with avar conf_s2 
 16.2211 +    have conf_s2': "s2'\<Colon>\<preceq>(G, L)"
 16.2212 +      by (cases s2) (auto simp add: avar_def2)
 16.2213 +    from avar error_free_s2
 16.2214 +    have error_free_s2': "error_free s2'"
 16.2215 +      by (cases s2) (auto simp add: avar_def2 )
 16.2216 +    have "normal s2' \<Longrightarrow> 
 16.2217 +           G,store s2'\<turnstile>fst v\<Colon>\<preceq>elemT \<and> store s2'\<le>|snd v\<preceq>elemT\<Colon>\<preceq>(G, L)"
 16.2218 +    proof -(*###AVar_lemma should be adjusted to be more directy applicable *)
 16.2219 +      assume normal: "normal s2'"
 16.2220 +      show ?thesis
 16.2221 +      proof -
 16.2222 +	obtain vv vf x1 store1 x2 store2 store2'
 16.2223 +	   where  v: "v=(vv,vf)" and
 16.2224 +                 s1: "s1=(x1,store1)" and
 16.2225 +                 s2: "s2=(x2,store2)" and
 16.2226 +	    store2': "store2'=store s2'"
 16.2227 +	  by (cases v,cases s1, cases s2, cases s2') blast 
 16.2228 +	have "G,store2'\<turnstile>vv\<Colon>\<preceq>elemT \<and> store2'\<le>|vf\<preceq>elemT\<Colon>\<preceq>(G, L)"
 16.2229 +	proof (rule AVar_lemma [of G x1 store1 e2 i x2 store2 vv vf store2' a,
 16.2230 +                                 OF wf])
 16.2231 +	  from s1 s2 eval_e2 show "G\<turnstile>(x1, store1) \<midarrow>e2-\<succ>i\<rightarrow> (x2, store2)"
 16.2232 +	    by simp
 16.2233 +	  from v normal s2 store2' avar 
 16.2234 +	  show "((vv, vf), Norm store2') = avar G i a (x2, store2)"
 16.2235 +	    by auto
 16.2236 +	  from s2 conf_s2 show "(x2, store2)\<Colon>\<preceq>(G, L)" by simp
 16.2237 +	  from s1 conf_a show  "x1 = None \<longrightarrow> G,store1\<turnstile>a\<Colon>\<preceq>elemT.[]" by simp 
 16.2238 +	  from eval_e2 s1 s2 show "store1\<le>|store2" by (auto dest: eval_gext)
 16.2239 +	qed
 16.2240 +	with v s1 s2 store2' 
 16.2241 +	show ?thesis
 16.2242 +	  by simp
 16.2243 +      qed
 16.2244 +    qed
 16.2245 +    with conf_s2' error_free_s2' T 
 16.2246 +    show "s2'\<Colon>\<preceq>(G, L) \<and>
 16.2247 +           (normal s2' \<longrightarrow> G,L,store s2'\<turnstile>In2 (e1.[e2])\<succ>In2 v\<Colon>\<preceq>T) \<and>
 16.2248 +           (error_free (Norm s0) = error_free s2') "
 16.2249 +      by auto
 16.2250 +  next
 16.2251 +    case (Nil s0 L accC T)
 16.2252 +    then show ?case
 16.2253 +      by (auto elim!: wt_elim_cases)
 16.2254 +  next
 16.2255 +    case (Cons e es s0 s1 s2 v vs L accC T)
 16.2256 +    have eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<rightarrow> s1" .
 16.2257 +    have eval_es: "G\<turnstile>s1 \<midarrow>es\<doteq>\<succ>vs\<rightarrow> s2" .
 16.2258 +    have hyp_e: "PROP ?TypeSafe (Norm s0) s1 (In1l e) (In1 v)" .
 16.2259 +    have hyp_es: "PROP ?TypeSafe s1 s2 (In3 es) (In3 vs)" .
 16.2260 +    have conf_s0: "Norm s0\<Colon>\<preceq>(G, L)" .
 16.2261 +    have wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>In3 (e # es)\<Colon>T" .
 16.2262 +    then obtain eT esT where
 16.2263 +       wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" and
 16.2264 +       wt_es: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>es\<Colon>\<doteq>esT" and
 16.2265 +       T: "T=Inr (eT#esT)"
 16.2266 +      by (rule wt_elim_cases) blast
 16.2267 +    from hyp_e [OF conf_s0 wt_e]
 16.2268 +    obtain conf_s1: "s1\<Colon>\<preceq>(G, L)" and error_free_s1: "error_free s1" and 
 16.2269 +      conf_v: "normal s1 \<longrightarrow> G,store s1\<turnstile>v\<Colon>\<preceq>eT"
 16.2270 +      by auto
 16.2271 +    from eval_es conf_v 
 16.2272 +    have conf_v': "normal s2 \<longrightarrow> G,store s2\<turnstile>v\<Colon>\<preceq>eT"
 16.2273 +      apply clarify
 16.2274 +      apply (rule conf_gext)
 16.2275 +      apply (auto dest: eval_gext)
 16.2276 +      done
 16.2277 +    from hyp_es [OF conf_s1 wt_es] error_free_s1 
 16.2278 +    obtain conf_s2: "s2\<Colon>\<preceq>(G, L)" and 
 16.2279 +           error_free_s2: "error_free s2" and
 16.2280 +           conf_vs: "normal s2 \<longrightarrow> list_all2 (conf G (store s2)) vs esT"
 16.2281 +      by auto
 16.2282 +    with conf_v' T
 16.2283 +    show 
 16.2284 +      "s2\<Colon>\<preceq>(G, L) \<and> 
 16.2285 +      (normal s2 \<longrightarrow> G,L,store s2\<turnstile>In3 (e # es)\<succ>In3 (v # vs)\<Colon>\<preceq>T) \<and>
 16.2286 +      (error_free (Norm s0) = error_free s2) "
 16.2287 +      by auto
 16.2288 +  qed
 16.2289 +  then show ?thesis .
 16.2290 +qed
 16.2291 + 
 16.2292 +corollary eval_ts: 
 16.2293 + "\<lbrakk>G\<turnstile>s \<midarrow>e-\<succ>v \<rightarrow> s'; wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-T\<rbrakk> 
 16.2294 +\<Longrightarrow>  s'\<Colon>\<preceq>(G,L) \<and> (normal s' \<longrightarrow> G,store s'\<turnstile>v\<Colon>\<preceq>T) \<and> 
 16.2295 +     (error_free s = error_free s')"
 16.2296  apply (drule (3) eval_type_sound)
 16.2297 -apply (unfold Let_def)
 16.2298  apply clarsimp
 16.2299  done
 16.2300  
 16.2301 -theorem evals_ts: 
 16.2302 -"\<lbrakk>G\<turnstile>s \<midarrow>es\<doteq>\<succ>vs\<rightarrow> (x',s'); wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>es\<Colon>\<doteq>Ts\<rbrakk> 
 16.2303 -\<Longrightarrow>  (x',s')\<Colon>\<preceq>(G,L) \<and> (x'=None \<longrightarrow> list_all2 (conf G s') vs Ts)"
 16.2304 +corollary evals_ts: 
 16.2305 +"\<lbrakk>G\<turnstile>s \<midarrow>es\<doteq>\<succ>vs\<rightarrow> s'; wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>es\<Colon>\<doteq>Ts\<rbrakk> 
 16.2306 +\<Longrightarrow>  s'\<Colon>\<preceq>(G,L) \<and> (normal s' \<longrightarrow> list_all2 (conf G (store s')) vs Ts) \<and> 
 16.2307 +     (error_free s = error_free s')" 
 16.2308  apply (drule (3) eval_type_sound)
 16.2309 -apply (unfold Let_def)
 16.2310  apply clarsimp
 16.2311  done
 16.2312  
 16.2313 -theorem evar_ts: 
 16.2314 -"\<lbrakk>G\<turnstile>s \<midarrow>v=\<succ>vf\<rightarrow> (x',s'); wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>v\<Colon>=T\<rbrakk> \<Longrightarrow>  
 16.2315 -  (x',s')\<Colon>\<preceq>(G,L) \<and> (x'=None \<longrightarrow> G,L,s'\<turnstile>In2 v\<succ>In2 vf\<Colon>\<preceq>Inl T)"
 16.2316 +corollary evar_ts: 
 16.2317 +"\<lbrakk>G\<turnstile>s \<midarrow>v=\<succ>vf\<rightarrow> s'; wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>v\<Colon>=T\<rbrakk> \<Longrightarrow>  
 16.2318 +  s'\<Colon>\<preceq>(G,L) \<and> (normal s' \<longrightarrow> G,L,(store s')\<turnstile>In2 v\<succ>In2 vf\<Colon>\<preceq>Inl T) \<and> 
 16.2319 +  (error_free s = error_free s')"
 16.2320  apply (drule (3) eval_type_sound)
 16.2321 -apply (unfold Let_def)
 16.2322  apply clarsimp
 16.2323  done
 16.2324  
 16.2325  theorem exec_ts: 
 16.2326 -"\<lbrakk>G\<turnstile>s \<midarrow>s0\<rightarrow> s'; wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>s0\<Colon>\<surd>\<rbrakk> \<Longrightarrow> s'\<Colon>\<preceq>(G,L)"
 16.2327 +"\<lbrakk>G\<turnstile>s \<midarrow>s0\<rightarrow> s'; wf_prog G; s\<Colon>\<preceq>(G,L); \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>s0\<Colon>\<surd>\<rbrakk> 
 16.2328 + \<Longrightarrow> s'\<Colon>\<preceq>(G,L) \<and> (error_free s \<longrightarrow> error_free s')"
 16.2329  apply (drule (3) eval_type_sound)
 16.2330 -apply (unfold Let_def)
 16.2331  apply clarsimp
 16.2332  done
 16.2333 -
 16.2334 -(*
 16.2335 -theorem dyn_methods_understood: 
 16.2336 - "\<And>s. \<lbrakk>wf_prog G; \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>{t,md,IntVir}e..mn({pTs'}ps)\<Colon>-rT;  
 16.2337 -  s\<Colon>\<preceq>(G,L); G\<turnstile>s \<midarrow>e-\<succ>a'\<rightarrow> Norm s'; a' \<noteq> Null\<rbrakk> \<Longrightarrow>  
 16.2338 -  \<exists>a obj. a'=Addr a \<and> heap s' a = Some obj \<and> 
 16.2339 -  cmethd G (obj_class obj) (mn, pTs') \<noteq> None"
 16.2340 -apply (erule wt_elim_cases)
 16.2341 -apply (drule max_spec2mheads)
 16.2342 -apply (drule (3) eval_ts)
 16.2343 -apply (clarsimp split del: split_if split_if_asm)
 16.2344 -apply (drule (2) DynT_propI)
 16.2345 -apply  (simp (no_asm_simp))
 16.2346 -apply (tactic *) (* {* exhaust_cmethd_tac "the (cmethd G (target (invmode m e) s' a' md) (mn, pTs'))" 1 *} *)(*)
 16.2347 -apply (drule (4) DynT_mheadsD [THEN conjunct1], rule HOL.refl)
 16.2348 -apply (drule conf_RefTD)
 16.2349 -apply clarsimp
 16.2350 -done 
 16.2351 -*)
 16.2352 -
 16.2353  end
    17.1 --- a/src/HOL/Bali/WellForm.thy	Thu Feb 21 20:11:32 2002 +0100
    17.2 +++ b/src/HOL/Bali/WellForm.thy	Fri Feb 22 11:26:44 2002 +0100
    17.3 @@ -1,6 +1,6 @@
    17.4  (*  Title:      HOL/Bali/WellForm.thy
    17.5      ID:         $Id$
    17.6 -    Author:     David von Oheimb
    17.7 +    Author:     David von Oheimb and Norbert Schirmer
    17.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
    17.9  *)
   17.10  
   17.11 @@ -31,8 +31,8 @@
   17.12  *}
   17.13  
   17.14  section "well-formed field declarations"
   17.15 -  (* well-formed field declaration (common part for classes and interfaces),
   17.16 -     cf. 8.3 and (9.3) *)
   17.17 +text  {* well-formed field declaration (common part for classes and interfaces),
   17.18 +        cf. 8.3 and (9.3) *}
   17.19  
   17.20  constdefs
   17.21    wf_fdecl :: "prog \<Rightarrow> pname \<Rightarrow> fdecl \<Rightarrow> bool"
   17.22 @@ -98,7 +98,7 @@
   17.23                          VNam v 
   17.24                          \<Rightarrow>(table_of (lcls (mbody m))((pars m)[\<mapsto>](parTs sig))) v
   17.25                        | Res \<Rightarrow> Some (resTy m))
   17.26 -	        | This \<Rightarrow> if static m then None else Some (Class C))
   17.27 +	        | This \<Rightarrow> if is_static m then None else Some (Class C))
   17.28            \<rparr>\<turnstile>(stmt (mbody m))\<Colon>\<surd>"
   17.29  
   17.30  lemma wf_mheadI: 
   17.31 @@ -122,7 +122,7 @@
   17.32                  VNam v 
   17.33                  \<Rightarrow> (table_of (lcls (mbody m))((pars m)[\<mapsto>](parTs sig))) v
   17.34                | Res \<Rightarrow> Some (resTy m))
   17.35 -        | This \<Rightarrow> if static m then None else Some (Class C))
   17.36 +        | This \<Rightarrow> if is_static m then None else Some (Class C))
   17.37    \<rparr>\<turnstile>(stmt (mbody m))\<Colon>\<surd>
   17.38    \<rbrakk> \<Longrightarrow>  
   17.39    wf_mdecl G C (sig,m)"
   17.40 @@ -149,7 +149,7 @@
   17.41              \<Rightarrow> (case e of 
   17.42                  VNam v \<Rightarrow> (table_of (lcls (mbody m))((pars m)[\<mapsto>](parTs sig))) v
   17.43                  | Res  \<Rightarrow> Some (resTy m))
   17.44 -          | This \<Rightarrow> if static m then None else Some (Class C))
   17.45 +          | This \<Rightarrow> if is_static m then None else Some (Class C))
   17.46         \<rparr>\<turnstile>Body C (stmt (mbody m))\<Colon>-T \<and> G\<turnstile>T\<preceq>(resTy m))"
   17.47  apply (unfold wf_mdecl_def)
   17.48  apply clarify
   17.49 @@ -1291,12 +1291,6 @@
   17.50    qed
   17.51  qed
   17.52  
   17.53 -declare split_paired_All [simp del] split_paired_Ex [simp del]
   17.54 -ML_setup {*
   17.55 -simpset_ref() := simpset() delloop "split_all_tac";
   17.56 -claset_ref () := claset () delSWrapper "split_all_tac"
   17.57 -*}
   17.58 -
   17.59  lemma declclass_widen[rule_format]: 
   17.60   "wf_prog G 
   17.61   \<longrightarrow> (\<forall>c m. class G C = Some c \<longrightarrow> methd G C sig = Some m 
   17.62 @@ -1326,8 +1320,9 @@
   17.63        moreover
   17.64        from wf cls_C False obtain sup where "class G (super c) = Some sup"
   17.65  	by (blast dest: wf_prog_cdecl wf_cdecl_supD is_acc_class_is_class)
   17.66 -      moreover note wf False cls_C Hyp 
   17.67 -      ultimately have "G\<turnstile>super c \<preceq>\<^sub>C declclass m"  by auto
   17.68 +      moreover note wf False cls_C  
   17.69 +      ultimately have "G\<turnstile>super c \<preceq>\<^sub>C declclass m"  
   17.70 +	by (auto intro: Hyp [rule_format])
   17.71        moreover from cls_C False have  "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 super c" by (rule subcls1I)
   17.72        ultimately show ?thesis by - (rule rtrancl_into_rtrancl2)
   17.73      next
   17.74 @@ -1337,104 +1332,10 @@
   17.75    qed
   17.76  qed
   17.77  
   17.78 -(*
   17.79 -lemma declclass_widen[rule_format]: 
   17.80 - "wf_prog G 
   17.81 - \<longrightarrow> (\<forall>c m. class G C = Some c \<longrightarrow> methd G C sig = Some m 
   17.82 - \<longrightarrow> G\<turnstile>C \<preceq>\<^sub>C declclass m)" (is "?P G C")
   17.83 -apply (rule class_rec.induct)
   17.84 -apply (rule impI)+
   17.85 -apply (case_tac "C=Object")
   17.86 -apply   (force simp add: methd_Object_SomeD)
   17.87 -
   17.88 -apply   (rule allI)+
   17.89 -apply   (rule impI)
   17.90 -apply   (simp (no_asm_simp) add: methd_rec)
   17.91 -apply   (case_tac "table_of (map (\<lambda>(s, m). (s, C, m)) (methods c)) sig")
   17.92 -apply    (simp add: override_def)
   17.93 -apply    (frule (1) subcls1I)
   17.94 -apply    (drule (1) wf_prog_cdecl)
   17.95 -apply    (drule (1) wf_cdecl_supD)
   17.96 -apply    clarify
   17.97 -apply    (drule is_acc_class_is_class)
   17.98 -apply    clarify
   17.99 -apply    (blast dest: rtrancl_into_rtrancl2)
  17.100 -
  17.101 -apply    auto
  17.102 -done
  17.103 -*)
  17.104 -
  17.105 -(*
  17.106 -lemma accessible_public_inheritance_lemma1:
  17.107 -  "\<lbrakk>wf_prog G; class G C = Some c; C \<noteq> Object; accmodi m = Public;
  17.108 -    G\<turnstile>m accessible_through_inheritance_in (super c)\<rbrakk> 
  17.109 -   \<Longrightarrow> G\<turnstile>m accessible_through_inheritance_in C"
  17.110 -apply   (frule (1) subcls1I)
  17.111 -apply   (rule accessible_through_inheritance.Indirect)
  17.112 -apply     (blast)
  17.113 -apply     (erule accessible_through_inheritance_subclsD)
  17.114 -apply     (blast dest: wf_prog_acc_superD is_acc_classD)
  17.115 -apply     assumption
  17.116 -apply     (force dest: wf_prog_acc_superD is_acc_classD
  17.117 -                 simp add: accessible_for_inheritance_in_def)
  17.118 -done
  17.119 -
  17.120 -lemma accessible_public_inheritance_lemma[rule_format]:
  17.121 -  "\<lbrakk>wf_prog G;C \<noteq> Object; class G C = Some c; 
  17.122 -    accmodi m = Public
  17.123 -   \<rbrakk> \<Longrightarrow> methd G (super c) sig = Some m 
  17.124 -        \<longrightarrow> G\<turnstile>m accessible_through_inheritance_in C" 
  17.125 -apply (frule (2) wf_prog_acc_superD [THEN is_acc_classD])
  17.126 -apply (erule conjE)
  17.127 -apply (simp only: not_None_eq)
  17.128 -apply (erule exE)
  17.129 -apply (case_tac "(super c) = Object")
  17.130 -apply   (rule impI)
  17.131 -apply   (rule accessible_through_inheritance.Direct)
  17.132 -apply     force
  17.133 -apply     (force simp add: accessible_for_inheritance_in_def)
  17.134 -
  17.135 -apply   (frule wf_ws_prog) 
  17.136 -apply   (simp add: methd_rec)
  17.137 -apply   (case_tac "table_of (map (\<lambda>(s, m). (s, super c, m)) (methods y)) sig")
  17.138 -apply     simp
  17.139 -apply     (clarify)
  17.140 -apply     (rule_tac D="super c" in accessible_through_inheritance.Indirect)
  17.141 -apply       (blast dest: subcls1I)
  17.142 -apply       (blast)
  17.143 -apply       simp
  17.144 -apply       assumption
  17.145 -apply       (simp add: accessible_for_inheritance_in_def)
  17.146 -
  17.147 -apply     clarsimp
  17.148 -apply     (rule accessible_through_inheritance.Direct)
  17.149 -apply     (auto dest: subcls1I simp add: accessible_for_inheritance_in_def)
  17.150 -done
  17.151 -
  17.152 -lemma accessible_public_inheritance:
  17.153 -  "\<lbrakk>wf_prog G; class G D = Some d; G\<turnstile>C \<prec>\<^sub>C D; methd G D sig = Some m; 
  17.154 -    accmodi m = Public\<rbrakk> 
  17.155 -   \<Longrightarrow> G \<turnstile> m accessible_through_inheritance_in C"
  17.156 -apply (erule converse_trancl_induct)
  17.157 -apply  (blast dest: subcls1D intro: accessible_public_inheritance_lemma)
  17.158 -
  17.159 -apply  (frule subcls1D)
  17.160 -apply  clarify
  17.161 -apply  (frule  (2) wf_prog_acc_superD [THEN is_acc_classD])
  17.162 -apply  clarify
  17.163 -apply  (rule_tac D="super c" in accessible_through_inheritance.Indirect)
  17.164 -apply   (auto intro:trancl_into_trancl2 
  17.165 -                    accessible_through_inheritance_subclsD
  17.166 -              simp add: accessible_for_inheritance_in_def)
  17.167 -done
  17.168 -*)
  17.169 -
  17.170 -
  17.171  lemma declclass_methd_Object: 
  17.172   "\<lbrakk>wf_prog G; methd G Object sig = Some m\<rbrakk> \<Longrightarrow> declclass m = Object"
  17.173  by auto
  17.174  
  17.175 -
  17.176  lemma methd_declaredD: 
  17.177   "\<lbrakk>wf_prog G; is_class G C;methd G C sig = Some m\<rbrakk> 
  17.178    \<Longrightarrow> G\<turnstile>(mdecl (sig,mthd m)) declared_in (declclass m)"
  17.179 @@ -1471,7 +1372,6 @@
  17.180    qed
  17.181  qed
  17.182  
  17.183 -
  17.184  lemma methd_rec_Some_cases [consumes 4, case_names NewMethod InheritedMethod]:
  17.185  (assumes methd_C: "methd G C sig = Some m" and
  17.186                      ws: "ws_prog G" and
  17.187 @@ -1757,9 +1657,8 @@
  17.188   ) "P"
  17.189  proof -
  17.190  from subclseq_C_D is_cls_D wf old accmodi_old not_static_old 
  17.191 -     inheritance overriding
  17.192  show ?thesis
  17.193 -  by (auto dest: inheritable_instance_methd)
  17.194 +  by (auto dest: inheritable_instance_methd intro: inheritance overriding)
  17.195  qed
  17.196  
  17.197  lemma inheritable_instance_methd_props: 
  17.198 @@ -1978,12 +1877,6 @@
  17.199  apply auto 
  17.200  done
  17.201  
  17.202 -
  17.203 -declare split_paired_All [simp] split_paired_Ex [simp]
  17.204 -ML_setup {*
  17.205 -claset_ref()  := claset() addSbefore ("split_all_tac", split_all_tac);
  17.206 -simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
  17.207 -*}
  17.208  lemma mheadsD [rule_format (no_asm)]: 
  17.209  "emh \<in> mheads G S t sig \<longrightarrow> wf_prog G \<longrightarrow>
  17.210   (\<exists>C D m. t = ClassT C \<and> declrefT emh = ClassT D \<and> 
  17.211 @@ -2168,14 +2061,14 @@
  17.212  special cases of arrays and interfaces,too. If we statically expect an array or
  17.213  inteface we may lookup a field or a method in Object which isn't covered in 
  17.214  the widening relation.
  17.215 -\begin{verbatim}
  17.216 +
  17.217  statT      field         instance method       static (class) method
  17.218  ------------------------------------------------------------------------
  17.219   NullT      /                  /                   /
  17.220   Iface      /                dynC                Object
  17.221   Class    dynC               dynC                 dynC
  17.222   Array      /                Object              Object
  17.223 -\end{verbatim}
  17.224 +
  17.225  In most cases we con lookup the member in the dynamic class. But as an
  17.226  interface can't declare new static methods, nor an array can define new
  17.227  methods at all, we have to lookup methods in the base class Object.
  17.228 @@ -2189,14 +2082,13 @@
  17.229  interfaces are allowed to declare new fields but in current Bali not!).
  17.230  So there is no principal reason why we should not allow Objects to declare
  17.231  non private fields. Then we would get the following column:
  17.232 -\begin{verbatim}
  17.233 +       
  17.234   statT    field
  17.235  ----------------- 
  17.236   NullT      /  
  17.237   Iface    Object 
  17.238   Class    dynC 
  17.239   Array    Object
  17.240 -\end{verbatim}
  17.241  *}
  17.242  consts valid_lookup_cls:: "prog \<Rightarrow> ref_ty \<Rightarrow> qtname \<Rightarrow> bool \<Rightarrow> bool"
  17.243                          ("_,_ \<turnstile> _ valid'_lookup'_cls'_for _" [61,61,61,61] 60)
  17.244 @@ -2237,7 +2129,6 @@
  17.245  simpset_ref() := simpset() delloop "split_all_tac";
  17.246  claset_ref () := claset () delSWrapper "split_all_tac"
  17.247  *}
  17.248 -
  17.249  lemma dynamic_mheadsD:   
  17.250  "\<lbrakk>emh \<in> mheads G S statT sig;    
  17.251    G,statT \<turnstile> dynC valid_lookup_cls_for (is_static emh);
  17.252 @@ -2270,7 +2161,7 @@
  17.253        "dynmethd G statC dynC sig = Some dm"
  17.254        "is_static dm = is_static sm" 
  17.255        "G\<turnstile>resTy dm\<preceq>resTy sm"  
  17.256 -      by (auto dest!: ws_dynmethd accmethd_SomeD)
  17.257 +      by (force dest!: ws_dynmethd accmethd_SomeD)
  17.258      with dynlookup eq_mheads 
  17.259      show ?thesis 
  17.260        by (cases emh type: *) (auto)
  17.261 @@ -2293,7 +2184,7 @@
  17.262        "methd G dynC sig = Some dm"
  17.263        "is_static dm = is_static im" 
  17.264        "G\<turnstile>resTy (mthd dm)\<preceq>resTy (mthd im)" 
  17.265 -      by (auto dest: implmt_methd)
  17.266 +      by (force dest: implmt_methd)
  17.267      with dynlookup eq_mheads
  17.268      show ?thesis 
  17.269        by (cases emh type: *) (auto)
  17.270 @@ -2319,7 +2210,7 @@
  17.271  	 "is_static dm = is_static sm" 
  17.272  	 "G\<turnstile>resTy (mthd dm)\<preceq>resTy (mthd sm)"  
  17.273  	 by (auto dest!: ws_dynmethd accmethd_SomeD 
  17.274 -                  intro: class_Object [OF wf])
  17.275 +                  intro: class_Object [OF wf] intro: that)
  17.276         with dynlookup eq_mheads
  17.277         show ?thesis 
  17.278  	 by (cases emh type: *) (auto)
  17.279 @@ -2364,6 +2255,11 @@
  17.280        by (cases emh type: *) (auto dest: accmethd_SomeD)
  17.281    qed
  17.282  qed
  17.283 +declare split_paired_All [simp] split_paired_Ex [simp]
  17.284 +ML_setup {*
  17.285 +claset_ref()  := claset() addSbefore ("split_all_tac", split_all_tac);
  17.286 +simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
  17.287 +*}
  17.288  
  17.289  (* Tactical version *)
  17.290  (*
  17.291 @@ -2431,7 +2327,7 @@
  17.292  done
  17.293  *)
  17.294  
  17.295 -(* ### auf ws_class_induct umstellen *)
  17.296 +(* FIXME occasionally convert to ws_class_induct*) 
  17.297  lemma methd_declclass:
  17.298  "\<lbrakk>class G C = Some c; wf_prog G; methd G C sig = Some m\<rbrakk> 
  17.299   \<Longrightarrow> methd G (declclass m) sig = Some m"
  17.300 @@ -2465,8 +2361,8 @@
  17.301  	moreover
  17.302  	from wf cls_C False obtain sup where "class G (super c) = Some sup"
  17.303  	  by (blast dest: wf_prog_cdecl wf_cdecl_supD is_acc_class_is_class)
  17.304 -	moreover note wf False cls_C hyp
  17.305 -	ultimately show ?thesis by auto
  17.306 +	moreover note wf False cls_C 
  17.307 +	ultimately show ?thesis by (auto intro: hyp [rule_format])
  17.308        next
  17.309  	case Some
  17.310  	from this methd_C m show ?thesis by auto 
  17.311 @@ -2504,12 +2400,12 @@
  17.312                   dest: methd_Object_SomeD)
  17.313  qed   
  17.314    
  17.315 +
  17.316  declare split_paired_All [simp del] split_paired_Ex [simp del]
  17.317  ML_setup {*
  17.318  simpset_ref() := simpset() delloop "split_all_tac";
  17.319  claset_ref () := claset () delSWrapper "split_all_tac"
  17.320  *}
  17.321 -
  17.322  lemma wt_is_type: "E,dt\<Turnstile>v\<Colon>T \<Longrightarrow>  wf_prog (prg E) \<longrightarrow> 
  17.323    dt=empty_dt \<longrightarrow> (case T of 
  17.324                       Inl T \<Rightarrow> is_type (prg E) T 
  17.325 @@ -2598,7 +2494,7 @@
  17.326  by (erule mheads_cases)
  17.327     (auto dest: accmethd_SomeD accessible_from_commonD accimethdsD)
  17.328  
  17.329 -lemma static_to_dynamic_accessible_from:
  17.330 +lemma static_to_dynamic_accessible_from_aux:
  17.331  "\<lbrakk>G\<turnstile>m of C accessible_from accC;wf_prog G\<rbrakk> 
  17.332   \<Longrightarrow> G\<turnstile>m in C dyn_accessible_from accC"
  17.333  proof (induct rule: accessible_fromR.induct)
  17.334 @@ -2615,22 +2511,36 @@
  17.335    from stat_acc subclseq 
  17.336    show ?thesis (is "?Dyn_accessible m")
  17.337    proof (induct rule: accessible_fromR.induct)
  17.338 -    case (immediate statC m)
  17.339 +    case (Immediate statC m)
  17.340      then show "?Dyn_accessible m"
  17.341 -      by (blast intro: dyn_accessible_fromR.immediate
  17.342 +      by (blast intro: dyn_accessible_fromR.Immediate
  17.343                         member_inI
  17.344                         permits_acc_inheritance)
  17.345    next
  17.346 -    case (overriding _ _ m)
  17.347 +    case (Overriding _ _ m)
  17.348      with wf show "?Dyn_accessible m"
  17.349 -      by (blast intro: dyn_accessible_fromR.overriding
  17.350 +      by (blast intro: dyn_accessible_fromR.Overriding
  17.351                         member_inI
  17.352                         static_to_dynamic_overriding  
  17.353                         rtrancl_trancl_trancl 
  17.354 -                       static_to_dynamic_accessible_from)
  17.355 +                       static_to_dynamic_accessible_from_aux)
  17.356    qed
  17.357  qed
  17.358  
  17.359 +lemma static_to_dynamic_accessible_from_static:
  17.360 + (assumes stat_acc: "G\<turnstile>m of statC accessible_from accC" and
  17.361 +            static: "is_static m" and
  17.362 +                wf: "wf_prog G"
  17.363 + ) "G\<turnstile>m in (declclass m) dyn_accessible_from accC"
  17.364 +proof -
  17.365 +  from stat_acc wf 
  17.366 +  have "G\<turnstile>m in statC dyn_accessible_from accC"
  17.367 +    by (auto intro: static_to_dynamic_accessible_from)
  17.368 +  from this static
  17.369 +  show ?thesis
  17.370 +    by (rule dyn_accessible_from_static_declC)
  17.371 +qed
  17.372 +
  17.373  lemma dynmethd_member_in:
  17.374   (assumes    m: "dynmethd G statC dynC sig = Some m" and
  17.375     iscls_statC: "is_class G statC" and
  17.376 @@ -2723,7 +2633,7 @@
  17.377      moreover
  17.378      note override eq_dynM_newM
  17.379      ultimately show ?thesis
  17.380 -      by (cases dynM,cases statM) (auto intro: dyn_accessible_fromR.overriding)
  17.381 +      by (cases dynM,cases statM) (auto intro: dyn_accessible_fromR.Overriding)
  17.382    qed
  17.383  qed
  17.384  
  17.385 @@ -2749,7 +2659,7 @@
  17.386      by (blast dest: implmt_methd)
  17.387    with iscls_dynC wf
  17.388    have "G\<turnstile>Methd sig dynM in dynC dyn_accessible_from accC"
  17.389 -    by (auto intro!: dyn_accessible_fromR.immediate 
  17.390 +    by (auto intro!: dyn_accessible_fromR.Immediate 
  17.391                intro: methd_member_of member_of_to_member_in
  17.392                       simp add: permits_acc_def)
  17.393    with dynM    
  17.394 @@ -2972,14 +2882,14 @@
  17.395              \<Longrightarrow> pid accC = pid (declclass m)"
  17.396      (is "?Pack m \<Longrightarrow> ?P m")
  17.397    proof (induct rule: dyn_accessible_fromR.induct)
  17.398 -    case (immediate C m)
  17.399 +    case (Immediate C m)
  17.400      assume "G\<turnstile>m member_in C"
  17.401             "G \<turnstile> m in C permits_acc_to accC"
  17.402             "accmodi m = Package"      
  17.403      then show "?P m"
  17.404        by (auto simp add: permits_acc_def)
  17.405    next
  17.406 -    case (overriding declC C new newm old Sup)
  17.407 +    case (Overriding declC C new newm old Sup)
  17.408      assume member_new: "G \<turnstile> new member_in C" and
  17.409                    new: "new = (declC, mdecl newm)" and
  17.410               override: "G \<turnstile> (declC, newm) overrides old" and
  17.411 @@ -3001,4 +2911,64 @@
  17.412    qed
  17.413  qed
  17.414  
  17.415 +
  17.416 +text {* @{text dyn_accessible_instance_field_Protected} only works for fields
  17.417 +since methods can break the package bounds due to overriding
  17.418 +*}
  17.419 +lemma dyn_accessible_instance_field_Protected:
  17.420 + (assumes dyn_acc: "G \<turnstile> f in C dyn_accessible_from accC" and
  17.421 +             prot: "accmodi f = Protected" and
  17.422 +            field: "is_field f" and
  17.423 +   instance_field: "\<not> is_static f" and
  17.424 +          outside: "pid (declclass f) \<noteq> pid accC"
  17.425 + ) "G\<turnstile> C \<preceq>\<^sub>C accC"
  17.426 +proof -
  17.427 +  from dyn_acc prot field instance_field outside
  17.428 +  show ?thesis
  17.429 +  proof (induct)
  17.430 +    case (Immediate C f)
  17.431 +    have "G \<turnstile> f in C permits_acc_to accC" .
  17.432 +    moreover 
  17.433 +    assume "accmodi f = Protected" and  "is_field f" and "\<not> is_static f" and
  17.434 +           "pid (declclass f) \<noteq> pid accC"
  17.435 +    ultimately 
  17.436 +    show "G\<turnstile> C \<preceq>\<^sub>C accC"
  17.437 +      by (auto simp add: permits_acc_def)
  17.438 +  next
  17.439 +    case Overriding
  17.440 +    then show ?case by (simp add: is_field_def)
  17.441 +  qed
  17.442 +qed
  17.443 +   
  17.444 +lemma dyn_accessible_static_field_Protected:
  17.445 + (assumes dyn_acc: "G \<turnstile> f in C dyn_accessible_from accC" and
  17.446 +             prot: "accmodi f = Protected" and
  17.447 +            field: "is_field f" and
  17.448 +     static_field: "is_static f" and
  17.449 +          outside: "pid (declclass f) \<noteq> pid accC"
  17.450 + ) "G\<turnstile> accC \<preceq>\<^sub>C declclass f  \<and> G\<turnstile>C \<preceq>\<^sub>C declclass f"
  17.451 +proof -
  17.452 +  from dyn_acc prot field static_field outside
  17.453 +  show ?thesis
  17.454 +  proof (induct)
  17.455 +    case (Immediate C f)
  17.456 +    assume "accmodi f = Protected" and  "is_field f" and "is_static f" and
  17.457 +           "pid (declclass f) \<noteq> pid accC"
  17.458 +    moreover 
  17.459 +    have "G \<turnstile> f in C permits_acc_to accC" .
  17.460 +    ultimately
  17.461 +    have "G\<turnstile> accC \<preceq>\<^sub>C declclass f"
  17.462 +      by (auto simp add: permits_acc_def)
  17.463 +    moreover
  17.464 +    have "G \<turnstile> f member_in C" .
  17.465 +    then have "G\<turnstile>C \<preceq>\<^sub>C declclass f"
  17.466 +      by (rule member_in_class_relation)
  17.467 +    ultimately show ?case
  17.468 +      by blast
  17.469 +  next
  17.470 +    case Overriding
  17.471 +    then show ?case by (simp add: is_field_def)
  17.472 +  qed
  17.473 +qed
  17.474 +
  17.475  end
  17.476 \ No newline at end of file
    18.1 --- a/src/HOL/Bali/WellType.thy	Thu Feb 21 20:11:32 2002 +0100
    18.2 +++ b/src/HOL/Bali/WellType.thy	Fri Feb 22 11:26:44 2002 +0100
    18.3 @@ -153,28 +153,30 @@
    18.4   "empty_dt \<equiv> \<lambda>a. None"
    18.5  
    18.6    invmode :: "('a::type)member_scheme \<Rightarrow> expr \<Rightarrow> inv_mode"
    18.7 -"invmode m e \<equiv> if static m then Static else if e=Super then SuperM else IntVir"
    18.8 +"invmode m e \<equiv> if is_static m 
    18.9 +                  then Static 
   18.10 +                  else if e=Super then SuperM else IntVir"
   18.11  
   18.12  lemma invmode_nonstatic [simp]: 
   18.13    "invmode \<lparr>access=a,static=False,\<dots>=x\<rparr> (Acc (LVar e)) = IntVir"
   18.14  apply (unfold invmode_def)
   18.15 +apply (simp (no_asm) add: member_is_static_simp)
   18.16 +done
   18.17 +
   18.18 +
   18.19 +lemma invmode_Static_eq [simp]: "(invmode m e = Static) = is_static m"
   18.20 +apply (unfold invmode_def)
   18.21  apply (simp (no_asm))
   18.22  done
   18.23  
   18.24  
   18.25 -lemma invmode_Static_eq [simp]: "(invmode m e = Static) = static m"
   18.26 -apply (unfold invmode_def)
   18.27 -apply (simp (no_asm))
   18.28 -done
   18.29 -
   18.30 -
   18.31 -lemma invmode_IntVir_eq: "(invmode m e = IntVir) = (\<not>(static m) \<and> e\<noteq>Super)"
   18.32 +lemma invmode_IntVir_eq: "(invmode m e = IntVir) = (\<not>(is_static m) \<and> e\<noteq>Super)"
   18.33  apply (unfold invmode_def)
   18.34  apply (simp (no_asm))
   18.35  done
   18.36  
   18.37  lemma Null_staticD: 
   18.38 -  "a'=Null \<longrightarrow> (static m) \<Longrightarrow> invmode m e = IntVir \<longrightarrow> a' \<noteq> Null"
   18.39 +  "a'=Null \<longrightarrow> (is_static m) \<Longrightarrow> invmode m e = IntVir \<longrightarrow> a' \<noteq> Null"
   18.40  apply (clarsimp simp add: invmode_IntVir_eq)
   18.41  done
   18.42  
   18.43 @@ -337,7 +339,7 @@
   18.44  	  max_spec (prg E) (cls E) statT \<lparr>name=mn,parTs=pTs\<rparr> 
   18.45              = {((statDeclT,m),pTs')}
   18.46           \<rbrakk> \<Longrightarrow>
   18.47 -		   E,dt\<Turnstile>{statT,invmode m e}e\<cdot>mn({pTs'}ps)\<Colon>-(resTy m)"
   18.48 +		   E,dt\<Turnstile>{cls E,statT,invmode m e}e\<cdot>mn({pTs'}ps)\<Colon>-(resTy m)"
   18.49  
   18.50    Methd: "\<lbrakk>is_class (prg E) C;
   18.51  	  methd (prg E) C sig = Some m;
   18.52 @@ -367,8 +369,8 @@
   18.53  					 E,dt\<Turnstile>LVar vn\<Colon>=T"
   18.54    (* cf. 15.10.1 *)
   18.55    FVar:	"\<lbrakk>E,dt\<Turnstile>e\<Colon>-Class C; 
   18.56 -	  accfield (prg E) (cls E) C fn = Some (fd,f)\<rbrakk> \<Longrightarrow>
   18.57 -			                 E,dt\<Turnstile>{fd,static f}e..fn\<Colon>=(type f)"
   18.58 +	  accfield (prg E) (cls E) C fn = Some (statDeclC,f)\<rbrakk> \<Longrightarrow>
   18.59 +			 E,dt\<Turnstile>{cls E,statDeclC,is_static f}e..fn\<Colon>=(type f)"
   18.60    (* cf. 15.12 *)
   18.61    AVar:	"\<lbrakk>E,dt\<Turnstile>e\<Colon>-T.[]; 
   18.62  	  E,dt\<Turnstile>i\<Colon>-PrimT Integer\<rbrakk> \<Longrightarrow>
   18.63 @@ -395,7 +397,7 @@
   18.64  inductive_cases wt_stmt_cases: "E,dt\<Turnstile>c\<Colon>\<surd>"
   18.65  inductive_cases wt_elim_cases:
   18.66  	"E,dt\<Turnstile>In2  (LVar vn)               \<Colon>T"
   18.67 -	"E,dt\<Turnstile>In2  ({fd,s}e..fn)           \<Colon>T"
   18.68 +	"E,dt\<Turnstile>In2  ({accC,statDeclC,s}e..fn)\<Colon>T"
   18.69  	"E,dt\<Turnstile>In2  (e.[i])                 \<Colon>T"
   18.70  	"E,dt\<Turnstile>In1l (NewC C)                \<Colon>T"
   18.71  	"E,dt\<Turnstile>In1l (New T'[i])             \<Colon>T"
   18.72 @@ -406,7 +408,7 @@
   18.73  	"E,dt\<Turnstile>In1l (Acc va)                \<Colon>T"
   18.74  	"E,dt\<Turnstile>In1l (Ass va v)              \<Colon>T"
   18.75  	"E,dt\<Turnstile>In1l (e0 ? e1 : e2)          \<Colon>T"
   18.76 -	"E,dt\<Turnstile>In1l ({statT,mode}e\<cdot>mn({pT'}p))\<Colon>T"
   18.77 +	"E,dt\<Turnstile>In1l ({accC,statT,mode}e\<cdot>mn({pT'}p))\<Colon>T"
   18.78  	"E,dt\<Turnstile>In1l (Methd C sig)           \<Colon>T"
   18.79  	"E,dt\<Turnstile>In1l (Body D blk)            \<Colon>T"
   18.80  	"E,dt\<Turnstile>In3  ([])                    \<Colon>Ts"
   18.81 @@ -463,15 +465,15 @@
   18.82   \<Longrightarrow> E,dt\<Turnstile>Super\<Colon>-Class D"
   18.83  by (auto elim: wt.Super)
   18.84   
   18.85 +
   18.86  lemma wt_Call: 
   18.87  "\<lbrakk>E,dt\<Turnstile>e\<Colon>-RefT statT; E,dt\<Turnstile>ps\<Colon>\<doteq>pTs;  
   18.88    max_spec (prg E) (cls E) statT \<lparr>name=mn,parTs=pTs\<rparr> 
   18.89 -    = {((statDeclC,m),pTs')};rT=(resTy m);   
   18.90 - mode = invmode m e\<rbrakk> \<Longrightarrow> E,dt\<Turnstile>{statT,mode}e\<cdot>mn({pTs'}ps)\<Colon>-rT"
   18.91 +    = {((statDeclC,m),pTs')};rT=(resTy m);accC=cls E;
   18.92 + mode = invmode m e\<rbrakk> \<Longrightarrow> E,dt\<Turnstile>{accC,statT,mode}e\<cdot>mn({pTs'}ps)\<Colon>-rT"
   18.93  by (auto elim: wt.Call)
   18.94  
   18.95  
   18.96 -
   18.97  lemma invocationTypeExpr_noClassD: 
   18.98  "\<lbrakk> E\<turnstile>e\<Colon>-RefT statT\<rbrakk>
   18.99   \<Longrightarrow> (\<forall> statC. statT \<noteq> ClassT statC) \<longrightarrow> invmode m e \<noteq> SuperM"
  18.100 @@ -493,11 +495,12 @@
  18.101  \<Longrightarrow> E,dt\<Turnstile>Super\<Colon>-Class D"
  18.102  by (auto elim: wt.Super)
  18.103  
  18.104 +lemma wt_FVar:	
  18.105 +"\<lbrakk>E,dt\<Turnstile>e\<Colon>-Class C; accfield (prg E) (cls E) C fn = Some (statDeclC,f);
  18.106 +  sf=is_static f; fT=(type f); accC=cls E\<rbrakk> 
  18.107 +\<Longrightarrow> E,dt\<Turnstile>{accC,statDeclC,sf}e..fn\<Colon>=fT"
  18.108 +by (auto dest: wt.FVar)
  18.109  
  18.110 -lemma wt_FVar:	
  18.111 -"\<lbrakk>E,dt\<Turnstile>e\<Colon>-Class C; accfield (prg E) (cls E) C fn = Some (fd,f);
  18.112 -  sf=static f; fT=(type f)\<rbrakk> \<Longrightarrow> E,dt\<Turnstile>{fd,sf}e..fn\<Colon>=fT"
  18.113 -by (auto elim: wt.FVar)
  18.114  
  18.115  lemma wt_init [iff]: "E,dt\<Turnstile>Init C\<Colon>\<surd> = is_class (prg E) C"
  18.116  by (auto elim: wt_elim_cases intro: "wt.Init")