"Definite Assignment Analysis" included, with proof of correctness. Large adjustments of type safety proof and soundness proof of the axiomatic semantics were necessary. Completeness proof of the loop rule of the axiomatic semantic was altered. So the additional polymorphic variants of some rules could be removed.
authorschirmer
Thu Oct 31 18:27:10 2002 +0100 (2002-10-31)
changeset 13688a0b16d42d489
parent 13687 22dce9134953
child 13689 3d4ad560b2ff
"Definite Assignment Analysis" included, with proof of correctness. Large adjustments of type safety proof and soundness proof of the axiomatic semantics were necessary. Completeness proof of the loop rule of the axiomatic semantic was altered. So the additional polymorphic variants of some rules could be removed.
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/DefiniteAssignment.thy
src/HOL/Bali/DefiniteAssignmentCorrect.thy
src/HOL/Bali/Eval.thy
src/HOL/Bali/Evaln.thy
src/HOL/Bali/Example.thy
src/HOL/Bali/Name.thy
src/HOL/Bali/State.thy
src/HOL/Bali/Table.thy
src/HOL/Bali/Term.thy
src/HOL/Bali/Trans.thy
src/HOL/Bali/Type.thy
src/HOL/Bali/TypeRel.thy
src/HOL/Bali/TypeSafe.thy
src/HOL/Bali/Value.thy
src/HOL/Bali/WellForm.thy
src/HOL/Bali/WellType.thy
src/HOL/Bali/document/root.tex
     1.1 --- a/src/HOL/Bali/AxCompl.thy	Wed Oct 30 12:44:18 2002 +0100
     1.2 +++ b/src/HOL/Bali/AxCompl.thy	Thu Oct 31 18:27:10 2002 +0100
     1.3 @@ -1,6 +1,6 @@
     1.4  (*  Title:      HOL/Bali/AxCompl.thy
     1.5      ID:         $Id$
     1.6 -    Author:     David von Oheimb
     1.7 +    Author:     David von Oheimb and Norbert Schirmer
     1.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
     1.9  *)
    1.10  
    1.11 @@ -19,6 +19,7 @@
    1.12  
    1.13  
    1.14  
    1.15 +           
    1.16  section "set of not yet initialzed classes"
    1.17  
    1.18  constdefs
    1.19 @@ -79,8 +80,8 @@
    1.20  apply fast
    1.21  done
    1.22  
    1.23 -lemma card_Suc_lemma: "\<lbrakk>card (insert a A) \<le> Suc n; a\<notin>A; finite A\<rbrakk> \<Longrightarrow> card A \<le> n"
    1.24 -apply (rotate_tac 1)
    1.25 +lemma card_Suc_lemma: 
    1.26 +  "\<lbrakk>card (insert a A) \<le> Suc n; a\<notin>A; finite A\<rbrakk> \<Longrightarrow> card A \<le> n"
    1.27  apply clarsimp
    1.28  done
    1.29  
    1.30 @@ -96,7 +97,8 @@
    1.31                simp add: nyinitcls_def inited_def split add: split_if_asm)
    1.32  done
    1.33  
    1.34 -ML {* bind_thm("inited_gext'",permute_prems 0 1 (thm "inited_gext")) *}
    1.35 +lemma inited_gext': "\<lbrakk>s\<le>|s';inited C (globs s)\<rbrakk> \<Longrightarrow> inited C (globs s')"
    1.36 +by (rule inited_gext)
    1.37  
    1.38  lemma nyinitcls_gext: "snd s\<le>|snd s' \<Longrightarrow> nyinitcls G s' \<subseteq> nyinitcls G s"
    1.39  apply (unfold nyinitcls_def)
    1.40 @@ -124,7 +126,9 @@
    1.41  apply auto
    1.42  done
    1.43  
    1.44 -lemma All_init_leD: "\<forall>n::nat. G,A\<turnstile>{P \<and>. G\<turnstile>init\<le>n} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
    1.45 +lemma All_init_leD: 
    1.46 + "\<forall>n::nat. G,(A::'a triple set)\<turnstile>{P \<and>. G\<turnstile>init\<le>n} t\<succ> {Q::'a assn} 
    1.47 +  \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
    1.48  apply (drule spec)
    1.49  apply (erule conseq1)
    1.50  apply clarsimp
    1.51 @@ -158,7 +162,6 @@
    1.52    "{=:n} t\<succ> {G\<rightarrow>} \<equiv> {\<doteq> \<and>. G\<turnstile>init\<le>n} t\<succ> {G\<rightarrow>}"
    1.53  
    1.54  (* unused *)
    1.55 -
    1.56  lemma MGF_valid: "wf_prog G \<Longrightarrow> G,{}\<Turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
    1.57  apply (unfold MGF_def)
    1.58  apply (simp add:  ax_valids_def triple_valid_def2)
    1.59 @@ -178,7 +181,8 @@
    1.60  apply fast
    1.61  done
    1.62  
    1.63 -lemma MGF_MGFn_iff: "G,A\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} = (\<forall>n. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>})"
    1.64 +lemma MGF_MGFn_iff: 
    1.65 +"G,(A::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} = (\<forall>n. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>})"
    1.66  apply (simp (no_asm_use) add: MGFn_def2 MGF_def)
    1.67  apply safe
    1.68  apply  (erule_tac [2] All_init_leD)
    1.69 @@ -187,7 +191,7 @@
    1.70  done
    1.71  
    1.72  lemma MGFnD: 
    1.73 -"G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>} \<Longrightarrow>  
    1.74 +"G,(A::state triple set)\<turnstile>{=:n} t\<succ> {G\<rightarrow>} \<Longrightarrow>  
    1.75   G,A\<turnstile>{(\<lambda>Y' s' s. s' = s           \<and> P s) \<and>. G\<turnstile>init\<le>n}  
    1.76   t\<succ>  {(\<lambda>Y' s' s. G\<turnstile>s\<midarrow>t\<succ>\<rightarrow>(Y',s') \<and> P s) \<and>. G\<turnstile>init\<le>n}"
    1.77  apply (unfold init_le_def)
    1.78 @@ -198,6 +202,10 @@
    1.79  done
    1.80  lemmas MGFnD' = MGFnD [of _ _ _ _ "\<lambda>x. True"] 
    1.81  
    1.82 +text {* To derive the most general formula, we can always assume a normal
    1.83 +state in the precondition, since abrupt cases can be handled uniformally by
    1.84 +the abrupt rule.
    1.85 +*}
    1.86  lemma MGFNormalI: "G,A\<turnstile>{Normal \<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow>  
    1.87    G,(A::state triple set)\<turnstile>{\<doteq>::state assn} t\<succ> {G\<rightarrow>}"
    1.88  apply (unfold MGF_def)
    1.89 @@ -208,12 +216,15 @@
    1.90  apply (clarsimp simp add: Let_def)
    1.91  done
    1.92  
    1.93 -lemma MGFNormalD: "G,A\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow> G,A\<turnstile>{Normal \<doteq>} t\<succ> {G\<rightarrow>}"
    1.94 +lemma MGFNormalD: 
    1.95 +"G,(A::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow> G,A\<turnstile>{Normal \<doteq>} t\<succ> {G\<rightarrow>}"
    1.96  apply (unfold MGF_def)
    1.97  apply (erule conseq1)
    1.98  apply clarsimp
    1.99  done
   1.100  
   1.101 +text {* Additionally to @{text MGFNormalI}, we also expand the definition of 
   1.102 +the most general formula here *} 
   1.103  lemma MGFn_NormalI: 
   1.104  "G,(A::state triple set)\<turnstile>{Normal((\<lambda>Y' s' s. s'=s \<and> normal s) \<and>. G\<turnstile>init\<le>n)}t\<succ> 
   1.105   {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')} \<Longrightarrow> G,A\<turnstile>{=:n}t\<succ>{G\<rightarrow>}"
   1.106 @@ -225,6 +236,9 @@
   1.107  apply (clarsimp simp add: Let_def)
   1.108  done
   1.109  
   1.110 +text {* To derive the most general formula, we can restrict ourselves to 
   1.111 +welltyped terms, since all others can be uniformally handled by the hazard
   1.112 +rule. *} 
   1.113  lemma MGFn_free_wt: 
   1.114    "(\<exists>T L C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) 
   1.115      \<longrightarrow> G,(A::state triple set)\<turnstile>{=:n} t\<succ> {G\<rightarrow>} 
   1.116 @@ -234,8 +248,12 @@
   1.117  apply (auto elim: conseq12 simp add: MGFn_def MGF_def)
   1.118  done
   1.119  
   1.120 +text {* To derive the most general formula, we can restrict ourselves to 
   1.121 +welltyped terms and assume that the state in the precondition conforms to the
   1.122 +environment. All type violations can be uniformally handled by the hazard
   1.123 +rule. *} 
   1.124  lemma MGFn_free_wt_NormalConformI: 
   1.125 -"(\<forall> T L C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T 
   1.126 +"(\<forall> T L C . \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T 
   1.127    \<longrightarrow> G,(A::state triple set)
   1.128        \<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.129        t\<succ> 
   1.130 @@ -247,389 +265,1129 @@
   1.131  apply (intro strip)
   1.132  apply (simp only: type_ok_def peek_and_def)
   1.133  apply (erule conjE)+
   1.134 -apply (erule exE,erule exE, erule exE,erule conjE,drule (1) mp)
   1.135 +apply (erule exE,erule exE, erule exE, erule exE,erule conjE,drule (1) mp,
   1.136 +       erule conjE)
   1.137  apply (drule spec,drule spec, drule spec, drule (1) mp)
   1.138  apply (erule conseq12)
   1.139  apply blast
   1.140  done
   1.141  
   1.142 +text {* To derive the most general formula, we can restrict ourselves to 
   1.143 +welltyped terms and assume that the state in the precondition conforms to the
   1.144 +environment and that the term is definetly assigned with respect to this state.
   1.145 +All type violations can be uniformally handled by the hazard rule. *} 
   1.146 +lemma MGFn_free_wt_da_NormalConformI: 
   1.147 +"(\<forall> T L C B. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T
   1.148 +  \<longrightarrow> G,(A::state triple set)
   1.149 +      \<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.150 +        \<and>. (\<lambda> s. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>B)}
   1.151 +      t\<succ> 
   1.152 +      {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')}) 
   1.153 + \<Longrightarrow> G,A\<turnstile>{=:n}t\<succ>{G\<rightarrow>}"
   1.154 +apply (rule MGFn_NormalI)
   1.155 +apply (rule ax_no_hazard)
   1.156 +apply (rule ax_escape)
   1.157 +apply (intro strip)
   1.158 +apply (simp only: type_ok_def peek_and_def)
   1.159 +apply (erule conjE)+
   1.160 +apply (erule exE,erule exE, erule exE, erule exE,erule conjE,drule (1) mp,
   1.161 +       erule conjE)
   1.162 +apply (drule spec,drule spec, drule spec,drule spec, drule (1) mp)
   1.163 +apply (erule conseq12)
   1.164 +apply blast
   1.165 +done
   1.166  
   1.167  section "main lemmas"
   1.168  
   1.169 -declare fun_upd_apply [simp del]
   1.170 -declare splitI2 [rule del] (*prevents ugly renaming of state variables*)
   1.171 -
   1.172 -ML_setup {* 
   1.173 -Delsimprocs [eval_expr_proc, eval_var_proc, eval_exprs_proc, eval_stmt_proc]
   1.174 -*} (*prevents modifying rhs of MGF*)
   1.175 -ML {*
   1.176 -val eval_css = (claset() delrules [thm "eval.Abrupt"] addSIs (thms "eval.intros") 
   1.177 -                delrules[thm "eval.Expr", thm "eval.Init", thm "eval.Try"] 
   1.178 -                addIs   [thm "eval.Expr", thm "eval.Init"]
   1.179 -                addSEs[thm "eval.Try"] delrules[equalityCE],
   1.180 -                simpset() addsimps [split_paired_all,Let_def]
   1.181 - addsimprocs [eval_expr_proc,eval_var_proc,eval_exprs_proc,eval_stmt_proc]);
   1.182 -val eval_Force_tac = force_tac eval_css;
   1.183 -
   1.184 -val wt_prepare_tac = EVERY'[
   1.185 -    rtac (thm "MGFn_free_wt"),
   1.186 -    clarsimp_tac (claset() addSEs (thms "wt_elim_cases"), simpset())]
   1.187 -val compl_prepare_tac = EVERY'[rtac (thm "MGFn_NormalI"), Simp_tac]
   1.188 -val wt_conf_prepare_tac = EVERY'[
   1.189 -    rtac (thm "MGFn_free_wt_NormalConformI"),
   1.190 -    clarsimp_tac (claset() addSEs (thms "wt_elim_cases"), simpset())]
   1.191 -val forw_hyp_tac = EVERY'[etac (thm "MGFnD'" RS thm "conseq12"), Clarsimp_tac]
   1.192 -val forw_hyp_eval_Force_tac = 
   1.193 -         EVERY'[TRY o rtac allI, forw_hyp_tac, eval_Force_tac]
   1.194 -*}
   1.195 -
   1.196 -lemma MGFn_Init: "\<forall>m. Suc m\<le>n \<longrightarrow> (\<forall>t. G,A\<turnstile>{=:m} t\<succ> {G\<rightarrow>}) \<Longrightarrow>  
   1.197 -  G,(A::state triple set)\<turnstile>{=:n} In1r (Init C)\<succ> {G\<rightarrow>}"
   1.198 -apply (tactic "wt_prepare_tac 1")
   1.199 -(* requires is_class G C two times for nyinitcls *)
   1.200 -apply (tactic "compl_prepare_tac 1")
   1.201 -apply (rule_tac C = "initd C" in ax_cases)
   1.202 -apply  (rule ax_derivs.Done [THEN conseq1])
   1.203 -apply  (clarsimp intro!: init_done)
   1.204 -apply (rule_tac y = n in nat.exhaust, clarsimp)
   1.205 -apply  (rule ax_impossible [THEN conseq1])
   1.206 -apply  (force dest!: nyinitcls_emptyD)
   1.207 -apply clarsimp
   1.208 -apply (drule_tac x = "nat" in spec)
   1.209 -apply clarsimp
   1.210 -apply (rule_tac Q = " (\<lambda>Y s' (x,s) . G\<turnstile> (x,init_class_obj G C s) \<midarrow> (if C=Object then Skip else Init (super (the (class G C))))\<rightarrow> s' \<and> x=None \<and> \<not>inited C (globs s)) \<and>. G\<turnstile>init\<le>nat" in ax_derivs.Init)
   1.211 -apply   simp
   1.212 -apply  (rule_tac P' = "Normal ((\<lambda>Y s' s. s' = supd (init_class_obj G C) s \<and> normal s \<and> \<not> initd C s) \<and>. G\<turnstile>init\<le>nat) " in conseq1)
   1.213 -prefer 2
   1.214 -apply   (force elim!: nyinitcls_le_SucD)
   1.215 -apply  (simp split add: split_if, rule conjI, clarify)
   1.216 -apply   (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
   1.217 -apply  clarify
   1.218 -apply  (drule spec)
   1.219 -apply  (erule MGFnD' [THEN conseq12])
   1.220 -apply  (tactic "force_tac (claset(), simpset() addsimprocs[eval_stmt_proc]) 1")
   1.221 -apply (rule allI)
   1.222 -apply (drule spec)
   1.223 -apply (erule MGFnD' [THEN conseq12])
   1.224 -apply clarsimp
   1.225 -apply (tactic {* pair_tac "sa" 1 *})
   1.226 -apply (tactic"clarsimp_tac (claset(), simpset() addsimprocs[eval_stmt_proc]) 1")
   1.227 -apply (rule eval_Init, force+)
   1.228 -done
   1.229 +lemma MGFn_Init: 
   1.230 + assumes mgf_hyp: "\<forall>m. Suc m\<le>n \<longrightarrow> (\<forall>t. G,A\<turnstile>{=:m} t\<succ> {G\<rightarrow>})"
   1.231 + shows "G,(A::state triple set)\<turnstile>{=:n} \<langle>Init C\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
   1.232 +proof (rule MGFn_free_wt [rule_format],elim exE,rule MGFn_NormalI)
   1.233 +  fix T L accC
   1.234 +  assume "\<lparr>prg=G, cls=accC, lcl= L\<rparr>\<turnstile>\<langle>Init C\<rangle>\<^sub>s\<Colon>T"
   1.235 +  hence is_cls: "is_class G C"
   1.236 +    by cases simp
   1.237 +  show "G,A\<turnstile>{Normal ((\<lambda>Y' s' s. s' = s \<and> normal s) \<and>. G\<turnstile>init\<le>n)} 
   1.238 +            .Init C.
   1.239 +            {\<lambda>Y s' s. G\<turnstile>s \<midarrow>\<langle>Init C\<rangle>\<^sub>s\<succ>\<rightarrow> (Y, s')}"
   1.240 +       (is "G,A\<turnstile>{Normal ?P} .Init C. {?R}")
   1.241 +  proof (rule ax_cases [where ?C="initd C"])
   1.242 +    show "G,A\<turnstile>{Normal ?P  \<and>. initd C} .Init C. {?R}"
   1.243 +      by (rule ax_derivs.Done [THEN conseq1]) (fastsimp intro: init_done)
   1.244 +  next
   1.245 +    have "G,A\<turnstile>{Normal (?P  \<and>. Not \<circ> initd C)} .Init C. {?R}" 
   1.246 +    proof (cases n)
   1.247 +      case 0
   1.248 +      with is_cls
   1.249 +      show ?thesis
   1.250 +	by - (rule ax_impossible [THEN conseq1],fastsimp dest: nyinitcls_emptyD)
   1.251 +    next
   1.252 +      case (Suc m)
   1.253 +      with mgf_hyp have mgf_hyp': "\<And> t. G,A\<turnstile>{=:m} t\<succ> {G\<rightarrow>}"
   1.254 +	by simp
   1.255 +      from is_cls obtain c where c: "the (class G C) = c"
   1.256 +	by auto
   1.257 +      let ?Q= "(\<lambda>Y s' (x,s) . 
   1.258 +          G\<turnstile> (x,init_class_obj G C s) 
   1.259 +             \<midarrow> (if C=Object then Skip else Init (super (the (class G C))))\<rightarrow> s'
   1.260 +          \<and> x=None \<and> \<not>inited C (globs s)) \<and>. G\<turnstile>init\<le>m"
   1.261 +      from c
   1.262 +      show ?thesis
   1.263 +      proof (rule ax_derivs.Init [where ?Q="?Q"])
   1.264 +	let ?P' = "Normal ((\<lambda>Y s' s. s' = supd (init_class_obj G C) s 
   1.265 +                           \<and> normal s \<and> \<not> initd C s) \<and>. G\<turnstile>init\<le>m)" 
   1.266 +	show "G,A\<turnstile>{Normal (?P \<and>. Not \<circ> initd C ;. supd (init_class_obj G C))}
   1.267 +                  .(if C = Object then Skip else Init (super c)). 
   1.268 +                  {?Q}"
   1.269 +	proof (rule conseq1 [where ?P'="?P'"])
   1.270 +	  show "G,A\<turnstile>{?P'} .(if C = Object then Skip else Init (super c)). {?Q}"
   1.271 +	  proof (cases "C=Object")
   1.272 +	    case True
   1.273 +	    have "G,A\<turnstile>{?P'} .Skip. {?Q}"
   1.274 +	      by (rule ax_derivs.Skip [THEN conseq1])
   1.275 +	         (auto simp add: True intro: eval.Skip)
   1.276 +            with True show ?thesis 
   1.277 +	      by simp
   1.278 +	  next
   1.279 +	    case False
   1.280 +	    from mgf_hyp'
   1.281 +	    have "G,A\<turnstile>{?P'} .Init (super c). {?Q}"
   1.282 +	      by (rule MGFnD' [THEN conseq12]) (fastsimp simp add: False c)
   1.283 +	    with False show ?thesis
   1.284 +	      by simp
   1.285 +	  qed
   1.286 +	next
   1.287 +	  from Suc is_cls
   1.288 +	  show "Normal (?P \<and>. Not \<circ> initd C ;. supd (init_class_obj G C))
   1.289 +                \<Rightarrow> ?P'"
   1.290 +	    by (fastsimp elim: nyinitcls_le_SucD)
   1.291 +	qed
   1.292 +      next
   1.293 +	from mgf_hyp'
   1.294 +	show "\<forall>l. G,A\<turnstile>{?Q \<and>. (\<lambda>s. l = locals (snd s)) ;. set_lvars empty} 
   1.295 +                      .init c.
   1.296 +                      {set_lvars l .; ?R}"
   1.297 +	  apply (rule MGFnD' [THEN conseq12, THEN allI])
   1.298 +	  apply (clarsimp simp add: split_paired_all)
   1.299 +	  apply (rule eval.Init [OF c])
   1.300 +	  apply (insert c)
   1.301 +	  apply auto
   1.302 +	  done
   1.303 +      qed
   1.304 +    qed
   1.305 +    thus "G,A\<turnstile>{Normal ?P  \<and>. Not \<circ> initd C} .Init C. {?R}"
   1.306 +      by clarsimp
   1.307 +  qed
   1.308 +qed
   1.309  lemmas MGFn_InitD = MGFn_Init [THEN MGFnD, THEN ax_NormalD]
   1.310  
   1.311 -text {* For @{text MGFn_Call} we need the wellformedness of the program to
   1.312 -switch from the evaln-semantics to the eval-semantics *}
   1.313  lemma MGFn_Call: 
   1.314 -"\<lbrakk>\<forall>C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>};  
   1.315 -  G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In3 ps\<succ> {G\<rightarrow>};wf_prog G\<rbrakk> \<Longrightarrow>  
   1.316 -  G,A\<turnstile>{=:n} In1l ({accC,statT,mode}e\<cdot>mn({pTs'}ps))\<succ> {G\<rightarrow>}"
   1.317 -apply (tactic "wt_conf_prepare_tac 1")
   1.318 -apply (rule_tac  
   1.319 -  Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
   1.320 -        (\<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.321 -         \<and> Y = In1 a)) 
   1.322 -    \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))" and 
   1.323 - R = "\<lambda>a'. (\<lambda>Y (x2,s2) (x,s) . x = None \<and> 
   1.324 -             (\<exists>s1 pvs. G\<turnstile>Norm s \<midarrow>e-\<succ>a'\<rightarrow> s1 \<and> 
   1.325 -                       (normal s1 \<longrightarrow> G, store s1\<turnstile>a'\<Colon>\<preceq>RefT statT)\<and> 
   1.326 -                       Y = In3 pvs \<and> G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2,s2))) 
   1.327 -            \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))" in ax_derivs.Call)
   1.328 -apply   (tactic "forw_hyp_tac 1")
   1.329 -apply   (tactic "clarsimp_tac eval_css 1")
   1.330 -apply   (frule (3) eval_type_sound)
   1.331 -apply   force
   1.332 -
   1.333 -apply   safe
   1.334 -apply   (tactic "forw_hyp_tac 1")
   1.335 -apply   (tactic "clarsimp_tac eval_css 1")
   1.336 -apply   (frule (3) eval_type_sound)
   1.337 -apply     (rule conjI)
   1.338 -apply       (rule exI,rule conjI)
   1.339 -apply         (assumption)
   1.340 -
   1.341 -apply         (rule conjI)
   1.342 -apply           simp
   1.343 -apply           assumption
   1.344 -apply      blast
   1.345 +  assumes mgf_methds: 
   1.346 +           "\<forall>C sig. G,(A::state triple set)\<turnstile>{=:n} \<langle>(Methd C sig)\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
   1.347 +  and mgf_e: "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
   1.348 +  and mgf_ps: "G,A\<turnstile>{=:n} \<langle>ps\<rangle>\<^sub>l\<succ> {G\<rightarrow>}"
   1.349 +  and wf: "wf_prog G"
   1.350 +  shows "G,A\<turnstile>{=:n} \<langle>{accC,statT,mode}e\<cdot>mn({pTs'}ps)\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
   1.351 +proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp) 
   1.352 +  note inj_term_simps [simp]
   1.353 +  fix T L accC' E
   1.354 +  assume wt: "\<lparr>prg=G,cls=accC',lcl = L\<rparr>\<turnstile>\<langle>({accC,statT,mode}e\<cdot>mn( {pTs'}ps))\<rangle>\<^sub>e\<Colon>T"
   1.355 +  then obtain pTs statDeclT statM where
   1.356 +                 wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT" and
   1.357 +              wt_args: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>ps\<Colon>\<doteq>pTs" and
   1.358 +                statM: "max_spec G accC statT \<lparr>name=mn,parTs=pTs\<rparr> 
   1.359 +                         = {((statDeclT,statM),pTs')}" and
   1.360 +                 mode: "mode = invmode statM e" and
   1.361 +                    T: "T =Inl (resTy statM)" and
   1.362 +        eq_accC_accC': "accC=accC'"
   1.363 +	by cases fastsimp+
   1.364 +  let ?Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
   1.365 +              (\<exists>a. G\<turnstile>Norm s \<midarrow>e-\<succ>a\<rightarrow> s1 \<and> 
   1.366 +                   (normal s1 \<longrightarrow> G, store s1\<turnstile>a\<Colon>\<preceq>RefT statT)
   1.367 +                   \<and> Y = In1 a) \<and> 
   1.368 +              (\<exists> P. normal s1
   1.369 +                  \<longrightarrow> \<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile>dom (locals (store s1))\<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright>P)) 
   1.370 +          \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))::state assn"
   1.371 +  let ?R="\<lambda>a. ((\<lambda>Y (x2,s2) (x,s) . x = None \<and> 
   1.372 +                (\<exists>s1 pvs. G\<turnstile>Norm s \<midarrow>e-\<succ>a\<rightarrow> s1 \<and> 
   1.373 +                          (normal s1 \<longrightarrow> G, store s1\<turnstile>a\<Colon>\<preceq>RefT statT)\<and> 
   1.374 +                          Y = \<lfloor>pvs\<rfloor>\<^sub>l \<and> G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2,s2))) 
   1.375 +               \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L)))::state assn"
   1.376  
   1.377 -apply (drule spec, drule spec)
   1.378 -apply (erule MGFnD' [THEN conseq12])
   1.379 -apply (tactic "clarsimp_tac eval_css 1")
   1.380 -apply (erule (1) eval_Call)
   1.381 -apply   (rule HOL.refl)+
   1.382 -apply   (subgoal_tac "check_method_access G C statT (invmode m e)
   1.383 -             \<lparr>name = mn, parTs = pTs'\<rparr> a
   1.384 -             (init_lvars G
   1.385 -               (invocation_declclass G (invmode m e) (snd (ab, ba)) a statT
   1.386 -                 \<lparr>name = mn, parTs = pTs'\<rparr>)
   1.387 -               \<lparr>name = mn, parTs = pTs'\<rparr> (invmode m e) a vs
   1.388 -               (ab,
   1.389 -                ba)) = (init_lvars G
   1.390 -               (invocation_declclass G (invmode m e) (snd (ab, ba)) a statT
   1.391 -                 \<lparr>name = mn, parTs = pTs'\<rparr>)
   1.392 -               \<lparr>name = mn, parTs = pTs'\<rparr> (invmode m e) a vs
   1.393 -               (ab,
   1.394 -                ba))")
   1.395 -apply    simp
   1.396 -defer 
   1.397 -apply simp
   1.398 -apply (erule (3) error_free_call_access) (* now showing the subgoal *)
   1.399 -apply auto
   1.400 -done
   1.401 +  show "G,A\<turnstile>{Normal ((\<lambda>Y' s' s. s' = s \<and> abrupt s = None) \<and>. G\<turnstile>init\<le>n \<and>.
   1.402 +                     (\<lambda>s. s\<Colon>\<preceq>(G, L)) \<and>.
   1.403 +                     (\<lambda>s. \<lparr>prg=G, cls=accC',lcl=L\<rparr> \<turnstile> dom (locals (store s)) 
   1.404 +                           \<guillemotright> \<langle>{accC,statT,mode}e\<cdot>mn( {pTs'}ps)\<rangle>\<^sub>e\<guillemotright> E))}
   1.405 +             {accC,statT,mode}e\<cdot>mn( {pTs'}ps)-\<succ>
   1.406 +             {\<lambda>Y s' s. \<exists>v. Y = \<lfloor>v\<rfloor>\<^sub>e \<and> 
   1.407 +                           G\<turnstile>s \<midarrow>{accC,statT,mode}e\<cdot>mn( {pTs'}ps)-\<succ>v\<rightarrow> s'}"
   1.408 +    (is "G,A\<turnstile>{Normal ?P} {accC,statT,mode}e\<cdot>mn( {pTs'}ps)-\<succ> {?S}")
   1.409 +  proof (rule ax_derivs.Call [where ?Q="?Q" and ?R="?R"])
   1.410 +    from mgf_e
   1.411 +    show "G,A\<turnstile>{Normal ?P} e-\<succ> {?Q}"
   1.412 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.413 +      fix s0 s1 a
   1.414 +      assume conf_s0: "Norm s0\<Colon>\<preceq>(G, L)"
   1.415 +      assume da: "\<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile> 
   1.416 +                     dom (locals s0) \<guillemotright>\<langle>{accC,statT,mode}e\<cdot>mn( {pTs'}ps)\<rangle>\<^sub>e\<guillemotright> E"
   1.417 +      assume eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<rightarrow> s1"
   1.418 +      show "(abrupt s1 = None \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>RefT statT) \<and>
   1.419 +            (abrupt s1 = None \<longrightarrow>
   1.420 +              (\<exists>P. \<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright> P))
   1.421 +            \<and> s1\<Colon>\<preceq>(G, L)"
   1.422 +      proof -
   1.423 +	from da obtain C where
   1.424 +	  da_e:  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>
   1.425 +                    dom (locals (store ((Norm s0)::state)))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> C" and
   1.426 +	  da_ps: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> nrm C \<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright> E" 
   1.427 +	  by cases (simp add: eq_accC_accC')
   1.428 +	from eval_e conf_s0 wt_e da_e wf
   1.429 +	obtain "(abrupt s1 = None \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>RefT statT)"
   1.430 +	  and  "s1\<Colon>\<preceq>(G, L)"
   1.431 +	  by (rule eval_type_soundE) simp
   1.432 +	moreover
   1.433 +	{
   1.434 +	  assume normal_s1: "normal s1"
   1.435 +	  have "\<exists>P. \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright> P"
   1.436 +	  proof -
   1.437 +	    from eval_e wt_e da_e wf normal_s1
   1.438 +	    have "nrm C \<subseteq>  dom (locals (store s1))"
   1.439 +	      by (cases rule: da_good_approxE') rules
   1.440 +	    with da_ps show ?thesis
   1.441 +	      by (rule da_weakenE) rules
   1.442 +	  qed
   1.443 +	}
   1.444 +	ultimately show ?thesis
   1.445 +	  using eq_accC_accC' by simp
   1.446 +      qed
   1.447 +    qed
   1.448 +  next
   1.449 +    show "\<forall>a. G,A\<turnstile>{?Q\<leftarrow>In1 a} ps\<doteq>\<succ> {?R a}" (is "\<forall> a. ?PS a")
   1.450 +    proof 
   1.451 +      fix a  
   1.452 +      show "?PS a"
   1.453 +      proof (rule MGFnD' [OF mgf_ps, THEN conseq12],
   1.454 +             clarsimp simp add: eq_accC_accC' [symmetric])
   1.455 +	fix s0 s1 s2 vs
   1.456 +	assume conf_s1: "s1\<Colon>\<preceq>(G, L)"
   1.457 +	assume eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<rightarrow> s1"
   1.458 +	assume conf_a: "abrupt s1 = None \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>RefT statT"
   1.459 +	assume eval_ps: "G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>vs\<rightarrow> s2"
   1.460 +	assume da_ps: "abrupt s1 = None \<longrightarrow> 
   1.461 +                       (\<exists>P. \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> 
   1.462 +                               dom (locals (store s1)) \<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright> P)"
   1.463 +	show "(\<exists>s1. G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<rightarrow> s1 \<and>
   1.464 +                (abrupt s1 = None \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>RefT statT) \<and>
   1.465 +                G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>vs\<rightarrow> s2) \<and>
   1.466 +              s2\<Colon>\<preceq>(G, L)"
   1.467 +	proof (cases "normal s1")
   1.468 +	  case True
   1.469 +	  with da_ps obtain P where
   1.470 +	   "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>ps\<rangle>\<^sub>l\<guillemotright> P"
   1.471 +	    by auto
   1.472 +	  from eval_ps conf_s1 wt_args this wf
   1.473 +	  have "s2\<Colon>\<preceq>(G, L)"
   1.474 +	    by (rule eval_type_soundE)
   1.475 +	  with eval_e conf_a eval_ps 
   1.476 +	  show ?thesis 
   1.477 +	    by auto
   1.478 +	next
   1.479 +	  case False
   1.480 +	  with eval_ps have "s2=s1" by auto
   1.481 +	  with eval_e conf_a eval_ps conf_s1 
   1.482 +	  show ?thesis 
   1.483 +	    by auto
   1.484 +	qed
   1.485 +      qed
   1.486 +    qed
   1.487 +  next
   1.488 +    show "\<forall>a vs invC declC l.
   1.489 +      G,A\<turnstile>{?R a\<leftarrow>\<lfloor>vs\<rfloor>\<^sub>l \<and>.
   1.490 +             (\<lambda>s. declC =
   1.491 +                  invocation_declclass G mode (store s) a statT
   1.492 +                      \<lparr>name=mn, parTs=pTs'\<rparr> \<and>
   1.493 +                  invC = invocation_class mode (store s) a statT \<and>
   1.494 +                  l = locals (store s)) ;.
   1.495 +             init_lvars G declC \<lparr>name=mn, parTs=pTs'\<rparr> mode a vs \<and>.
   1.496 +             (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}
   1.497 +          Methd declC \<lparr>name=mn,parTs=pTs'\<rparr>-\<succ> 
   1.498 +          {set_lvars l .; ?S}" 
   1.499 +      (is "\<forall> a vs invC declC l. ?METHD a vs invC declC l")
   1.500 +    proof (intro allI)
   1.501 +      fix a vs invC declC l
   1.502 +      from mgf_methds [rule_format]
   1.503 +      show "?METHD a vs invC declC l"
   1.504 +      proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.505 +	fix s4 s2 s1::state
   1.506 +	fix s0 v
   1.507 +	let ?D= "invocation_declclass G mode (store s2) a statT 
   1.508 +                    \<lparr>name=mn,parTs=pTs'\<rparr>"
   1.509 +	let ?s3= "init_lvars G ?D \<lparr>name=mn, parTs=pTs'\<rparr> mode a vs s2"
   1.510 +	assume inv_prop: "abrupt ?s3=None 
   1.511 +             \<longrightarrow> G\<turnstile>mode\<rightarrow>invocation_class mode (store s2) a statT\<preceq>statT"
   1.512 +	assume conf_s2: "s2\<Colon>\<preceq>(G, L)"
   1.513 +	assume conf_a: "abrupt s1 = None \<longrightarrow> G,store s1\<turnstile>a\<Colon>\<preceq>RefT statT"
   1.514 +	assume eval_e: "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<rightarrow> s1"
   1.515 +	assume eval_ps: "G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>vs\<rightarrow> s2"
   1.516 +	assume eval_mthd: "G\<turnstile>?s3 \<midarrow>Methd ?D \<lparr>name=mn,parTs=pTs'\<rparr>-\<succ>v\<rightarrow> s4"
   1.517 +	show "G\<turnstile>Norm s0 \<midarrow>{accC,statT,mode}e\<cdot>mn( {pTs'}ps)-\<succ>v
   1.518 +                        \<rightarrow> (set_lvars (locals (store s2))) s4"
   1.519 +	proof -
   1.520 +	  obtain D where D: "D=?D" by simp
   1.521 +	  obtain s3 where s3: "s3=?s3" by simp
   1.522 +	  obtain s3' where 
   1.523 +	    s3': "s3' = check_method_access G accC statT mode 
   1.524 +                           \<lparr>name=mn,parTs=pTs'\<rparr> a s3"
   1.525 +	    by simp
   1.526 +	  have eq_s3'_s3: "s3'=s3"
   1.527 +	  proof -
   1.528 +	    from inv_prop s3 mode
   1.529 +	    have "normal s3 \<Longrightarrow> 
   1.530 +             G\<turnstile>invmode statM e\<rightarrow>invocation_class mode (store s2) a statT\<preceq>statT"
   1.531 +	      by auto
   1.532 +	    with eval_ps wt_e statM conf_s2 conf_a [rule_format] 
   1.533 +	    have "check_method_access G accC statT (invmode statM e)
   1.534 +                      \<lparr>name=mn,parTs=pTs'\<rparr> a s3 = s3"
   1.535 +	      by (rule error_free_call_access) (auto simp add: s3 mode wf)
   1.536 +	    thus ?thesis 
   1.537 +	      by (simp add: s3' mode)
   1.538 +	  qed
   1.539 +	  with eval_mthd D s3
   1.540 +	  have "G\<turnstile>s3' \<midarrow>Methd D \<lparr>name=mn,parTs=pTs'\<rparr>-\<succ>v\<rightarrow> s4"
   1.541 +	    by simp
   1.542 +	  with eval_e eval_ps D _ s3' 
   1.543 +	  show ?thesis
   1.544 +	    by (rule eval_Call) (auto simp add: s3 mode D)
   1.545 +	qed
   1.546 +      qed
   1.547 +    qed
   1.548 +  qed
   1.549 +qed
   1.550 +	  	  
   1.551 +lemma eval_expression_no_jump':
   1.552 +  assumes eval: "G\<turnstile>s0 \<midarrow>e-\<succ>v\<rightarrow> s1"
   1.553 +  and   no_jmp: "abrupt s0 \<noteq> Some (Jump j)"
   1.554 +  and      wt: "\<lparr>prg=G, cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-T" 
   1.555 +  and      wf: "wf_prog G"
   1.556 +shows "abrupt s1 \<noteq> Some (Jump j)"
   1.557 +using eval no_jmp wt wf
   1.558 +by - (rule eval_expression_no_jump 
   1.559 +            [where ?Env="\<lparr>prg=G, cls=C,lcl=L\<rparr>",simplified],auto)
   1.560  
   1.561 -lemma MGF_altern: "G,A\<turnstile>{Normal (\<doteq> \<and>. p)} t\<succ> {G\<rightarrow>} =  
   1.562 - G,A\<turnstile>{Normal ((\<lambda>Y s Z. \<forall>w s'. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (w,s') \<longrightarrow> (w,s') = Z) \<and>. p)} 
   1.563 -  t\<succ> {\<lambda>Y s Z. (Y,s) = Z}"
   1.564 -apply (unfold MGF_def)
   1.565 -apply (auto del: conjI elim!: conseq12)
   1.566 -apply (case_tac "\<exists>w s. G\<turnstile>Norm sa \<midarrow>t\<succ>\<rightarrow> (w,s) ")
   1.567 -apply  (fast dest: unique_eval)
   1.568 -apply clarsimp
   1.569 -apply (drule split_paired_All [THEN subst])
   1.570 -apply (clarsimp elim!: state_not_single)
   1.571 -done
   1.572 +
   1.573 +text {* To derive the most general formula for the loop statement, we need to
   1.574 +come up with a proper loop invariant, which intuitively states that we are 
   1.575 +currently inside the evaluation of the loop. To define such an invariant, we
   1.576 +unroll the loop in iterated evaluations of the expression and evaluations of
   1.577 +the loop body. *}
   1.578 +
   1.579 +constdefs
   1.580 + unroll:: "prog \<Rightarrow> label \<Rightarrow> expr \<Rightarrow> stmt \<Rightarrow> (state \<times>  state) set"
   1.581 +
   1.582 + "unroll G l e c \<equiv> {(s,t). \<exists> v s1 s2.
   1.583 +                             G\<turnstile>s \<midarrow>e-\<succ>v\<rightarrow> s1 \<and> the_Bool v \<and> normal s1 \<and>
   1.584 +                             G\<turnstile>s1 \<midarrow>c\<rightarrow> s2 \<and> t=(abupd (absorb (Cont l)) s2)}"
   1.585 +
   1.586 +
   1.587 +lemma unroll_while:
   1.588 +  assumes unroll: "(s, t) \<in> (unroll G l e c)\<^sup>*"
   1.589 +  and     eval_e: "G\<turnstile>t \<midarrow>e-\<succ>v\<rightarrow> s'" 
   1.590 +  and     normal_termination: "normal s'  \<longrightarrow> \<not> the_Bool v"
   1.591 +  and     wt: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>e\<Colon>-T"
   1.592 +  and     wf: "wf_prog G" 
   1.593 +  shows "G\<turnstile>s \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.594 +using unroll (* normal_s *)
   1.595 +proof (induct rule: converse_rtrancl_induct) 
   1.596 +  show "G\<turnstile>t \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.597 +  proof (cases "normal t")
   1.598 +    case False
   1.599 +    with eval_e have "s'=t" by auto
   1.600 +    with False show ?thesis by auto
   1.601 +  next
   1.602 +    case True
   1.603 +    note normal_t = this
   1.604 +    show ?thesis
   1.605 +    proof (cases "normal s'")
   1.606 +      case True
   1.607 +      with normal_t eval_e normal_termination
   1.608 +      show ?thesis
   1.609 +	by (auto intro: eval.Loop)
   1.610 +    next
   1.611 +      case False
   1.612 +      note abrupt_s' = this
   1.613 +      from eval_e _ wt wf
   1.614 +      have no_cont: "abrupt s' \<noteq> Some (Jump (Cont l))"
   1.615 +	by (rule eval_expression_no_jump') (insert normal_t,simp)
   1.616 +      have
   1.617 +	"if the_Bool v 
   1.618 +             then (G\<turnstile>s' \<midarrow>c\<rightarrow> s' \<and> 
   1.619 +                   G\<turnstile>(abupd (absorb (Cont l)) s') \<midarrow>l\<bullet> While(e) c\<rightarrow> s')
   1.620 +	     else s' = s'"
   1.621 +      proof (cases "the_Bool v")
   1.622 +	case False thus ?thesis by simp
   1.623 +      next
   1.624 +	case True
   1.625 +	with abrupt_s' have "G\<turnstile>s' \<midarrow>c\<rightarrow> s'" by auto
   1.626 +	moreover from abrupt_s' no_cont 
   1.627 +	have no_absorb: "(abupd (absorb (Cont l)) s')=s'"
   1.628 +	  by (cases s') (simp add: absorb_def split: split_if)
   1.629 +	moreover
   1.630 +	from no_absorb abrupt_s'
   1.631 +	have "G\<turnstile>(abupd (absorb (Cont l)) s') \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.632 +	  by auto
   1.633 +	ultimately show ?thesis
   1.634 +	  using True by simp
   1.635 +      qed
   1.636 +      with eval_e 
   1.637 +      show ?thesis
   1.638 +	using normal_t by (auto intro: eval.Loop)
   1.639 +    qed
   1.640 +  qed
   1.641 +next
   1.642 +  fix s s3
   1.643 +  assume unroll: "(s,s3) \<in> unroll G l e c"
   1.644 +  assume while: "G\<turnstile>s3 \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.645 +  show "G\<turnstile>s \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.646 +  proof -
   1.647 +    from unroll obtain v s1 s2 where
   1.648 +      normal_s1: "normal s1" and
   1.649 +      eval_e: "G\<turnstile>s \<midarrow>e-\<succ>v\<rightarrow> s1" and
   1.650 +      continue: "the_Bool v" and
   1.651 +      eval_c: "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2" and
   1.652 +      s3: "s3=(abupd (absorb (Cont l)) s2)"
   1.653 +      by  (unfold unroll_def) fast 
   1.654 +    from eval_e normal_s1 have
   1.655 +      "normal s"
   1.656 +      by (rule eval_no_abrupt_lemma [rule_format])
   1.657 +    with while eval_e continue eval_c s3 show ?thesis
   1.658 +      by (auto intro!: eval.Loop)
   1.659 +  qed
   1.660 +qed
   1.661  
   1.662  
   1.663 -lemma MGFn_Loop: 
   1.664 -"\<lbrakk>G,(A::state triple set)\<turnstile>{=:n} In1l expr\<succ> {G\<rightarrow>};G,A\<turnstile>{=:n} In1r stmnt\<succ> {G\<rightarrow>} \<rbrakk> 
   1.665 -\<Longrightarrow> 
   1.666 -  G,A\<turnstile>{=:n} In1r (l\<bullet> While(expr) stmnt)\<succ> {G\<rightarrow>}"
   1.667 -apply (rule MGFn_NormalI, simp)
   1.668 -apply (rule_tac p2 = "\<lambda>s. card (nyinitcls G s) \<le> n" in 
   1.669 -          MGF_altern [unfolded MGF_def, THEN iffD2, THEN conseq1])
   1.670 -prefer 2
   1.671 -apply  clarsimp
   1.672 -apply (rule_tac P' = 
   1.673 -"((\<lambda>Y s Z. \<forall>w s'. G\<turnstile>s \<midarrow>In1r (l\<bullet>  While(expr) stmnt) \<succ>\<rightarrow> (w,s') \<longrightarrow> (w,s') = Z) 
   1.674 -  \<and>. (\<lambda>s. card (nyinitcls G s) \<le> n))" in conseq12)
   1.675 -prefer 2
   1.676 -apply  clarsimp
   1.677 -apply  (tactic "smp_tac 1 1", erule_tac V = "All ?P" in thin_rl)
   1.678 -apply  (rule_tac [2] P' = " (\<lambda>b s (Y',s') . (\<exists>s0. G\<turnstile>s0 \<midarrow>In1l expr\<succ>\<rightarrow> (b,s)) \<and> (if normal s \<and> the_Bool (the_In1 b) then (\<forall>s'' w s0. G\<turnstile>s \<midarrow>stmnt\<rightarrow> s'' \<and> G\<turnstile>(abupd (absorb (Cont l)) s'') \<midarrow>In1r (l\<bullet> While(expr) stmnt) \<succ>\<rightarrow> (w,s0) \<longrightarrow> (w,s0) = (Y',s')) else (\<diamondsuit>,s) = (Y',s'))) \<and>. G\<turnstile>init\<le>n" in polymorphic_Loop)
   1.679 -apply   (force dest!: eval.Loop split add: split_if_asm)
   1.680 -prefer 2
   1.681 -apply  (erule MGFnD' [THEN conseq12])
   1.682 -apply  clarsimp
   1.683 -apply  (erule_tac V = "card (nyinitcls G s') \<le> n" in thin_rl)
   1.684 -apply  (tactic "eval_Force_tac 1")
   1.685 -apply (erule MGFnD' [THEN conseq12] , clarsimp)
   1.686 -apply (rule conjI, erule exI)
   1.687 -apply (tactic "clarsimp_tac eval_css 1")
   1.688 -apply (case_tac "a")
   1.689 -prefer 2
   1.690 -apply  (clarsimp)
   1.691 -apply (clarsimp split add: split_if)
   1.692 -apply (rule conjI, (tactic {* force_tac (claset() addSDs [thm "eval.Loop"],
   1.693 -  simpset() addsimps [split_paired_all] addsimprocs [eval_stmt_proc]) 1*})+)
   1.694 -done
   1.695 +ML"Addsimprocs [eval_expr_proc, eval_var_proc, eval_exprs_proc, eval_stmt_proc]"
   1.696 +  
   1.697 +lemma MGFn_Loop:
   1.698 +  assumes mfg_e: "G,(A::state triple set)\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
   1.699 +  and     mfg_c: "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
   1.700 +  and     wf: "wf_prog G" 
   1.701 +shows "G,A\<turnstile>{=:n} \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
   1.702 +proof (rule MGFn_free_wt [rule_format],elim exE)
   1.703 +  fix T L C
   1.704 +  assume wt: "\<lparr>prg = G, cls = C, lcl = L\<rparr>\<turnstile>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<Colon>T"
   1.705 +  then obtain eT where
   1.706 +    wt_e: "\<lparr>prg = G, cls = C, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" 
   1.707 +    by cases simp
   1.708 +  show ?thesis
   1.709 +  proof (rule MGFn_NormalI)
   1.710 +    show "G,A\<turnstile>{Normal ((\<lambda>Y' s' s. s' = s \<and> normal s) \<and>. G\<turnstile>init\<le>n)} 
   1.711 +              .l\<bullet> While(e) c.
   1.712 +              {\<lambda>Y s' s. G\<turnstile>s \<midarrow>In1r (l\<bullet> While(e) c)\<succ>\<rightarrow> (Y, s')}"
   1.713 +    proof (rule conseq12 
   1.714 +           [where ?P'="(\<lambda> Y s' s. (s,s') \<in> (unroll G l e c)\<^sup>* ) \<and>. G\<turnstile>init\<le>n"
   1.715 +             and  ?Q'="((\<lambda> Y s' s. (\<exists> t b. (s,t) \<in> (unroll G l e c)\<^sup>* \<and> 
   1.716 +                          Y=\<lfloor>b\<rfloor>\<^sub>e \<and> G\<turnstile>t \<midarrow>e-\<succ>b\<rightarrow> s')) 
   1.717 +                        \<and>. G\<turnstile>init\<le>n)\<leftarrow>=False\<down>=\<diamondsuit>"])
   1.718 +      show  "G,A\<turnstile>{(\<lambda>Y s' s. (s, s') \<in> (unroll G l e c)\<^sup>*) \<and>. G\<turnstile>init\<le>n} 
   1.719 +                  .l\<bullet> While(e) c.
   1.720 +                 {((\<lambda>Y s' s. (\<exists>t b. (s, t) \<in> (unroll G l e c)\<^sup>* \<and> 
   1.721 +                                  Y = In1 b \<and> G\<turnstile>t \<midarrow>e-\<succ>b\<rightarrow> s')) 
   1.722 +                              \<and>. G\<turnstile>init\<le>n)\<leftarrow>=False\<down>=\<diamondsuit>}"
   1.723 +      proof (rule ax_derivs.Loop)
   1.724 +	from mfg_e
   1.725 +	show "G,A\<turnstile>{(\<lambda>Y s' s. (s, s') \<in> (unroll G l e c)\<^sup>*) \<and>. G\<turnstile>init\<le>n} 
   1.726 +                   e-\<succ>
   1.727 +                  {(\<lambda>Y s' s. (\<exists>t b. (s, t) \<in> (unroll G l e c)\<^sup>* \<and> 
   1.728 +                                     Y = In1 b \<and> G\<turnstile>t \<midarrow>e-\<succ>b\<rightarrow> s')) 
   1.729 +                   \<and>. G\<turnstile>init\<le>n}"
   1.730 +	proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.731 +	  fix s Z s' v
   1.732 +	  assume "(Z, s) \<in> (unroll G l e c)\<^sup>*"
   1.733 +	  moreover
   1.734 +	  assume "G\<turnstile>s \<midarrow>e-\<succ>v\<rightarrow> s'"
   1.735 +	  ultimately
   1.736 +	  show "\<exists>t. (Z, t) \<in> (unroll G l e c)\<^sup>* \<and> G\<turnstile>t \<midarrow>e-\<succ>v\<rightarrow> s'"
   1.737 +	    by blast
   1.738 +	qed
   1.739 +      next
   1.740 +	from mfg_c
   1.741 +	show "G,A\<turnstile>{Normal (((\<lambda>Y s' s. \<exists>t b. (s, t) \<in> (unroll G l e c)\<^sup>* \<and>
   1.742 +                                       Y = \<lfloor>b\<rfloor>\<^sub>e \<and> G\<turnstile>t \<midarrow>e-\<succ>b\<rightarrow> s') 
   1.743 +                          \<and>. G\<turnstile>init\<le>n)\<leftarrow>=True)}
   1.744 +                  .c.
   1.745 +                  {abupd (absorb (Cont l)) .;
   1.746 +                   ((\<lambda>Y s' s. (s, s') \<in> (unroll G l e c)\<^sup>*) \<and>. G\<turnstile>init\<le>n)}"
   1.747 +	proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.748 +	  fix Z s' s v t
   1.749 +	  assume unroll: "(Z, t) \<in> (unroll G l e c)\<^sup>*"
   1.750 +	  assume eval_e: "G\<turnstile>t \<midarrow>e-\<succ>v\<rightarrow> Norm s" 
   1.751 +	  assume true: "the_Bool v"
   1.752 +	  assume eval_c: "G\<turnstile>Norm s \<midarrow>c\<rightarrow> s'"
   1.753 +	  show "(Z, abupd (absorb (Cont l)) s') \<in> (unroll G l e c)\<^sup>*"
   1.754 +	  proof -
   1.755 +	    note unroll
   1.756 +	    also
   1.757 +	    from eval_e true eval_c
   1.758 +	    have "(t,abupd (absorb (Cont l)) s') \<in> unroll G l e c" 
   1.759 +	      by (unfold unroll_def) force
   1.760 +	    ultimately show ?thesis ..
   1.761 +	  qed
   1.762 +	qed
   1.763 +      qed
   1.764 +    next
   1.765 +      show 
   1.766 +	"\<forall>Y s Z.
   1.767 +         (Normal ((\<lambda>Y' s' s. s' = s \<and> normal s) \<and>. G\<turnstile>init\<le>n)) Y s Z 
   1.768 +         \<longrightarrow> (\<forall>Y' s'.
   1.769 +               (\<forall>Y Z'. 
   1.770 +                 ((\<lambda>Y s' s. (s, s') \<in> (unroll G l e c)\<^sup>*) \<and>. G\<turnstile>init\<le>n) Y s Z' 
   1.771 +                 \<longrightarrow> (((\<lambda>Y s' s. \<exists>t b. (s,t) \<in> (unroll G l e c)\<^sup>* 
   1.772 +                                       \<and> Y=\<lfloor>b\<rfloor>\<^sub>e \<and> G\<turnstile>t \<midarrow>e-\<succ>b\<rightarrow> s') 
   1.773 +                     \<and>. G\<turnstile>init\<le>n)\<leftarrow>=False\<down>=\<diamondsuit>) Y' s' Z') 
   1.774 +               \<longrightarrow> G\<turnstile>Z \<midarrow>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<succ>\<rightarrow> (Y', s'))"
   1.775 +      proof (clarsimp)
   1.776 +	fix Y' s' s
   1.777 +	assume asm:
   1.778 +	  "\<forall>Z'. (Z', Norm s) \<in> (unroll G l e c)\<^sup>* 
   1.779 +                 \<longrightarrow> card (nyinitcls G s') \<le> n \<and>
   1.780 +                     (\<exists>v. (\<exists>t. (Z', t) \<in> (unroll G l e c)\<^sup>* \<and> G\<turnstile>t \<midarrow>e-\<succ>v\<rightarrow> s') \<and>
   1.781 +                     (fst s' = None \<longrightarrow> \<not> the_Bool v)) \<and> Y' = \<diamondsuit>"
   1.782 +	show "Y' = \<diamondsuit> \<and> G\<turnstile>Norm s \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.783 +	proof -
   1.784 +	  from asm obtain v t where 
   1.785 +	    -- {* @{term "Z'"} gets instantiated with @{term "Norm s"} *}  
   1.786 +	    unroll: "(Norm s, t) \<in> (unroll G l e c)\<^sup>*" and
   1.787 +            eval_e: "G\<turnstile>t \<midarrow>e-\<succ>v\<rightarrow> s'" and
   1.788 +            normal_termination: "normal s' \<longrightarrow> \<not> the_Bool v" and
   1.789 +	     Y': "Y' = \<diamondsuit>"
   1.790 +	    by auto
   1.791 +	  from unroll eval_e normal_termination wt_e wf
   1.792 +	  have "G\<turnstile>Norm s \<midarrow>l\<bullet> While(e) c\<rightarrow> s'"
   1.793 +	    by (rule unroll_while)
   1.794 +	  with Y' 
   1.795 +	  show ?thesis
   1.796 +	    by simp
   1.797 +	qed
   1.798 +      qed
   1.799 +    qed
   1.800 +  qed
   1.801 +qed
   1.802  
   1.803 -text {* For @{text MGFn_FVar} we need the wellformedness of the program to
   1.804 -switch from the evaln-semantics to the eval-semantics *}
   1.805  lemma MGFn_FVar:
   1.806 - "\<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.807 -   \<Longrightarrow> G,(A\<Colon>state triple set)\<turnstile>{=:n} In2 ({accC,statDeclC,stat}e..fn)\<succ> {G\<rightarrow>}"
   1.808 -apply (tactic "wt_conf_prepare_tac 1")
   1.809 -apply (rule_tac  
   1.810 -  Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
   1.811 -        (G\<turnstile>Norm s \<midarrow>Init statDeclC\<rightarrow> s1 
   1.812 -         )) \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))"  
   1.813 - in ax_derivs.FVar)
   1.814 -apply (tactic "forw_hyp_tac 1")
   1.815 -apply (tactic "clarsimp_tac eval_css 1")
   1.816 -apply (subgoal_tac "is_class G statDeclC")
   1.817 -apply   (force dest: eval_type_sound)
   1.818 -apply   (force dest: ty_expr_is_type [THEN type_is_class] 
   1.819 -                      accfield_fields [THEN fields_declC])
   1.820 -apply (tactic "forw_hyp_tac 1")
   1.821 -apply (tactic "clarsimp_tac eval_css 1")
   1.822 -apply (subgoal_tac "(\<exists> v' s2' s3.   
   1.823 -        ( fvar statDeclC (is_static f) fn v (aa, ba) = (v',s2') ) \<and>
   1.824 -            (s3  = check_field_access G C statDeclC fn (is_static f) v s2') \<and>
   1.825 -            (s3 = s2'))")
   1.826 -apply   (erule exE)+
   1.827 -apply   (erule conjE)+
   1.828 -apply   (erule (1) eval.FVar)
   1.829 -apply     simp
   1.830 -apply     simp
   1.831 -
   1.832 -apply   (case_tac "fvar statDeclC (is_static f) fn v (aa, ba)")
   1.833 -apply   (rule exI)+
   1.834 -apply   (rule context_conjI)
   1.835 -apply      force
   1.836 -
   1.837 -apply   (rule context_conjI)
   1.838 -apply     simp
   1.839 -
   1.840 -apply     (erule (3) error_free_field_access)
   1.841 -apply       (auto dest: eval_type_sound)
   1.842 -done
   1.843 +  fixes A :: "state triple set"
   1.844 + assumes mgf_init: "G,A\<turnstile>{=:n} \<langle>Init statDeclC\<rangle>\<^sub>s\<succ> {G\<rightarrow>}" 
   1.845 +  and    mgf_e: "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
   1.846 +  and    wf: "wf_prog G"
   1.847 +  shows "G,A\<turnstile>{=:n} \<langle>{accC,statDeclC,stat}e..fn\<rangle>\<^sub>v\<succ> {G\<rightarrow>}"
   1.848 +proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp) 
   1.849 +  note inj_term_simps [simp]
   1.850 +  fix T L accC' V
   1.851 +  assume wt: "\<lparr>prg = G, cls = accC', lcl = L\<rparr>\<turnstile>\<langle>{accC,statDeclC,stat}e..fn\<rangle>\<^sub>v\<Colon>T"
   1.852 +  then obtain statC f where
   1.853 +    wt_e: "\<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
   1.854 +    accfield: "accfield G accC' statC fn = Some (statDeclC,f )" and
   1.855 +    eq_accC: "accC=accC'" and
   1.856 +    stat: "stat=is_static  f"
   1.857 +    by (cases) (auto simp add: member_is_static_simp)
   1.858 +  let ?Q="(\<lambda>Y s1 (x,s) . x = None \<and> 
   1.859 +                (G\<turnstile>Norm s \<midarrow>Init statDeclC\<rightarrow> s1) \<and>
   1.860 +                (\<exists> E. \<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile>dom (locals (store s1)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E))
   1.861 +                \<and>. G\<turnstile>init\<le>n \<and>. (\<lambda> s. s\<Colon>\<preceq>(G, L))"
   1.862 +  show "G,A\<turnstile>{Normal
   1.863 +             ((\<lambda>Y' s' s. s' = s \<and> abrupt s = None) \<and>. G\<turnstile>init\<le>n \<and>.
   1.864 +              (\<lambda>s. s\<Colon>\<preceq>(G, L)) \<and>.
   1.865 +              (\<lambda>s. \<lparr>prg=G,cls=accC',lcl=L\<rparr>
   1.866 +                 \<turnstile> dom (locals (store s)) \<guillemotright> \<langle>{accC,statDeclC,stat}e..fn\<rangle>\<^sub>v\<guillemotright> V))
   1.867 +             } {accC,statDeclC,stat}e..fn=\<succ>
   1.868 +             {\<lambda>Y s' s. \<exists>vf. Y = \<lfloor>vf\<rfloor>\<^sub>v \<and> 
   1.869 +                        G\<turnstile>s \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>vf\<rightarrow> s'}"
   1.870 +    (is "G,A\<turnstile>{Normal ?P} {accC,statDeclC,stat}e..fn=\<succ> {?R}")
   1.871 +  proof (rule ax_derivs.FVar [where ?Q="?Q" ])
   1.872 +    from mgf_init
   1.873 +    show "G,A\<turnstile>{Normal ?P} .Init statDeclC. {?Q}"
   1.874 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.875 +      fix s s'
   1.876 +      assume conf_s: "Norm s\<Colon>\<preceq>(G, L)"
   1.877 +      assume da: "\<lparr>prg=G,cls=accC',lcl=L\<rparr>
   1.878 +                    \<turnstile> dom (locals s) \<guillemotright>\<langle>{accC,statDeclC,stat}e..fn\<rangle>\<^sub>v\<guillemotright> V"
   1.879 +      assume eval_init: "G\<turnstile>Norm s \<midarrow>Init statDeclC\<rightarrow> s'"
   1.880 +      show "(\<exists>E. \<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile> dom (locals (store s')) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E) \<and>
   1.881 +            s'\<Colon>\<preceq>(G, L)"
   1.882 +      proof -
   1.883 +	from da 
   1.884 +	obtain E where
   1.885 +	  "\<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile> dom (locals s) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
   1.886 +	  by cases simp
   1.887 +	moreover
   1.888 +	from eval_init
   1.889 +	have "dom (locals s) \<subseteq> dom (locals (store s'))"
   1.890 +	  by (rule dom_locals_eval_mono [elim_format]) simp
   1.891 +	ultimately obtain E' where
   1.892 +	  "\<lparr>prg=G, cls=accC', lcl=L\<rparr>\<turnstile> dom (locals (store s')) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E'"
   1.893 +	  by (rule da_weakenE)
   1.894 +	moreover
   1.895 +	have "s'\<Colon>\<preceq>(G, L)"
   1.896 +	proof -
   1.897 +	  have wt_init: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>(Init statDeclC)\<Colon>\<surd>"
   1.898 +	  proof -
   1.899 +	    from wf wt_e 
   1.900 +	    have iscls_statC: "is_class G statC"
   1.901 +	      by (auto dest: ty_expr_is_type type_is_class)
   1.902 +	    with wf accfield 
   1.903 +	    have iscls_statDeclC: "is_class G statDeclC"
   1.904 +	      by (auto dest!: accfield_fields dest: fields_declC)
   1.905 +	    thus ?thesis by simp
   1.906 +	  qed
   1.907 +	  obtain I where 
   1.908 +	    da_init: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
   1.909 +               \<turnstile> dom (locals (store ((Norm s)::state))) \<guillemotright>\<langle>Init statDeclC\<rangle>\<^sub>s\<guillemotright> I"
   1.910 +	    by (auto intro: da_Init [simplified] assigned.select_convs)
   1.911 +	  from eval_init conf_s wt_init da_init  wf
   1.912 +	  show ?thesis
   1.913 +	    by (rule eval_type_soundE)
   1.914 +	qed
   1.915 +	ultimately show ?thesis by rules
   1.916 +      qed
   1.917 +    qed
   1.918 +  next
   1.919 +    from mgf_e
   1.920 +    show "G,A\<turnstile>{?Q} e-\<succ> {\<lambda>Val:a:. fvar statDeclC stat fn a ..; ?R}"
   1.921 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
   1.922 +      fix s0 s1 s2 E a
   1.923 +      let ?fvar = "fvar statDeclC stat fn a s2"
   1.924 +      assume eval_init: "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<rightarrow> s1"
   1.925 +      assume eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<rightarrow> s2"
   1.926 +      assume conf_s1: "s1\<Colon>\<preceq>(G, L)"
   1.927 +      assume da_e: "\<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
   1.928 +      show "G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>fst ?fvar\<rightarrow> snd ?fvar"
   1.929 +      proof -
   1.930 +	obtain v s2' where
   1.931 +	  v: "v=fst ?fvar" and s2': "s2'=snd ?fvar"
   1.932 +	  by simp
   1.933 +	obtain s3 where
   1.934 +	  s3: "s3= check_field_access G accC' statDeclC fn stat a s2'"
   1.935 +	  by simp
   1.936 +	have eq_s3_s2': "s3=s2'"
   1.937 +	proof -
   1.938 +	  from eval_e conf_s1 wt_e da_e wf obtain
   1.939 +	    conf_s2: "s2\<Colon>\<preceq>(G, L)"  and
   1.940 +	    conf_a: "normal s2 \<Longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
   1.941 +	    by (rule eval_type_soundE) simp
   1.942 +	  from accfield wt_e eval_init eval_e conf_s2 conf_a _ wf
   1.943 +	  show ?thesis
   1.944 +	    by (rule  error_free_field_access 
   1.945 +                      [where ?v=v and ?s2'=s2',elim_format])
   1.946 +	       (simp add: s3 v s2' stat)+
   1.947 +        qed
   1.948 +	from eval_init eval_e 
   1.949 +	show ?thesis
   1.950 +	  apply (rule eval.FVar [where ?s2'=s2'])
   1.951 +	  apply  (simp add: s2')
   1.952 +	  apply  (simp add: s3 [symmetric]   eq_s3_s2' eq_accC s2' [symmetric])
   1.953 +	  done
   1.954 +      qed
   1.955 +    qed
   1.956 +  qed
   1.957 +qed
   1.958  
   1.959 -text {* For @{text MGFn_Fin} we need the wellformedness of the program to
   1.960 -switch from the evaln-semantics to the eval-semantics *}
   1.961 -lemma MGFn_Fin: 
   1.962 -"\<lbrakk>wf_prog G; G,A\<turnstile>{=:n} In1r stmt1\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In1r stmt2\<succ> {G\<rightarrow>}\<rbrakk>
   1.963 - \<Longrightarrow> G,(A\<Colon>state triple set)\<turnstile>{=:n} In1r (stmt1 Finally stmt2)\<succ> {G\<rightarrow>}"
   1.964 -apply (tactic "wt_conf_prepare_tac 1")
   1.965 -apply (rule_tac Q = " (\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>stmt1\<rightarrow> s' \<and> s\<Colon>\<preceq>(G, L)) 
   1.966 -\<and>. G\<turnstile>init\<le>n" in ax_derivs.Fin)
   1.967 -apply (tactic "forw_hyp_tac 1")
   1.968 -apply (tactic "clarsimp_tac eval_css 1")
   1.969 -apply (rule allI)
   1.970 -apply (tactic "clarsimp_tac eval_css 1")
   1.971 -apply (tactic "forw_hyp_tac 1")
   1.972 -apply (tactic {* pair_tac "sb" 1 *})
   1.973 -apply (tactic"clarsimp_tac (claset(),simpset() addsimprocs [eval_stmt_proc]) 1")
   1.974 -apply (rule wf_eval_Fin)
   1.975 -apply auto
   1.976 -done
   1.977  
   1.978 -text {* For @{text MGFn_lemma} we need the wellformedness of the program to
   1.979 -switch from the evaln-semantics to the eval-semantics cf. @{text MGFn_call}, 
   1.980 -@{text MGFn_FVar}*}
   1.981 -lemma MGFn_lemma [rule_format (no_asm)]: 
   1.982 - "\<lbrakk>\<forall>n C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>};
   1.983 -   wf_prog G\<rbrakk> 
   1.984 -  \<Longrightarrow>  \<forall>t. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
   1.985 -apply (rule full_nat_induct)
   1.986 -apply (rule allI)
   1.987 -apply (drule_tac x = n in spec)
   1.988 -apply (drule_tac psi = "All ?P" in asm_rl)
   1.989 -apply (subgoal_tac "\<forall>v e c es. G,A\<turnstile>{=:n} In2 v\<succ> {G\<rightarrow>} \<and> G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>} \<and> G,A\<turnstile>{=:n} In1r c\<succ> {G\<rightarrow>} \<and> G,A\<turnstile>{=:n} In3 es\<succ> {G\<rightarrow>}")
   1.990 -apply  (tactic "Clarify_tac 2")
   1.991 -apply  (induct_tac "t")
   1.992 -apply    (induct_tac "a")
   1.993 -apply     fast+
   1.994 -apply (rule var_expr_stmt.induct) 
   1.995 -(* 34 subgoals *)
   1.996 -prefer 17 apply fast (* Methd *)
   1.997 -prefer 16 apply (erule (3) MGFn_Call)
   1.998 -prefer 2  apply (drule MGFn_Init,erule (2) MGFn_FVar)
   1.999 -apply (erule_tac [!] V = "All ?P" in thin_rl) (* assumptions on Methd *)
  1.1000 -apply (erule_tac [29] MGFn_Init)
  1.1001 -prefer 23 apply (erule (1) MGFn_Loop)
  1.1002 -prefer 26 apply (erule (2) MGFn_Fin)
  1.1003 -apply (tactic "ALLGOALS compl_prepare_tac")
  1.1004 +lemma MGFn_Fin:
  1.1005 +  assumes wf: "wf_prog G" 
  1.1006 +  and     mgf_c1: "G,A\<turnstile>{=:n} \<langle>c1\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1007 +  and     mgf_c2: "G,A\<turnstile>{=:n} \<langle>c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1008 +  shows "G,(A\<Colon>state triple set)\<turnstile>{=:n} \<langle>c1 Finally c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1009 +proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp)
  1.1010 +  fix T L accC C 
  1.1011 +  assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>In1r (c1 Finally c2)\<Colon>T"
  1.1012 +  then obtain
  1.1013 +    wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  1.1014 +    wt_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c2\<Colon>\<surd>"
  1.1015 +    by cases simp
  1.1016 +  let  ?Q = "(\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>c1\<rightarrow> s' \<and> 
  1.1017 +               (\<exists> C1. \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s)) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1)
  1.1018 +               \<and> s\<Colon>\<preceq>(G, L)) 
  1.1019 +             \<and>. G\<turnstile>init\<le>n"
  1.1020 +  show "G,A\<turnstile>{Normal
  1.1021 +              ((\<lambda>Y' s' s. s' = s \<and> abrupt s = None) \<and>. G\<turnstile>init\<le>n \<and>.
  1.1022 +              (\<lambda>s. s\<Colon>\<preceq>(G, L)) \<and>.
  1.1023 +              (\<lambda>s. \<lparr>prg=G,cls=accC,lcl =L\<rparr>  
  1.1024 +                     \<turnstile>dom (locals (store s)) \<guillemotright>\<langle>c1 Finally c2\<rangle>\<^sub>s\<guillemotright> C))}
  1.1025 +             .c1 Finally c2. 
  1.1026 +             {\<lambda>Y s' s. Y = \<diamondsuit> \<and> G\<turnstile>s \<midarrow>c1 Finally c2\<rightarrow> s'}"
  1.1027 +    (is "G,A\<turnstile>{Normal ?P} .c1 Finally c2. {?R}")
  1.1028 +  proof (rule ax_derivs.Fin [where ?Q="?Q"])
  1.1029 +    from mgf_c1
  1.1030 +    show "G,A\<turnstile>{Normal ?P} .c1. {?Q}"
  1.1031 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
  1.1032 +      fix s0
  1.1033 +      assume "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals s0) \<guillemotright>\<langle>c1 Finally c2\<rangle>\<^sub>s\<guillemotright> C"
  1.1034 +      thus "\<exists>C1. \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals s0) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1"
  1.1035 +	by cases (auto simp add: inj_term_simps)
  1.1036 +    qed
  1.1037 +  next
  1.1038 +    from mgf_c2
  1.1039 +    show "\<forall>abr. G,A\<turnstile>{?Q \<and>. (\<lambda>s. abr = abrupt s) ;. abupd (\<lambda>abr. None)} .c2.
  1.1040 +          {abupd (abrupt_if (abr \<noteq> None) abr) .; ?R}"
  1.1041 +    proof (rule MGFnD' [THEN conseq12, THEN allI],clarsimp)
  1.1042 +      fix s0 s1 s2 C1
  1.1043 +      assume da_c1:"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals s0) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1"
  1.1044 +      assume conf_s0: "Norm s0\<Colon>\<preceq>(G, L)"
  1.1045 +      assume eval_c1: "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1"
  1.1046 +      assume eval_c2: "G\<turnstile>abupd (\<lambda>abr. None) s1 \<midarrow>c2\<rightarrow> s2"
  1.1047 +      show "G\<turnstile>Norm s0 \<midarrow>c1 Finally c2
  1.1048 +               \<rightarrow> abupd (abrupt_if (\<exists>y. abrupt s1 = Some y) (abrupt s1)) s2"
  1.1049 +      proof -
  1.1050 +	obtain abr1 str1 where s1: "s1=(abr1,str1)"
  1.1051 +	  by (cases s1) simp
  1.1052 +	with eval_c1 eval_c2 obtain
  1.1053 +	  eval_c1': "G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> (abr1,str1)" and
  1.1054 +	  eval_c2': "G\<turnstile>Norm str1 \<midarrow>c2\<rightarrow> s2"
  1.1055 +	  by simp
  1.1056 +	obtain s3 where 
  1.1057 +	  s3: "s3 = (if \<exists>err. abr1 = Some (Error err) 
  1.1058 +	                then (abr1, str1)
  1.1059 +                        else abupd (abrupt_if (abr1 \<noteq> None) abr1) s2)"
  1.1060 +	  by simp
  1.1061 +	from eval_c1' conf_s0 wt_c1 _ wf 
  1.1062 +	have "error_free (abr1,str1)"
  1.1063 +	  by (rule eval_type_soundE) (insert da_c1,auto)
  1.1064 +	with s3 have eq_s3: "s3=abupd (abrupt_if (abr1 \<noteq> None) abr1) s2"
  1.1065 +	  by (simp add: error_free_def)
  1.1066 +	from eval_c1' eval_c2' s3
  1.1067 +	show ?thesis
  1.1068 +	  by (rule eval.Fin [elim_format]) (simp add: s1 eq_s3)
  1.1069 +      qed
  1.1070 +    qed 
  1.1071 +  qed
  1.1072 +qed
  1.1073 +      
  1.1074 +lemma Body_no_break:
  1.1075 + assumes eval_init: "G\<turnstile>Norm s0 \<midarrow>Init D\<rightarrow> s1" 
  1.1076 +   and      eval_c: "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2" 
  1.1077 +   and       jmpOk: "jumpNestingOkS {Ret} c"
  1.1078 +   and        wt_c: "\<lparr>prg=G, cls=C, lcl=L\<rparr>\<turnstile>c\<Colon>\<surd>"
  1.1079 +   and        clsD: "class G D=Some d"
  1.1080 +   and          wf: "wf_prog G" 
  1.1081 +  shows "\<forall> l. abrupt s2 \<noteq> Some (Jump (Break l)) \<and> 
  1.1082 +              abrupt s2 \<noteq> Some (Jump (Cont l))"
  1.1083 +proof
  1.1084 +  fix l show "abrupt s2 \<noteq> Some (Jump (Break l)) \<and>  
  1.1085 +              abrupt s2 \<noteq> Some (Jump (Cont l))"
  1.1086 +  proof -
  1.1087 +    from clsD have wt_init: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>(Init D)\<Colon>\<surd>"
  1.1088 +      by auto
  1.1089 +    from eval_init wf
  1.1090 +    have s1_no_jmp: "\<And> j. abrupt s1 \<noteq> Some (Jump j)"
  1.1091 +      by - (rule eval_statement_no_jump [OF _ _ _ wt_init],auto)
  1.1092 +    from eval_c _ wt_c wf
  1.1093 +    show ?thesis
  1.1094 +      apply (rule jumpNestingOk_eval [THEN conjE, elim_format])
  1.1095 +      using jmpOk s1_no_jmp
  1.1096 +      apply auto
  1.1097 +      done
  1.1098 +  qed
  1.1099 +qed
  1.1100  
  1.1101 -apply (rule ax_derivs.LVar [THEN conseq1], tactic "eval_Force_tac 1")
  1.1102 -
  1.1103 -apply (rule ax_derivs.AVar)
  1.1104 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1105 -apply (tactic "forw_hyp_eval_Force_tac 1")
  1.1106 -
  1.1107 -apply (rule ax_derivs.InstInitV)
  1.1108 -
  1.1109 -apply (rule ax_derivs.NewC)
  1.1110 -apply (erule MGFn_InitD [THEN conseq2])
  1.1111 -apply (tactic "eval_Force_tac 1")
  1.1112 -
  1.1113 -apply (rule_tac Q = "(\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>In1r (init_comp_ty ty) \<succ>\<rightarrow> (Y',s')) \<and>. G\<turnstile>init\<le>n" in ax_derivs.NewA)
  1.1114 -apply  (simp add: init_comp_ty_def split add: split_if)
  1.1115 -apply   (rule conjI, clarsimp)
  1.1116 -apply   (erule MGFn_InitD [THEN conseq2])
  1.1117 -apply   (tactic "clarsimp_tac eval_css 1")
  1.1118 -apply  clarsimp
  1.1119 -apply  (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
  1.1120 -apply (tactic "forw_hyp_eval_Force_tac 1")
  1.1121 -
  1.1122 -apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Cast],tactic"eval_Force_tac 1")
  1.1123 -
  1.1124 -apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Inst],tactic"eval_Force_tac 1")
  1.1125 -apply (rule ax_derivs.Lit [THEN conseq1], tactic "eval_Force_tac 1")
  1.1126 -apply (rule ax_derivs.UnOp, tactic "forw_hyp_eval_Force_tac 1")
  1.1127 +lemma MGFn_Body:
  1.1128 +  assumes wf: "wf_prog G"
  1.1129 +  and     mgf_init: "G,A\<turnstile>{=:n} \<langle>Init D\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1130 +  and     mgf_c: "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1131 +  shows  "G,(A\<Colon>state triple set)\<turnstile>{=:n} \<langle>Body D c\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1132 +proof (rule MGFn_free_wt_da_NormalConformI [rule_format],clarsimp)
  1.1133 +  fix T L accC E
  1.1134 +  assume wt: "\<lparr>prg=G, cls=accC,lcl=L\<rparr>\<turnstile>\<langle>Body D c\<rangle>\<^sub>e\<Colon>T"
  1.1135 +  let ?Q="(\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>Init D\<rightarrow> s' \<and> jumpNestingOkS {Ret} c) 
  1.1136 +          \<and>. G\<turnstile>init\<le>n" 
  1.1137 +  show "G,A\<turnstile>{Normal
  1.1138 +               ((\<lambda>Y' s' s. s' = s \<and> fst s = None) \<and>. G\<turnstile>init\<le>n \<and>.
  1.1139 +                (\<lambda>s. s\<Colon>\<preceq>(G, L)) \<and>.
  1.1140 +                (\<lambda>s. \<lparr>prg=G,cls=accC,lcl=L\<rparr>
  1.1141 +                       \<turnstile> dom (locals (store s)) \<guillemotright>\<langle>Body D c\<rangle>\<^sub>e\<guillemotright> E))}
  1.1142 +             Body D c-\<succ> 
  1.1143 +             {\<lambda>Y s' s. \<exists>v. Y = In1 v \<and> G\<turnstile>s \<midarrow>Body D c-\<succ>v\<rightarrow> s'}"
  1.1144 +    (is "G,A\<turnstile>{Normal ?P} Body D c-\<succ> {?R}")
  1.1145 +  proof (rule ax_derivs.Body [where ?Q="?Q"])
  1.1146 +    from mgf_init
  1.1147 +    show "G,A\<turnstile>{Normal ?P} .Init D. {?Q}"
  1.1148 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
  1.1149 +      fix s0
  1.1150 +      assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals s0) \<guillemotright>\<langle>Body D c\<rangle>\<^sub>e\<guillemotright> E"
  1.1151 +      thus "jumpNestingOkS {Ret} c"
  1.1152 +	by cases simp
  1.1153 +    qed
  1.1154 +  next
  1.1155 +    from mgf_c
  1.1156 +    show "G,A\<turnstile>{?Q}.c.{\<lambda>s.. abupd (absorb Ret) .; ?R\<leftarrow>\<lfloor>the (locals s Result)\<rfloor>\<^sub>e}"
  1.1157 +    proof (rule MGFnD' [THEN conseq12],clarsimp)
  1.1158 +      fix s0 s1 s2
  1.1159 +      assume eval_init: "G\<turnstile>Norm s0 \<midarrow>Init D\<rightarrow> s1"
  1.1160 +      assume eval_c: "G\<turnstile>s1 \<midarrow>c\<rightarrow> s2"
  1.1161 +      assume nestingOk: "jumpNestingOkS {Ret} c"
  1.1162 +      show "G\<turnstile>Norm s0 \<midarrow>Body D c-\<succ>the (locals (store s2) Result)
  1.1163 +              \<rightarrow> abupd (absorb Ret) s2"
  1.1164 +      proof -
  1.1165 +	from wt obtain d where 
  1.1166 +          d: "class G D=Some d" and
  1.1167 +          wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
  1.1168 +	  by cases auto
  1.1169 +	obtain s3 where 
  1.1170 +	  s3: "s3= (if \<exists>l. fst s2 = Some (Jump (Break l)) \<or>
  1.1171 +                           fst s2 = Some (Jump (Cont l))
  1.1172 +                       then abupd (\<lambda>x. Some (Error CrossMethodJump)) s2 
  1.1173 +                       else s2)"
  1.1174 +	  by simp
  1.1175 +	from eval_init eval_c nestingOk wt_c d wf
  1.1176 +	have eq_s3_s2: "s3=s2"
  1.1177 +	  by (rule Body_no_break [elim_format]) (simp add: s3)
  1.1178 +	from eval_init eval_c s3
  1.1179 +	show ?thesis
  1.1180 +	  by (rule eval.Body [elim_format]) (simp add: eq_s3_s2)
  1.1181 +      qed
  1.1182 +    qed
  1.1183 +  qed
  1.1184 +qed
  1.1185  
  1.1186 -apply (rule ax_derivs.BinOp)
  1.1187 -apply   (erule MGFnD [THEN ax_NormalD])
  1.1188 -
  1.1189 -apply   (rule allI)
  1.1190 -apply   (case_tac "need_second_arg binop v1")
  1.1191 -apply     simp
  1.1192 -apply     (tactic "forw_hyp_eval_Force_tac 1")
  1.1193 -
  1.1194 -apply     simp
  1.1195 -apply     (rule ax_Normal_cases)
  1.1196 -apply       (rule ax_derivs.Skip [THEN conseq1])
  1.1197 -apply       clarsimp
  1.1198 -
  1.1199 -apply       (rule eval_BinOp_arg2_indepI)
  1.1200 -apply       simp
  1.1201 -apply       simp
  1.1202 -
  1.1203 -apply  (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
  1.1204 -apply  (tactic "eval_Force_tac 1")
  1.1205 -
  1.1206 -apply (rule ax_derivs.Super [THEN conseq1], tactic "eval_Force_tac 1")
  1.1207 -apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Acc],tactic"eval_Force_tac 1")
  1.1208 -
  1.1209 -apply (rule ax_derivs.Ass)
  1.1210 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1211 -apply (tactic "forw_hyp_eval_Force_tac 1")
  1.1212 +(* To term *)
  1.1213 +lemma term_cases: "
  1.1214 +  \<lbrakk>\<And> v. P \<langle>v\<rangle>\<^sub>v; \<And> e. P \<langle>e\<rangle>\<^sub>e;\<And> c. P \<langle>c\<rangle>\<^sub>s;\<And> l. P \<langle>l\<rangle>\<^sub>l\<rbrakk>
  1.1215 +  \<Longrightarrow> P t"
  1.1216 +  apply (cases t)
  1.1217 +  apply (case_tac a)
  1.1218 +  apply auto
  1.1219 +  done
  1.1220  
  1.1221 -apply (rule ax_derivs.Cond)
  1.1222 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1223 -apply (rule allI)
  1.1224 -apply (rule ax_Normal_cases)
  1.1225 -prefer 2
  1.1226 -apply  (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
  1.1227 -apply  (tactic "eval_Force_tac 1")
  1.1228 -apply (case_tac "b")
  1.1229 -apply  (simp, tactic "forw_hyp_eval_Force_tac 1")
  1.1230 -apply (simp, tactic "forw_hyp_eval_Force_tac 1")
  1.1231 -
  1.1232 -apply (rule_tac Q = " (\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>Init pid_field_type\<rightarrow> s') \<and>. G\<turnstile>init\<le>n" in ax_derivs.Body)
  1.1233 - apply (erule MGFn_InitD [THEN conseq2])
  1.1234 - apply (tactic "eval_Force_tac 1")
  1.1235 -apply (tactic "forw_hyp_tac 1")
  1.1236 -apply (tactic {* clarsimp_tac (eval_css delsimps2 [split_paired_all]) 1 *})
  1.1237 -apply (erule (1) eval.Body)
  1.1238 -
  1.1239 -apply (rule ax_derivs.InstInitE)
  1.1240 -
  1.1241 -apply (rule ax_derivs.Callee)
  1.1242 -
  1.1243 -apply (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
  1.1244 -
  1.1245 -apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Expr],tactic"eval_Force_tac 1")
  1.1246 -
  1.1247 -apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Lab])
  1.1248 -apply (tactic "clarsimp_tac eval_css 1")
  1.1249 -
  1.1250 -apply (rule ax_derivs.Comp)
  1.1251 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1252 -apply (tactic "forw_hyp_eval_Force_tac 1")
  1.1253 -
  1.1254 -apply (rule ax_derivs.If)
  1.1255 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1256 -apply (rule allI)
  1.1257 -apply (rule ax_Normal_cases)
  1.1258 -prefer 2
  1.1259 -apply  (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
  1.1260 -apply  (tactic "eval_Force_tac 1")
  1.1261 -apply (case_tac "b")
  1.1262 -apply  (simp, tactic "forw_hyp_eval_Force_tac 1")
  1.1263 -apply (simp, tactic "forw_hyp_eval_Force_tac 1")
  1.1264 -
  1.1265 -apply (rule ax_derivs.Do [THEN conseq1])
  1.1266 -apply (tactic {* force_tac (eval_css addsimps2 [thm "abupd_def2"]) 1 *})
  1.1267 -
  1.1268 -apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Throw])
  1.1269 -apply (tactic "clarsimp_tac eval_css 1")
  1.1270 -
  1.1271 -apply (rule_tac Q = " (\<lambda>Y' s' s. normal s \<and> (\<exists>s''. G\<turnstile>s \<midarrow>In1r stmt1\<succ>\<rightarrow> (Y',s'') \<and> G\<turnstile>s'' \<midarrow>sxalloc\<rightarrow> s')) \<and>. G\<turnstile>init\<le>n" in ax_derivs.Try)
  1.1272 -apply   (tactic "eval_Force_tac 3")
  1.1273 -apply  (tactic "forw_hyp_eval_Force_tac 2")
  1.1274 -apply (erule MGFnD [THEN ax_NormalD, THEN conseq2])
  1.1275 -apply (tactic "clarsimp_tac eval_css 1")
  1.1276 -apply (force elim: sxalloc_gext [THEN card_nyinitcls_gext])
  1.1277 -
  1.1278 -apply (rule ax_derivs.FinA)
  1.1279 -
  1.1280 -apply (rule ax_derivs.Nil [THEN conseq1], tactic "eval_Force_tac 1")
  1.1281 -
  1.1282 -apply (rule ax_derivs.Cons)
  1.1283 -apply  (erule MGFnD [THEN ax_NormalD])
  1.1284 -apply (tactic "forw_hyp_eval_Force_tac 1")
  1.1285 -done
  1.1286 +lemma MGFn_lemma:
  1.1287 +  assumes mgf_methds: 
  1.1288 +           "\<And> n. \<forall> C sig. G,(A::state triple set)\<turnstile>{=:n} \<langle>Methd C sig\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1289 +  and wf: "wf_prog G"
  1.1290 +  shows "\<And> t. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
  1.1291 +proof (induct rule: full_nat_induct)
  1.1292 +  fix n t
  1.1293 +  assume hyp: "\<forall> m. Suc m \<le> n \<longrightarrow> (\<forall> t. G,A\<turnstile>{=:m} t\<succ> {G\<rightarrow>})"
  1.1294 +  show "G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
  1.1295 +  proof -
  1.1296 +  { 
  1.1297 +    fix v e c es
  1.1298 +    have "G,A\<turnstile>{=:n} \<langle>v\<rangle>\<^sub>v\<succ> {G\<rightarrow>}" and 
  1.1299 +      "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}" and
  1.1300 +      "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}" and  
  1.1301 +      "G,A\<turnstile>{=:n} \<langle>es\<rangle>\<^sub>l\<succ> {G\<rightarrow>}"
  1.1302 +    proof (induct rule: var_expr_stmt.induct)
  1.1303 +      case (LVar v)
  1.1304 +      show "G,A\<turnstile>{=:n} \<langle>LVar v\<rangle>\<^sub>v\<succ> {G\<rightarrow>}"
  1.1305 +	apply (rule MGFn_NormalI)
  1.1306 +	apply (rule ax_derivs.LVar [THEN conseq1])
  1.1307 +	apply (clarsimp)
  1.1308 +	apply (rule eval.LVar)
  1.1309 +	done
  1.1310 +    next
  1.1311 +      case (FVar accC statDeclC stat e fn)
  1.1312 +      have "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}".
  1.1313 +      from MGFn_Init [OF hyp] this wf 
  1.1314 +      show ?case
  1.1315 +	by (rule MGFn_FVar)
  1.1316 +    next
  1.1317 +      case (AVar e1 e2)
  1.1318 +      have mgf_e1: "G,A\<turnstile>{=:n} \<langle>e1\<rangle>\<^sub>e\<succ> {G\<rightarrow>}".
  1.1319 +      have mgf_e2: "G,A\<turnstile>{=:n} \<langle>e2\<rangle>\<^sub>e\<succ> {G\<rightarrow>}".
  1.1320 +      show "G,A\<turnstile>{=:n} \<langle>e1.[e2]\<rangle>\<^sub>v\<succ> {G\<rightarrow>}"
  1.1321 +	apply (rule MGFn_NormalI)
  1.1322 +	apply (rule ax_derivs.AVar)
  1.1323 +	apply  (rule MGFnD [OF mgf_e1, THEN ax_NormalD])
  1.1324 +	apply (rule allI)
  1.1325 +	apply (rule MGFnD' [OF mgf_e2, THEN conseq12])
  1.1326 +	apply (fastsimp intro: eval.AVar)
  1.1327 +	done
  1.1328 +    next
  1.1329 +      case (InsInitV c v)
  1.1330 +      show ?case
  1.1331 +	by (rule MGFn_NormalI) (rule ax_derivs.InsInitV)
  1.1332 +    next
  1.1333 +      case (NewC C)
  1.1334 +      show ?case
  1.1335 +	apply (rule MGFn_NormalI)
  1.1336 +	apply (rule ax_derivs.NewC)
  1.1337 +	apply (rule MGFn_InitD [OF hyp, THEN conseq2])
  1.1338 +	apply (fastsimp intro: eval.NewC)
  1.1339 +	done
  1.1340 +    next
  1.1341 +      case (NewA T e)
  1.1342 +      thus ?case
  1.1343 +	apply -
  1.1344 +	apply (rule MGFn_NormalI) 
  1.1345 +	apply (rule ax_derivs.NewA 
  1.1346 +               [where ?Q = "(\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>In1r (init_comp_ty T) 
  1.1347 +                              \<succ>\<rightarrow> (Y',s')) \<and>. G\<turnstile>init\<le>n"])
  1.1348 +	apply  (simp add: init_comp_ty_def split add: split_if)
  1.1349 +	apply  (rule conjI, clarsimp)
  1.1350 +	apply   (rule MGFn_InitD [OF hyp, THEN conseq2])
  1.1351 +	apply   (clarsimp intro: eval.Init)
  1.1352 +	apply  clarsimp
  1.1353 +	apply  (rule ax_derivs.Skip [THEN conseq1])
  1.1354 +	apply  (clarsimp intro: eval.Skip)
  1.1355 +	apply (erule MGFnD' [THEN conseq12])
  1.1356 +	apply (fastsimp intro: eval.NewA)
  1.1357 +	done
  1.1358 +    next
  1.1359 +      case (Cast C e)
  1.1360 +      thus ?case
  1.1361 +	apply -
  1.1362 +	apply (rule MGFn_NormalI)
  1.1363 +	apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Cast])
  1.1364 +	apply (fastsimp intro: eval.Cast)
  1.1365 +	done
  1.1366 +    next
  1.1367 +      case (Inst e C)
  1.1368 +      thus ?case
  1.1369 +	apply -
  1.1370 +	apply (rule MGFn_NormalI)
  1.1371 +	apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Inst])
  1.1372 +	apply (fastsimp intro: eval.Inst)
  1.1373 +	done
  1.1374 +    next
  1.1375 +      case (Lit v)
  1.1376 +      show ?case
  1.1377 +	apply -
  1.1378 +	apply (rule MGFn_NormalI)
  1.1379 +	apply (rule ax_derivs.Lit [THEN conseq1])
  1.1380 +	apply (fastsimp intro: eval.Lit)
  1.1381 +	done
  1.1382 +    next
  1.1383 +      case (UnOp unop e)
  1.1384 +      thus ?case
  1.1385 +	apply -
  1.1386 +	apply (rule MGFn_NormalI)
  1.1387 +	apply (rule ax_derivs.UnOp)
  1.1388 +	apply (erule MGFnD' [THEN conseq12])
  1.1389 +	apply (fastsimp intro: eval.UnOp)
  1.1390 +	done
  1.1391 +    next
  1.1392 +      case (BinOp binop e1 e2)
  1.1393 +      thus ?case
  1.1394 +	apply -
  1.1395 +	apply (rule MGFn_NormalI)
  1.1396 +	apply (rule ax_derivs.BinOp)
  1.1397 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1398 +	apply (rule allI)
  1.1399 +	apply (case_tac "need_second_arg binop__ v1")
  1.1400 +	apply  simp
  1.1401 +	apply  (erule MGFnD' [THEN conseq12])
  1.1402 +	apply  (fastsimp intro: eval.BinOp)
  1.1403 +	apply simp
  1.1404 +	apply (rule ax_Normal_cases)
  1.1405 +	apply  (rule ax_derivs.Skip [THEN conseq1])
  1.1406 +	apply  clarsimp
  1.1407 +	apply  (rule eval_BinOp_arg2_indepI)
  1.1408 +	apply   simp
  1.1409 +	apply  simp
  1.1410 +	apply (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
  1.1411 +	apply (fastsimp intro: eval.BinOp)
  1.1412 +	done
  1.1413 +    next
  1.1414 +      case Super
  1.1415 +      show ?case
  1.1416 +	apply -
  1.1417 +	apply (rule MGFn_NormalI)
  1.1418 +	apply (rule ax_derivs.Super [THEN conseq1])
  1.1419 +	apply (fastsimp intro: eval.Super)
  1.1420 +	done
  1.1421 +    next
  1.1422 +      case (Acc v)
  1.1423 +      thus ?case
  1.1424 +	apply -
  1.1425 +	apply (rule MGFn_NormalI)
  1.1426 +	apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Acc])
  1.1427 +	apply (fastsimp intro: eval.Acc simp add: split_paired_all)
  1.1428 +	done
  1.1429 +    next
  1.1430 +      case (Ass v e)
  1.1431 +      thus "G,A\<turnstile>{=:n} \<langle>v:=e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1432 +	apply -
  1.1433 +	apply (rule MGFn_NormalI)
  1.1434 +	apply (rule ax_derivs.Ass)
  1.1435 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1436 +	apply (rule allI)
  1.1437 +	apply (erule MGFnD'[THEN conseq12])
  1.1438 +	apply (fastsimp intro: eval.Ass simp add: split_paired_all)
  1.1439 +	done
  1.1440 +    next
  1.1441 +      case (Cond e1 e2 e3)
  1.1442 +      thus "G,A\<turnstile>{=:n} \<langle>e1 ? e2 : e3\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1443 +	apply -
  1.1444 +	apply (rule MGFn_NormalI)
  1.1445 +	apply (rule ax_derivs.Cond)
  1.1446 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1447 +	apply (rule allI)
  1.1448 +	apply (rule ax_Normal_cases)
  1.1449 +	prefer 2
  1.1450 +	apply  (rule ax_derivs.Abrupt [THEN conseq1],clarsimp simp add: Let_def)
  1.1451 +	apply  (fastsimp intro: eval.Cond)
  1.1452 +	apply (case_tac "b")
  1.1453 +	apply  simp
  1.1454 +	apply  (erule MGFnD'[THEN conseq12])
  1.1455 +	apply  (fastsimp intro: eval.Cond)
  1.1456 +	apply simp
  1.1457 +	apply (erule MGFnD'[THEN conseq12])
  1.1458 +	apply (fastsimp intro: eval.Cond)
  1.1459 +	done
  1.1460 +    next
  1.1461 +      case (Call accC statT mode e mn pTs' ps)
  1.1462 +      have mgf_e:  "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}".
  1.1463 +      have mgf_ps: "G,A\<turnstile>{=:n} \<langle>ps\<rangle>\<^sub>l\<succ> {G\<rightarrow>}".
  1.1464 +      from mgf_methds mgf_e mgf_ps wf
  1.1465 +      show "G,A\<turnstile>{=:n} \<langle>{accC,statT,mode}e\<cdot>mn({pTs'}ps)\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1466 +	by (rule MGFn_Call)
  1.1467 +    next
  1.1468 +      case (Methd D mn)
  1.1469 +      from mgf_methds
  1.1470 +      show "G,A\<turnstile>{=:n} \<langle>Methd D mn\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1471 +	by simp
  1.1472 +    next
  1.1473 +      case (Body D c)
  1.1474 +      have mgf_c: "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}" .
  1.1475 +      from wf MGFn_Init [OF hyp] mgf_c
  1.1476 +      show "G,A\<turnstile>{=:n} \<langle>Body D c\<rangle>\<^sub>e\<succ> {G\<rightarrow>}"
  1.1477 +	by (rule MGFn_Body)
  1.1478 +    next
  1.1479 +      case (InsInitE c e)
  1.1480 +      show ?case
  1.1481 +	by (rule MGFn_NormalI) (rule ax_derivs.InsInitE)
  1.1482 +    next
  1.1483 +      case (Callee l e)
  1.1484 +      show ?case
  1.1485 +	by (rule MGFn_NormalI) (rule ax_derivs.Callee)
  1.1486 +    next
  1.1487 +      case Skip
  1.1488 +      show ?case
  1.1489 +	apply -
  1.1490 +	apply (rule MGFn_NormalI)
  1.1491 +	apply (rule ax_derivs.Skip [THEN conseq1])
  1.1492 +	apply (fastsimp intro: eval.Skip)
  1.1493 +	done
  1.1494 +    next
  1.1495 +      case (Expr e)
  1.1496 +      thus ?case
  1.1497 +	apply -
  1.1498 +	apply (rule MGFn_NormalI)
  1.1499 +	apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Expr])
  1.1500 +	apply (fastsimp intro: eval.Expr)
  1.1501 +	done
  1.1502 +    next
  1.1503 +      case (Lab l c)
  1.1504 +      thus "G,A\<turnstile>{=:n} \<langle>l\<bullet> c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1505 +	apply -
  1.1506 +	apply (rule MGFn_NormalI)
  1.1507 +	apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Lab])
  1.1508 +	apply (fastsimp intro: eval.Lab)
  1.1509 +	done
  1.1510 +    next
  1.1511 +      case (Comp c1 c2)
  1.1512 +      thus "G,A\<turnstile>{=:n} \<langle>c1;; c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1513 +	apply -
  1.1514 +	apply (rule MGFn_NormalI)
  1.1515 +	apply (rule ax_derivs.Comp)
  1.1516 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1517 +	apply (erule MGFnD' [THEN conseq12])
  1.1518 +	apply (fastsimp intro: eval.Comp) 
  1.1519 +	done
  1.1520 +    next
  1.1521 +      case (If_ e c1 c2)
  1.1522 +      thus "G,A\<turnstile>{=:n} \<langle>If(e) c1 Else c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1523 +	apply -
  1.1524 +	apply (rule MGFn_NormalI)
  1.1525 +	apply (rule ax_derivs.If)
  1.1526 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1527 +	apply (rule allI)
  1.1528 +	apply (rule ax_Normal_cases)
  1.1529 +	prefer 2
  1.1530 +	apply  (rule ax_derivs.Abrupt [THEN conseq1],clarsimp simp add: Let_def)
  1.1531 +	apply  (fastsimp intro: eval.If)
  1.1532 +	apply (case_tac "b")
  1.1533 +	apply  simp
  1.1534 +	apply  (erule MGFnD' [THEN conseq12])
  1.1535 +	apply  (fastsimp intro: eval.If)
  1.1536 +	apply simp
  1.1537 +	apply (erule MGFnD' [THEN conseq12])
  1.1538 +	apply (fastsimp intro: eval.If)
  1.1539 +	done
  1.1540 +    next
  1.1541 +      case (Loop l e c)
  1.1542 +      have mgf_e: "G,A\<turnstile>{=:n} \<langle>e\<rangle>\<^sub>e\<succ> {G\<rightarrow>}".
  1.1543 +      have mgf_c: "G,A\<turnstile>{=:n} \<langle>c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}".
  1.1544 +      from mgf_e mgf_c wf
  1.1545 +      show "G,A\<turnstile>{=:n} \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1546 +	by (rule MGFn_Loop)
  1.1547 +    next
  1.1548 +      case (Jmp j)
  1.1549 +      thus ?case
  1.1550 +	apply -
  1.1551 +	apply (rule MGFn_NormalI)
  1.1552 +	apply (rule ax_derivs.Jmp [THEN conseq1])
  1.1553 +	apply (auto intro: eval.Jmp simp add: abupd_def2)
  1.1554 +	done
  1.1555 +    next
  1.1556 +      case (Throw e)
  1.1557 +      thus ?case
  1.1558 +	apply -
  1.1559 +	apply (rule MGFn_NormalI)
  1.1560 +	apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Throw])
  1.1561 +	apply (fastsimp intro: eval.Throw)
  1.1562 +	done
  1.1563 +    next
  1.1564 +      case (TryC c1 C vn c2)
  1.1565 +      thus "G,A\<turnstile>{=:n} \<langle>Try c1 Catch(C vn) c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1566 +	apply -
  1.1567 +	apply (rule MGFn_NormalI)
  1.1568 +	apply (rule ax_derivs.Try [where 
  1.1569 +          ?Q = " (\<lambda>Y' s' s. normal s \<and> (\<exists>s''. G\<turnstile>s \<midarrow>\<langle>c1\<rangle>\<^sub>s\<succ>\<rightarrow> (Y',s'') \<and> 
  1.1570 +                            G\<turnstile>s'' \<midarrow>sxalloc\<rightarrow> s')) \<and>. G\<turnstile>init\<le>n"])
  1.1571 +	apply   (erule MGFnD [THEN ax_NormalD, THEN conseq2])
  1.1572 +	apply   (fastsimp elim: sxalloc_gext [THEN card_nyinitcls_gext])
  1.1573 +	apply  (erule MGFnD'[THEN conseq12])
  1.1574 +	apply  (fastsimp intro: eval.Try)
  1.1575 +	apply (fastsimp intro: eval.Try)
  1.1576 +	done
  1.1577 +    next
  1.1578 +      case (Fin c1 c2)
  1.1579 +      have mgf_c1: "G,A\<turnstile>{=:n} \<langle>c1\<rangle>\<^sub>s\<succ> {G\<rightarrow>}".
  1.1580 +      have mgf_c2: "G,A\<turnstile>{=:n} \<langle>c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}".
  1.1581 +      from wf mgf_c1 mgf_c2
  1.1582 +      show "G,A\<turnstile>{=:n} \<langle>c1 Finally c2\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1583 +	by (rule MGFn_Fin)
  1.1584 +    next
  1.1585 +      case (FinA abr c)
  1.1586 +      show ?case
  1.1587 +	by (rule MGFn_NormalI) (rule ax_derivs.FinA)
  1.1588 +    next
  1.1589 +      case (Init C)
  1.1590 +      from hyp
  1.1591 +      show "G,A\<turnstile>{=:n} \<langle>Init C\<rangle>\<^sub>s\<succ> {G\<rightarrow>}"
  1.1592 +	by (rule MGFn_Init)
  1.1593 +    next
  1.1594 +      case Nil_expr
  1.1595 +      show "G,A\<turnstile>{=:n} \<langle>[]\<rangle>\<^sub>l\<succ> {G\<rightarrow>}"
  1.1596 +	apply -
  1.1597 +	apply (rule MGFn_NormalI)
  1.1598 +	apply (rule ax_derivs.Nil [THEN conseq1])
  1.1599 +	apply (fastsimp intro: eval.Nil)
  1.1600 +	done
  1.1601 +    next
  1.1602 +      case (Cons_expr e es)
  1.1603 +      thus "G,A\<turnstile>{=:n} \<langle>e# es\<rangle>\<^sub>l\<succ> {G\<rightarrow>}"
  1.1604 +	apply -
  1.1605 +	apply (rule MGFn_NormalI)
  1.1606 +	apply (rule ax_derivs.Cons)
  1.1607 +	apply  (erule MGFnD [THEN ax_NormalD])
  1.1608 +	apply (rule allI)
  1.1609 +	apply (erule MGFnD'[THEN conseq12])
  1.1610 +	apply (fastsimp intro: eval.Cons)
  1.1611 +	done
  1.1612 +    qed
  1.1613 +  }
  1.1614 +  thus ?thesis
  1.1615 +    by (cases rule: term_cases) auto
  1.1616 +  qed
  1.1617 +qed
  1.1618  
  1.1619  lemma MGF_asm: 
  1.1620  "\<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.1621 @@ -643,70 +1401,55 @@
  1.1622  apply assumption (* wf_prog G *)
  1.1623  done
  1.1624  
  1.1625 -declare splitI2 [intro!]
  1.1626 -ML_setup {*
  1.1627 -Addsimprocs [ eval_expr_proc, eval_var_proc, eval_exprs_proc, eval_stmt_proc]
  1.1628 -*}
  1.1629 -
  1.1630 -
  1.1631  section "nested version"
  1.1632  
  1.1633 -lemma nesting_lemma' [rule_format (no_asm)]: "[| !!A ts. ts <= A ==> P A ts; 
  1.1634 -  !!A pn. !b:bdy pn. P (insert (mgf_call pn) A) {mgf b} ==> P A {mgf_call pn}; 
  1.1635 -  !!A t. !pn:U. P A {mgf_call pn} ==> P A {mgf t};  
  1.1636 -          finite U; uA = mgf_call`U |] ==>  
  1.1637 -  !A. A <= uA --> n <= card uA --> card A = card uA - n --> (!t. P A {mgf t})"
  1.1638 -proof -
  1.1639 -  assume ax_derivs_asm:    "!!A ts. ts <= A ==> P A ts"
  1.1640 -  assume MGF_nested_Methd: "!!A pn. !b:bdy pn. P (insert (mgf_call pn) A) 
  1.1641 -                                                  {mgf b} ==> P A {mgf_call pn}"
  1.1642 -  assume MGF_asm:          "!!A t. !pn:U. P A {mgf_call pn} ==> P A {mgf t}"
  1.1643 -  assume "finite U" "uA = mgf_call`U"
  1.1644 -  then show ?thesis
  1.1645 -    apply -
  1.1646 -    apply (induct_tac "n")
  1.1647 -    apply  (tactic "ALLGOALS Clarsimp_tac")
  1.1648 -    apply  (tactic "dtac (permute_prems 0 1 card_seteq) 1")
  1.1649 -    apply    simp
  1.1650 -    apply   (erule finite_imageI)
  1.1651 -    apply  (simp add: MGF_asm ax_derivs_asm)
  1.1652 -    apply (rule MGF_asm)
  1.1653 -    apply (rule ballI)
  1.1654 -    apply (case_tac "mgf_call pn : A")
  1.1655 -    apply  (fast intro: ax_derivs_asm)
  1.1656 -    apply (rule MGF_nested_Methd)
  1.1657 -    apply (rule ballI)
  1.1658 -    apply (drule spec, erule impE, erule_tac [2] impE, erule_tac [3] spec)
  1.1659 -    apply   fast
  1.1660 -    apply (drule finite_subset)
  1.1661 -    apply (erule finite_imageI)
  1.1662 -    apply auto
  1.1663 -    apply arith
  1.1664 -  done
  1.1665 -qed
  1.1666 +lemma nesting_lemma' [rule_format (no_asm)]: 
  1.1667 +  assumes ax_derivs_asm: "\<And>A ts. ts \<subseteq> A \<Longrightarrow> P A ts" 
  1.1668 +  and MGF_nested_Methd: "\<And>A pn. \<forall>b\<in>bdy pn. P (insert (mgf_call pn) A) {mgf b}
  1.1669 +                                  \<Longrightarrow> P A {mgf_call pn}"
  1.1670 +  and MGF_asm: "\<And>A t. \<forall>pn\<in>U. P A {mgf_call pn} \<Longrightarrow> P A {mgf t}"
  1.1671 +  and finU: "finite U"
  1.1672 +  and uA: "uA = mgf_call`U"
  1.1673 +  shows "\<forall>A. A \<subseteq> uA \<longrightarrow> n \<le> card uA \<longrightarrow> card A = card uA - n 
  1.1674 +             \<longrightarrow> (\<forall>t. P A {mgf t})"
  1.1675 +using finU uA
  1.1676 +apply -
  1.1677 +apply (induct_tac "n")
  1.1678 +apply  (tactic "ALLGOALS Clarsimp_tac")
  1.1679 +apply  (tactic "dtac (permute_prems 0 1 card_seteq) 1")
  1.1680 +apply    simp
  1.1681 +apply   (erule finite_imageI)
  1.1682 +apply  (simp add: MGF_asm ax_derivs_asm)
  1.1683 +apply (rule MGF_asm)
  1.1684 +apply (rule ballI)
  1.1685 +apply (case_tac "mgf_call pn : A")
  1.1686 +apply  (fast intro: ax_derivs_asm)
  1.1687 +apply (rule MGF_nested_Methd)
  1.1688 +apply (rule ballI)
  1.1689 +apply (drule spec, erule impE, erule_tac [2] impE, erule_tac [3] spec)
  1.1690 +apply   fast
  1.1691 +apply (drule finite_subset)
  1.1692 +apply (erule finite_imageI)
  1.1693 +apply auto
  1.1694 +apply arith
  1.1695 +done
  1.1696  
  1.1697 -lemma nesting_lemma [rule_format (no_asm)]: "[| !!A ts. ts <= A ==> P A ts; 
  1.1698 -  !!A pn. !b:bdy pn. P (insert (mgf (f pn)) A) {mgf b} ==> P A {mgf (f pn)}; 
  1.1699 -          !!A t. !pn:U. P A {mgf (f pn)} ==> P A {mgf t}; 
  1.1700 -          finite U |] ==> P {} {mgf t}"
  1.1701 -proof -
  1.1702 -  assume 2: "!!A pn. !b:bdy pn. P (insert (mgf (f pn)) A) {mgf b} ==> P A {mgf (f pn)}"
  1.1703 -  assume 3: "!!A t. !pn:U. P A {mgf (f pn)} ==> P A {mgf t}"
  1.1704 -  assume "!!A ts. ts <= A ==> P A ts" "finite U"
  1.1705 -  then show ?thesis
  1.1706 -    apply -
  1.1707 -    apply (rule_tac mgf = "mgf" in nesting_lemma')
  1.1708 -    apply (erule_tac [2] 2)
  1.1709 -    apply (rule_tac [2] 3)
  1.1710 -    apply (rule_tac [6] le_refl)
  1.1711 -    apply auto
  1.1712 -  done
  1.1713 -qed
  1.1714 +
  1.1715 +lemma nesting_lemma [rule_format (no_asm)]:
  1.1716 +  assumes ax_derivs_asm: "\<And>A ts. ts \<subseteq> A \<Longrightarrow> P A ts"
  1.1717 +  and MGF_nested_Methd: "\<And>A pn. \<forall>b\<in>bdy pn. P (insert (mgf (f pn)) A) {mgf b}
  1.1718 +                                  \<Longrightarrow> P A {mgf (f pn)}"
  1.1719 +  and MGF_asm: "\<And>A t. \<forall>pn\<in>U. P A {mgf (f pn)} \<Longrightarrow> P A {mgf t}"
  1.1720 +  and finU: "finite U"
  1.1721 +shows "P {} {mgf t}"
  1.1722 +using ax_derivs_asm MGF_nested_Methd MGF_asm finU
  1.1723 +by (rule nesting_lemma') (auto intro!: le_refl)
  1.1724 +
  1.1725  
  1.1726  lemma MGF_nested_Methd: "\<lbrakk>  
  1.1727 -  G,insert ({Normal \<doteq>} In1l (Methd  C sig) \<succ>{G\<rightarrow>}) A\<turnstile>  
  1.1728 -            {Normal \<doteq>} In1l (body G C sig) \<succ>{G\<rightarrow>}  
  1.1729 - \<rbrakk> \<Longrightarrow>  G,A\<turnstile>{Normal \<doteq>} In1l (Methd  C sig) \<succ>{G\<rightarrow>}"
  1.1730 + G,insert ({Normal \<doteq>} \<langle>Methd  C sig\<rangle>\<^sub>e \<succ>{G\<rightarrow>}) A
  1.1731 +    \<turnstile>{Normal \<doteq>} \<langle>body G C sig\<rangle>\<^sub>e \<succ>{G\<rightarrow>}  
  1.1732 + \<rbrakk> \<Longrightarrow>  G,A\<turnstile>{Normal \<doteq>}  \<langle>Methd  C sig\<rangle>\<^sub>e \<succ>{G\<rightarrow>}"
  1.1733  apply (unfold MGF_def)
  1.1734  apply (rule ax_MethdN)
  1.1735  apply (erule conseq2)
  1.1736 @@ -717,8 +1460,8 @@
  1.1737  lemma MGF_deriv: "wf_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
  1.1738  apply (rule MGFNormalI)
  1.1739  apply (rule_tac mgf = "\<lambda>t. {Normal \<doteq>} t\<succ> {G\<rightarrow>}" and 
  1.1740 -                bdy = "\<lambda> (C,sig) .{In1l (body G C sig) }" and 
  1.1741 -                f = "\<lambda> (C,sig) . In1l (Methd C sig) " in nesting_lemma)
  1.1742 +                bdy = "\<lambda> (C,sig) .{\<langle>body G C sig\<rangle>\<^sub>e }" and 
  1.1743 +                f = "\<lambda> (C,sig) . \<langle>Methd C sig\<rangle>\<^sub>e " in nesting_lemma)
  1.1744  apply    (erule ax_derivs.asm)
  1.1745  apply   (clarsimp simp add: split_tupled_all)
  1.1746  apply   (erule MGF_nested_Methd)
  1.1747 @@ -731,9 +1474,9 @@
  1.1748  section "simultaneous version"
  1.1749  
  1.1750  lemma MGF_simult_Methd_lemma: "finite ms \<Longrightarrow>  
  1.1751 -  G,A\<union> (\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd  C sig)\<succ> {G\<rightarrow>}) ` ms  
  1.1752 -     |\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (body G C sig)\<succ> {G\<rightarrow>}) ` ms \<Longrightarrow>  
  1.1753 -  G,A|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd  C sig)\<succ> {G\<rightarrow>}) ` ms"
  1.1754 +  G,A \<union> (\<lambda>(C,sig). {Normal \<doteq>} \<langle>Methd  C sig\<rangle>\<^sub>e\<succ> {G\<rightarrow>}) ` ms  
  1.1755 +      |\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} \<langle>body G C sig\<rangle>\<^sub>e\<succ> {G\<rightarrow>}) ` ms \<Longrightarrow>  
  1.1756 +  G,A|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} \<langle>Methd  C sig\<rangle>\<^sub>e\<succ> {G\<rightarrow>}) ` ms"
  1.1757  apply (unfold MGF_def)
  1.1758  apply (rule ax_derivs.Methd [unfolded mtriples_def])
  1.1759  apply (erule ax_finite_pointwise)
  1.1760 @@ -748,7 +1491,7 @@
  1.1761  done
  1.1762  
  1.1763  lemma MGF_simult_Methd: "wf_prog G \<Longrightarrow> 
  1.1764 -   G,({}::state triple set)|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>}) 
  1.1765 +   G,({}::state triple set)|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} \<langle>Methd C sig\<rangle>\<^sub>e\<succ> {G\<rightarrow>}) 
  1.1766     ` Collect (split (is_methd G)) "
  1.1767  apply (frule finite_is_methd [OF wf_ws_prog])
  1.1768  apply (rule MGF_simult_Methd_lemma)
  1.1769 @@ -772,20 +1515,48 @@
  1.1770  apply   (force intro: evaln.Abrupt)
  1.1771  done
  1.1772  
  1.1773 -lemma MGF_complete: 
  1.1774 - "\<lbrakk>G,{}\<Turnstile>{P} t\<succ> {Q}; G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}; wf_prog G\<rbrakk> 
  1.1775 -  \<Longrightarrow> G,({}::state triple set)\<turnstile>{P::state assn} t\<succ> {Q}"
  1.1776 -apply (rule ax_no_hazard)
  1.1777 -apply (unfold MGF_def)
  1.1778 -apply (erule conseq12)
  1.1779 -apply (simp (no_asm_use) add: ax_valids_def triple_valid_def)
  1.1780 -apply (blast dest: eval_to_evaln)
  1.1781 -done
  1.1782 -
  1.1783 -theorem ax_complete: "wf_prog G \<Longrightarrow>  
  1.1784 -  G,{}\<Turnstile>{P::state assn} t\<succ> {Q} \<Longrightarrow> G,({}::state triple set)\<turnstile>{P} t\<succ> {Q}"
  1.1785 -apply (erule MGF_complete)
  1.1786 -apply (erule (1) MGF_deriv)
  1.1787 -done
  1.1788 -
  1.1789 +lemma MGF_complete:
  1.1790 +  assumes valid: "G,{}\<Turnstile>{P} t\<succ> {Q}"
  1.1791 +  and     mgf: "G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
  1.1792 +  and      wf: "wf_prog G"
  1.1793 +  shows "G,({}::state triple set)\<turnstile>{P::state assn} t\<succ> {Q}"
  1.1794 +proof (rule ax_no_hazard)
  1.1795 +  from mgf
  1.1796 +  have "G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y, s')}"  
  1.1797 +    by  (unfold MGF_def) 
  1.1798 +  thus "G,({}::state triple set)\<turnstile>{P \<and>. type_ok G t} t\<succ> {Q}"
  1.1799 +  proof (rule conseq12,clarsimp)
  1.1800 +    fix Y s Z Y' s'
  1.1801 +    assume P: "P Y s Z"
  1.1802 +    assume type_ok: "type_ok G t s"
  1.1803 +    assume eval_t: "G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y', s')"
  1.1804 +    show "Q Y' s' Z"
  1.1805 +    proof -
  1.1806 +      from eval_t type_ok wf 
  1.1807 +      obtain n where evaln: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y', s')"
  1.1808 +	by (rule eval_to_evaln [elim_format]) rules
  1.1809 +      from valid have 
  1.1810 +	valid_expanded:
  1.1811 +	"\<forall>n Y s Z. P Y s Z \<longrightarrow> type_ok G t s 
  1.1812 +                   \<longrightarrow> (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y', s') \<longrightarrow> Q Y' s' Z)"
  1.1813 +	by (simp add: ax_valids_def triple_valid_def)
  1.1814 +      from P type_ok evaln
  1.1815 +      show "Q Y' s' Z"
  1.1816 +	by (rule valid_expanded [rule_format])
  1.1817 +    qed
  1.1818 +  qed 
  1.1819 +qed
  1.1820 +   
  1.1821 +theorem ax_complete: 
  1.1822 +  assumes wf: "wf_prog G" 
  1.1823 +  and valid: "G,{}\<Turnstile>{P::state assn} t\<succ> {Q}"
  1.1824 +  shows "G,({}::state triple set)\<turnstile>{P} t\<succ> {Q}"
  1.1825 +proof -
  1.1826 +  from wf have "G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
  1.1827 +    by (rule MGF_deriv)
  1.1828 +  from valid this wf
  1.1829 +  show ?thesis
  1.1830 +    by (rule MGF_complete)
  1.1831 +qed
  1.1832 + 
  1.1833  end
     2.1 --- a/src/HOL/Bali/AxExample.thy	Wed Oct 30 12:44:18 2002 +0100
     2.2 +++ b/src/HOL/Bali/AxExample.thy	Thu Oct 31 18:27:10 2002 +0100
     2.3 @@ -52,10 +52,13 @@
     2.4  
     2.5  theorem ax_test: "tprg,({}::'a triple set)\<turnstile> 
     2.6    {Normal (\<lambda>Y s Z::'a. heap_free four s \<and> \<not>initd Base s \<and> \<not> initd Ext s)} 
     2.7 -  .test [Class Base]. {\<lambda>Y s Z. abrupt s = Some (Xcpt (Std IndOutBound))}"
     2.8 +  .test [Class Base]. 
     2.9 +  {\<lambda>Y s Z. abrupt s = Some (Xcpt (Std IndOutBound))}"
    2.10  apply (unfold test_def arr_viewed_from_def)
    2.11  apply (tactic "ax_tac 1" (*;;*))
    2.12 -defer
    2.13 +defer (* We begin with the last assertion, to synthesise the intermediate
    2.14 +         assertions, like in the fashion of the weakest
    2.15 +         precondition. *)
    2.16  apply  (tactic "ax_tac 1" (* Try *))
    2.17  defer
    2.18  apply    (tactic {* inst1_tac "Q1" 
    2.19 @@ -108,11 +111,18 @@
    2.20  (* apply       (rule_tac [2] ax_derivs.Abrupt) *)
    2.21  defer
    2.22  apply      (simp (no_asm))
    2.23 -apply      (tactic "ax_tac 1")
    2.24 +apply      (tactic "ax_tac 1") (* Comp *)
    2.25 +            (* The first statement in the  composition 
    2.26 +                 ((Ext)z).vee = 1; Return Null 
    2.27 +                will throw an exception (since z is null). So we can handle
    2.28 +                Return Null with the Abrupt rule *)
    2.29 +apply       (rule_tac [2] ax_derivs.Abrupt)
    2.30 +             
    2.31 +apply      (rule ax_derivs.Expr) (* Expr *)
    2.32  apply      (tactic "ax_tac 1") (* Ass *)
    2.33  prefer 2
    2.34  apply       (rule ax_subst_Var_allI)
    2.35 -apply       (tactic {* inst1_tac "P'27" "\<lambda>a vs l vf. ?PP a vs l vf\<leftarrow>?x \<and>. ?p" *})
    2.36 +apply       (tactic {* inst1_tac "P'29" "\<lambda>a vs l vf. ?PP a vs l vf\<leftarrow>?x \<and>. ?p" *})
    2.37  apply       (rule allI)
    2.38  apply       (tactic {* simp_tac (simpset() delloop "split_all_tac" delsimps [thm "peek_and_def2"]) 1 *})
    2.39  apply       (rule ax_derivs.Abrupt)
    2.40 @@ -120,11 +130,10 @@
    2.41  apply      (tactic "ax_tac 1" (* FVar *))
    2.42  apply       (tactic "ax_tac 2", tactic "ax_tac 2", tactic "ax_tac 2")
    2.43  apply      (tactic "ax_tac 1")
    2.44 -apply     clarsimp
    2.45  apply     (tactic {* inst1_tac "R14" "\<lambda>a'. Normal ((\<lambda>Vals:vs (x, s) Z. arr_inv s \<and> inited Ext (globs s) \<and> a' \<noteq> Null \<and> hd vs = Null) \<and>. heap_free two)" *})
    2.46 -prefer 5
    2.47 -apply     (rule ax_derivs.Done [THEN conseq1], force)
    2.48 -apply    force
    2.49 +apply     fastsimp
    2.50 +prefer 4
    2.51 +apply    (rule ax_derivs.Done [THEN conseq1],force)
    2.52  apply   (rule ax_subst_Val_allI)
    2.53  apply   (tactic {* inst1_tac "P'33" "\<lambda>u a. Normal (?PP a\<leftarrow>?x) u" *})
    2.54  apply   (simp (no_asm) del: peek_and_def2)
     3.1 --- a/src/HOL/Bali/AxSem.thy	Wed Oct 30 12:44:18 2002 +0100
     3.2 +++ b/src/HOL/Bali/AxSem.thy	Thu Oct 31 18:27:10 2002 +0100
     3.3 @@ -39,7 +39,7 @@
     3.4  \end{itemize}
     3.5  *}
     3.6  
     3.7 -types  res = vals (* result entry *)
     3.8 +types  res = vals --{* result entry *}
     3.9  syntax
    3.10    Val  :: "val      \<Rightarrow> res"
    3.11    Var  :: "var      \<Rightarrow> res"
    3.12 @@ -59,7 +59,7 @@
    3.13    "\<lambda>Var:v . b"  == "(\<lambda>v. b) \<circ> the_In2"
    3.14    "\<lambda>Vals:v. b"  == "(\<lambda>v. b) \<circ> the_In3"
    3.15  
    3.16 -  (* relation on result values, state and auxiliary variables *)
    3.17 +  --{* relation on result values, state and auxiliary variables *}
    3.18  types 'a assn   =        "res \<Rightarrow> state \<Rightarrow> 'a \<Rightarrow> bool"
    3.19  translations
    3.20        "res"    <= (type) "AxSem.res"
    3.21 @@ -377,7 +377,10 @@
    3.22  
    3.23  constdefs
    3.24    type_ok  :: "prog \<Rightarrow> term \<Rightarrow> state \<Rightarrow> bool"
    3.25 - "type_ok G t s \<equiv> \<exists>L T C. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<and> s\<Colon>\<preceq>(G,L)"
    3.26 + "type_ok G t s \<equiv> 
    3.27 +    \<exists>L T C A. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T \<and> 
    3.28 +                            \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>A )
    3.29 +              \<and> s\<Colon>\<preceq>(G,L)"
    3.30  
    3.31  datatype    'a triple = triple "('a assn)" "term" "('a assn)" (** should be
    3.32  something like triple = \<forall>'a. triple ('a assn) term ('a assn)   **)
    3.33 @@ -468,8 +471,10 @@
    3.34  
    3.35  lemma triple_valid_def2: "G\<Turnstile>n:{P} t\<succ> {Q} =  
    3.36   (\<forall>Y s Z. P Y s Z 
    3.37 -  \<longrightarrow> (\<exists>L. (normal s \<longrightarrow> (\<exists>T C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T)) \<and> s\<Colon>\<preceq>(G,L)) \<longrightarrow> 
    3.38 -  (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s')\<longrightarrow> Q Y' s' Z))"
    3.39 +  \<longrightarrow> (\<exists>L. (normal s \<longrightarrow> (\<exists> C T A. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T \<and> 
    3.40 +                   \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>A)) \<and> 
    3.41 +           s\<Colon>\<preceq>(G,L))
    3.42 +  \<longrightarrow> (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s')\<longrightarrow> Q Y' s' Z))"
    3.43  apply (unfold triple_valid_def type_ok_def)
    3.44  apply (simp (no_asm))
    3.45  done
    3.46 @@ -506,7 +511,7 @@
    3.47  
    3.48    Abrupt:  "G,A\<turnstile>{P\<leftarrow>(arbitrary3 t) \<and>. Not \<circ> normal} t\<succ> {P}"
    3.49  
    3.50 -  (* variables *)
    3.51 +  --{* variables *}
    3.52    LVar:  " G,A\<turnstile>{Normal (\<lambda>s.. P\<leftarrow>Var (lvar vn s))} LVar vn=\<succ> {P}"
    3.53  
    3.54    FVar: "\<lbrakk>G,A\<turnstile>{Normal P} .Init C. {Q};
    3.55 @@ -516,7 +521,7 @@
    3.56    AVar:  "\<lbrakk>G,A\<turnstile>{Normal P} e1-\<succ> {Q};
    3.57            \<forall>a. G,A\<turnstile>{Q\<leftarrow>Val a} e2-\<succ> {\<lambda>Val:i:. avar G i a ..; R}\<rbrakk> \<Longrightarrow>
    3.58                                   G,A\<turnstile>{Normal P} e1.[e2]=\<succ> {R}"
    3.59 -  (* expressions *)
    3.60 +  --{* expressions *}
    3.61  
    3.62    NewC: "\<lbrakk>G,A\<turnstile>{Normal P} .Init C. {Alloc G (CInst C) Q}\<rbrakk> \<Longrightarrow>
    3.63                                   G,A\<turnstile>{Normal P} NewC C-\<succ> {Q}"
    3.64 @@ -579,7 +584,7 @@
    3.65      \<Longrightarrow>
    3.66                                   G,A\<turnstile>{Normal P} Body D c-\<succ> {R}"
    3.67    
    3.68 -  (* expression lists *)
    3.69 +  --{* expression lists *}
    3.70  
    3.71    Nil:                          "G,A\<turnstile>{Normal (P\<leftarrow>Vals [])} []\<doteq>\<succ> {P}"
    3.72  
    3.73 @@ -587,7 +592,7 @@
    3.74            \<forall>v. G,A\<turnstile>{Q\<leftarrow>Val v} es\<doteq>\<succ> {\<lambda>Vals:vs:. R\<leftarrow>Vals (v#vs)}\<rbrakk> \<Longrightarrow>
    3.75                                   G,A\<turnstile>{Normal P} e#es\<doteq>\<succ> {R}"
    3.76  
    3.77 -  (* statements *)
    3.78 +  --{* statements *}
    3.79  
    3.80    Skip:                         "G,A\<turnstile>{Normal (P\<leftarrow>\<diamondsuit>)} .Skip. {P}"
    3.81  
    3.82 @@ -612,9 +617,8 @@
    3.83    Loop: "\<lbrakk>G,A\<turnstile>{P} e-\<succ> {P'}; 
    3.84            G,A\<turnstile>{Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}\<rbrakk> \<Longrightarrow>
    3.85                              G,A\<turnstile>{P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}"
    3.86 -(** Beware of polymorphic_Loop below: should be identical terms **)
    3.87    
    3.88 -  Do: "G,A\<turnstile>{Normal (abupd (\<lambda>a. (Some (Jump j))) .; P\<leftarrow>\<diamondsuit>)} .Do j. {P}"
    3.89 +  Jmp: "G,A\<turnstile>{Normal (abupd (\<lambda>a. (Some (Jump j))) .; P\<leftarrow>\<diamondsuit>)} .Jmp j. {P}"
    3.90  
    3.91    Throw:"\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {\<lambda>Val:a:. abupd (throw a) .; Q\<leftarrow>\<diamondsuit>}\<rbrakk> \<Longrightarrow>
    3.92                                   G,A\<turnstile>{Normal P} .Throw e. {Q}"
    3.93 @@ -642,21 +646,13 @@
    3.94  @{text InsInitE}, @{text InsInitV}, @{text FinA} only used by the smallstep 
    3.95  semantics.
    3.96  *}
    3.97 -  InstInitV: " G,A\<turnstile>{Normal P} InsInitV c v=\<succ> {Q}"
    3.98 -  InstInitE: " G,A\<turnstile>{Normal P} InsInitE c e-\<succ> {Q}"
    3.99 +  InsInitV: " G,A\<turnstile>{Normal P} InsInitV c v=\<succ> {Q}"
   3.100 +  InsInitE: " G,A\<turnstile>{Normal P} InsInitE c e-\<succ> {Q}"
   3.101    Callee:    " G,A\<turnstile>{Normal P} Callee l e-\<succ> {Q}"
   3.102    FinA:      " G,A\<turnstile>{Normal P} .FinA a c. {Q}"
   3.103 -axioms (** these terms are the same as above, but with generalized typing **)
   3.104 -  polymorphic_conseq:
   3.105 -        "\<forall>Y s Z . P  Y s Z  \<longrightarrow> (\<exists>P' Q'. G,A\<turnstile>{P'} t\<succ> {Q'} \<and> (\<forall>Y' s'. 
   3.106 -        (\<forall>Y   Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow>
   3.107 -                                Q  Y' s' Z ))
   3.108 -                                         \<Longrightarrow> G,A\<turnstile>{P } t\<succ> {Q }"
   3.109 -
   3.110 -  polymorphic_Loop:
   3.111 -        "\<lbrakk>G,A\<turnstile>{P} e-\<succ> {P'}; 
   3.112 -          G,A\<turnstile>{Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}\<rbrakk> \<Longrightarrow>
   3.113 -                            G,A\<turnstile>{P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}"
   3.114 +(*
   3.115 +axioms 
   3.116 +*)
   3.117  
   3.118  constdefs
   3.119   adapt_pre :: "'a assn \<Rightarrow> 'a assn \<Rightarrow> 'a assn \<Rightarrow> 'a assn"
   3.120 @@ -743,50 +739,67 @@
   3.121  
   3.122  section "rules derived from conseq"
   3.123  
   3.124 -lemma conseq12: "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'};  
   3.125 +text {* In the following rules we often have to give some type annotations like:
   3.126 + @{term "G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q}"}.
   3.127 +Given only the term above without annotations, Isabelle would infer a more 
   3.128 +general type were we could have 
   3.129 +different types of auxiliary variables in the assumption set (@{term A}) and 
   3.130 +in the triple itself (@{term P} and @{term Q}). But 
   3.131 +@{text "ax_derivs.Methd"} enforces the same type in the inductive definition of
   3.132 +the derivation. So we have to restrict the types to be able to apply the
   3.133 +rules. 
   3.134 +*}
   3.135 +lemma conseq12: "\<lbrakk>G,(A::'a triple set)\<turnstile>{P'::'a assn} t\<succ> {Q'};  
   3.136   \<forall>Y s Z. P Y s Z \<longrightarrow> (\<forall>Y' s'. (\<forall>Y Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow>  
   3.137    Q Y' s' Z)\<rbrakk>  
   3.138    \<Longrightarrow>  G,A\<turnstile>{P ::'a assn} t\<succ> {Q }"
   3.139 -apply (rule polymorphic_conseq)
   3.140 +apply (rule ax_derivs.conseq)
   3.141  apply clarsimp
   3.142  apply blast
   3.143  done
   3.144  
   3.145 -(*unused, but nice variant*)
   3.146 -lemma conseq12': "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'}; \<forall>s Y' s'.  
   3.147 +-- {* Nice variant, since it is so symmetric we might be able to memorise it. *}
   3.148 +lemma conseq12': "\<lbrakk>G,(A::'a triple set)\<turnstile>{P'::'a assn} t\<succ> {Q'}; \<forall>s Y' s'.  
   3.149         (\<forall>Y Z. P' Y s Z \<longrightarrow> Q' Y' s' Z) \<longrightarrow>  
   3.150         (\<forall>Y Z. P  Y s Z \<longrightarrow> Q  Y' s' Z)\<rbrakk>  
   3.151 -  \<Longrightarrow>  G,A\<turnstile>{P } t\<succ> {Q }"
   3.152 +  \<Longrightarrow>  G,A\<turnstile>{P::'a assn } t\<succ> {Q }"
   3.153  apply (erule conseq12)
   3.154  apply fast
   3.155  done
   3.156  
   3.157 -lemma conseq12_from_conseq12': "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'};  
   3.158 +lemma conseq12_from_conseq12': "\<lbrakk>G,(A::'a triple set)\<turnstile>{P'::'a assn} t\<succ> {Q'};  
   3.159   \<forall>Y s Z. P Y s Z \<longrightarrow> (\<forall>Y' s'. (\<forall>Y Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow>  
   3.160    Q Y' s' Z)\<rbrakk>  
   3.161 -  \<Longrightarrow>  G,A\<turnstile>{P } t\<succ> {Q }"
   3.162 +  \<Longrightarrow>  G,A\<turnstile>{P::'a assn} t\<succ> {Q }"
   3.163  apply (erule conseq12')
   3.164  apply blast
   3.165  done
   3.166  
   3.167 -lemma conseq1: "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q}; P \<Rightarrow> P'\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P } t\<succ> {Q}"
   3.168 +lemma conseq1: "\<lbrakk>G,(A::'a triple set)\<turnstile>{P'::'a assn} t\<succ> {Q}; P \<Rightarrow> P'\<rbrakk> 
   3.169 + \<Longrightarrow> G,A\<turnstile>{P::'a assn} t\<succ> {Q}"
   3.170  apply (erule conseq12)
   3.171  apply blast
   3.172  done
   3.173  
   3.174 -lemma conseq2: "\<lbrakk>G,A\<turnstile>{P} t\<succ> {Q'}; Q' \<Rightarrow> Q\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.175 +lemma conseq2: "\<lbrakk>G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q'}; Q' \<Rightarrow> Q\<rbrakk> 
   3.176 +\<Longrightarrow> G,A\<turnstile>{P::'a assn} t\<succ> {Q}"
   3.177  apply (erule conseq12)
   3.178  apply blast
   3.179  done
   3.180  
   3.181 -lemma ax_escape: "\<lbrakk>\<forall>Y s Z. P Y s Z \<longrightarrow> G,A\<turnstile>{\<lambda>Y' s' Z'. (Y',s') = (Y,s)} t\<succ> {\<lambda>Y s Z'. Q Y s Z}\<rbrakk> \<Longrightarrow>  
   3.182 -  G,A\<turnstile>{P} t\<succ> {Q}"
   3.183 -apply (rule polymorphic_conseq)
   3.184 +lemma ax_escape: 
   3.185 + "\<lbrakk>\<forall>Y s Z. P Y s Z 
   3.186 +   \<longrightarrow> G,(A::'a triple set)\<turnstile>{\<lambda>Y' s' (Z'::'a). (Y',s') = (Y,s)} 
   3.187 +                             t\<succ> 
   3.188 +                            {\<lambda>Y s Z'. Q Y s Z}
   3.189 +\<rbrakk> \<Longrightarrow>  G,A\<turnstile>{P::'a assn} t\<succ> {Q::'a assn}"
   3.190 +apply (rule ax_derivs.conseq)
   3.191  apply force
   3.192  done
   3.193  
   3.194  (* unused *)
   3.195 -lemma ax_constant: "\<lbrakk> C \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}\<rbrakk> \<Longrightarrow> G,A\<turnstile>{\<lambda>Y s Z. C \<and> P Y s Z} t\<succ> {Q}"
   3.196 +lemma ax_constant: "\<lbrakk> C \<Longrightarrow> G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q}\<rbrakk> 
   3.197 +\<Longrightarrow> G,A\<turnstile>{\<lambda>Y s Z. C \<and> P Y s Z} t\<succ> {Q}"
   3.198  apply (rule ax_escape (* unused *))
   3.199  apply clarify
   3.200  apply (rule conseq12)
   3.201 @@ -799,7 +812,8 @@
   3.202  *)
   3.203  
   3.204  
   3.205 -lemma ax_impossible [intro]: "G,A\<turnstile>{\<lambda>Y s Z. False} t\<succ> {Q}"
   3.206 +lemma ax_impossible [intro]: 
   3.207 +  "G,(A::'a triple set)\<turnstile>{\<lambda>Y s Z. False} t\<succ> {Q::'a assn}"
   3.208  apply (rule ax_escape)
   3.209  apply clarify
   3.210  done
   3.211 @@ -808,34 +822,40 @@
   3.212  lemma ax_nochange_lemma: "\<lbrakk>P Y s; All (op = w)\<rbrakk> \<Longrightarrow> P w s"
   3.213  apply auto
   3.214  done
   3.215 -lemma ax_nochange:"G,A\<turnstile>{\<lambda>Y s Z. (Y,s)=Z} t\<succ> {\<lambda>Y s Z. (Y,s)=Z} \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {P}"
   3.216 +
   3.217 +lemma ax_nochange:
   3.218 + "G,(A::(res \<times> state) triple set)\<turnstile>{\<lambda>Y s Z. (Y,s)=Z} t\<succ> {\<lambda>Y s Z. (Y,s)=Z} 
   3.219 +  \<Longrightarrow> G,A\<turnstile>{P::(res \<times> state) assn} t\<succ> {P}"
   3.220  apply (erule conseq12)
   3.221  apply auto
   3.222  apply (erule (1) ax_nochange_lemma)
   3.223  done
   3.224  
   3.225  (* unused *)
   3.226 -lemma ax_trivial: "G,A\<turnstile>{P}  t\<succ> {\<lambda>Y s Z. True}"
   3.227 -apply (rule polymorphic_conseq(* unused *))
   3.228 +lemma ax_trivial: "G,(A::'a triple set)\<turnstile>{P::'a assn}  t\<succ> {\<lambda>Y s Z. True}"
   3.229 +apply (rule ax_derivs.conseq(* unused *))
   3.230  apply auto
   3.231  done
   3.232  
   3.233  (* unused *)
   3.234 -lemma ax_disj: "\<lbrakk>G,A\<turnstile>{P1} t\<succ> {Q1}; G,A\<turnstile>{P2} t\<succ> {Q2}\<rbrakk> \<Longrightarrow>  
   3.235 -  G,A\<turnstile>{\<lambda>Y s Z. P1 Y s Z \<or> P2 Y s Z} t\<succ> {\<lambda>Y s Z. Q1 Y s Z \<or> Q2 Y s Z}"
   3.236 +lemma ax_disj: 
   3.237 + "\<lbrakk>G,(A::'a triple set)\<turnstile>{P1::'a assn} t\<succ> {Q1}; G,A\<turnstile>{P2::'a assn} t\<succ> {Q2}\<rbrakk> 
   3.238 +  \<Longrightarrow>  G,A\<turnstile>{\<lambda>Y s Z. P1 Y s Z \<or> P2 Y s Z} t\<succ> {\<lambda>Y s Z. Q1 Y s Z \<or> Q2 Y s Z}"
   3.239  apply (rule ax_escape (* unused *))
   3.240  apply safe
   3.241  apply  (erule conseq12, fast)+
   3.242  done
   3.243  
   3.244  (* unused *)
   3.245 -lemma ax_supd_shuffle: "(\<exists>Q. G,A\<turnstile>{P} .c1. {Q} \<and> G,A\<turnstile>{Q ;. f} .c2. {R}) =  
   3.246 +lemma ax_supd_shuffle: 
   3.247 + "(\<exists>Q. G,(A::'a triple set)\<turnstile>{P::'a assn} .c1. {Q} \<and> G,A\<turnstile>{Q ;. f} .c2. {R}) =  
   3.248         (\<exists>Q'. G,A\<turnstile>{P} .c1. {f .; Q'} \<and> G,A\<turnstile>{Q'} .c2. {R})"
   3.249  apply (best elim!: conseq1 conseq2)
   3.250  done
   3.251  
   3.252 -lemma ax_cases: "\<lbrakk>G,A\<turnstile>{P \<and>.       C} t\<succ> {Q};  
   3.253 -                       G,A\<turnstile>{P \<and>. Not \<circ> C} t\<succ> {Q}\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.254 +lemma ax_cases: "
   3.255 + \<lbrakk>G,(A::'a triple set)\<turnstile>{P \<and>.       C} t\<succ> {Q::'a assn};  
   3.256 +                   G,A\<turnstile>{P \<and>. Not \<circ> C} t\<succ> {Q}\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.257  apply (unfold peek_and_def)
   3.258  apply (rule ax_escape)
   3.259  apply clarify
   3.260 @@ -849,13 +869,15 @@
   3.261  apply  force+
   3.262  *)
   3.263  
   3.264 -lemma ax_adapt: "G,A\<turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.265 +lemma ax_adapt: "G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q} 
   3.266 +  \<Longrightarrow> G,A\<turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.267  apply (unfold adapt_pre_def)
   3.268  apply (erule conseq12)
   3.269  apply fast
   3.270  done
   3.271  
   3.272 -lemma adapt_pre_adapts: "G,A\<Turnstile>{P} t\<succ> {Q} \<longrightarrow> G,A\<Turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.273 +lemma adapt_pre_adapts: "G,(A::'a triple set)\<Turnstile>{P::'a assn} t\<succ> {Q} 
   3.274 +\<longrightarrow> G,A\<Turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.275  apply (unfold adapt_pre_def)
   3.276  apply (simp add: ax_valids_def triple_valid_def2)
   3.277  apply fast
   3.278 @@ -872,72 +894,44 @@
   3.279  apply (simp add: ax_valids_def triple_valid_def2)
   3.280  oops
   3.281  
   3.282 -(*
   3.283 -Goal "\<forall>(A::'a triple set) t. G,A\<Turnstile>{P} t\<succ> {Q} \<longrightarrow> G,A\<Turnstile>{P'} t\<succ> {Q'} \<Longrightarrow>  
   3.284 -  wf_prog G \<Longrightarrow> G,(A::'a triple set)\<turnstile>{P} t\<succ> {Q::'a assn} \<Longrightarrow> G,A\<turnstile>{P'} t\<succ> {Q'::'a assn}"
   3.285 -b y fatac ax_sound 1 1;
   3.286 -b y asm_full_simp_tac (simpset() addsimps [ax_valids_def,triple_valid_def2]) 1;
   3.287 -b y rtac ax_no_hazard 1; 
   3.288 -b y etac conseq12 1;
   3.289 -b y Clarify_tac 1;
   3.290 -b y case_tac "\<forall>Z. \<not>P Y s Z" 1;
   3.291 -b y smp_tac 2 1;
   3.292 -b y etac thin_rl 1;
   3.293 -b y etac thin_rl 1;
   3.294 -b y clarsimp_tac (claset(), simpset() addsimps [type_ok_def]) 1;
   3.295 -b y subgoal_tac "G|\<Turnstile>n:A" 1;
   3.296 -b y smp_tac 1 1;
   3.297 -b y smp_tac 3 1;
   3.298 -b y etac impE 1;
   3.299 - back();
   3.300 - b y Fast_tac 1;
   3.301 -b y 
   3.302 -b y rotate_tac 2 1;
   3.303 -b y etac thin_rl 1;
   3.304 -b y  etac thin_rl 2;
   3.305 -b y  etac thin_rl 2;
   3.306 -b y  Clarify_tac 2;
   3.307 -b y  dtac spec 2;
   3.308 -b y  EVERY'[dtac spec, mp_tac] 2;
   3.309 -b y  thin_tac "\<forall>n Y s Z. ?PP n Y s Z" 2;
   3.310 -b y  thin_tac "P' Y s Z" 2;
   3.311 -b y  Blast_tac 2;
   3.312 -b y smp_tac 3 1;
   3.313 -b y case_tac "\<forall>Z. \<not>P Y s Z" 1;
   3.314 -b y dres_inst_tac [("x","In1r Skip")] spec 1;
   3.315 -b y Full_simp_tac 1;
   3.316 -*)
   3.317 -
   3.318  lemma peek_and_forget1_Normal: 
   3.319 - "G,A\<turnstile>{Normal P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{Normal (P \<and>. p)} t\<succ> {Q}"
   3.320 + "G,(A::'a triple set)\<turnstile>{Normal P} t\<succ> {Q::'a assn} 
   3.321 + \<Longrightarrow> G,A\<turnstile>{Normal (P \<and>. p)} t\<succ> {Q}"
   3.322  apply (erule conseq1)
   3.323  apply (simp (no_asm))
   3.324  done
   3.325  
   3.326 -lemma peek_and_forget1: "G,A\<turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{P \<and>. p} t\<succ> {Q}"
   3.327 +lemma peek_and_forget1: 
   3.328 +"G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q} 
   3.329 + \<Longrightarrow> G,A\<turnstile>{P \<and>. p} t\<succ> {Q}"
   3.330  apply (erule conseq1)
   3.331  apply (simp (no_asm))
   3.332  done
   3.333  
   3.334  lemmas ax_NormalD = peek_and_forget1 [of _ _ _ _ _ normal] 
   3.335  
   3.336 -lemma peek_and_forget2: "G,A\<turnstile>{P} t\<succ> {Q \<and>. p} \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.337 +lemma peek_and_forget2: 
   3.338 +"G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> {Q \<and>. p} 
   3.339 +\<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.340  apply (erule conseq2)
   3.341  apply (simp (no_asm))
   3.342  done
   3.343  
   3.344 -lemma ax_subst_Val_allI: "\<forall>v. G,A\<turnstile>{(P'               v )\<leftarrow>Val v} t\<succ> {Q v} \<Longrightarrow>  
   3.345 -      \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In1 w))\<leftarrow>Val v} t\<succ> {Q v}"
   3.346 +lemma ax_subst_Val_allI: 
   3.347 +"\<forall>v. G,(A::'a triple set)\<turnstile>{(P'               v )\<leftarrow>Val v} t\<succ> {(Q v)::'a assn}
   3.348 + \<Longrightarrow>  \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In1 w))\<leftarrow>Val v} t\<succ> {Q v}"
   3.349  apply (force elim!: conseq1)
   3.350  done
   3.351  
   3.352 -lemma ax_subst_Var_allI: "\<forall>v. G,A\<turnstile>{(P'               v )\<leftarrow>Var v} t\<succ> {Q v} \<Longrightarrow>  
   3.353 -      \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In2 w))\<leftarrow>Var v} t\<succ> {Q v}"
   3.354 +lemma ax_subst_Var_allI: 
   3.355 +"\<forall>v. G,(A::'a triple set)\<turnstile>{(P'               v )\<leftarrow>Var v} t\<succ> {(Q v)::'a assn}
   3.356 + \<Longrightarrow>  \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In2 w))\<leftarrow>Var v} t\<succ> {Q v}"
   3.357  apply (force elim!: conseq1)
   3.358  done
   3.359  
   3.360 -lemma ax_subst_Vals_allI: "(\<forall>v. G,A\<turnstile>{(     P'          v )\<leftarrow>Vals v} t\<succ> {Q v}) \<Longrightarrow>  
   3.361 -       \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In3 w))\<leftarrow>Vals v} t\<succ> {Q v}"
   3.362 +lemma ax_subst_Vals_allI: 
   3.363 +"(\<forall>v. G,(A::'a triple set)\<turnstile>{(     P'          v )\<leftarrow>Vals v} t\<succ> {(Q v)::'a assn})
   3.364 + \<Longrightarrow>  \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In3 w))\<leftarrow>Vals v} t\<succ> {Q v}"
   3.365  apply (force elim!: conseq1)
   3.366  done
   3.367  
   3.368 @@ -1171,36 +1165,43 @@
   3.369  
   3.370  section "introduction rules for Alloc and SXAlloc"
   3.371  
   3.372 -lemma ax_SXAlloc_Normal: "G,A\<turnstile>{P} .c. {Normal Q} \<Longrightarrow> G,A\<turnstile>{P} .c. {SXAlloc G Q}"
   3.373 +lemma ax_SXAlloc_Normal: 
   3.374 + "G,(A::'a triple set)\<turnstile>{P::'a assn} .c. {Normal Q} 
   3.375 + \<Longrightarrow> G,A\<turnstile>{P} .c. {SXAlloc G Q}"
   3.376  apply (erule conseq2)
   3.377  apply (clarsimp elim!: sxalloc_elim_cases simp add: split_tupled_all)
   3.378  done
   3.379  
   3.380  lemma ax_Alloc: 
   3.381 -  "G,A\<turnstile>{P} t\<succ> {Normal (\<lambda>Y (x,s) Z. (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.382 - Q (Val (Addr a)) (Norm(init_obj G (CInst C) (Heap a) s)) Z)) \<and>. 
   3.383 -    heap_free (Suc (Suc 0))}
   3.384 +  "G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> 
   3.385 +     {Normal (\<lambda>Y (x,s) Z. (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.386 +      Q (Val (Addr a)) (Norm(init_obj G (CInst C) (Heap a) s)) Z)) \<and>. 
   3.387 +      heap_free (Suc (Suc 0))}
   3.388     \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Alloc G (CInst C) Q}"
   3.389  apply (erule conseq2)
   3.390  apply (auto elim!: halloc_elim_cases)
   3.391  done
   3.392  
   3.393  lemma ax_Alloc_Arr: 
   3.394 - "G,A\<turnstile>{P} t\<succ> {\<lambda>Val:i:. Normal (\<lambda>Y (x,s) Z. \<not>the_Intg i<0 \<and>  
   3.395 -  (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.396 -  Q (Val (Addr a)) (Norm (init_obj G (Arr T (the_Intg i)) (Heap a) s)) Z)) \<and>. 
   3.397 -   heap_free (Suc (Suc 0))} \<Longrightarrow>  
   3.398 + "G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> 
   3.399 +   {\<lambda>Val:i:. Normal (\<lambda>Y (x,s) Z. \<not>the_Intg i<0 \<and>  
   3.400 +    (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.401 +    Q (Val (Addr a)) (Norm (init_obj G (Arr T (the_Intg i)) (Heap a) s)) Z)) \<and>.
   3.402 +    heap_free (Suc (Suc 0))} 
   3.403 + \<Longrightarrow>  
   3.404   G,A\<turnstile>{P} t\<succ> {\<lambda>Val:i:. abupd (check_neg i) .; Alloc G (Arr T(the_Intg i)) Q}"
   3.405  apply (erule conseq2)
   3.406  apply (auto elim!: halloc_elim_cases)
   3.407  done
   3.408  
   3.409  lemma ax_SXAlloc_catch_SXcpt: 
   3.410 - "\<lbrakk>G,A\<turnstile>{P} t\<succ> {(\<lambda>Y (x,s) Z. x=Some (Xcpt (Std xn)) \<and>  
   3.411 -  (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.412 -  Q Y (Some (Xcpt (Loc a)),init_obj G (CInst (SXcpt xn)) (Heap a) s) Z))  
   3.413 -  \<and>. heap_free (Suc (Suc 0))}\<rbrakk> \<Longrightarrow>  
   3.414 -  G,A\<turnstile>{P} t\<succ> {SXAlloc G (\<lambda>Y s Z. Q Y s Z \<and> G,s\<turnstile>catch SXcpt xn)}"
   3.415 + "\<lbrakk>G,(A::'a triple set)\<turnstile>{P::'a assn} t\<succ> 
   3.416 +     {(\<lambda>Y (x,s) Z. x=Some (Xcpt (Std xn)) \<and>  
   3.417 +      (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
   3.418 +      Q Y (Some (Xcpt (Loc a)),init_obj G (CInst (SXcpt xn)) (Heap a) s) Z))  
   3.419 +      \<and>. heap_free (Suc (Suc 0))}\<rbrakk> 
   3.420 + \<Longrightarrow>  
   3.421 + G,A\<turnstile>{P} t\<succ> {SXAlloc G (\<lambda>Y s Z. Q Y s Z \<and> G,s\<turnstile>catch SXcpt xn)}"
   3.422  apply (erule conseq2)
   3.423  apply (auto elim!: sxalloc_elim_cases halloc_elim_cases)
   3.424  done
     4.1 --- a/src/HOL/Bali/AxSound.thy	Wed Oct 30 12:44:18 2002 +0100
     4.2 +++ b/src/HOL/Bali/AxSound.thy	Thu Oct 31 18:27:10 2002 +0100
     4.3 @@ -1,6 +1,6 @@
     4.4  (*  Title:      HOL/Bali/AxSound.thy
     4.5      ID:         $Id$
     4.6 -    Author:     David von Oheimb
     4.7 +    Author:     David von Oheimb and Norbert Schirmer
     4.8      License:    GPL (GNU GENERAL PUBLIC LICENSE)
     4.9  *)
    4.10  header {* Soundness proof for Axiomatic semantics of Java expressions and 
    4.11 @@ -22,14 +22,24 @@
    4.12  
    4.13  defs  triple_valid2_def: "G\<Turnstile>n\<Colon>t \<equiv> case t of {P} t\<succ> {Q} \<Rightarrow>
    4.14   \<forall>Y s Z. P Y s Z \<longrightarrow> (\<forall>L. s\<Colon>\<preceq>(G,L) 
    4.15 - \<longrightarrow> (\<forall>T C. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<longrightarrow>
    4.16 + \<longrightarrow> (\<forall>T C A. (normal s \<longrightarrow> (\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T \<and> 
    4.17 +                            \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>A)) \<longrightarrow>
    4.18   (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s') \<longrightarrow> Q Y' s' Z \<and> s'\<Colon>\<preceq>(G,L))))"
    4.19  
    4.20 +text {* This definition differs from the ordinary  @{text triple_valid_def} 
    4.21 +manly in the conclusion: We also ensures conformance of the result state. So
    4.22 +we don't have to apply the type soundness lemma all the time during
    4.23 +induction. This definition is only introduced for the soundness
    4.24 +proof of the axiomatic semantics, in the end we will conclude to 
    4.25 +the ordinary definition.
    4.26 +*}
    4.27 + 
    4.28  defs  ax_valids2_def:    "G,A|\<Turnstile>\<Colon>ts \<equiv>  \<forall>n. (\<forall>t\<in>A. G\<Turnstile>n\<Colon>t) \<longrightarrow> (\<forall>t\<in>ts. G\<Turnstile>n\<Colon>t)"
    4.29  
    4.30  lemma triple_valid2_def2: "G\<Turnstile>n\<Colon>{P} t\<succ> {Q} =  
    4.31   (\<forall>Y s Z. P Y s Z \<longrightarrow> (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s')\<longrightarrow>  
    4.32 -  (\<forall>L. s\<Colon>\<preceq>(G,L) \<longrightarrow> (\<forall>T C. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<longrightarrow>  
    4.33 +  (\<forall>L. s\<Colon>\<preceq>(G,L) \<longrightarrow> (\<forall>T C A. (normal s \<longrightarrow> (\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T \<and> 
    4.34 +                            \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>A)) \<longrightarrow>
    4.35    Q Y' s' Z \<and> s'\<Colon>\<preceq>(G,L)))))"
    4.36  apply (unfold triple_valid2_def)
    4.37  apply (simp (no_asm) add: split_paired_All)
    4.38 @@ -48,10 +58,18 @@
    4.39  apply (tactic "smp_tac 3 1")
    4.40  apply (case_tac "normal s")
    4.41  apply  clarsimp
    4.42 -apply  (blast dest: evaln_eval eval_type_sound [THEN conjunct1])
    4.43 -apply clarsimp
    4.44 +apply  (elim conjE impE)
    4.45 +apply    blast
    4.46 +
    4.47 +apply    (tactic "smp_tac 2 1")
    4.48 +apply    (drule evaln_eval)
    4.49 +apply    (drule (1) eval_type_sound [THEN conjunct1],simp, assumption+)
    4.50 +apply    simp
    4.51 +
    4.52 +apply    clarsimp
    4.53  done
    4.54  
    4.55 +
    4.56  lemma ax_valids2_eq: "wf_prog G \<Longrightarrow> G,A|\<Turnstile>\<Colon>ts = G,A|\<Turnstile>ts"
    4.57  apply (unfold ax_valids_def ax_valids2_def)
    4.58  apply (force simp add: triple_valid2_eq)
    4.59 @@ -73,9 +91,9 @@
    4.60    \<Longrightarrow> G\<Turnstile>Suc n\<Colon>{Normal P} Methd C sig-\<succ> {Q}"
    4.61  apply (simp (no_asm_use) add: triple_valid2_def2)
    4.62  apply (intro strip, tactic "smp_tac 3 1", clarify)
    4.63 -apply (erule wt_elim_cases, erule evaln_elim_cases)
    4.64 +apply (erule wt_elim_cases, erule da_elim_cases, erule evaln_elim_cases)
    4.65  apply (unfold body_def Let_def)
    4.66 -apply clarsimp
    4.67 +apply (clarsimp simp add: inj_term_simps)
    4.68  apply blast
    4.69  done
    4.70  
    4.71 @@ -91,380 +109,2555 @@
    4.72  section "soundness"
    4.73  
    4.74  lemma Methd_sound: 
    4.75 -"\<lbrakk>G,A\<union>  {{P} Methd-\<succ> {Q} | ms}|\<Turnstile>\<Colon>{{P} body G-\<succ> {Q} | ms}\<rbrakk> \<Longrightarrow> 
    4.76 -  G,A|\<Turnstile>\<Colon>{{P} Methd-\<succ> {Q} | ms}"
    4.77 -apply (unfold ax_valids2_def mtriples_def)
    4.78 -apply (rule allI)
    4.79 -apply (induct_tac "n")
    4.80 -apply  (clarify, tactic {* pair_tac "x" 1 *}, simp (no_asm))
    4.81 -apply  (fast intro: Methd_triple_valid2_0)
    4.82 -apply (clarify, tactic {* pair_tac "xa" 1 *}, simp (no_asm))
    4.83 -apply (drule triples_valid2_Suc)
    4.84 -apply (erule (1) notE impE)
    4.85 -apply (drule_tac x = na in spec)
    4.86 -apply (rule Methd_triple_valid2_SucI)
    4.87 -apply (simp (no_asm_use) add: ball_Un)
    4.88 -apply auto
    4.89 -done
    4.90 +  assumes recursive: "G,A\<union>  {{P} Methd-\<succ> {Q} | ms}|\<Turnstile>\<Colon>{{P} body G-\<succ> {Q} | ms}"
    4.91 +  shows "G,A|\<Turnstile>\<Colon>{{P} Methd-\<succ> {Q} | ms}"
    4.92 +proof -
    4.93 +  {
    4.94 +    fix n
    4.95 +    assume recursive: "\<And> n. \<forall>t\<in>(A \<union> {{P} Methd-\<succ> {Q} | ms}). G\<Turnstile>n\<Colon>t
    4.96 +                              \<Longrightarrow>  \<forall>t\<in>{{P} body G-\<succ> {Q} | ms}.  G\<Turnstile>n\<Colon>t"
    4.97 +    have "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t \<Longrightarrow> \<forall>t\<in>{{P} Methd-\<succ> {Q} | ms}.  G\<Turnstile>n\<Colon>t"
    4.98 +    proof (induct n)
    4.99 +      case 0
   4.100 +      show "\<forall>t\<in>{{P} Methd-\<succ> {Q} | ms}.  G\<Turnstile>0\<Colon>t"
   4.101 +      proof -
   4.102 +	{
   4.103 +	  fix C sig
   4.104 +	  assume "(C,sig) \<in> ms" 
   4.105 +	  have "G\<Turnstile>0\<Colon>{Normal (P C sig)} Methd C sig-\<succ> {Q C sig}"
   4.106 +	    by (rule Methd_triple_valid2_0)
   4.107 +	}
   4.108 +	thus ?thesis
   4.109 +	  by (simp add: mtriples_def split_def)
   4.110 +      qed
   4.111 +    next
   4.112 +      case (Suc m)
   4.113 +      have hyp: "\<forall>t\<in>A. G\<Turnstile>m\<Colon>t \<Longrightarrow> \<forall>t\<in>{{P} Methd-\<succ> {Q} | ms}.  G\<Turnstile>m\<Colon>t".
   4.114 +      have prem: "\<forall>t\<in>A. G\<Turnstile>Suc m\<Colon>t" .
   4.115 +      show "\<forall>t\<in>{{P} Methd-\<succ> {Q} | ms}.  G\<Turnstile>Suc m\<Colon>t"
   4.116 +      proof -
   4.117 +	{
   4.118 +	  fix C sig
   4.119 +	  assume m: "(C,sig) \<in> ms" 
   4.120 +	  have "G\<Turnstile>Suc m\<Colon>{Normal (P C sig)} Methd C sig-\<succ> {Q C sig}"
   4.121 +	  proof -
   4.122 +	    from prem have prem_m: "\<forall>t\<in>A. G\<Turnstile>m\<Colon>t"
   4.123 +	      by (rule triples_valid2_Suc)
   4.124 +	    hence "\<forall>t\<in>{{P} Methd-\<succ> {Q} | ms}.  G\<Turnstile>m\<Colon>t"
   4.125 +	      by (rule hyp)
   4.126 +	    with prem_m
   4.127 +	    have "\<forall>t\<in>(A \<union> {{P} Methd-\<succ> {Q} | ms}). G\<Turnstile>m\<Colon>t"
   4.128 +	      by (simp add: ball_Un)
   4.129 +	    hence "\<forall>t\<in>{{P} body G-\<succ> {Q} | ms}.  G\<Turnstile>m\<Colon>t"
   4.130 +	      by (rule recursive)
   4.131 +	    with m have "G\<Turnstile>m\<Colon>{Normal (P C sig)} body G C sig-\<succ> {Q C sig}"
   4.132 +	      by (auto simp add: mtriples_def split_def)
   4.133 +	    thus ?thesis
   4.134 +	      by (rule Methd_triple_valid2_SucI)
   4.135 +	  qed
   4.136 +	}
   4.137 +	thus ?thesis
   4.138 +	  by (simp add: mtriples_def split_def)
   4.139 +      qed
   4.140 +    qed
   4.141 +  }
   4.142 +  with recursive show ?thesis
   4.143 +    by (unfold ax_valids2_def) blast
   4.144 +qed
   4.145  
   4.146  
   4.147  lemma valids2_inductI: "\<forall>s t n Y' s'. G\<turnstile>s\<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s') \<longrightarrow> t = c \<longrightarrow>    
   4.148    Ball A (triple_valid2 G n) \<longrightarrow> (\<forall>Y Z. P Y s Z \<longrightarrow>  
   4.149 -  (\<forall>L. s\<Colon>\<preceq>(G,L) \<longrightarrow> (\<forall>T C. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<longrightarrow>  
   4.150 -  Q Y' s' Z \<and> s'\<Colon>\<preceq>(G, L)))) \<Longrightarrow>  
   4.151 +  (\<forall>L. s\<Colon>\<preceq>(G,L) \<longrightarrow> 
   4.152 +    (\<forall>T C A. (normal s \<longrightarrow> (\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<and> 
   4.153 +                            \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>A) \<longrightarrow>
   4.154 +    Q Y' s' Z \<and> s'\<Colon>\<preceq>(G, L)))) \<Longrightarrow>  
   4.155    G,A|\<Turnstile>\<Colon>{ {P} c\<succ> {Q}}"
   4.156  apply (simp (no_asm) add: ax_valids2_def triple_valid2_def2)
   4.157  apply clarsimp
   4.158  done
   4.159  
   4.160 -ML_setup {*
   4.161 -Delsimprocs [evaln_expr_proc,evaln_var_proc,evaln_exprs_proc,evaln_stmt_proc]
   4.162 -*}
   4.163 +lemma da_good_approx_evalnE [consumes 4]:
   4.164 +  assumes evaln: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s1)"
   4.165 +     and     wt: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T"
   4.166 +     and     da: "\<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>t\<guillemotright> A"
   4.167 +     and     wf: "wf_prog G"
   4.168 +     and   elim: "\<lbrakk>normal s1 \<Longrightarrow> nrm A \<subseteq> dom (locals (store s1));
   4.169 +                  \<And> l. \<lbrakk>abrupt s1 = Some (Jump (Break l)); normal s0\<rbrakk>
   4.170 +                        \<Longrightarrow> brk A l \<subseteq> dom (locals (store s1));
   4.171 +                   \<lbrakk>abrupt s1 = Some (Jump Ret);normal s0\<rbrakk>
   4.172 +                   \<Longrightarrow>Result \<in> dom (locals (store s1))
   4.173 +                  \<rbrakk> \<Longrightarrow> P"
   4.174 +  shows "P"
   4.175 +proof -
   4.176 +  from evaln have "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v, s1)"
   4.177 +    by (rule evaln_eval)
   4.178 +  from this wt da wf elim show P
   4.179 +    by (rule da_good_approxE') rules+
   4.180 +qed
   4.181  
   4.182 -lemma Loop_sound: "\<lbrakk>G,A|\<Turnstile>\<Colon>{ {P} e-\<succ> {P'}};  
   4.183 -       G,A|\<Turnstile>\<Colon>{ {Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}}\<rbrakk> \<Longrightarrow>  
   4.184 -       G,A|\<Turnstile>\<Colon>{ {P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}}"
   4.185 -apply (rule valids2_inductI)
   4.186 -apply ((rule allI)+, rule impI, tactic {* pair_tac "s" 1*}, tactic {* pair_tac "s'" 1*})
   4.187 -apply (erule evaln.induct)
   4.188 -apply  simp_all (* takes half a minute *)
   4.189 -apply  clarify
   4.190 -apply  (erule_tac V = "G,A|\<Turnstile>\<Colon>{ {?P'} .c. {?P}}" in thin_rl)
   4.191 -apply  (simp_all (no_asm_use) add: ax_valids2_def triple_valid2_def2)
   4.192 -apply  (tactic "smp_tac 1 1", tactic "smp_tac 3 1", force)
   4.193 -apply clarify
   4.194 -apply (rule wt_elim_cases, assumption)
   4.195 -apply (tactic "smp_tac 1 1", tactic "smp_tac 1 1", tactic "smp_tac 3 1", 
   4.196 -       tactic "smp_tac 2 1", tactic "smp_tac 1 1")
   4.197 -apply (erule impE,simp (no_asm),blast)
   4.198 -apply (simp add: imp_conjL split_tupled_all split_paired_All)
   4.199 -apply (case_tac "the_Bool b")
   4.200 -apply  clarsimp
   4.201 -apply  (case_tac "a")
   4.202 -apply (simp_all)
   4.203 -apply clarsimp
   4.204 -apply  (erule_tac V = "c = l\<bullet> While(e) c \<longrightarrow> ?P" in thin_rl)
   4.205 -apply (blast intro: conforms_absorb)
   4.206 -apply blast+
   4.207 +lemma validI: 
   4.208 +   assumes I: "\<And> n s0 L accC T C v s1 Y Z.
   4.209 +               \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); 
   4.210 +               normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T;
   4.211 +               normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>t\<guillemotright>C;
   4.212 +               G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1); P Y s0 Z\<rbrakk> \<Longrightarrow> Q v s1 Z \<and> s1\<Colon>\<preceq>(G,L)" 
   4.213 +  shows "G,A|\<Turnstile>\<Colon>{ {P} t\<succ> {Q} }"
   4.214 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.215 +apply (intro allI impI)
   4.216 +apply (case_tac "normal s")
   4.217 +apply   clarsimp 
   4.218 +apply   (rule I,(assumption|simp)+)
   4.219 +
   4.220 +apply   (rule I,auto)
   4.221 +done
   4.222 +  
   4.223 +
   4.224 +
   4.225 +
   4.226 +ML "Addsimprocs [wt_expr_proc,wt_var_proc,wt_exprs_proc,wt_stmt_proc]"
   4.227 +
   4.228 +lemma valid_stmtI: 
   4.229 +   assumes I: "\<And> n s0 L accC C s1 Y Z.
   4.230 +             \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); 
   4.231 +              normal s0\<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c\<Colon>\<surd>;
   4.232 +              normal s0\<Longrightarrow>\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright>C;
   4.233 +              G\<turnstile>s0 \<midarrow>c\<midarrow>n\<rightarrow> s1; P Y s0 Z\<rbrakk> \<Longrightarrow> Q \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G,L)" 
   4.234 +  shows "G,A|\<Turnstile>\<Colon>{ {P} \<langle>c\<rangle>\<^sub>s\<succ> {Q} }"
   4.235 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.236 +apply (intro allI impI)
   4.237 +apply (case_tac "normal s")
   4.238 +apply   clarsimp 
   4.239 +apply   (rule I,(assumption|simp)+)
   4.240 +
   4.241 +apply   (rule I,auto)
   4.242  done
   4.243  
   4.244 -declare subst_Bool_def2 [simp del]
   4.245 +lemma valid_stmt_NormalI: 
   4.246 +   assumes I: "\<And> n s0 L accC C s1 Y Z.
   4.247 +               \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); normal s0; \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c\<Colon>\<surd>;
   4.248 +               \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright>C;
   4.249 +               G\<turnstile>s0 \<midarrow>c\<midarrow>n\<rightarrow> s1; (Normal P) Y s0 Z\<rbrakk> \<Longrightarrow> Q \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G,L)" 
   4.250 +  shows "G,A|\<Turnstile>\<Colon>{ {Normal P} \<langle>c\<rangle>\<^sub>s\<succ> {Q} }"
   4.251 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.252 +apply (intro allI impI)
   4.253 +apply (elim exE conjE)
   4.254 +apply (rule I)
   4.255 +by auto
   4.256 +
   4.257 +lemma valid_var_NormalI: 
   4.258 +   assumes I: "\<And> n s0 L accC T C vf s1 Y Z.
   4.259 +               \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); normal s0; 
   4.260 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>=T;
   4.261 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>t\<rangle>\<^sub>v\<guillemotright>C;
   4.262 +                G\<turnstile>s0 \<midarrow>t=\<succ>vf\<midarrow>n\<rightarrow> s1; (Normal P) Y s0 Z\<rbrakk> 
   4.263 +               \<Longrightarrow> Q (In2 vf) s1 Z \<and> s1\<Colon>\<preceq>(G,L)"
   4.264 +   shows "G,A|\<Turnstile>\<Colon>{ {Normal P} \<langle>t\<rangle>\<^sub>v\<succ> {Q} }"
   4.265 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.266 +apply (intro allI impI)
   4.267 +apply (elim exE conjE)
   4.268 +apply simp
   4.269 +apply (rule I)
   4.270 +by auto
   4.271 +
   4.272 +lemma valid_expr_NormalI: 
   4.273 +   assumes I: "\<And> n s0 L accC T C v s1 Y Z.
   4.274 +               \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); normal s0; 
   4.275 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>-T;
   4.276 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>t\<rangle>\<^sub>e\<guillemotright>C;
   4.277 +                G\<turnstile>s0 \<midarrow>t-\<succ>v\<midarrow>n\<rightarrow> s1; (Normal P) Y s0 Z\<rbrakk> 
   4.278 +               \<Longrightarrow> Q (In1 v) s1 Z \<and> s1\<Colon>\<preceq>(G,L)"
   4.279 +   shows "G,A|\<Turnstile>\<Colon>{ {Normal P} \<langle>t\<rangle>\<^sub>e\<succ> {Q} }"
   4.280 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.281 +apply (intro allI impI)
   4.282 +apply (elim exE conjE)
   4.283 +apply simp
   4.284 +apply (rule I)
   4.285 +by auto
   4.286 +
   4.287 +lemma valid_expr_list_NormalI: 
   4.288 +   assumes I: "\<And> n s0 L accC T C vs s1 Y Z.
   4.289 +               \<lbrakk>\<forall>t\<in>A. G\<Turnstile>n\<Colon>t; s0\<Colon>\<preceq>(G,L); normal s0; 
   4.290 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>\<doteq>T;
   4.291 +                \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>t\<rangle>\<^sub>l\<guillemotright>C;
   4.292 +                G\<turnstile>s0 \<midarrow>t\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s1; (Normal P) Y s0 Z\<rbrakk> 
   4.293 +                \<Longrightarrow> Q (In3 vs) s1 Z \<and> s1\<Colon>\<preceq>(G,L)"
   4.294 +   shows "G,A|\<Turnstile>\<Colon>{ {Normal P} \<langle>t\<rangle>\<^sub>l\<succ> {Q} }"
   4.295 +apply (simp add: ax_valids2_def triple_valid2_def2)
   4.296 +apply (intro allI impI)
   4.297 +apply (elim exE conjE)
   4.298 +apply simp
   4.299 +apply (rule I)
   4.300 +by auto
   4.301 +
   4.302 +lemma validE [consumes 5]: 
   4.303 +  assumes valid: "G,A|\<Turnstile>\<Colon>{ {P} t\<succ> {Q} }"
   4.304 +   and    P: "P Y s0 Z"
   4.305 +   and    valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.306 +   and    conf: "s0\<Colon>\<preceq>(G,L)"
   4.307 +   and    eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)"
   4.308 +   and    wt: "normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T"
   4.309 +   and    da: "normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>t\<guillemotright>C"
   4.310 +   and    elim: "\<lbrakk>Q v s1 Z; s1\<Colon>\<preceq>(G,L)\<rbrakk> \<Longrightarrow> concl" 
   4.311 +  shows "concl"
   4.312 +using prems
   4.313 +by (simp add: ax_valids2_def triple_valid2_def2) fast
   4.314 +(* why consumes 5?. If I want to apply this lemma in a context wgere
   4.315 +   \<not> normal s0 holds,
   4.316 +   I can chain "\<not> normal s0" as fact number 6 and apply the rule with
   4.317 +   cases. Auto will then solve premise 6 and 7.
   4.318 +*)
   4.319 +
   4.320  lemma all_empty: "(!x. P) = P"
   4.321  by simp
   4.322 -lemma sound_valid2_lemma: 
   4.323 -"\<lbrakk>\<forall>v n. Ball A (triple_valid2 G n) \<longrightarrow> P v n; Ball A (triple_valid2 G n)\<rbrakk>
   4.324 - \<Longrightarrow>P v n"
   4.325 -by blast
   4.326 -ML {*
   4.327 -val fullsimptac = full_simp_tac(simpset() delsimps [thm "all_empty"]);
   4.328 -val sound_prepare_tac = EVERY'[REPEAT o thin_tac "?x \<in> ax_derivs G",
   4.329 - full_simp_tac (simpset()addsimps[thm "ax_valids2_def",thm "triple_valid2_def2",
   4.330 -                                  thm "imp_conjL"] delsimps[thm "all_empty"]),
   4.331 - Clarify_tac];
   4.332 -val sound_elim_tac = EVERY'[eresolve_tac (thms "evaln_elim_cases"), 
   4.333 -        TRY o eresolve_tac (thms "wt_elim_cases"), fullsimptac, Clarify_tac];
   4.334 -val sound_valid2_tac = REPEAT o FIRST'[smp_tac 1, 
   4.335 -                  datac (thm "sound_valid2_lemma") 1];
   4.336 -val sound_forw_hyp_tac = 
   4.337 - EVERY'[smp_tac 3 
   4.338 -          ORELSE' EVERY'[dtac spec,dtac spec, dtac spec,etac impE, Fast_tac] 
   4.339 -          ORELSE' EVERY'[dtac spec,dtac spec,etac impE, Fast_tac],
   4.340 -        fullsimptac, 
   4.341 -        smp_tac 2,TRY o smp_tac 1,
   4.342 -        TRY o EVERY'[etac impE, TRY o rtac impI, 
   4.343 -        atac ORELSE' (EVERY' [REPEAT o rtac exI,Blast_tac]),
   4.344 -        fullsimptac, Clarify_tac, TRY o smp_tac 1]]
   4.345 -*}
   4.346 -(* ### rtac conjI,rtac HOL.refl *)
   4.347 -lemma Call_sound: 
   4.348 -"\<lbrakk>wf_prog G; G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {Q}}; \<forall>a. G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>Val a} ps\<doteq>\<succ> {R a}};
   4.349 -  \<forall>a vs invC declC l. G,A|\<Turnstile>\<Colon>{ {(R a\<leftarrow>Vals vs \<and>.  
   4.350 -   (\<lambda>s. declC = invocation_declclass 
   4.351 -                    G mode (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr> \<and>
   4.352 -         invC = invocation_class mode (store s) a statT \<and>
   4.353 -            l = locals (store s)) ;.  
   4.354 -   init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> mode a vs) \<and>.  
   4.355 -   (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}  
   4.356 -   Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}}\<rbrakk> \<Longrightarrow>  
   4.357 -  G,A|\<Turnstile>\<Colon>{ {Normal P} {accC,statT,mode}e\<cdot>mn({pTs}ps)-\<succ> {S}}"
   4.358 -apply (tactic "EVERY'[sound_prepare_tac, sound_elim_tac, sound_valid2_tac] 1")
   4.359 -apply (rename_tac x1 s1 x2 s2 ab bb v vs m pTsa statDeclC)
   4.360 -apply (tactic "smp_tac 6 1")
   4.361 -apply (tactic "sound_forw_hyp_tac 1")
   4.362 -apply (tactic "sound_forw_hyp_tac 1")
   4.363 -apply (drule max_spec2mheads)
   4.364 -apply (drule (3) evaln_eval, drule (3) eval_ts)
   4.365 -apply (drule (3) evaln_eval, frule (3) evals_ts)
   4.366 -apply (drule spec,erule impE,rule exI, blast)
   4.367 -(* apply (drule spec,drule spec,drule spec,erule impE,rule exI,blast) *)
   4.368 -apply (case_tac "if is_static m then x2 else (np a') x2")
   4.369 -defer 1
   4.370 -apply  (rename_tac x, subgoal_tac "(Some x, s2)\<Colon>\<preceq>(G, L)" (* used two times *))
   4.371 -prefer 2 
   4.372 -apply   (force split add: split_if_asm)
   4.373 -apply  (simp del: if_raise_if_None)
   4.374 -apply  (tactic "smp_tac 2 1")
   4.375 -apply (simp only: init_lvars_def2 invmode_Static_eq)
   4.376 -apply (clarsimp simp del: resTy_mthd)
   4.377 -apply  (drule spec,erule swap,erule conforms_set_locals [OF _ lconf_empty])
   4.378 -apply clarsimp
   4.379 -apply (drule Null_staticD)
   4.380 -apply (drule eval_gext', drule (1) conf_gext, frule (3) DynT_propI)
   4.381 -apply (erule impE) apply blast
   4.382 -apply (subgoal_tac 
   4.383 - "G\<turnstile>invmode (mhd (statDeclC,m)) e
   4.384 -     \<rightarrow>invocation_class (invmode m e) s2 a' statT\<preceq>statT")
   4.385 -defer   apply simp
   4.386 -apply (drule (3) DynT_mheadsD,simp,simp)
   4.387 -apply (clarify, drule wf_mdeclD1, clarify)
   4.388 -apply (frule ty_expr_is_type) apply simp
   4.389 -apply (subgoal_tac "invmode (mhd (statDeclC,m)) e = IntVir \<longrightarrow> a' \<noteq> Null")
   4.390 -defer   apply simp
   4.391 -apply (frule (2) wt_MethdI)
   4.392 -apply clarify
   4.393 -apply (drule (2) conforms_init_lvars)
   4.394 -apply   (simp) 
   4.395 -apply   (assumption)+
   4.396 -apply   simp
   4.397 -apply   (assumption)+
   4.398 -apply   (rule impI) apply simp
   4.399 -apply   simp
   4.400 -apply   simp
   4.401 -apply   (rule Ball_weaken)
   4.402 -apply     assumption
   4.403 -apply     (force simp add: is_acc_type_def)
   4.404 -apply (tactic "smp_tac 2 1")
   4.405 -apply simp
   4.406 -apply (tactic "smp_tac 1 1")
   4.407 -apply (erule_tac V = "?P \<longrightarrow> ?Q" in thin_rl) 
   4.408 -apply (erule impE)
   4.409 -apply   (rule exI)+ 
   4.410 -apply   (subgoal_tac "is_static dm = (static m)") 
   4.411 -prefer 2  apply (simp add: member_is_static_simp)
   4.412 -apply   (simp only: )
   4.413 -apply   (simp only: sig.simps)
   4.414 -apply (force dest!: evaln_eval eval_gext' elim: conforms_return 
   4.415 -             del: impCE simp add: init_lvars_def2)
   4.416 -done
   4.417  
   4.418  corollary evaln_type_sound:
   4.419    assumes evaln: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)" and
   4.420               wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T" and
   4.421 +             da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>t\<guillemotright> A" and
   4.422          conf_s0: "s0\<Colon>\<preceq>(G,L)" and
   4.423               wf: "wf_prog G"                         
   4.424    shows "s1\<Colon>\<preceq>(G,L) \<and>  (normal s1 \<longrightarrow> G,L,store s1\<turnstile>t\<succ>v\<Colon>\<preceq>T) \<and> 
   4.425           (error_free s0 = error_free s1)"
   4.426  proof -
   4.427 -  from evaln wt conf_s0 wf
   4.428 -  show ?thesis
   4.429 -    by (blast dest: evaln_eval eval_type_sound)
   4.430 +  from evaln have "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)"
   4.431 +    by (rule evaln_eval)
   4.432 +  from this wt da wf conf_s0 show ?thesis
   4.433 +    by (rule eval_type_sound)
   4.434  qed
   4.435  
   4.436 -lemma Init_sound: "\<lbrakk>wf_prog G; the (class G C) = c;  
   4.437 -      G,A|\<Turnstile>\<Colon>{ {Normal ((P \<and>. Not \<circ> initd C) ;. supd (init_class_obj G C))}  
   4.438 -             .(if C = Object then Skip else Init (super c)). {Q}};  
   4.439 -  \<forall>l. G,A|\<Turnstile>\<Colon>{ {Q \<and>. (\<lambda>s. l = locals (store s)) ;. set_lvars empty}  
   4.440 -            .init c. {set_lvars l .; R}}\<rbrakk> \<Longrightarrow>  
   4.441 -      G,A|\<Turnstile>\<Colon>{ {Normal (P \<and>. Not \<circ> initd C)} .Init C. {R}}"
   4.442 -apply (tactic "EVERY'[sound_prepare_tac, sound_elim_tac,sound_valid2_tac] 1")
   4.443 -apply (tactic {* instantiate_tac [("l24","\<lambda> n Y Z sa Y' s' L y a b aa ba ab bb. locals b")]*})
   4.444 -apply (clarsimp simp add: split_paired_Ex)
   4.445 -apply (drule spec, drule spec, drule spec, erule impE)
   4.446 -apply  (erule_tac V = "All ?P" in thin_rl, fast)
   4.447 -apply clarsimp
   4.448 -apply (tactic "smp_tac 2 1", drule spec, erule impE, 
   4.449 -       erule (3) conforms_init_class_obj)
   4.450 -apply (frule (1) wf_prog_cdecl)
   4.451 -apply (erule impE, rule exI,erule_tac V = "All ?P" in thin_rl,
   4.452 -       force dest: wf_cdecl_supD split add: split_if simp add: is_acc_class_def)
   4.453 -apply clarify
   4.454 -apply (drule spec)
   4.455 -apply (drule spec)
   4.456 -apply (drule spec)
   4.457 -apply  (erule impE)
   4.458 -apply ( fast)
   4.459 -apply (simp (no_asm_use) del: empty_def2)
   4.460 -apply (tactic "smp_tac 2 1")
   4.461 -apply (drule spec, erule impE, erule conforms_set_locals, rule lconf_empty)
   4.462 -apply (erule impE,rule impI,rule exI,erule wf_cdecl_wt_init)
   4.463 -apply clarsimp
   4.464 -apply (erule (1) conforms_return)
   4.465 -apply (frule wf_cdecl_wt_init)
   4.466 -apply (subgoal_tac "(a, set_locals empty b)\<Colon>\<preceq>(G, empty)")
   4.467 -apply   (frule (3) evaln_eval)
   4.468 -apply   (drule eval_gext') 
   4.469 -apply   force
   4.470 -
   4.471 -        (* refer to case Init in eval_type_sound proof, to see whats going on*)
   4.472 -apply   (subgoal_tac "(a,b)\<Colon>\<preceq>(G, L)")
   4.473 -apply     (blast intro: conforms_set_locals)
   4.474 -
   4.475 -apply     (drule evaln_type_sound)
   4.476 -apply       (cases "C=Object") 
   4.477 -apply         force 
   4.478 -apply         (force dest: wf_cdecl_supD is_acc_classD)
   4.479 -apply     (erule (4) conforms_init_class_obj)
   4.480 -apply     blast
   4.481 -done
   4.482 -
   4.483 -lemma all_conjunct2: "\<forall>l. P' l \<and> P l \<Longrightarrow> \<forall>l. P l"
   4.484 -by fast
   4.485 -
   4.486 -lemma all4_conjunct2: 
   4.487 -  "\<forall>a vs D l. (P' a vs D l \<and> P a vs D l) \<Longrightarrow> \<forall>a vs D l. P a vs D l"
   4.488 -by fast
   4.489 -
   4.490 -
   4.491 -lemmas sound_lemmas = Init_sound Loop_sound Methd_sound
   4.492 -
   4.493 -lemma ax_sound2: "wf_prog G \<Longrightarrow> G,A|\<turnstile>ts \<Longrightarrow> G,A|\<Turnstile>\<Colon>ts"
   4.494 -apply (erule ax_derivs.induct)
   4.495 -prefer 22 (* Call *)
   4.496 -apply (erule (1) Call_sound) apply simp apply force apply force 
   4.497 -
   4.498 -apply (tactic {* TRYALL (eresolve_tac (thms "sound_lemmas") THEN_ALL_NEW 
   4.499 -    eresolve_tac [asm_rl, thm "all_conjunct2", thm "all4_conjunct2"]) *})
   4.500 -
   4.501 -apply(tactic "COND (has_fewer_prems(30+9)) (ALLGOALS sound_prepare_tac) no_tac")
   4.502 -
   4.503 -               (*empty*)
   4.504 -apply        fast (* insert *)
   4.505 -apply       fast (* asm *)
   4.506 -(*apply    fast *) (* cut *)
   4.507 -apply     fast (* weaken *)
   4.508 -apply    (tactic "smp_tac 3 1", clarify, tactic "smp_tac 1 1",
   4.509 -          case_tac"fst s",clarsimp,erule (3) evaln_type_sound [THEN conjunct1],
   4.510 -          clarsimp) (* conseq *)
   4.511 -apply   (simp (no_asm_use) add: type_ok_def,fast)(* hazard *)
   4.512 -apply  force (* Abrupt *)
   4.513 -
   4.514 -prefer 28 apply (simp add: evaln_InsInitV)
   4.515 -prefer 28 apply (simp add: evaln_InsInitE)
   4.516 -prefer 28 apply (simp add: evaln_Callee)
   4.517 -prefer 28 apply (simp add: evaln_FinA)
   4.518 -
   4.519 -(* 27 subgoals *)
   4.520 -apply (tactic {* sound_elim_tac 1 *})
   4.521 -apply (tactic {* ALLGOALS sound_elim_tac *})(* LVar, Lit, Super, Nil, Skip,Do *)
   4.522 -apply (tactic {* ALLGOALS (asm_simp_tac (noAll_simpset() 
   4.523 -                          delsimps [thm "all_empty"])) *})    (* Done *)
   4.524 -(* for FVar *)
   4.525 -apply (frule wf_ws_prog) 
   4.526 -apply (frule ty_expr_is_type [THEN type_is_class, 
   4.527 -                              THEN accfield_declC_is_class])
   4.528 -apply (simp (no_asm_use), simp (no_asm_use), simp (no_asm_use))
   4.529 -apply (frule_tac [4] wt_init_comp_ty) (* for NewA*)
   4.530 -apply (tactic "ALLGOALS sound_valid2_tac")
   4.531 -apply (tactic "TRYALL sound_forw_hyp_tac") (* UnOp, Cast, Inst, Acc, Expr *)
   4.532 -apply (tactic {* TRYALL (EVERY'[dtac spec, TRY o EVERY'[rotate_tac ~1, 
   4.533 -  dtac spec], dtac conjunct2, smp_tac 1, 
   4.534 -  TRY o dres_inst_tac [("P","P'")] (thm "subst_Bool_the_BoolI")]) *})
   4.535 -apply (frule_tac [15] x = x1 in conforms_NormI)  (* for Fin *)
   4.536 -
   4.537 -(* 15 subgoals *)
   4.538 -(* FVar *)
   4.539 -apply (tactic "sound_forw_hyp_tac 1")
   4.540 -apply (clarsimp simp add: fvar_def2 Let_def split add: split_if_asm)
   4.541 -
   4.542 -(* AVar *)
   4.543 -(*
   4.544 -apply (drule spec, drule spec, erule impE, fast)
   4.545 -apply (simp)
   4.546 -apply (tactic "smp_tac 2 1")
   4.547 -apply (tactic "smp_tac 1 1")
   4.548 -apply (erule impE)
   4.549 -apply (rule impI)
   4.550 -apply (rule exI)+
   4.551 -apply blast
   4.552 -apply (clarsimp simp add: avar_def2)
   4.553 -*)
   4.554 -apply (tactic "sound_forw_hyp_tac 1")
   4.555 -apply (clarsimp simp add: avar_def2)
   4.556 -
   4.557 -(* NewC *)
   4.558 -apply (clarsimp simp add: is_acc_class_def)
   4.559 -apply (erule (1) halloc_conforms, simp, simp)
   4.560 -
   4.561 -(* NewA *)
   4.562 -apply (tactic "sound_forw_hyp_tac 1")
   4.563 -apply (rule conjI,blast)
   4.564 -apply (erule (1) halloc_conforms, simp, simp, simp add: is_acc_type_def)
   4.565 -
   4.566 -(* BinOp *)
   4.567 -apply (tactic "sound_forw_hyp_tac 1")
   4.568 -apply (case_tac "need_second_arg binop v1")
   4.569 -apply   fastsimp
   4.570 -apply   simp
   4.571 -
   4.572 -(* Ass *)
   4.573 -apply (tactic "sound_forw_hyp_tac 1")
   4.574 -apply (case_tac "aa")
   4.575 -prefer 2
   4.576 -apply  clarsimp
   4.577 -apply (drule (3) evaln_type_sound)
   4.578 -apply (drule (3) evaln_eval)
   4.579 -apply (frule (3) eval_type_sound)
   4.580 -apply clarsimp
   4.581 -apply (frule wf_ws_prog)
   4.582 -apply (drule (2) conf_widen)
   4.583 -apply (drule_tac "s1.0" = b in eval_gext')
   4.584 -apply (clarsimp simp add: assign_conforms_def)
   4.585 -
   4.586 -
   4.587 -(* Cond *)
   4.588 -apply (tactic "smp_tac 3 1") apply (tactic "smp_tac 2 1") 
   4.589 -apply (tactic "smp_tac 1 1") apply (erule impE) 
   4.590 -apply (rule impI,rule exI) 
   4.591 -apply (rule_tac x = "if the_Bool b then T1 else T2" in exI)
   4.592 -apply (force split add: split_if)
   4.593 -apply assumption
   4.594 -
   4.595 -(* Body *)
   4.596 -apply (tactic "sound_forw_hyp_tac 1")
   4.597 -apply (rule conforms_absorb,assumption)
   4.598 -
   4.599 -(* Lab *)
   4.600 -apply (tactic "sound_forw_hyp_tac 1")
   4.601 -apply (rule conforms_absorb,assumption)
   4.602 -
   4.603 -(* If *)
   4.604 -apply (tactic "sound_forw_hyp_tac 1")
   4.605 -apply (tactic "sound_forw_hyp_tac 1")
   4.606 -apply (force split add: split_if)
   4.607 -
   4.608 -(* Throw *)
   4.609 -apply (drule (3) evaln_type_sound)
   4.610 -apply clarsimp
   4.611 -apply (drule (3) Throw_lemma)
   4.612 -apply clarsimp
   4.613 -
   4.614 -(* Try *)
   4.615 -apply (frule (1) sxalloc_type_sound)
   4.616 -apply (erule sxalloc_elim_cases2)
   4.617 -apply  (tactic "smp_tac 3 1")
   4.618 -apply  (clarsimp split add: option.split_asm)
   4.619 -apply (clarsimp split add: option.split_asm)
   4.620 -apply (tactic "smp_tac 1 1")
   4.621 -apply (simp only: split add: split_if_asm)
   4.622 -prefer 2
   4.623 -apply  (tactic "smp_tac 3 1", erule_tac V = "All ?P" in thin_rl, clarsimp)
   4.624 -apply (drule spec, erule_tac V = "All ?P" in thin_rl, drule spec, drule spec, 
   4.625 -       erule impE, force)
   4.626 -apply (frule (2) Try_lemma)
   4.627 -apply clarsimp
   4.628 -apply (fast elim!: conforms_deallocL)
   4.629 -
   4.630 -(* Fin *)
   4.631 -apply (tactic "sound_forw_hyp_tac 1")
   4.632 -apply (case_tac "x1", force)
   4.633 -apply clarsimp
   4.634 -apply (drule (3) evaln_eval, drule (4) Fin_lemma)
   4.635 -done
   4.636 +corollary dom_locals_evaln_mono_elim [consumes 1]: 
   4.637 +  assumes   
   4.638 +  evaln: "G\<turnstile> s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)" and
   4.639 +    hyps: "\<lbrakk>dom (locals (store s0)) \<subseteq> dom (locals (store s1));
   4.640 +           \<And> vv s val. \<lbrakk>v=In2 vv; normal s1\<rbrakk> 
   4.641 +                        \<Longrightarrow> dom (locals (store s)) 
   4.642 +                             \<subseteq> dom (locals (store ((snd vv) val s)))\<rbrakk> \<Longrightarrow> P"
   4.643 + shows "P"
   4.644 +proof -
   4.645 +  from evaln have "G\<turnstile> s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)" by (rule evaln_eval)
   4.646 +  from this hyps show ?thesis
   4.647 +    by (rule dom_locals_eval_mono_elim) rules+
   4.648 +qed
   4.649  
   4.650  
   4.651  
   4.652 -declare subst_Bool_def2 [simp]
   4.653 +lemma evaln_no_abrupt: 
   4.654 +   "\<And>s s'. \<lbrakk>G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (w,s'); normal s'\<rbrakk> \<Longrightarrow> normal s"
   4.655 +by (erule evaln_cases,auto)
   4.656 +
   4.657 +declare inj_term_simps [simp]
   4.658 +lemma ax_sound2: 
   4.659 +  assumes    wf: "wf_prog G" 
   4.660 +    and   deriv: "G,A|\<turnstile>ts"
   4.661 +  shows "G,A|\<Turnstile>\<Colon>ts"
   4.662 +using deriv
   4.663 +proof (induct)
   4.664 +  case (empty A)
   4.665 +  show ?case
   4.666 +    by (simp add: ax_valids2_def triple_valid2_def2)
   4.667 +next
   4.668 +  case (insert A t ts)
   4.669 +  have valid_t: "G,A|\<Turnstile>\<Colon>{t}" . 
   4.670 +  moreover have valid_ts: "G,A|\<Turnstile>\<Colon>ts" .
   4.671 +  {
   4.672 +    fix n assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.673 +    have "G\<Turnstile>n\<Colon>t" and "\<forall>t\<in>ts. G\<Turnstile>n\<Colon>t"
   4.674 +    proof -
   4.675 +      from valid_A valid_t show "G\<Turnstile>n\<Colon>t"
   4.676 +	by (simp add: ax_valids2_def)
   4.677 +    next
   4.678 +      from valid_A valid_ts show "\<forall>t\<in>ts. G\<Turnstile>n\<Colon>t"
   4.679 +	by (unfold ax_valids2_def) blast
   4.680 +    qed
   4.681 +    hence "\<forall>t'\<in>insert t ts. G\<Turnstile>n\<Colon>t'"
   4.682 +      by simp
   4.683 +  }
   4.684 +  thus ?case
   4.685 +    by (unfold ax_valids2_def) blast
   4.686 +next
   4.687 +  case (asm A ts)
   4.688 +  have "ts \<subseteq> A" .
   4.689 +  then show "G,A|\<Turnstile>\<Colon>ts"
   4.690 +    by (auto simp add: ax_valids2_def triple_valid2_def)
   4.691 +next
   4.692 +  case (weaken A ts ts')
   4.693 +  have "G,A|\<Turnstile>\<Colon>ts'" .
   4.694 +  moreover have "ts \<subseteq> ts'" .
   4.695 +  ultimately show "G,A|\<Turnstile>\<Colon>ts"
   4.696 +    by (unfold ax_valids2_def triple_valid2_def) blast
   4.697 +next
   4.698 +  case (conseq A P Q t)
   4.699 +  have con: "\<forall>Y s Z. P Y s Z \<longrightarrow> 
   4.700 +              (\<exists>P' Q'.
   4.701 +                  (G,A\<turnstile>{P'} t\<succ> {Q'} \<and> G,A|\<Turnstile>\<Colon>{ {P'} t\<succ> {Q'} }) \<and>
   4.702 +                  (\<forall>Y' s'. (\<forall>Y Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow> Q Y' s' Z))".
   4.703 +  show "G,A|\<Turnstile>\<Colon>{ {P} t\<succ> {Q} }"
   4.704 +  proof (rule validI)
   4.705 +    fix n s0 L accC T C v s1 Y Z
   4.706 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t" 
   4.707 +    assume conf: "s0\<Colon>\<preceq>(G,L)"
   4.708 +    assume wt: "normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T"
   4.709 +    assume da: "normal s0 
   4.710 +                 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>t\<guillemotright> C"
   4.711 +    assume eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s1)"
   4.712 +    assume P: "P Y s0 Z"
   4.713 +    show "Q v s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
   4.714 +    proof -
   4.715 +      from valid_A conf wt da eval P con
   4.716 +      have "Q v s1 Z"
   4.717 +	apply (simp add: ax_valids2_def triple_valid2_def2)
   4.718 +	apply (tactic "smp_tac 3 1")
   4.719 +	apply clarify
   4.720 +	apply (tactic "smp_tac 1 1")
   4.721 +	apply (erule allE,erule allE, erule mp)
   4.722 +	apply (intro strip)
   4.723 +	apply (tactic "smp_tac 3 1")
   4.724 +	apply (tactic "smp_tac 2 1")
   4.725 +	apply (tactic "smp_tac 1 1")
   4.726 +	by blast
   4.727 +      moreover have "s1\<Colon>\<preceq>(G, L)"
   4.728 +      proof (cases "normal s0")
   4.729 +	case True
   4.730 +	from eval wt [OF True] da [OF True] conf wf 
   4.731 +	show ?thesis
   4.732 +	  by (rule evaln_type_sound [elim_format]) simp
   4.733 +      next
   4.734 +	case False
   4.735 +	with eval have "s1=s0"
   4.736 +	  by auto
   4.737 +	with conf show ?thesis by simp
   4.738 +      qed
   4.739 +      ultimately show ?thesis ..
   4.740 +    qed
   4.741 +  qed
   4.742 +next
   4.743 +  case (hazard A P Q t)
   4.744 +  show "G,A|\<Turnstile>\<Colon>{ {P \<and>. Not \<circ> type_ok G t} t\<succ> {Q} }"
   4.745 +    by (simp add: ax_valids2_def triple_valid2_def2 type_ok_def) fast
   4.746 +next
   4.747 +  case (Abrupt A P t)
   4.748 +  show "G,A|\<Turnstile>\<Colon>{ {P\<leftarrow>arbitrary3 t \<and>. Not \<circ> normal} t\<succ> {P} }"
   4.749 +  proof (rule validI)
   4.750 +    fix n s0 L accC T C v s1 Y Z 
   4.751 +    assume conf_s0: "s0\<Colon>\<preceq>(G, L)"
   4.752 +    assume eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s1)"
   4.753 +    assume "(P\<leftarrow>arbitrary3 t \<and>. Not \<circ> normal) Y s0 Z"
   4.754 +    then obtain P: "P (arbitrary3 t) s0 Z" and abrupt_s0: "\<not> normal s0"
   4.755 +      by simp
   4.756 +    from eval abrupt_s0 obtain "s1=s0" and "v=arbitrary3 t"
   4.757 +      by auto
   4.758 +    with P conf_s0
   4.759 +    show "P v s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
   4.760 +      by simp
   4.761 +  qed
   4.762 +next
   4.763 +  case (LVar A P vn)
   4.764 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (\<lambda>s.. P\<leftarrow>In2 (lvar vn s))} LVar vn=\<succ> {P} }"
   4.765 +  proof (rule valid_var_NormalI)
   4.766 +    fix n s0 L accC T C vf s1 Y Z
   4.767 +    assume conf_s0: "s0\<Colon>\<preceq>(G, L)"
   4.768 +    assume normal_s0: "normal s0"
   4.769 +    assume wt: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>LVar vn\<Colon>=T"
   4.770 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>LVar vn\<rangle>\<^sub>v\<guillemotright> C"
   4.771 +    assume eval: "G\<turnstile>s0 \<midarrow>LVar vn=\<succ>vf\<midarrow>n\<rightarrow> s1" 
   4.772 +    assume P: "(Normal (\<lambda>s.. P\<leftarrow>In2 (lvar vn s))) Y s0 Z"
   4.773 +    show "P (In2 vf) s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
   4.774 +    proof 
   4.775 +      from eval normal_s0 obtain "s1=s0" "vf=lvar vn (store s0)"
   4.776 +	by (fastsimp elim: evaln_elim_cases)
   4.777 +      with P show "P (In2 vf) s1 Z"
   4.778 +	by simp
   4.779 +    next
   4.780 +      from eval wt da conf_s0 wf
   4.781 +      show "s1\<Colon>\<preceq>(G, L)"
   4.782 +	by (rule evaln_type_sound [elim_format]) simp
   4.783 +    qed
   4.784 +  qed
   4.785 +next
   4.786 +  case (FVar A statDeclC P Q R accC e fn stat)
   4.787 +  have valid_init: "G,A|\<Turnstile>\<Colon>{ {Normal P} .Init statDeclC. {Q} }" .
   4.788 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Q} e-\<succ> {\<lambda>Val:a:. fvar statDeclC stat fn a ..; R} }" .
   4.789 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} {accC,statDeclC,stat}e..fn=\<succ> {R} }"
   4.790 +  proof (rule valid_var_NormalI)
   4.791 +    fix n s0 L accC' T V vf s3 Y Z
   4.792 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.793 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
   4.794 +    assume normal_s0: "normal s0"
   4.795 +    assume wt: "\<lparr>prg=G,cls=accC',lcl=L\<rparr>\<turnstile>{accC,statDeclC,stat}e..fn\<Colon>=T"
   4.796 +    assume da: "\<lparr>prg=G,cls=accC',lcl=L\<rparr>
   4.797 +                  \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>{accC,statDeclC,stat}e..fn\<rangle>\<^sub>v\<guillemotright> V"
   4.798 +    assume eval: "G\<turnstile>s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>vf\<midarrow>n\<rightarrow> s3"
   4.799 +    assume P: "(Normal P) Y s0 Z"
   4.800 +    show "R \<lfloor>vf\<rfloor>\<^sub>v s3 Z \<and> s3\<Colon>\<preceq>(G, L)"
   4.801 +    proof -
   4.802 +      from wt obtain statC f where
   4.803 +        wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-Class statC" and
   4.804 +        accfield: "accfield G accC statC fn = Some (statDeclC,f)" and
   4.805 +	eq_accC: "accC=accC'" and
   4.806 +        stat: "stat=is_static f" and
   4.807 +	T: "T=(type f)"
   4.808 +	by (cases) (auto simp add: member_is_static_simp)
   4.809 +      from da eq_accC
   4.810 +      have da_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> V"
   4.811 +	by cases simp
   4.812 +      from eval obtain a s1 s2 s2' where
   4.813 +	eval_init: "G\<turnstile>s0 \<midarrow>Init statDeclC\<midarrow>n\<rightarrow> s1" and 
   4.814 +        eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s2" and 
   4.815 +	fvar: "(vf,s2')=fvar statDeclC stat fn a s2" and
   4.816 +	s3: "s3 = check_field_access G accC statDeclC fn stat a s2'"
   4.817 +	using normal_s0 by (fastsimp elim: evaln_elim_cases) 
   4.818 +      have wt_init: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>(Init statDeclC)\<Colon>\<surd>"
   4.819 +      proof -
   4.820 +	from wf wt_e 
   4.821 +	have iscls_statC: "is_class G statC"
   4.822 +	  by (auto dest: ty_expr_is_type type_is_class)
   4.823 +	with wf accfield 
   4.824 +	have iscls_statDeclC: "is_class G statDeclC"
   4.825 +	  by (auto dest!: accfield_fields dest: fields_declC)
   4.826 +	thus ?thesis by simp
   4.827 +      qed
   4.828 +      obtain I where 
   4.829 +	da_init: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
   4.830 +                    \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>Init statDeclC\<rangle>\<^sub>s\<guillemotright> I"
   4.831 +	by (auto intro: da_Init [simplified] assigned.select_convs)
   4.832 +      from valid_init P valid_A conf_s0 eval_init wt_init da_init
   4.833 +      obtain Q: "Q \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G, L)"
   4.834 +	by (rule validE)
   4.835 +      obtain 
   4.836 +	R: "R \<lfloor>vf\<rfloor>\<^sub>v s2' Z" and 
   4.837 +        conf_s2: "s2\<Colon>\<preceq>(G, L)" and
   4.838 +	conf_a: "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
   4.839 +      proof (cases "normal s1")
   4.840 +	case True
   4.841 +	obtain V' where 
   4.842 +	  da_e':
   4.843 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile>dom (locals (store s1))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> V'"
   4.844 +	proof -
   4.845 +	  from eval_init 
   4.846 +	  have "(dom (locals (store s0))) \<subseteq> (dom (locals (store s1)))"
   4.847 +	    by (rule dom_locals_evaln_mono_elim)
   4.848 +	  with da_e show ?thesis
   4.849 +	    by (rule da_weakenE)
   4.850 +	qed
   4.851 +	with valid_e Q valid_A conf_s1 eval_e wt_e
   4.852 +	obtain "R \<lfloor>vf\<rfloor>\<^sub>v s2' Z" and "s2\<Colon>\<preceq>(G, L)"
   4.853 +	  by (rule validE) (simp add: fvar [symmetric])
   4.854 +	moreover
   4.855 +	from eval_e wt_e da_e' conf_s1 wf
   4.856 +	have "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
   4.857 +	  by (rule evaln_type_sound [elim_format]) simp
   4.858 +	ultimately show ?thesis ..
   4.859 +      next
   4.860 +	case False
   4.861 +	with valid_e Q valid_A conf_s1 eval_e
   4.862 +	obtain  "R \<lfloor>vf\<rfloor>\<^sub>v s2' Z" and "s2\<Colon>\<preceq>(G, L)"
   4.863 +	  by (cases rule: validE) (simp add: fvar [symmetric])+
   4.864 +	moreover from False eval_e have "\<not> normal s2"
   4.865 +	  by auto
   4.866 +	hence "normal s2 \<longrightarrow> G,store s2\<turnstile>a\<Colon>\<preceq>Class statC"
   4.867 +	  by auto
   4.868 +	ultimately show ?thesis ..
   4.869 +      qed
   4.870 +      from accfield wt_e eval_init eval_e conf_s2 conf_a fvar stat s3 wf
   4.871 +      have eq_s3_s2': "s3=s2'"  
   4.872 +	using normal_s0 by (auto dest!: error_free_field_access evaln_eval)
   4.873 +      moreover
   4.874 +      from eval wt da conf_s0 wf
   4.875 +      have "s3\<Colon>\<preceq>(G, L)"
   4.876 +	by (rule evaln_type_sound [elim_format]) simp
   4.877 +      ultimately show ?thesis using Q by simp
   4.878 +    qed
   4.879 +  qed
   4.880 +next   
   4.881 +  case (AVar A P Q R e1 e2)
   4.882 +  have valid_e1: "G,A|\<Turnstile>\<Colon>{ {Normal P} e1-\<succ> {Q} }" .
   4.883 +  have valid_e2: "\<And> a. G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>In1 a} e2-\<succ> {\<lambda>Val:i:. avar G i a ..; R} }"
   4.884 +    using AVar.hyps by simp
   4.885 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} e1.[e2]=\<succ> {R} }"
   4.886 +  proof (rule valid_var_NormalI)
   4.887 +    fix n s0 L accC T V vf s2' Y Z
   4.888 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.889 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
   4.890 +    assume normal_s0: "normal s0"
   4.891 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1.[e2]\<Colon>=T"
   4.892 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
   4.893 +                  \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e1.[e2]\<rangle>\<^sub>v\<guillemotright> V"
   4.894 +    assume eval: "G\<turnstile>s0 \<midarrow>e1.[e2]=\<succ>vf\<midarrow>n\<rightarrow> s2'"
   4.895 +    assume P: "(Normal P) Y s0 Z"
   4.896 +    show "R \<lfloor>vf\<rfloor>\<^sub>v s2' Z \<and> s2'\<Colon>\<preceq>(G, L)"
   4.897 +    proof -
   4.898 +      from wt obtain 
   4.899 +	wt_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1\<Colon>-T.[]" and
   4.900 +        wt_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e2\<Colon>-PrimT Integer" 
   4.901 +	by (rule wt_elim_cases) simp
   4.902 +      from da obtain E1 where
   4.903 +	da_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile>dom (locals (store s0))\<guillemotright>\<langle>e1\<rangle>\<^sub>e\<guillemotright> E1" and
   4.904 +	da_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> nrm E1 \<guillemotright>\<langle>e2\<rangle>\<^sub>e\<guillemotright> V"
   4.905 +	by (rule da_elim_cases) simp
   4.906 +      from eval obtain s1 a i s2 where
   4.907 +	eval_e1: "G\<turnstile>s0 \<midarrow>e1-\<succ>a\<midarrow>n\<rightarrow> s1" and
   4.908 +	eval_e2: "G\<turnstile>s1 \<midarrow>e2-\<succ>i\<midarrow>n\<rightarrow> s2" and
   4.909 +	avar: "avar G i a s2 =(vf, s2')"
   4.910 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
   4.911 +      from valid_e1 P valid_A conf_s0 eval_e1 wt_e1 da_e1
   4.912 +      obtain Q: "Q \<lfloor>a\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G, L)"
   4.913 +	by (rule validE)
   4.914 +      from Q have Q': "\<And> v. (Q\<leftarrow>In1 a) v s1 Z"
   4.915 +	by simp
   4.916 +      have "R \<lfloor>vf\<rfloor>\<^sub>v s2' Z"
   4.917 +      proof (cases "normal s1")
   4.918 +	case True
   4.919 +	obtain V' where 
   4.920 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile>dom (locals (store s1))\<guillemotright>\<langle>e2\<rangle>\<^sub>e\<guillemotright> V'"
   4.921 +	proof -
   4.922 +	  from eval_e1  wt_e1 da_e1 wf True
   4.923 +	  have "nrm E1 \<subseteq> dom (locals (store s1))"
   4.924 +	    by (cases rule: da_good_approx_evalnE) rules
   4.925 +	  with da_e2 show ?thesis
   4.926 +	    by (rule da_weakenE)
   4.927 +	qed
   4.928 +	with valid_e2 Q' valid_A conf_s1 eval_e2 wt_e2 
   4.929 +	show ?thesis
   4.930 +	  by (rule validE) (simp add: avar)
   4.931 +      next
   4.932 +	case False
   4.933 +	with valid_e2 Q' valid_A conf_s1 eval_e2
   4.934 +	show ?thesis
   4.935 +	  by (cases rule: validE) (simp add: avar)+
   4.936 +      qed
   4.937 +      moreover
   4.938 +      from eval wt da conf_s0 wf
   4.939 +      have "s2'\<Colon>\<preceq>(G, L)"
   4.940 +	by (rule evaln_type_sound [elim_format]) simp
   4.941 +      ultimately show ?thesis ..
   4.942 +    qed
   4.943 +  qed
   4.944 +next
   4.945 +  case (NewC A C P Q)
   4.946 +  have valid_init: "G,A|\<Turnstile>\<Colon>{ {Normal P} .Init C. {Alloc G (CInst C) Q} }".
   4.947 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} NewC C-\<succ> {Q} }"
   4.948 +  proof (rule valid_expr_NormalI)
   4.949 +    fix n s0 L accC T E v s2 Y Z
   4.950 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.951 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
   4.952 +    assume normal_s0: "normal s0"
   4.953 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>NewC C\<Colon>-T"
   4.954 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
   4.955 +                  \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>NewC C\<rangle>\<^sub>e\<guillemotright> E"
   4.956 +    assume eval: "G\<turnstile>s0 \<midarrow>NewC C-\<succ>v\<midarrow>n\<rightarrow> s2"
   4.957 +    assume P: "(Normal P) Y s0 Z"
   4.958 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
   4.959 +    proof -
   4.960 +      from wt obtain is_cls_C: "is_class G C" 
   4.961 +	by (rule wt_elim_cases) (auto dest: is_acc_classD)
   4.962 +      hence wt_init: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>Init C\<Colon>\<surd>" 
   4.963 +	by auto
   4.964 +      obtain I where 
   4.965 +	da_init: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>Init C\<rangle>\<^sub>s\<guillemotright> I"
   4.966 +	by (auto intro: da_Init [simplified] assigned.select_convs)
   4.967 +      from eval obtain s1 a where
   4.968 +	eval_init: "G\<turnstile>s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s1" and 
   4.969 +        alloc: "G\<turnstile>s1 \<midarrow>halloc CInst C\<succ>a\<rightarrow> s2" and
   4.970 +	v: "v=Addr a"
   4.971 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
   4.972 +      from valid_init P valid_A conf_s0 eval_init wt_init da_init
   4.973 +      obtain "(Alloc G (CInst C) Q) \<diamondsuit> s1 Z" 
   4.974 +	by (rule validE)
   4.975 +      with alloc v have "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z"
   4.976 +	by simp
   4.977 +      moreover
   4.978 +      from eval wt da conf_s0 wf
   4.979 +      have "s2\<Colon>\<preceq>(G, L)"
   4.980 +	by (rule evaln_type_sound [elim_format]) simp
   4.981 +      ultimately show ?thesis ..
   4.982 +    qed
   4.983 +  qed
   4.984 +next
   4.985 +  case (NewA A P Q R T e)
   4.986 +  have valid_init: "G,A|\<Turnstile>\<Colon>{ {Normal P} .init_comp_ty T. {Q} }" .
   4.987 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Q} e-\<succ> {\<lambda>Val:i:. abupd (check_neg i) .; 
   4.988 +                                            Alloc G (Arr T (the_Intg i)) R}}" .
   4.989 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} New T[e]-\<succ> {R} }"
   4.990 +  proof (rule valid_expr_NormalI)
   4.991 +    fix n s0 L accC arrT E v s3 Y Z
   4.992 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
   4.993 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
   4.994 +    assume normal_s0: "normal s0"
   4.995 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>New T[e]\<Colon>-arrT"
   4.996 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>New T[e]\<rangle>\<^sub>e\<guillemotright> E"
   4.997 +    assume eval: "G\<turnstile>s0 \<midarrow>New T[e]-\<succ>v\<midarrow>n\<rightarrow> s3"
   4.998 +    assume P: "(Normal P) Y s0 Z"
   4.999 +    show "R \<lfloor>v\<rfloor>\<^sub>e s3 Z \<and> s3\<Colon>\<preceq>(G, L)"
  4.1000 +    proof -
  4.1001 +      from wt obtain
  4.1002 +	wt_init: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>init_comp_ty T\<Colon>\<surd>" and 
  4.1003 +	wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-PrimT Integer" 
  4.1004 +	by (rule wt_elim_cases) (auto intro: wt_init_comp_ty )
  4.1005 +      from da obtain
  4.1006 +	da_e:"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1007 +	by cases simp
  4.1008 +      from eval obtain s1 i s2 a where
  4.1009 +	eval_init: "G\<turnstile>s0 \<midarrow>init_comp_ty T\<midarrow>n\<rightarrow> s1" and 
  4.1010 +        eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>i\<midarrow>n\<rightarrow> s2" and
  4.1011 +        alloc: "G\<turnstile>abupd (check_neg i) s2 \<midarrow>halloc Arr T (the_Intg i)\<succ>a\<rightarrow> s3" and
  4.1012 +        v: "v=Addr a"
  4.1013 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1014 +      obtain I where
  4.1015 +	da_init:
  4.1016 +	"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>init_comp_ty T\<rangle>\<^sub>s\<guillemotright> I"
  4.1017 +      proof (cases "\<exists>C. T = Class C")
  4.1018 +	case True
  4.1019 +	thus ?thesis
  4.1020 +	  by - (rule that, (auto intro: da_Init [simplified] 
  4.1021 +                                        assigned.select_convs
  4.1022 +                              simp add: init_comp_ty_def))
  4.1023 +	 (* simplified: to rewrite \<langle>Init C\<rangle> to In1r (Init C) *)
  4.1024 +      next
  4.1025 +	case False
  4.1026 +	thus ?thesis
  4.1027 +	  by - (rule that, (auto intro: da_Skip [simplified] 
  4.1028 +                                      assigned.select_convs
  4.1029 +                           simp add: init_comp_ty_def))
  4.1030 +         (* simplified: to rewrite \<langle>Skip\<rangle> to In1r (Skip) *)
  4.1031 +      qed
  4.1032 +      with valid_init P valid_A conf_s0 eval_init wt_init 
  4.1033 +      obtain Q: "Q \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G, L)"
  4.1034 +	by (rule validE)
  4.1035 +      obtain E' where
  4.1036 +       "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E'"
  4.1037 +      proof -
  4.1038 +	from eval_init 
  4.1039 +	have "dom (locals (store s0)) \<subseteq> dom (locals (store s1))"
  4.1040 +	  by (rule dom_locals_evaln_mono_elim)
  4.1041 +	with da_e show ?thesis
  4.1042 +	  by (rule da_weakenE)
  4.1043 +      qed
  4.1044 +      with valid_e Q valid_A conf_s1 eval_e wt_e
  4.1045 +      have "(\<lambda>Val:i:. abupd (check_neg i) .; 
  4.1046 +                      Alloc G (Arr T (the_Intg i)) R) \<lfloor>i\<rfloor>\<^sub>e s2 Z"
  4.1047 +	by (rule validE)
  4.1048 +      with alloc v have "R \<lfloor>v\<rfloor>\<^sub>e s3 Z"
  4.1049 +	by simp
  4.1050 +      moreover 
  4.1051 +      from eval wt da conf_s0 wf
  4.1052 +      have "s3\<Colon>\<preceq>(G, L)"
  4.1053 +	by (rule evaln_type_sound [elim_format]) simp
  4.1054 +      ultimately show ?thesis ..
  4.1055 +    qed
  4.1056 +  qed
  4.1057 +next
  4.1058 +  case (Cast A P Q T e)
  4.1059 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> 
  4.1060 +                 {\<lambda>Val:v:. \<lambda>s.. abupd (raise_if (\<not> G,s\<turnstile>v fits T) ClassCast) .;
  4.1061 +                  Q\<leftarrow>In1 v} }" .
  4.1062 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} Cast T e-\<succ> {Q} }"
  4.1063 +  proof (rule valid_expr_NormalI)
  4.1064 +    fix n s0 L accC castT E v s2 Y Z
  4.1065 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1066 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1067 +    assume normal_s0: "normal s0"
  4.1068 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Cast T e\<Colon>-castT"
  4.1069 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>Cast T e\<rangle>\<^sub>e\<guillemotright> E"
  4.1070 +    assume eval: "G\<turnstile>s0 \<midarrow>Cast T e-\<succ>v\<midarrow>n\<rightarrow> s2"
  4.1071 +    assume P: "(Normal P) Y s0 Z"
  4.1072 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
  4.1073 +    proof -
  4.1074 +      from wt obtain eT where 
  4.1075 +	wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" 
  4.1076 +	by cases simp
  4.1077 +      from da obtain
  4.1078 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1079 +	by cases simp
  4.1080 +      from eval obtain s1 where
  4.1081 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1" and
  4.1082 +        s2: "s2 = abupd (raise_if (\<not> G,snd s1\<turnstile>v fits T) ClassCast) s1"
  4.1083 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1084 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e
  4.1085 +      have "(\<lambda>Val:v:. \<lambda>s.. abupd (raise_if (\<not> G,s\<turnstile>v fits T) ClassCast) .;
  4.1086 +                  Q\<leftarrow>In1 v) \<lfloor>v\<rfloor>\<^sub>e s1 Z"
  4.1087 +	by (rule validE)
  4.1088 +      with s2 have "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z"
  4.1089 +	by simp
  4.1090 +      moreover
  4.1091 +      from eval wt da conf_s0 wf
  4.1092 +      have "s2\<Colon>\<preceq>(G, L)"
  4.1093 +	by (rule evaln_type_sound [elim_format]) simp
  4.1094 +      ultimately show ?thesis ..
  4.1095 +    qed
  4.1096 +  qed
  4.1097 +next
  4.1098 +  case (Inst A P Q T e)
  4.1099 +  assume valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ>
  4.1100 +               {\<lambda>Val:v:. \<lambda>s.. Q\<leftarrow>In1 (Bool (v \<noteq> Null \<and> G,s\<turnstile>v fits RefT T))} }"
  4.1101 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} e InstOf T-\<succ> {Q} }"
  4.1102 +  proof (rule valid_expr_NormalI)
  4.1103 +    fix n s0 L accC instT E v s1 Y Z
  4.1104 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1105 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1106 +    assume normal_s0: "normal s0"
  4.1107 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e InstOf T\<Colon>-instT"
  4.1108 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>e InstOf T\<rangle>\<^sub>e\<guillemotright> E"
  4.1109 +    assume eval: "G\<turnstile>s0 \<midarrow>e InstOf T-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.1110 +    assume P: "(Normal P) Y s0 Z"
  4.1111 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1112 +    proof -
  4.1113 +      from wt obtain eT where 
  4.1114 +	wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" 
  4.1115 +	by cases simp
  4.1116 +      from da obtain
  4.1117 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1118 +	by cases simp
  4.1119 +      from eval obtain a where
  4.1120 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s1" and
  4.1121 +        v: "v = Bool (a \<noteq> Null \<and> G,store s1\<turnstile>a fits RefT T)"
  4.1122 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1123 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e
  4.1124 +      have "(\<lambda>Val:v:. \<lambda>s.. Q\<leftarrow>In1 (Bool (v \<noteq> Null \<and> G,s\<turnstile>v fits RefT T))) 
  4.1125 +              \<lfloor>a\<rfloor>\<^sub>e s1 Z"
  4.1126 +	by (rule validE)
  4.1127 +      with v have "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z"
  4.1128 +	by simp
  4.1129 +      moreover
  4.1130 +      from eval wt da conf_s0 wf
  4.1131 +      have "s1\<Colon>\<preceq>(G, L)"
  4.1132 +	by (rule evaln_type_sound [elim_format]) simp
  4.1133 +      ultimately show ?thesis ..
  4.1134 +    qed
  4.1135 +  qed
  4.1136 +next
  4.1137 +  case (Lit A P v)
  4.1138 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (P\<leftarrow>In1 v)} Lit v-\<succ> {P} }"
  4.1139 +  proof (rule valid_expr_NormalI)
  4.1140 +    fix n L s0 s1 v'  Y Z
  4.1141 +    assume conf_s0: "s0\<Colon>\<preceq>(G, L)"
  4.1142 +    assume normal_s0: " normal s0"
  4.1143 +    assume eval: "G\<turnstile>s0 \<midarrow>Lit v-\<succ>v'\<midarrow>n\<rightarrow> s1"
  4.1144 +    assume P: "(Normal (P\<leftarrow>In1 v)) Y s0 Z"
  4.1145 +    show "P \<lfloor>v'\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1146 +    proof -
  4.1147 +      from eval have "s1=s0" and  "v'=v"
  4.1148 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.1149 +      with P conf_s0 show ?thesis by simp
  4.1150 +    qed
  4.1151 +  qed
  4.1152 +next
  4.1153 +  case (UnOp A P Q e unop)
  4.1154 +  assume valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P}e-\<succ>{\<lambda>Val:v:. Q\<leftarrow>In1 (eval_unop unop v)} }"
  4.1155 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} UnOp unop e-\<succ> {Q} }"
  4.1156 +  proof (rule valid_expr_NormalI)
  4.1157 +    fix n s0 L accC T E v s1 Y Z
  4.1158 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1159 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1160 +    assume normal_s0: "normal s0"
  4.1161 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>UnOp unop e\<Colon>-T"
  4.1162 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>UnOp unop e\<rangle>\<^sub>e\<guillemotright>E"
  4.1163 +    assume eval: "G\<turnstile>s0 \<midarrow>UnOp unop e-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.1164 +    assume P: "(Normal P) Y s0 Z"
  4.1165 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1166 +    proof -
  4.1167 +      from wt obtain eT where 
  4.1168 +	wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT" 
  4.1169 +	by cases simp
  4.1170 +      from da obtain
  4.1171 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1172 +	by cases simp
  4.1173 +      from eval obtain ve where
  4.1174 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>ve\<midarrow>n\<rightarrow> s1" and
  4.1175 +        v: "v = eval_unop unop ve"
  4.1176 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1177 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e
  4.1178 +      have "(\<lambda>Val:v:. Q\<leftarrow>In1 (eval_unop unop v)) \<lfloor>ve\<rfloor>\<^sub>e s1 Z"
  4.1179 +	by (rule validE)
  4.1180 +      with v have "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z"
  4.1181 +	by simp
  4.1182 +      moreover
  4.1183 +      from eval wt da conf_s0 wf
  4.1184 +      have "s1\<Colon>\<preceq>(G, L)"
  4.1185 +	by (rule evaln_type_sound [elim_format]) simp
  4.1186 +      ultimately show ?thesis ..
  4.1187 +    qed
  4.1188 +  qed
  4.1189 +next
  4.1190 +  case (BinOp A P Q R binop e1 e2)
  4.1191 +  assume valid_e1: "G,A|\<Turnstile>\<Colon>{ {Normal P} e1-\<succ> {Q} }" 
  4.1192 +  have valid_e2: "\<And> v1.  G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>In1 v1}
  4.1193 +              (if need_second_arg binop v1 then In1l e2 else In1r Skip)\<succ>
  4.1194 +              {\<lambda>Val:v2:. R\<leftarrow>In1 (eval_binop binop v1 v2)} }"
  4.1195 +    using BinOp.hyps by simp
  4.1196 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} BinOp binop e1 e2-\<succ> {R} }"
  4.1197 +  proof (rule valid_expr_NormalI)
  4.1198 +    fix n s0 L accC T E v s2 Y Z
  4.1199 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1200 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1201 +    assume normal_s0: "normal s0"
  4.1202 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>BinOp binop e1 e2\<Colon>-T"
  4.1203 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1204 +                  \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>BinOp binop e1 e2\<rangle>\<^sub>e\<guillemotright> E"
  4.1205 +    assume eval: "G\<turnstile>s0 \<midarrow>BinOp binop e1 e2-\<succ>v\<midarrow>n\<rightarrow> s2"
  4.1206 +    assume P: "(Normal P) Y s0 Z"
  4.1207 +    show "R \<lfloor>v\<rfloor>\<^sub>e s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
  4.1208 +    proof -
  4.1209 +      from wt obtain e1T e2T where
  4.1210 +        wt_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1\<Colon>-e1T" and
  4.1211 +        wt_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e2\<Colon>-e2T" and
  4.1212 +	wt_binop: "wt_binop G binop e1T e2T" 
  4.1213 +	by cases simp
  4.1214 +      have wt_Skip: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>Skip\<Colon>\<surd>"
  4.1215 +	by simp
  4.1216 +      (*
  4.1217 +      obtain S where
  4.1218 +	daSkip: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1219 +                   \<turnstile> dom (locals (store s1)) \<guillemotright>In1r Skip\<guillemotright> S"
  4.1220 +	by (auto intro: da_Skip [simplified] assigned.select_convs) *)
  4.1221 +      from da obtain E1 where
  4.1222 +	da_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e1\<rangle>\<^sub>e\<guillemotright> E1"
  4.1223 +	by cases simp+
  4.1224 +      from eval obtain v1 s1 v2 where
  4.1225 +	eval_e1: "G\<turnstile>s0 \<midarrow>e1-\<succ>v1\<midarrow>n\<rightarrow> s1" and
  4.1226 +	eval_e2: "G\<turnstile>s1 \<midarrow>(if need_second_arg binop v1 then \<langle>e2\<rangle>\<^sub>e else \<langle>Skip\<rangle>\<^sub>s)
  4.1227 +                        \<succ>\<midarrow>n\<rightarrow> (\<lfloor>v2\<rfloor>\<^sub>e, s2)" and
  4.1228 +        v: "v=eval_binop binop v1 v2"
  4.1229 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1230 +      from valid_e1 P valid_A conf_s0 eval_e1 wt_e1 da_e1
  4.1231 +      obtain Q: "Q \<lfloor>v1\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.1232 +	by (rule validE)
  4.1233 +      from Q have Q': "\<And> v. (Q\<leftarrow>In1 v1) v s1 Z"
  4.1234 +	by simp
  4.1235 +      have "(\<lambda>Val:v2:. R\<leftarrow>In1 (eval_binop binop v1 v2)) \<lfloor>v2\<rfloor>\<^sub>e s2 Z"
  4.1236 +      proof (cases "normal s1")
  4.1237 +	case True
  4.1238 +	from eval_e1 wt_e1 da_e1 conf_s0 wf
  4.1239 +	have conf_v1: "G,store s1\<turnstile>v1\<Colon>\<preceq>e1T" 
  4.1240 +	  by (rule evaln_type_sound [elim_format]) (insert True,simp)
  4.1241 +	from eval_e1 
  4.1242 +	have "G\<turnstile>s0 \<midarrow>e1-\<succ>v1\<rightarrow> s1"
  4.1243 +	  by (rule evaln_eval)
  4.1244 +	from da wt_e1 wt_e2 wt_binop conf_s0 True this conf_v1 wf
  4.1245 +	obtain E2 where
  4.1246 +	  da_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) 
  4.1247 +                   \<guillemotright>(if need_second_arg binop v1 then \<langle>e2\<rangle>\<^sub>e else \<langle>Skip\<rangle>\<^sub>s)\<guillemotright> E2"
  4.1248 +	  by (rule da_e2_BinOp [elim_format]) rules
  4.1249 +	from wt_e2 wt_Skip obtain T2 
  4.1250 +	  where "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1251 +                  \<turnstile>(if need_second_arg binop v1 then \<langle>e2\<rangle>\<^sub>e else \<langle>Skip\<rangle>\<^sub>s)\<Colon>T2"
  4.1252 +	  by (cases "need_second_arg binop v1") auto
  4.1253 +	note ve=validE [OF valid_e2,OF  Q' valid_A conf_s1 eval_e2 this da_e2]
  4.1254 +	(* chaining Q', without extra OF causes unification error *)
  4.1255 +	thus ?thesis
  4.1256 +	  by (rule ve)
  4.1257 +      next
  4.1258 +	case False
  4.1259 +	note ve=validE [OF valid_e2,OF Q' valid_A conf_s1 eval_e2]
  4.1260 +	with False show ?thesis
  4.1261 +	  by rules
  4.1262 +      qed
  4.1263 +      with v have "R \<lfloor>v\<rfloor>\<^sub>e s2 Z"
  4.1264 +	by simp
  4.1265 +      moreover
  4.1266 +      from eval wt da conf_s0 wf
  4.1267 +      have "s2\<Colon>\<preceq>(G, L)"
  4.1268 +	by (rule evaln_type_sound [elim_format]) simp
  4.1269 +      ultimately show ?thesis ..
  4.1270 +    qed
  4.1271 +  qed
  4.1272 +next
  4.1273 +  case (Super A P)
  4.1274 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (\<lambda>s.. P\<leftarrow>In1 (val_this s))} Super-\<succ> {P} }"
  4.1275 +  proof (rule valid_expr_NormalI)
  4.1276 +    fix n L s0 s1 v  Y Z
  4.1277 +    assume conf_s0: "s0\<Colon>\<preceq>(G, L)"
  4.1278 +    assume normal_s0: " normal s0"
  4.1279 +    assume eval: "G\<turnstile>s0 \<midarrow>Super-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.1280 +    assume P: "(Normal (\<lambda>s.. P\<leftarrow>In1 (val_this s))) Y s0 Z"
  4.1281 +    show "P \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1282 +    proof -
  4.1283 +      from eval have "s1=s0" and  "v=val_this (store s0)"
  4.1284 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.1285 +      with P conf_s0 show ?thesis by simp
  4.1286 +    qed
  4.1287 +  qed
  4.1288 +next
  4.1289 +  case (Acc A P Q var)
  4.1290 +  have valid_var: "G,A|\<Turnstile>\<Colon>{ {Normal P} var=\<succ> {\<lambda>Var:(v, f):. Q\<leftarrow>In1 v} }" .
  4.1291 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} Acc var-\<succ> {Q} }"
  4.1292 +  proof (rule valid_expr_NormalI)
  4.1293 +    fix n s0 L accC T E v s1 Y Z
  4.1294 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1295 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1296 +    assume normal_s0: "normal s0"
  4.1297 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Acc var\<Colon>-T"
  4.1298 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>Acc var\<rangle>\<^sub>e\<guillemotright>E"
  4.1299 +    assume eval: "G\<turnstile>s0 \<midarrow>Acc var-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.1300 +    assume P: "(Normal P) Y s0 Z"
  4.1301 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1302 +    proof -
  4.1303 +      from wt obtain 
  4.1304 +	wt_var: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>var\<Colon>=T" 
  4.1305 +	by cases simp
  4.1306 +      from da obtain V where 
  4.1307 +	da_var: "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>var\<rangle>\<^sub>v\<guillemotright> V"
  4.1308 +	by (cases "\<exists> n. var=LVar n") (insert da.LVar,auto elim!: da_elim_cases)
  4.1309 +      from eval obtain w upd where
  4.1310 +	eval_var: "G\<turnstile>s0 \<midarrow>var=\<succ>(v, upd)\<midarrow>n\<rightarrow> s1"
  4.1311 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1312 +      from valid_var P valid_A conf_s0 eval_var wt_var da_var
  4.1313 +      have "(\<lambda>Var:(v, f):. Q\<leftarrow>In1 v) \<lfloor>(v, upd)\<rfloor>\<^sub>v s1 Z"
  4.1314 +	by (rule validE)
  4.1315 +      then have "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z"
  4.1316 +	by simp
  4.1317 +      moreover
  4.1318 +      from eval wt da conf_s0 wf
  4.1319 +      have "s1\<Colon>\<preceq>(G, L)"
  4.1320 +	by (rule evaln_type_sound [elim_format]) simp
  4.1321 +      ultimately show ?thesis ..
  4.1322 +    qed
  4.1323 +  qed
  4.1324 +next
  4.1325 +  case (Ass A P Q R e var)
  4.1326 +  have valid_var: "G,A|\<Turnstile>\<Colon>{ {Normal P} var=\<succ> {Q} }" .
  4.1327 +  have valid_e: "\<And> vf. 
  4.1328 +                  G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>In2 vf} e-\<succ> {\<lambda>Val:v:. assign (snd vf) v .; R} }"
  4.1329 +    using Ass.hyps by simp
  4.1330 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} var:=e-\<succ> {R} }"
  4.1331 +  proof (rule valid_expr_NormalI)
  4.1332 +    fix n s0 L accC T E v s3 Y Z
  4.1333 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1334 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1335 +    assume normal_s0: "normal s0"
  4.1336 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>var:=e\<Colon>-T"
  4.1337 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>var:=e\<rangle>\<^sub>e\<guillemotright>E"
  4.1338 +    assume eval: "G\<turnstile>s0 \<midarrow>var:=e-\<succ>v\<midarrow>n\<rightarrow> s3"
  4.1339 +    assume P: "(Normal P) Y s0 Z"
  4.1340 +    show "R \<lfloor>v\<rfloor>\<^sub>e s3 Z \<and> s3\<Colon>\<preceq>(G, L)"
  4.1341 +    proof -
  4.1342 +      from wt obtain varT  where
  4.1343 +	wt_var: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>var\<Colon>=varT" and
  4.1344 +	wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-T" 
  4.1345 +	by cases simp
  4.1346 +      from eval obtain w upd s1 s2 where
  4.1347 +	eval_var: "G\<turnstile>s0 \<midarrow>var=\<succ>(w, upd)\<midarrow>n\<rightarrow> s1" and
  4.1348 +        eval_e: "G\<turnstile>s1 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s2" and
  4.1349 +	s3: "s3=assign upd v s2"
  4.1350 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.1351 +      have "R \<lfloor>v\<rfloor>\<^sub>e s3 Z"
  4.1352 +      proof (cases "\<exists> vn. var = LVar vn")
  4.1353 +	case False
  4.1354 +	with da obtain V where
  4.1355 +	  da_var: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1356 +                      \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>var\<rangle>\<^sub>v\<guillemotright> V" and
  4.1357 +	  da_e:   "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> nrm V \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1358 +	  by cases simp+
  4.1359 +	from valid_var P valid_A conf_s0 eval_var wt_var da_var
  4.1360 +	obtain Q: "Q \<lfloor>(w,upd)\<rfloor>\<^sub>v s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"  
  4.1361 +	  by (rule validE) 
  4.1362 +	hence Q': "\<And> v. (Q\<leftarrow>In2 (w,upd)) v s1 Z"
  4.1363 +	  by simp
  4.1364 +	have "(\<lambda>Val:v:. assign (snd (w,upd)) v .; R) \<lfloor>v\<rfloor>\<^sub>e s2 Z"
  4.1365 +	proof (cases "normal s1")
  4.1366 +	  case True
  4.1367 +	  obtain E' where 
  4.1368 +	    da_e': "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E'"
  4.1369 +	  proof -
  4.1370 +	    from eval_var wt_var da_var wf True
  4.1371 +	    have "nrm V \<subseteq>  dom (locals (store s1))"
  4.1372 +	      by (cases rule: da_good_approx_evalnE) rules
  4.1373 +	    with da_e show ?thesis
  4.1374 +	      by (rule da_weakenE) 
  4.1375 +	  qed
  4.1376 +	  note ve=validE [OF valid_e,OF Q' valid_A conf_s1 eval_e wt_e da_e']
  4.1377 +	  show ?thesis
  4.1378 +	    by (rule ve)
  4.1379 +	next
  4.1380 +	  case False
  4.1381 +	  note ve=validE [OF valid_e,OF Q' valid_A conf_s1 eval_e]
  4.1382 +	  with False show ?thesis
  4.1383 +	    by rules
  4.1384 +	qed
  4.1385 +	with s3 show "R \<lfloor>v\<rfloor>\<^sub>e s3 Z"
  4.1386 +	  by simp
  4.1387 +      next
  4.1388 +	case True
  4.1389 +	then obtain vn where 
  4.1390 +	  vn: "var = LVar vn" 
  4.1391 +	  by auto
  4.1392 +	with da obtain E where
  4.1393 +	    da_e:   "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.1394 +	  by cases simp+
  4.1395 +	from da.LVar vn obtain  V where
  4.1396 +	  da_var: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1397 +                      \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>var\<rangle>\<^sub>v\<guillemotright> V"
  4.1398 +	  by auto
  4.1399 +	from valid_var P valid_A conf_s0 eval_var wt_var da_var
  4.1400 +	obtain Q: "Q \<lfloor>(w,upd)\<rfloor>\<^sub>v s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"  
  4.1401 +	  by (rule validE) 
  4.1402 +	hence Q': "\<And> v. (Q\<leftarrow>In2 (w,upd)) v s1 Z"
  4.1403 +	  by simp
  4.1404 +	have "(\<lambda>Val:v:. assign (snd (w,upd)) v .; R) \<lfloor>v\<rfloor>\<^sub>e s2 Z"
  4.1405 +	proof (cases "normal s1")
  4.1406 +	  case True
  4.1407 +	  obtain E' where
  4.1408 +	    da_e': "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1409 +                       \<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E'"
  4.1410 +	  proof -
  4.1411 +	    from eval_var
  4.1412 +	    have "dom (locals (store s0)) \<subseteq> dom (locals (store (s1)))"
  4.1413 +	      by (rule dom_locals_evaln_mono_elim)
  4.1414 +	    with da_e show ?thesis
  4.1415 +	      by (rule da_weakenE)
  4.1416 +	  qed
  4.1417 +	  note ve=validE [OF valid_e,OF Q' valid_A conf_s1 eval_e wt_e da_e']
  4.1418 +	  show ?thesis
  4.1419 +	    by (rule ve)
  4.1420 +	next
  4.1421 +	  case False
  4.1422 +	  note ve=validE [OF valid_e,OF Q' valid_A conf_s1 eval_e]
  4.1423 +	  with False show ?thesis
  4.1424 +	    by rules
  4.1425 +	qed
  4.1426 +	with s3 show "R \<lfloor>v\<rfloor>\<^sub>e s3 Z"
  4.1427 +	  by simp
  4.1428 +      qed
  4.1429 +      moreover
  4.1430 +      from eval wt da conf_s0 wf
  4.1431 +      have "s3\<Colon>\<preceq>(G, L)"
  4.1432 +	by (rule evaln_type_sound [elim_format]) simp
  4.1433 +      ultimately show ?thesis ..
  4.1434 +    qed
  4.1435 +  qed
  4.1436 +next
  4.1437 +  case (Cond A P P' Q e0 e1 e2)
  4.1438 +  have valid_e0: "G,A|\<Turnstile>\<Colon>{ {Normal P} e0-\<succ> {P'} }" .
  4.1439 +  have valid_then_else:"\<And> b.  G,A|\<Turnstile>\<Colon>{ {P'\<leftarrow>=b} (if b then e1 else e2)-\<succ> {Q} }"
  4.1440 +    using Cond.hyps by simp
  4.1441 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} e0 ? e1 : e2-\<succ> {Q} }"
  4.1442 +  proof (rule valid_expr_NormalI)
  4.1443 +    fix n s0 L accC T E v s2 Y Z
  4.1444 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1445 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1446 +    assume normal_s0: "normal s0"
  4.1447 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e0 ? e1 : e2\<Colon>-T"
  4.1448 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>e0 ? e1:e2\<rangle>\<^sub>e\<guillemotright>E"
  4.1449 +    assume eval: "G\<turnstile>s0 \<midarrow>e0 ? e1 : e2-\<succ>v\<midarrow>n\<rightarrow> s2"
  4.1450 +    assume P: "(Normal P) Y s0 Z"
  4.1451 +    show "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
  4.1452 +    proof -
  4.1453 +      from wt obtain T1 T2 where
  4.1454 +	wt_e0: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e0\<Colon>-PrimT Boolean" and
  4.1455 +	wt_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e1\<Colon>-T1" and
  4.1456 +	wt_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e2\<Colon>-T2" 
  4.1457 +	by cases simp
  4.1458 +      from da obtain E0 E1 E2 where
  4.1459 +        da_e0: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e0\<rangle>\<^sub>e\<guillemotright> E0" and
  4.1460 +        da_e1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1461 +                 \<turnstile>(dom (locals (store s0)) \<union> assigns_if True e0)\<guillemotright>\<langle>e1\<rangle>\<^sub>e\<guillemotright> E1" and
  4.1462 +        da_e2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1463 +                 \<turnstile>(dom (locals (store s0)) \<union> assigns_if False e0)\<guillemotright>\<langle>e2\<rangle>\<^sub>e\<guillemotright> E2"
  4.1464 +	by cases simp+
  4.1465 +      from eval obtain b s1 where
  4.1466 +	eval_e0: "G\<turnstile>s0 \<midarrow>e0-\<succ>b\<midarrow>n\<rightarrow> s1" and
  4.1467 +        eval_then_else: "G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<midarrow>n\<rightarrow> s2"
  4.1468 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1469 +      from valid_e0 P valid_A conf_s0 eval_e0 wt_e0 da_e0
  4.1470 +      obtain "P' \<lfloor>b\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"  
  4.1471 +	by (rule validE)
  4.1472 +      hence P': "\<And> v. (P'\<leftarrow>=(the_Bool b)) v s1 Z"
  4.1473 +	by (cases "normal s1") auto
  4.1474 +      have "Q \<lfloor>v\<rfloor>\<^sub>e s2 Z"
  4.1475 +      proof (cases "normal s1")
  4.1476 +	case True
  4.1477 +	note normal_s1=this
  4.1478 +	from wt_e1 wt_e2 obtain T' where
  4.1479 +	  wt_then_else: 
  4.1480 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>(if the_Bool b then e1 else e2)\<Colon>-T'"
  4.1481 +	  by (cases "the_Bool b") simp+
  4.1482 +	have s0_s1: "dom (locals (store s0)) 
  4.1483 +                      \<union> assigns_if (the_Bool b) e0 \<subseteq> dom (locals (store s1))"
  4.1484 +	proof -
  4.1485 +	  from eval_e0 
  4.1486 +	  have eval_e0': "G\<turnstile>s0 \<midarrow>e0-\<succ>b\<rightarrow> s1"
  4.1487 +	    by (rule evaln_eval)
  4.1488 +	  hence
  4.1489 +	    "dom (locals (store s0)) \<subseteq> dom (locals (store s1))"
  4.1490 +	    by (rule dom_locals_eval_mono_elim)
  4.1491 +          moreover
  4.1492 +	  from eval_e0' True wt_e0 
  4.1493 +	  have "assigns_if (the_Bool b) e0 \<subseteq> dom (locals (store s1))"
  4.1494 +	    by (rule assigns_if_good_approx') 
  4.1495 +	  ultimately show ?thesis by (rule Un_least)
  4.1496 +	qed
  4.1497 +	obtain E' where
  4.1498 +	  da_then_else:
  4.1499 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.1500 +              \<turnstile>dom (locals (store s1))\<guillemotright>\<langle>if the_Bool b then e1 else e2\<rangle>\<^sub>e\<guillemotright> E'"
  4.1501 +	proof (cases "the_Bool b")
  4.1502 +	  case True
  4.1503 +	  with that da_e1 s0_s1 show ?thesis
  4.1504 +	    by simp (erule da_weakenE,auto)
  4.1505 +	next
  4.1506 +	  case False
  4.1507 +	  with that da_e2 s0_s1 show ?thesis
  4.1508 +	    by simp (erule da_weakenE,auto)
  4.1509 +	qed
  4.1510 +	with valid_then_else P' valid_A conf_s1 eval_then_else wt_then_else
  4.1511 +	show ?thesis
  4.1512 +	  by (rule validE)
  4.1513 +      next
  4.1514 +	case False
  4.1515 +	with valid_then_else P' valid_A conf_s1 eval_then_else
  4.1516 +	show ?thesis
  4.1517 +	  by (cases rule: validE) rules+
  4.1518 +      qed
  4.1519 +      moreover
  4.1520 +      from eval wt da conf_s0 wf
  4.1521 +      have "s2\<Colon>\<preceq>(G, L)"
  4.1522 +	by (rule evaln_type_sound [elim_format]) simp
  4.1523 +      ultimately show ?thesis ..
  4.1524 +    qed
  4.1525 +  qed
  4.1526 +next
  4.1527 +  case (Call A P Q R S accC' args e mn mode pTs' statT)
  4.1528 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {Q} }" .
  4.1529 +  have valid_args: "\<And> a. G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>In1 a} args\<doteq>\<succ> {R a} }"
  4.1530 +    using Call.hyps by simp
  4.1531 +  have valid_methd: "\<And> a vs invC declC l.
  4.1532 +        G,A|\<Turnstile>\<Colon>{ {R a\<leftarrow>In3 vs \<and>.
  4.1533 +                 (\<lambda>s. declC =
  4.1534 +                    invocation_declclass G mode (store s) a statT
  4.1535 +                     \<lparr>name = mn, parTs = pTs'\<rparr> \<and>
  4.1536 +                    invC = invocation_class mode (store s) a statT \<and>
  4.1537 +                    l = locals (store s)) ;.
  4.1538 +                 init_lvars G declC \<lparr>name = mn, parTs = pTs'\<rparr> mode a vs \<and>.
  4.1539 +                 (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}
  4.1540 +            Methd declC \<lparr>name=mn,parTs=pTs'\<rparr>-\<succ> {set_lvars l .; S} }"
  4.1541 +    using Call.hyps by simp
  4.1542 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} {accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ> {S} }"
  4.1543 +  proof (rule valid_expr_NormalI)
  4.1544 +    fix n s0 L accC T E v s5 Y Z
  4.1545 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1546 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1547 +    assume normal_s0: "normal s0"
  4.1548 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>{accC',statT,mode}e\<cdot>mn( {pTs'}args)\<Colon>-T"
  4.1549 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))
  4.1550 +                   \<guillemotright>\<langle>{accC',statT,mode}e\<cdot>mn( {pTs'}args)\<rangle>\<^sub>e\<guillemotright> E"
  4.1551 +    assume eval: "G\<turnstile>s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>n\<rightarrow> s5"
  4.1552 +    assume P: "(Normal P) Y s0 Z"
  4.1553 +    show "S \<lfloor>v\<rfloor>\<^sub>e s5 Z \<and> s5\<Colon>\<preceq>(G, L)"
  4.1554 +    proof -
  4.1555 +      from wt obtain pTs statDeclT statM where
  4.1556 +                 wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-RefT statT" and
  4.1557 +              wt_args: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>args\<Colon>\<doteq>pTs" and
  4.1558 +                statM: "max_spec G accC statT \<lparr>name=mn,parTs=pTs\<rparr> 
  4.1559 +                         = {((statDeclT,statM),pTs')}" and
  4.1560 +                 mode: "mode = invmode statM e" and
  4.1561 +                    T: "T =(resTy statM)" and
  4.1562 +        eq_accC_accC': "accC=accC'"
  4.1563 +	by cases fastsimp+
  4.1564 +      from da obtain C where
  4.1565 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s0)))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> C" and
  4.1566 +	da_args: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> nrm C \<guillemotright>\<langle>args\<rangle>\<^sub>l\<guillemotright> E" 
  4.1567 +	by cases simp
  4.1568 +      from eval eq_accC_accC' obtain a s1 vs s2 s3 s3' s4 invDeclC where
  4.1569 +	evaln_e: "G\<turnstile>s0 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s1" and
  4.1570 +        evaln_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s2" and
  4.1571 +	invDeclC: "invDeclC = invocation_declclass 
  4.1572 +                G mode (store s2) a statT \<lparr>name=mn,parTs=pTs'\<rparr>" and
  4.1573 +        s3: "s3 = init_lvars G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> mode a vs s2" and
  4.1574 +        check: "s3' = check_method_access G 
  4.1575 +                           accC' statT mode \<lparr>name = mn, parTs = pTs'\<rparr> a s3" and
  4.1576 +	evaln_methd:
  4.1577 +           "G\<turnstile>s3' \<midarrow>Methd invDeclC  \<lparr>name=mn,parTs=pTs'\<rparr>-\<succ>v\<midarrow>n\<rightarrow> s4" and
  4.1578 +        s5: "s5=(set_lvars (locals (store s2))) s4"
  4.1579 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.1580 +
  4.1581 +      from evaln_e
  4.1582 +      have eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>a\<rightarrow> s1"
  4.1583 +	by (rule evaln_eval)
  4.1584 +      
  4.1585 +      from eval_e _ wt_e wf
  4.1586 +      have s1_no_return: "abrupt s1 \<noteq> Some (Jump Ret)"
  4.1587 +	by (rule eval_expression_no_jump 
  4.1588 +                 [where ?Env="\<lparr>prg=G,cls=accC,lcl=L\<rparr>",simplified])
  4.1589 +	   (insert normal_s0,auto)
  4.1590 +
  4.1591 +      from valid_e P valid_A conf_s0 evaln_e wt_e da_e
  4.1592 +      obtain "Q \<lfloor>a\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.1593 +	by (rule validE)
  4.1594 +      hence Q: "\<And> v. (Q\<leftarrow>In1 a) v s1 Z"
  4.1595 +	by simp
  4.1596 +      obtain 
  4.1597 +	R: "(R a) \<lfloor>vs\<rfloor>\<^sub>l s2 Z" and 
  4.1598 +	conf_s2: "s2\<Colon>\<preceq>(G,L)" and 
  4.1599 +	s2_no_return: "abrupt s2 \<noteq> Some (Jump Ret)"
  4.1600 +      proof (cases "normal s1")
  4.1601 +	case True
  4.1602 +	obtain E' where 
  4.1603 +	  da_args':
  4.1604 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>args\<rangle>\<^sub>l\<guillemotright> E'"
  4.1605 +	proof -
  4.1606 +	  from evaln_e wt_e da_e wf True
  4.1607 +	  have "nrm C \<subseteq>  dom (locals (store s1))"
  4.1608 +	    by (cases rule: da_good_approx_evalnE) rules
  4.1609 +	  with da_args show ?thesis
  4.1610 +	    by (rule da_weakenE) 
  4.1611 +	qed
  4.1612 +	with valid_args Q valid_A conf_s1 evaln_args wt_args 
  4.1613 +	obtain "(R a) \<lfloor>vs\<rfloor>\<^sub>l s2 Z" "s2\<Colon>\<preceq>(G,L)" 
  4.1614 +	  by (rule validE)
  4.1615 +	moreover
  4.1616 +	from evaln_args
  4.1617 +	have e: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2"
  4.1618 +	  by (rule evaln_eval)
  4.1619 +	from this s1_no_return wt_args wf
  4.1620 +	have "abrupt s2 \<noteq> Some (Jump Ret)"
  4.1621 +	  by (rule eval_expression_list_no_jump 
  4.1622 +                 [where ?Env="\<lparr>prg=G,cls=accC,lcl=L\<rparr>",simplified])
  4.1623 +	ultimately show ?thesis ..
  4.1624 +      next
  4.1625 +	case False
  4.1626 +	with valid_args Q valid_A conf_s1 evaln_args
  4.1627 +	obtain "(R a) \<lfloor>vs\<rfloor>\<^sub>l s2 Z" "s2\<Colon>\<preceq>(G,L)" 
  4.1628 +	  by (cases rule: validE) rules+
  4.1629 +	moreover
  4.1630 +	from False evaln_args have "s2=s1"
  4.1631 +	  by auto
  4.1632 +	with s1_no_return have "abrupt s2 \<noteq> Some (Jump Ret)"
  4.1633 +	  by simp
  4.1634 +	ultimately show ?thesis ..
  4.1635 +      qed
  4.1636 +
  4.1637 +      obtain invC where
  4.1638 +	invC: "invC = invocation_class mode (store s2) a statT"
  4.1639 +	by simp
  4.1640 +      with s3
  4.1641 +      have invC': "invC = (invocation_class mode (store s3) a statT)"
  4.1642 +	by (cases s2,cases mode) (auto simp add: init_lvars_def2 )
  4.1643 +      obtain l where
  4.1644 +	l: "l = locals (store s2)"
  4.1645 +	by simp
  4.1646 +
  4.1647 +      from eval wt da conf_s0 wf
  4.1648 +      have conf_s5: "s5\<Colon>\<preceq>(G, L)"
  4.1649 +	by (rule evaln_type_sound [elim_format]) simp
  4.1650 +      let "PROP ?R" = "\<And> v.
  4.1651 +             (R a\<leftarrow>In3 vs \<and>.
  4.1652 +                 (\<lambda>s. invDeclC = invocation_declclass G mode (store s) a statT
  4.1653 +                                  \<lparr>name = mn, parTs = pTs'\<rparr> \<and>
  4.1654 +                       invC = invocation_class mode (store s) a statT \<and>
  4.1655 +                          l = locals (store s)) ;.
  4.1656 +                  init_lvars G invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> mode a vs \<and>.
  4.1657 +                  (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)
  4.1658 +               ) v s3' Z"
  4.1659 +      {
  4.1660 +	assume abrupt_s3: "\<not> normal s3"
  4.1661 +	have "S \<lfloor>v\<rfloor>\<^sub>e s5 Z"
  4.1662 +	proof -
  4.1663 +	  from abrupt_s3 check have eq_s3'_s3: "s3'=s3"
  4.1664 +	    by (auto simp add: check_method_access_def Let_def)
  4.1665 +	  with R s3 invDeclC invC l abrupt_s3
  4.1666 +	  have R': "PROP ?R"
  4.1667 +	    by auto
  4.1668 +	  have conf_s3': "s3'\<Colon>\<preceq>(G, empty)"
  4.1669 +	   (* we need an arbirary environment (here empty) that s2' conforms to
  4.1670 +              to apply validE *)
  4.1671 +	  proof -
  4.1672 +	    from s2_no_return s3
  4.1673 +	    have "abrupt s3 \<noteq> Some (Jump Ret)"
  4.1674 +	      by (cases s2) (auto simp add: init_lvars_def2 split: split_if_asm)
  4.1675 +	    moreover
  4.1676 +	    obtain abr2 str2 where s2: "s2=(abr2,str2)"
  4.1677 +	      by (cases s2) simp
  4.1678 +	    from s3 s2 conf_s2 have "(abrupt s3,str2)\<Colon>\<preceq>(G, L)"
  4.1679 +	      by (auto simp add: init_lvars_def2 split: split_if_asm)
  4.1680 +	    ultimately show ?thesis
  4.1681 +	      using s3 s2 eq_s3'_s3
  4.1682 +	      apply (simp add: init_lvars_def2)
  4.1683 +	      apply (rule conforms_set_locals [OF _ wlconf_empty])
  4.1684 +	      by auto
  4.1685 +	  qed
  4.1686 +	  from valid_methd R' valid_A conf_s3' evaln_methd abrupt_s3 eq_s3'_s3
  4.1687 +	  have "(set_lvars l .; S) \<lfloor>v\<rfloor>\<^sub>e s4 Z"
  4.1688 +	    by (cases rule: validE) simp+
  4.1689 +	  with s5 l show ?thesis
  4.1690 +	    by simp
  4.1691 +	qed
  4.1692 +      } note abrupt_s3_lemma = this
  4.1693 +
  4.1694 +      have "S \<lfloor>v\<rfloor>\<^sub>e s5 Z"
  4.1695 +      proof (cases "normal s2")
  4.1696 +	case False
  4.1697 +	with s3 have abrupt_s3: "\<not> normal s3"
  4.1698 +	  by (cases s2) (simp add: init_lvars_def2)
  4.1699 +	thus ?thesis
  4.1700 +	  by (rule abrupt_s3_lemma)
  4.1701 +      next
  4.1702 +	case True
  4.1703 +	note normal_s2 = this
  4.1704 +	with evaln_args 
  4.1705 +	have normal_s1: "normal s1"
  4.1706 +	  by (rule evaln_no_abrupt)
  4.1707 +	obtain E' where 
  4.1708 +	  da_args':
  4.1709 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>args\<rangle>\<^sub>l\<guillemotright> E'"
  4.1710 +	proof -
  4.1711 +	  from evaln_e wt_e da_e wf normal_s1
  4.1712 +	  have "nrm C \<subseteq>  dom (locals (store s1))"
  4.1713 +	    by (cases rule: da_good_approx_evalnE) rules
  4.1714 +	  with da_args show ?thesis
  4.1715 +	    by (rule da_weakenE) 
  4.1716 +	qed
  4.1717 +	from evaln_args
  4.1718 +	have eval_args: "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<rightarrow> s2"
  4.1719 +	  by (rule evaln_eval)
  4.1720 +	from evaln_e wt_e da_e conf_s0 wf
  4.1721 +	have conf_a: "G, store s1\<turnstile>a\<Colon>\<preceq>RefT statT"
  4.1722 +	  by (rule evaln_type_sound [elim_format]) (insert normal_s1,simp)
  4.1723 +	with normal_s1 normal_s2 eval_args 
  4.1724 +	have conf_a_s2: "G, store s2\<turnstile>a\<Colon>\<preceq>RefT statT"
  4.1725 +	  by (auto dest: eval_gext intro: conf_gext)
  4.1726 +	from evaln_args wt_args da_args' conf_s1 wf
  4.1727 +	have conf_args: "list_all2 (conf G (store s2)) vs pTs"
  4.1728 +	  by (rule evaln_type_sound [elim_format]) (insert normal_s2,simp)
  4.1729 +	from statM 
  4.1730 +	obtain
  4.1731 +	  statM': "(statDeclT,statM)\<in>mheads G accC statT \<lparr>name=mn,parTs=pTs'\<rparr>" 
  4.1732 +	  and
  4.1733 +	  pTs_widen: "G\<turnstile>pTs[\<preceq>]pTs'"
  4.1734 +	  by (blast dest: max_spec2mheads)
  4.1735 +	show ?thesis
  4.1736 +	proof (cases "normal s3")
  4.1737 +	  case False
  4.1738 +	  thus ?thesis
  4.1739 +	    by (rule abrupt_s3_lemma)
  4.1740 +	next
  4.1741 +	  case True
  4.1742 +	  note normal_s3 = this
  4.1743 +	  with s3 have notNull: "mode = IntVir \<longrightarrow> a \<noteq> Null"
  4.1744 +	    by (cases s2) (auto simp add: init_lvars_def2)
  4.1745 +	  from conf_s2 conf_a_s2 wf notNull invC
  4.1746 +	  have dynT_prop: "G\<turnstile>mode\<rightarrow>invC\<preceq>statT"
  4.1747 +	    by (cases s2) (auto intro: DynT_propI)
  4.1748 +
  4.1749 +	  with wt_e statM' invC mode wf 
  4.1750 +	  obtain dynM where 
  4.1751 +            dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  4.1752 +            acc_dynM: "G \<turnstile>Methd  \<lparr>name=mn,parTs=pTs'\<rparr> dynM 
  4.1753 +                            in invC dyn_accessible_from accC"
  4.1754 +	    by (force dest!: call_access_ok)
  4.1755 +	  with invC' check eq_accC_accC'
  4.1756 +	  have eq_s3'_s3: "s3'=s3"
  4.1757 +	    by (auto simp add: check_method_access_def Let_def)
  4.1758 +	  
  4.1759 +	  with dynT_prop R s3 invDeclC invC l 
  4.1760 +	  have R': "PROP ?R"
  4.1761 +	    by auto
  4.1762  
  4.1763 +	  from dynT_prop wf wt_e statM' mode invC invDeclC dynM
  4.1764 +	  obtain 
  4.1765 +            dynM: "dynlookup G statT invC  \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  4.1766 +	    wf_dynM: "wf_mdecl G invDeclC (\<lparr>name=mn,parTs=pTs'\<rparr>,mthd dynM)" and
  4.1767 +	      dynM': "methd G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> = Some dynM" and
  4.1768 +            iscls_invDeclC: "is_class G invDeclC" and
  4.1769 +	         invDeclC': "invDeclC = declclass dynM" and
  4.1770 +	      invC_widen: "G\<turnstile>invC\<preceq>\<^sub>C invDeclC" and
  4.1771 +	     resTy_widen: "G\<turnstile>resTy dynM\<preceq>resTy statM" and
  4.1772 +	    is_static_eq: "is_static dynM = is_static statM" and
  4.1773 +	    involved_classes_prop:
  4.1774 +             "(if invmode statM e = IntVir
  4.1775 +               then \<forall>statC. statT = ClassT statC \<longrightarrow> G\<turnstile>invC\<preceq>\<^sub>C statC
  4.1776 +               else ((\<exists>statC. statT = ClassT statC \<and> G\<turnstile>statC\<preceq>\<^sub>C invDeclC) \<or>
  4.1777 +                     (\<forall>statC. statT \<noteq> ClassT statC \<and> invDeclC = Object)) \<and>
  4.1778 +                      statDeclT = ClassT invDeclC)"
  4.1779 +	    by (cases rule: DynT_mheadsE) simp
  4.1780 +	  obtain L' where 
  4.1781 +	    L':"L'=(\<lambda> k. 
  4.1782 +                    (case k of
  4.1783 +                       EName e
  4.1784 +                       \<Rightarrow> (case e of 
  4.1785 +                             VNam v 
  4.1786 +                             \<Rightarrow>(table_of (lcls (mbody (mthd dynM)))
  4.1787 +                                (pars (mthd dynM)[\<mapsto>]pTs')) v
  4.1788 +                           | Res \<Rightarrow> Some (resTy dynM))
  4.1789 +                     | This \<Rightarrow> if is_static statM 
  4.1790 +                               then None else Some (Class invDeclC)))"
  4.1791 +	    by simp
  4.1792 +	  from wf_dynM [THEN wf_mdeclD1, THEN conjunct1] normal_s2 conf_s2 wt_e
  4.1793 +            wf eval_args conf_a mode notNull wf_dynM involved_classes_prop
  4.1794 +	  have conf_s3: "s3\<Colon>\<preceq>(G,L')"
  4.1795 +	    apply - 
  4.1796 +               (* FIXME confomrs_init_lvars should be 
  4.1797 +                  adjusted to be more directy applicable *)
  4.1798 +	    apply (drule conforms_init_lvars [of G invDeclC 
  4.1799 +                    "\<lparr>name=mn,parTs=pTs'\<rparr>" dynM "store s2" vs pTs "abrupt s2" 
  4.1800 +                    L statT invC a "(statDeclT,statM)" e])
  4.1801 +	    apply (rule wf)
  4.1802 +	    apply (rule conf_args)
  4.1803 +	    apply (simp add: pTs_widen)
  4.1804 +	    apply (cases s2,simp)
  4.1805 +	    apply (rule dynM')
  4.1806 +	    apply (force dest: ty_expr_is_type)
  4.1807 +	    apply (rule invC_widen)
  4.1808 +	    apply (force intro: conf_gext dest: eval_gext)
  4.1809 +	    apply simp
  4.1810 +	    apply simp
  4.1811 +	    apply (simp add: invC)
  4.1812 +	    apply (simp add: invDeclC)
  4.1813 +	    apply (simp add: normal_s2)
  4.1814 +	    apply (cases s2, simp add: L' init_lvars_def2 s3
  4.1815 +	                     cong add: lname.case_cong ename.case_cong)
  4.1816 +	    done
  4.1817 +	  with eq_s3'_s3 have conf_s3': "s3'\<Colon>\<preceq>(G,L')" by simp
  4.1818 +	  from is_static_eq wf_dynM L'
  4.1819 +	  obtain mthdT where
  4.1820 +	    "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
  4.1821 +               \<turnstile>Body invDeclC (stmt (mbody (mthd dynM)))\<Colon>-mthdT" and
  4.1822 +	    mthdT_widen: "G\<turnstile>mthdT\<preceq>resTy dynM"
  4.1823 +	    by - (drule wf_mdecl_bodyD,
  4.1824 +                  auto simp add: callee_lcl_def  
  4.1825 +                       cong add: lname.case_cong ename.case_cong)
  4.1826 +	  with dynM' iscls_invDeclC invDeclC'
  4.1827 +	  have
  4.1828 +	    wt_methd:
  4.1829 +	    "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr>
  4.1830 +               \<turnstile>(Methd invDeclC \<lparr>name = mn, parTs = pTs'\<rparr>)\<Colon>-mthdT"
  4.1831 +	    by (auto intro: wt.Methd)
  4.1832 +	  obtain M where 
  4.1833 +	    da_methd:
  4.1834 +	    "\<lparr>prg=G,cls=invDeclC,lcl=L'\<rparr> 
  4.1835 +	       \<turnstile> dom (locals (store s3')) 
  4.1836 +                   \<guillemotright>\<langle>Methd invDeclC \<lparr>name=mn,parTs=pTs'\<rparr>\<rangle>\<^sub>e\<guillemotright> M"
  4.1837 +	  proof -
  4.1838 +	    from wf_dynM
  4.1839 +	    obtain M' where
  4.1840 +	      da_body: 
  4.1841 +	      "\<lparr>prg=G, cls=invDeclC
  4.1842 +               ,lcl=callee_lcl invDeclC \<lparr>name = mn, parTs = pTs'\<rparr> (mthd dynM)
  4.1843 +               \<rparr> \<turnstile> parameters (mthd dynM) \<guillemotright>\<langle>stmt (mbody (mthd dynM))\<rangle>\<guillemotright> M'" and
  4.1844 +              res: "Result \<in> nrm M'"
  4.1845 +	      by (rule wf_mdeclE) rules
  4.1846 +	    from da_body is_static_eq L' have
  4.1847 +	      "\<lparr>prg=G, cls=invDeclC,lcl=L'\<rparr> 
  4.1848 +                 \<turnstile> parameters (mthd dynM) \<guillemotright>\<langle>stmt (mbody (mthd dynM))\<rangle>\<guillemotright> M'"
  4.1849 +	      by (simp add: callee_lcl_def  
  4.1850 +                  cong add: lname.case_cong ename.case_cong)
  4.1851 +	    moreover have "parameters (mthd dynM) \<subseteq>  dom (locals (store s3'))"
  4.1852 +	    proof -
  4.1853 +	      from is_static_eq 
  4.1854 +	      have "(invmode (mthd dynM) e) = (invmode statM e)"
  4.1855 +		by (simp add: invmode_def)
  4.1856 +	      with s3 dynM' is_static_eq normal_s2 mode 
  4.1857 +	      have "parameters (mthd dynM) = dom (locals (store s3))"
  4.1858 +		using dom_locals_init_lvars 
  4.1859 +                  [of "mthd dynM" G invDeclC "\<lparr>name=mn,parTs=pTs'\<rparr>" e a vs s2]
  4.1860 +		by simp
  4.1861 +	      thus ?thesis using eq_s3'_s3 by simp
  4.1862 +	    qed
  4.1863 +	    ultimately obtain M2 where
  4.1864 +	      da:
  4.1865 +	      "\<lparr>prg=G, cls=invDeclC,lcl=L'\<rparr> 
  4.1866 +                \<turnstile> dom (locals (store s3')) \<guillemotright>\<langle>stmt (mbody (mthd dynM))\<rangle>\<guillemotright> M2" and
  4.1867 +              M2: "nrm M' \<subseteq> nrm M2"
  4.1868 +	      by (rule da_weakenE)
  4.1869 +	    from res M2 have "Result \<in> nrm M2"
  4.1870 +	      by blast
  4.1871 +	    moreover from wf_dynM
  4.1872 +	    have "jumpNestingOkS {Ret} (stmt (mbody (mthd dynM)))"
  4.1873 +	      by (rule wf_mdeclE)
  4.1874 +	    ultimately
  4.1875 +	    obtain M3 where
  4.1876 +	      "\<lparr>prg=G, cls=invDeclC,lcl=L'\<rparr> \<turnstile> dom (locals (store s3')) 
  4.1877 +                     \<guillemotright>\<langle>Body (declclass dynM) (stmt (mbody (mthd dynM)))\<rangle>\<guillemotright> M3"
  4.1878 +	      using da
  4.1879 +	      by (rules intro: da.Body assigned.select_convs)
  4.1880 +	    from _ this [simplified]
  4.1881 +	    show ?thesis
  4.1882 +	      by (rule da.Methd [simplified,elim_format])
  4.1883 +	         (auto intro: dynM')
  4.1884 +	  qed
  4.1885 +	  from valid_methd R' valid_A conf_s3' evaln_methd wt_methd da_methd
  4.1886 +	  have "(set_lvars l .; S) \<lfloor>v\<rfloor>\<^sub>e s4 Z"
  4.1887 +	    by (cases rule: validE) rules+
  4.1888 +	  with s5 l show ?thesis
  4.1889 +	    by simp
  4.1890 +	qed
  4.1891 +      qed
  4.1892 +      with conf_s5 show ?thesis by rules
  4.1893 +    qed
  4.1894 +  qed
  4.1895 +next
  4.1896 +-- {* 
  4.1897 +\par
  4.1898 +*} (* dummy text command to break paragraph for latex;
  4.1899 +              large paragraphs exhaust memory of debian pdflatex *)
  4.1900 +  case (Methd A P Q ms)
  4.1901 +  have valid_body: "G,A \<union> {{P} Methd-\<succ> {Q} | ms}|\<Turnstile>\<Colon>{{P} body G-\<succ> {Q} | ms}".
  4.1902 +  show "G,A|\<Turnstile>\<Colon>{{P} Methd-\<succ> {Q} | ms}"
  4.1903 +    by (rule Methd_sound)
  4.1904 +next
  4.1905 +  case (Body A D P Q R c)
  4.1906 +  have valid_init: "G,A|\<Turnstile>\<Colon>{ {Normal P} .Init D. {Q} }".
  4.1907 +  have valid_c: "G,A|\<Turnstile>\<Colon>{ {Q} .c. 
  4.1908 +              {\<lambda>s.. abupd (absorb Ret) .; R\<leftarrow>In1 (the (locals s Result))} }".
  4.1909 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} Body D c-\<succ> {R} }"
  4.1910 +  proof (rule valid_expr_NormalI)
  4.1911 +    fix n s0 L accC T E v s4 Y Z
  4.1912 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.1913 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1914 +    assume normal_s0: "normal s0"
  4.1915 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Body D c\<Colon>-T"
  4.1916 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>Body D c\<rangle>\<^sub>e\<guillemotright>E"
  4.1917 +    assume eval: "G\<turnstile>s0 \<midarrow>Body D c-\<succ>v\<midarrow>n\<rightarrow> s4"
  4.1918 +    assume P: "(Normal P) Y s0 Z"
  4.1919 +    show "R \<lfloor>v\<rfloor>\<^sub>e s4 Z \<and> s4\<Colon>\<preceq>(G, L)"
  4.1920 +    proof -
  4.1921 +      from wt obtain 
  4.1922 +	iscls_D: "is_class G D" and
  4.1923 +        wt_init: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Init D\<Colon>\<surd>" and
  4.1924 +        wt_c: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c\<Colon>\<surd>" 
  4.1925 +	by cases auto
  4.1926 +      obtain I where 
  4.1927 +	da_init:"\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>Init D\<rangle>\<^sub>s\<guillemotright> I"
  4.1928 +	by (auto intro: da_Init [simplified] assigned.select_convs)
  4.1929 +      from da obtain C where
  4.1930 +	da_c: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s0)))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright> C" and
  4.1931 +	jmpOk: "jumpNestingOkS {Ret} c" 
  4.1932 +	by cases simp
  4.1933 +      from eval obtain s1 s2 s3 where
  4.1934 +	eval_init: "G\<turnstile>s0 \<midarrow>Init D\<midarrow>n\<rightarrow> s1" and
  4.1935 +        eval_c: "G\<turnstile>s1 \<midarrow>c\<midarrow>n\<rightarrow> s2" and
  4.1936 +	v: "v = the (locals (store s2) Result)" and
  4.1937 +        s3: "s3 =(if \<exists>l. abrupt s2 = Some (Jump (Break l)) \<or> 
  4.1938 +                         abrupt s2 = Some (Jump (Cont l))
  4.1939 +                  then abupd (\<lambda>x. Some (Error CrossMethodJump)) s2 else s2)"and
  4.1940 +        s4: "s4 = abupd (absorb Ret) s3"
  4.1941 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.1942 +      obtain C' where 
  4.1943 +	da_c': "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s1)))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright> C'"
  4.1944 +      proof -
  4.1945 +	from eval_init 
  4.1946 +	have "(dom (locals (store s0))) \<subseteq> (dom (locals (store s1)))"
  4.1947 +	  by (rule dom_locals_evaln_mono_elim)
  4.1948 +	with da_c show ?thesis by (rule da_weakenE)
  4.1949 +      qed
  4.1950 +      from valid_init P valid_A conf_s0 eval_init wt_init da_init
  4.1951 +      obtain Q: "Q \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.1952 +	by (rule validE)
  4.1953 +      from valid_c Q valid_A conf_s1 eval_c wt_c da_c' 
  4.1954 +      have R: "(\<lambda>s.. abupd (absorb Ret) .; R\<leftarrow>In1 (the (locals s Result))) 
  4.1955 +                \<diamondsuit> s2 Z"
  4.1956 +	by (rule validE)
  4.1957 +      have "s3=s2"
  4.1958 +      proof -
  4.1959 +	from eval_init [THEN evaln_eval] wf
  4.1960 +	have s1_no_jmp: "\<And> j. abrupt s1 \<noteq> Some (Jump j)"
  4.1961 +	  by - (rule eval_statement_no_jump [OF _ _ _ wt_init],
  4.1962 +                insert normal_s0,auto)
  4.1963 +	from eval_c [THEN evaln_eval] _ wt_c wf
  4.1964 +	have "\<And> j. abrupt s2 = Some (Jump j) \<Longrightarrow> j=Ret"
  4.1965 +	  by (rule jumpNestingOk_evalE) (auto intro: jmpOk simp add: s1_no_jmp)
  4.1966 +	moreover note s3
  4.1967 +	ultimately show ?thesis 
  4.1968 +	  by (force split: split_if)
  4.1969 +      qed
  4.1970 +      with R v s4 
  4.1971 +      have "R \<lfloor>v\<rfloor>\<^sub>e s4 Z"
  4.1972 +	by simp
  4.1973 +      moreover
  4.1974 +      from eval wt da conf_s0 wf
  4.1975 +      have "s4\<Colon>\<preceq>(G, L)"
  4.1976 +	by (rule evaln_type_sound [elim_format]) simp
  4.1977 +      ultimately show ?thesis ..
  4.1978 +    qed
  4.1979 +  qed
  4.1980 +next
  4.1981 +  case (Nil A P)
  4.1982 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (P\<leftarrow>\<lfloor>[]\<rfloor>\<^sub>l)} []\<doteq>\<succ> {P} }"
  4.1983 +  proof (rule valid_expr_list_NormalI)
  4.1984 +    fix s0 s1 vs n L Y Z
  4.1985 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.1986 +    assume normal_s0: "normal s0"
  4.1987 +    assume eval: "G\<turnstile>s0 \<midarrow>[]\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s1"
  4.1988 +    assume P: "(Normal (P\<leftarrow>\<lfloor>[]\<rfloor>\<^sub>l)) Y s0 Z"
  4.1989 +    show "P \<lfloor>vs\<rfloor>\<^sub>l s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.1990 +    proof -
  4.1991 +      from eval obtain "vs=[]" "s1=s0"
  4.1992 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.1993 +      with P conf_s0 show ?thesis
  4.1994 +	by simp
  4.1995 +    qed
  4.1996 +  qed
  4.1997 +next
  4.1998 +  case (Cons A P Q R e es)
  4.1999 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {Q} }".
  4.2000 +  have valid_es: "\<And> v. G,A|\<Turnstile>\<Colon>{ {Q\<leftarrow>\<lfloor>v\<rfloor>\<^sub>e} es\<doteq>\<succ> {\<lambda>Vals:vs:. R\<leftarrow>\<lfloor>(v # vs)\<rfloor>\<^sub>l} }"
  4.2001 +    using Cons.hyps by simp
  4.2002 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} e # es\<doteq>\<succ> {R} }"
  4.2003 +  proof (rule valid_expr_list_NormalI)
  4.2004 +    fix n s0 L accC T E v s2 Y Z
  4.2005 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2006 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.2007 +    assume normal_s0: "normal s0"
  4.2008 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e # es\<Colon>\<doteq>T"
  4.2009 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>e # es\<rangle>\<^sub>l\<guillemotright> E"
  4.2010 +    assume eval: "G\<turnstile>s0 \<midarrow>e # es\<doteq>\<succ>v\<midarrow>n\<rightarrow> s2"
  4.2011 +    assume P: "(Normal P) Y s0 Z"
  4.2012 +    show "R \<lfloor>v\<rfloor>\<^sub>l s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
  4.2013 +    proof -
  4.2014 +      from wt obtain eT esT where
  4.2015 +	wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-eT" and
  4.2016 +	wt_es: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>es\<Colon>\<doteq>esT"
  4.2017 +	by cases simp
  4.2018 +      from da obtain E1 where
  4.2019 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> (dom (locals (store s0)))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E1" and
  4.2020 +	da_es: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> nrm E1 \<guillemotright>\<langle>es\<rangle>\<^sub>l\<guillemotright> E" 
  4.2021 +	by cases simp
  4.2022 +      from eval obtain s1 ve vs where
  4.2023 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>ve\<midarrow>n\<rightarrow> s1" and
  4.2024 +	eval_es: "G\<turnstile>s1 \<midarrow>es\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s2" and
  4.2025 +	v: "v=ve#vs"
  4.2026 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2027 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e 
  4.2028 +      obtain Q: "Q \<lfloor>ve\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.2029 +	by (rule validE)
  4.2030 +      from Q have Q': "\<And> v. (Q\<leftarrow>\<lfloor>ve\<rfloor>\<^sub>e) v s1 Z"
  4.2031 +	by simp
  4.2032 +      have "(\<lambda>Vals:vs:. R\<leftarrow>\<lfloor>(ve # vs)\<rfloor>\<^sub>l) \<lfloor>vs\<rfloor>\<^sub>l s2 Z"
  4.2033 +      proof (cases "normal s1")
  4.2034 +	case True
  4.2035 +	obtain E' where 
  4.2036 +	  da_es': "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>es\<rangle>\<^sub>l\<guillemotright> E'"
  4.2037 +	proof -
  4.2038 +	  from eval_e wt_e da_e wf True
  4.2039 +	  have "nrm E1 \<subseteq> dom (locals (store s1))"
  4.2040 +	    by (cases rule: da_good_approx_evalnE) rules
  4.2041 +	  with da_es show ?thesis
  4.2042 +	    by (rule da_weakenE)
  4.2043 +	qed
  4.2044 +	from valid_es Q' valid_A conf_s1 eval_es wt_es da_es'
  4.2045 +	show ?thesis
  4.2046 +	  by (rule validE)
  4.2047 +      next
  4.2048 +	case False
  4.2049 +	with valid_es Q' valid_A conf_s1 eval_es 
  4.2050 +	show ?thesis
  4.2051 +	  by (cases rule: validE) rules+
  4.2052 +      qed
  4.2053 +      with v have "R \<lfloor>v\<rfloor>\<^sub>l s2 Z"
  4.2054 +	by simp
  4.2055 +      moreover
  4.2056 +      from eval wt da conf_s0 wf
  4.2057 +      have "s2\<Colon>\<preceq>(G, L)"
  4.2058 +	by (rule evaln_type_sound [elim_format]) simp
  4.2059 +      ultimately show ?thesis ..
  4.2060 +    qed
  4.2061 +  qed
  4.2062 +next
  4.2063 +  case (Skip A P)
  4.2064 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (P\<leftarrow>\<diamondsuit>)} .Skip. {P} }"
  4.2065 +  proof (rule valid_stmt_NormalI)
  4.2066 +    fix s0 s1 n L Y Z
  4.2067 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.2068 +    assume normal_s0: "normal s0"
  4.2069 +    assume eval: "G\<turnstile>s0 \<midarrow>Skip\<midarrow>n\<rightarrow> s1"
  4.2070 +    assume P: "(Normal (P\<leftarrow>\<diamondsuit>)) Y s0 Z"
  4.2071 +    show "P \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.2072 +    proof -
  4.2073 +      from eval obtain "s1=s0"
  4.2074 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2075 +      with P conf_s0 show ?thesis
  4.2076 +	by simp
  4.2077 +    qed
  4.2078 +  qed
  4.2079 +next
  4.2080 +  case (Expr A P Q e)
  4.2081 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {Q\<leftarrow>\<diamondsuit>} }".
  4.2082 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .Expr e. {Q} }"
  4.2083 +  proof (rule valid_stmt_NormalI)
  4.2084 +    fix n s0 L accC C s1 Y Z
  4.2085 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2086 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.2087 +    assume normal_s0: "normal s0"
  4.2088 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Expr e\<Colon>\<surd>"
  4.2089 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>Expr e\<rangle>\<^sub>s\<guillemotright> C"
  4.2090 +    assume eval: "G\<turnstile>s0 \<midarrow>Expr e\<midarrow>n\<rightarrow> s1"
  4.2091 +    assume P: "(Normal P) Y s0 Z"
  4.2092 +    show "Q \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G, L)"
  4.2093 +    proof -
  4.2094 +      from wt obtain eT where 
  4.2095 +	wt_e: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>e\<Colon>-eT"
  4.2096 +	by cases simp
  4.2097 +      from da obtain E where
  4.2098 +	da_e: "\<lparr>prg=G,cls=accC, lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright>E"
  4.2099 +	by cases simp
  4.2100 +      from eval obtain v where
  4.2101 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.2102 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2103 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e
  4.2104 +      obtain Q: "(Q\<leftarrow>\<diamondsuit>) \<lfloor>v\<rfloor>\<^sub>e s1 Z" and "s1\<Colon>\<preceq>(G,L)"
  4.2105 +	by (rule validE)
  4.2106 +      thus ?thesis by simp
  4.2107 +    qed
  4.2108 +  qed
  4.2109 +next
  4.2110 +  case (Lab A P Q c l)
  4.2111 +  have valid_c: "G,A|\<Turnstile>\<Colon>{ {Normal P} .c. {abupd (absorb l) .; Q} }".
  4.2112 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .l\<bullet> c. {Q} }"
  4.2113 +  proof (rule valid_stmt_NormalI)
  4.2114 +    fix n s0 L accC C s2 Y Z
  4.2115 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2116 +    assume conf_s0: "s0\<Colon>\<preceq>(G,L)"  
  4.2117 +    assume normal_s0: "normal s0"
  4.2118 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>l\<bullet> c\<Colon>\<surd>"
  4.2119 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>l\<bullet> c\<rangle>\<^sub>s\<guillemotright> C"
  4.2120 +    assume eval: "G\<turnstile>s0 \<midarrow>l\<bullet> c\<midarrow>n\<rightarrow> s2"
  4.2121 +    assume P: "(Normal P) Y s0 Z"
  4.2122 +    show "Q \<diamondsuit> s2 Z \<and> s2\<Colon>\<preceq>(G, L)"
  4.2123 +    proof -
  4.2124 +      from wt obtain 
  4.2125 +	wt_c: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c\<Colon>\<surd>"
  4.2126 +	by cases simp
  4.2127 +      from da obtain E where
  4.2128 +	da_c: "\<lparr>prg=G,cls=accC, lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright>E"
  4.2129 +	by cases simp
  4.2130 +      from eval obtain s1 where
  4.2131 +	eval_c: "G\<turnstile>s0 \<midarrow>c\<midarrow>n\<rightarrow> s1" and
  4.2132 +	s2: "s2 = abupd (absorb l) s1"
  4.2133 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2134 +      from valid_c P valid_A conf_s0 eval_c wt_c da_c
  4.2135 +      obtain Q: "(abupd (absorb l) .; Q) \<diamondsuit> s1 Z" 
  4.2136 +	by (rule validE)
  4.2137 +      with s2 have "Q \<diamondsuit> s2 Z"
  4.2138 +	by simp
  4.2139 +      moreover
  4.2140 +      from eval wt da conf_s0 wf
  4.2141 +      have "s2\<Colon>\<preceq>(G, L)"
  4.2142 +	by (rule evaln_type_sound [elim_format]) simp
  4.2143 +      ultimately show ?thesis ..
  4.2144 +    qed
  4.2145 +  qed
  4.2146 +next
  4.2147 +  case (Comp A P Q R c1 c2)
  4.2148 +  have valid_c1: "G,A|\<Turnstile>\<Colon>{ {Normal P} .c1. {Q} }" .
  4.2149 +  have valid_c2: "G,A|\<Turnstile>\<Colon>{ {Q} .c2. {R} }" .
  4.2150 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .c1;; c2. {R} }"
  4.2151 +  proof (rule valid_stmt_NormalI)
  4.2152 +    fix n s0 L accC C s2 Y Z
  4.2153 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2154 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2155 +    assume normal_s0: "normal s0"
  4.2156 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>(c1;; c2)\<Colon>\<surd>"
  4.2157 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s0))\<guillemotright>\<langle>c1;;c2\<rangle>\<^sub>s\<guillemotright>C"
  4.2158 +    assume eval: "G\<turnstile>s0 \<midarrow>c1;; c2\<midarrow>n\<rightarrow> s2"
  4.2159 +    assume P: "(Normal P) Y s0 Z"
  4.2160 +    show "R \<diamondsuit> s2 Z \<and> s2\<Colon>\<preceq>(G,L)"
  4.2161 +    proof -
  4.2162 +      from eval  obtain s1 where
  4.2163 +	eval_c1: "G\<turnstile>s0 \<midarrow>c1 \<midarrow>n\<rightarrow> s1" and
  4.2164 +	eval_c2: "G\<turnstile>s1 \<midarrow>c2 \<midarrow>n\<rightarrow> s2"
  4.2165 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2166 +      from wt obtain 
  4.2167 +	wt_c1: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  4.2168 +        wt_c2: "\<lparr>prg = G, cls = accC, lcl = L\<rparr>\<turnstile>c2\<Colon>\<surd>"
  4.2169 +	by cases simp
  4.2170 +      from da obtain C1 C2 where 
  4.2171 +	da_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1" and 
  4.2172 +	da_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>nrm C1 \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2" 
  4.2173 +	by cases simp
  4.2174 +      from valid_c1 P valid_A conf_s0 eval_c1 wt_c1 da_c1  
  4.2175 +      obtain Q: "Q \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"  
  4.2176 +	by (rule validE) 
  4.2177 +      have "R \<diamondsuit> s2 Z"
  4.2178 +      proof (cases "normal s1")
  4.2179 +	case True
  4.2180 +	obtain C2' where 
  4.2181 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s1)) \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2'"
  4.2182 +	proof -
  4.2183 +	  from eval_c1 wt_c1 da_c1 wf True
  4.2184 +	  have "nrm C1 \<subseteq> dom (locals (store s1))"
  4.2185 +	    by (cases rule: da_good_approx_evalnE) rules
  4.2186 +	  with da_c2 show ?thesis
  4.2187 +	    by (rule da_weakenE)
  4.2188 +	qed
  4.2189 +	with valid_c2 Q valid_A conf_s1 eval_c2 wt_c2 
  4.2190 +	show ?thesis
  4.2191 +	  by (rule validE)
  4.2192 +      next
  4.2193 +	case False
  4.2194 +	from valid_c2 Q valid_A conf_s1 eval_c2 False
  4.2195 +	show ?thesis
  4.2196 +	  by (cases rule: validE) rules+
  4.2197 +      qed
  4.2198 +      moreover
  4.2199 +      from eval wt da conf_s0 wf
  4.2200 +      have "s2\<Colon>\<preceq>(G, L)"
  4.2201 +	by (rule evaln_type_sound [elim_format]) simp
  4.2202 +      ultimately show ?thesis ..
  4.2203 +    qed
  4.2204 +  qed
  4.2205 +next
  4.2206 +  case (If A P P' Q c1 c2 e)
  4.2207 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {P'} }" .
  4.2208 +  have valid_then_else: "\<And> b. G,A|\<Turnstile>\<Colon>{ {P'\<leftarrow>=b} .(if b then c1 else c2). {Q} }" 
  4.2209 +    using If.hyps by simp
  4.2210 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .If(e) c1 Else c2. {Q} }"
  4.2211 +  proof (rule valid_stmt_NormalI)
  4.2212 +    fix n s0 L accC C s2 Y Z
  4.2213 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2214 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2215 +    assume normal_s0: "normal s0"
  4.2216 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>If(e) c1 Else c2\<Colon>\<surd>"
  4.2217 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2218 +                    \<turnstile>dom (locals (store s0))\<guillemotright>\<langle>If(e) c1 Else c2\<rangle>\<^sub>s\<guillemotright>C"
  4.2219 +    assume eval: "G\<turnstile>s0 \<midarrow>If(e) c1 Else c2\<midarrow>n\<rightarrow> s2"
  4.2220 +    assume P: "(Normal P) Y s0 Z"
  4.2221 +    show "Q \<diamondsuit> s2 Z \<and> s2\<Colon>\<preceq>(G,L)"
  4.2222 +    proof -
  4.2223 +      from eval obtain b s1 where
  4.2224 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>b\<midarrow>n\<rightarrow> s1" and
  4.2225 +	eval_then_else: "G\<turnstile>s1 \<midarrow>(if the_Bool b then c1 else c2)\<midarrow>n\<rightarrow> s2"
  4.2226 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.2227 +      from wt obtain  
  4.2228 +	wt_e: "\<lparr>prg=G, cls=accC, lcl=L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
  4.2229 +	wt_then_else: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>(if the_Bool b then c1 else c2)\<Colon>\<surd>"
  4.2230 +	by cases (simp split: split_if)
  4.2231 +      from da obtain E S where
  4.2232 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E" and
  4.2233 +	da_then_else: 
  4.2234 +	"\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> 
  4.2235 +             (dom (locals (store s0)) \<union> assigns_if (the_Bool b) e)
  4.2236 +               \<guillemotright>\<langle>if the_Bool b then c1 else c2\<rangle>\<^sub>s\<guillemotright> S"
  4.2237 +	by cases (cases "the_Bool b",auto)
  4.2238 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e
  4.2239 +      obtain "P' \<lfloor>b\<rfloor>\<^sub>e s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.2240 +	by (rule validE)
  4.2241 +      hence P': "\<And>v. (P'\<leftarrow>=the_Bool b) v s1 Z"
  4.2242 +	by (cases "normal s1") auto
  4.2243 +      have "Q \<diamondsuit> s2 Z"
  4.2244 +      proof (cases "normal s1")
  4.2245 +	case True
  4.2246 +	have s0_s1: "dom (locals (store s0)) 
  4.2247 +                      \<union> assigns_if (the_Bool b) e \<subseteq> dom (locals (store s1))"
  4.2248 +	proof -
  4.2249 +	  from eval_e 
  4.2250 +	  have eval_e': "G\<turnstile>s0 \<midarrow>e-\<succ>b\<rightarrow> s1"
  4.2251 +	    by (rule evaln_eval)
  4.2252 +	  hence
  4.2253 +	    "dom (locals (store s0)) \<subseteq> dom (locals (store s1))"
  4.2254 +	    by (rule dom_locals_eval_mono_elim)
  4.2255 +          moreover
  4.2256 +	  from eval_e' True wt_e
  4.2257 +	  have "assigns_if (the_Bool b) e \<subseteq> dom (locals (store s1))"
  4.2258 +	    by (rule assigns_if_good_approx') 
  4.2259 +	  ultimately show ?thesis by (rule Un_least)
  4.2260 +	qed
  4.2261 +	with da_then_else
  4.2262 +	obtain S' where
  4.2263 +	  "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2264 +              \<turnstile>dom (locals (store s1))\<guillemotright>\<langle>if the_Bool b then c1 else c2\<rangle>\<^sub>s\<guillemotright> S'"
  4.2265 +	  by (rule da_weakenE)
  4.2266 +	with valid_then_else P' valid_A conf_s1 eval_then_else wt_then_else
  4.2267 +	show ?thesis
  4.2268 +	  by (rule validE)
  4.2269 +      next
  4.2270 +	case False
  4.2271 +	with valid_then_else P' valid_A conf_s1 eval_then_else
  4.2272 +	show ?thesis
  4.2273 +	  by (cases rule: validE) rules+
  4.2274 +      qed
  4.2275 +      moreover
  4.2276 +      from eval wt da conf_s0 wf
  4.2277 +      have "s2\<Colon>\<preceq>(G, L)"
  4.2278 +	by (rule evaln_type_sound [elim_format]) simp
  4.2279 +      ultimately show ?thesis ..
  4.2280 +    qed
  4.2281 +  qed
  4.2282 +next
  4.2283 +  case (Loop A P P' c e l)
  4.2284 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {P} e-\<succ> {P'} }".
  4.2285 +  have valid_c: "G,A|\<Turnstile>\<Colon>{ {Normal (P'\<leftarrow>=True)} 
  4.2286 +                         .c. 
  4.2287 +                         {abupd (absorb (Cont l)) .; P} }" .
  4.2288 +  show "G,A|\<Turnstile>\<Colon>{ {P} .l\<bullet> While(e) c. {P'\<leftarrow>=False\<down>=\<diamondsuit>} }"
  4.2289 +  proof (rule valid_stmtI)
  4.2290 +    fix n s0 L accC C s3 Y Z
  4.2291 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2292 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2293 +    assume wt: "normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>l\<bullet> While(e) c\<Colon>\<surd>"
  4.2294 +    assume da: "normal s0 \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2295 +                    \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<guillemotright> C"
  4.2296 +    assume eval: "G\<turnstile>s0 \<midarrow>l\<bullet> While(e) c\<midarrow>n\<rightarrow> s3"
  4.2297 +    assume P: "P Y s0 Z"
  4.2298 +    show "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3 Z \<and> s3\<Colon>\<preceq>(G,L)"
  4.2299 +    proof -
  4.2300 +        --{* From the given hypothesises @{text valid_e} and @{text valid_c} 
  4.2301 +           we can only reach the state after unfolding the loop once, i.e. 
  4.2302 +	   @{term "P \<diamondsuit> s2 Z"}, where @{term s2} is the state after executing
  4.2303 +           @{term c}. To gain validity of the further execution of while, to
  4.2304 +           finally get @{term "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3 Z"} we have to get 
  4.2305 +           a hypothesis about the subsequent unfoldings (the whole loop again),
  4.2306 +           too. We can achieve this, by performing induction on the 
  4.2307 +           evaluation relation, with all
  4.2308 +           the necessary preconditions to apply @{text valid_e} and 
  4.2309 +           @{text valid_c} in the goal.
  4.2310 +        *}
  4.2311 +      {
  4.2312 +	fix t s s' v 
  4.2313 +	assume "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s')"
  4.2314 +	hence "\<And> Y' T E. 
  4.2315 +                \<lbrakk>t =  \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s; \<forall>t\<in>A. G\<Turnstile>n\<Colon>t; P Y' s Z; s\<Colon>\<preceq>(G, L);
  4.2316 +                 normal s \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>t\<Colon>T; 
  4.2317 +                 normal s \<Longrightarrow> \<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>dom (locals (store s))\<guillemotright>t\<guillemotright>E
  4.2318 +                \<rbrakk>\<Longrightarrow> (P'\<leftarrow>=False\<down>=\<diamondsuit>) v s' Z"
  4.2319 +	  (is "PROP ?Hyp n t s v s'")
  4.2320 +	proof (induct)
  4.2321 +	  case (Loop b c' e' l' n' s0' s1' s2' s3' Y' T E)
  4.2322 +	  have while: "(\<langle>l'\<bullet> While(e') c'\<rangle>\<^sub>s::term) = \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s" .
  4.2323 +          hence eqs: "l'=l" "e'=e" "c'=c" by simp_all
  4.2324 +	  have valid_A: "\<forall>t\<in>A. G\<Turnstile>n'\<Colon>t". 
  4.2325 +	  have P: "P Y' (Norm s0') Z".
  4.2326 +	  have conf_s0': "Norm s0'\<Colon>\<preceq>(G, L)" .
  4.2327 +          have wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<Colon>T"
  4.2328 +	    using Loop.prems eqs by simp
  4.2329 +	  have da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>
  4.2330 +                    dom (locals (store ((Norm s0')::state)))\<guillemotright>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<guillemotright>E"
  4.2331 +	    using Loop.prems eqs by simp
  4.2332 +	  have evaln_e: "G\<turnstile>Norm s0' \<midarrow>e-\<succ>b\<midarrow>n'\<rightarrow> s1'" 
  4.2333 +	    using Loop.hyps eqs by simp
  4.2334 +	  show "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3' Z"
  4.2335 +	  proof -
  4.2336 +	    from wt  obtain 
  4.2337 +	      wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-PrimT Boolean" and
  4.2338 +              wt_c: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c\<Colon>\<surd>"
  4.2339 +	      by cases (simp add: eqs)
  4.2340 +	    from da obtain E S where
  4.2341 +	      da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2342 +                     \<turnstile> dom (locals (store ((Norm s0')::state))) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E" and
  4.2343 +	      da_c: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2344 +                     \<turnstile> (dom (locals (store ((Norm s0')::state))) 
  4.2345 +                            \<union> assigns_if True e) \<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright> S"
  4.2346 +	      by cases (simp add: eqs)
  4.2347 +	    from evaln_e 
  4.2348 +	    have eval_e: "G\<turnstile>Norm s0' \<midarrow>e-\<succ>b\<rightarrow> s1'"
  4.2349 +	      by (rule evaln_eval)
  4.2350 +	    from valid_e P valid_A conf_s0' evaln_e wt_e da_e
  4.2351 +	    obtain P': "P' \<lfloor>b\<rfloor>\<^sub>e s1' Z" and conf_s1': "s1'\<Colon>\<preceq>(G,L)"
  4.2352 +	      by (rule validE)
  4.2353 +	    show "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3' Z"
  4.2354 +	    proof (cases "normal s1'")
  4.2355 +	      case True
  4.2356 +	      note normal_s1'=this
  4.2357 +	      show ?thesis
  4.2358 +	      proof (cases "the_Bool b")
  4.2359 +		case True
  4.2360 +		with P' normal_s1' have P'': "(Normal (P'\<leftarrow>=True)) \<lfloor>b\<rfloor>\<^sub>e s1' Z"
  4.2361 +		  by auto
  4.2362 +		from True Loop.hyps obtain
  4.2363 +		  eval_c: "G\<turnstile>s1' \<midarrow>c\<midarrow>n'\<rightarrow> s2'" and 
  4.2364 +		  eval_while:  
  4.2365 +		     "G\<turnstile>abupd (absorb (Cont l)) s2' \<midarrow>l\<bullet> While(e) c\<midarrow>n'\<rightarrow> s3'"
  4.2366 +		  by (simp add: eqs)
  4.2367 +		from True Loop.hyps have
  4.2368 +		  hyp: "PROP ?Hyp n' \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s 
  4.2369 +                          (abupd (absorb (Cont l')) s2') \<diamondsuit> s3'"
  4.2370 +		  apply (simp only: True if_True eqs)
  4.2371 +		  apply (elim conjE)
  4.2372 +		  apply (tactic "smp_tac 3 1")
  4.2373 +		  apply fast
  4.2374 +		  done
  4.2375 +		from eval_e
  4.2376 +		have s0'_s1': "dom (locals (store ((Norm s0')::state))) 
  4.2377 +                                  \<subseteq> dom (locals (store s1'))"
  4.2378 +		  by (rule dom_locals_eval_mono_elim)
  4.2379 +		obtain S' where
  4.2380 +		  da_c':
  4.2381 +		   "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>(dom (locals (store s1')))\<guillemotright>\<langle>c\<rangle>\<^sub>s\<guillemotright> S'" 
  4.2382 +		proof -
  4.2383 +		  note s0'_s1'
  4.2384 +		  moreover
  4.2385 +		  from eval_e normal_s1' wt_e 
  4.2386 +		  have "assigns_if True e \<subseteq> dom (locals (store s1'))"
  4.2387 +		    by (rule assigns_if_good_approx' [elim_format]) 
  4.2388 +                       (simp add: True)
  4.2389 +		  ultimately 
  4.2390 +		  have "dom (locals (store ((Norm s0')::state)))
  4.2391 +                           \<union> assigns_if True e \<subseteq> dom (locals (store s1'))"
  4.2392 +		    by (rule Un_least)
  4.2393 +		  with da_c show ?thesis
  4.2394 +		    by (rule da_weakenE)
  4.2395 +		qed
  4.2396 +		with valid_c P'' valid_A conf_s1' eval_c wt_c
  4.2397 +		obtain "(abupd (absorb (Cont l)) .; P) \<diamondsuit> s2' Z" and 
  4.2398 +                  conf_s2': "s2'\<Colon>\<preceq>(G,L)"
  4.2399 +		  by (rule validE)
  4.2400 +		hence P_s2': "P \<diamondsuit> (abupd (absorb (Cont l)) s2') Z"
  4.2401 +		  by simp
  4.2402 +		from conf_s2'
  4.2403 +		have conf_absorb: "abupd (absorb (Cont l)) s2' \<Colon>\<preceq>(G, L)"
  4.2404 +		  by (cases s2') (auto intro: conforms_absorb)
  4.2405 +		moreover
  4.2406 +		obtain E' where 
  4.2407 +		  da_while':
  4.2408 +		   "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> 
  4.2409 +		     dom (locals(store (abupd (absorb (Cont l)) s2')))
  4.2410 +                      \<guillemotright>\<langle>l\<bullet> While(e) c\<rangle>\<^sub>s\<guillemotright> E'"
  4.2411 +		proof -
  4.2412 +		  note s0'_s1'
  4.2413 +		  also 
  4.2414 +		  from eval_c 
  4.2415 +		  have "G\<turnstile>s1' \<midarrow>c\<rightarrow> s2'"
  4.2416 +		    by (rule evaln_eval)
  4.2417 +		  hence "dom (locals (store s1')) \<subseteq> dom (locals (store s2'))"
  4.2418 +		    by (rule dom_locals_eval_mono_elim)
  4.2419 +		  also 
  4.2420 +		  have "\<dots>\<subseteq>dom (locals (store (abupd (absorb (Cont l)) s2')))"
  4.2421 +		    by simp
  4.2422 +		  finally
  4.2423 +		  have "dom (locals (store ((Norm s0')::state))) \<subseteq> \<dots>" .
  4.2424 +		  with da show ?thesis
  4.2425 +		    by (rule da_weakenE)
  4.2426 +		qed
  4.2427 +		from valid_A P_s2' conf_absorb wt da_while'
  4.2428 +		show "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3' Z" 
  4.2429 +		  using hyp by (simp add: eqs)
  4.2430 +	      next
  4.2431 +		case False
  4.2432 +		with Loop.hyps obtain "s3'=s1'"
  4.2433 +		  by simp
  4.2434 +		with P' False show ?thesis
  4.2435 +		  by auto
  4.2436 +	      qed 
  4.2437 +	    next
  4.2438 +	      case False
  4.2439 +	      note abnormal_s1'=this
  4.2440 +	      have "s3'=s1'"
  4.2441 +	      proof -
  4.2442 +		from False obtain abr where abr: "abrupt s1' = Some abr"
  4.2443 +		  by (cases s1') auto
  4.2444 +		from eval_e _ wt_e wf
  4.2445 +		have no_jmp: "\<And> j. abrupt s1' \<noteq> Some (Jump j)"
  4.2446 +		  by (rule eval_expression_no_jump 
  4.2447 +                       [where ?Env="\<lparr>prg=G,cls=accC,lcl=L\<rparr>",simplified])
  4.2448 +		     simp
  4.2449 +		show ?thesis
  4.2450 +		proof (cases "the_Bool b")
  4.2451 +		  case True  
  4.2452 +		  with Loop.hyps obtain
  4.2453 +		    eval_c: "G\<turnstile>s1' \<midarrow>c\<midarrow>n'\<rightarrow> s2'" and 
  4.2454 +		    eval_while:  
  4.2455 +		     "G\<turnstile>abupd (absorb (Cont l)) s2' \<midarrow>l\<bullet> While(e) c\<midarrow>n'\<rightarrow> s3'"
  4.2456 +		    by (simp add: eqs)
  4.2457 +		  from eval_c abr have "s2'=s1'" by auto
  4.2458 +		  moreover from calculation no_jmp 
  4.2459 +		  have "abupd (absorb (Cont l)) s2'=s2'"
  4.2460 +		    by (cases s1') (simp add: absorb_def)
  4.2461 +		  ultimately show ?thesis
  4.2462 +		    using eval_while abr
  4.2463 +		    by auto
  4.2464 +		next
  4.2465 +		  case False
  4.2466 +		  with Loop.hyps show ?thesis by simp
  4.2467 +		qed
  4.2468 +	      qed
  4.2469 +	      with P' False show ?thesis
  4.2470 +		by auto
  4.2471 +	    qed
  4.2472 +	  qed
  4.2473 +	next
  4.2474 +	  case (Abrupt n' s t' abr Y' T E)
  4.2475 +	  have t': "t' = \<langle>l\<bullet> While(e) c\<rangle>\<^sub>s".
  4.2476 +	  have conf: "(Some abr, s)\<Colon>\<preceq>(G, L)".
  4.2477 +	  have P: "P Y' (Some abr, s) Z".
  4.2478 +	  have valid_A: "\<forall>t\<in>A. G\<Turnstile>n'\<Colon>t". 
  4.2479 +	  show "(P'\<leftarrow>=False\<down>=\<diamondsuit>) (arbitrary3 t') (Some abr, s) Z"
  4.2480 +	  proof -
  4.2481 +	    have eval_e: 
  4.2482 +	      "G\<turnstile>(Some abr,s) \<midarrow>\<langle>e\<rangle>\<^sub>e\<succ>\<midarrow>n'\<rightarrow> (arbitrary3 \<langle>e\<rangle>\<^sub>e,(Some abr,s))"
  4.2483 +	      by auto
  4.2484 +	    from valid_e P valid_A conf eval_e 
  4.2485 +	    have "P' (arbitrary3 \<langle>e\<rangle>\<^sub>e) (Some abr,s) Z"
  4.2486 +	      by (cases rule: validE [where ?P="P"]) simp+
  4.2487 +	    with t' show ?thesis
  4.2488 +	      by auto
  4.2489 +	  qed
  4.2490 +	qed (simp_all)
  4.2491 +      } note generalized=this
  4.2492 +      from eval _ valid_A P conf_s0 wt da
  4.2493 +      have "(P'\<leftarrow>=False\<down>=\<diamondsuit>) \<diamondsuit> s3 Z"
  4.2494 +	by (rule generalized)  simp_all
  4.2495 +      moreover
  4.2496 +      have "s3\<Colon>\<preceq>(G, L)"
  4.2497 +      proof (cases "normal s0")
  4.2498 +	case True
  4.2499 +	from eval wt [OF True] da [OF True] conf_s0 wf
  4.2500 +	show ?thesis
  4.2501 +	  by (rule evaln_type_sound [elim_format]) simp
  4.2502 +      next
  4.2503 +	case False
  4.2504 +	with eval have "s3=s0"
  4.2505 +	  by auto
  4.2506 +	with conf_s0 show ?thesis 
  4.2507 +	  by simp
  4.2508 +      qed
  4.2509 +      ultimately show ?thesis ..
  4.2510 +    qed
  4.2511 +  qed
  4.2512 +next
  4.2513 +  case (Jmp A P j)
  4.2514 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (abupd (\<lambda>a. Some (Jump j)) .; P\<leftarrow>\<diamondsuit>)} .Jmp j. {P} }"
  4.2515 +  proof (rule valid_stmt_NormalI)
  4.2516 +    fix n s0 L accC C s1 Y Z
  4.2517 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2518 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2519 +    assume normal_s0: "normal s0"
  4.2520 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Jmp j\<Colon>\<surd>"
  4.2521 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2522 +                    \<turnstile>dom (locals (store s0))\<guillemotright>\<langle>Jmp j\<rangle>\<^sub>s\<guillemotright>C"
  4.2523 +    assume eval: "G\<turnstile>s0 \<midarrow>Jmp j\<midarrow>n\<rightarrow> s1"
  4.2524 +    assume P: "(Normal (abupd (\<lambda>a. Some (Jump j)) .; P\<leftarrow>\<diamondsuit>)) Y s0 Z"
  4.2525 +    show "P \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G,L)"
  4.2526 +    proof -
  4.2527 +      from eval obtain s where  
  4.2528 +	s: "s0=Norm s" "s1=(Some (Jump j), s)" 
  4.2529 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.2530 +      with P have "P \<diamondsuit> s1 Z"
  4.2531 +	by simp
  4.2532 +      moreover 
  4.2533 +      from eval wt da conf_s0 wf
  4.2534 +      have "s1\<Colon>\<preceq>(G,L)"
  4.2535 +	by (rule evaln_type_sound [elim_format]) simp
  4.2536 +      ultimately show ?thesis ..
  4.2537 +    qed
  4.2538 +  qed
  4.2539 +next
  4.2540 +  case (Throw A P Q e)
  4.2541 +  have valid_e: "G,A|\<Turnstile>\<Colon>{ {Normal P} e-\<succ> {\<lambda>Val:a:. abupd (throw a) .; Q\<leftarrow>\<diamondsuit>} }".
  4.2542 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .Throw e. {Q} }"
  4.2543 +  proof (rule valid_stmt_NormalI)
  4.2544 +    fix n s0 L accC C s2 Y Z
  4.2545 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2546 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2547 +    assume normal_s0: "normal s0"
  4.2548 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Throw e\<Colon>\<surd>"
  4.2549 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2550 +                    \<turnstile>dom (locals (store s0))\<guillemotright>\<langle>Throw e\<rangle>\<^sub>s\<guillemotright>C"
  4.2551 +    assume eval: "G\<turnstile>s0 \<midarrow>Throw e\<midarrow>n\<rightarrow> s2"
  4.2552 +    assume P: "(Normal P) Y s0 Z"
  4.2553 +    show "Q \<diamondsuit> s2 Z \<and> s2\<Colon>\<preceq>(G,L)"
  4.2554 +    proof -
  4.2555 +      from eval obtain s1 a where
  4.2556 +	eval_e: "G\<turnstile>s0 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s1" and
  4.2557 +	s2: "s2 = abupd (throw a) s1"
  4.2558 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.2559 +      from wt obtain T where
  4.2560 +	wt_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>e\<Colon>-T"
  4.2561 +	by cases simp
  4.2562 +      from da obtain E where
  4.2563 +	da_e: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>e\<rangle>\<^sub>e\<guillemotright> E"
  4.2564 +	by cases simp
  4.2565 +      from valid_e P valid_A conf_s0 eval_e wt_e da_e 
  4.2566 +      obtain "(\<lambda>Val:a:. abupd (throw a) .; Q\<leftarrow>\<diamondsuit>) \<lfloor>a\<rfloor>\<^sub>e s1 Z"
  4.2567 +	by (rule validE)
  4.2568 +      with s2 have "Q \<diamondsuit> s2 Z"
  4.2569 +	by simp
  4.2570 +      moreover 
  4.2571 +      from eval wt da conf_s0 wf
  4.2572 +      have "s2\<Colon>\<preceq>(G,L)"
  4.2573 +	by (rule evaln_type_sound [elim_format]) simp
  4.2574 +      ultimately show ?thesis ..
  4.2575 +    qed
  4.2576 +  qed
  4.2577 +next
  4.2578 +  case (Try A C P Q R c1 c2 vn)
  4.2579 +  have valid_c1: "G,A|\<Turnstile>\<Colon>{ {Normal P} .c1. {SXAlloc G Q} }".
  4.2580 +  have valid_c2: "G,A|\<Turnstile>\<Colon>{ {Q \<and>. (\<lambda>s. G,s\<turnstile>catch C) ;. new_xcpt_var vn} 
  4.2581 +                           .c2. 
  4.2582 +                          {R} }".
  4.2583 +  have Q_R: "(Q \<and>. (\<lambda>s. \<not> G,s\<turnstile>catch C)) \<Rightarrow> R" .
  4.2584 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .Try c1 Catch(C vn) c2. {R} }"
  4.2585 +  proof (rule valid_stmt_NormalI)
  4.2586 +    fix n s0 L accC E s3 Y Z
  4.2587 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2588 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2589 +    assume normal_s0: "normal s0"
  4.2590 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Try c1 Catch(C vn) c2\<Colon>\<surd>"
  4.2591 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2592 +                    \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>Try c1 Catch(C vn) c2\<rangle>\<^sub>s\<guillemotright> E"
  4.2593 +    assume eval: "G\<turnstile>s0 \<midarrow>Try c1 Catch(C vn) c2\<midarrow>n\<rightarrow> s3"
  4.2594 +    assume P: "(Normal P) Y s0 Z"
  4.2595 +    show "R \<diamondsuit> s3 Z \<and> s3\<Colon>\<preceq>(G,L)"
  4.2596 +    proof -
  4.2597 +      from eval obtain s1 s2 where
  4.2598 +	eval_c1: "G\<turnstile>s0 \<midarrow>c1\<midarrow>n\<rightarrow> s1" and
  4.2599 +        sxalloc: "G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2" and
  4.2600 +        s3: "if G,s2\<turnstile>catch C 
  4.2601 +                then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>n\<rightarrow> s3 
  4.2602 +                else s3 = s2"
  4.2603 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2604 +      from wt obtain
  4.2605 +	wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  4.2606 +	wt_c2: "\<lparr>prg=G,cls=accC,lcl=L(VName vn\<mapsto>Class C)\<rparr>\<turnstile>c2\<Colon>\<surd>"
  4.2607 +	by cases simp
  4.2608 +      from da obtain C1 C2 where
  4.2609 +	da_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1" and
  4.2610 +	da_c2: "\<lparr>prg=G,cls=accC,lcl=L(VName vn\<mapsto>Class C)\<rparr>
  4.2611 +                   \<turnstile> (dom (locals (store s0)) \<union> {VName vn}) \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2"
  4.2612 +	by cases simp
  4.2613 +      from valid_c1 P valid_A conf_s0 eval_c1 wt_c1 da_c1
  4.2614 +      obtain sxQ: "(SXAlloc G Q) \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.2615 +	by (rule validE)
  4.2616 +      from sxalloc sxQ
  4.2617 +      have Q: "Q \<diamondsuit> s2 Z"
  4.2618 +	by auto
  4.2619 +      have "R \<diamondsuit> s3 Z"
  4.2620 +      proof (cases "\<exists> x. abrupt s1 = Some (Xcpt x)")
  4.2621 +	case False
  4.2622 +	from sxalloc wf
  4.2623 +	have "s2=s1"
  4.2624 +	  by (rule sxalloc_type_sound [elim_format])
  4.2625 +	     (insert False, auto split: option.splits abrupt.splits )
  4.2626 +	with False 
  4.2627 +	have no_catch: "\<not>  G,s2\<turnstile>catch C"
  4.2628 +	  by (simp add: catch_def)
  4.2629 +	moreover
  4.2630 +	from no_catch s3
  4.2631 +	have "s3=s2"
  4.2632 +	  by simp
  4.2633 +	ultimately show ?thesis
  4.2634 +	  using Q Q_R by simp
  4.2635 +      next
  4.2636 +	case True
  4.2637 +	note exception_s1 = this
  4.2638 +	show ?thesis
  4.2639 +	proof (cases "G,s2\<turnstile>catch C") 
  4.2640 +	  case False
  4.2641 +	  with s3
  4.2642 +	  have "s3=s2"
  4.2643 +	    by simp
  4.2644 +	  with False Q Q_R show ?thesis
  4.2645 +	    by simp
  4.2646 +	next
  4.2647 +	  case True
  4.2648 +	  with s3 have eval_c2: "G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>n\<rightarrow> s3"
  4.2649 +	    by simp
  4.2650 +	  from conf_s1 sxalloc wf 
  4.2651 +	  have conf_s2: "s2\<Colon>\<preceq>(G, L)" 
  4.2652 +	    by (auto dest: sxalloc_type_sound 
  4.2653 +                    split: option.splits abrupt.splits)
  4.2654 +	  from exception_s1 sxalloc wf
  4.2655 +	  obtain a 
  4.2656 +	    where xcpt_s2: "abrupt s2 = Some (Xcpt (Loc a))"
  4.2657 +	    by (auto dest!: sxalloc_type_sound 
  4.2658 +                            split: option.splits abrupt.splits)
  4.2659 +	  with True
  4.2660 +	  have "G\<turnstile>obj_ty (the (globs (store s2) (Heap a)))\<preceq>Class C"
  4.2661 +	    by (cases s2) simp
  4.2662 +	  with xcpt_s2 conf_s2 wf
  4.2663 +	  have conf_new_xcpt: "new_xcpt_var vn s2 \<Colon>\<preceq>(G, L(VName vn\<mapsto>Class C))"
  4.2664 +	    by (auto dest: Try_lemma)
  4.2665 +	  obtain C2' where
  4.2666 +	    da_c2':
  4.2667 +	    "\<lparr>prg=G,cls=accC,lcl=L(VName vn\<mapsto>Class C)\<rparr>
  4.2668 +              \<turnstile> (dom (locals (store (new_xcpt_var vn s2)))) \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2'"
  4.2669 +	  proof -
  4.2670 +	    have "(dom (locals (store s0)) \<union> {VName vn}) 
  4.2671 +                    \<subseteq> dom (locals (store (new_xcpt_var vn s2)))"
  4.2672 +            proof -
  4.2673 +	      from eval_c1 
  4.2674 +              have "dom (locals (store s0)) 
  4.2675 +                      \<subseteq> dom (locals (store s1))"
  4.2676 +		by (rule dom_locals_evaln_mono_elim)
  4.2677 +              also
  4.2678 +              from sxalloc
  4.2679 +              have "\<dots> \<subseteq> dom (locals (store s2))"
  4.2680 +		by (rule dom_locals_sxalloc_mono)
  4.2681 +              also 
  4.2682 +              have "\<dots> \<subseteq> dom (locals (store (new_xcpt_var vn s2)))" 
  4.2683 +		by (cases s2) (simp add: new_xcpt_var_def, blast) 
  4.2684 +              also
  4.2685 +              have "{VName vn} \<subseteq> \<dots>"
  4.2686 +		by (cases s2) simp
  4.2687 +              ultimately show ?thesis
  4.2688 +		by (rule Un_least)
  4.2689 +            qed
  4.2690 +	    with da_c2 show ?thesis
  4.2691 +	      by (rule da_weakenE)
  4.2692 +	  qed
  4.2693 +	  from Q eval_c2 True 
  4.2694 +	  have "(Q \<and>. (\<lambda>s. G,s\<turnstile>catch C) ;. new_xcpt_var vn) 
  4.2695 +                   \<diamondsuit> (new_xcpt_var vn s2) Z"
  4.2696 +	    by auto
  4.2697 +	  from valid_c2 this valid_A conf_new_xcpt eval_c2 wt_c2 da_c2'
  4.2698 +	  show "R \<diamondsuit> s3 Z"
  4.2699 +	    by (rule validE)
  4.2700 +	qed
  4.2701 +      qed
  4.2702 +      moreover 
  4.2703 +      from eval wt da conf_s0 wf
  4.2704 +      have "s3\<Colon>\<preceq>(G,L)"
  4.2705 +	by (rule evaln_type_sound [elim_format]) simp
  4.2706 +      ultimately show ?thesis ..
  4.2707 +    qed
  4.2708 +  qed
  4.2709 +next
  4.2710 +  case (Fin A P Q R c1 c2)
  4.2711 +  have valid_c1: "G,A|\<Turnstile>\<Colon>{ {Normal P} .c1. {Q} }".
  4.2712 +  have valid_c2: "\<And> abr. G,A|\<Turnstile>\<Colon>{ {Q \<and>. (\<lambda>s. abr = fst s) ;. abupd (\<lambda>x. None)} 
  4.2713 +                                  .c2.
  4.2714 +                                  {abupd (abrupt_if (abr \<noteq> None) abr) .; R} }"
  4.2715 +    using Fin.hyps by simp
  4.2716 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .c1 Finally c2. {R} }"
  4.2717 +  proof (rule valid_stmt_NormalI)
  4.2718 +    fix n s0 L accC E s3 Y Z
  4.2719 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2720 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2721 +    assume normal_s0: "normal s0"
  4.2722 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1 Finally c2\<Colon>\<surd>"
  4.2723 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2724 +                    \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>c1 Finally c2\<rangle>\<^sub>s\<guillemotright> E"
  4.2725 +    assume eval: "G\<turnstile>s0 \<midarrow>c1 Finally c2\<midarrow>n\<rightarrow> s3"
  4.2726 +    assume P: "(Normal P) Y s0 Z"
  4.2727 +    show "R \<diamondsuit> s3 Z \<and> s3\<Colon>\<preceq>(G,L)"
  4.2728 +    proof -
  4.2729 +      from eval obtain s1 abr1 s2 where
  4.2730 +	eval_c1: "G\<turnstile>s0 \<midarrow>c1\<midarrow>n\<rightarrow> (abr1, s1)" and
  4.2731 +        eval_c2: "G\<turnstile>Norm s1 \<midarrow>c2\<midarrow>n\<rightarrow> s2" and
  4.2732 +        s3: "s3 = (if \<exists>err. abr1 = Some (Error err) 
  4.2733 +                      then (abr1, s1)
  4.2734 +                      else abupd (abrupt_if (abr1 \<noteq> None) abr1) s2)"
  4.2735 +	using normal_s0 by (fastsimp elim: evaln_elim_cases)
  4.2736 +      from wt obtain
  4.2737 +	wt_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c1\<Colon>\<surd>" and
  4.2738 +	wt_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>c2\<Colon>\<surd>"
  4.2739 +	by cases simp
  4.2740 +      from da obtain C1 C2 where
  4.2741 +	da_c1: "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>c1\<rangle>\<^sub>s\<guillemotright> C1" and
  4.2742 +	da_c2: "\<lparr>prg=G,cls=accC,lcl=L\<rparr> \<turnstile> dom (locals (store s0)) \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2"
  4.2743 +	by cases simp
  4.2744 +      from valid_c1 P valid_A conf_s0 eval_c1 wt_c1 da_c1
  4.2745 +      obtain Q: "Q \<diamondsuit> (abr1,s1) Z" and conf_s1: "(abr1,s1)\<Colon>\<preceq>(G,L)" 
  4.2746 +	by (rule validE)
  4.2747 +      from Q 
  4.2748 +      have Q': "(Q \<and>. (\<lambda>s. abr1 = fst s) ;. abupd (\<lambda>x. None)) \<diamondsuit> (Norm s1) Z"
  4.2749 +	by auto
  4.2750 +      from eval_c1 wt_c1 da_c1 conf_s0 wf
  4.2751 +      have  "error_free (abr1,s1)"
  4.2752 +	by (rule evaln_type_sound  [elim_format]) (insert normal_s0,simp)
  4.2753 +      with s3 have s3': "s3 = abupd (abrupt_if (abr1 \<noteq> None) abr1) s2"
  4.2754 +	by (simp add: error_free_def)
  4.2755 +      from conf_s1 
  4.2756 +      have conf_Norm_s1: "Norm s1\<Colon>\<preceq>(G,L)"
  4.2757 +	by (rule conforms_NormI)
  4.2758 +      obtain C2' where 
  4.2759 +	da_c2': "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2760 +                   \<turnstile> dom (locals (store ((Norm s1)::state))) \<guillemotright>\<langle>c2\<rangle>\<^sub>s\<guillemotright> C2'"
  4.2761 +      proof -
  4.2762 +	from eval_c1 
  4.2763 +	have "dom (locals (store s0)) \<subseteq> dom (locals (store (abr1,s1)))"
  4.2764 +          by (rule dom_locals_evaln_mono_elim)
  4.2765 +	hence "dom (locals (store s0)) 
  4.2766 +                 \<subseteq> dom (locals (store ((Norm s1)::state)))"
  4.2767 +	  by simp
  4.2768 +	with da_c2 show ?thesis
  4.2769 +	  by (rule da_weakenE)
  4.2770 +      qed
  4.2771 +      from valid_c2 Q' valid_A conf_Norm_s1 eval_c2 wt_c2 da_c2'
  4.2772 +      have "(abupd (abrupt_if (abr1 \<noteq> None) abr1) .; R) \<diamondsuit> s2 Z"
  4.2773 +	by (rule validE)
  4.2774 +      with s3' have "R \<diamondsuit> s3 Z"
  4.2775 +	by simp
  4.2776 +      moreover
  4.2777 +      from eval wt da conf_s0 wf
  4.2778 +      have "s3\<Colon>\<preceq>(G,L)"
  4.2779 +	by (rule evaln_type_sound [elim_format]) simp
  4.2780 +      ultimately show ?thesis ..
  4.2781 +    qed
  4.2782 +  qed
  4.2783 +next
  4.2784 +  case (Done A C P)
  4.2785 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (P\<leftarrow>\<diamondsuit> \<and>. initd C)} .Init C. {P} }" 
  4.2786 +  proof (rule valid_stmt_NormalI)
  4.2787 +    fix n s0 L accC E s3 Y Z
  4.2788 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2789 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2790 +    assume normal_s0: "normal s0"
  4.2791 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Init C\<Colon>\<surd>"
  4.2792 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2793 +                    \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>Init C\<rangle>\<^sub>s\<guillemotright> E"
  4.2794 +    assume eval: "G\<turnstile>s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s3"
  4.2795 +    assume P: "(Normal (P\<leftarrow>\<diamondsuit> \<and>. initd C)) Y s0 Z"
  4.2796 +    show "P \<diamondsuit> s3 Z \<and> s3\<Colon>\<preceq>(G,L)"
  4.2797 +    proof -
  4.2798 +      from P have inited: "inited C (globs (store s0))"
  4.2799 +	by simp
  4.2800 +      with eval have "s3=s0"
  4.2801 +	using normal_s0 by (auto elim: evaln_elim_cases)
  4.2802 +      with P conf_s0 show ?thesis
  4.2803 +	by simp
  4.2804 +    qed
  4.2805 +  qed
  4.2806 +next
  4.2807 +  case (Init A C P Q R c)
  4.2808 +  have c: "the (class G C) = c".
  4.2809 +  have valid_super: 
  4.2810 +        "G,A|\<Turnstile>\<Colon>{ {Normal (P \<and>. Not \<circ> initd C ;. supd (init_class_obj G C))}
  4.2811 +                 .(if C = Object then Skip else Init (super c)). 
  4.2812 +                 {Q} }".
  4.2813 +  have valid_init: 
  4.2814 +        "\<And> l.  G,A|\<Turnstile>\<Colon>{ {Q \<and>. (\<lambda>s. l = locals (snd s)) ;. set_lvars empty} 
  4.2815 +                        .init c.
  4.2816 +                        {set_lvars l .; R} }"
  4.2817 +    using Init.hyps by simp
  4.2818 +  show "G,A|\<Turnstile>\<Colon>{ {Normal (P \<and>. Not \<circ> initd C)} .Init C. {R} }"
  4.2819 +  proof (rule valid_stmt_NormalI)
  4.2820 +    fix n s0 L accC E s3 Y Z
  4.2821 +    assume valid_A: "\<forall>t\<in>A. G\<Turnstile>n\<Colon>t"
  4.2822 +    assume conf_s0:  "s0\<Colon>\<preceq>(G,L)"  
  4.2823 +    assume normal_s0: "normal s0"
  4.2824 +    assume wt: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>\<turnstile>Init C\<Colon>\<surd>"
  4.2825 +    assume da: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2826 +                    \<turnstile>dom (locals (store s0)) \<guillemotright>\<langle>Init C\<rangle>\<^sub>s\<guillemotright> E"
  4.2827 +    assume eval: "G\<turnstile>s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s3"
  4.2828 +    assume P: "(Normal (P \<and>. Not \<circ> initd C)) Y s0 Z"
  4.2829 +    show "R \<diamondsuit> s3 Z \<and> s3\<Colon>\<preceq>(G,L)"
  4.2830 +    proof -
  4.2831 +      from P have not_inited: "\<not> inited C (globs (store s0))" by simp
  4.2832 +      with eval c obtain s1 s2 where
  4.2833 +	eval_super: 
  4.2834 +	"G\<turnstile>Norm ((init_class_obj G C) (store s0)) 
  4.2835 +           \<midarrow>(if C = Object then Skip else Init (super c))\<midarrow>n\<rightarrow> s1" and
  4.2836 +	eval_init: "G\<turnstile>(set_lvars empty) s1 \<midarrow>init c\<midarrow>n\<rightarrow> s2" and
  4.2837 +        s3: "s3 = (set_lvars (locals (store s1))) s2"
  4.2838 +	using normal_s0 by (auto elim!: evaln_elim_cases)
  4.2839 +      from wt c have
  4.2840 +	cls_C: "class G C = Some c"
  4.2841 +	by cases auto
  4.2842 +      from wf cls_C have
  4.2843 +	wt_super: "\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2844 +                         \<turnstile>(if C = Object then Skip else Init (super c))\<Colon>\<surd>"
  4.2845 +	by (cases "C=Object")
  4.2846 +           (auto dest: wf_prog_cdecl wf_cdecl_supD is_acc_classD)
  4.2847 +      obtain S where
  4.2848 +	da_super:
  4.2849 +	"\<lparr>prg=G,cls=accC,lcl=L\<rparr>
  4.2850 +          \<turnstile> dom (locals (store ((Norm 
  4.2851 +                            ((init_class_obj G C) (store s0)))::state))) 
  4.2852 +               \<guillemotright>\<langle>if C = Object then Skip else Init (super c)\<rangle>\<^sub>s\<guillemotright> S"
  4.2853 +      proof (cases "C=Object")
  4.2854 +	case True 
  4.2855 +	with da_Skip show ?thesis
  4.2856 +	  using that by (auto intro: assigned.select_convs)
  4.2857 +      next
  4.2858 +	case False 
  4.2859 +	with da_Init show ?thesis
  4.2860 +	  by - (rule that, auto intro: assigned.select_convs)
  4.2861 +      qed
  4.2862 +      from normal_s0 conf_s0 wf cls_C not_inited
  4.2863 +      have conf_init_cls: "(Norm ((init_class_obj G C) (store s0)))\<Colon>\<preceq>(G, L)"
  4.2864 +	by (auto intro: conforms_init_class_obj)	
  4.2865 +      from P 
  4.2866 +      have P': "(Normal (P \<and>. Not \<circ> initd C ;. supd (init_class_obj G C)))
  4.2867 +                   Y (Norm ((init_class_obj G C) (store s0))) Z"
  4.2868 +	by auto
  4.2869 +
  4.2870 +      from valid_super P' valid_A conf_init_cls eval_super wt_super da_super
  4.2871 +      obtain Q: "Q \<diamondsuit> s1 Z" and conf_s1: "s1\<Colon>\<preceq>(G,L)"
  4.2872 +	by (rule validE)
  4.2873 +      
  4.2874 +      from cls_C wf have wt_init: "\<lparr>prg=G, cls=C,lcl=empty\<rparr>\<turnstile>(init c)\<Colon>\<surd>"
  4.2875 +	by (rule wf_prog_cdecl [THEN wf_cdecl_wt_init])
  4.2876 +      from cls_C wf obtain I where 
  4.2877 +	"\<lparr>prg=G,cls=C,lcl=empty\<rparr>\<turnstile> {} \<guillemotright>\<langle>init c\<rangle>\<^sub>s\<guillemotright> I"
  4.2878 +	by (rule wf_prog_cdecl [THEN wf_cdeclE,simplified]) blast
  4.2879 +       (*  simplified: to rewrite \<langle>init c\<rangle> to In1r (init c) *) 
  4.2880 +      then obtain I' where
  4.2881 +	da_init:
  4.2882 +	"\<lparr>prg=G,cls=C,lcl=empty\<rparr>\<turnstile>dom (locals (store ((set_lvars empty) s1))) 
  4.2883 +            \<guillemotright>\<langle>init c\<rangle>\<^sub>s\<guillemotright> I'"
  4.2884 +	by (rule da_weakenE) simp
  4.2885 +      have conf_s1_empty: "(set_lvars empty) s1\<Colon>\<preceq>(G, empty)"
  4.2886 +      proof -
  4.2887 +	from eval_super have
  4.2888 +	  "G\<turnstile>Norm ((init_class_obj G C) (store s0)) 
  4.2889 +             \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1"
  4.2890 +	  by (rule evaln_eval)
  4.2891 +	from this wt_super wf
  4.2892 +	have s1_no_ret: "\<And> j. abrupt s1 \<noteq> Some (Jump j)"
  4.2893 +	  by - (rule eval_statement_no_jump 
  4.2894 +                 [where ?Env="\<lparr>prg=G,cls=accC,lcl=L\<rparr>"], auto split: split_if)
  4.2895 +        with conf_s1
  4.2896 +	show ?thesis
  4.2897 +	  by (cases s1) (auto intro: conforms_set_locals)
  4.2898 +      qed
  4.2899 +      
  4.2900 +      obtain l where l: "l = locals (store s1)"
  4.2901 +	by simp
  4.2902 +      with Q 
  4.2903 +      have Q': "(Q \<and>. (\<lambda>s. l = locals (snd s)) ;. set_lvars empty)
  4.2904 +                  \<diamondsuit> ((set_lvars empty) s1) Z"
  4.2905 +	by auto
  4.2906 +      from valid_init Q' valid_A conf_s1_empty eval_init wt_init da_init
  4.2907 +      have "(set_lvars l .; R) \<diamondsuit> s2 Z"
  4.2908 +	by (rule validE)
  4.2909 +      with s3 l have "R \<diamondsuit> s3 Z"
  4.2910 +	by simp
  4.2911 +      moreover 
  4.2912 +      from eval wt da conf_s0 wf
  4.2913 +      have "s3\<Colon>\<preceq>(G,L)"
  4.2914 +	by (rule evaln_type_sound [elim_format]) simp
  4.2915 +      ultimately show ?thesis ..
  4.2916 +    qed
  4.2917 +  qed
  4.2918 +next
  4.2919 +  case (InsInitV A P Q c v)
  4.2920 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} InsInitV c v=\<succ> {Q} }"
  4.2921 +  proof (rule valid_var_NormalI)
  4.2922 +    fix s0 vf n s1 L Z
  4.2923 +    assume "normal s0"
  4.2924 +    moreover
  4.2925 +    assume "G\<turnstile>s0 \<midarrow>InsInitV c v=\<succ>vf\<midarrow>n\<rightarrow> s1"
  4.2926 +    ultimately have "False" 
  4.2927 +      by (cases s0) (simp add: evaln_InsInitV) 
  4.2928 +    thus "Q \<lfloor>vf\<rfloor>\<^sub>v s1 Z \<and> s1\<Colon>\<preceq>(G, L)"..
  4.2929 +  qed
  4.2930 +next
  4.2931 +  case (InsInitE A P Q c e)
  4.2932 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} InsInitE c e-\<succ> {Q} }"
  4.2933 +  proof (rule valid_expr_NormalI)
  4.2934 +    fix s0 v n s1 L Z
  4.2935 +    assume "normal s0"
  4.2936 +    moreover
  4.2937 +    assume "G\<turnstile>s0 \<midarrow>InsInitE c e-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.2938 +    ultimately have "False" 
  4.2939 +      by (cases s0) (simp add: evaln_InsInitE) 
  4.2940 +    thus "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"..
  4.2941 +  qed
  4.2942 +next
  4.2943 +  case (Callee A P Q e l)
  4.2944 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} Callee l e-\<succ> {Q} }"
  4.2945 +  proof (rule valid_expr_NormalI)
  4.2946 +    fix s0 v n s1 L Z
  4.2947 +    assume "normal s0"
  4.2948 +    moreover
  4.2949 +    assume "G\<turnstile>s0 \<midarrow>Callee l e-\<succ>v\<midarrow>n\<rightarrow> s1"
  4.2950 +    ultimately have "False" 
  4.2951 +      by (cases s0) (simp add: evaln_Callee) 
  4.2952 +    thus "Q \<lfloor>v\<rfloor>\<^sub>e s1 Z \<and> s1\<Colon>\<preceq>(G, L)"..
  4.2953 +  qed
  4.2954 +next
  4.2955 +  case (FinA A P Q a c)
  4.2956 +  show "G,A|\<Turnstile>\<Colon>{ {Normal P} .FinA a c. {Q} }"
  4.2957 +  proof (rule valid_stmt_NormalI)
  4.2958 +    fix s0 v n s1 L Z
  4.2959 +    assume "normal s0"
  4.2960 +    moreover
  4.2961 +    assume "G\<turnstile>s0 \<midarrow>FinA a c\<midarrow>n\<rightarrow> s1"
  4.2962 +    ultimately have "False" 
  4.2963 +      by (cases s0) (simp add: evaln_FinA) 
  4.2964 +    thus "Q \<diamondsuit> s1 Z \<and> s1\<Colon>\<preceq>(G, L)"..
  4.2965 +  qed
  4.2966 +qed
  4.2967 +declare inj_term_simps [simp del]
  4.2968 +    
  4.2969  theorem ax_sound: 
  4.2970   "wf_prog G \<Longrightarrow> G,(A::'a triple set)|\<turnstile>(ts::'a triple set) \<Longrightarrow> G,A|\<Turnstile>ts"
  4.2971  apply (subst ax_valids2_eq [symmetric])
  4.2972 @@ -472,5 +2665,9 @@
  4.2973  apply (erule (1) ax_sound2)
  4.2974  done
  4.2975  
  4.2976 +lemma sound_valid2_lemma: 
  4.2977 +"\<lbrakk>\<forall>v n. Ball A (triple_valid2 G n) \<longrightarrow> P v n; Ball A (triple_valid2 G n)\<rbrakk>
  4.2978 + \<Longrightarrow>P v n"
  4.2979 +by blast
  4.2980  
  4.2981  end
     5.1 --- a/src/HOL/Bali/Basis.thy	Wed Oct 30 12:44:18 2002 +0100
     5.2 +++ b/src/HOL/Bali/Basis.thy	Thu Oct 31 18:27:10 2002 +0100
     5.3 @@ -247,6 +247,12 @@
     5.4  	"In1l e" == "In1 (Inl e)"
     5.5  	"In1r c" == "In1 (Inr c)"
     5.6  
     5.7 +syntax the_In1l :: "('al + 'ar, 'b, 'c) sum3 \<Rightarrow> 'al"
     5.8 +       the_In1r :: "('al + 'ar, 'b, 'c) sum3 \<Rightarrow> 'ar"
     5.9 +translations
    5.10 +   "the_In1l" == "the_Inl \<circ> the_In1"
    5.11 +   "the_In1r" == "the_Inr \<circ> the_In1"
    5.12 +
    5.13  ML {*
    5.14  fun sum3_instantiate thm = map (fn s => simplify(simpset()delsimps[not_None_eq])
    5.15   (read_instantiate [("t","In"^s^" ?x")] thm)) ["1l","2","3","1r"]
     6.1 --- a/src/HOL/Bali/Conform.thy	Wed Oct 30 12:44:18 2002 +0100
     6.2 +++ b/src/HOL/Bali/Conform.thy	Thu Oct 31 18:27:10 2002 +0100
     6.3 @@ -115,6 +115,13 @@
     6.4  apply (simp add: conf_def)
     6.5  done
     6.6  
     6.7 +lemma conf_Boolean: "G,s\<turnstile>v\<Colon>\<preceq>PrimT Boolean \<Longrightarrow> \<exists> b. v=Bool b"
     6.8 +by (cases v)
     6.9 +   (auto simp: conf_def obj_ty_def 
    6.10 +         dest: widen_Boolean2 
    6.11 +        split: obj_tag.splits)
    6.12 +
    6.13 +
    6.14  lemma conf_litval [rule_format (no_asm)]: 
    6.15    "typeof (\<lambda>a. None) v = Some T \<longrightarrow> G,s\<turnstile>v\<Colon>\<preceq>T"
    6.16  apply (unfold conf_def)
    6.17 @@ -249,6 +256,97 @@
    6.18  apply force
    6.19  done
    6.20  
    6.21 +section "weak value list conformance"
    6.22 +
    6.23 +text {* Only if the value is defined it has to conform to its type. 
    6.24 +        This is the contribution of the definite assignment analysis to 
    6.25 +        the notion of conformance. The definite assignment analysis ensures
    6.26 +        that the program only attempts to access local variables that 
    6.27 +        actually have a defined value in the state. 
    6.28 +        So conformance must only ensure that the
    6.29 +        defined values are of the right type, and not also that the value
    6.30 +        is defined. 
    6.31 +*}
    6.32 +
    6.33 +  
    6.34 +constdefs
    6.35 +
    6.36 +  wlconf :: "prog \<Rightarrow> st \<Rightarrow> ('a, val) table \<Rightarrow> ('a, ty) table \<Rightarrow> bool"
    6.37 +                                          ("_,_\<turnstile>_[\<sim>\<Colon>\<preceq>]_" [71,71,71,71] 70)
    6.38 +           "G,s\<turnstile>vs[\<sim>\<Colon>\<preceq>]Ts \<equiv> \<forall>n. \<forall>T\<in>Ts n: \<forall> v\<in>vs n: G,s\<turnstile>v\<Colon>\<preceq>T"
    6.39 +
    6.40 +lemma wlconfD: "\<lbrakk>G,s\<turnstile>vs[\<sim>\<Colon>\<preceq>]Ts; Ts n = Some T; vs n = Some v\<rbrakk> \<Longrightarrow> G,s\<turnstile>v\<Colon>\<preceq>T"
    6.41 +by (auto simp: wlconf_def)
    6.42 +
    6.43 +
    6.44 +lemma wlconf_cong [simp]: "\<And>s. G,set_locals x s\<turnstile>l[\<sim>\<Colon>\<preceq>]L = G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L"
    6.45 +by (auto simp: wlconf_def)
    6.46 +
    6.47 +lemma wlconf_lupd [simp]: "G,lupd(vn\<mapsto>v)s\<turnstile>l[\<sim>\<Colon>\<preceq>]L = G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L"
    6.48 +by (auto simp: wlconf_def)
    6.49 +
    6.50 +
    6.51 +lemma wlconf_upd: "\<lbrakk>G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L; G,s\<turnstile>v\<Colon>\<preceq>T; L vn = Some T\<rbrakk> \<Longrightarrow>  
    6.52 +  G,s\<turnstile>l(vn\<mapsto>v)[\<sim>\<Colon>\<preceq>]L"
    6.53 +by (auto simp: wlconf_def)
    6.54 +
    6.55 +lemma wlconf_ext: "\<lbrakk>G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L; G,s\<turnstile>v\<Colon>\<preceq>T\<rbrakk> \<Longrightarrow> G,s\<turnstile>l(vn\<mapsto>v)[\<sim>\<Colon>\<preceq>]L(vn\<mapsto>T)"
    6.56 +by (auto simp: wlconf_def)
    6.57 +
    6.58 +lemma wlconf_map_sum [simp]: 
    6.59 + "G,s\<turnstile>l1 (+) l2[\<sim>\<Colon>\<preceq>]L1 (+) L2 = (G,s\<turnstile>l1[\<sim>\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>l2[\<sim>\<Colon>\<preceq>]L2)"
    6.60 +apply (unfold wlconf_def)
    6.61 +apply safe
    6.62 +apply (case_tac [3] "n")
    6.63 +apply (force split add: sum.split)+
    6.64 +done
    6.65 +
    6.66 +lemma wlconf_ext_list [rule_format (no_asm)]: "
    6.67 + \<And>X. \<lbrakk>G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L\<rbrakk> \<Longrightarrow> 
    6.68 +      \<forall>vs Ts. distinct vns \<longrightarrow> length Ts = length vns 
    6.69 +      \<longrightarrow> list_all2 (conf G s) vs Ts \<longrightarrow> G,s\<turnstile>l(vns[\<mapsto>]vs)[\<sim>\<Colon>\<preceq>]L(vns[\<mapsto>]Ts)"
    6.70 +apply (unfold wlconf_def)
    6.71 +apply (induct_tac "vns")
    6.72 +apply  clarsimp
    6.73 +apply clarsimp
    6.74 +apply (frule list_all2_lengthD)
    6.75 +apply clarsimp
    6.76 +done
    6.77 +
    6.78 +
    6.79 +lemma wlconf_deallocL: "\<lbrakk>G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L(vn\<mapsto>T); L vn = None\<rbrakk> \<Longrightarrow> G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L"
    6.80 +apply (simp only: wlconf_def)
    6.81 +apply safe
    6.82 +apply (drule spec)
    6.83 +apply (drule ospec)
    6.84 +defer
    6.85 +apply (drule ospec )
    6.86 +apply auto
    6.87 +done 
    6.88 +
    6.89 +
    6.90 +lemma wlconf_gext [elim]: "\<lbrakk>G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L; s\<le>|s'\<rbrakk> \<Longrightarrow> G,s'\<turnstile>l[\<sim>\<Colon>\<preceq>]L"
    6.91 +apply (simp only: wlconf_def)
    6.92 +apply fast
    6.93 +done
    6.94 +
    6.95 +lemma wlconf_empty [simp, intro!]: "G,s\<turnstile>vs[\<sim>\<Colon>\<preceq>]empty"
    6.96 +apply (unfold wlconf_def)
    6.97 +apply force
    6.98 +done
    6.99 +
   6.100 +lemma wlconf_empty_vals: "G,s\<turnstile>empty[\<sim>\<Colon>\<preceq>]ts"
   6.101 +  by (simp add: wlconf_def)
   6.102 +
   6.103 +lemma wlconf_init_vals [intro!]: 
   6.104 +	" \<forall>n. \<forall>T\<in>fs n:is_type G T \<Longrightarrow> G,s\<turnstile>init_vals fs[\<sim>\<Colon>\<preceq>]fs"
   6.105 +apply (unfold wlconf_def)
   6.106 +apply force
   6.107 +done
   6.108 +
   6.109 +lemma lconf_wlconf:
   6.110 + "G,s\<turnstile>l[\<Colon>\<preceq>]L \<Longrightarrow> G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L"
   6.111 +by (force simp add: lconf_def wlconf_def)
   6.112  
   6.113  section "object conformance"
   6.114  
   6.115 @@ -259,18 +357,8 @@
   6.116                             (case r of 
   6.117  		              Heap a \<Rightarrow> is_type G (obj_ty obj) 
   6.118                              | Stat C \<Rightarrow> True)"
   6.119 -(*
   6.120 -lemma oconf_def2:  "G,s\<turnstile>\<lparr>tag=oi,values=fs\<rparr>\<Colon>\<preceq>\<surd>r =  
   6.121 -  (G,s\<turnstile>fs[\<Colon>\<preceq>]var_tys G oi r \<and> 
   6.122 -  (case r of Heap a \<Rightarrow> is_type G (obj_ty \<lparr>tag=oi,values=fs\<rparr>) | Stat C \<Rightarrow> True))"
   6.123 -by (simp add: oconf_def Let_def)
   6.124 -*)
   6.125 -(*
   6.126 -lemma oconf_def2:  "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r =  
   6.127 -  (G,s\<turnstile>values obj[\<Colon>\<preceq>]var_tys G (tag obj) r \<and> 
   6.128 -  (case r of Heap a \<Rightarrow> is_type G (obj_ty obj) | Stat C \<Rightarrow> True))"
   6.129 -by (simp add: oconf_def Let_def)
   6.130 -*)
   6.131 +
   6.132 +
   6.133  lemma oconf_is_type: "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>Heap a \<Longrightarrow> is_type G (obj_ty obj)"
   6.134  by (auto simp: oconf_def Let_def)
   6.135  
   6.136 @@ -297,33 +385,16 @@
   6.137             split add: sum.split_asm obj_tag.split_asm)
   6.138  done
   6.139  
   6.140 -(*
   6.141 -lemma oconf_init_obj_lemma: 
   6.142 -"\<lbrakk>\<And>C c. class G C = Some c \<Longrightarrow> unique (fields G C);  
   6.143 -  \<And>C c f fld. \<lbrakk>class G C = Some c; table_of (fields G C) f = Some fld \<rbrakk> 
   6.144 -            \<Longrightarrow> is_type G (type fld);  
   6.145 -  (case r of 
   6.146 -     Heap a \<Rightarrow> is_type G (obj_ty \<lparr>tag=oi,values=fs\<rparr>) 
   6.147 -  | Stat C \<Rightarrow> is_class G C)
   6.148 -\<rbrakk> \<Longrightarrow>  G,s\<turnstile>\<lparr>tag=oi, values=init_vals (var_tys G oi r)\<rparr>\<Colon>\<preceq>\<surd>r"
   6.149 -apply (auto simp add: oconf_def)
   6.150 -apply (drule_tac var_tys_Some_eq [THEN iffD1]) 
   6.151 -defer
   6.152 -apply (subst obj_ty_eq)
   6.153 -apply(auto dest!: fields_table_SomeD split add: sum.split_asm obj_tag.split_asm)
   6.154 -done
   6.155 -*)
   6.156 -
   6.157 -
   6.158  section "state conformance"
   6.159  
   6.160  constdefs
   6.161  
   6.162    conforms :: "state \<Rightarrow> env_ \<Rightarrow> bool"          (     "_\<Colon>\<preceq>_"   [71,71]      70)
   6.163     "xs\<Colon>\<preceq>E \<equiv> let (G, L) = E; s = snd xs; l = locals s in
   6.164 -      (\<forall>r. \<forall>obj\<in>globs s r:           G,s\<turnstile>obj   \<Colon>\<preceq>\<surd>r) \<and>
   6.165 -                  \<spacespace>                   G,s\<turnstile>l    [\<Colon>\<preceq>]L\<spacespace> \<and>
   6.166 -      (\<forall>a. fst xs=Some(Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable))"
   6.167 +    (\<forall>r. \<forall>obj\<in>globs s r:           G,s\<turnstile>obj   \<Colon>\<preceq>\<surd>r) \<and>
   6.168 +                \<spacespace>                   G,s\<turnstile>l    [\<sim>\<Colon>\<preceq>]L\<spacespace> \<and>
   6.169 +    (\<forall>a. fst xs=Some(Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)) \<and>
   6.170 +         (fst xs=Some(Jump Ret) \<longrightarrow> l Result \<noteq> None)"
   6.171  
   6.172  section "conforms"
   6.173  
   6.174 @@ -331,13 +402,17 @@
   6.175  "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); globs s r = Some obj\<rbrakk> \<Longrightarrow> G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r"
   6.176  by (auto simp: conforms_def Let_def)
   6.177  
   6.178 -lemma conforms_localD: "(x, s)\<Colon>\<preceq>(G, L) \<Longrightarrow> G,s\<turnstile>locals s[\<Colon>\<preceq>]L"
   6.179 +lemma conforms_localD: "(x, s)\<Colon>\<preceq>(G, L) \<Longrightarrow> G,s\<turnstile>locals s[\<sim>\<Colon>\<preceq>]L"
   6.180  by (auto simp: conforms_def Let_def)
   6.181  
   6.182  lemma conforms_XcptLocD: "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); x = Some (Xcpt (Loc a))\<rbrakk> \<Longrightarrow>  
   6.183  	  G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)"
   6.184  by (auto simp: conforms_def Let_def)
   6.185  
   6.186 +lemma conforms_RetD: "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); x = Some (Jump Ret)\<rbrakk> \<Longrightarrow>  
   6.187 +	  (locals s) Result \<noteq> None"
   6.188 +by (auto simp: conforms_def Let_def)
   6.189 +
   6.190  lemma conforms_RefTD: 
   6.191   "\<lbrakk>G,s\<turnstile>a'\<Colon>\<preceq>RefT t; a' \<noteq> Null; (x,s) \<Colon>\<preceq>(G, L)\<rbrakk> \<Longrightarrow>  
   6.192     \<exists>a obj. a' = Addr a \<and> globs s (Inl a) = Some obj \<and>  
   6.193 @@ -349,8 +424,9 @@
   6.194  done
   6.195  
   6.196  lemma conforms_Jump [iff]:
   6.197 -  "((Some (Jump j), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
   6.198 -by (auto simp: conforms_def)
   6.199 +  "j=Ret \<longrightarrow> locals s Result \<noteq> None 
   6.200 +   \<Longrightarrow> ((Some (Jump j), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
   6.201 +by (auto simp: conforms_def Let_def)
   6.202  
   6.203  lemma conforms_StdXcpt [iff]: 
   6.204    "((Some (Xcpt (Std xn)), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
   6.205 @@ -382,45 +458,61 @@
   6.206  done
   6.207  
   6.208  lemma conformsI: "\<lbrakk>\<forall>r. \<forall>obj\<in>globs s r: G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r;  
   6.209 -     G,s\<turnstile>locals s[\<Colon>\<preceq>]L;  
   6.210 -     \<forall>a. x = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)\<rbrakk> \<Longrightarrow> 
   6.211 +     G,s\<turnstile>locals s[\<sim>\<Colon>\<preceq>]L;  
   6.212 +     \<forall>a. x = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable);
   6.213 +     x = Some (Jump Ret)\<longrightarrow> locals s Result \<noteq> None\<rbrakk> \<Longrightarrow> 
   6.214    (x, s)\<Colon>\<preceq>(G, L)"
   6.215  by (auto simp: conforms_def Let_def)
   6.216  
   6.217  lemma conforms_xconf: "\<lbrakk>(x, s)\<Colon>\<preceq>(G,L);   
   6.218 - \<forall>a. x' = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)\<rbrakk> \<Longrightarrow> 
   6.219 + \<forall>a. x' = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable);
   6.220 +     x' = Some (Jump Ret) \<longrightarrow> locals s Result \<noteq> None\<rbrakk> \<Longrightarrow> 
   6.221   (x',s)\<Colon>\<preceq>(G,L)"
   6.222  by (fast intro: conformsI elim: conforms_globsD conforms_localD)
   6.223  
   6.224  lemma conforms_lupd: 
   6.225   "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); L vn = Some T; G,s\<turnstile>v\<Colon>\<preceq>T\<rbrakk> \<Longrightarrow> (x, lupd(vn\<mapsto>v)s)\<Colon>\<preceq>(G, L)"
   6.226 -by (force intro: conformsI lconf_upd dest: conforms_globsD conforms_localD 
   6.227 -                                           conforms_XcptLocD simp: oconf_def)
   6.228 +by (force intro: conformsI wlconf_upd dest: conforms_globsD conforms_localD 
   6.229 +                                           conforms_XcptLocD conforms_RetD 
   6.230 +          simp: oconf_def)
   6.231  
   6.232  
   6.233 -lemmas conforms_allocL_aux = conforms_localD [THEN lconf_ext]
   6.234 +lemmas conforms_allocL_aux = conforms_localD [THEN wlconf_ext]
   6.235  
   6.236  lemma conforms_allocL: 
   6.237    "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); G,s\<turnstile>v\<Colon>\<preceq>T\<rbrakk> \<Longrightarrow> (x, lupd(vn\<mapsto>v)s)\<Colon>\<preceq>(G, L(vn\<mapsto>T))"
   6.238 -by (force intro: conformsI dest: conforms_globsD 
   6.239 -          elim: conforms_XcptLocD conforms_allocL_aux simp: oconf_def)
   6.240 +by (force intro: conformsI dest: conforms_globsD conforms_RetD 
   6.241 +          elim: conforms_XcptLocD  conforms_allocL_aux 
   6.242 +          simp: oconf_def)
   6.243  
   6.244 -lemmas conforms_deallocL_aux = conforms_localD [THEN lconf_deallocL]
   6.245 +lemmas conforms_deallocL_aux = conforms_localD [THEN wlconf_deallocL]
   6.246  
   6.247  lemma conforms_deallocL: "\<And>s.\<lbrakk>s\<Colon>\<preceq>(G, L(vn\<mapsto>T)); L vn = None\<rbrakk> \<Longrightarrow> s\<Colon>\<preceq>(G,L)"
   6.248 -by (fast intro: conformsI dest: conforms_globsD 
   6.249 +by (fast intro: conformsI dest: conforms_globsD conforms_RetD
   6.250           elim: conforms_XcptLocD conforms_deallocL_aux)
   6.251  
   6.252  lemma conforms_gext: "\<lbrakk>(x, s)\<Colon>\<preceq>(G,L); s\<le>|s';  
   6.253    \<forall>r. \<forall>obj\<in>globs s' r: G,s'\<turnstile>obj\<Colon>\<preceq>\<surd>r;  
   6.254     locals s'=locals s\<rbrakk> \<Longrightarrow> (x,s')\<Colon>\<preceq>(G,L)"
   6.255 -by (force intro!: conformsI dest: conforms_localD conforms_XcptLocD)
   6.256 +apply (rule conformsI)
   6.257 +apply     assumption
   6.258 +apply    (drule conforms_localD) apply force
   6.259 +apply   (intro strip)
   6.260 +apply  (drule (1) conforms_XcptLocD) apply force 
   6.261 +apply (intro strip)
   6.262 +apply (drule (1) conforms_RetD) apply force
   6.263 +done
   6.264 +
   6.265  
   6.266  
   6.267  lemma conforms_xgext: 
   6.268 -  "\<lbrakk>(x ,s)\<Colon>\<preceq>(G,L); (x', s')\<Colon>\<preceq>(G, L); s'\<le>|s\<rbrakk> \<Longrightarrow> (x',s)\<Colon>\<preceq>(G,L)"
   6.269 +  "\<lbrakk>(x ,s)\<Colon>\<preceq>(G,L); (x', s')\<Colon>\<preceq>(G, L); s'\<le>|s;dom (locals s') \<subseteq> dom (locals s)\<rbrakk> 
   6.270 +   \<Longrightarrow> (x',s)\<Colon>\<preceq>(G,L)"
   6.271  apply (erule_tac conforms_xconf)
   6.272 -apply (fast dest: conforms_XcptLocD)
   6.273 +apply  (fast dest: conforms_XcptLocD)
   6.274 +apply (intro strip)
   6.275 +apply (drule (1) conforms_RetD) 
   6.276 +apply (auto dest: domI)
   6.277  done
   6.278  
   6.279  lemma conforms_gupd: "\<And>obj. \<lbrakk>(x, s)\<Colon>\<preceq>(G, L); G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r; s\<le>|gupd(r\<mapsto>obj)s\<rbrakk> 
   6.280 @@ -445,17 +537,29 @@
   6.281  done
   6.282  
   6.283  lemma conforms_set_locals: 
   6.284 -  "\<lbrakk>(x,s)\<Colon>\<preceq>(G, L'); G,s\<turnstile>l[\<Colon>\<preceq>]L\<rbrakk> \<Longrightarrow> (x,set_locals l s)\<Colon>\<preceq>(G,L)"
   6.285 -apply (auto intro!: conformsI dest: conforms_globsD 
   6.286 -            elim!: conforms_XcptLocD simp add: oconf_def)
   6.287 +  "\<lbrakk>(x,s)\<Colon>\<preceq>(G, L'); G,s\<turnstile>l[\<sim>\<Colon>\<preceq>]L; x=Some (Jump Ret) \<longrightarrow> l Result \<noteq> None\<rbrakk> 
   6.288 +   \<Longrightarrow> (x,set_locals l s)\<Colon>\<preceq>(G,L)"
   6.289 +apply (rule conformsI)
   6.290 +apply     (intro strip)
   6.291 +apply     simp
   6.292 +apply     (drule (2) conforms_globsD)
   6.293 +apply    simp
   6.294 +apply   (intro strip)
   6.295 +apply   (drule (1) conforms_XcptLocD)
   6.296 +apply   simp
   6.297 +apply (intro strip)
   6.298 +apply (drule (1) conforms_RetD)
   6.299 +apply simp
   6.300  done
   6.301  
   6.302 -lemma conforms_locals [rule_format]: 
   6.303 -  "(a,b)\<Colon>\<preceq>(G, L) \<longrightarrow> L x = Some T \<longrightarrow> G,b\<turnstile>the (locals b x)\<Colon>\<preceq>T"
   6.304 -apply (force simp: conforms_def Let_def lconf_def)
   6.305 +lemma conforms_locals: 
   6.306 +  "\<lbrakk>(a,b)\<Colon>\<preceq>(G, L); L x = Some T;locals b x \<noteq>None\<rbrakk>
   6.307 +   \<Longrightarrow> G,b\<turnstile>the (locals b x)\<Colon>\<preceq>T"
   6.308 +apply (force simp: conforms_def Let_def wlconf_def)
   6.309  done
   6.310  
   6.311 -lemma conforms_return: "\<And>s'. \<lbrakk>(x,s)\<Colon>\<preceq>(G, L); (x',s')\<Colon>\<preceq>(G, L'); s\<le>|s'\<rbrakk> \<Longrightarrow>  
   6.312 +lemma conforms_return: 
   6.313 +"\<And>s'. \<lbrakk>(x,s)\<Colon>\<preceq>(G, L); (x',s')\<Colon>\<preceq>(G, L'); s\<le>|s';x'\<noteq>Some (Jump Ret)\<rbrakk> \<Longrightarrow>  
   6.314    (x',set_locals (locals s) s')\<Colon>\<preceq>(G, L)"
   6.315  apply (rule conforms_xconf)
   6.316  prefer 2 apply (force dest: conforms_XcptLocD)
     7.1 --- a/src/HOL/Bali/Decl.thy	Wed Oct 30 12:44:18 2002 +0100
     7.2 +++ b/src/HOL/Bali/Decl.thy	Thu Oct 31 18:27:10 2002 +0100
     7.3 @@ -291,13 +291,13 @@
     7.4  subsection {* Interface *}
     7.5  
     7.6  
     7.7 -record  ibody = decl +  (* interface body *)
     7.8 -          imethods :: "(sig \<times> mhead) list" (* method heads *)
     7.9 +record  ibody = decl +  --{* interface body *}
    7.10 +          imethods :: "(sig \<times> mhead) list" --{* method heads *}
    7.11  
    7.12 -record  iface = ibody + (* interface *)
    7.13 -         isuperIfs:: "qtname list" (* superinterface list *)
    7.14 +record  iface = ibody + --{* interface *}
    7.15 +         isuperIfs:: "qtname list" --{* superinterface list *}
    7.16  types	
    7.17 -	idecl           (* interface declaration, cf. 9.1 *)
    7.18 +	idecl           --{* interface declaration, cf. 9.1 *}
    7.19  	= "qtname \<times> iface"
    7.20  
    7.21  translations
    7.22 @@ -320,16 +320,16 @@
    7.23  by (simp add: ibody_def)
    7.24  
    7.25  subsection  {* Class *}
    7.26 -record cbody = decl +          (* class body *)
    7.27 +record cbody = decl +          --{* class body *}
    7.28           cfields:: "fdecl list" 
    7.29           methods:: "mdecl list"
    7.30 -         init   :: "stmt"       (* initializer *)
    7.31 +         init   :: "stmt"       --{* initializer *}
    7.32  
    7.33 -record class = cbody +           (* class *)
    7.34 -        super   :: "qtname"      (* superclass *)
    7.35 -        superIfs:: "qtname list" (* implemented interfaces *)
    7.36 +record class = cbody +           --{* class *}
    7.37 +        super   :: "qtname"      --{* superclass *}
    7.38 +        superIfs:: "qtname list" --{* implemented interfaces *}
    7.39  types	
    7.40 -	cdecl           (* class declaration, cf. 8.1 *)
    7.41 +	cdecl           --{* class declaration, cf. 8.1 *}
    7.42  	= "qtname \<times> class"
    7.43  
    7.44  translations
    7.45 @@ -366,10 +366,10 @@
    7.46  
    7.47  consts
    7.48  
    7.49 -  Object_mdecls  ::  "mdecl list" (* methods of Object *)
    7.50 -  SXcpt_mdecls   ::  "mdecl list" (* methods of SXcpts *)
    7.51 -  ObjectC ::         "cdecl"      (* declaration  of root      class   *)
    7.52 -  SXcptC  ::"xname \<Rightarrow> cdecl"      (* declarations of throwable classes *)
    7.53 +  Object_mdecls  ::  "mdecl list" --{* methods of Object *}
    7.54 +  SXcpt_mdecls   ::  "mdecl list" --{* methods of SXcpts *}
    7.55 +  ObjectC ::         "cdecl"      --{* declaration  of root      class   *}
    7.56 +  SXcptC  ::"xname \<Rightarrow> cdecl"      --{* declarations of throwable classes *}
    7.57  
    7.58  defs 
    7.59  
    7.60 @@ -442,8 +442,8 @@
    7.61  section "subinterface and subclass relation, in anticipation of TypeRel.thy"
    7.62  
    7.63  consts 
    7.64 -  subint1  :: "prog \<Rightarrow> (qtname \<times> qtname) set"
    7.65 -  subcls1  :: "prog \<Rightarrow> (qtname \<times> qtname) set"
    7.66 +  subint1  :: "prog \<Rightarrow> (qtname \<times> qtname) set" --{* direct subinterface *}
    7.67 +  subcls1  :: "prog \<Rightarrow> (qtname \<times> qtname) set" --{* direct subclass     *}
    7.68  
    7.69  defs
    7.70    subint1_def: "subint1 G \<equiv> {(I,J). \<exists>i\<in>iface G I: J\<in>set (isuperIfs i)}"
    7.71 @@ -795,65 +795,10 @@
    7.72  apply (rule class_rec.simps [THEN trans [THEN fun_cong [THEN fun_cong]]])
    7.73  apply simp
    7.74  done
    7.75 -(*
    7.76 -lemma bar:
    7.77 - "[| P;  !!x.  P ==> Q x  |] ==> Q x"
    7.78 -by simp
    7.79 -
    7.80 -lemma metaMP: "[| A ==> B; A |] ==> B"
    7.81 -by blast
    7.82 -
    7.83 -lemma True
    7.84 -proof- 
    7.85 -  presume t: "C  ==> E"
    7.86 -  thm metaMP [OF t]
    7.87 -
    7.88 -  presume r1: "\<And> B. P \<Longrightarrow> B"
    7.89 -  presume r2: "\<And> C. C \<Longrightarrow> P"
    7.90 -  thm r1 [OF r2]
    7.91 -
    7.92 -  thm metaMP [OF t]
    7.93 -
    7.94 -lemma ws_subcls1_induct4: "\<lbrakk>is_class G C; ws_prog G;  
    7.95 -  \<And>C c. \<lbrakk>C \<noteq> Object\<longrightarrow> P (super c)\<rbrakk> \<Longrightarrow> P C
    7.96 - \<rbrakk> \<Longrightarrow> P C"
    7.97 -proof -
    7.98 -  assume cls_C: "is_class G C"
    7.99 -  and       ws: "ws_prog G"
   7.100 -  and      hyp: "\<And>C c. \<lbrakk>C \<noteq> Object\<longrightarrow> P (super c)\<rbrakk> \<Longrightarrow> P C"
   7.101 -  thm ws_subcls1_induct [OF cls_C ws hyp]
   7.102 -
   7.103 -show
   7.104 -(\<And>C c. class G C = Some c \<and>
   7.105 -       (C \<noteq> Object \<longrightarrow> G\<turnstile>C\<prec>\<^sub>C\<^sub>1super c \<and> ?P (super c) \<and> is_class G (super c)) \<Longrightarrow>
   7.106 -       ?P C) \<Longrightarrow>
   7.107 -?P C
   7.108 -  show ?thesis
   7.109 -    thm "thm ws_subcls1_induct [OF cls_C ws hyp]"
   7.110 -    apply (rule ws_subcls1_induct)
   7.111 -  proof (rule ws_subcls1_induct)
   7.112 -    fix C c
   7.113 -    assume "class G C = Some c \<and>
   7.114 -            (C \<noteq> Object \<longrightarrow>
   7.115 -              G\<turnstile>C\<prec>\<^sub>C\<^sub>1super c \<and> P (super c) \<and> is_class G (super c))"
   7.116 -    show "C \<noteq> Object \<longrightarrow> P (super  (?c C c))" 
   7.117 -apply (erule ws_subcls1_induct)
   7.118 -apply assumption
   7.119 -apply (erule conjE)
   7.120 -apply (case_tac "C=Object")
   7.121 -apply blast
   7.122 -apply (erule impE)
   7.123 -apply assumption
   7.124 -apply (erule conjE)+
   7.125 -apply (rotate_tac 2)
   7.126 -sorry
   7.127 -
   7.128 -*)
   7.129 -
   7.130  
   7.131  constdefs
   7.132  imethds:: "prog \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> mhead) tables"
   7.133 -  (* methods of an interface, with overriding and inheritance, cf. 9.2 *)
   7.134 +  --{* methods of an interface, with overriding and inheritance, cf. 9.2 *}
   7.135  "imethds G I 
   7.136    \<equiv> iface_rec (G,I)  
   7.137                (\<lambda>I i ts. (Un_tables ts) \<oplus>\<oplus> 
     8.1 --- a/src/HOL/Bali/DeclConcepts.thy	Wed Oct 30 12:44:18 2002 +0100
     8.2 +++ b/src/HOL/Bali/DeclConcepts.thy	Thu Oct 31 18:27:10 2002 +0100
     8.3 @@ -153,10 +153,6 @@
     8.4  axclass has_static < "type"
     8.5  consts is_static :: "'a::has_static \<Rightarrow> bool"
     8.6  
     8.7 -(*
     8.8 -consts is_static :: "'a \<Rightarrow> bool"
     8.9 -*)
    8.10 -
    8.11  instance access_field_type :: ("type","has_static") has_static ..
    8.12  
    8.13  defs (overloaded)
    8.14 @@ -205,48 +201,31 @@
    8.15  lemma mhead_static_simp [simp]: "is_static (mhead m) = is_static m"
    8.16  by (cases m) (simp add: mhead_def member_is_static_simp)
    8.17  
    8.18 -constdefs  (* some mnemotic selectors for (qtname \<times> ('a::more) decl_scheme) 
    8.19 -            * the first component is a class or interface name
    8.20 -            * the second component is a method, field or method head *)
    8.21 -(* "declclass":: "(qtname \<times> ('a::more) decl_scheme) \<Rightarrow> qtname"*)
    8.22 -(* "declclass \<equiv> fst" *)          (* get the class component *)
    8.23 -
    8.24 +constdefs  --{* some mnemotic selectors for various pairs *} 
    8.25 +           
    8.26   "decliface":: "(qtname \<times> ('a::type) decl_scheme) \<Rightarrow> qtname"
    8.27 - "decliface \<equiv> fst"          (* get the interface component *)
    8.28 + "decliface \<equiv> fst"          --{* get the interface component *}
    8.29  
    8.30 -(*
    8.31 - "member"::   "(qtname \<times> ('a::type) decl_scheme) \<Rightarrow> ('a::type) decl_scheme"
    8.32 -*)
    8.33   "mbr"::   "(qtname \<times> memberdecl) \<Rightarrow> memberdecl"
    8.34 - "mbr \<equiv> snd"            (* get the memberdecl component *)
    8.35 + "mbr \<equiv> snd"            --{* get the memberdecl component *}
    8.36  
    8.37   "mthd"::   "('b \<times> 'a) \<Rightarrow> 'a"
    8.38 -                           (* also used for mdecl,mhead *)
    8.39 - "mthd \<equiv> snd"              (* get the method component *)
    8.40 +                           --{* also used for mdecl, mhead *}
    8.41 + "mthd \<equiv> snd"              --{* get the method component *}
    8.42  
    8.43   "fld"::   "('b \<times> ('a::type) decl_scheme) \<Rightarrow> ('a::type) decl_scheme"
    8.44 -              (* also used for ((vname \<times> qtname)\<times> field) *)
    8.45 - "fld \<equiv> snd"               (* get the field component *)
    8.46 +              --{* also used for @{text "((vname \<times> qtname)\<times> field)"} *}
    8.47 + "fld \<equiv> snd"               --{* get the field component *}
    8.48  
    8.49 -(* "accmodi" :: "('b \<times> ('a::type) decl_scheme) \<Rightarrow> acc_modi"*)
    8.50 -                           (* also used for mdecl *)
    8.51 -(* "accmodi \<equiv> access \<circ> snd"*)  (* get the access modifier *) 
    8.52 -(*
    8.53 - "is_static" ::"('b \<times> ('a::type) member_scheme) \<Rightarrow> bool" *)
    8.54 -                            (* also defined for emhead cf. WellType *)
    8.55 - (*"is_static \<equiv> static \<circ> snd"*) (* get the static modifier *)
    8.56  
    8.57 -constdefs (* some mnemotic selectors for (vname \<times> qtname) *)
    8.58 - fname:: "(vname \<times> 'a) \<Rightarrow> vname" (* also used for fdecl *)
    8.59 +constdefs --{* some mnemotic selectors for @{text "(vname \<times> qtname)"} *}
    8.60 + fname:: "(vname \<times> 'a) \<Rightarrow> vname" --{* also used for fdecl *}
    8.61   "fname \<equiv> fst"
    8.62    
    8.63    declclassf:: "(vname \<times> qtname) \<Rightarrow> qtname"
    8.64   "declclassf \<equiv> snd"
    8.65  
    8.66 -(*
    8.67 -lemma declclass_simp[simp]: "declclass (C,m) = C"
    8.68 -by (simp add: declclass_def)
    8.69 -*)
    8.70 +
    8.71  
    8.72  lemma decliface_simp[simp]: "decliface (I,m) = I"
    8.73  by (simp add: decliface_def) 
    8.74 @@ -272,11 +251,6 @@
    8.75  lemma access_fld_simp [simp]: "(access (fld f)) = accmodi f"
    8.76  by (cases f) (simp add:  fld_def) 
    8.77  
    8.78 -(*
    8.79 -lemma is_static_simp[simp]: "is_static (C,m) = static m"
    8.80 -by (simp add: is_static_def)
    8.81 -*)
    8.82 -
    8.83  lemma static_mthd_simp[simp]: "static (mthd m) = is_static m"
    8.84  by (cases m) (simp add:  mthd_def member_is_static_simp)
    8.85  
    8.86 @@ -301,7 +275,7 @@
    8.87  lemma declclassf_simp[simp]:"declclassf (n,c) = c"
    8.88  by (simp add: declclassf_def)
    8.89  
    8.90 -constdefs  (* some mnemotic selectors for (vname \<times> qtname) *)
    8.91 +constdefs  --{* some mnemotic selectors for @{text "(vname \<times> qtname)"} *}
    8.92    "fldname"  :: "(vname \<times> qtname) \<Rightarrow> vname" 
    8.93    "fldname \<equiv> fst"
    8.94  
    8.95 @@ -1265,6 +1239,7 @@
    8.96    qed
    8.97  qed
    8.98  *)
    8.99 +
   8.100  lemma accessible_fieldD: 
   8.101   "\<lbrakk>G\<turnstile>membr of C accessible_from accC; is_field membr\<rbrakk>
   8.102   \<Longrightarrow> G\<turnstile>membr member_of C \<and>
   8.103 @@ -1272,34 +1247,7 @@
   8.104       G\<turnstile>membr in C permits_acc_to accC"
   8.105  by (induct rule: accessible_fromR.induct) (auto dest: is_fieldD)
   8.106        
   8.107 -(* lemmata:
   8.108 - Wegen  G\<turnstile>Super accessible_in (pid C) folgt:
   8.109 -  G\<turnstile>m declared_in C; G\<turnstile>m member_of D; accmodi m = Package (G\<turnstile>D \<preceq>\<^sub>C C)
   8.110 -  \<Longrightarrow> pid C = pid D 
   8.111  
   8.112 -  C package
   8.113 -  m public in C
   8.114 -  für alle anderen D: G\<turnstile>m undeclared_in C
   8.115 -  m wird in alle subklassen vererbt, auch aus dem Package heraus!
   8.116 -
   8.117 -  G\<turnstile>m member_of C \<Longrightarrow> \<exists> D. G\<turnstile>C \<preceq>\<^sub>C D \<and> G\<turnstile>m declared_in D
   8.118 -*)
   8.119 -
   8.120 -(* Begriff (C,m) overrides (D,m)
   8.121 -    3 Fälle: Direkt,
   8.122 -             Indirekt über eine Zwischenklasse (ohne weiteres override)
   8.123 -             Indirekt über override
   8.124 -*)
   8.125 -   
   8.126 -(*
   8.127 -"G\<turnstile>m member_of C \<equiv> 
   8.128 -constdefs declares_method:: "prog \<Rightarrow> sig \<Rightarrow> qtname \<Rightarrow> methd \<Rightarrow> bool"
   8.129 -                                 ("_,_\<turnstile> _ declares'_method _" [61,61,61,61] 60)
   8.130 -"G,sig\<turnstile>C declares_method m \<equiv> cdeclaredmethd G C sig = Some m" 
   8.131 -
   8.132 -constdefs is_declared:: "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> bool"
   8.133 -"is_declared G sig em \<equiv> G,sig\<turnstile>declclass em declares_method mthd em"
   8.134 -*)
   8.135  
   8.136  lemma member_of_Private:
   8.137  "\<lbrakk>G\<turnstile>m member_of C; accmodi m = Private\<rbrakk> \<Longrightarrow> declclass m = C"
   8.138 @@ -1541,23 +1489,7 @@
   8.139                        ) sig
   8.140                )
   8.141          else None)"
   8.142 -(*
   8.143 -"dynmethd G statC dynC  
   8.144 -  \<equiv> \<lambda> sig. 
   8.145 -     (if G\<turnstile>dynC \<preceq>\<^sub>C statC
   8.146 -        then (case methd G statC sig of
   8.147 -                None \<Rightarrow> None
   8.148 -              | Some statM 
   8.149 -                    \<Rightarrow> (class_rec (G,statC) empty
   8.150 -                         (\<lambda>C c subcls_mthds. 
   8.151 -                            subcls_mthds
   8.152 -                            ++
   8.153 -                            (filter_tab 
   8.154 -                              (\<lambda> _ dynM. G,sig\<turnstile>dynM overrides statM)  
   8.155 -                              (table_of (map (\<lambda>(s,m). (s,C,m)) (methods c)))))
   8.156 -                        ) sig
   8.157 -              )
   8.158 -        else None)"*)
   8.159 +
   8.160  text {* @{term "dynmethd G statC dynC"}: dynamic method lookup of a reference 
   8.161          with dynamic class @{term dynC} and static class @{term statC} *}
   8.162  text {* Note some kind of duality between @{term methd} and @{term dynmethd} 
   8.163 @@ -2014,8 +1946,6 @@
   8.164  lemma dynmethdSomeD: 
   8.165   "\<lbrakk>dynmethd G statC dynC sig = Some dynM; is_class G dynC; ws_prog G\<rbrakk> 
   8.166    \<Longrightarrow> G\<turnstile>dynC \<preceq>\<^sub>C statC \<and> (\<exists> statM. methd G statC sig = Some statM)"
   8.167 -apply clarify
   8.168 -apply rotate_tac
   8.169  by (auto simp add: dynmethd_rec)
   8.170   
   8.171  lemma dynmethd_Some_cases [consumes 3, case_names Static Overrides]:
   8.172 @@ -2243,31 +2173,6 @@
   8.173    qed
   8.174  qed
   8.175  
   8.176 -(*
   8.177 -lemma dom_dynmethd: 
   8.178 -  "dom (dynmethd G statC dynC) \<subseteq> dom (methd G statC) \<union> dom (methd G dynC)"
   8.179 -by (auto simp add: dynmethd_def dom_def)
   8.180 -
   8.181 -lemma finite_dom_dynmethd:
   8.182 - "\<lbrakk>ws_prog G; is_class G statC; is_class G dynC\<rbrakk> 
   8.183 -  \<Longrightarrow> finite (dom (dynmethd G statC dynC))"
   8.184 -apply (rule_tac B="dom (methd G statC) \<union> dom (methd G dynC)" in finite_subset)
   8.185 -apply (rule dom_dynmethd)
   8.186 -apply (rule finite_UnI)
   8.187 -apply (drule (2) finite_dom_methd)+
   8.188 -done
   8.189 -*)
   8.190 -(*
   8.191 -lemma dynmethd_SomeD: 
   8.192 -"\<lbrakk>ws_prog G; is_class G statC; is_class G dynC;
   8.193 - methd G statC sig = Some sm; dynmethd G statC dynC sig = Some dm; sm \<noteq> dm
   8.194 - \<rbrakk> \<Longrightarrow> G\<turnstile>dynC \<prec>\<^sub>C statC \<and> 
   8.195 -       (declclass dm \<noteq> dynC \<longrightarrow> G \<turnstile> dm accessible_through_inheritance_in dynC)"
   8.196 -by (auto simp add: dynmethd_def 
   8.197 -         dest: methd_inheritedD methd_diff_cls
   8.198 -         intro: rtrancl_into_trancl3)
   8.199 -*)
   8.200 -
   8.201  subsection "dynlookup"
   8.202  
   8.203  lemma dynlookup_cases [consumes 1, case_names NullT IfaceT ClassT ArrayT]:
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/Bali/DefiniteAssignment.thy	Thu Oct 31 18:27:10 2002 +0100
     9.3 @@ -0,0 +1,1853 @@
     9.4 +header {* Definite Assignment *}
     9.5 +
     9.6 +theory DefiniteAssignment = WellType: 
     9.7 +
     9.8 +text {* Definite Assignment Analysis (cf. 16)
     9.9 +
    9.10 +The definite assignment analysis approximates the sets of local 
    9.11 +variables that will be assigned at a certain point of evaluation, and ensures
    9.12 +that we will only read variables which previously were assigned.
    9.13 +It should conform to the following idea:
    9.14 + If the evaluation of a term completes normally (no abruption (exception, 
    9.15 +break, continue, return) appeared) , the set of local variables calculated 
    9.16 +by the analysis is a subset of the
    9.17 +variables that were actually assigned during evaluation.
    9.18 +
    9.19 +To get more precise information about the sets of assigned variables the 
    9.20 +analysis includes the following optimisations:
    9.21 +\begin{itemize}
    9.22 +  \item Inside of a while loop we also take care of the variables assigned
    9.23 +        before break statements, since the break causes the while loop to
    9.24 +        continue normally.
    9.25 +  \item For conditional statements we take care of constant conditions to 
    9.26 +        statically determine the path of evaluation.
    9.27 +  \item Inside a distinct path of a conditional statements we know to which
    9.28 +        boolean value the condition has evaluated to, and so can retrieve more
    9.29 +        information about the variables assigned during evaluation of the
    9.30 +        boolean condition.
    9.31 +\end{itemize}
    9.32 +
    9.33 +Since in our model of Java the return values of methods are stored in a local
    9.34 +variable we also ensure that every path of (normal) evaluation will assign the
    9.35 +result variable, or in the sense of real Java every path ends up in and 
    9.36 +return instruction. 
    9.37 +
    9.38 +Not covered yet:
    9.39 +\begin{itemize} 
    9.40 +  \item analysis of definite unassigned
    9.41 +  \item special treatment of final fields
    9.42 +\end{itemize}
    9.43 +*}
    9.44 +
    9.45 +section {* Correct nesting of jump statements *}
    9.46 +
    9.47 +text {* For definite assignment it becomes crucial, that jumps (break, 
    9.48 +continue, return) are nested correctly i.e. a continue jump is nested in a
    9.49 +matching while statement, a break jump is nested in a proper label statement,
    9.50 +a class initialiser does not terminate abruptly with a return. With this we 
    9.51 +can for example ensure that evaluation of an expression will never end up 
    9.52 +with a jump, since no breaks, continues or returns are allowed in an 
    9.53 +expression. *}
    9.54 +
    9.55 +consts jumpNestingOkS :: "jump set \<Rightarrow> stmt \<Rightarrow> bool"
    9.56 +primrec
    9.57 +"jumpNestingOkS jmps (Skip)   = True"
    9.58 +"jumpNestingOkS jmps (Expr e) = True"
    9.59 +"jumpNestingOkS jmps (j\<bullet> s) = jumpNestingOkS ({j} \<union> jmps) s"
    9.60 +"jumpNestingOkS jmps (c1;;c2) = (jumpNestingOkS jmps c1 \<and> 
    9.61 +                                 jumpNestingOkS jmps c2)"
    9.62 +"jumpNestingOkS jmps (If(e) c1 Else c2) = (jumpNestingOkS jmps c1 \<and>  
    9.63 +                                           jumpNestingOkS jmps c2)"
    9.64 +"jumpNestingOkS jmps (l\<bullet> While(e) c) = jumpNestingOkS ({Cont l} \<union> jmps) c"
    9.65 +--{* The label of the while loop only handles continue jumps. Breaks are only
    9.66 +     handled by @{term Lab} *}
    9.67 +"jumpNestingOkS jmps (Jmp j) = (j \<in> jmps)"
    9.68 +"jumpNestingOkS jmps (Throw e) = True"
    9.69 +"jumpNestingOkS jmps (Try c1 Catch(C vn) c2) = (jumpNestingOkS jmps c1 \<and> 
    9.70 +                                                jumpNestingOkS jmps c2)"
    9.71 +"jumpNestingOkS jmps (c1 Finally c2) = (jumpNestingOkS jmps c1 \<and> 
    9.72 +                                        jumpNestingOkS jmps c2)"
    9.73 +"jumpNestingOkS jmps (Init C) = True" 
    9.74 + --{* wellformedness of the program must enshure that for all initializers 
    9.75 +      jumpNestingOkS {} holds *} 
    9.76 +--{* Dummy analysis for intermediate smallstep term @{term  FinA} *}
    9.77 +"jumpNestingOkS jmps (FinA a c) = False"
    9.78 +
    9.79 +
    9.80 +constdefs jumpNestingOk :: "jump set \<Rightarrow> term \<Rightarrow> bool"
    9.81 +"jumpNestingOk jmps t \<equiv> (case t of
    9.82 +                      In1 se \<Rightarrow> (case se of
    9.83 +                                   Inl e \<Rightarrow> True
    9.84 +                                 | Inr s \<Rightarrow> jumpNestingOkS jmps s)
    9.85 +                    | In2  v \<Rightarrow> True
    9.86 +                    | In3  es \<Rightarrow> True)"
    9.87 +
    9.88 +lemma jumpNestingOk_expr_simp [simp]: "jumpNestingOk jmps (In1l e) = True"
    9.89 +by (simp add: jumpNestingOk_def)
    9.90 +
    9.91 +lemma jumpNestingOk_expr_simp1 [simp]: "jumpNestingOk jmps \<langle>e::expr\<rangle> = True"
    9.92 +by (simp add: inj_term_simps)
    9.93 +
    9.94 +lemma jumpNestingOk_stmt_simp [simp]: 
    9.95 +  "jumpNestingOk jmps (In1r s) = jumpNestingOkS jmps s"
    9.96 +by (simp add: jumpNestingOk_def)
    9.97 +
    9.98 +lemma jumpNestingOk_stmt_simp1 [simp]: 
    9.99 +   "jumpNestingOk jmps \<langle>s::stmt\<rangle> = jumpNestingOkS jmps s"
   9.100 +by (simp add: inj_term_simps)
   9.101 +
   9.102 +lemma jumpNestingOk_var_simp [simp]: "jumpNestingOk jmps (In2 v) = True"
   9.103 +by (simp add: jumpNestingOk_def)
   9.104 +
   9.105 +lemma jumpNestingOk_var_simp1 [simp]: "jumpNestingOk jmps \<langle>v::var\<rangle> = True"
   9.106 +by (simp add: inj_term_simps)
   9.107 +
   9.108 +lemma jumpNestingOk_expr_list_simp [simp]: "jumpNestingOk jmps (In3 es) = True"
   9.109 +by (simp add: jumpNestingOk_def)
   9.110 +
   9.111 +lemma jumpNestingOk_expr_list_simp1 [simp]: 
   9.112 +  "jumpNestingOk jmps \<langle>es::expr list\<rangle> = True"
   9.113 +by (simp add: inj_term_simps)
   9.114 +
   9.115 +
   9.116 +
   9.117 +section {* Calculation of assigned variables for boolean expressions*}
   9.118 +
   9.119 +
   9.120 +subsection {* Very restricted calculation fallback calculation *}
   9.121 +
   9.122 +consts the_LVar_name:: "var \<Rightarrow> lname"
   9.123 +primrec 
   9.124 +"the_LVar_name (LVar n) = n"
   9.125 +
   9.126 +consts assignsE :: "expr      \<Rightarrow> lname set" 
   9.127 +       assignsV :: "var       \<Rightarrow> lname set"
   9.128 +       assignsEs:: "expr list \<Rightarrow> lname set"
   9.129 +text {* *}
   9.130 +primrec
   9.131 +"assignsE (NewC c)            = {}" 
   9.132 +"assignsE (NewA t e)          = assignsE e"
   9.133 +"assignsE (Cast t e)          = assignsE e"
   9.134 +"assignsE (e InstOf r)        = assignsE e"
   9.135 +"assignsE (Lit val)           = {}"
   9.136 +"assignsE (UnOp unop e)       = assignsE e"
   9.137 +"assignsE (BinOp binop e1 e2) = (if binop=CondAnd \<or> binop=CondOr
   9.138 +                                     then (assignsE e1)
   9.139 +                                     else (assignsE e1) \<union> (assignsE e2))" 
   9.140 +"assignsE (Super)             = {}"
   9.141 +"assignsE (Acc v)             = assignsV v"
   9.142 +"assignsE (v:=e)              = (assignsV v) \<union> (assignsE e) \<union> 
   9.143 +                                 (if \<exists> n. v=(LVar n) then {the_LVar_name v} 
   9.144 +                                                     else {})"
   9.145 +"assignsE (b? e1 : e2) = (assignsE b) \<union> ((assignsE e1) \<inter> (assignsE e2))"
   9.146 +"assignsE ({accC,statT,mode}objRef\<cdot>mn({pTs}args)) 
   9.147 +                          = (assignsE objRef) \<union> (assignsEs args)"
   9.148 +-- {* Only dummy analysis for intermediate expressions  
   9.149 +      @{term Methd}, @{term Body}, @{term InsInitE} and @{term Callee} *}
   9.150 +"assignsE (Methd C sig)   = {}" 
   9.151 +"assignsE (Body  C s)     = {}"   
   9.152 +"assignsE (InsInitE s e)  = {}"  
   9.153 +"assignsE (Callee l e)    = {}" 
   9.154 +
   9.155 +"assignsV (LVar n)       = {}"
   9.156 +"assignsV ({accC,statDeclC,stat}objRef..fn) = assignsE objRef"
   9.157 +"assignsV (e1.[e2])      = assignsE e1 \<union> assignsE e2"
   9.158 +
   9.159 +"assignsEs     [] = {}"
   9.160 +"assignsEs (e#es) = assignsE e \<union> assignsEs es"
   9.161 +
   9.162 +constdefs assigns:: "term \<Rightarrow> lname set"
   9.163 +"assigns t \<equiv> (case t of
   9.164 +                In1 se \<Rightarrow> (case se of
   9.165 +                             Inl e \<Rightarrow> assignsE e
   9.166 +                           | Inr s \<Rightarrow> {})
   9.167 +              | In2  v \<Rightarrow> assignsV v
   9.168 +              | In3  es \<Rightarrow> assignsEs es)"
   9.169 +
   9.170 +lemma assigns_expr_simp [simp]: "assigns (In1l e) = assignsE e"
   9.171 +by (simp add: assigns_def)
   9.172 +
   9.173 +lemma assigns_expr_simp1 [simp]: "assigns (\<langle>e\<rangle>) = assignsE e"
   9.174 +by (simp add: inj_term_simps)
   9.175 +
   9.176 +lemma assigns_stmt_simp [simp]: "assigns (In1r s) = {}"
   9.177 +by (simp add: assigns_def)
   9.178 +
   9.179 +lemma assigns_stmt_simp1 [simp]: "assigns (\<langle>s::stmt\<rangle>) = {}"
   9.180 +by (simp add: inj_term_simps)
   9.181 +
   9.182 +lemma assigns_var_simp [simp]: "assigns (In2 v) = assignsV v"
   9.183 +by (simp add: assigns_def)
   9.184 +
   9.185 +lemma assigns_var_simp1 [simp]: "assigns (\<langle>v\<rangle>) = assignsV v"
   9.186 +by (simp add: inj_term_simps)
   9.187 +
   9.188 +lemma assigns_expr_list_simp [simp]: "assigns (In3 es) = assignsEs es"
   9.189 +by (simp add: assigns_def)
   9.190 +
   9.191 +lemma assigns_expr_list_simp1 [simp]: "assigns (\<langle>es\<rangle>) = assignsEs es"
   9.192 +by (simp add: inj_term_simps)
   9.193 +
   9.194 +subsection "Analysis of constant expressions"
   9.195 +
   9.196 +consts constVal :: "expr \<Rightarrow> val option"
   9.197 +primrec 
   9.198 +"constVal (NewC c)      = None"
   9.199 +"constVal (NewA t e)    = None"
   9.200 +"constVal (Cast t e)    = None"
   9.201 +"constVal (Inst e r)    = None"
   9.202 +"constVal (Lit val)     = Some val"
   9.203 +"constVal (UnOp unop e) = (case (constVal e) of
   9.204 +                             None   \<Rightarrow> None
   9.205 +                           | Some v \<Rightarrow> Some (eval_unop unop v))" 
   9.206 +"constVal (BinOp binop e1 e2) = (case (constVal e1) of
   9.207 +                                   None    \<Rightarrow> None
   9.208 +                                 | Some v1 \<Rightarrow> (case (constVal e2) of 
   9.209 +                                                None    \<Rightarrow> None
   9.210 +                                              | Some v2 \<Rightarrow> Some (eval_binop 
   9.211 +                                                                 binop v1 v2)))"
   9.212 +"constVal (Super)         = None"
   9.213 +"constVal (Acc v)         = None"
   9.214 +"constVal (Ass v e)       = None"
   9.215 +"constVal (Cond b e1 e2)  = (case (constVal b) of
   9.216 +                               None   \<Rightarrow> None
   9.217 +                             | Some bv\<Rightarrow> (case the_Bool bv of
   9.218 +                                            True \<Rightarrow> (case (constVal e2) of
   9.219 +                                                       None   \<Rightarrow> None
   9.220 +                                                     | Some v \<Rightarrow> constVal e1)
   9.221 +                                          | False\<Rightarrow> (case (constVal e1) of
   9.222 +                                                       None   \<Rightarrow> None
   9.223 +                                                     | Some v \<Rightarrow> constVal e2)))"
   9.224 +--{* Note that @{text "constVal (Cond b e1 e2)"} is stricter as it could be.
   9.225 +     It requires that all tree expressions are constant even if we can decide
   9.226 +     which branch to choose, provided the constant value of @{term b} *}
   9.227 +"constVal (Call accC statT mode objRef mn pTs args) = None"
   9.228 +"constVal (Methd C sig)   = None" 
   9.229 +"constVal (Body  C s)     = None"   
   9.230 +"constVal (InsInitE s e)  = None"  
   9.231 +"constVal (Callee l e)    = None" 
   9.232 +
   9.233 +lemma constVal_Some_induct [consumes 1, case_names Lit UnOp BinOp CondL CondR]: 
   9.234 +  assumes const: "constVal e = Some v" and
   9.235 +        hyp_Lit: "\<And> v. P (Lit v)" and
   9.236 +       hyp_UnOp: "\<And> unop e'. P e' \<Longrightarrow> P (UnOp unop e')" and
   9.237 +      hyp_BinOp: "\<And> binop e1 e2. \<lbrakk>P e1; P e2\<rbrakk> \<Longrightarrow> P (BinOp binop e1 e2)" and
   9.238 +      hyp_CondL: "\<And> b bv e1 e2. \<lbrakk>constVal b = Some bv; the_Bool bv; P b; P e1\<rbrakk> 
   9.239 +                              \<Longrightarrow> P (b? e1 : e2)" and
   9.240 +      hyp_CondR: "\<And> b bv e1 e2. \<lbrakk>constVal b = Some bv; \<not>the_Bool bv; P b; P e2\<rbrakk>
   9.241 +                              \<Longrightarrow> P (b? e1 : e2)"
   9.242 +  shows "P e"
   9.243 +proof -
   9.244 +  have "True" and "\<And> v. constVal e = Some v \<Longrightarrow> P e" and "True" and "True"
   9.245 +  proof (induct "x::var" and e and "s::stmt" and "es::expr list")
   9.246 +    case Lit
   9.247 +    show ?case by (rule hyp_Lit)
   9.248 +  next
   9.249 +    case UnOp
   9.250 +    thus ?case
   9.251 +      by (auto intro: hyp_UnOp)
   9.252 +  next
   9.253 +    case BinOp
   9.254 +    thus ?case
   9.255 +      by (auto intro: hyp_BinOp)
   9.256 +  next
   9.257 +    case (Cond b e1 e2)
   9.258 +    then obtain v where   v: "constVal (b ? e1 : e2) = Some v"
   9.259 +      by blast
   9.260 +    then obtain bv where bv: "constVal b = Some bv"
   9.261 +      by simp
   9.262 +    show ?case
   9.263 +    proof (cases "the_Bool bv")
   9.264 +      case True
   9.265 +      with Cond show ?thesis using v bv
   9.266 +	by (auto intro: hyp_CondL)
   9.267 +    next
   9.268 +      case False
   9.269 +      with Cond show ?thesis using v bv
   9.270 +	by (auto intro: hyp_CondR)
   9.271 +    qed
   9.272 +  qed (simp_all)
   9.273 +  with const 
   9.274 +  show ?thesis
   9.275 +    by blast  
   9.276 +qed
   9.277 +
   9.278 +lemma assignsE_const_simp: "constVal e = Some v \<Longrightarrow> assignsE e = {}"
   9.279 +  by (induct rule: constVal_Some_induct) simp_all
   9.280 +
   9.281 +
   9.282 +subsection {* Main analysis for boolean expressions *}
   9.283 +
   9.284 +text {* Assigned local variables after evaluating the expression if it evaluates
   9.285 +to a specific boolean value. If the expression cannot evaluate to a 
   9.286 +@{term Boolean} value UNIV is returned. If we expect true/false the opposite 
   9.287 +constant false/true will also lead to UNIV. *}
   9.288 +consts assigns_if:: "bool \<Rightarrow> expr \<Rightarrow> lname set" 
   9.289 +primrec
   9.290 +"assigns_if b (NewC c)            = UNIV" --{*can never evaluate to Boolean*} 
   9.291 +"assigns_if b (NewA t e)          = UNIV" --{*can never evaluate to Boolean*}
   9.292 +"assigns_if b (Cast t e)          = assigns_if b e" 
   9.293 +"assigns_if b (Inst e r)          = assignsE e" --{*Inst has type Boolean but
   9.294 +                                                     e is a reference type*}
   9.295 +"assigns_if b (Lit val)           = (if val=Bool b then {} else UNIV)"  
   9.296 +"assigns_if b (UnOp unop e)       = (case constVal (UnOp unop e) of
   9.297 +                                         None   \<Rightarrow> (if unop = UNot 
   9.298 +                                                       then assigns_if (\<not>b) e
   9.299 +                                                       else UNIV)
   9.300 +                                       | Some v \<Rightarrow> (if v=Bool b 
   9.301 +                                                       then {} 
   9.302 +                                                       else UNIV))"
   9.303 +"assigns_if b (BinOp binop e1 e2) 
   9.304 +  = (case constVal (BinOp binop e1 e2) of
   9.305 +       None \<Rightarrow> (if binop=CondAnd then
   9.306 +                   (case b of 
   9.307 +                       True  \<Rightarrow> assigns_if True  e1 \<union> assigns_if True e2
   9.308 +                    |  False \<Rightarrow> assigns_if False e1 \<inter> 
   9.309 +                                (assigns_if True e1 \<union> assigns_if False e2))
   9.310 +                else
   9.311 +               (if binop=CondOr then
   9.312 +                   (case b of 
   9.313 +                       True  \<Rightarrow> assigns_if True e1 \<inter> 
   9.314 +                                (assigns_if False e1 \<union> assigns_if True e2)
   9.315 +                    |  False \<Rightarrow> assigns_if False  e1 \<union> assigns_if False e2)
   9.316 +                else assignsE e1 \<union> assignsE e2))
   9.317 +     | Some v \<Rightarrow> (if v=Bool b then {} else UNIV))"
   9.318 +
   9.319 +"assigns_if b (Super)      = UNIV" --{*can never evaluate to Boolean*}
   9.320 +"assigns_if b (Acc v)      = (assignsV v)"
   9.321 +"assigns_if b (v := e)     = (assignsE (Ass v e))"
   9.322 +"assigns_if b (c? e1 : e2) = (assignsE c) \<union>
   9.323 +                               (case (constVal c) of
   9.324 +                                  None    \<Rightarrow> (assigns_if b e1) \<inter> 
   9.325 +                                             (assigns_if b e2)
   9.326 +                                | Some bv \<Rightarrow> (case the_Bool bv of
   9.327 +                                                True  \<Rightarrow> assigns_if b e1
   9.328 +                                              | False \<Rightarrow> assigns_if b e2))"
   9.329 +"assigns_if b ({accC,statT,mode}objRef\<cdot>mn({pTs}args))  
   9.330 +          = assignsE ({accC,statT,mode}objRef\<cdot>mn({pTs}args)) "
   9.331 +-- {* Only dummy analysis for intermediate expressions  
   9.332 +      @{term Methd}, @{term Body}, @{term InsInitE} and @{term Callee} *}
   9.333 +"assigns_if b (Methd C sig)   = {}" 
   9.334 +"assigns_if b (Body  C s)     = {}"   
   9.335 +"assigns_if b (InsInitE s e)  = {}"  
   9.336 +"assigns_if b (Callee l e)    = {}" 
   9.337 +
   9.338 +lemma assigns_if_const_b_simp:
   9.339 +  assumes boolConst: "constVal e = Some (Bool b)" (is "?Const b e")
   9.340 +  shows   "assigns_if b e = {}" (is "?Ass b e")
   9.341 +proof -
   9.342 +  have "True" and "\<And> b. ?Const b e \<Longrightarrow> ?Ass b e" and "True" and "True"
   9.343 +  proof (induct _ and e and _ and _ rule: var_expr_stmt.induct) 
   9.344 +    case Lit
   9.345 +    thus ?case by simp
   9.346 +  next
   9.347 +    case UnOp 
   9.348 +    thus ?case by simp
   9.349 +  next 
   9.350 +    case (BinOp binop)
   9.351 +    thus ?case
   9.352 +      by (cases binop) (simp_all)
   9.353 +  next
   9.354 +    case (Cond c e1 e2 b)
   9.355 +    have hyp_c:  "\<And> b. ?Const b c \<Longrightarrow> ?Ass b c" .
   9.356 +    have hyp_e1: "\<And> b. ?Const b e1 \<Longrightarrow> ?Ass b e1" .
   9.357 +    have hyp_e2: "\<And> b. ?Const b e2 \<Longrightarrow> ?Ass b e2" .
   9.358 +    have const: "constVal (c ? e1 : e2) = Some (Bool b)" .
   9.359 +    then obtain bv where bv: "constVal c = Some bv"
   9.360 +      by simp
   9.361 +    hence emptyC: "assignsE c = {}" by (rule assignsE_const_simp)
   9.362 +    show ?case
   9.363 +    proof (cases "the_Bool bv")
   9.364 +      case True
   9.365 +      with const bv  
   9.366 +      have "?Const b e1" by simp
   9.367 +      hence "?Ass b e1" by (rule hyp_e1)
   9.368 +      with emptyC bv True
   9.369 +      show ?thesis
   9.370 +	by simp
   9.371 +    next
   9.372 +      case False
   9.373 +      with const bv  
   9.374 +      have "?Const b e2" by simp
   9.375 +      hence "?Ass b e2" by (rule hyp_e2)
   9.376 +      with emptyC bv False
   9.377 +      show ?thesis
   9.378 +	by simp
   9.379 +    qed
   9.380 +  qed (simp_all)
   9.381 +  with boolConst
   9.382 +  show ?thesis
   9.383 +    by blast
   9.384 +qed
   9.385 +
   9.386 +lemma assigns_if_const_not_b_simp:
   9.387 +  assumes boolConst: "constVal e = Some (Bool b)"        (is "?Const b e")  
   9.388 +    shows "assigns_if (\<not>b) e = UNIV"                    (is "?Ass b e")
   9.389 +proof -
   9.390 +  have True and "\<And> b. ?Const b e \<Longrightarrow> ?Ass b e" and True and True
   9.391 +  proof (induct _ and e and _ and _ rule: var_expr_stmt.induct) 
   9.392 +    case Lit
   9.393 +    thus ?case by simp
   9.394 +  next
   9.395 +    case UnOp 
   9.396 +    thus ?case by simp
   9.397 +  next 
   9.398 +    case (BinOp binop)
   9.399 +    thus ?case
   9.400 +      by (cases binop) (simp_all)
   9.401 +  next
   9.402 +    case (Cond c e1 e2 b)
   9.403 +    have hyp_c:  "\<And> b. ?Const b c \<Longrightarrow> ?Ass b c" .
   9.404 +    have hyp_e1: "\<And> b. ?Const b e1 \<Longrightarrow> ?Ass b e1" .
   9.405 +    have hyp_e2: "\<And> b. ?Const b e2 \<Longrightarrow> ?Ass b e2" .
   9.406 +    have const: "constVal (c ? e1 : e2) = Some (Bool b)" .
   9.407 +    then obtain bv where bv: "constVal c = Some bv"
   9.408 +      by simp
   9.409 +    show ?case
   9.410 +    proof (cases "the_Bool bv")
   9.411 +      case True
   9.412 +      with const bv  
   9.413 +      have "?Const b e1" by simp
   9.414 +      hence "?Ass b e1" by (rule hyp_e1)
   9.415 +      with bv True
   9.416 +      show ?thesis
   9.417 +	by simp
   9.418 +    next
   9.419 +      case False
   9.420 +      with const bv  
   9.421 +      have "?Const b e2" by simp
   9.422 +      hence "?Ass b e2" by (rule hyp_e2)
   9.423 +      with bv False 
   9.424 +      show ?thesis
   9.425 +	by simp
   9.426 +    qed
   9.427 +  qed (simp_all)
   9.428 +  with boolConst
   9.429 +  show ?thesis
   9.430 +    by blast
   9.431 +qed
   9.432 +
   9.433 +subsection {* Lifting set operations to range of tables (map to a set) *}
   9.434 +
   9.435 +constdefs 
   9.436 + union_ts:: "('a,'b) tables \<Rightarrow> ('a,'b) tables \<Rightarrow> ('a,'b) tables"
   9.437 +                    ("_ \<Rightarrow>\<union> _" [67,67] 65)
   9.438 + "A \<Rightarrow>\<union> B \<equiv> \<lambda> k. A k \<union> B k"
   9.439 +
   9.440 +constdefs
   9.441 + intersect_ts:: "('a,'b) tables \<Rightarrow> ('a,'b) tables \<Rightarrow> ('a,'b) tables"
   9.442 +                    ("_ \<Rightarrow>\<inter>  _" [72,72] 71)
   9.443 + "A \<Rightarrow>\<inter>  B \<equiv> \<lambda> k. A k \<inter> B k"
   9.444 +
   9.445 +constdefs
   9.446 + all_union_ts:: "('a,'b) tables \<Rightarrow> 'b set \<Rightarrow> ('a,'b) tables" 
   9.447 +                                                     (infixl "\<Rightarrow>\<union>\<^sub>\<forall>" 40)
   9.448 +"A \<Rightarrow>\<union>\<^sub>\<forall> B \<equiv> \<lambda> k. A k \<union> B"
   9.449 +  
   9.450 +subsubsection {* Binary union of tables *}
   9.451 +
   9.452 +lemma union_ts_iff [simp]: "(c \<in> (A \<Rightarrow>\<union> B) k) = (c \<in> A k \<or>  c \<in> B k)"
   9.453 +  by (unfold union_ts_def) blast
   9.454 +
   9.455 +lemma union_tsI1 [elim?]: "c \<in> A k \<Longrightarrow> c \<in> (A \<Rightarrow>\<union> B) k"
   9.456 +  by simp
   9.457 +
   9.458 +lemma union_tsI2 [elim?]: "c \<in> B k \<Longrightarrow> c \<in> (A \<Rightarrow>\<union> B) k"
   9.459 +  by simp
   9.460 +
   9.461 +lemma union_tsCI [intro!]: "(c \<notin> B k \<Longrightarrow> c \<in> A k) \<Longrightarrow> c \<in> (A \<Rightarrow>\<union> B) k"
   9.462 +  by auto
   9.463 +
   9.464 +lemma union_tsE [elim!]: 
   9.465 + "\<lbrakk>c \<in> (A \<Rightarrow>\<union> B) k; (c \<in> A k \<Longrightarrow> P); (c \<in> B k \<Longrightarrow> P)\<rbrakk> \<Longrightarrow> P"
   9.466 +  by (unfold union_ts_def) blast
   9.467 +
   9.468 +subsubsection {* Binary intersection of tables *}
   9.469 +
   9.470 +lemma intersect_ts_iff [simp]: "c \<in> (A \<Rightarrow>\<inter> B) k = (c \<in> A k \<and> c \<in> B k)"
   9.471 +  by (unfold intersect_ts_def) blast
   9.472 +
   9.473 +lemma intersect_tsI [intro!]: "\<lbrakk>c \<in> A k; c \<in> B k\<rbrakk> \<Longrightarrow> c \<in>  (A \<Rightarrow>\<inter> B) k"
   9.474 +  by simp
   9.475 +
   9.476 +lemma intersect_tsD1: "c \<in> (A \<Rightarrow>\<inter> B) k \<Longrightarrow> c \<in> A k"
   9.477 +  by simp
   9.478 +
   9.479 +lemma intersect_tsD2: "c \<in> (A \<Rightarrow>\<inter> B) k \<Longrightarrow> c \<in> B k"
   9.480 +  by simp
   9.481 +
   9.482 +lemma intersect_tsE [elim!]: 
   9.483 +   "\<lbrakk>c \<in> (A \<Rightarrow>\<inter> B) k; \<lbrakk>c \<in> A k; c \<in> B k\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   9.484 +  by simp
   9.485 +
   9.486 +
   9.487 +subsubsection {* All-Union of tables and set *}
   9.488 +
   9.489 +lemma all_union_ts_iff [simp]: "(c \<in> (A \<Rightarrow>\<union>\<^sub>\<forall> B) k) = (c \<in> A k \<or>  c \<in> B)"
   9.490 +  by (unfold all_union_ts_def) blast
   9.491 +
   9.492 +lemma all_union_tsI1 [elim?]: "c \<in> A k \<Longrightarrow> c \<in> (A \<Rightarrow>\<union>\<^sub>\<forall> B) k"
   9.493 +  by simp
   9.494 +
   9.495 +lemma all_union_tsI2 [elim?]: "c \<in> B \<Longrightarrow> c \<in> (A \<Rightarrow>\<union>\<^sub>\<forall> B) k"
   9.496 +  by simp
   9.497 +
   9.498 +lemma all_union_tsCI [intro!]: "(c \<notin> B \<Longrightarrow> c \<in> A k) \<Longrightarrow> c \<in> (A \<Rightarrow>\<union>\<^sub>\<forall> B) k"
   9.499 +  by auto
   9.500 +
   9.501 +lemma all_union_tsE [elim!]: 
   9.502 + "\<lbrakk>c \<in> (A \<Rightarrow>\<union>\<^sub>\<forall> B) k; (c \<in> A k \<Longrightarrow> P); (c \<in> B \<Longrightarrow> P)\<rbrakk> \<Longrightarrow> P"
   9.503 +  by (unfold all_union_ts_def) blast
   9.504 +
   9.505 +
   9.506 +section "The rules of definite assignment"
   9.507 +
   9.508 + 
   9.509 +types breakass = "(label, lname) tables" 
   9.510 +--{* Mapping from a break label, to the set of variables that will be assigned 
   9.511 +     if the evaluation terminates with this break *}
   9.512 +    
   9.513 +record assigned = 
   9.514 +         nrm :: "lname set" --{* Definetly assigned variables 
   9.515 +                                 for normal completion*}
   9.516 +         brk :: "breakass" --{* Definetly assigned variables for 
   9.517 +                                abnormal completion with a break *}
   9.518 +
   9.519 +consts da :: "(env \<times> lname set \<times> term \<times> assigned) set"  
   9.520 +text {* The environment @{term env} is only needed for the 
   9.521 +        conditional @{text "_ ? _ : _"}.
   9.522 +        The definite assignment rules refer to the typing rules here to
   9.523 +        distinguish boolean and other expressions.
   9.524 +      *}
   9.525 +
   9.526 +syntax
   9.527 +da :: "env \<Rightarrow> lname set \<Rightarrow> term \<Rightarrow> assigned \<Rightarrow> bool" 
   9.528 +                           ("_\<turnstile> _ \<guillemotright>_\<guillemotright> _" [65,65,65,65] 71)
   9.529 +
   9.530 +translations 
   9.531 +  "E\<turnstile> B \<guillemotright>t\<guillemotright> A" == "(E,B,t,A) \<in> da"
   9.532 +
   9.533 +text {* @{text B}: the ''assigned'' variables before evaluating term @{text t};
   9.534 +        @{text A}: the ''assigned'' variables after evaluating term @{text t}
   9.535 +*}
   9.536 +
   9.537 +
   9.538 +constdefs rmlab :: "'a \<Rightarrow> ('a,'b) tables \<Rightarrow> ('a,'b) tables"
   9.539 +"rmlab k A \<equiv> \<lambda> x. if x=k then UNIV else A x"
   9.540 + 
   9.541 +(*
   9.542 +constdefs setbrk :: "breakass \<Rightarrow> assigned \<Rightarrow> breakass set"
   9.543 +"setbrk b A \<equiv> {b} \<union> {a| a. a\<in> brk A \<and> lab a \<noteq> lab b}"
   9.544 +*)
   9.545 +
   9.546 +constdefs range_inter_ts :: "('a,'b) tables \<Rightarrow> 'b set" ("\<Rightarrow>\<Inter>_" 80)
   9.547 + "\<Rightarrow>\<Inter>A \<equiv> {x |x. \<forall> k. x \<in> A k}"
   9.548 +
   9.549 +inductive "da" intros
   9.550 +
   9.551 + Skip: "Env\<turnstile> B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>"
   9.552 +
   9.553 + Expr: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A 
   9.554 +        \<Longrightarrow>  
   9.555 +        Env\<turnstile> B \<guillemotright>\<langle>Expr e\<rangle>\<guillemotright> A"
   9.556 + Lab:  "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>c\<rangle>\<guillemotright> C; nrm A = nrm C \<inter> (brk C) l; brk A = rmlab l (brk C)\<rbrakk>
   9.557 +        \<Longrightarrow> 
   9.558 +        Env\<turnstile> B \<guillemotright>\<langle>Break l\<bullet> c\<rangle>\<guillemotright> A" 
   9.559 +
   9.560 + Comp: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>c1\<rangle>\<guillemotright> C1; Env\<turnstile> nrm C1 \<guillemotright>\<langle>c2\<rangle>\<guillemotright> C2; 
   9.561 +        nrm A = nrm C2; brk A = (brk C1) \<Rightarrow>\<inter> (brk C2)\<rbrakk> 
   9.562 +        \<Longrightarrow>  
   9.563 +        Env\<turnstile> B \<guillemotright>\<langle>c1;; c2\<rangle>\<guillemotright> A"
   9.564 +
   9.565 + If:   "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E;
   9.566 +         Env\<turnstile> (B \<union> assigns_if True  e) \<guillemotright>\<langle>c1\<rangle>\<guillemotright> C1;
   9.567 +         Env\<turnstile> (B \<union> assigns_if False e) \<guillemotright>\<langle>c2\<rangle>\<guillemotright> C2;
   9.568 +         nrm A = nrm C1 \<inter> nrm C2;
   9.569 +         brk A = brk C1 \<Rightarrow>\<inter> brk C2 \<rbrakk>  
   9.570 +         \<Longrightarrow>
   9.571 +         Env\<turnstile> B \<guillemotright>\<langle>If(e) c1 Else c2\<rangle>\<guillemotright> A"
   9.572 +
   9.573 +--{* Note that @{term E} is not further used, because we take the specialized
   9.574 +     sets that also consider if the expression evaluates to true or false. 
   9.575 +     Inside of @{term e} there is no {\tt break} or {\tt finally}, so the break
   9.576 +     map of @{term E} will be the trivial one. So 
   9.577 +     @{term "Env\<turnstile>B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E"} is just used to enshure the definite assignment in
   9.578 +     expression @{term e}.
   9.579 +     Notice the implicit analysis of a constant boolean expression @{term e}
   9.580 +     in this rule. For example, if @{term e} is constantly @{term True} then 
   9.581 +     @{term "assigns_if False e = UNIV"} and therefor @{term "nrm C2=UNIV"}.
   9.582 +     So finally @{term "nrm A = nrm C1"}. For the break maps this trick 
   9.583 +     workd too, because the trival break map will map all labels to 
   9.584 +     @{term UNIV}. In the example, if no break occurs in @{term c2} the break
   9.585 +     maps will trivially map to @{term UNIV} and if a break occurs it will map
   9.586 +     to @{term UNIV} too, because @{term "assigns_if False e = UNIV"}. So
   9.587 +     in the intersection of the break maps the path @{term c2} will have no
   9.588 +     contribution.
   9.589 +  *}
   9.590 +
   9.591 + Loop: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E; 
   9.592 +         Env\<turnstile> (B \<union> assigns_if True e) \<guillemotright>\<langle>c\<rangle>\<guillemotright> C;
   9.593 +         nrm A = nrm C \<inter> (B \<union> assigns_if False e);
   9.594 +         brk A = brk C\<rbrakk>  
   9.595 +         \<Longrightarrow>
   9.596 +         Env\<turnstile> B \<guillemotright>\<langle>l\<bullet> While(e) c\<rangle>\<guillemotright> A"
   9.597 +--{* The @{text Loop} rule resembles some of the ideas of the @{text If} rule.
   9.598 +     For the @{term "nrm A"} the set @{term "B \<union> assigns_if False e"} 
   9.599 +     will be @{term UNIV} if the condition is constantly true. To normally exit
   9.600 +     the while loop, we must consider the body @{term c} to be completed 
   9.601 +     normally (@{term "nrm C"}) or with a break. But in this model, 
   9.602 +     the label @{term l} of the loop
   9.603 +     only handles continue labels, not break labels. The break label will be
   9.604 +     handled by an enclosing @{term Lab} statement. So we don't have to
   9.605 +     handle the breaks specially. 
   9.606 +  *}
   9.607 +
   9.608 + Jmp: "\<lbrakk>jump=Ret \<longrightarrow> Result \<in> B;
   9.609 +        nrm A = UNIV;
   9.610 +        brk A = (case jump of
   9.611 +                   Break l \<Rightarrow> \<lambda> k. if k=l then B else UNIV     
   9.612 +                 | Cont l  \<Rightarrow> \<lambda> k. UNIV
   9.613 +                 | Ret     \<Rightarrow> \<lambda> k. UNIV)\<rbrakk> 
   9.614 +       \<Longrightarrow> 
   9.615 +       Env\<turnstile> B \<guillemotright>\<langle>Jmp jump\<rangle>\<guillemotright> A"
   9.616 +--{* In case of a break to label @{term l} the corresponding break set is all
   9.617 +     variables assigned before the break. The assigned variables for normal
   9.618 +     completion of the @{term Jmp} is @{term UNIV}, because the statement will
   9.619 +     never complete normally. For continue and return the break map is the 
   9.620 +     trivial one. In case of a return we enshure that the result value is
   9.621 +     assigned.
   9.622 +  *}
   9.623 +
   9.624 + Throw: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E; nrm A = UNIV; brk A = (\<lambda> l. UNIV)\<rbrakk> 
   9.625 +        \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Throw e\<rangle>\<guillemotright> A"
   9.626 +
   9.627 + Try:  "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>c1\<rangle>\<guillemotright> C1; 
   9.628 +         Env\<lparr>lcl := lcl Env(VName vn\<mapsto>Class C)\<rparr>\<turnstile> (B \<union> {VName vn}) \<guillemotright>\<langle>c2\<rangle>\<guillemotright> C2;  
   9.629 +         nrm A = nrm C1 \<inter> nrm C2;
   9.630 +         brk A = brk C1 \<Rightarrow>\<inter> brk C2\<rbrakk> 
   9.631 +        \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Try c1 Catch(C vn) c2\<rangle>\<guillemotright> A"
   9.632 +
   9.633 + Fin:  "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>c1\<rangle>\<guillemotright> C1;
   9.634 +         Env\<turnstile> B \<guillemotright>\<langle>c2\<rangle>\<guillemotright> C2;
   9.635 +         nrm A = nrm C1 \<union> nrm C2;
   9.636 +         brk A = ((brk C1) \<Rightarrow>\<union>\<^sub>\<forall> (nrm C2)) \<Rightarrow>\<inter> (brk C2)\<rbrakk>  
   9.637 +         \<Longrightarrow>
   9.638 +         Env\<turnstile> B \<guillemotright>\<langle>c1 Finally c2\<rangle>\<guillemotright> A" 
   9.639 +--{* The set of assigned variables before execution @{term c2} are the same
   9.640 +     as before execution @{term c1}, because @{term c1} could throw an exception
   9.641 +     and so we can't guarantee that any variable will be assigned in @{term c1}.
   9.642 +     The @{text Finally} statement completes
   9.643 +     normally if both @{term c1} and @{term c2} complete normally. If @{term c1}
   9.644 +     completes abnormally with a break, then @{term c2} also will be executed 
   9.645 +     and may terminate normally or with a break. The overall break map then is
   9.646 +     the intersection of the maps of both paths. If @{term c2} terminates 
   9.647 +     normally we have to extend all break sets in @{term "brk C1"} with 
   9.648 +     @{term "nrm C2"} (@{text "\<Rightarrow>\<union>\<^sub>\<forall>"}). If @{term c2} exits with a break this
   9.649 +     break will appear in the overall result state. We don't know if 
   9.650 +     @{term c1} completed normally or abruptly (maybe with an exception not only
   9.651 +     a break) so @{term c1} has no contribution to the break map following this
   9.652 +     path.
   9.653 +  *}
   9.654 +
   9.655 +--{* Evaluation of expressions and the break sets of definite assignment:
   9.656 +     Thinking of a Java expression we assume that we can never have
   9.657 +     a break statement inside of a expression. So for all expressions the
   9.658 +     break sets could be set to the trivial one: @{term "\<lambda> l. UNIV"}. 
   9.659 +     But we can't
   9.660 +     trivially proof, that evaluating an expression will never result in a 
   9.661 +     break, allthough Java expressions allready syntactically don't allow
   9.662 +     nested stetements in them. The reason are the nested class initialzation 
   9.663 +     statements which are inserted by the evaluation rules. So to proof the
   9.664 +     absence of a break we need to ensure, that the initialization statements
   9.665 +     will never end up in a break. In a wellfromed initialization statement, 
   9.666 +     of course, were breaks are nested correctly inside of @{term Lab} 
   9.667 +     or @{term Loop} statements evaluation of the whole initialization 
   9.668 +     statement will never result in a break, because this break will be 
   9.669 +     handled inside of the statement. But for simplicity we haven't added
   9.670 +     the analysis of the correct nesting of breaks in the typing judgments 
   9.671 +     right now. So we have decided to adjust the rules of definite assignment
   9.672 +     to fit to these circumstances. If an initialization is involved during
   9.673 +     evaluation of the expression (evaluation rules @{text FVar}, @{text NewC} 
   9.674 +     and @{text NewA}
   9.675 +*}
   9.676 +
   9.677 + Init: "Env\<turnstile> B \<guillemotright>\<langle>Init C\<rangle>\<guillemotright> \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>"
   9.678 +--{* Wellformedness of a program will ensure, that every static initialiser 
   9.679 +     is definetly assigned and the jumps are nested correctly. The case here
   9.680 +     for @{term Init} is just for convenience, to get a proper precondition 
   9.681 +     for the induction hypothesis in various proofs, so that we don't have to
   9.682 +     expand the initialisation on every point where it is triggerred by the
   9.683 +     evaluation rules.
   9.684 +  *}   
   9.685 + NewC: "Env\<turnstile> B \<guillemotright>\<langle>NewC C\<rangle>\<guillemotright> \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>" 
   9.686 +
   9.687 + NewA: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A 
   9.688 +        \<Longrightarrow>
   9.689 +        Env\<turnstile> B \<guillemotright>\<langle>New T[e]\<rangle>\<guillemotright> A"
   9.690 +
   9.691 + Cast: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A
   9.692 +        \<Longrightarrow>
   9.693 +        Env\<turnstile> B \<guillemotright>\<langle>Cast T e\<rangle>\<guillemotright> A"
   9.694 +
   9.695 + Inst: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A 
   9.696 +        \<Longrightarrow> 
   9.697 +        Env\<turnstile> B \<guillemotright>\<langle>e InstOf T\<rangle>\<guillemotright> A"
   9.698 +
   9.699 + Lit:  "Env\<turnstile> B \<guillemotright>\<langle>Lit v\<rangle>\<guillemotright> \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>"
   9.700 +
   9.701 + UnOp: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A
   9.702 +        \<Longrightarrow> 
   9.703 +        Env\<turnstile> B \<guillemotright>\<langle>UnOp unop e\<rangle>\<guillemotright> A"
   9.704 +
   9.705 + CondAnd: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1; Env\<turnstile> (B \<union> assigns_if True e1) \<guillemotright>\<langle>e2\<rangle>\<guillemotright> E2; 
   9.706 +            nrm A = B \<union> (assigns_if True (BinOp CondAnd e1 e2) \<inter> 
   9.707 +                            assigns_if False (BinOp CondAnd e1 e2));
   9.708 +            brk A = (\<lambda> l. UNIV) \<rbrakk>
   9.709 +           \<Longrightarrow>
   9.710 +           Env\<turnstile> B \<guillemotright>\<langle>BinOp CondAnd e1 e2\<rangle>\<guillemotright> A"
   9.711 +
   9.712 + CondOr: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1; Env\<turnstile> (B \<union> assigns_if False e1) \<guillemotright>\<langle>e2\<rangle>\<guillemotright> E2; 
   9.713 +           nrm A = B \<union> (assigns_if True (BinOp CondOr e1 e2) \<inter> 
   9.714 +                             assigns_if False (BinOp CondOr e1 e2));
   9.715 +           brk A = (\<lambda> l. UNIV) \<rbrakk>
   9.716 +           \<Longrightarrow>
   9.717 +           Env\<turnstile> B \<guillemotright>\<langle>BinOp CondOr e1 e2\<rangle>\<guillemotright> A"
   9.718 +
   9.719 + BinOp: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1; Env\<turnstile> nrm E1 \<guillemotright>\<langle>e2\<rangle>\<guillemotright> A; 
   9.720 +          binop \<noteq> CondAnd; binop \<noteq> CondOr\<rbrakk>
   9.721 +         \<Longrightarrow>
   9.722 +         Env\<turnstile> B \<guillemotright>\<langle>BinOp binop e1 e2\<rangle>\<guillemotright> A"
   9.723 +
   9.724 + Super: "This \<in> B 
   9.725 +         \<Longrightarrow> 
   9.726 +         Env\<turnstile> B \<guillemotright>\<langle>Super\<rangle>\<guillemotright> \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>"
   9.727 +
   9.728 + AccLVar: "\<lbrakk>vn \<in> B;
   9.729 +            nrm A = B; brk A = (\<lambda> k. UNIV)\<rbrakk> 
   9.730 +            \<Longrightarrow> 
   9.731 +            Env\<turnstile> B \<guillemotright>\<langle>Acc (LVar vn)\<rangle>\<guillemotright> A"
   9.732 +--{* To properly access a local variable we have to test the definite 
   9.733 +     assignment here. The variable must occur in the set @{term B} 
   9.734 +  *}
   9.735 +
   9.736 + Acc: "\<lbrakk>\<forall> vn. v \<noteq> LVar vn;
   9.737 +        Env\<turnstile> B \<guillemotright>\<langle>v\<rangle>\<guillemotright> A\<rbrakk>
   9.738 +        \<Longrightarrow>
   9.739 +        Env\<turnstile> B \<guillemotright>\<langle>Acc v\<rangle>\<guillemotright> A"
   9.740 +
   9.741 + AssLVar: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E; nrm A = nrm E \<union> {vn}; brk A = brk E\<rbrakk> 
   9.742 +           \<Longrightarrow> 
   9.743 +           Env\<turnstile> B \<guillemotright>\<langle>(LVar vn) := e\<rangle>\<guillemotright> A"
   9.744 +
   9.745 + Ass: "\<lbrakk>\<forall> vn. v \<noteq> LVar vn; Env\<turnstile> B \<guillemotright>\<langle>v\<rangle>\<guillemotright> V; Env\<turnstile> nrm V \<guillemotright>\<langle>e\<rangle>\<guillemotright> A\<rbrakk>
   9.746 +        \<Longrightarrow>
   9.747 +        Env\<turnstile> B \<guillemotright>\<langle>v := e\<rangle>\<guillemotright> A"
   9.748 +
   9.749 + CondBool: "\<lbrakk>Env\<turnstile>(c ? e1 : e2)\<Colon>-(PrimT Boolean);
   9.750 +             Env\<turnstile> B \<guillemotright>\<langle>c\<rangle>\<guillemotright> C;
   9.751 +             Env\<turnstile> (B \<union> assigns_if True  c) \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1;
   9.752 +             Env\<turnstile> (B \<union> assigns_if False c) \<guillemotright>\<langle>e2\<rangle>\<guillemotright> E2;
   9.753 +             nrm A = B \<union> (assigns_if True  (c ? e1 : e2) \<inter> 
   9.754 +                              assigns_if False (c ? e1 : e2));
   9.755 +             brk A = (\<lambda> l. UNIV)\<rbrakk>
   9.756 +             \<Longrightarrow> 
   9.757 +             Env\<turnstile> B \<guillemotright>\<langle>c ? e1 : e2\<rangle>\<guillemotright> A" 
   9.758 +
   9.759 + Cond: "\<lbrakk>\<not> Env\<turnstile>(c ? e1 : e2)\<Colon>-(PrimT Boolean);
   9.760 +         Env\<turnstile> B \<guillemotright>\<langle>c\<rangle>\<guillemotright> C;
   9.761 +         Env\<turnstile> (B \<union> assigns_if True  c) \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1;
   9.762 +         Env\<turnstile> (B \<union> assigns_if False c) \<guillemotright>\<langle>e2\<rangle>\<guillemotright> E2;
   9.763 +        nrm A = nrm E1 \<inter> nrm E2; brk A = (\<lambda> l. UNIV)\<rbrakk>
   9.764 +        \<Longrightarrow> 
   9.765 +        Env\<turnstile> B \<guillemotright>\<langle>c ? e1 : e2\<rangle>\<guillemotright> A" 
   9.766 +
   9.767 + Call: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> E; Env\<turnstile> nrm E \<guillemotright>\<langle>args\<rangle>\<guillemotright> A\<rbrakk> 
   9.768 +        \<Longrightarrow>  
   9.769 +        Env\<turnstile> B \<guillemotright>\<langle>{accC,statT,mode}e\<cdot>mn({pTs}args)\<rangle>\<guillemotright> A"
   9.770 +
   9.771 +-- {* The interplay of @{term Call}, @{term Methd} and @{term Body}:
   9.772 +      Why rules for @{term Methd} and @{term Body} at all? Note that a
   9.773 +      Java source program will not include bare  @{term Methd} or @{term Body}
   9.774 +      terms. These terms are just introduced during evaluation. So definite
   9.775 +      assignment of @{term Call} does not consider @{term Methd} or 
   9.776 +      @{term Body} at all. So for definite assignment alone we could omit the
   9.777 +      rules for @{term Methd} and @{term Body}. 
   9.778 +      But since evaluation of the method invocation is
   9.779 +      split up into three rules we must ensure that we have enough information
   9.780 +      about the call even in the @{term Body} term to make sure that we can
   9.781 +      proof type safety. Also we must be able transport this information 
   9.782 +      from @{term Call} to @{term Methd} and then further to @{term Body} 
   9.783 +      during evaluation to establish the definite assignment of @{term Methd}
   9.784 +      during evaluation of @{term Call}, and of @{term Body} during evaluation
   9.785 +      of @{term Methd}. This is necessary since definite assignment will be
   9.786 +      a precondition for each induction hypothesis coming out of the evaluation
   9.787 +      rules, and therefor we have to establish the definite assignment of the
   9.788 +      sub-evaluation during the type-safety proof. Note that well-typedness is
   9.789 +      also a precondition for type-safety and so we can omit some assertion 
   9.790 +      that are already ensured by well-typedness. 
   9.791 +   *}
   9.792 + Methd: "\<lbrakk>methd (prg Env) D sig = Some m;
   9.793 +          Env\<turnstile> B \<guillemotright>\<langle>Body (declclass m) (stmt (mbody (mthd m)))\<rangle>\<guillemotright> A
   9.794 +         \<rbrakk>
   9.795 +         \<Longrightarrow>
   9.796 +         Env\<turnstile> B \<guillemotright>\<langle>Methd D sig\<rangle>\<guillemotright> A" 
   9.797 +
   9.798 + Body: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>c\<rangle>\<guillemotright> C; jumpNestingOkS {Ret} c; Result \<in> nrm C;
   9.799 +         nrm A = B; brk A = (\<lambda> l. UNIV)\<rbrakk>
   9.800 +        \<Longrightarrow>
   9.801 +        Env\<turnstile> B \<guillemotright>\<langle>Body D c\<rangle>\<guillemotright> A"
   9.802 +-- {* Note that @{term A} is not correlated to  @{term C}. If the body
   9.803 +      statement returns abruptly with return, evaluation of  @{term Body}
   9.804 +      will absorb this return and complete normally. So we cannot trivially
   9.805 +      get the assigned variables of the body statement since it has not 
   9.806 +      completed normally or with a break.
   9.807 +      If the body completes normally we guarantee that the result variable
   9.808 +      is set with this rule. But if the body completes abruptly with a return
   9.809 +      we can't guarantee that the result variable is set here, since 
   9.810 +      definite assignment only talks about normal completion and breaks. So
   9.811 +      for a return the @{term Jump} rule ensures that the result variable is
   9.812 +      set and then this information must be carried over to the @{term Body}
   9.813 +      rule by the conformance predicate of the state.
   9.814 +   *}
   9.815 + LVar: "Env\<turnstile> B \<guillemotright>\<langle>LVar vn\<rangle>\<guillemotright> \<lparr>nrm=B, brk=\<lambda> l. UNIV\<rparr>" 
   9.816 +
   9.817 + FVar: "Env\<turnstile> B \<guillemotright>\<langle>e\<rangle>\<guillemotright> A 
   9.818 +        \<Longrightarrow> 
   9.819 +        Env\<turnstile> B \<guillemotright>\<langle>{accC,statDeclC,stat}e..fn\<rangle>\<guillemotright> A" 
   9.820 +
   9.821 + AVar: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e1\<rangle>\<guillemotright> E1; Env\<turnstile> nrm E1 \<guillemotright>\<langle>e2\<rangle>\<guillemotright> A\<rbrakk>
   9.822 +         \<Longrightarrow> 
   9.823 +         Env\<turnstile> B \<guillemotright>\<langle>e1.[e2]\<rangle>\<guillemotright> A" 
   9.824 +
   9.825 + Nil: "Env\<turnstile> B \<guillemotright>\<langle>[]::expr list\<rangle>\<guillemotright> \<lparr>nrm=B, brk=\<lambda> l. UNIV\<rparr>" 
   9.826 +
   9.827 + Cons: "\<lbrakk>Env\<turnstile> B \<guillemotright>\<langle>e::expr\<rangle>\<guillemotright> E; Env\<turnstile> nrm E \<guillemotright>\<langle>es\<rangle>\<guillemotright> A\<rbrakk>
   9.828 +        \<Longrightarrow> 
   9.829 +        Env\<turnstile> B \<guillemotright>\<langle>e#es\<rangle>\<guillemotright> A" 
   9.830 +
   9.831 +
   9.832 +declare inj_term_sym_simps [simp]
   9.833 +declare assigns_if.simps [simp del]
   9.834 +declare split_paired_All [simp del] split_paired_Ex [simp del]
   9.835 +ML_setup {*
   9.836 +simpset_ref() := simpset() delloop "split_all_tac"
   9.837 +*}
   9.838 +inductive_cases da_elim_cases [cases set]:
   9.839 +  "Env\<turnstile> B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> A" 
   9.840 +  "Env\<turnstile> B \<guillemotright>In1r Skip\<guillemotright> A" 
   9.841 +  "Env\<turnstile> B \<guillemotright>\<langle>Expr e\<rangle>\<guillemotright> A"
   9.842 +  "Env\<turnstile> B \<guillemotright>In1r (Expr e)\<guillemotright> A"
   9.843 +  "Env\<turnstile> B \<guillemotright>\<langle>l\<bullet> c\<rangle>\<guillemotright> A"
   9.844 +  "Env\<turnstile> B \<guillemotright>In1r (l\<bullet> c)\<guillemotright> A"
   9.845 +  "Env\<turnstile> B \<guillemotright>\<langle>c1;; c2\<rangle>\<guillemotright> A"
   9.846 +  "Env\<turnstile> B \<guillemotright>In1r (c1;; c2)\<guillemotright> A"
   9.847 +  "Env\<turnstile> B \<guillemotright>\<langle>If(e) c1 Else c2\<rangle>\<guillemotright> A" 
   9.848 +  "Env\<turnstile> B \<guillemotright>In1r (If(e) c1 Else c2)\<guillemotright> A" 
   9.849 +  "Env\<turnstile> B \<guillemotright>\<langle>l\<bullet> While(e) c\<rangle>\<guillemotright> A"
   9.850 +  "Env\<turnstile> B \<guillemotright>In1r (l\<bullet> While(e) c)\<guillemotright> A"  
   9.851 +  "Env\<turnstile> B \<guillemotright>\<langle>Jmp jump\<rangle>\<guillemotright> A"
   9.852 +  "Env\<turnstile> B \<guillemotright>In1r (Jmp jump)\<guillemotright> A"
   9.853 +  "Env\<turnstile> B \<guillemotright>\<langle>Throw e\<rangle>\<guillemotright> A"
   9.854 +  "Env\<turnstile> B \<guillemotright>In1r (Throw e)\<guillemotright> A"
   9.855 +  "Env\<turnstile> B \<guillemotright>\<langle>Try c1 Catch(C vn) c2\<rangle>\<guillemotright> A"
   9.856 +  "Env\<turnstile> B \<guillemotright>In1r (Try c1 Catch(C vn) c2)\<guillemotright> A"
   9.857 +  "Env\<turnstile> B \<guillemotright>\<langle>c1 Finally c2\<rangle>\<guillemotright> A" 
   9.858 +  "Env\<turnstile> B \<guillemotright>In1r (c1 Finally c2)\<guillemotright> A" 
   9.859 +  "Env\<turnstile> B \<guillemotright>\<langle>Init C\<rangle>\<guillemotright> A"
   9.860 +  "Env\<turnstile> B \<guillemotright>In1r (Init C)\<guillemotright> A"
   9.861 +  "Env\<turnstile> B \<guillemotright>\<langle>NewC C\<rangle>\<guillemotright> A"
   9.862 +  "Env\<turnstile> B \<guillemotright>In1l (NewC C)\<guillemotright> A"
   9.863 +  "Env\<turnstile> B \<guillemotright>\<langle>New T[e]\<rangle>\<guillemotright> A"
   9.864 +  "Env\<turnstile> B \<guillemotright>In1l (New T[e])\<guillemotright> A"
   9.865 +  "Env\<turnstile> B \<guillemotright>\<langle>Cast T e\<rangle>\<guillemotright> A"
   9.866 +  "Env\<turnstile> B \<guillemotright>In1l (Cast T e)\<guillemotright> A"
   9.867 +  "Env\<turnstile> B \<guillemotright>\<langle>e InstOf T\<rangle>\<guillemotright> A"
   9.868 +  "Env\<turnstile> B \<guillemotright>In1l (e InstOf T)\<guillemotright> A"
   9.869 +  "Env\<turnstile> B \<guillemotright>\<langle>Lit v\<rangle>\<guillemotright> A"
   9.870 +  "Env\<turnstile> B \<guillemotright>In1l (Lit v)\<guillemotright> A"
   9.871 +  "Env\<turnstile> B \<guillemotright>\<langle>UnOp unop e\<rangle>\<guillemotright> A"
   9.872 +  "Env\<turnstile> B \<guillemotright>In1l (UnOp unop e)\<guillemotright> A"
   9.873 +  "Env\<turnstile> B \<guillemotright>\<langle>BinOp binop e1 e2\<rangle>\<guillemotright> A"
   9.874 +  "Env\<turnstile> B \<guillemotright>In1l (BinOp binop e1 e2)\<guillemotright> A"
   9.875 +  "Env\<turnstile> B \<guillemotright>\<langle>Super\<rangle>\<guillemotright> A"
   9.876 +  "Env\<turnstile> B \<guillemotright>In1l (Super)\<guillemotright> A"
   9.877 +  "Env\<turnstile> B \<guillemotright>\<langle>Acc v\<rangle>\<guillemotright> A"
   9.878 +  "Env\<turnstile> B \<guillemotright>In1l (Acc v)\<guillemotright> A"
   9.879 +  "Env\<turnstile> B \<guillemotright>\<langle>v := e\<rangle>\<guillemotright> A"
   9.880 +  "Env\<turnstile> B \<guillemotright>In1l (v := e)\<guillemotright> A"
   9.881 +  "Env\<turnstile> B \<guillemotright>\<langle>c ? e1 : e2\<rangle>\<guillemotright> A" 
   9.882 +  "Env\<turnstile> B \<guillemotright>In1l (c ? e1 : e2)\<guillemotright> A" 
   9.883 +  "Env\<turnstile> B \<guillemotright>\<langle>{accC,statT,mode}e\<cdot>mn({pTs}args)\<rangle>\<guillemotright> A"
   9.884 +  "Env\<turnstile> B \<guillemotright>In1l ({accC,statT,mode}e\<cdot>mn({pTs}args))\<guillemotright> A"
   9.885 +  "Env\<turnstile> B \<guillemotright>\<langle>Methd C sig\<rangle>\<guillemotright> A" 
   9.886 +  "Env\<turnstile> B \<guillemotright>In1l (Methd C sig)\<guillemotright> A"
   9.887 +  "Env\<turnstile> B \<guillemotright>\<langle>Body D c\<rangle>\<guillemotright> A" 
   9.888 +  "Env\<turnstile> B \<guillemotright>In1l (Body D c)\<guillemotright> A" 
   9.889 +  "Env\<turnstile> B \<guillemotright>\<langle>LVar vn\<rangle>\<guillemotright> A"
   9.890 +  "Env\<turnstile> B \<guillemotright>In2 (LVar vn)\<guillemotright> A"
   9.891 +  "Env\<turnstile> B \<guillemotright>\<langle>{accC,statDeclC,stat}e..fn\<rangle>\<guillemotright> A" 
   9.892 +  "Env\<turnstile> B \<guillemotright>In2 ({accC,statDeclC,stat}e..fn)\<guillemotright> A" 
   9.893 +  "Env\<turnstile> B \<guillemotright>\<langle>e1.[e2]\<rangle>\<guillemotright> A" 
   9.894 +  "Env\<turnstile> B \<guillemotright>In2 (e1.[e2])\<guillemotright> A" 
   9.895 +  "Env\<turnstile> B \<guillemotright>\<langle>[]::expr list\<rangle>\<guillemotright> A"
   9.896 +  "Env\<turnstile> B \<guillemotright>In3 ([]::expr list)\<guillemotright> A"
   9.897 +  "Env\<turnstile> B \<guillemotright>\<langle>e#es\<rangle>\<guillemotright> A"
   9.898 +  "Env\<turnstile> B \<guillemotright>In3 (e#es)\<guillemotright> A"
   9.899 +declare inj_term_sym_simps [simp del]
   9.900 +declare assigns_if.simps [simp]
   9.901 +declare split_paired_All [simp] split_paired_Ex [simp]
   9.902 +ML_setup {*
   9.903 +simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
   9.904 +*}
   9.905 +(* To be able to eliminate both the versions with the overloaded brackets: 
   9.906 +   (B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> A) and with the explicit constructor (B \<guillemotright>In1r Skip\<guillemotright> A), 
   9.907 +   every rule appears in both versions
   9.908 + *)
   9.909 +
   9.910 +lemma da_Skip: "A = \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr> \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Skip\<rangle>\<guillemotright> A"
   9.911 +  by (auto intro: da.Skip)
   9.912 +
   9.913 +lemma da_NewC: "A = \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr> \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>NewC C\<rangle>\<guillemotright> A"
   9.914 +  by (auto intro: da.NewC)
   9.915 + 
   9.916 +lemma da_Lit:  "A = \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr> \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Lit v\<rangle>\<guillemotright> A"
   9.917 +  by (auto intro: da.Lit)
   9.918 +
   9.919 +lemma da_Super: "\<lbrakk>This \<in> B;A = \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr>\<rbrakk> \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Super\<rangle>\<guillemotright> A"
   9.920 +  by (auto intro: da.Super)
   9.921 +
   9.922 +lemma da_Init: "A = \<lparr>nrm=B,brk=\<lambda> l. UNIV\<rparr> \<Longrightarrow> Env\<turnstile> B \<guillemotright>\<langle>Init C\<rangle>\<guillemotright> A"
   9.923 +  by (auto intro: da.Init)
   9.924 +
   9.925 +
   9.926 +(*
   9.927 +For boolean expressions:
   9.928 +
   9.929 +The following holds: "assignsE e \<subseteq> assigns_if True e \<inter> assigns_if False e"
   9.930 +but not vice versa:
   9.931 + "assigns_if True e \<inter> assigns_if False e \<subseteq> assignsE e"
   9.932 +
   9.933 +Example: 
   9.934 + e = ((x < 5) || (y = true)) && (y = true)
   9.935 +
   9.936 +   =  (   a    ||    b     ) &&    c
   9.937 +
   9.938 +assigns_if True  a = {}
   9.939 +assigns_if False a = {}
   9.940 +
   9.941 +assigns_if True  b = {y}
   9.942 +assigns_if False b = {y}
   9.943 +
   9.944 +assigns_if True  c = {y}
   9.945 +assigns_if False c = {y}
   9.946 +
   9.947 +assigns_if True (a || b) = assigns_if True a \<inter> 
   9.948 +                                (assigns_if False a \<union> assigns_if True b)
   9.949 +                           = {} \<inter> ({} \<union> {y}) = {}
   9.950 +assigns_if False (a || b) = assigns_if False a \<union> assigns_if False b
   9.951 +                            = {} \<union> {y} = {y}
   9.952 +
   9.953 +
   9.954 +
   9.955 +assigns_ifE True e =  assigns_if True (a || b) \<union> assigns_if True c
   9.956 +                    = {} \<union> {y} = {y}