Isabelle/Bali sources;
authorschirmer
Mon Jan 28 17:00:19 2002 +0100 (2002-01-28)
changeset 1285400d4a435777f
parent 12853 de505273c971
child 12855 21225338f8db
Isabelle/Bali sources;
src/HOL/Bali/AxCompl.thy
src/HOL/Bali/AxExample.thy
src/HOL/Bali/AxSem.thy
src/HOL/Bali/AxSound.thy
src/HOL/Bali/Basis.thy
src/HOL/Bali/Conform.thy
src/HOL/Bali/Decl.thy
src/HOL/Bali/DeclConcepts.thy
src/HOL/Bali/Eval.thy
src/HOL/Bali/Evaln.thy
src/HOL/Bali/Example.thy
src/HOL/Bali/Name.thy
src/HOL/Bali/ROOT.ML
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 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/Bali/AxCompl.thy	Mon Jan 28 17:00:19 2002 +0100
     1.3 @@ -0,0 +1,645 @@
     1.4 +(*  Title:      isabelle/Bali/AxCompl.thy
     1.5 +    ID:         $Id$
     1.6 +    Author:     David von Oheimb
     1.7 +    Copyright   1999 Technische Universitaet Muenchen
     1.8 +*)
     1.9 +
    1.10 +header {*
    1.11 +Completeness proof for Axiomatic semantics of Java expressions and statements
    1.12 +*}
    1.13 +
    1.14 +theory AxCompl = AxSem:
    1.15 +
    1.16 +text {*
    1.17 +design issues:
    1.18 +\begin{itemize}
    1.19 +\item proof structured by Most General Formulas (-> Thomas Kleymann)
    1.20 +\end{itemize}
    1.21 +*}
    1.22 +section "set of not yet initialzed classes"
    1.23 +
    1.24 +constdefs
    1.25 +
    1.26 +  nyinitcls :: "prog \<Rightarrow> state \<Rightarrow> qtname set"
    1.27 + "nyinitcls G s \<equiv> {C. is_class G C \<and> \<not> initd C s}"
    1.28 +
    1.29 +lemma nyinitcls_subset_class: "nyinitcls G s \<subseteq> {C. is_class G C}"
    1.30 +apply (unfold nyinitcls_def)
    1.31 +apply fast
    1.32 +done
    1.33 +
    1.34 +lemmas finite_nyinitcls [simp] =
    1.35 +   finite_is_class [THEN nyinitcls_subset_class [THEN finite_subset], standard]
    1.36 +
    1.37 +lemma card_nyinitcls_bound: "card (nyinitcls G s) \<le> card {C. is_class G C}"
    1.38 +apply (rule nyinitcls_subset_class [THEN finite_is_class [THEN card_mono]])
    1.39 +done
    1.40 +
    1.41 +lemma nyinitcls_set_locals_cong [simp]: 
    1.42 +  "nyinitcls G (x,set_locals l s) = nyinitcls G (x,s)"
    1.43 +apply (unfold nyinitcls_def)
    1.44 +apply (simp (no_asm))
    1.45 +done
    1.46 +
    1.47 +lemma nyinitcls_abrupt_cong [simp]: "nyinitcls G (f x, y) = nyinitcls G (x, y)"
    1.48 +apply (unfold nyinitcls_def)
    1.49 +apply (simp (no_asm))
    1.50 +done
    1.51 +
    1.52 +lemma nyinitcls_abupd_cong [simp]:"!!s. nyinitcls G (abupd f s) = nyinitcls G s"
    1.53 +apply (unfold nyinitcls_def)
    1.54 +apply (simp (no_asm_simp) only: split_tupled_all)
    1.55 +apply (simp (no_asm))
    1.56 +done
    1.57 +
    1.58 +lemma card_nyinitcls_abrupt_congE [elim!]: 
    1.59 +        "card (nyinitcls G (x, s)) \<le> n \<Longrightarrow> card (nyinitcls G (y, s)) \<le> n"
    1.60 +apply (unfold nyinitcls_def)
    1.61 +apply auto
    1.62 +done
    1.63 +
    1.64 +lemma nyinitcls_new_xcpt_var [simp]: 
    1.65 +"nyinitcls G (new_xcpt_var vn s) = nyinitcls G s"
    1.66 +apply (unfold nyinitcls_def)
    1.67 +apply (induct_tac "s")
    1.68 +apply (simp (no_asm))
    1.69 +done
    1.70 +
    1.71 +lemma nyinitcls_init_lvars [simp]: 
    1.72 +  "nyinitcls G ((init_lvars G C sig mode a' pvs) s) = nyinitcls G s"
    1.73 +apply (induct_tac "s")
    1.74 +apply (simp (no_asm) add: init_lvars_def2 split add: split_if)
    1.75 +done
    1.76 +
    1.77 +lemma nyinitcls_emptyD: "\<lbrakk>nyinitcls G s = {}; is_class G C\<rbrakk> \<Longrightarrow> initd C s"
    1.78 +apply (unfold nyinitcls_def)
    1.79 +apply fast
    1.80 +done
    1.81 +
    1.82 +lemma card_Suc_lemma: "\<lbrakk>card (insert a A) \<le> Suc n; a\<notin>A; finite A\<rbrakk> \<Longrightarrow> card A \<le> n"
    1.83 +apply (rotate_tac 1)
    1.84 +apply clarsimp
    1.85 +done
    1.86 +
    1.87 +lemma nyinitcls_le_SucD: 
    1.88 +"\<lbrakk>card (nyinitcls G (x,s)) \<le> Suc n; \<not>inited C (globs s); class G C=Some y\<rbrakk> \<Longrightarrow> 
    1.89 +  card (nyinitcls G (x,init_class_obj G C s)) \<le> n"
    1.90 +apply (subgoal_tac 
    1.91 +        "nyinitcls G (x,s) = insert C (nyinitcls G (x,init_class_obj G C s))")
    1.92 +apply  clarsimp
    1.93 +apply  (erule thin_rl)
    1.94 +apply  (rule card_Suc_lemma [OF _ _ finite_nyinitcls])
    1.95 +apply   (auto dest!: not_initedD elim!: 
    1.96 +              simp add: nyinitcls_def inited_def split add: split_if_asm)
    1.97 +done
    1.98 +
    1.99 +ML {* bind_thm("inited_gext'",permute_prems 0 1 (thm "inited_gext")) *}
   1.100 +
   1.101 +lemma nyinitcls_gext: "snd s\<le>|snd s' \<Longrightarrow> nyinitcls G s' \<subseteq> nyinitcls G s"
   1.102 +apply (unfold nyinitcls_def)
   1.103 +apply (force dest!: inited_gext')
   1.104 +done
   1.105 +
   1.106 +lemma card_nyinitcls_gext: 
   1.107 +  "\<lbrakk>snd s\<le>|snd s'; card (nyinitcls G s) \<le> n\<rbrakk>\<Longrightarrow> card (nyinitcls G s') \<le> n"
   1.108 +apply (rule le_trans)
   1.109 +apply  (rule card_mono)
   1.110 +apply   (rule finite_nyinitcls)
   1.111 +apply  (erule nyinitcls_gext)
   1.112 +apply assumption
   1.113 +done
   1.114 +
   1.115 +
   1.116 +section "init-le"
   1.117 +
   1.118 +constdefs
   1.119 +  init_le :: "prog \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> bool"            ("_\<turnstile>init\<le>_"  [51,51] 50)
   1.120 + "G\<turnstile>init\<le>n \<equiv> \<lambda>s. card (nyinitcls G s) \<le> n"
   1.121 +  
   1.122 +lemma init_le_def2 [simp]: "(G\<turnstile>init\<le>n) s = (card (nyinitcls G s)\<le>n)"
   1.123 +apply (unfold init_le_def)
   1.124 +apply auto
   1.125 +done
   1.126 +
   1.127 +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.128 +apply (drule spec)
   1.129 +apply (erule conseq1)
   1.130 +apply clarsimp
   1.131 +apply (rule card_nyinitcls_bound)
   1.132 +done
   1.133 +
   1.134 +section "Most General Triples and Formulas"
   1.135 +
   1.136 +constdefs
   1.137 +
   1.138 +  remember_init_state :: "state assn"                ("\<doteq>")
   1.139 +  "\<doteq> \<equiv> \<lambda>Y s Z. s = Z"
   1.140 +
   1.141 +lemma remember_init_state_def2 [simp]: "\<doteq> Y = op ="
   1.142 +apply (unfold remember_init_state_def)
   1.143 +apply (simp (no_asm))
   1.144 +done
   1.145 +
   1.146 +consts
   1.147 +  
   1.148 +  MGF ::"[state assn, term, prog] \<Rightarrow> state triple"   ("{_} _\<succ> {_\<rightarrow>}"[3,65,3]62)
   1.149 +  MGFn::"[nat       , term, prog] \<Rightarrow> state triple" ("{=:_} _\<succ> {_\<rightarrow>}"[3,65,3]62)
   1.150 +
   1.151 +defs
   1.152 +  
   1.153 +
   1.154 +  MGF_def:
   1.155 +  "{P} t\<succ> {G\<rightarrow>} \<equiv> {P} t\<succ> {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')}"
   1.156 +
   1.157 +  MGFn_def:
   1.158 +  "{=:n} t\<succ> {G\<rightarrow>} \<equiv> {\<doteq> \<and>. G\<turnstile>init\<le>n} t\<succ> {G\<rightarrow>}"
   1.159 +
   1.160 +(* unused *)
   1.161 +lemma MGF_valid: "G,{}\<Turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.162 +apply (unfold MGF_def)
   1.163 +apply (force dest!: evaln_eval simp add: ax_valids_def triple_valid_def2)
   1.164 +done
   1.165 +
   1.166 +lemma MGF_res_eq_lemma [simp]: 
   1.167 +  "(\<forall>Y' Y s. Y = Y' \<and> P s \<longrightarrow> Q s) = (\<forall>s. P s \<longrightarrow> Q s)"
   1.168 +apply auto
   1.169 +done
   1.170 +
   1.171 +lemma MGFn_def2: 
   1.172 +"G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>} = G,A\<turnstile>{\<doteq> \<and>. G\<turnstile>init\<le>n} 
   1.173 +                    t\<succ> {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')}"
   1.174 +apply (unfold MGFn_def MGF_def)
   1.175 +apply fast
   1.176 +done
   1.177 +
   1.178 +lemma MGF_MGFn_iff: "G,A\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} = (\<forall>n. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>})"
   1.179 +apply (simp (no_asm_use) add: MGFn_def2 MGF_def)
   1.180 +apply safe
   1.181 +apply  (erule_tac [2] All_init_leD)
   1.182 +apply (erule conseq1)
   1.183 +apply clarsimp
   1.184 +done
   1.185 +
   1.186 +lemma MGFnD: 
   1.187 +"G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>} \<Longrightarrow>  
   1.188 + G,A\<turnstile>{(\<lambda>Y' s' s. s' = s           \<and> P s) \<and>. G\<turnstile>init\<le>n}  
   1.189 + 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.190 +apply (unfold init_le_def)
   1.191 +apply (simp (no_asm_use) add: MGFn_def2)
   1.192 +apply (erule conseq12)
   1.193 +apply clarsimp
   1.194 +apply (erule (1) eval_gext [THEN card_nyinitcls_gext])
   1.195 +done
   1.196 +lemmas MGFnD' = MGFnD [of _ _ _ _ "\<lambda>x. True"] 
   1.197 +
   1.198 +lemma MGFNormalI: "G,A\<turnstile>{Normal \<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow>  
   1.199 +  G,(A::state triple set)\<turnstile>{\<doteq>::state assn} t\<succ> {G\<rightarrow>}"
   1.200 +apply (unfold MGF_def)
   1.201 +apply (rule ax_Normal_cases)
   1.202 +apply  (erule conseq1)
   1.203 +apply  clarsimp
   1.204 +apply (rule ax_derivs.Abrupt [THEN conseq1])
   1.205 +apply (clarsimp simp add: Let_def)
   1.206 +done
   1.207 +
   1.208 +lemma MGFNormalD: "G,A\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow> G,A\<turnstile>{Normal \<doteq>} t\<succ> {G\<rightarrow>}"
   1.209 +apply (unfold MGF_def)
   1.210 +apply (erule conseq1)
   1.211 +apply clarsimp
   1.212 +done
   1.213 +
   1.214 +lemma MGFn_NormalI: 
   1.215 +"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.216 + {\<lambda>Y s' s. G\<turnstile>s \<midarrow>t\<succ>\<rightarrow> (Y,s')} \<Longrightarrow> G,A\<turnstile>{=:n}t\<succ>{G\<rightarrow>}"
   1.217 +apply (simp (no_asm_use) add: MGFn_def2)
   1.218 +apply (rule ax_Normal_cases)
   1.219 +apply  (erule conseq1)
   1.220 +apply  clarsimp
   1.221 +apply (rule ax_derivs.Abrupt [THEN conseq1])
   1.222 +apply (clarsimp simp add: Let_def)
   1.223 +done
   1.224 +
   1.225 +lemma MGFn_free_wt: 
   1.226 +  "(\<exists>T L C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) 
   1.227 +    \<longrightarrow> G,(A::state triple set)\<turnstile>{=:n} t\<succ> {G\<rightarrow>} 
   1.228 +   \<Longrightarrow> G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
   1.229 +apply (rule MGFn_NormalI)
   1.230 +apply (rule ax_free_wt)
   1.231 +apply (auto elim: conseq12 simp add: MGFn_def MGF_def)
   1.232 +done
   1.233 +
   1.234 +
   1.235 +section "main lemmas"
   1.236 +
   1.237 +declare fun_upd_apply [simp del]
   1.238 +declare splitI2 [rule del] (*prevents ugly renaming of state variables*)
   1.239 +
   1.240 +ML_setup {* 
   1.241 +Delsimprocs [eval_expr_proc, eval_var_proc, eval_exprs_proc, eval_stmt_proc]
   1.242 +*} (*prevents modifying rhs of MGF*)
   1.243 +ML {*
   1.244 +val eval_css = (claset() delrules [thm "eval.Abrupt"] addSIs (thms "eval.intros") 
   1.245 +                delrules[thm "eval.Expr", thm "eval.Init", thm "eval.Try"] 
   1.246 +                addIs   [thm "eval.Expr", thm "eval.Init"]
   1.247 +                addSEs[thm "eval.Try"] delrules[equalityCE],
   1.248 +                simpset() addsimps [split_paired_all,Let_def]
   1.249 + addsimprocs [eval_expr_proc,eval_var_proc,eval_exprs_proc,eval_stmt_proc]);
   1.250 +val eval_Force_tac = force_tac eval_css;
   1.251 +
   1.252 +val wt_prepare_tac = EVERY'[
   1.253 +    rtac (thm "MGFn_free_wt"),
   1.254 +    clarsimp_tac (claset() addSEs (thms "wt_elim_cases"), simpset())]
   1.255 +val compl_prepare_tac = EVERY'[rtac (thm "MGFn_NormalI"), Simp_tac]
   1.256 +val forw_hyp_tac = EVERY'[etac (thm "MGFnD'" RS thm "conseq12"), Clarsimp_tac]
   1.257 +val forw_hyp_eval_Force_tac = 
   1.258 +         EVERY'[TRY o rtac allI, forw_hyp_tac, eval_Force_tac]
   1.259 +*}
   1.260 +
   1.261 +lemma MGFn_Init: "\<forall>m. Suc m\<le>n \<longrightarrow> (\<forall>t. G,A\<turnstile>{=:m} t\<succ> {G\<rightarrow>}) \<Longrightarrow>  
   1.262 +  G,(A::state triple set)\<turnstile>{=:n} In1r (Init C)\<succ> {G\<rightarrow>}"
   1.263 +apply (tactic "wt_prepare_tac 1")
   1.264 +(* requires is_class G C two times for nyinitcls *)
   1.265 +apply (tactic "compl_prepare_tac 1")
   1.266 +apply (rule_tac C = "initd C" in ax_cases)
   1.267 +apply  (rule ax_derivs.Done [THEN conseq1])
   1.268 +apply  (clarsimp intro!: init_done)
   1.269 +apply (rule_tac y = n in nat.exhaust, clarsimp)
   1.270 +apply  (rule ax_impossible [THEN conseq1])
   1.271 +apply  (force dest!: nyinitcls_emptyD)
   1.272 +apply clarsimp
   1.273 +apply (drule_tac x = "nat" in spec)
   1.274 +apply clarsimp
   1.275 +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.276 +apply   simp
   1.277 +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.278 +prefer 2
   1.279 +apply   (force elim!: nyinitcls_le_SucD)
   1.280 +apply  (simp split add: split_if, rule conjI, clarify)
   1.281 +apply   (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
   1.282 +apply  clarify
   1.283 +apply  (drule spec)
   1.284 +apply  (erule MGFnD' [THEN conseq12])
   1.285 +apply  (tactic "force_tac (claset(), simpset() addsimprocs[eval_stmt_proc]) 1")
   1.286 +apply (rule allI)
   1.287 +apply (drule spec)
   1.288 +apply (erule MGFnD' [THEN conseq12])
   1.289 +apply clarsimp
   1.290 +apply (tactic {* pair_tac "sa" 1 *})
   1.291 +apply (tactic"clarsimp_tac (claset(), simpset() addsimprocs[eval_stmt_proc]) 1")
   1.292 +apply (rule eval_Init, force+)
   1.293 +done
   1.294 +lemmas MGFn_InitD = MGFn_Init [THEN MGFnD, THEN ax_NormalD]
   1.295 +
   1.296 +lemma MGFn_Call: 
   1.297 +"\<lbrakk>\<forall>C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>};  
   1.298 +  G,A\<turnstile>{=:n} In1l e\<succ> {G\<rightarrow>}; G,A\<turnstile>{=:n} In3 ps\<succ> {G\<rightarrow>}\<rbrakk> \<Longrightarrow>  
   1.299 +  G,A\<turnstile>{=:n} In1l ({statT,mode}e\<cdot>mn({pTs'}ps))\<succ> {G\<rightarrow>}"
   1.300 +apply (tactic "wt_prepare_tac 1") (* required for equating mode = invmode m e *)
   1.301 +apply (tactic "compl_prepare_tac 1")
   1.302 +apply (rule_tac R = "\<lambda>a'. (\<lambda>Y (x2,s2) (x,s) . x = None \<and> (\<exists>s1 pvs. G\<turnstile>Norm s \<midarrow>e-\<succ>a'\<rightarrow> s1 \<and> Y = In3 pvs \<and> G\<turnstile>s1 \<midarrow>ps\<doteq>\<succ>pvs\<rightarrow> (x2,s2))) \<and>. G\<turnstile>init\<le>n" in ax_derivs.Call)
   1.303 +apply  (erule MGFnD [THEN ax_NormalD])
   1.304 +apply safe
   1.305 +apply  (erule_tac V = "All ?P" in thin_rl, tactic "forw_hyp_eval_Force_tac 1")
   1.306 +apply (drule spec, drule spec)
   1.307 +apply (erule MGFnD' [THEN conseq12])
   1.308 +apply (tactic "clarsimp_tac eval_css 1")
   1.309 +apply (erule (1) eval_Call)
   1.310 +apply   (rule HOL.refl)
   1.311 +apply  (simp (no_asm_simp))+
   1.312 +done
   1.313 +
   1.314 +lemma MGF_altern: "G,A\<turnstile>{Normal (\<doteq> \<and>. p)} t\<succ> {G\<rightarrow>} =  
   1.315 + 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.316 +  t\<succ> {\<lambda>Y s Z. (Y,s) = Z}"
   1.317 +apply (unfold MGF_def)
   1.318 +apply (auto del: conjI elim!: conseq12)
   1.319 +apply (case_tac "\<exists>w s. G\<turnstile>Norm sa \<midarrow>t\<succ>\<rightarrow> (w,s) ")
   1.320 +apply  (fast dest: unique_eval)
   1.321 +apply clarsimp
   1.322 +apply (erule thin_rl)
   1.323 +apply (erule thin_rl)
   1.324 +apply (drule split_paired_All [THEN subst])
   1.325 +apply (clarsimp elim!: state_not_single)
   1.326 +done
   1.327 +
   1.328 +
   1.329 +lemma MGFn_Loop: 
   1.330 +"\<lbrakk>G,(A::state triple set)\<turnstile>{=:n} In1l expr\<succ> {G\<rightarrow>};G,A\<turnstile>{=:n} In1r stmnt\<succ> {G\<rightarrow>} \<rbrakk> 
   1.331 +\<Longrightarrow> 
   1.332 +  G,A\<turnstile>{=:n} In1r (l\<bullet> While(expr) stmnt)\<succ> {G\<rightarrow>}"
   1.333 +apply (rule MGFn_NormalI, simp)
   1.334 +apply (rule_tac p2 = "\<lambda>s. card (nyinitcls G s) \<le> n" in 
   1.335 +          MGF_altern [unfolded MGF_def, THEN iffD2, THEN conseq1])
   1.336 +prefer 2
   1.337 +apply  clarsimp
   1.338 +apply (rule_tac P' = 
   1.339 +"((\<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.340 +  \<and>. (\<lambda>s. card (nyinitcls G s) \<le> n))" in conseq12)
   1.341 +prefer 2
   1.342 +apply  clarsimp
   1.343 +apply  (tactic "smp_tac 1 1", erule_tac V = "All ?P" in thin_rl)
   1.344 +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.345 +apply   (force dest!: eval.Loop split add: split_if_asm)
   1.346 +prefer 2
   1.347 +apply  (erule MGFnD' [THEN conseq12])
   1.348 +apply  clarsimp
   1.349 +apply  (erule_tac V = "card (nyinitcls G s') \<le> n" in thin_rl)
   1.350 +apply  (tactic "eval_Force_tac 1")
   1.351 +apply (erule MGFnD' [THEN conseq12] , clarsimp)
   1.352 +apply (rule conjI, erule exI)
   1.353 +apply (tactic "clarsimp_tac eval_css 1")
   1.354 +apply (case_tac "a")
   1.355 +prefer 2
   1.356 +apply  (clarsimp)
   1.357 +apply (clarsimp split add: split_if)
   1.358 +apply (rule conjI, (tactic {* force_tac (claset() addSDs [thm "eval.Loop"],
   1.359 +  simpset() addsimps [split_paired_all] addsimprocs [eval_stmt_proc]) 1*})+)
   1.360 +done
   1.361 +
   1.362 +lemma MGFn_lemma [rule_format (no_asm)]: 
   1.363 + "\<forall>n C sig. G,(A::state triple set)\<turnstile>{=:n} In1l (Methd C sig)\<succ> {G\<rightarrow>} \<Longrightarrow>  
   1.364 +  \<forall>t. G,A\<turnstile>{=:n} t\<succ> {G\<rightarrow>}"
   1.365 +apply (rule full_nat_induct)
   1.366 +apply (rule allI)
   1.367 +apply (drule_tac x = n in spec)
   1.368 +apply (drule_tac psi = "All ?P" in asm_rl)
   1.369 +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.370 +apply  (tactic "Clarify_tac 2")
   1.371 +apply  (induct_tac "t")
   1.372 +apply    (induct_tac "a")
   1.373 +apply     fast+
   1.374 +apply (rule var_expr_stmt.induct)
   1.375 +(* 28 subgoals *)
   1.376 +prefer 14 apply fast (* Methd *)
   1.377 +prefer 13 apply (erule (2) MGFn_Call)
   1.378 +apply (erule_tac [!] V = "All ?P" in thin_rl) (* assumptions on Methd *)
   1.379 +apply (erule_tac [24] MGFn_Init)
   1.380 +prefer 19 apply (erule (1) MGFn_Loop)
   1.381 +apply (tactic "ALLGOALS compl_prepare_tac")
   1.382 +
   1.383 +apply (rule ax_derivs.LVar [THEN conseq1], tactic "eval_Force_tac 1")
   1.384 +
   1.385 +apply (rule ax_derivs.FVar)
   1.386 +apply  (erule MGFn_InitD)
   1.387 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.388 +
   1.389 +apply (rule ax_derivs.AVar)
   1.390 +apply  (erule MGFnD [THEN ax_NormalD])
   1.391 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.392 +
   1.393 +apply (rule ax_derivs.NewC)
   1.394 +apply (erule MGFn_InitD [THEN conseq2])
   1.395 +apply (tactic "eval_Force_tac 1")
   1.396 +
   1.397 +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.398 +apply  (simp add: init_comp_ty_def split add: split_if)
   1.399 +apply   (rule conjI, clarsimp)
   1.400 +apply   (erule MGFn_InitD [THEN conseq2])
   1.401 +apply   (tactic "clarsimp_tac eval_css 1")
   1.402 +apply  clarsimp
   1.403 +apply  (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
   1.404 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.405 +
   1.406 +apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Cast],tactic"eval_Force_tac 1")
   1.407 +
   1.408 +apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Inst],tactic"eval_Force_tac 1")
   1.409 +apply (rule ax_derivs.Lit [THEN conseq1], tactic "eval_Force_tac 1")
   1.410 +apply (rule ax_derivs.Super [THEN conseq1], tactic "eval_Force_tac 1")
   1.411 +apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Acc],tactic"eval_Force_tac 1")
   1.412 +
   1.413 +apply (rule ax_derivs.Ass)
   1.414 +apply  (erule MGFnD [THEN ax_NormalD])
   1.415 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.416 +
   1.417 +apply (rule ax_derivs.Cond)
   1.418 +apply  (erule MGFnD [THEN ax_NormalD])
   1.419 +apply (rule allI)
   1.420 +apply (rule ax_Normal_cases)
   1.421 +prefer 2
   1.422 +apply  (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
   1.423 +apply  (tactic "eval_Force_tac 1")
   1.424 +apply (case_tac "b")
   1.425 +apply  (simp, tactic "forw_hyp_eval_Force_tac 1")
   1.426 +apply (simp, tactic "forw_hyp_eval_Force_tac 1")
   1.427 +
   1.428 +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.429 + apply (erule MGFn_InitD [THEN conseq2])
   1.430 + apply (tactic "eval_Force_tac 1")
   1.431 +apply (tactic "forw_hyp_tac 1")
   1.432 +apply (tactic {* clarsimp_tac (eval_css delsimps2 [split_paired_all]) 1 *})
   1.433 +apply (erule (1) eval.Body)
   1.434 +
   1.435 +apply (rule ax_derivs.Skip [THEN conseq1], tactic "eval_Force_tac 1")
   1.436 +
   1.437 +apply (erule MGFnD'[THEN conseq12,THEN ax_derivs.Expr],tactic"eval_Force_tac 1")
   1.438 +
   1.439 +apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Lab])
   1.440 +apply (tactic "clarsimp_tac eval_css 1")
   1.441 +
   1.442 +apply (rule ax_derivs.Comp)
   1.443 +apply  (erule MGFnD [THEN ax_NormalD])
   1.444 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.445 +
   1.446 +apply (rule ax_derivs.If)
   1.447 +apply  (erule MGFnD [THEN ax_NormalD])
   1.448 +apply (rule allI)
   1.449 +apply (rule ax_Normal_cases)
   1.450 +prefer 2
   1.451 +apply  (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
   1.452 +apply  (tactic "eval_Force_tac 1")
   1.453 +apply (case_tac "b")
   1.454 +apply  (simp, tactic "forw_hyp_eval_Force_tac 1")
   1.455 +apply (simp, tactic "forw_hyp_eval_Force_tac 1")
   1.456 +
   1.457 +apply (rule ax_derivs.Do [THEN conseq1])
   1.458 +apply (tactic {* force_tac (eval_css addsimps2 [thm "abupd_def2"]) 1 *})
   1.459 +
   1.460 +apply (erule MGFnD' [THEN conseq12, THEN ax_derivs.Throw])
   1.461 +apply (tactic "clarsimp_tac eval_css 1")
   1.462 +
   1.463 +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.464 +apply   (tactic "eval_Force_tac 3")
   1.465 +apply  (tactic "forw_hyp_eval_Force_tac 2")
   1.466 +apply (erule MGFnD [THEN ax_NormalD, THEN conseq2])
   1.467 +apply (tactic "clarsimp_tac eval_css 1")
   1.468 +apply (force elim: sxalloc_gext [THEN card_nyinitcls_gext])
   1.469 +
   1.470 +apply (rule_tac Q = " (\<lambda>Y' s' s. normal s \<and> G\<turnstile>s \<midarrow>stmt1\<rightarrow> s') \<and>. G\<turnstile>init\<le>n" in ax_derivs.Fin)
   1.471 +apply  (tactic "forw_hyp_eval_Force_tac 1")
   1.472 +apply (rule allI)
   1.473 +apply (tactic "forw_hyp_tac 1")
   1.474 +apply (tactic {* pair_tac "sb" 1 *})
   1.475 +apply (tactic"clarsimp_tac (claset(),simpset() addsimprocs [eval_stmt_proc]) 1")
   1.476 +apply (drule (1) eval.Fin)
   1.477 +apply clarsimp
   1.478 +
   1.479 +apply (rule ax_derivs.Nil [THEN conseq1], tactic "eval_Force_tac 1")
   1.480 +
   1.481 +apply (rule ax_derivs.Cons)
   1.482 +apply  (erule MGFnD [THEN ax_NormalD])
   1.483 +apply (tactic "forw_hyp_eval_Force_tac 1")
   1.484 +done
   1.485 +
   1.486 +lemma MGF_asm: "\<forall>C sig. is_methd G C sig \<longrightarrow> G,A\<turnstile>{\<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>} \<Longrightarrow>
   1.487 +  G,(A::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.488 +apply (simp (no_asm_use) add: MGF_MGFn_iff)
   1.489 +apply (rule allI)
   1.490 +apply (rule MGFn_lemma)
   1.491 +apply (intro strip)
   1.492 +apply (rule MGFn_free_wt)
   1.493 +apply (force dest: wt_Methd_is_methd)
   1.494 +done
   1.495 +
   1.496 +declare splitI2 [intro!]
   1.497 +ML_setup {*
   1.498 +Addsimprocs [ eval_expr_proc, eval_var_proc, eval_exprs_proc, eval_stmt_proc]
   1.499 +*}
   1.500 +
   1.501 +
   1.502 +section "nested version"
   1.503 +
   1.504 +lemma nesting_lemma' [rule_format (no_asm)]: "[| !!A ts. ts <= A ==> P A ts; 
   1.505 +  !!A pn. !b:bdy pn. P (insert (mgf_call pn) A) {mgf b} ==> P A {mgf_call pn}; 
   1.506 +  !!A t. !pn:U. P A {mgf_call pn} ==> P A {mgf t};  
   1.507 +          finite U; uA = mgf_call`U |] ==>  
   1.508 +  !A. A <= uA --> n <= card uA --> card A = card uA - n --> (!t. P A {mgf t})"
   1.509 +proof -
   1.510 +  assume ax_derivs_asm:    "!!A ts. ts <= A ==> P A ts"
   1.511 +  assume MGF_nested_Methd: "!!A pn. !b:bdy pn. P (insert (mgf_call pn) A) 
   1.512 +                                                  {mgf b} ==> P A {mgf_call pn}"
   1.513 +  assume MGF_asm:          "!!A t. !pn:U. P A {mgf_call pn} ==> P A {mgf t}"
   1.514 +  assume "finite U" "uA = mgf_call`U"
   1.515 +  then show ?thesis
   1.516 +    apply -
   1.517 +    apply (induct_tac "n")
   1.518 +    apply  (tactic "ALLGOALS Clarsimp_tac")
   1.519 +    apply  (tactic "dtac (permute_prems 0 1 card_seteq) 1")
   1.520 +    apply    simp
   1.521 +    apply   (erule finite_imageI)
   1.522 +    apply  (simp add: MGF_asm ax_derivs_asm)
   1.523 +    apply (rule MGF_asm)
   1.524 +    apply (rule ballI)
   1.525 +    apply (case_tac "mgf_call pn : A")
   1.526 +    apply  (fast intro: ax_derivs_asm)
   1.527 +    apply (rule MGF_nested_Methd)
   1.528 +    apply (rule ballI)
   1.529 +    apply (drule spec, erule impE, erule_tac [2] impE, erule_tac [3] impE, 
   1.530 +           erule_tac [4] spec)
   1.531 +    apply   fast
   1.532 +    apply  (erule Suc_leD)
   1.533 +    apply (drule finite_subset)
   1.534 +    apply (erule finite_imageI)
   1.535 +    apply auto
   1.536 +    apply arith
   1.537 +  done
   1.538 +qed
   1.539 +
   1.540 +lemma nesting_lemma [rule_format (no_asm)]: "[| !!A ts. ts <= A ==> P A ts; 
   1.541 +  !!A pn. !b:bdy pn. P (insert (mgf (f pn)) A) {mgf b} ==> P A {mgf (f pn)}; 
   1.542 +          !!A t. !pn:U. P A {mgf (f pn)} ==> P A {mgf t}; 
   1.543 +          finite U |] ==> P {} {mgf t}"
   1.544 +proof -
   1.545 +  assume 2: "!!A pn. !b:bdy pn. P (insert (mgf (f pn)) A) {mgf b} ==> P A {mgf (f pn)}"
   1.546 +  assume 3: "!!A t. !pn:U. P A {mgf (f pn)} ==> P A {mgf t}"
   1.547 +  assume "!!A ts. ts <= A ==> P A ts" "finite U"
   1.548 +  then show ?thesis
   1.549 +    apply -
   1.550 +    apply (rule_tac mgf = "mgf" in nesting_lemma')
   1.551 +    apply (erule_tac [2] 2)
   1.552 +    apply (rule_tac [2] 3)
   1.553 +    apply (rule_tac [6] le_refl)
   1.554 +    apply auto
   1.555 +  done
   1.556 +qed
   1.557 +
   1.558 +lemma MGF_nested_Methd: "\<lbrakk>  
   1.559 +  G,insert ({Normal \<doteq>} In1l (Methd  C sig) \<succ>{G\<rightarrow>}) A\<turnstile>  
   1.560 +            {Normal \<doteq>} In1l (body G C sig) \<succ>{G\<rightarrow>}  
   1.561 + \<rbrakk> \<Longrightarrow>  G,A\<turnstile>{Normal \<doteq>} In1l (Methd  C sig) \<succ>{G\<rightarrow>}"
   1.562 +apply (unfold MGF_def)
   1.563 +apply (rule ax_MethdN)
   1.564 +apply (erule conseq2)
   1.565 +apply clarsimp
   1.566 +apply (erule MethdI)
   1.567 +done
   1.568 +
   1.569 +lemma MGF_deriv: "ws_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.570 +apply (rule MGFNormalI)
   1.571 +apply (rule_tac mgf = "\<lambda>t. {Normal \<doteq>} t\<succ> {G\<rightarrow>}" and 
   1.572 +                bdy = "\<lambda> (C,sig) .{In1l (body G C sig) }" and 
   1.573 +                f = "\<lambda> (C,sig) . In1l (Methd C sig) " in nesting_lemma)
   1.574 +apply    (erule ax_derivs.asm)
   1.575 +apply   (clarsimp simp add: split_tupled_all)
   1.576 +apply   (erule MGF_nested_Methd)
   1.577 +apply  (erule_tac [2] finite_is_methd)
   1.578 +apply (rule MGF_asm [THEN MGFNormalD])
   1.579 +apply clarify
   1.580 +apply (rule MGFNormalI)
   1.581 +apply force
   1.582 +done
   1.583 +
   1.584 +
   1.585 +section "simultaneous version"
   1.586 +
   1.587 +lemma MGF_simult_Methd_lemma: "finite ms \<Longrightarrow>  
   1.588 +  G,A\<union> (\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd  C sig)\<succ> {G\<rightarrow>}) ` ms  
   1.589 +     |\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (body G C sig)\<succ> {G\<rightarrow>}) ` ms \<Longrightarrow>  
   1.590 +  G,A|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd  C sig)\<succ> {G\<rightarrow>}) ` ms"
   1.591 +apply (unfold MGF_def)
   1.592 +apply (rule ax_derivs.Methd [unfolded mtriples_def])
   1.593 +apply (erule ax_finite_pointwise)
   1.594 +prefer 2
   1.595 +apply  (rule ax_derivs.asm)
   1.596 +apply  fast
   1.597 +apply clarsimp
   1.598 +apply (rule conseq2)
   1.599 +apply  (erule (1) ax_methods_spec)
   1.600 +apply clarsimp
   1.601 +apply (erule eval_Methd)
   1.602 +done
   1.603 +
   1.604 +lemma MGF_simult_Methd: "ws_prog G \<Longrightarrow> 
   1.605 +   G,({}::state triple set)|\<turnstile>(\<lambda>(C,sig). {Normal \<doteq>} In1l (Methd C sig)\<succ> {G\<rightarrow>}) 
   1.606 +   ` Collect (split (is_methd G)) "
   1.607 +apply (frule finite_is_methd)
   1.608 +apply (rule MGF_simult_Methd_lemma)
   1.609 +apply  assumption
   1.610 +apply (erule ax_finite_pointwise)
   1.611 +prefer 2
   1.612 +apply  (rule ax_derivs.asm)
   1.613 +apply  blast
   1.614 +apply clarsimp
   1.615 +apply (rule MGF_asm [THEN MGFNormalD])
   1.616 +apply clarify
   1.617 +apply (rule MGFNormalI)
   1.618 +apply force
   1.619 +done
   1.620 +
   1.621 +lemma MGF_deriv: "ws_prog G \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>}"
   1.622 +apply (rule MGF_asm)
   1.623 +apply (intro strip)
   1.624 +apply (rule MGFNormalI)
   1.625 +apply (rule ax_derivs.weaken)
   1.626 +apply  (erule MGF_simult_Methd)
   1.627 +apply force
   1.628 +done
   1.629 +
   1.630 +
   1.631 +section "corollaries"
   1.632 +
   1.633 +lemma MGF_complete: "G,{}\<Turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,({}::state triple set)\<turnstile>{\<doteq>} t\<succ> {G\<rightarrow>} \<Longrightarrow>
   1.634 +  G,({}::state triple set)\<turnstile>{P::state assn} t\<succ> {Q}"
   1.635 +apply (rule ax_no_hazard)
   1.636 +apply (unfold MGF_def)
   1.637 +apply (erule conseq12)
   1.638 +apply (simp (no_asm_use) add: ax_valids_def triple_valid_def)
   1.639 +apply (fast dest!: eval_evaln)
   1.640 +done
   1.641 +
   1.642 +theorem ax_complete: "ws_prog G \<Longrightarrow>  
   1.643 +  G,{}\<Turnstile>{P::state assn} t\<succ> {Q} \<Longrightarrow> G,({}::state triple set)\<turnstile>{P} t\<succ> {Q}"
   1.644 +apply (erule MGF_complete)
   1.645 +apply (erule MGF_deriv)
   1.646 +done
   1.647 +
   1.648 +end
     2.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2 +++ b/src/HOL/Bali/AxExample.thy	Mon Jan 28 17:00:19 2002 +0100
     2.3 @@ -0,0 +1,270 @@
     2.4 +(*  Title:      isabelle/Bali/AxExample.thy
     2.5 +    ID:         $Id$
     2.6 +    Author:     David von Oheimb
     2.7 +    Copyright   2000 Technische Universitaet Muenchen
     2.8 +*)
     2.9 +header {* Example of a proof based on the Bali axiomatic semantics *}
    2.10 +
    2.11 +theory AxExample = AxSem + Example:
    2.12 +
    2.13 +constdefs
    2.14 +  arr_inv :: "st \<Rightarrow> bool"
    2.15 + "arr_inv \<equiv> \<lambda>s. \<exists>obj a T el. globs s (Stat Base) = Some obj \<and>
    2.16 +                              values obj (Inl (arr, Base)) = Some (Addr a) \<and>
    2.17 +                              heap s a = Some \<lparr>tag=Arr T 2,values=el\<rparr>"
    2.18 +
    2.19 +lemma arr_inv_new_obj: 
    2.20 +"\<And>a. \<lbrakk>arr_inv s; new_Addr (heap s)=Some a\<rbrakk> \<Longrightarrow> arr_inv (gupd(Inl a\<mapsto>x) s)"
    2.21 +apply (unfold arr_inv_def)
    2.22 +apply (force dest!: new_AddrD2)
    2.23 +done
    2.24 +
    2.25 +lemma arr_inv_set_locals [simp]: "arr_inv (set_locals l s) = arr_inv s"
    2.26 +apply (unfold arr_inv_def)
    2.27 +apply (simp (no_asm))
    2.28 +done
    2.29 +
    2.30 +lemma arr_inv_gupd_Stat [simp]: 
    2.31 +  "Base \<noteq> C \<Longrightarrow> arr_inv (gupd(Stat C\<mapsto>obj) s) = arr_inv s"
    2.32 +apply (unfold arr_inv_def)
    2.33 +apply (simp (no_asm_simp))
    2.34 +done
    2.35 +
    2.36 +lemma ax_inv_lupd [simp]: "arr_inv (lupd(x\<mapsto>y) s) = arr_inv s"
    2.37 +apply (unfold arr_inv_def)
    2.38 +apply (simp (no_asm))
    2.39 +done
    2.40 +
    2.41 +
    2.42 +declare split_if_asm [split del]
    2.43 +declare lvar_def [simp]
    2.44 +
    2.45 +ML {*
    2.46 +fun inst1_tac s t = instantiate_tac [(s,t)];
    2.47 +val ax_tac = REPEAT o rtac allI THEN'
    2.48 +             resolve_tac(thm "ax_Skip"::thm "ax_StatRef"::thm "ax_MethdN"::
    2.49 +                         thm "ax_Alloc"::thm "ax_Alloc_Arr"::
    2.50 +                         thm "ax_SXAlloc_Normal"::
    2.51 +                         funpow 7 tl (thms "ax_derivs.intros"))
    2.52 +*}
    2.53 +
    2.54 +
    2.55 +theorem ax_test: "tprg,({}::'a triple set)\<turnstile> 
    2.56 +  {Normal (\<lambda>Y s Z::'a. heap_free four s \<and> \<not>initd Base s \<and> \<not> initd Ext s)} 
    2.57 +  .test [Class Base]. {\<lambda>Y s Z. abrupt s = Some (Xcpt (Std IndOutBound))}"
    2.58 +apply (unfold test_def arr_viewed_from_def)
    2.59 +apply (tactic "ax_tac 1" (*;;*))
    2.60 +defer
    2.61 +apply  (tactic "ax_tac 1" (* Try *))
    2.62 +defer
    2.63 +apply    (tactic {* inst1_tac "Q1" 
    2.64 +                 "\<lambda>Y s Z. arr_inv (snd s) \<and> tprg,s\<turnstile>catch SXcpt NullPointer" *})
    2.65 +prefer 2
    2.66 +apply    simp
    2.67 +apply   (rule_tac P' = "Normal (\<lambda>Y s Z. arr_inv (snd s))" in conseq1)
    2.68 +prefer 2
    2.69 +apply    clarsimp
    2.70 +apply   (rule_tac Q' = "(\<lambda>Y s Z. ?Q Y s Z)\<leftarrow>=False\<down>=\<diamondsuit>" in conseq2)
    2.71 +prefer 2
    2.72 +apply    simp
    2.73 +apply   (tactic "ax_tac 1" (* While *))
    2.74 +prefer 2
    2.75 +apply    (rule ax_impossible [THEN conseq1], clarsimp)
    2.76 +apply   (rule_tac P' = "Normal ?P" in conseq1)
    2.77 +prefer 2
    2.78 +apply    clarsimp
    2.79 +apply   (tactic "ax_tac 1")
    2.80 +apply   (tactic "ax_tac 1" (* AVar *))
    2.81 +prefer 2
    2.82 +apply    (rule ax_subst_Val_allI)
    2.83 +apply    (tactic {* inst1_tac "P'21" "\<lambda>u a. Normal (?PP a\<leftarrow>?x) u" *})
    2.84 +apply    (simp del: avar_def2 peek_and_def2)
    2.85 +apply    (tactic "ax_tac 1")
    2.86 +apply   (tactic "ax_tac 1")
    2.87 +      (* just for clarification: *)
    2.88 +apply   (rule_tac Q' = "Normal (\<lambda>Var:(v, f) u ua. fst (snd (avar tprg (Intg 2) v u)) = Some (Xcpt (Std IndOutBound)))" in conseq2)
    2.89 +prefer 2
    2.90 +apply    (clarsimp simp add: split_beta)
    2.91 +apply   (tactic "ax_tac 1" (* FVar *))
    2.92 +apply    (tactic "ax_tac 2" (* StatRef *))
    2.93 +apply   (rule ax_derivs.Done [THEN conseq1])
    2.94 +apply   (clarsimp simp add: arr_inv_def inited_def in_bounds_def)
    2.95 +defer
    2.96 +apply  (rule ax_SXAlloc_catch_SXcpt)
    2.97 +apply  (rule_tac Q' = "(\<lambda>Y (x, s) Z. x = Some (Xcpt (Std NullPointer)) \<and> arr_inv s) \<and>. heap_free two" in conseq2)
    2.98 +prefer 2
    2.99 +apply   (simp add: arr_inv_new_obj)
   2.100 +apply  (tactic "ax_tac 1") 
   2.101 +apply  (rule_tac C = "Ext" in ax_Call_known_DynT)
   2.102 +apply     (unfold DynT_prop_def)
   2.103 +apply     (simp (no_asm))
   2.104 +apply    (intro strip)
   2.105 +apply    (rule_tac P' = "Normal ?P" in conseq1)
   2.106 +apply     (tactic "ax_tac 1" (* Methd *))
   2.107 +apply     (rule ax_thin [OF _ empty_subsetI])
   2.108 +apply     (simp (no_asm) add: body_def2)
   2.109 +apply     (tactic "ax_tac 1" (* Body *))
   2.110 +(* apply       (rule_tac [2] ax_derivs.Abrupt) *)
   2.111 +defer
   2.112 +apply      (simp (no_asm))
   2.113 +apply      (tactic "ax_tac 1")
   2.114 +apply      (tactic "ax_tac 1") (* Ass *)
   2.115 +prefer 2
   2.116 +apply       (rule ax_subst_Var_allI)
   2.117 +apply       (tactic {* inst1_tac "P'27" "\<lambda>a vs l vf. ?PP a vs l vf\<leftarrow>?x \<and>. ?p" *})
   2.118 +apply       (rule allI)
   2.119 +apply       (tactic {* simp_tac (simpset() delloop "split_all_tac" delsimps [thm "peek_and_def2"]) 1 *})
   2.120 +apply       (rule ax_derivs.Abrupt)
   2.121 +apply      (simp (no_asm))
   2.122 +apply      (tactic "ax_tac 1" (* FVar *))
   2.123 +apply       (tactic "ax_tac 2", tactic "ax_tac 2", tactic "ax_tac 2")
   2.124 +apply      (tactic "ax_tac 1")
   2.125 +apply     clarsimp
   2.126 +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.127 +prefer 5
   2.128 +apply     (rule ax_derivs.Done [THEN conseq1], force)
   2.129 +apply    force
   2.130 +apply   (rule ax_subst_Val_allI)
   2.131 +apply   (tactic {* inst1_tac "P'33" "\<lambda>u a. Normal (?PP a\<leftarrow>?x) u" *})
   2.132 +apply   (simp (no_asm) del: peek_and_def2)
   2.133 +apply   (tactic "ax_tac 1")
   2.134 +prefer 2
   2.135 +apply   (rule ax_subst_Val_allI)
   2.136 +apply    (tactic {* inst1_tac "P'4" "\<lambda>aa v. Normal (?QQ aa v\<leftarrow>?y)" *})
   2.137 +apply    (simp del: peek_and_def2)
   2.138 +apply    (tactic "ax_tac 1")
   2.139 +apply   (tactic "ax_tac 1")
   2.140 +apply  (tactic "ax_tac 1")
   2.141 +apply  (tactic "ax_tac 1")
   2.142 +(* end method call *)
   2.143 +apply (simp (no_asm))
   2.144 +    (* just for clarification: *)
   2.145 +apply (rule_tac Q' = "Normal ((\<lambda>Y (x, s) Z. arr_inv s \<and> (\<exists>a. the (locals s (VName e)) = Addr a \<and> obj_class (the (globs s (Inl a))) = Ext \<and> 
   2.146 + invocation_declclass tprg IntVir s (the (locals s (VName e))) (ClassT Base)  
   2.147 +     \<lparr>name = foo, parTs = [Class Base]\<rparr> = Ext)) \<and>. initd Ext \<and>. heap_free two)"
   2.148 +  in conseq2)
   2.149 +prefer 2
   2.150 +apply  clarsimp
   2.151 +apply (tactic "ax_tac 1")
   2.152 +apply (tactic "ax_tac 1")
   2.153 +defer
   2.154 +apply  (rule ax_subst_Var_allI)
   2.155 +apply  (tactic {* inst1_tac "P'14" "\<lambda>u vf. Normal (?PP vf \<and>. ?p) u" *})
   2.156 +apply  (simp (no_asm) del: split_paired_All peek_and_def2)
   2.157 +apply  (tactic "ax_tac 1" (* NewC *))
   2.158 +apply  (tactic "ax_tac 1" (* ax_Alloc *))
   2.159 +     (* just for clarification: *)
   2.160 +apply  (rule_tac Q' = "Normal ((\<lambda>Y s Z. arr_inv (store s) \<and> vf=lvar (VName e) (store s)) \<and>. heap_free tree \<and>. initd Ext)" in conseq2)
   2.161 +prefer 2
   2.162 +apply   (simp add: invocation_declclass_def dynmethd_def)
   2.163 +apply   (unfold dynlookup_def)
   2.164 +apply   (simp add: dynmethd_Ext_foo)
   2.165 +apply   (force elim!: arr_inv_new_obj atleast_free_SucD atleast_free_weaken)
   2.166 +     (* begin init *)
   2.167 +apply  (rule ax_InitS)
   2.168 +apply     force
   2.169 +apply    (simp (no_asm))
   2.170 +apply   (tactic {* simp_tac (simpset() delloop "split_all_tac") 1 *})
   2.171 +apply   (rule ax_Init_Skip_lemma)
   2.172 +apply  (tactic {* simp_tac (simpset() delloop "split_all_tac") 1 *})
   2.173 +apply  (rule ax_InitS [THEN conseq1] (* init Base *))
   2.174 +apply      force
   2.175 +apply     (simp (no_asm))
   2.176 +apply    (unfold arr_viewed_from_def)
   2.177 +apply    (rule allI)
   2.178 +apply    (rule_tac P' = "Normal ?P" in conseq1)
   2.179 +apply     (tactic {* simp_tac (simpset() delloop "split_all_tac") 1 *})
   2.180 +apply     (tactic "ax_tac 1")
   2.181 +apply     (tactic "ax_tac 1")
   2.182 +apply     (rule_tac [2] ax_subst_Var_allI)
   2.183 +apply      (tactic {* inst1_tac "P'29" "\<lambda>vf l vfa. Normal (?P vf l vfa)" *})
   2.184 +apply     (tactic {* simp_tac (simpset() delloop "split_all_tac" delsimps [split_paired_All, thm "peek_and_def2"]) 2 *})
   2.185 +apply      (tactic "ax_tac 2" (* NewA *))
   2.186 +apply       (tactic "ax_tac 3" (* ax_Alloc_Arr *))
   2.187 +apply       (tactic "ax_tac 3")
   2.188 +apply      (tactic {* inst1_tac "P" "\<lambda>vf l vfa. Normal (?P vf l vfa\<leftarrow>\<diamondsuit>)" *})
   2.189 +apply      (tactic {* simp_tac (simpset() delloop "split_all_tac") 2 *})
   2.190 +apply      (tactic "ax_tac 2")
   2.191 +apply     (tactic "ax_tac 1" (* FVar *))
   2.192 +apply      (tactic "ax_tac 2" (* StatRef *))
   2.193 +apply     (rule ax_derivs.Done [THEN conseq1])
   2.194 +apply     (tactic {* inst1_tac "Q22" "\<lambda>vf. Normal ((\<lambda>Y s Z. vf=lvar (VName e) (snd s)) \<and>. heap_free four \<and>. initd Base \<and>. initd Ext)" *})
   2.195 +apply     (clarsimp split del: split_if)
   2.196 +apply     (frule atleast_free_weaken [THEN atleast_free_weaken])
   2.197 +apply     (drule initedD)
   2.198 +apply     (clarsimp elim!: atleast_free_SucD simp add: arr_inv_def)
   2.199 +apply    force
   2.200 +apply   (tactic {* simp_tac (simpset() delloop "split_all_tac") 1 *})
   2.201 +apply   (rule ax_triv_Init_Object [THEN peek_and_forget2, THEN conseq1])
   2.202 +apply     (rule wf_tprg)
   2.203 +apply    clarsimp
   2.204 +apply   (tactic {* inst1_tac "P22" "\<lambda>vf. Normal ((\<lambda>Y s Z. vf = lvar (VName e) (snd s)) \<and>. heap_free four \<and>. initd Ext)" *})
   2.205 +apply   clarsimp
   2.206 +apply  (tactic {* inst1_tac "PP" "\<lambda>vf. Normal ((\<lambda>Y s Z. vf = lvar (VName e) (snd s)) \<and>. heap_free four \<and>. Not \<circ> initd Base)" *})
   2.207 +apply  clarsimp
   2.208 +     (* end init *)
   2.209 +apply (rule conseq1)
   2.210 +apply (tactic "ax_tac 1")
   2.211 +apply clarsimp
   2.212 +done
   2.213 +
   2.214 +(*
   2.215 +while (true) {
   2.216 +  if (i) {throw xcpt;}
   2.217 +  else i=j
   2.218 +}
   2.219 +*)
   2.220 +lemma Loop_Xcpt_benchmark: 
   2.221 + "Q = (\<lambda>Y (x,s) Z. x \<noteq> None \<longrightarrow> the_Bool (the (locals s i))) \<Longrightarrow>  
   2.222 +  G,({}::'a triple set)\<turnstile>{Normal (\<lambda>Y s Z::'a. True)}  
   2.223 +  .lab1\<bullet> While(Lit (Bool True)) (If(Acc (LVar i)) (Throw (Acc (LVar xcpt))) Else
   2.224 +        (Expr (Ass (LVar i) (Acc (LVar j))))). {Q}"
   2.225 +apply (rule_tac P' = "Q" and Q' = "Q\<leftarrow>=False\<down>=\<diamondsuit>" in conseq12)
   2.226 +apply  safe
   2.227 +apply  (tactic "ax_tac 1" (* Loop *))
   2.228 +apply   (rule ax_Normal_cases)
   2.229 +prefer 2
   2.230 +apply    (rule ax_derivs.Abrupt [THEN conseq1], clarsimp simp add: Let_def)
   2.231 +apply   (rule conseq1)
   2.232 +apply    (tactic "ax_tac 1")
   2.233 +apply   clarsimp
   2.234 +prefer 2
   2.235 +apply  clarsimp
   2.236 +apply (tactic "ax_tac 1" (* If *))
   2.237 +apply  (tactic 
   2.238 +  {* inst1_tac "P'21" "Normal (\<lambda>s.. (\<lambda>Y s Z. True)\<down>=Val (the (locals s i)))" *})
   2.239 +apply  (tactic "ax_tac 1")
   2.240 +apply  (rule conseq1)
   2.241 +apply   (tactic "ax_tac 1")
   2.242 +apply  clarsimp
   2.243 +apply (rule allI)
   2.244 +apply (rule ax_escape)
   2.245 +apply auto
   2.246 +apply  (rule conseq1)
   2.247 +apply   (tactic "ax_tac 1" (* Throw *))
   2.248 +apply   (tactic "ax_tac 1")
   2.249 +apply   (tactic "ax_tac 1")
   2.250 +apply  clarsimp
   2.251 +apply (rule_tac Q' = "Normal (\<lambda>Y s Z. True)" in conseq2)
   2.252 +prefer 2
   2.253 +apply  clarsimp
   2.254 +apply (rule conseq1)
   2.255 +apply  (tactic "ax_tac 1")
   2.256 +apply  (tactic "ax_tac 1")
   2.257 +prefer 2
   2.258 +apply   (rule ax_subst_Var_allI)
   2.259 +apply   (tactic {* inst1_tac "P'29" "\<lambda>b Y ba Z vf. \<lambda>Y (x,s) Z. x=None \<and> snd vf = snd (lvar i s)" *})
   2.260 +apply   (rule allI)
   2.261 +apply   (rule_tac P' = "Normal ?P" in conseq1)
   2.262 +prefer 2
   2.263 +apply    clarsimp
   2.264 +apply   (tactic "ax_tac 1")
   2.265 +apply   (rule conseq1)
   2.266 +apply    (tactic "ax_tac 1")
   2.267 +apply   clarsimp
   2.268 +apply  (tactic "ax_tac 1")
   2.269 +apply clarsimp
   2.270 +done
   2.271 +
   2.272 +end
   2.273 +
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/src/HOL/Bali/AxSem.thy	Mon Jan 28 17:00:19 2002 +0100
     3.3 @@ -0,0 +1,1191 @@
     3.4 +(*  Title:      isabelle/Bali/AxSem.thy
     3.5 +    ID:         $Id$
     3.6 +    Author:     David von Oheimb
     3.7 +    Copyright   1998 Technische Universitaet Muenchen
     3.8 +*)
     3.9 +
    3.10 +header {* Axiomatic semantics of Java expressions and statements 
    3.11 +          (see also Eval.thy)
    3.12 +        *}
    3.13 +
    3.14 +theory AxSem = Evaln + TypeSafe:
    3.15 +
    3.16 +text {*
    3.17 +design issues:
    3.18 +\begin{itemize}
    3.19 +\item a strong version of validity for triples with premises, namely one that 
    3.20 +      takes the recursive depth needed to complete execution, enables 
    3.21 +      correctness proof
    3.22 +\item auxiliary variables are handled first-class (-> Thomas Kleymann)
    3.23 +\item expressions not flattened to elementary assignments (as usual for 
    3.24 +      axiomatic semantics) but treated first-class => explicit result value 
    3.25 +      handling
    3.26 +\item intermediate values not on triple, but on assertion level 
    3.27 +      (with result entry)
    3.28 +\item multiple results with semantical substitution mechnism not requiring a 
    3.29 +      stack 
    3.30 +\item because of dynamic method binding, terms need to be dependent on state.
    3.31 +  this is also useful for conditional expressions and statements
    3.32 +\item result values in triples exactly as in eval relation (also for xcpt 
    3.33 +      states)
    3.34 +\item validity: additional assumption of state conformance and well-typedness,
    3.35 +  which is required for soundness and thus rule hazard required of completeness
    3.36 +\end{itemize}
    3.37 +
    3.38 +restrictions:
    3.39 +\begin{itemize}
    3.40 +\item all triples in a derivation are of the same type (due to weak 
    3.41 +      polymorphism)
    3.42 +\end{itemize}
    3.43 +*}
    3.44 +
    3.45 +
    3.46 +
    3.47 +types  res = vals (* result entry *)
    3.48 +syntax
    3.49 +  Val  :: "val      \<Rightarrow> res"
    3.50 +  Var  :: "var      \<Rightarrow> res"
    3.51 +  Vals :: "val list \<Rightarrow> res"
    3.52 +translations
    3.53 +  "Val  x"     => "(In1 x)"
    3.54 +  "Var  x"     => "(In2 x)"
    3.55 +  "Vals x"     => "(In3 x)"
    3.56 +
    3.57 +syntax
    3.58 +  "Val_"    :: "[pttrn] => pttrn"     ("Val:_"  [951] 950)
    3.59 +  "Var_"    :: "[pttrn] => pttrn"     ("Var:_"  [951] 950)
    3.60 +  "Vals_"   :: "[pttrn] => pttrn"     ("Vals:_" [951] 950)
    3.61 +
    3.62 +translations
    3.63 +  "\<lambda>Val:v . b"  == "(\<lambda>v. b) \<circ> the_In1"
    3.64 +  "\<lambda>Var:v . b"  == "(\<lambda>v. b) \<circ> the_In2"
    3.65 +  "\<lambda>Vals:v. b"  == "(\<lambda>v. b) \<circ> the_In3"
    3.66 +
    3.67 +  (* relation on result values, state and auxiliary variables *)
    3.68 +types 'a assn   =        "res \<Rightarrow> state \<Rightarrow> 'a \<Rightarrow> bool"
    3.69 +translations
    3.70 +      "res"    <= (type) "AxSem.res"
    3.71 +      "a assn" <= (type) "vals \<Rightarrow> state \<Rightarrow> a \<Rightarrow> bool"
    3.72 +
    3.73 +constdefs
    3.74 +  assn_imp   :: "'a assn \<Rightarrow> 'a assn \<Rightarrow> bool"             (infixr "\<Rightarrow>" 25)
    3.75 + "P \<Rightarrow> Q \<equiv> \<forall>Y s Z. P Y s Z \<longrightarrow> Q Y s Z"
    3.76 +  
    3.77 +lemma assn_imp_def2 [iff]: "(P \<Rightarrow> Q) = (\<forall>Y s Z. P Y s Z \<longrightarrow> Q Y s Z)"
    3.78 +apply (unfold assn_imp_def)
    3.79 +apply (rule HOL.refl)
    3.80 +done
    3.81 +
    3.82 +
    3.83 +section "assertion transformers"
    3.84 +
    3.85 +subsection "peek-and"
    3.86 +
    3.87 +constdefs
    3.88 +  peek_and   :: "'a assn \<Rightarrow> (state \<Rightarrow>  bool) \<Rightarrow> 'a assn" (infixl "\<and>." 13)
    3.89 + "P \<and>. p \<equiv> \<lambda>Y s Z. P Y s Z \<and> p s"
    3.90 +
    3.91 +lemma peek_and_def2 [simp]: "peek_and P p Y s = (\<lambda>Z. (P Y s Z \<and> p s))"
    3.92 +apply (unfold peek_and_def)
    3.93 +apply (simp (no_asm))
    3.94 +done
    3.95 +
    3.96 +lemma peek_and_Not [simp]: "(P \<and>. (\<lambda>s. \<not> f s)) = (P \<and>. Not \<circ> f)"
    3.97 +apply (rule ext)
    3.98 +apply (rule ext)
    3.99 +apply (simp (no_asm))
   3.100 +done
   3.101 +
   3.102 +lemma peek_and_and [simp]: "peek_and (peek_and P p) p = peek_and P p"
   3.103 +apply (unfold peek_and_def)
   3.104 +apply (simp (no_asm))
   3.105 +done
   3.106 +
   3.107 +lemma peek_and_commut: "(P \<and>. p \<and>. q) = (P \<and>. q \<and>. p)"
   3.108 +apply (rule ext)
   3.109 +apply (rule ext)
   3.110 +apply (rule ext)
   3.111 +apply auto
   3.112 +done
   3.113 +
   3.114 +syntax
   3.115 +  Normal     :: "'a assn \<Rightarrow> 'a assn"
   3.116 +translations
   3.117 +  "Normal P" == "P \<and>. normal"
   3.118 +
   3.119 +lemma peek_and_Normal [simp]: "peek_and (Normal P) p = Normal (peek_and P p)"
   3.120 +apply (rule ext)
   3.121 +apply (rule ext)
   3.122 +apply (rule ext)
   3.123 +apply auto
   3.124 +done
   3.125 +
   3.126 +subsection "assn-supd"
   3.127 +
   3.128 +constdefs
   3.129 +  assn_supd  :: "'a assn \<Rightarrow> (state \<Rightarrow> state) \<Rightarrow> 'a assn" (infixl ";." 13)
   3.130 + "P ;. f \<equiv> \<lambda>Y s' Z. \<exists>s. P Y s Z \<and> s' = f s"
   3.131 +
   3.132 +lemma assn_supd_def2 [simp]: "assn_supd P f Y s' Z = (\<exists>s. P Y s Z \<and> s' = f s)"
   3.133 +apply (unfold assn_supd_def)
   3.134 +apply (simp (no_asm))
   3.135 +done
   3.136 +
   3.137 +subsection "supd-assn"
   3.138 +
   3.139 +constdefs
   3.140 +  supd_assn  :: "(state \<Rightarrow> state) \<Rightarrow> 'a assn \<Rightarrow> 'a assn" (infixr ".;" 13)
   3.141 + "f .; P \<equiv> \<lambda>Y s. P Y (f s)"
   3.142 +
   3.143 +
   3.144 +lemma supd_assn_def2 [simp]: "(f .; P) Y s = P Y (f s)"
   3.145 +apply (unfold supd_assn_def)
   3.146 +apply (simp (no_asm))
   3.147 +done
   3.148 +
   3.149 +lemma supd_assn_supdD [elim]: "((f .; Q) ;. f) Y s Z \<Longrightarrow> Q Y s Z"
   3.150 +apply auto
   3.151 +done
   3.152 +
   3.153 +lemma supd_assn_supdI [elim]: "Q Y s Z \<Longrightarrow> (f .; (Q ;. f)) Y s Z"
   3.154 +apply (auto simp del: split_paired_Ex)
   3.155 +done
   3.156 +
   3.157 +subsection "subst-res"
   3.158 +
   3.159 +constdefs
   3.160 +  subst_res   :: "'a assn \<Rightarrow> res \<Rightarrow> 'a assn"              ("_\<leftarrow>_"  [60,61] 60)
   3.161 + "P\<leftarrow>w \<equiv> \<lambda>Y. P w"
   3.162 +
   3.163 +lemma subst_res_def2 [simp]: "(P\<leftarrow>w) Y = P w"
   3.164 +apply (unfold subst_res_def)
   3.165 +apply (simp (no_asm))
   3.166 +done
   3.167 +
   3.168 +lemma subst_subst_res [simp]: "P\<leftarrow>w\<leftarrow>v = P\<leftarrow>w"
   3.169 +apply (rule ext)
   3.170 +apply (simp (no_asm))
   3.171 +done
   3.172 +
   3.173 +lemma peek_and_subst_res [simp]: "(P \<and>. p)\<leftarrow>w = (P\<leftarrow>w \<and>. p)"
   3.174 +apply (rule ext)
   3.175 +apply (rule ext)
   3.176 +apply (simp (no_asm))
   3.177 +done
   3.178 +
   3.179 +(*###Do not work for some strange (unification?) reason
   3.180 +lemma subst_res_Val_beta [simp]: "(\<lambda>Y. P (the_In1 Y))\<leftarrow>Val v = (\<lambda>Y. P v)"
   3.181 +apply (rule ext)
   3.182 +by simp
   3.183 +
   3.184 +lemma subst_res_Var_beta [simp]: "(\<lambda>Y. P (the_In2 Y))\<leftarrow>Var vf = (\<lambda>Y. P vf)";
   3.185 +apply (rule ext)
   3.186 +by simp
   3.187 +
   3.188 +lemma subst_res_Vals_beta [simp]: "(\<lambda>Y. P (the_In3 Y))\<leftarrow>Vals vs = (\<lambda>Y. P vs)";
   3.189 +apply (rule ext)
   3.190 +by simp
   3.191 +*)
   3.192 +
   3.193 +subsection "subst-Bool"
   3.194 +
   3.195 +constdefs
   3.196 +  subst_Bool  :: "'a assn \<Rightarrow> bool \<Rightarrow> 'a assn"             ("_\<leftarrow>=_" [60,61] 60)
   3.197 + "P\<leftarrow>=b \<equiv> \<lambda>Y s Z. \<exists>v. P (Val v) s Z \<and> (normal s \<longrightarrow> the_Bool v=b)"
   3.198 +
   3.199 +lemma subst_Bool_def2 [simp]: 
   3.200 +"(P\<leftarrow>=b) Y s Z = (\<exists>v. P (Val v) s Z \<and> (normal s \<longrightarrow> the_Bool v=b))"
   3.201 +apply (unfold subst_Bool_def)
   3.202 +apply (simp (no_asm))
   3.203 +done
   3.204 +
   3.205 +lemma subst_Bool_the_BoolI: "P (Val b) s Z \<Longrightarrow> (P\<leftarrow>=the_Bool b) Y s Z"
   3.206 +apply auto
   3.207 +done
   3.208 +
   3.209 +subsection "peek-res"
   3.210 +
   3.211 +constdefs
   3.212 +  peek_res    :: "(res \<Rightarrow> 'a assn) \<Rightarrow> 'a assn"
   3.213 + "peek_res Pf \<equiv> \<lambda>Y. Pf Y Y"
   3.214 +
   3.215 +syntax
   3.216 +"@peek_res"  :: "pttrn \<Rightarrow> 'a assn \<Rightarrow> 'a assn"            ("\<lambda>_:. _" [0,3] 3)
   3.217 +translations
   3.218 +  "\<lambda>w:. P"   == "peek_res (\<lambda>w. P)"
   3.219 +
   3.220 +lemma peek_res_def2 [simp]: "peek_res P Y = P Y Y"
   3.221 +apply (unfold peek_res_def)
   3.222 +apply (simp (no_asm))
   3.223 +done
   3.224 +
   3.225 +lemma peek_res_subst_res [simp]: "peek_res P\<leftarrow>w = P w\<leftarrow>w"
   3.226 +apply (rule ext)
   3.227 +apply (simp (no_asm))
   3.228 +done
   3.229 +
   3.230 +(* unused *)
   3.231 +lemma peek_subst_res_allI: 
   3.232 + "(\<And>a. T a (P (f a)\<leftarrow>f a)) \<Longrightarrow> \<forall>a. T a (peek_res P\<leftarrow>f a)"
   3.233 +apply (rule allI)
   3.234 +apply (simp (no_asm))
   3.235 +apply fast
   3.236 +done
   3.237 +
   3.238 +subsection "ign-res"
   3.239 +
   3.240 +constdefs
   3.241 +  ign_res    ::  "        'a assn \<Rightarrow> 'a assn"            ("_\<down>" [1000] 1000)
   3.242 +  "P\<down>        \<equiv> \<lambda>Y s Z. \<exists>Y. P Y s Z"
   3.243 +
   3.244 +lemma ign_res_def2 [simp]: "P\<down> Y s Z = (\<exists>Y. P Y s Z)"
   3.245 +apply (unfold ign_res_def)
   3.246 +apply (simp (no_asm))
   3.247 +done
   3.248 +
   3.249 +lemma ign_ign_res [simp]: "P\<down>\<down> = P\<down>"
   3.250 +apply (rule ext)
   3.251 +apply (rule ext)
   3.252 +apply (rule ext)
   3.253 +apply (simp (no_asm))
   3.254 +done
   3.255 +
   3.256 +lemma ign_subst_res [simp]: "P\<down>\<leftarrow>w = P\<down>"
   3.257 +apply (rule ext)
   3.258 +apply (rule ext)
   3.259 +apply (rule ext)
   3.260 +apply (simp (no_asm))
   3.261 +done
   3.262 +
   3.263 +lemma peek_and_ign_res [simp]: "(P \<and>. p)\<down> = (P\<down> \<and>. p)"
   3.264 +apply (rule ext)
   3.265 +apply (rule ext)
   3.266 +apply (rule ext)
   3.267 +apply (simp (no_asm))
   3.268 +done
   3.269 +
   3.270 +subsection "peek-st"
   3.271 +
   3.272 +constdefs
   3.273 +  peek_st    :: "(st \<Rightarrow> 'a assn) \<Rightarrow> 'a assn"
   3.274 + "peek_st P \<equiv> \<lambda>Y s. P (store s) Y s"
   3.275 +
   3.276 +syntax
   3.277 +"@peek_st"   :: "pttrn \<Rightarrow> 'a assn \<Rightarrow> 'a assn"            ("\<lambda>_.. _" [0,3] 3)
   3.278 +translations
   3.279 +  "\<lambda>s.. P"   == "peek_st (\<lambda>s. P)"
   3.280 +
   3.281 +lemma peek_st_def2 [simp]: "(\<lambda>s.. Pf s) Y s = Pf (store s) Y s"
   3.282 +apply (unfold peek_st_def)
   3.283 +apply (simp (no_asm))
   3.284 +done
   3.285 +
   3.286 +lemma peek_st_triv [simp]: "(\<lambda>s.. P) = P"
   3.287 +apply (rule ext)
   3.288 +apply (rule ext)
   3.289 +apply (simp (no_asm))
   3.290 +done
   3.291 +
   3.292 +lemma peek_st_st [simp]: "(\<lambda>s.. \<lambda>s'.. P s s') = (\<lambda>s.. P s s)"
   3.293 +apply (rule ext)
   3.294 +apply (rule ext)
   3.295 +apply (simp (no_asm))
   3.296 +done
   3.297 +
   3.298 +lemma peek_st_split [simp]: "(\<lambda>s.. \<lambda>Y s'. P s Y s') = (\<lambda>Y s. P (store s) Y s)"
   3.299 +apply (rule ext)
   3.300 +apply (rule ext)
   3.301 +apply (simp (no_asm))
   3.302 +done
   3.303 +
   3.304 +lemma peek_st_subst_res [simp]: "(\<lambda>s.. P s)\<leftarrow>w = (\<lambda>s.. P s\<leftarrow>w)"
   3.305 +apply (rule ext)
   3.306 +apply (simp (no_asm))
   3.307 +done
   3.308 +
   3.309 +lemma peek_st_Normal [simp]: "(\<lambda>s..(Normal (P s))) = Normal (\<lambda>s.. P s)"
   3.310 +apply (rule ext)
   3.311 +apply (rule ext)
   3.312 +apply (simp (no_asm))
   3.313 +done
   3.314 +
   3.315 +subsection "ign-res-eq"
   3.316 +
   3.317 +constdefs
   3.318 +  ign_res_eq :: "'a assn \<Rightarrow> res \<Rightarrow> 'a assn"               ("_\<down>=_"  [60,61] 60)
   3.319 + "P\<down>=w       \<equiv> \<lambda>Y:. P\<down> \<and>. (\<lambda>s. Y=w)"
   3.320 +
   3.321 +lemma ign_res_eq_def2 [simp]: "(P\<down>=w) Y s Z = ((\<exists>Y. P Y s Z) \<and> Y=w)"
   3.322 +apply (unfold ign_res_eq_def)
   3.323 +apply auto
   3.324 +done
   3.325 +
   3.326 +lemma ign_ign_res_eq [simp]: "(P\<down>=w)\<down> = P\<down>"
   3.327 +apply (rule ext)
   3.328 +apply (rule ext)
   3.329 +apply (rule ext)
   3.330 +apply (simp (no_asm))
   3.331 +done
   3.332 +
   3.333 +(* unused *)
   3.334 +lemma ign_res_eq_subst_res: "P\<down>=w\<leftarrow>w = P\<down>"
   3.335 +apply (rule ext)
   3.336 +apply (rule ext)
   3.337 +apply (rule ext)
   3.338 +apply (simp (no_asm))
   3.339 +done
   3.340 +
   3.341 +(* unused *)
   3.342 +lemma subst_Bool_ign_res_eq: "((P\<leftarrow>=b)\<down>=x) Y s Z = ((P\<leftarrow>=b) Y s Z  \<and> Y=x)"
   3.343 +apply (simp (no_asm))
   3.344 +done
   3.345 +
   3.346 +subsection "RefVar"
   3.347 +
   3.348 +constdefs
   3.349 +  RefVar    :: "(state \<Rightarrow> vvar \<times> state) \<Rightarrow> 'a assn \<Rightarrow> 'a assn"(infixr "..;" 13)
   3.350 + "vf ..; P \<equiv> \<lambda>Y s. let (v,s') = vf s in P (Var v) s'"
   3.351 + 
   3.352 +lemma RefVar_def2 [simp]: "(vf ..; P) Y s =  
   3.353 +  P (Var (fst (vf s))) (snd (vf s))"
   3.354 +apply (unfold RefVar_def Let_def)
   3.355 +apply (simp (no_asm) add: split_beta)
   3.356 +done
   3.357 +
   3.358 +subsection "allocation"
   3.359 +
   3.360 +constdefs
   3.361 +  Alloc      :: "prog \<Rightarrow> obj_tag \<Rightarrow> 'a assn \<Rightarrow> 'a assn"
   3.362 + "Alloc G otag P \<equiv> \<lambda>Y s Z.
   3.363 +                   \<forall>s' a. G\<turnstile>s \<midarrow>halloc otag\<succ>a\<rightarrow> s'\<longrightarrow> P (Val (Addr a)) s' Z"
   3.364 +
   3.365 +  SXAlloc     :: "prog \<Rightarrow> 'a assn \<Rightarrow> 'a assn"
   3.366 + "SXAlloc G P \<equiv> \<lambda>Y s Z. \<forall>s'. G\<turnstile>s \<midarrow>sxalloc\<rightarrow> s' \<longrightarrow> P Y s' Z"
   3.367 +
   3.368 +
   3.369 +lemma Alloc_def2 [simp]: "Alloc G otag P Y s Z =  
   3.370 +       (\<forall>s' a. G\<turnstile>s \<midarrow>halloc otag\<succ>a\<rightarrow> s'\<longrightarrow> P (Val (Addr a)) s' Z)"
   3.371 +apply (unfold Alloc_def)
   3.372 +apply (simp (no_asm))
   3.373 +done
   3.374 +
   3.375 +lemma SXAlloc_def2 [simp]: 
   3.376 +  "SXAlloc G P Y s Z = (\<forall>s'. G\<turnstile>s \<midarrow>sxalloc\<rightarrow> s' \<longrightarrow> P Y s' Z)"
   3.377 +apply (unfold SXAlloc_def)
   3.378 +apply (simp (no_asm))
   3.379 +done
   3.380 +
   3.381 +section "validity"
   3.382 +
   3.383 +constdefs
   3.384 +  type_ok  :: "prog \<Rightarrow> term \<Rightarrow> state \<Rightarrow> bool"
   3.385 + "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.386 +
   3.387 +datatype    'a triple = triple "('a assn)" "term" "('a assn)" (** should be
   3.388 +something like triple = \<forall>'a. triple ('a assn) term ('a assn)   **)
   3.389 +                                        ("{(1_)}/ _>/ {(1_)}"      [3,65,3]75)
   3.390 +types    'a triples = "'a triple set"
   3.391 +
   3.392 +syntax
   3.393 +
   3.394 +  var_triple   :: "['a assn, var         ,'a assn] \<Rightarrow> 'a triple"
   3.395 +                                         ("{(1_)}/ _=>/ {(1_)}"    [3,80,3] 75)
   3.396 +  expr_triple  :: "['a assn, expr        ,'a assn] \<Rightarrow> 'a triple"
   3.397 +                                         ("{(1_)}/ _->/ {(1_)}"    [3,80,3] 75)
   3.398 +  exprs_triple :: "['a assn, expr list   ,'a assn] \<Rightarrow> 'a triple"
   3.399 +                                         ("{(1_)}/ _#>/ {(1_)}"    [3,65,3] 75)
   3.400 +  stmt_triple  :: "['a assn, stmt,        'a assn] \<Rightarrow> 'a triple"
   3.401 +                                         ("{(1_)}/ ._./ {(1_)}"     [3,65,3] 75)
   3.402 +
   3.403 +syntax (xsymbols)
   3.404 +
   3.405 +  triple       :: "['a assn, term        ,'a assn] \<Rightarrow> 'a triple"
   3.406 +                                         ("{(1_)}/ _\<succ>/ {(1_)}"     [3,65,3] 75)
   3.407 +  var_triple   :: "['a assn, var         ,'a assn] \<Rightarrow> 'a triple"
   3.408 +                                         ("{(1_)}/ _=\<succ>/ {(1_)}"    [3,80,3] 75)
   3.409 +  expr_triple  :: "['a assn, expr        ,'a assn] \<Rightarrow> 'a triple"
   3.410 +                                         ("{(1_)}/ _-\<succ>/ {(1_)}"    [3,80,3] 75)
   3.411 +  exprs_triple :: "['a assn, expr list   ,'a assn] \<Rightarrow> 'a triple"
   3.412 +                                         ("{(1_)}/ _\<doteq>\<succ>/ {(1_)}"    [3,65,3] 75)
   3.413 +
   3.414 +translations
   3.415 +  "{P} e-\<succ> {Q}" == "{P} In1l e\<succ> {Q}"
   3.416 +  "{P} e=\<succ> {Q}" == "{P} In2  e\<succ> {Q}"
   3.417 +  "{P} e\<doteq>\<succ> {Q}" == "{P} In3  e\<succ> {Q}"
   3.418 +  "{P} .c. {Q}" == "{P} In1r c\<succ> {Q}"
   3.419 +
   3.420 +lemma inj_triple: "inj (\<lambda>(P,t,Q). {P} t\<succ> {Q})"
   3.421 +apply (rule injI)
   3.422 +apply auto
   3.423 +done
   3.424 +
   3.425 +lemma triple_inj_eq: "({P} t\<succ> {Q} = {P'} t'\<succ> {Q'} ) = (P=P' \<and> t=t' \<and> Q=Q')"
   3.426 +apply auto
   3.427 +done
   3.428 +
   3.429 +constdefs
   3.430 +  mtriples  :: "('c \<Rightarrow> 'sig \<Rightarrow> 'a assn) \<Rightarrow> ('c \<Rightarrow> 'sig \<Rightarrow> expr) \<Rightarrow> 
   3.431 +                ('c \<Rightarrow> 'sig \<Rightarrow> 'a assn) \<Rightarrow> ('c \<times>  'sig) set \<Rightarrow> 'a triples"
   3.432 +                                     ("{{(1_)}/ _-\<succ>/ {(1_)} | _}"[3,65,3,65]75)
   3.433 + "{{P} tf-\<succ> {Q} | ms} \<equiv> (\<lambda>(C,sig). {Normal(P C sig)} tf C sig-\<succ> {Q C sig})`ms"
   3.434 +  
   3.435 +consts
   3.436 +
   3.437 + triple_valid :: "prog \<Rightarrow> nat \<Rightarrow>        'a triple  \<Rightarrow> bool"
   3.438 +                                                (   "_\<Turnstile>_:_" [61,0, 58] 57)
   3.439 +    ax_valids :: "prog \<Rightarrow> 'b triples \<Rightarrow> 'a triples \<Rightarrow> bool"
   3.440 +                                                ("_,_|\<Turnstile>_"   [61,58,58] 57)
   3.441 +    ax_derivs :: "prog \<Rightarrow> ('b triples \<times> 'a triples) set"
   3.442 +
   3.443 +syntax
   3.444 +
   3.445 + triples_valid:: "prog \<Rightarrow> nat \<Rightarrow>         'a triples \<Rightarrow> bool"
   3.446 +                                                (  "_||=_:_" [61,0, 58] 57)
   3.447 +     ax_valid :: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triple  \<Rightarrow> bool"
   3.448 +                                                ( "_,_|=_"   [61,58,58] 57)
   3.449 +     ax_Derivs:: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triples \<Rightarrow> bool"
   3.450 +                                                ("_,_||-_"   [61,58,58] 57)
   3.451 +     ax_Deriv :: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triple  \<Rightarrow> bool"
   3.452 +                                                ( "_,_|-_"   [61,58,58] 57)
   3.453 +
   3.454 +syntax (xsymbols)
   3.455 +
   3.456 + triples_valid:: "prog \<Rightarrow> nat \<Rightarrow>         'a triples \<Rightarrow> bool"
   3.457 +                                                (  "_|\<Turnstile>_:_" [61,0, 58] 57)
   3.458 +     ax_valid :: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triple  \<Rightarrow> bool"
   3.459 +                                                ( "_,_\<Turnstile>_"   [61,58,58] 57)
   3.460 +     ax_Derivs:: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triples \<Rightarrow> bool"
   3.461 +                                                ("_,_|\<turnstile>_"   [61,58,58] 57)
   3.462 +     ax_Deriv :: "prog \<Rightarrow>  'b triples \<Rightarrow> 'a triple  \<Rightarrow> bool"
   3.463 +                                                ( "_,_\<turnstile>_"   [61,58,58] 57)
   3.464 +
   3.465 +defs  triple_valid_def:  "G\<Turnstile>n:t  \<equiv> case t of {P} t\<succ> {Q} \<Rightarrow>
   3.466 +                          \<forall>Y s Z. P Y s Z \<longrightarrow> type_ok G t s \<longrightarrow>
   3.467 +                          (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s') \<longrightarrow> Q Y' s' Z)"
   3.468 +translations         "G|\<Turnstile>n:ts" == "Ball ts (triple_valid G n)"
   3.469 +defs   ax_valids_def:"G,A|\<Turnstile>ts  \<equiv>  \<forall>n. G|\<Turnstile>n:A \<longrightarrow> G|\<Turnstile>n:ts"
   3.470 +translations         "G,A \<Turnstile>t"  == "G,A|\<Turnstile>{t}"
   3.471 +                     "G,A|\<turnstile>ts" == "(A,ts) \<in> ax_derivs G"
   3.472 +                     "G,A \<turnstile>t"  == "G,A|\<turnstile>{t}"
   3.473 +
   3.474 +lemma triple_valid_def2: "G\<Turnstile>n:{P} t\<succ> {Q} =  
   3.475 + (\<forall>Y s Z. P Y s Z 
   3.476 +  \<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.477 +  (\<forall>Y' s'. G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (Y',s')\<longrightarrow> Q Y' s' Z))"
   3.478 +apply (unfold triple_valid_def type_ok_def)
   3.479 +apply (simp (no_asm))
   3.480 +done
   3.481 +
   3.482 +
   3.483 +declare split_paired_All [simp del] split_paired_Ex [simp del] 
   3.484 +declare split_if     [split del] split_if_asm     [split del] 
   3.485 +        option.split [split del] option.split_asm [split del]
   3.486 +ML_setup {*
   3.487 +simpset_ref() := simpset() delloop "split_all_tac";
   3.488 +claset_ref () := claset () delSWrapper "split_all_tac"
   3.489 +*}
   3.490 +
   3.491 +
   3.492 +inductive "ax_derivs G" intros
   3.493 +
   3.494 +  empty: " G,A|\<turnstile>{}"
   3.495 +  insert:"\<lbrakk>G,A\<turnstile>t; G,A|\<turnstile>ts\<rbrakk> \<Longrightarrow>
   3.496 +          G,A|\<turnstile>insert t ts"
   3.497 +
   3.498 +  asm:   "ts\<subseteq>A \<Longrightarrow> G,A|\<turnstile>ts"
   3.499 +
   3.500 +(* could be added for convenience and efficiency, but is not necessary
   3.501 +  cut:   "\<lbrakk>G,A'|\<turnstile>ts; G,A|\<turnstile>A'\<rbrakk> \<Longrightarrow>
   3.502 +           G,A |\<turnstile>ts"
   3.503 +*)
   3.504 +  weaken:"\<lbrakk>G,A|\<turnstile>ts'; ts \<subseteq> ts'\<rbrakk> \<Longrightarrow> G,A|\<turnstile>ts"
   3.505 +
   3.506 +  conseq:"\<forall>Y s Z . P  Y s Z  \<longrightarrow> (\<exists>P' Q'. G,A\<turnstile>{P'} t\<succ> {Q'} \<and> (\<forall>Y' s'. 
   3.507 +         (\<forall>Y   Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow>
   3.508 +                                 Q  Y' s' Z ))
   3.509 +                                         \<Longrightarrow> G,A\<turnstile>{P } t\<succ> {Q }"
   3.510 +
   3.511 +  hazard:"G,A\<turnstile>{P \<and>. Not \<circ> type_ok G t} t\<succ> {Q}"
   3.512 +
   3.513 +  Abrupt:  "G,A\<turnstile>{P\<leftarrow>(arbitrary3 t) \<and>. Not \<circ> normal} t\<succ> {P}"
   3.514 +
   3.515 +  (* variables *)
   3.516 +  LVar:  " G,A\<turnstile>{Normal (\<lambda>s.. P\<leftarrow>Var (lvar vn s))} LVar vn=\<succ> {P}"
   3.517 +
   3.518 +  FVar: "\<lbrakk>G,A\<turnstile>{Normal P} .Init C. {Q};
   3.519 +          G,A\<turnstile>{Q} e-\<succ> {\<lambda>Val:a:. fvar C stat fn a ..; R}\<rbrakk> \<Longrightarrow>
   3.520 +                                 G,A\<turnstile>{Normal P} {C,stat}e..fn=\<succ> {R}"
   3.521 +
   3.522 +  AVar:  "\<lbrakk>G,A\<turnstile>{Normal P} e1-\<succ> {Q};
   3.523 +          \<forall>a. G,A\<turnstile>{Q\<leftarrow>Val a} e2-\<succ> {\<lambda>Val:i:. avar G i a ..; R}\<rbrakk> \<Longrightarrow>
   3.524 +                                 G,A\<turnstile>{Normal P} e1.[e2]=\<succ> {R}"
   3.525 +  (* expressions *)
   3.526 +
   3.527 +  NewC: "\<lbrakk>G,A\<turnstile>{Normal P} .Init C. {Alloc G (CInst C) Q}\<rbrakk> \<Longrightarrow>
   3.528 +                                 G,A\<turnstile>{Normal P} NewC C-\<succ> {Q}"
   3.529 +
   3.530 +  NewA: "\<lbrakk>G,A\<turnstile>{Normal P} .init_comp_ty T. {Q};  G,A\<turnstile>{Q} e-\<succ>
   3.531 +	  {\<lambda>Val:i:. abupd (check_neg i) .; Alloc G (Arr T (the_Intg i)) R}\<rbrakk> \<Longrightarrow>
   3.532 +                                 G,A\<turnstile>{Normal P} New T[e]-\<succ> {R}"
   3.533 +
   3.534 +  Cast: "\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {\<lambda>Val:v:. \<lambda>s..
   3.535 +          abupd (raise_if (\<not>G,s\<turnstile>v fits T) ClassCast) .; Q\<leftarrow>Val v}\<rbrakk> \<Longrightarrow>
   3.536 +                                 G,A\<turnstile>{Normal P} Cast T e-\<succ> {Q}"
   3.537 +
   3.538 +  Inst: "\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {\<lambda>Val:v:. \<lambda>s..
   3.539 +                  Q\<leftarrow>Val (Bool (v\<noteq>Null \<and> G,s\<turnstile>v fits RefT T))}\<rbrakk> \<Longrightarrow>
   3.540 +                                 G,A\<turnstile>{Normal P} e InstOf T-\<succ> {Q}"
   3.541 +
   3.542 +  Lit:                          "G,A\<turnstile>{Normal (P\<leftarrow>Val v)} Lit v-\<succ> {P}"
   3.543 +
   3.544 +  Super:" G,A\<turnstile>{Normal (\<lambda>s.. P\<leftarrow>Val (val_this s))} Super-\<succ> {P}"
   3.545 +
   3.546 +  Acc:  "\<lbrakk>G,A\<turnstile>{Normal P} va=\<succ> {\<lambda>Var:(v,f):. Q\<leftarrow>Val v}\<rbrakk> \<Longrightarrow>
   3.547 +                                 G,A\<turnstile>{Normal P} Acc va-\<succ> {Q}"
   3.548 +
   3.549 +  Ass:  "\<lbrakk>G,A\<turnstile>{Normal P} va=\<succ> {Q};
   3.550 +     \<forall>vf. G,A\<turnstile>{Q\<leftarrow>Var vf} e-\<succ> {\<lambda>Val:v:. assign (snd vf) v .; R}\<rbrakk> \<Longrightarrow>
   3.551 +                                 G,A\<turnstile>{Normal P} va:=e-\<succ> {R}"
   3.552 +
   3.553 +  Cond: "\<lbrakk>G,A \<turnstile>{Normal P} e0-\<succ> {P'};
   3.554 +          \<forall>b. G,A\<turnstile>{P'\<leftarrow>=b} (if b then e1 else e2)-\<succ> {Q}\<rbrakk> \<Longrightarrow>
   3.555 +                                 G,A\<turnstile>{Normal P} e0 ? e1 : e2-\<succ> {Q}"
   3.556 +
   3.557 +  Call: 
   3.558 +"\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {Q}; \<forall>a. G,A\<turnstile>{Q\<leftarrow>Val a} args\<doteq>\<succ> {R a};
   3.559 +  \<forall>a vs invC declC l. G,A\<turnstile>{(R a\<leftarrow>Vals vs \<and>.
   3.560 + (\<lambda>s. declC=invocation_declclass G mode (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr> \<and>
   3.561 +      invC = invocation_class mode (store s) a statT \<and>
   3.562 +         l = locals (store s)) ;.
   3.563 +      init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> mode a vs) \<and>.
   3.564 +      (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}
   3.565 + Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}\<rbrakk> \<Longrightarrow>
   3.566 +         G,A\<turnstile>{Normal P} {statT,mode}e\<cdot>mn({pTs}args)-\<succ> {S}"
   3.567 +
   3.568 +  Methd:"\<lbrakk>G,A\<union> {{P} Methd-\<succ> {Q} | ms} |\<turnstile> {{P} body G-\<succ> {Q} | ms}\<rbrakk> \<Longrightarrow>
   3.569 +                                 G,A|\<turnstile>{{P} Methd-\<succ>  {Q} | ms}"
   3.570 +
   3.571 +  Body: "\<lbrakk>G,A\<turnstile>{Normal P} .Init D. {Q}; 
   3.572 +  G,A\<turnstile>{Q} .c. {\<lambda>s.. abupd (absorb Ret) .; R\<leftarrow>(In1 (the (locals s Result)))}\<rbrakk> 
   3.573 +    \<Longrightarrow>
   3.574 +                                 G,A\<turnstile>{Normal P} Body D c-\<succ> {R}"
   3.575 +  
   3.576 +  (* expression lists *)
   3.577 +
   3.578 +  Nil:                          "G,A\<turnstile>{Normal (P\<leftarrow>Vals [])} []\<doteq>\<succ> {P}"
   3.579 +
   3.580 +  Cons: "\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {Q};
   3.581 +          \<forall>v. G,A\<turnstile>{Q\<leftarrow>Val v} es\<doteq>\<succ> {\<lambda>Vals:vs:. R\<leftarrow>Vals (v#vs)}\<rbrakk> \<Longrightarrow>
   3.582 +                                 G,A\<turnstile>{Normal P} e#es\<doteq>\<succ> {R}"
   3.583 +
   3.584 +  (* statements *)
   3.585 +
   3.586 +  Skip:                         "G,A\<turnstile>{Normal (P\<leftarrow>\<diamondsuit>)} .Skip. {P}"
   3.587 +
   3.588 +  Expr: "\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {Q\<leftarrow>\<diamondsuit>}\<rbrakk> \<Longrightarrow>
   3.589 +                                 G,A\<turnstile>{Normal P} .Expr e. {Q}"
   3.590 +
   3.591 +  Lab: "\<lbrakk>G,A\<turnstile>{Normal P} .c. {abupd (absorb (Break l)) .; Q}\<rbrakk> \<Longrightarrow>
   3.592 +                           G,A\<turnstile>{Normal P} .l\<bullet> c. {Q}"
   3.593 +
   3.594 +  Comp: "\<lbrakk>G,A\<turnstile>{Normal P} .c1. {Q};
   3.595 +          G,A\<turnstile>{Q} .c2. {R}\<rbrakk> \<Longrightarrow>
   3.596 +                                 G,A\<turnstile>{Normal P} .c1;;c2. {R}"
   3.597 +
   3.598 +  If:   "\<lbrakk>G,A \<turnstile>{Normal P} e-\<succ> {P'};
   3.599 +          \<forall>b. G,A\<turnstile>{P'\<leftarrow>=b} .(if b then c1 else c2). {Q}\<rbrakk> \<Longrightarrow>
   3.600 +                                 G,A\<turnstile>{Normal P} .If(e) c1 Else c2. {Q}"
   3.601 +(* unfolding variant of Loop, not needed here
   3.602 +  LoopU:"\<lbrakk>G,A \<turnstile>{Normal P} e-\<succ> {P'};
   3.603 +          \<forall>b. G,A\<turnstile>{P'\<leftarrow>=b} .(if b then c;;While(e) c else Skip).{Q}\<rbrakk>
   3.604 +         \<Longrightarrow>              G,A\<turnstile>{Normal P} .While(e) c. {Q}"
   3.605 +*)
   3.606 +  Loop: "\<lbrakk>G,A\<turnstile>{P} e-\<succ> {P'}; 
   3.607 +          G,A\<turnstile>{Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}\<rbrakk> \<Longrightarrow>
   3.608 +                            G,A\<turnstile>{P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}"
   3.609 +(** Beware of polymorphic_Loop below: should be identical terms **)
   3.610 +  
   3.611 +  Do: "G,A\<turnstile>{Normal (abupd (\<lambda>a. (Some (Jump j))) .; P\<leftarrow>\<diamondsuit>)} .Do j. {P}"
   3.612 +
   3.613 +  Throw:"\<lbrakk>G,A\<turnstile>{Normal P} e-\<succ> {\<lambda>Val:a:. abupd (throw a) .; Q\<leftarrow>\<diamondsuit>}\<rbrakk> \<Longrightarrow>
   3.614 +                                 G,A\<turnstile>{Normal P} .Throw e. {Q}"
   3.615 +
   3.616 +  Try:  "\<lbrakk>G,A\<turnstile>{Normal P} .c1. {SXAlloc G Q};
   3.617 +          G,A\<turnstile>{Q \<and>. (\<lambda>s.  G,s\<turnstile>catch C) ;. new_xcpt_var vn} .c2. {R};
   3.618 +              (Q \<and>. (\<lambda>s. \<not>G,s\<turnstile>catch C)) \<Rightarrow> R\<rbrakk> \<Longrightarrow>
   3.619 +                                 G,A\<turnstile>{Normal P} .Try c1 Catch(C vn) c2. {R}"
   3.620 +
   3.621 +  Fin:  "\<lbrakk>G,A\<turnstile>{Normal P} .c1. {Q};
   3.622 +      \<forall>x. G,A\<turnstile>{Q \<and>. (\<lambda>s. x = fst s) ;. abupd (\<lambda>x. None)}
   3.623 +              .c2. {abupd (abrupt_if (x\<noteq>None) x) .; R}\<rbrakk> \<Longrightarrow>
   3.624 +                                 G,A\<turnstile>{Normal P} .c1 Finally c2. {R}"
   3.625 +
   3.626 +  Done:                       "G,A\<turnstile>{Normal (P\<leftarrow>\<diamondsuit> \<and>. initd C)} .Init C. {P}"
   3.627 +
   3.628 +  Init: "\<lbrakk>the (class G C) = c;
   3.629 +          G,A\<turnstile>{Normal ((P \<and>. Not \<circ> initd C) ;. supd (init_class_obj G C))}
   3.630 +              .(if C = Object then Skip else Init (super c)). {Q};
   3.631 +      \<forall>l. G,A\<turnstile>{Q \<and>. (\<lambda>s. l = locals (store s)) ;. set_lvars empty}
   3.632 +              .init c. {set_lvars l .; R}\<rbrakk> \<Longrightarrow>
   3.633 +                               G,A\<turnstile>{Normal (P \<and>. Not \<circ> initd C)} .Init C. {R}"
   3.634 +
   3.635 +axioms (** these terms are the same as above, but with generalized typing **)
   3.636 +  polymorphic_conseq:
   3.637 +        "\<forall>Y s Z . P  Y s Z  \<longrightarrow> (\<exists>P' Q'. G,A\<turnstile>{P'} t\<succ> {Q'} \<and> (\<forall>Y' s'. 
   3.638 +        (\<forall>Y   Z'. P' Y s Z' \<longrightarrow> Q' Y' s' Z') \<longrightarrow>
   3.639 +                                Q  Y' s' Z ))
   3.640 +                                         \<Longrightarrow> G,A\<turnstile>{P } t\<succ> {Q }"
   3.641 +
   3.642 +  polymorphic_Loop:
   3.643 +        "\<lbrakk>G,A\<turnstile>{P} e-\<succ> {P'}; 
   3.644 +          G,A\<turnstile>{Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}\<rbrakk> \<Longrightarrow>
   3.645 +                            G,A\<turnstile>{P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}"
   3.646 +
   3.647 +constdefs
   3.648 + adapt_pre :: "'a assn \<Rightarrow> 'a assn \<Rightarrow> 'a assn \<Rightarrow> 'a assn"
   3.649 +"adapt_pre P Q Q'\<equiv>\<lambda>Y s Z. \<forall>Y' s'. \<exists>Z'. P Y s Z' \<and> (Q Y' s' Z' \<longrightarrow> Q' Y' s' Z)"
   3.650 +
   3.651 +
   3.652 +section "rules derived by induction"
   3.653 +
   3.654 +lemma cut_valid: "\<lbrakk>G,A'|\<Turnstile>ts; G,A|\<Turnstile>A'\<rbrakk> \<Longrightarrow> G,A|\<Turnstile>ts"
   3.655 +apply (unfold ax_valids_def)
   3.656 +apply fast
   3.657 +done
   3.658 +
   3.659 +(*if cut is available
   3.660 +Goal "\<lbrakk>G,A'|\<turnstile>ts; A' \<subseteq> A; \<forall>P Q t. {P} t\<succ> {Q} \<in> A' \<longrightarrow> (\<exists>T. (G,L)\<turnstile>t\<Colon>T) \<rbrakk> \<Longrightarrow>  
   3.661 +       G,A|\<turnstile>ts"
   3.662 +b y etac ax_derivs.cut 1;
   3.663 +b y eatac ax_derivs.asm 1 1;
   3.664 +qed "ax_thin";
   3.665 +*)
   3.666 +lemma ax_thin [rule_format (no_asm)]: 
   3.667 +  "G,(A'::'a triple set)|\<turnstile>(ts::'a triple set) \<Longrightarrow> \<forall>A. A' \<subseteq> A \<longrightarrow> G,A|\<turnstile>ts"
   3.668 +apply (erule ax_derivs.induct)
   3.669 +apply                (tactic "ALLGOALS(EVERY'[Clarify_tac,REPEAT o smp_tac 1])")
   3.670 +apply                (rule ax_derivs.empty)
   3.671 +apply               (erule (1) ax_derivs.insert)
   3.672 +apply              (fast intro: ax_derivs.asm)
   3.673 +(*apply           (fast intro: ax_derivs.cut) *)
   3.674 +apply            (fast intro: ax_derivs.weaken)
   3.675 +apply           (rule ax_derivs.conseq, intro strip, tactic "smp_tac 3 1",clarify, tactic "smp_tac 1 1",rule exI, rule exI, erule (1) conjI)
   3.676 +(* 31 subgoals *)
   3.677 +prefer 16 (* Methd *)
   3.678 +apply (rule ax_derivs.Methd, drule spec, erule mp, fast)
   3.679 +apply (tactic {* TRYALL (resolve_tac ((funpow 5 tl) (thms "ax_derivs.intros")) 
   3.680 +                     THEN_ALL_NEW Blast_tac) *})
   3.681 +apply (erule ax_derivs.Call)
   3.682 +apply   clarify 
   3.683 +apply   blast
   3.684 +
   3.685 +apply   (rule allI)+ 
   3.686 +apply   (drule spec)+
   3.687 +apply   blast
   3.688 +done
   3.689 +
   3.690 +lemma ax_thin_insert: "G,(A::'a triple set)\<turnstile>(t::'a triple) \<Longrightarrow> G,insert x A\<turnstile>t"
   3.691 +apply (erule ax_thin)
   3.692 +apply fast
   3.693 +done
   3.694 +
   3.695 +lemma subset_mtriples_iff: 
   3.696 +  "ts \<subseteq> {{P} mb-\<succ> {Q} | ms} = (\<exists>ms'. ms'\<subseteq>ms \<and>  ts = {{P} mb-\<succ> {Q} | ms'})"
   3.697 +apply (unfold mtriples_def)
   3.698 +apply (rule subset_image_iff)
   3.699 +done
   3.700 +
   3.701 +lemma weaken: 
   3.702 + "G,(A::'a triple set)|\<turnstile>(ts'::'a triple set) \<Longrightarrow> !ts. ts \<subseteq> ts' \<longrightarrow> G,A|\<turnstile>ts"
   3.703 +apply (erule ax_derivs.induct)
   3.704 +(*36 subgoals*)
   3.705 +apply       (tactic "ALLGOALS strip_tac")
   3.706 +apply       (tactic {* ALLGOALS(REPEAT o (EVERY'[dtac (thm "subset_singletonD"),
   3.707 +         etac disjE, fast_tac (claset() addSIs [thm "ax_derivs.empty"])]))*})
   3.708 +apply       (tactic "TRYALL hyp_subst_tac")
   3.709 +apply       (simp, rule ax_derivs.empty)
   3.710 +apply      (drule subset_insertD)
   3.711 +apply      (blast intro: ax_derivs.insert)
   3.712 +apply     (fast intro: ax_derivs.asm)
   3.713 +(*apply  (blast intro: ax_derivs.cut) *)
   3.714 +apply   (fast intro: ax_derivs.weaken)
   3.715 +apply  (rule ax_derivs.conseq, clarify, tactic "smp_tac 3 1", blast(* unused *))
   3.716 +(*31 subgoals*)
   3.717 +apply (tactic {* TRYALL (resolve_tac ((funpow 5 tl) (thms "ax_derivs.intros")) 
   3.718 +                   THEN_ALL_NEW Fast_tac) *})
   3.719 +(*1 subgoal*)
   3.720 +apply (clarsimp simp add: subset_mtriples_iff)
   3.721 +apply (rule ax_derivs.Methd)
   3.722 +apply (drule spec)
   3.723 +apply (erule impE)
   3.724 +apply  (rule exI)
   3.725 +apply  (erule conjI)
   3.726 +apply  (rule HOL.refl)
   3.727 +oops (* dead end, Methd is to blame *)
   3.728 +
   3.729 +
   3.730 +section "rules derived from conseq"
   3.731 +
   3.732 +lemma conseq12: "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'};  
   3.733 + \<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.734 +  Q Y' s' Z)\<rbrakk>  
   3.735 +  \<Longrightarrow>  G,A\<turnstile>{P ::'a assn} t\<succ> {Q }"
   3.736 +apply (rule polymorphic_conseq)
   3.737 +apply clarsimp
   3.738 +apply blast
   3.739 +done
   3.740 +
   3.741 +(*unused, but nice variant*)
   3.742 +lemma conseq12': "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'}; \<forall>s Y' s'.  
   3.743 +       (\<forall>Y Z. P' Y s Z \<longrightarrow> Q' Y' s' Z) \<longrightarrow>  
   3.744 +       (\<forall>Y Z. P  Y s Z \<longrightarrow> Q  Y' s' Z)\<rbrakk>  
   3.745 +  \<Longrightarrow>  G,A\<turnstile>{P } t\<succ> {Q }"
   3.746 +apply (erule conseq12)
   3.747 +apply fast
   3.748 +done
   3.749 +
   3.750 +lemma conseq12_from_conseq12': "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q'};  
   3.751 + \<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.752 +  Q Y' s' Z)\<rbrakk>  
   3.753 +  \<Longrightarrow>  G,A\<turnstile>{P } t\<succ> {Q }"
   3.754 +apply (erule conseq12')
   3.755 +apply blast
   3.756 +done
   3.757 +
   3.758 +lemma conseq1: "\<lbrakk>G,A\<turnstile>{P'} t\<succ> {Q}; P \<Rightarrow> P'\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P } t\<succ> {Q}"
   3.759 +apply (erule conseq12)
   3.760 +apply blast
   3.761 +done
   3.762 +
   3.763 +lemma conseq2: "\<lbrakk>G,A\<turnstile>{P} t\<succ> {Q'}; Q' \<Rightarrow> Q\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.764 +apply (erule conseq12)
   3.765 +apply blast
   3.766 +done
   3.767 +
   3.768 +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.769 +  G,A\<turnstile>{P} t\<succ> {Q}"
   3.770 +apply (rule polymorphic_conseq)
   3.771 +apply force
   3.772 +done
   3.773 +
   3.774 +(* unused *)
   3.775 +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.776 +apply (rule ax_escape (* unused *))
   3.777 +apply clarify
   3.778 +apply (rule conseq12)
   3.779 +apply  fast
   3.780 +apply auto
   3.781 +done
   3.782 +(*alternative (more direct) proof:
   3.783 +apply (rule ax_derivs.conseq) *)(* unused *)(*
   3.784 +apply (fast)
   3.785 +*)
   3.786 +
   3.787 +
   3.788 +lemma ax_impossible [intro]: "G,A\<turnstile>{\<lambda>Y s Z. False} t\<succ> {Q}"
   3.789 +apply (rule ax_escape)
   3.790 +apply clarify
   3.791 +done
   3.792 +
   3.793 +(* unused *)
   3.794 +lemma ax_nochange_lemma: "\<lbrakk>P Y s; All (op = w)\<rbrakk> \<Longrightarrow> P w s"
   3.795 +apply auto
   3.796 +done
   3.797 +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.798 +apply (erule conseq12)
   3.799 +apply auto
   3.800 +apply (erule (1) ax_nochange_lemma)
   3.801 +done
   3.802 +
   3.803 +(* unused *)
   3.804 +lemma ax_trivial: "G,A\<turnstile>{P}  t\<succ> {\<lambda>Y s Z. True}"
   3.805 +apply (rule polymorphic_conseq(* unused *))
   3.806 +apply auto
   3.807 +done
   3.808 +
   3.809 +(* unused *)
   3.810 +lemma ax_disj: "\<lbrakk>G,A\<turnstile>{P1} t\<succ> {Q1}; G,A\<turnstile>{P2} t\<succ> {Q2}\<rbrakk> \<Longrightarrow>  
   3.811 +  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.812 +apply (rule ax_escape (* unused *))
   3.813 +apply safe
   3.814 +apply  (erule conseq12, fast)+
   3.815 +done
   3.816 +
   3.817 +(* unused *)
   3.818 +lemma ax_supd_shuffle: "(\<exists>Q. G,A\<turnstile>{P} .c1. {Q} \<and> G,A\<turnstile>{Q ;. f} .c2. {R}) =  
   3.819 +       (\<exists>Q'. G,A\<turnstile>{P} .c1. {f .; Q'} \<and> G,A\<turnstile>{Q'} .c2. {R})"
   3.820 +apply (best elim!: conseq1 conseq2)
   3.821 +done
   3.822 +
   3.823 +lemma ax_cases: "\<lbrakk>G,A\<turnstile>{P \<and>.       C} t\<succ> {Q};  
   3.824 +                       G,A\<turnstile>{P \<and>. Not \<circ> C} t\<succ> {Q}\<rbrakk> \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.825 +apply (unfold peek_and_def)
   3.826 +apply (rule ax_escape)
   3.827 +apply clarify
   3.828 +apply (case_tac "C s")
   3.829 +apply  (erule conseq12, force)+
   3.830 +done
   3.831 +(*alternative (more direct) proof:
   3.832 +apply (rule rtac ax_derivs.conseq) *)(* unused *)(*
   3.833 +apply clarify
   3.834 +apply (case_tac "C s")
   3.835 +apply  force+
   3.836 +*)
   3.837 +
   3.838 +lemma ax_adapt: "G,A\<turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.839 +apply (unfold adapt_pre_def)
   3.840 +apply (erule conseq12)
   3.841 +apply fast
   3.842 +done
   3.843 +
   3.844 +lemma adapt_pre_adapts: "G,A\<Turnstile>{P} t\<succ> {Q} \<longrightarrow> G,A\<Turnstile>{adapt_pre P Q Q'} t\<succ> {Q'}"
   3.845 +apply (unfold adapt_pre_def)
   3.846 +apply (simp add: ax_valids_def triple_valid_def2)
   3.847 +apply fast
   3.848 +done
   3.849 +
   3.850 +
   3.851 +lemma adapt_pre_weakest: 
   3.852 +"\<forall>G (A::'a triple set) t. G,A\<Turnstile>{P} t\<succ> {Q} \<longrightarrow> G,A\<Turnstile>{P'} t\<succ> {Q'} \<Longrightarrow>  
   3.853 +  P' \<Rightarrow> adapt_pre P Q (Q'::'a assn)"
   3.854 +apply (unfold adapt_pre_def)
   3.855 +apply (drule spec)
   3.856 +apply (drule_tac x = "{}" in spec)
   3.857 +apply (drule_tac x = "In1r Skip" in spec)
   3.858 +apply (simp add: ax_valids_def triple_valid_def2)
   3.859 +oops
   3.860 +
   3.861 +(*
   3.862 +Goal "\<forall>(A::'a triple set) t. G,A\<Turnstile>{P} t\<succ> {Q} \<longrightarrow> G,A\<Turnstile>{P'} t\<succ> {Q'} \<Longrightarrow>  
   3.863 +  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.864 +b y fatac ax_sound 1 1;
   3.865 +b y asm_full_simp_tac (simpset() addsimps [ax_valids_def,triple_valid_def2]) 1;
   3.866 +b y rtac ax_no_hazard 1; 
   3.867 +b y etac conseq12 1;
   3.868 +b y Clarify_tac 1;
   3.869 +b y case_tac "\<forall>Z. \<not>P Y s Z" 1;
   3.870 +b y smp_tac 2 1;
   3.871 +b y etac thin_rl 1;
   3.872 +b y etac thin_rl 1;
   3.873 +b y clarsimp_tac (claset(), simpset() addsimps [type_ok_def]) 1;
   3.874 +b y subgoal_tac "G|\<Turnstile>n:A" 1;
   3.875 +b y smp_tac 1 1;
   3.876 +b y smp_tac 3 1;
   3.877 +b y etac impE 1;
   3.878 + back();
   3.879 + b y Fast_tac 1;
   3.880 +b y 
   3.881 +b y rotate_tac 2 1;
   3.882 +b y etac thin_rl 1;
   3.883 +b y  etac thin_rl 2;
   3.884 +b y  etac thin_rl 2;
   3.885 +b y  Clarify_tac 2;
   3.886 +b y  dtac spec 2;
   3.887 +b y  EVERY'[dtac spec, mp_tac] 2;
   3.888 +b y  thin_tac "\<forall>n Y s Z. ?PP n Y s Z" 2;
   3.889 +b y  thin_tac "P' Y s Z" 2;
   3.890 +b y  Blast_tac 2;
   3.891 +b y smp_tac 3 1;
   3.892 +b y case_tac "\<forall>Z. \<not>P Y s Z" 1;
   3.893 +b y dres_inst_tac [("x","In1r Skip")] spec 1;
   3.894 +b y Full_simp_tac 1;
   3.895 +*)
   3.896 +
   3.897 +lemma peek_and_forget1_Normal: 
   3.898 + "G,A\<turnstile>{Normal P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{Normal (P \<and>. p)} t\<succ> {Q}"
   3.899 +apply (erule conseq1)
   3.900 +apply (simp (no_asm))
   3.901 +done
   3.902 +
   3.903 +lemma peek_and_forget1: "G,A\<turnstile>{P} t\<succ> {Q} \<Longrightarrow> G,A\<turnstile>{P \<and>. p} t\<succ> {Q}"
   3.904 +apply (erule conseq1)
   3.905 +apply (simp (no_asm))
   3.906 +done
   3.907 +
   3.908 +lemmas ax_NormalD = peek_and_forget1 [of _ _ _ _ _ normal] 
   3.909 +
   3.910 +lemma peek_and_forget2: "G,A\<turnstile>{P} t\<succ> {Q \<and>. p} \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
   3.911 +apply (erule conseq2)
   3.912 +apply (simp (no_asm))
   3.913 +done
   3.914 +
   3.915 +lemma ax_subst_Val_allI: "\<forall>v. G,A\<turnstile>{(P'               v )\<leftarrow>Val v} t\<succ> {Q v} \<Longrightarrow>  
   3.916 +      \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In1 w))\<leftarrow>Val v} t\<succ> {Q v}"
   3.917 +apply (force elim!: conseq1)
   3.918 +done
   3.919 +
   3.920 +lemma ax_subst_Var_allI: "\<forall>v. G,A\<turnstile>{(P'               v )\<leftarrow>Var v} t\<succ> {Q v} \<Longrightarrow>  
   3.921 +      \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In2 w))\<leftarrow>Var v} t\<succ> {Q v}"
   3.922 +apply (force elim!: conseq1)
   3.923 +done
   3.924 +
   3.925 +lemma ax_subst_Vals_allI: "(\<forall>v. G,A\<turnstile>{(     P'          v )\<leftarrow>Vals v} t\<succ> {Q v}) \<Longrightarrow>  
   3.926 +       \<forall>v. G,A\<turnstile>{(\<lambda>w:. P' (the_In3 w))\<leftarrow>Vals v} t\<succ> {Q v}"
   3.927 +apply (force elim!: conseq1)
   3.928 +done
   3.929 +
   3.930 +
   3.931 +section "alternative axioms"
   3.932 +
   3.933 +lemma ax_Lit2: 
   3.934 +  "G,(A::'a triple set)\<turnstile>{Normal P::'a assn} Lit v-\<succ> {Normal (P\<down>=Val v)}"
   3.935 +apply (rule ax_derivs.Lit [THEN conseq1])
   3.936 +apply force
   3.937 +done
   3.938 +lemma ax_Lit2_test_complete: 
   3.939 +  "G,(A::'a triple set)\<turnstile>{Normal (P\<leftarrow>Val v)::'a assn} Lit v-\<succ> {P}"
   3.940 +apply (rule ax_Lit2 [THEN conseq2])
   3.941 +apply force
   3.942 +done
   3.943 +
   3.944 +lemma ax_LVar2: "G,(A::'a triple set)\<turnstile>{Normal P::'a assn} LVar vn=\<succ> {Normal (\<lambda>s.. P\<down>=Var (lvar vn s))}"
   3.945 +apply (rule ax_derivs.LVar [THEN conseq1])
   3.946 +apply force
   3.947 +done
   3.948 +
   3.949 +lemma ax_Super2: "G,(A::'a triple set)\<turnstile>
   3.950 +  {Normal P::'a assn} Super-\<succ> {Normal (\<lambda>s.. P\<down>=Val (val_this s))}"
   3.951 +apply (rule ax_derivs.Super [THEN conseq1])
   3.952 +apply force
   3.953 +done
   3.954 +
   3.955 +lemma ax_Nil2: 
   3.956 +  "G,(A::'a triple set)\<turnstile>{Normal P::'a assn} []\<doteq>\<succ> {Normal (P\<down>=Vals [])}"
   3.957 +apply (rule ax_derivs.Nil [THEN conseq1])
   3.958 +apply force
   3.959 +done
   3.960 +
   3.961 +
   3.962 +section "misc derived structural rules"
   3.963 +
   3.964 +(* unused *)
   3.965 +lemma ax_finite_mtriples_lemma: "\<lbrakk>F \<subseteq> ms; finite ms; \<forall>(C,sig)\<in>ms. 
   3.966 +    G,(A::'a triple set)\<turnstile>{Normal (P C sig)::'a assn} mb C sig-\<succ> {Q C sig}\<rbrakk> \<Longrightarrow> 
   3.967 +       G,A|\<turnstile>{{P} mb-\<succ> {Q} | F}"
   3.968 +apply (frule (1) finite_subset)
   3.969 +apply (erule make_imp)
   3.970 +apply (erule thin_rl)
   3.971 +apply (erule finite_induct)
   3.972 +apply  (unfold mtriples_def)
   3.973 +apply  (clarsimp intro!: ax_derivs.empty ax_derivs.insert)+
   3.974 +apply force
   3.975 +done
   3.976 +lemmas ax_finite_mtriples = ax_finite_mtriples_lemma [OF subset_refl]
   3.977 +
   3.978 +lemma ax_derivs_insertD: 
   3.979 + "G,(A::'a triple set)|\<turnstile>insert (t::'a triple) ts \<Longrightarrow> G,A\<turnstile>t \<and> G,A|\<turnstile>ts"
   3.980 +apply (fast intro: ax_derivs.weaken)
   3.981 +done
   3.982 +
   3.983 +lemma ax_methods_spec: 
   3.984 +"\<lbrakk>G,(A::'a triple set)|\<turnstile>split f ` ms; (C,sig) \<in> ms\<rbrakk>\<Longrightarrow> G,A\<turnstile>((f C sig)::'a triple)"
   3.985 +apply (erule ax_derivs.weaken)
   3.986 +apply (force del: image_eqI intro: rev_image_eqI)
   3.987 +done
   3.988 +
   3.989 +(* this version is used to avoid using the cut rule *)
   3.990 +lemma ax_finite_pointwise_lemma [rule_format]: "\<lbrakk>F \<subseteq> ms; finite ms\<rbrakk> \<Longrightarrow>  
   3.991 +  ((\<forall>(C,sig)\<in>F. G,(A::'a triple set)\<turnstile>(f C sig::'a triple)) \<longrightarrow> (\<forall>(C,sig)\<in>ms. G,A\<turnstile>(g C sig::'a triple))) \<longrightarrow>  
   3.992 +      G,A|\<turnstile>split f ` F \<longrightarrow> G,A|\<turnstile>split g ` F"
   3.993 +apply (frule (1) finite_subset)
   3.994 +apply (erule make_imp)
   3.995 +apply (erule thin_rl)
   3.996 +apply (erule finite_induct)
   3.997 +apply  clarsimp+
   3.998 +apply (drule ax_derivs_insertD)
   3.999 +apply (rule ax_derivs.insert)
  3.1000 +apply  (simp (no_asm_simp) only: split_tupled_all)
  3.1001 +apply  (auto elim: ax_methods_spec)
  3.1002 +done
  3.1003 +lemmas ax_finite_pointwise = ax_finite_pointwise_lemma [OF subset_refl]
  3.1004 + 
  3.1005 +lemma ax_no_hazard: 
  3.1006 +  "G,(A::'a triple set)\<turnstile>{P \<and>. type_ok G t} t\<succ> {Q::'a assn} \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Q}"
  3.1007 +apply (erule ax_cases)
  3.1008 +apply (rule ax_derivs.hazard [THEN conseq1])
  3.1009 +apply force
  3.1010 +done
  3.1011 +
  3.1012 +lemma ax_free_wt: 
  3.1013 + "(\<exists>T L C. \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) 
  3.1014 +  \<longrightarrow> G,(A::'a triple set)\<turnstile>{Normal P} t\<succ> {Q::'a assn} \<Longrightarrow> 
  3.1015 +  G,A\<turnstile>{Normal P} t\<succ> {Q}"
  3.1016 +apply (rule ax_no_hazard)
  3.1017 +apply (rule ax_escape)
  3.1018 +apply clarify
  3.1019 +apply (erule mp [THEN conseq12])
  3.1020 +apply  (auto simp add: type_ok_def)
  3.1021 +done
  3.1022 +
  3.1023 +ML {*
  3.1024 +bind_thms ("ax_Abrupts", sum3_instantiate (thm "ax_derivs.Abrupt"))
  3.1025 +*}
  3.1026 +declare ax_Abrupts [intro!]
  3.1027 +
  3.1028 +lemmas ax_Normal_cases = ax_cases [of _ _ normal]
  3.1029 +
  3.1030 +lemma ax_Skip [intro!]: "G,(A::'a triple set)\<turnstile>{P\<leftarrow>\<diamondsuit>} .Skip. {P::'a assn}"
  3.1031 +apply (rule ax_Normal_cases)
  3.1032 +apply  (rule ax_derivs.Skip)
  3.1033 +apply fast
  3.1034 +done
  3.1035 +lemmas ax_SkipI = ax_Skip [THEN conseq1, standard]
  3.1036 +
  3.1037 +
  3.1038 +section "derived rules for methd call"
  3.1039 +
  3.1040 +lemma ax_Call_known_DynT: 
  3.1041 +"\<lbrakk>G\<turnstile>IntVir\<rightarrow>C\<preceq>statT; 
  3.1042 +  \<forall>a vs l. G,A\<turnstile>{(R a\<leftarrow>Vals vs \<and>. (\<lambda>s. l = locals (store s)) ;.
  3.1043 +  init_lvars G C \<lparr>name=mn,parTs=pTs\<rparr> IntVir a vs)} 
  3.1044 +    Methd C \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}; 
  3.1045 +  \<forall>a. G,A\<turnstile>{Q\<leftarrow>Val a} args\<doteq>\<succ>  
  3.1046 +       {R a \<and>. (\<lambda>s. C = obj_class (the (heap (store s) (the_Addr a))) \<and>
  3.1047 +                     C = invocation_declclass 
  3.1048 +                            G IntVir (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr> )};  
  3.1049 +       G,(A::'a triple set)\<turnstile>{Normal P} e-\<succ> {Q::'a assn}\<rbrakk>  
  3.1050 +   \<Longrightarrow> G,A\<turnstile>{Normal P} {statT,IntVir}e\<cdot>mn({pTs}args)-\<succ> {S}"
  3.1051 +apply (erule ax_derivs.Call)
  3.1052 +apply  safe
  3.1053 +apply  (erule spec)
  3.1054 +apply (rule ax_escape, clarsimp)
  3.1055 +apply (drule spec, drule spec, drule spec,erule conseq12)
  3.1056 +apply force
  3.1057 +done
  3.1058 +
  3.1059 +
  3.1060 +lemma ax_Call_Static: 
  3.1061 + "\<lbrakk>\<forall>a vs l. G,A\<turnstile>{R a\<leftarrow>Vals vs \<and>. (\<lambda>s. l = locals (store s)) ;.  
  3.1062 +               init_lvars G C \<lparr>name=mn,parTs=pTs\<rparr> Static any_Addr vs}  
  3.1063 +              Methd C \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}; 
  3.1064 +  G,A\<turnstile>{Normal P} e-\<succ> {Q};
  3.1065 +  \<forall> a. G,(A::'a triple set)\<turnstile>{Q\<leftarrow>Val a} args\<doteq>\<succ> {(R::val \<Rightarrow> 'a assn)  a 
  3.1066 +  \<and>. (\<lambda> s. C=invocation_declclass 
  3.1067 +                G Static (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr>)}
  3.1068 +\<rbrakk>  \<Longrightarrow>  G,A\<turnstile>{Normal P} {statT,Static}e\<cdot>mn({pTs}args)-\<succ> {S}"
  3.1069 +apply (erule ax_derivs.Call)
  3.1070 +apply  safe
  3.1071 +apply  (erule spec)
  3.1072 +apply (rule ax_escape, clarsimp)
  3.1073 +apply (erule_tac V = "?P \<longrightarrow> ?Q" in thin_rl)
  3.1074 +apply (drule spec,drule spec,drule spec, erule conseq12)
  3.1075 +apply (force simp add: init_lvars_def)
  3.1076 +done
  3.1077 +
  3.1078 +lemma ax_Methd1: 
  3.1079 + "\<lbrakk>G,A\<union>{{P} Methd-\<succ> {Q} | ms}|\<turnstile> {{P} body G-\<succ> {Q} | ms}; (C,sig)\<in> ms\<rbrakk> \<Longrightarrow> 
  3.1080 +       G,A\<turnstile>{Normal (P C sig)} Methd C sig-\<succ> {Q C sig}"
  3.1081 +apply (drule ax_derivs.Methd)
  3.1082 +apply (unfold mtriples_def)
  3.1083 +apply (erule (1) ax_methods_spec)
  3.1084 +done
  3.1085 +
  3.1086 +lemma ax_MethdN: 
  3.1087 +"G,insert({Normal P} Methd  C sig-\<succ> {Q}) A\<turnstile> 
  3.1088 +          {Normal P} body G C sig-\<succ> {Q} \<Longrightarrow>  
  3.1089 +      G,A\<turnstile>{Normal P} Methd   C sig-\<succ> {Q}"
  3.1090 +apply (rule ax_Methd1)
  3.1091 +apply  (rule_tac [2] singletonI)
  3.1092 +apply (unfold mtriples_def)
  3.1093 +apply clarsimp
  3.1094 +done
  3.1095 +
  3.1096 +lemma ax_StatRef: 
  3.1097 +  "G,(A::'a triple set)\<turnstile>{Normal (P\<leftarrow>Val Null)} StatRef rt-\<succ> {P::'a assn}"
  3.1098 +apply (rule ax_derivs.Cast)
  3.1099 +apply (rule ax_Lit2 [THEN conseq2])
  3.1100 +apply clarsimp
  3.1101 +done
  3.1102 +
  3.1103 +section "rules derived from Init and Done"
  3.1104 +
  3.1105 +  lemma ax_InitS: "\<lbrakk>the (class G C) = c; C \<noteq> Object;  
  3.1106 +     \<forall>l. G,A\<turnstile>{Q \<and>. (\<lambda>s. l = locals (store s)) ;. set_lvars empty}  
  3.1107 +            .init c. {set_lvars l .; R};   
  3.1108 +         G,A\<turnstile>{Normal ((P \<and>. Not \<circ> initd C) ;. supd (init_class_obj G C))}  
  3.1109 +  .Init (super c). {Q}\<rbrakk> \<Longrightarrow>  
  3.1110 +  G,(A::'a triple set)\<turnstile>{Normal (P \<and>. Not \<circ> initd C)} .Init C. {R::'a assn}"
  3.1111 +apply (erule ax_derivs.Init)
  3.1112 +apply  (simp (no_asm_simp))
  3.1113 +apply assumption
  3.1114 +done
  3.1115 +
  3.1116 +lemma ax_Init_Skip_lemma: 
  3.1117 +"\<forall>l. G,(A::'a triple set)\<turnstile>{P\<leftarrow>\<diamondsuit> \<and>. (\<lambda>s. l = locals (store s)) ;. set_lvars l'}
  3.1118 +  .Skip. {(set_lvars l .; P)::'a assn}"
  3.1119 +apply (rule allI)
  3.1120 +apply (rule ax_SkipI)
  3.1121 +apply clarsimp
  3.1122 +done
  3.1123 +
  3.1124 +lemma ax_triv_InitS: "\<lbrakk>the (class G C) = c;init c = Skip; C \<noteq> Object; 
  3.1125 +       P\<leftarrow>\<diamondsuit> \<Rightarrow> (supd (init_class_obj G C) .; P);  
  3.1126 +       G,A\<turnstile>{Normal (P \<and>. initd C)} .Init (super c). {(P \<and>. initd C)\<leftarrow>\<diamondsuit>}\<rbrakk> \<Longrightarrow>  
  3.1127 +       G,(A::'a triple set)\<turnstile>{Normal P\<leftarrow>\<diamondsuit>} .Init C. {(P \<and>. initd C)::'a assn}"
  3.1128 +apply (rule_tac C = "initd C" in ax_cases)
  3.1129 +apply  (rule conseq1, rule ax_derivs.Done, clarsimp)
  3.1130 +apply (simp (no_asm))
  3.1131 +apply (erule (1) ax_InitS)
  3.1132 +apply  simp
  3.1133 +apply  (rule ax_Init_Skip_lemma)
  3.1134 +apply (erule conseq1)
  3.1135 +apply force
  3.1136 +done
  3.1137 +
  3.1138 +lemma ax_Init_Object: "wf_prog G \<Longrightarrow> G,(A::'a triple set)\<turnstile>
  3.1139 +  {Normal ((supd (init_class_obj G Object) .; P\<leftarrow>\<diamondsuit>) \<and>. Not \<circ> initd Object)} 
  3.1140 +       .Init Object. {(P \<and>. initd Object)::'a assn}"
  3.1141 +apply (rule ax_derivs.Init)
  3.1142 +apply   (drule class_Object, force)
  3.1143 +apply (simp_all (no_asm))
  3.1144 +apply (rule_tac [2] ax_Init_Skip_lemma)
  3.1145 +apply (rule ax_SkipI, force)
  3.1146 +done
  3.1147 +
  3.1148 +lemma ax_triv_Init_Object: "\<lbrakk>wf_prog G;  
  3.1149 +       (P::'a assn) \<Rightarrow> (supd (init_class_obj G Object) .; P)\<rbrakk> \<Longrightarrow>  
  3.1150 +  G,(A::'a triple set)\<turnstile>{Normal P\<leftarrow>\<diamondsuit>} .Init Object. {P \<and>. initd Object}"
  3.1151 +apply (rule_tac C = "initd Object" in ax_cases)
  3.1152 +apply  (rule conseq1, rule ax_derivs.Done, clarsimp)
  3.1153 +apply (erule ax_Init_Object [THEN conseq1])
  3.1154 +apply force
  3.1155 +done
  3.1156 +
  3.1157 +
  3.1158 +section "introduction rules for Alloc and SXAlloc"
  3.1159 +
  3.1160 +lemma ax_SXAlloc_Normal: "G,A\<turnstile>{P} .c. {Normal Q} \<Longrightarrow> G,A\<turnstile>{P} .c. {SXAlloc G Q}"
  3.1161 +apply (erule conseq2)
  3.1162 +apply (clarsimp elim!: sxalloc_elim_cases simp add: split_tupled_all)
  3.1163 +done
  3.1164 +
  3.1165 +lemma ax_Alloc: 
  3.1166 +  "G,A\<turnstile>{P} t\<succ> {Normal (\<lambda>Y (x,s) Z. (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
  3.1167 + Q (Val (Addr a)) (Norm(init_obj G (CInst C) (Heap a) s)) Z)) \<and>. 
  3.1168 +    heap_free (Suc (Suc 0))}
  3.1169 +   \<Longrightarrow> G,A\<turnstile>{P} t\<succ> {Alloc G (CInst C) Q}"
  3.1170 +apply (erule conseq2)
  3.1171 +apply (auto elim!: halloc_elim_cases)
  3.1172 +done
  3.1173 +
  3.1174 +lemma ax_Alloc_Arr: 
  3.1175 + "G,A\<turnstile>{P} t\<succ> {\<lambda>Val:i:. Normal (\<lambda>Y (x,s) Z. \<not>the_Intg i<0 \<and>  
  3.1176 +  (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
  3.1177 +  Q (Val (Addr a)) (Norm (init_obj G (Arr T (the_Intg i)) (Heap a) s)) Z)) \<and>. 
  3.1178 +   heap_free (Suc (Suc 0))} \<Longrightarrow>  
  3.1179 + G,A\<turnstile>{P} t\<succ> {\<lambda>Val:i:. abupd (check_neg i) .; Alloc G (Arr T(the_Intg i)) Q}"
  3.1180 +apply (erule conseq2)
  3.1181 +apply (auto elim!: halloc_elim_cases)
  3.1182 +done
  3.1183 +
  3.1184 +lemma ax_SXAlloc_catch_SXcpt: 
  3.1185 + "\<lbrakk>G,A\<turnstile>{P} t\<succ> {(\<lambda>Y (x,s) Z. x=Some (Xcpt (Std xn)) \<and>  
  3.1186 +  (\<forall>a. new_Addr (heap s) = Some a \<longrightarrow>  
  3.1187 +  Q Y (Some (Xcpt (Loc a)),init_obj G (CInst (SXcpt xn)) (Heap a) s) Z))  
  3.1188 +  \<and>. heap_free (Suc (Suc 0))}\<rbrakk> \<Longrightarrow>  
  3.1189 +  G,A\<turnstile>{P} t\<succ> {SXAlloc G (\<lambda>Y s Z. Q Y s Z \<and> G,s\<turnstile>catch SXcpt xn)}"
  3.1190 +apply (erule conseq2)
  3.1191 +apply (auto elim!: sxalloc_elim_cases halloc_elim_cases)
  3.1192 +done
  3.1193 +
  3.1194 +end
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/HOL/Bali/AxSound.thy	Mon Jan 28 17:00:19 2002 +0100
     4.3 @@ -0,0 +1,434 @@
     4.4 +(*  Title:      isabelle/Bali/AxSound.thy
     4.5 +    ID:         $Id$
     4.6 +    Author:     David von Oheimb
     4.7 +    Copyright   1999 Technische Universitaet Muenchen
     4.8 +*)
     4.9 +header {* Soundness proof for Axiomatic semantics of Java expressions and 
    4.10 +          statements
    4.11 +       *}
    4.12 +
    4.13 +
    4.14 +
    4.15 +theory AxSound = AxSem:
    4.16 +
    4.17 +section "validity"
    4.18 +
    4.19 +consts
    4.20 +
    4.21 + triple_valid2:: "prog \<Rightarrow> nat \<Rightarrow>        'a triple  \<Rightarrow> bool"
    4.22 +                                                (   "_\<Turnstile>_\<Colon>_"[61,0, 58] 57)
    4.23 +    ax_valids2:: "prog \<Rightarrow> 'a triples \<Rightarrow> 'a triples \<Rightarrow> bool"
    4.24 +                                                ("_,_|\<Turnstile>\<Colon>_" [61,58,58] 57)
    4.25 +
    4.26 +defs  triple_valid2_def: "G\<Turnstile>n\<Colon>t \<equiv> case t of {P} t\<succ> {Q} \<Rightarrow>
    4.27 + \<forall>Y s Z. P Y s Z \<longrightarrow> (\<forall>L. s\<Colon>\<preceq>(G,L) 
    4.28 + \<longrightarrow> (\<forall>T C. (normal s \<longrightarrow> \<lparr>prg=G,cls=C,lcl=L\<rparr>\<turnstile>t\<Colon>T) \<longrightarrow>
    4.29 + (\<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.30 +
    4.31 +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.32 +
    4.33 +lemma triple_valid2_def2: "G\<Turnstile>n\<Colon>{P} t\<succ> {Q} =  
    4.34 + (\<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.35 +  (\<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.36 +  Q Y' s' Z \<and> s'\<Colon>\<preceq>(G,L)))))"
    4.37 +apply (unfold triple_valid2_def)
    4.38 +apply (simp (no_asm) add: split_paired_All)
    4.39 +apply blast
    4.40 +done
    4.41 +
    4.42 +lemma triple_valid2_eq [rule_format (no_asm)]: 
    4.43 +  "wf_prog G ==> triple_valid2 G = triple_valid G"
    4.44 +apply (rule ext)
    4.45 +apply (rule ext)
    4.46 +apply (rule triple.induct)
    4.47 +apply (simp (no_asm) add: triple_valid_def2 triple_valid2_def2)
    4.48 +apply (rule iffI)
    4.49 +apply  fast
    4.50 +apply clarify
    4.51 +apply (tactic "smp_tac 3 1")
    4.52 +apply (case_tac "normal s")
    4.53 +apply  clarsimp
    4.54 +apply  (blast dest: evaln_eval eval_type_sound [THEN conjunct1])
    4.55 +apply clarsimp
    4.56 +done
    4.57 +
    4.58 +lemma ax_valids2_eq: "wf_prog G \<Longrightarrow> G,A|\<Turnstile>\<Colon>ts = G,A|\<Turnstile>ts"
    4.59 +apply (unfold ax_valids_def ax_valids2_def)
    4.60 +apply (force simp add: triple_valid2_eq)
    4.61 +done
    4.62 +
    4.63 +lemma triple_valid2_Suc [rule_format (no_asm)]: "G\<Turnstile>Suc n\<Colon>t \<longrightarrow> G\<Turnstile>n\<Colon>t"
    4.64 +apply (induct_tac "t")
    4.65 +apply (subst triple_valid2_def2)
    4.66 +apply (subst triple_valid2_def2)
    4.67 +apply (fast intro: evaln_nonstrict_Suc)
    4.68 +done
    4.69 +
    4.70 +lemma Methd_triple_valid2_0: "G\<Turnstile>0\<Colon>{Normal P} Methd C sig-\<succ> {Q}"
    4.71 +apply (clarsimp elim!: evaln_elim_cases simp add: triple_valid2_def2)
    4.72 +done
    4.73 +
    4.74 +lemma Methd_triple_valid2_SucI: 
    4.75 +"\<lbrakk>G\<Turnstile>n\<Colon>{Normal P} body G C sig-\<succ>{Q}\<rbrakk> 
    4.76 +  \<Longrightarrow> G\<Turnstile>Suc n\<Colon>{Normal P} Methd C sig-\<succ> {Q}"
    4.77 +apply (simp (no_asm_use) add: triple_valid2_def2)
    4.78 +apply (intro strip, tactic "smp_tac 3 1", clarify)
    4.79 +apply (erule wt_elim_cases, erule evaln_elim_cases)
    4.80 +apply (unfold body_def Let_def)
    4.81 +apply clarsimp
    4.82 +apply blast
    4.83 +done
    4.84 +
    4.85 +lemma triples_valid2_Suc: 
    4.86 + "Ball ts (triple_valid2 G (Suc n)) \<Longrightarrow> Ball ts (triple_valid2 G n)"
    4.87 +apply (fast intro: triple_valid2_Suc)
    4.88 +done
    4.89 +
    4.90 +lemma "G|\<Turnstile>n:insert t A = (G\<Turnstile>n:t \<and> G|\<Turnstile>n:A)";
    4.91 +oops
    4.92 +
    4.93 +
    4.94 +section "soundness"
    4.95 +
    4.96 +lemma Methd_sound: 
    4.97 +"\<lbrakk>G,A\<union>  {{P} Methd-\<succ> {Q} | ms}|\<Turnstile>\<Colon>{{P} body G-\<succ> {Q} | ms}\<rbrakk> \<Longrightarrow> 
    4.98 +  G,A|\<Turnstile>\<Colon>{{P} Methd-\<succ> {Q} | ms}"
    4.99 +apply (unfold ax_valids2_def mtriples_def)
   4.100 +apply (rule allI)
   4.101 +apply (induct_tac "n")
   4.102 +apply  (clarify, tactic {* pair_tac "x" 1 *}, simp (no_asm))
   4.103 +apply  (fast intro: Methd_triple_valid2_0)
   4.104 +apply (clarify, tactic {* pair_tac "xa" 1 *}, simp (no_asm))
   4.105 +apply (drule triples_valid2_Suc)
   4.106 +apply (erule (1) notE impE)
   4.107 +apply (drule_tac x = na in spec)
   4.108 +apply (tactic {* auto_tac (claset() addSIs [thm "Methd_triple_valid2_SucI"],
   4.109 +   simpset() addsimps [ball_Un] addloop ("split_all_tac", split_all_tac)) *})
   4.110 +done
   4.111 +
   4.112 +
   4.113 +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.114 +  Ball A (triple_valid2 G n) \<longrightarrow> (\<forall>Y Z. P Y s Z \<longrightarrow>  
   4.115 +  (\<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.116 +  Q Y' s' Z \<and> s'\<Colon>\<preceq>(G, L)))) \<Longrightarrow>  
   4.117 +  G,A|\<Turnstile>\<Colon>{ {P} c\<succ> {Q}}"
   4.118 +apply (simp (no_asm) add: ax_valids2_def triple_valid2_def2)
   4.119 +apply clarsimp
   4.120 +done
   4.121 +
   4.122 +ML_setup {*
   4.123 +Delsimprocs [evaln_expr_proc,evaln_var_proc,evaln_exprs_proc,evaln_stmt_proc]
   4.124 +*}
   4.125 +
   4.126 +lemma Loop_sound: "\<lbrakk>G,A|\<Turnstile>\<Colon>{ {P} e-\<succ> {P'}};  
   4.127 +       G,A|\<Turnstile>\<Colon>{ {Normal (P'\<leftarrow>=True)} .c. {abupd (absorb (Cont l)) .; P}}\<rbrakk> \<Longrightarrow>  
   4.128 +       G,A|\<Turnstile>\<Colon>{ {P} .l\<bullet> While(e) c. {(P'\<leftarrow>=False)\<down>=\<diamondsuit>}}"
   4.129 +apply (rule valids2_inductI)
   4.130 +apply ((rule allI)+, rule impI, tactic {* pair_tac "s" 1*}, tactic {* pair_tac "s'" 1*})
   4.131 +apply (erule evaln.induct)
   4.132 +apply  simp_all (* takes half a minute *)
   4.133 +apply  clarify
   4.134 +apply  (erule_tac V = "G,A|\<Turnstile>\<Colon>{ {?P'} .c. {?P}}" in thin_rl)
   4.135 +apply  (simp_all (no_asm_use) add: ax_valids2_def triple_valid2_def2)
   4.136 +apply  (tactic "smp_tac 1 1", tactic "smp_tac 3 1", force)
   4.137 +apply clarify
   4.138 +apply (rule wt_elim_cases, assumption)
   4.139 +apply (tactic "smp_tac 1 1", tactic "smp_tac 1 1", tactic "smp_tac 3 1", 
   4.140 +       tactic "smp_tac 2 1", tactic "smp_tac 1 1")
   4.141 +apply (erule impE,simp (no_asm),blast)
   4.142 +apply (simp add: imp_conjL split_tupled_all split_paired_All)
   4.143 +apply (case_tac "the_Bool b")
   4.144 +apply  clarsimp
   4.145 +apply  (case_tac "a")
   4.146 +apply (simp_all)
   4.147 +apply clarsimp
   4.148 +apply  (erule_tac V = "c = l\<bullet> While(e) c \<longrightarrow> ?P" in thin_rl)
   4.149 +apply (blast intro: conforms_absorb)
   4.150 +apply blast+
   4.151 +done
   4.152 +
   4.153 +declare subst_Bool_def2 [simp del]
   4.154 +lemma all_empty: "(!x. P) = P"
   4.155 +by simp
   4.156 +lemma sound_valid2_lemma: 
   4.157 +"\<lbrakk>\<forall>v n. Ball A (triple_valid2 G n) \<longrightarrow> P v n; Ball A (triple_valid2 G n)\<rbrakk>
   4.158 + \<Longrightarrow>P v n"
   4.159 +by blast
   4.160 +ML {*
   4.161 +val fullsimptac = full_simp_tac(simpset() delsimps [thm "all_empty"]);
   4.162 +val sound_prepare_tac = EVERY'[REPEAT o thin_tac "?x \<in> ax_derivs G",
   4.163 + full_simp_tac (simpset()addsimps[thm "ax_valids2_def",thm "triple_valid2_def2",
   4.164 +                                  thm "imp_conjL"] delsimps[thm "all_empty"]),
   4.165 + Clarify_tac];
   4.166 +val sound_elim_tac = EVERY'[eresolve_tac (thms "evaln_elim_cases"), 
   4.167 +        TRY o eresolve_tac (thms "wt_elim_cases"), fullsimptac, Clarify_tac];
   4.168 +val sound_valid2_tac = REPEAT o FIRST'[smp_tac 1, 
   4.169 +                  datac (thm "sound_valid2_lemma") 1];
   4.170 +val sound_forw_hyp_tac = 
   4.171 + EVERY'[smp_tac 3 
   4.172 +          ORELSE' EVERY'[dtac spec,dtac spec, dtac spec,etac impE, Fast_tac] 
   4.173 +          ORELSE' EVERY'[dtac spec,dtac spec,etac impE, Fast_tac],
   4.174 +        fullsimptac, 
   4.175 +        smp_tac 2,TRY o smp_tac 1,
   4.176 +        TRY o EVERY'[etac impE, TRY o rtac impI, 
   4.177 +        atac ORELSE' (EVERY' [REPEAT o rtac exI,Blast_tac]),
   4.178 +        fullsimptac, Clarify_tac, TRY o smp_tac 1]]
   4.179 +*}
   4.180 +(* ### rtac conjI,rtac HOL.refl *)
   4.181 +lemma Call_sound: 
   4.182 +"\<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.183 +  \<forall>a vs invC declC l. G,A|\<Turnstile>\<Colon>{ {(R a\<leftarrow>Vals vs \<and>.  
   4.184 +   (\<lambda>s. declC = invocation_declclass 
   4.185 +                    G mode (store s) a statT \<lparr>name=mn,parTs=pTs\<rparr> \<and>
   4.186 +         invC = invocation_class mode (store s) a statT \<and>
   4.187 +            l = locals (store s)) ;.  
   4.188 +   init_lvars G declC \<lparr>name=mn,parTs=pTs\<rparr> mode a vs) \<and>.  
   4.189 +   (\<lambda>s. normal s \<longrightarrow> G\<turnstile>mode\<rightarrow>invC\<preceq>statT)}  
   4.190 +   Methd declC \<lparr>name=mn,parTs=pTs\<rparr>-\<succ> {set_lvars l .; S}}\<rbrakk> \<Longrightarrow>  
   4.191 +  G,A|\<Turnstile>\<Colon>{ {Normal P} {statT,mode}e\<cdot>mn({pTs}ps)-\<succ> {S}}"
   4.192 +apply (tactic "EVERY'[sound_prepare_tac, sound_elim_tac, sound_valid2_tac] 1")
   4.193 +apply (rename_tac x1 s1 x2 s2 ab bb v vs m pTsa statDeclC)
   4.194 +apply (tactic "smp_tac 6 1")
   4.195 +apply (tactic "sound_forw_hyp_tac 1")
   4.196 +apply (tactic "sound_forw_hyp_tac 1")
   4.197 +apply (drule max_spec2mheads)
   4.198 +apply (drule evaln_eval, drule (3) eval_ts)
   4.199 +apply (drule evaln_eval, frule (3) evals_ts)
   4.200 +apply (drule spec,erule impE,rule exI, blast)
   4.201 +(* apply (drule spec,drule spec,drule spec,erule impE,rule exI,blast) *)
   4.202 +apply (case_tac "if static m then x2 else (np a') x2")
   4.203 +defer 1
   4.204 +apply  (rename_tac x, subgoal_tac "(Some x, s2)\<Colon>\<preceq>(G, L)" (* used two times *))
   4.205 +prefer 2 
   4.206 +apply   (force split add: split_if_asm)
   4.207 +apply  (simp del: if_raise_if_None)
   4.208 +apply  (tactic "smp_tac 2 1")
   4.209 +apply (simp only: init_lvars_def2 invmode_Static_eq)
   4.210 +apply (clarsimp simp del: resTy_mthd)
   4.211 +apply  (drule spec,erule swap,erule conforms_set_locals [OF _ lconf_empty])
   4.212 +apply clarsimp
   4.213 +apply (drule Null_staticD)
   4.214 +apply (drule eval_gext', drule (1) conf_gext, frule (3) DynT_propI)
   4.215 +apply (erule impE) apply blast
   4.216 +apply (subgoal_tac 
   4.217 + "G\<turnstile>invmode (mhd (statDeclC,m)) e
   4.218 +     \<rightarrow>invocation_class (invmode m e) s2 a' statT\<preceq>statT")
   4.219 +defer   apply simp
   4.220 +apply (drule (3) DynT_mheadsD,simp,simp)
   4.221 +apply (clarify, drule wf_mdeclD1, clarify)
   4.222 +apply (frule ty_expr_is_type) apply simp
   4.223 +apply (subgoal_tac "invmode (mhd (statDeclC,m)) e = IntVir \<longrightarrow> a' \<noteq> Null")
   4.224 +defer   apply simp
   4.225 +apply (frule (2) wt_MethdI)
   4.226 +apply clarify
   4.227 +apply (drule (2) conforms_init_lvars)
   4.228 +apply   (simp) 
   4.229 +apply   (assumption)+
   4.230 +apply   simp
   4.231 +apply   (assumption)+
   4.232 +apply   (rule impI) apply simp
   4.233 +apply   simp
   4.234 +apply   simp
   4.235 +apply   (rule Ball_weaken)
   4.236 +apply     assumption
   4.237 +apply     (force simp add: is_acc_type_def)
   4.238 +apply (tactic "smp_tac 2 1")
   4.239 +apply simp
   4.240 +apply (tactic "smp_tac 1 1")
   4.241 +apply (erule_tac V = "?P \<longrightarrow> ?Q" in thin_rl) 
   4.242 +apply (erule impE)
   4.243 +apply   (rule exI)+ 
   4.244 +apply   (subgoal_tac "is_static dm = (static m)") 
   4.245 +prefer 2  apply (simp add: member_is_static_simp)
   4.246 +apply   (simp only: )
   4.247 +apply   (simp only: sig.simps)
   4.248 +apply (force dest!: evaln_eval eval_gext' elim: conforms_return 
   4.249 +             del: impCE simp add: init_lvars_def2)
   4.250 +done
   4.251 +
   4.252 +lemma Init_sound: "\<lbrakk>wf_prog G; the (class G C) = c;  
   4.253 +      G,A|\<Turnstile>\<Colon>{ {Normal ((P \<and>. Not \<circ> initd C) ;. supd (init_class_obj G C))}  
   4.254 +             .(if C = Object then Skip else Init (super c)). {Q}};  
   4.255 +  \<forall>l. G,A|\<Turnstile>\<Colon>{ {Q \<and>. (\<lambda>s. l = locals (store s)) ;. set_lvars empty}  
   4.256 +            .init c. {set_lvars l .; R}}\<rbrakk> \<Longrightarrow>  
   4.257 +      G,A|\<Turnstile>\<Colon>{ {Normal (P \<and>. Not \<circ> initd C)} .Init C. {R}}"
   4.258 +apply (tactic "EVERY'[sound_prepare_tac, sound_elim_tac,sound_valid2_tac] 1")
   4.259 +apply (tactic {* instantiate_tac [("l24","\<lambda> n Y Z sa Y' s' L y a b aa ba ab bb. locals b")]*})
   4.260 +apply (clarsimp simp add: split_paired_Ex)
   4.261 +apply (drule spec, drule spec, drule spec, erule impE)
   4.262 +apply  (erule_tac V = "All ?P" in thin_rl, fast)
   4.263 +apply clarsimp
   4.264 +apply (tactic "smp_tac 2 1", drule spec, erule impE, 
   4.265 +       erule (3) conforms_init_class_obj)
   4.266 +apply (drule (1) wf_prog_cdecl)
   4.267 +apply (erule impE, rule exI,erule_tac V = "All ?P" in thin_rl,
   4.268 +       force dest: wf_cdecl_supD split add: split_if simp add: is_acc_class_def)
   4.269 +apply clarify
   4.270 +apply (drule spec)
   4.271 +apply (drule spec)
   4.272 +apply (drule spec)
   4.273 +apply  (erule impE)
   4.274 +apply ( fast)
   4.275 +apply (simp (no_asm_use) del: empty_def2)
   4.276 +apply (tactic "smp_tac 2 1")
   4.277 +apply (drule spec, erule impE, erule conforms_set_locals, rule lconf_empty)
   4.278 +apply (erule impE,rule impI,rule exI, erule wf_cdecl_wt_init)
   4.279 +apply clarsimp
   4.280 +apply (erule (1) conforms_return, force dest: evaln_eval eval_gext')
   4.281 +done
   4.282 +
   4.283 +lemma all_conjunct2: "\<forall>l. P' l \<and> P l \<Longrightarrow> \<forall>l. P l"
   4.284 +by fast
   4.285 +
   4.286 +lemma all4_conjunct2: 
   4.287 +  "\<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.288 +by fast
   4.289 +
   4.290 +lemmas sound_lemmas = Init_sound Loop_sound Methd_sound
   4.291 +
   4.292 +lemma ax_sound2: "wf_prog G \<Longrightarrow> G,A|\<turnstile>ts \<Longrightarrow> G,A|\<Turnstile>\<Colon>ts"
   4.293 +apply (erule ax_derivs.induct)
   4.294 +prefer 20 (* Call *)
   4.295 +apply (erule (1) Call_sound) apply simp apply force apply force 
   4.296 +
   4.297 +apply (tactic {* TRYALL (eresolve_tac (thms "sound_lemmas") THEN_ALL_NEW 
   4.298 +    eresolve_tac [asm_rl, thm "all_conjunct2", thm "all4_conjunct2"]) *})
   4.299 +
   4.300 +apply(tactic "COND (has_fewer_prems(30+3)) (ALLGOALS sound_prepare_tac) no_tac")
   4.301 +
   4.302 +               (*empty*)
   4.303 +apply        fast (* insert *)
   4.304 +apply       fast (* asm *)
   4.305 +(*apply    fast *) (* cut *)
   4.306 +apply     fast (* weaken *)
   4.307 +apply    (tactic "smp_tac 3 1", clarify, tactic "smp_tac 1 1", frule evaln_eval,
   4.308 +(* conseq *)case_tac"fst s",clarsimp simp add: eval_type_sound [THEN conjunct1],
   4.309 +clarsimp)
   4.310 +apply   (simp (no_asm_use) add: type_ok_def, drule evaln_eval,fast) (* hazard *)
   4.311 +apply  force (* Abrupt *)
   4.312 +
   4.313 +(* 25 subgoals *)
   4.314 +apply (tactic {* ALLGOALS sound_elim_tac *})(* LVar, Lit, Super, Nil, Skip,Do *)
   4.315 +apply (tactic {* ALLGOALS (asm_simp_tac (noAll_simpset() 
   4.316 +                          delsimps [thm "all_empty"])) *})    (* Done *)
   4.317 +(* for FVar *)
   4.318 +apply (frule wf_ws_prog) 
   4.319 +apply (frule ty_expr_is_type [THEN type_is_class, 
   4.320 +                              THEN accfield_declC_is_class])
   4.321 +apply (simp,simp,simp) 
   4.322 +apply (frule_tac [4] wt_init_comp_ty) (* for NewA*)
   4.323 +apply (tactic "ALLGOALS sound_valid2_tac")
   4.324 +apply (tactic "TRYALL sound_forw_hyp_tac") (* Cast, Inst, Acc, Expr *)
   4.325 +apply (tactic {* TRYALL (EVERY'[dtac spec, TRY o EVERY'[rotate_tac ~1, 
   4.326 +  dtac spec], dtac conjunct2, smp_tac 1, 
   4.327 +  TRY o dres_inst_tac [("P","P'")] (thm "subst_Bool_the_BoolI")]) *})
   4.328 +apply (frule_tac [14] x = x1 in conforms_NormI)  (* for Fin *)
   4.329 +
   4.330 +
   4.331 +(* 15 subgoals *)
   4.332 +(* FVar *)
   4.333 +apply (tactic "sound_forw_hyp_tac 1")
   4.334 +apply (clarsimp simp add: fvar_def2 Let_def split add: split_if_asm)
   4.335 +
   4.336 +(* AVar *)
   4.337 +(*
   4.338 +apply (drule spec, drule spec, erule impE, fast)
   4.339 +apply (simp)
   4.340 +apply (tactic "smp_tac 2 1")
   4.341 +apply (tactic "smp_tac 1 1")
   4.342 +apply (erule impE)
   4.343 +apply (rule impI)
   4.344 +apply (rule exI)+
   4.345 +apply blast
   4.346 +apply (clarsimp simp add: avar_def2)
   4.347 +*)
   4.348 +apply (tactic "sound_forw_hyp_tac 1")
   4.349 +apply (clarsimp simp add: avar_def2)
   4.350 +
   4.351 +(* NewC *)
   4.352 +apply (clarsimp simp add: is_acc_class_def)
   4.353 +apply (erule (1) halloc_conforms, simp, simp)
   4.354 +
   4.355 +(* NewA *)
   4.356 +apply (tactic "sound_forw_hyp_tac 1")
   4.357 +apply (rule conjI,blast)
   4.358 +apply (erule (1) halloc_conforms, simp, simp, simp add: is_acc_type_def)
   4.359 +
   4.360 +(* Ass *)
   4.361 +apply (tactic "sound_forw_hyp_tac 1")
   4.362 +apply (case_tac "aa")
   4.363 +prefer 2
   4.364 +apply  clarsimp
   4.365 +apply (drule evaln_eval)+
   4.366 +apply (frule (3) eval_ts)
   4.367 +apply clarsimp
   4.368 +apply (frule (3) evar_ts [THEN conjunct2])
   4.369 +apply (frule wf_ws_prog)
   4.370 +apply (drule (2) conf_widen)
   4.371 +apply (drule_tac "s1.0" = b in eval_gext')
   4.372 +apply (clarsimp simp add: assign_conforms_def)
   4.373 +
   4.374 +(* Cond *)
   4.375 +
   4.376 +apply (tactic "smp_tac 3 1") apply (tactic "smp_tac 2 1") 
   4.377 +apply (tactic "smp_tac 1 1") apply (erule impE) 
   4.378 +apply (rule impI,rule exI) 
   4.379 +apply (rule_tac x = "if the_Bool b then T1 else T2" in exI)
   4.380 +apply (force split add: split_if)
   4.381 +apply assumption
   4.382 +
   4.383 +(* Body *)
   4.384 +apply (tactic "sound_forw_hyp_tac 1")
   4.385 +apply (rule conforms_absorb,assumption)
   4.386 +
   4.387 +(* Lab *)
   4.388 +apply (tactic "sound_forw_hyp_tac 1")
   4.389 +apply (rule conforms_absorb,assumption)
   4.390 +
   4.391 +(* If *)
   4.392 +apply (tactic "sound_forw_hyp_tac 1")
   4.393 +apply (tactic "sound_forw_hyp_tac 1")
   4.394 +apply (force split add: split_if)
   4.395 +
   4.396 +(* Throw *)
   4.397 +apply (drule evaln_eval, drule (3) eval_ts)
   4.398 +apply clarsimp
   4.399 +apply (drule (3) Throw_lemma)
   4.400 +apply clarsimp
   4.401 +
   4.402 +(* Try *)
   4.403 +apply (frule (1) sxalloc_type_sound)
   4.404 +apply (erule sxalloc_elim_cases2)
   4.405 +apply  (tactic "smp_tac 3 1")
   4.406 +apply  (clarsimp split add: option.split_asm)
   4.407 +apply (clarsimp split add: option.split_asm)
   4.408 +apply (tactic "smp_tac 1 1")
   4.409 +apply (simp only: split add: split_if_asm)
   4.410 +prefer 2
   4.411 +apply  (tactic "smp_tac 3 1", erule_tac V = "All ?P" in thin_rl, clarsimp)
   4.412 +apply (drule spec, erule_tac V = "All ?P" in thin_rl, drule spec, drule spec, 
   4.413 +       erule impE, force)
   4.414 +apply (frule (2) Try_lemma)
   4.415 +apply clarsimp
   4.416 +apply (fast elim!: conforms_deallocL)
   4.417 +
   4.418 +(* Fin *)
   4.419 +apply (tactic "sound_forw_hyp_tac 1")
   4.420 +apply (case_tac "x1", force)
   4.421 +apply clarsimp
   4.422 +apply (drule evaln_eval, drule (4) Fin_lemma)
   4.423 +done
   4.424 +
   4.425 +
   4.426 +
   4.427 +declare subst_Bool_def2 [simp]
   4.428 +
   4.429 +theorem ax_sound: 
   4.430 + "wf_prog G \<Longrightarrow> G,(A::'a triple set)|\<turnstile>(ts::'a triple set) \<Longrightarrow> G,A|\<Turnstile>ts"
   4.431 +apply (subst ax_valids2_eq [symmetric])
   4.432 +apply  assumption
   4.433 +apply (erule (1) ax_sound2)
   4.434 +done
   4.435 +
   4.436 +
   4.437 +end
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/Bali/Basis.thy	Mon Jan 28 17:00:19 2002 +0100
     5.3 @@ -0,0 +1,370 @@
     5.4 +(*  Title:      isabelle/Bali/Basis.thy
     5.5 +    ID:         $Id$
     5.6 +    Author:     David von Oheimb
     5.7 +    Copyright   1997 Technische Universitaet Muenchen
     5.8 +
     5.9 +*)
    5.10 +header {* Definitions extending HOL as logical basis of Bali *}
    5.11 +
    5.12 +theory Basis = Main:
    5.13 +
    5.14 +ML_setup {*
    5.15 +Unify.search_bound := 40;
    5.16 +Unify.trace_bound  := 40;
    5.17 +
    5.18 +quick_and_dirty:=true;
    5.19 +
    5.20 +Pretty.setmargin 77;
    5.21 +goals_limit:=2;
    5.22 +*}
    5.23 +(*print_depth 100;*)
    5.24 +(*Syntax.ambiguity_level := 1;*)
    5.25 +
    5.26 +section "misc"
    5.27 +
    5.28 +declare same_fstI [intro!] (*### TO HOL/Wellfounded_Relations *)
    5.29 +
    5.30 +(* ###TO HOL/???.ML?? *)
    5.31 +ML {*
    5.32 +fun make_simproc name pat pred thm = Simplifier.mk_simproc name
    5.33 +   [Thm.read_cterm (Thm.sign_of_thm thm) (pat, HOLogic.typeT)] 
    5.34 +   (K (K (fn s => if pred s then None else Some (standard (mk_meta_eq thm)))))
    5.35 +*}
    5.36 +
    5.37 +declare split_if_asm  [split] option.split [split] option.split_asm [split]
    5.38 +ML {*
    5.39 +simpset_ref() := simpset() addloop ("split_all_tac", split_all_tac)
    5.40 +*}
    5.41 +declare if_weak_cong [cong del] option.weak_case_cong [cong del]
    5.42 +declare length_Suc_conv [iff];
    5.43 +
    5.44 +(*###to be phased out *)
    5.45 +ML {*
    5.46 +bind_thm ("make_imp", rearrange_prems [1,0] mp)
    5.47 +*}
    5.48 +
    5.49 +lemma Collect_split_eq: "{p. P (split f p)} = {(a,b). P (f a b)}"
    5.50 +apply auto
    5.51 +done
    5.52 +
    5.53 +lemma subset_insertD: 
    5.54 +  "A <= insert x B ==> A <= B & x ~: A | (EX B'. A = insert x B' & B' <= B)"
    5.55 +apply (case_tac "x:A")
    5.56 +apply (rule disjI2)
    5.57 +apply (rule_tac x = "A-{x}" in exI)
    5.58 +apply fast+
    5.59 +done
    5.60 +
    5.61 +syntax
    5.62 +  "3" :: nat   ("3")
    5.63 +  "4" :: nat   ("4")
    5.64 +translations
    5.65 + "3" == "Suc 2"
    5.66 + "4" == "Suc 3"
    5.67 +
    5.68 +(*unused*)
    5.69 +lemma range_bool_domain: "range f = {f True, f False}"
    5.70 +apply auto
    5.71 +apply (case_tac "xa")
    5.72 +apply auto
    5.73 +done
    5.74 +
    5.75 +(* context (theory "Transitive_Closure") *)
    5.76 +lemma irrefl_tranclI': "r^-1 Int r^+ = {} ==> !x. (x, x) ~: r^+"
    5.77 +apply (rule allI)
    5.78 +apply (erule irrefl_tranclI)
    5.79 +done
    5.80 +
    5.81 +lemma trancl_rtrancl_trancl:
    5.82 +"\<lbrakk>(x,y)\<in>r^+; (y,z)\<in>r^*\<rbrakk> \<Longrightarrow> (x,z)\<in>r^+"
    5.83 +by (auto dest: tranclD rtrancl_trans rtrancl_into_trancl2)
    5.84 +
    5.85 +lemma rtrancl_into_trancl3:
    5.86 +"\<lbrakk>(a,b)\<in>r^*; a\<noteq>b\<rbrakk> \<Longrightarrow> (a,b)\<in>r^+"
    5.87 +apply (drule rtranclD)
    5.88 +apply auto
    5.89 +done
    5.90 +
    5.91 +lemma rtrancl_into_rtrancl2: 
    5.92 +  "\<lbrakk> (a, b) \<in>  r; (b, c) \<in> r^* \<rbrakk> \<Longrightarrow> (a, c) \<in>  r^*"
    5.93 +by (auto intro: r_into_rtrancl rtrancl_trans)
    5.94 +
    5.95 +lemma triangle_lemma:
    5.96 + "\<lbrakk> \<And> a b c. \<lbrakk>(a,b)\<in>r; (a,c)\<in>r\<rbrakk> \<Longrightarrow> b=c; (a,x)\<in>r\<^sup>*; (a,y)\<in>r\<^sup>*\<rbrakk> 
    5.97 + \<Longrightarrow> (x,y)\<in>r\<^sup>* \<or> (y,x)\<in>r\<^sup>*"
    5.98 +proof -
    5.99 +  note converse_rtrancl_induct = converse_rtrancl_induct [consumes 1]
   5.100 +  note converse_rtranclE = converse_rtranclE [consumes 1] 
   5.101 +  assume unique: "\<And> a b c. \<lbrakk>(a,b)\<in>r; (a,c)\<in>r\<rbrakk> \<Longrightarrow> b=c"
   5.102 +  assume "(a,x)\<in>r\<^sup>*" 
   5.103 +  then show "(a,y)\<in>r\<^sup>* \<Longrightarrow> (x,y)\<in>r\<^sup>* \<or> (y,x)\<in>r\<^sup>*"
   5.104 +  proof (induct rule: converse_rtrancl_induct)
   5.105 +    assume "(x,y)\<in>r\<^sup>*"
   5.106 +    then show ?thesis 
   5.107 +      by blast
   5.108 +  next
   5.109 +    fix a v
   5.110 +    assume a_v_r: "(a, v) \<in> r" and
   5.111 +          v_x_rt: "(v, x) \<in> r\<^sup>*" and
   5.112 +          a_y_rt: "(a, y) \<in> r\<^sup>*"  and
   5.113 +             hyp: "(v, y) \<in> r\<^sup>* \<Longrightarrow> (x, y) \<in> r\<^sup>* \<or> (y, x) \<in> r\<^sup>*"
   5.114 +    from a_y_rt 
   5.115 +    show "(x, y) \<in> r\<^sup>* \<or> (y, x) \<in> r\<^sup>*"
   5.116 +    proof (cases rule: converse_rtranclE)
   5.117 +      assume "a=y"
   5.118 +      with a_v_r v_x_rt have "(y,x) \<in> r\<^sup>*"
   5.119 +	by (auto intro: r_into_rtrancl rtrancl_trans)
   5.120 +      then show ?thesis 
   5.121 +	by blast
   5.122 +    next
   5.123 +      fix w 
   5.124 +      assume a_w_r: "(a, w) \<in> r" and
   5.125 +            w_y_rt: "(w, y) \<in> r\<^sup>*"
   5.126 +      from a_v_r a_w_r unique 
   5.127 +      have "v=w" 
   5.128 +	by auto
   5.129 +      with w_y_rt hyp 
   5.130 +      show ?thesis
   5.131 +	by blast
   5.132 +    qed
   5.133 +  qed
   5.134 +qed
   5.135 +
   5.136 +
   5.137 +lemma rtrancl_cases [consumes 1, case_names Refl Trancl]:
   5.138 + "\<lbrakk>(a,b)\<in>r\<^sup>*;  a = b \<Longrightarrow> P; (a,b)\<in>r\<^sup>+ \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   5.139 +apply (erule rtranclE)
   5.140 +apply (auto dest: rtrancl_into_trancl1)
   5.141 +done
   5.142 +
   5.143 +(* ### To Transitive_Closure *)
   5.144 +theorems converse_rtrancl_induct 
   5.145 + = converse_rtrancl_induct [consumes 1,case_names Id Step]
   5.146 +
   5.147 +theorems converse_trancl_induct 
   5.148 +         = converse_trancl_induct [consumes 1,case_names Single Step]
   5.149 +
   5.150 +(* context (theory "Set") *)
   5.151 +lemma Ball_weaken:"\<lbrakk>Ball s P;\<And> x. P x\<longrightarrow>Q x\<rbrakk>\<Longrightarrow>Ball s Q"
   5.152 +by auto
   5.153 +
   5.154 +(* context (theory "Finite") *)
   5.155 +lemma finite_SetCompr2: "[| finite (Collect P); !y. P y --> finite (range (f y)) |] ==>  
   5.156 +  finite {f y x |x y. P y}"
   5.157 +apply (subgoal_tac "{f y x |x y. P y} = UNION (Collect P) (%y. range (f y))")
   5.158 +prefer 2 apply  fast
   5.159 +apply (erule ssubst)
   5.160 +apply (erule finite_UN_I)
   5.161 +apply fast
   5.162 +done
   5.163 +
   5.164 +
   5.165 +(* ### TO theory "List" *)
   5.166 +lemma list_all2_trans: "\<forall> a b c. P1 a b \<longrightarrow> P2 b c \<longrightarrow> P3 a c \<Longrightarrow>
   5.167 + \<forall>xs2 xs3. list_all2 P1 xs1 xs2 \<longrightarrow> list_all2 P2 xs2 xs3 \<longrightarrow> list_all2 P3 xs1 xs3"
   5.168 +apply (induct_tac "xs1")
   5.169 +apply simp
   5.170 +apply (rule allI)
   5.171 +apply (induct_tac "xs2")
   5.172 +apply simp
   5.173 +apply (rule allI)
   5.174 +apply (induct_tac "xs3")
   5.175 +apply auto
   5.176 +done
   5.177 +
   5.178 +
   5.179 +section "pairs"
   5.180 +
   5.181 +lemma surjective_pairing5: "p = (fst p, fst (snd p), fst (snd (snd p)), fst (snd (snd (snd p))), 
   5.182 +  snd (snd (snd (snd p))))"
   5.183 +apply auto
   5.184 +done
   5.185 +
   5.186 +lemma fst_splitE [elim!]: 
   5.187 +"[| fst s' = x';  !!x s. [| s' = (x,s);  x = x' |] ==> Q |] ==> Q"
   5.188 +apply (cut_tac p = "s'" in surjective_pairing)
   5.189 +apply auto
   5.190 +done
   5.191 +
   5.192 +lemma fst_in_set_lemma [rule_format (no_asm)]: "(x, y) : set l --> x : fst ` set l"
   5.193 +apply (induct_tac "l")
   5.194 +apply  auto
   5.195 +done
   5.196 +
   5.197 +
   5.198 +section "quantifiers"
   5.199 +
   5.200 +(*###to be phased out *)
   5.201 +ML {* 
   5.202 +fun noAll_simpset () = simpset() setmksimps 
   5.203 +	mksimps (filter (fn (x,_) => x<>"All") mksimps_pairs)
   5.204 +*}
   5.205 +
   5.206 +lemma All_Ex_refl_eq2 [simp]: 
   5.207 + "(!x. (? b. x = f b & Q b) \<longrightarrow> P x) = (!b. Q b --> P (f b))"
   5.208 +apply auto
   5.209 +done
   5.210 +
   5.211 +lemma ex_ex_miniscope1 [simp]:
   5.212 +  "(EX w v. P w v & Q v) = (EX v. (EX w. P w v) & Q v)"
   5.213 +apply auto
   5.214 +done
   5.215 +
   5.216 +lemma ex_miniscope2 [simp]:
   5.217 +  "(EX v. P v & Q & R v) = (Q & (EX v. P v & R v))" 
   5.218 +apply auto
   5.219 +done
   5.220 +
   5.221 +lemma ex_reorder31: "(\<exists>z x y. P x y z) = (\<exists>x y z. P x y z)"
   5.222 +apply auto
   5.223 +done
   5.224 +
   5.225 +lemma All_Ex_refl_eq1 [simp]: "(!x. (? b. x = f b) --> P x) = (!b. P (f b))"
   5.226 +apply auto
   5.227 +done
   5.228 +
   5.229 +
   5.230 +section "sums"
   5.231 +
   5.232 +hide const In0 In1
   5.233 +
   5.234 +syntax
   5.235 +  fun_sum :: "('a => 'c) => ('b => 'c) => (('a+'b) => 'c)" (infixr "'(+')"80)
   5.236 +translations
   5.237 + "fun_sum" == "sum_case"
   5.238 +
   5.239 +consts    the_Inl  :: "'a + 'b \<Rightarrow> 'a"
   5.240 +          the_Inr  :: "'a + 'b \<Rightarrow> 'b"
   5.241 +primrec  "the_Inl (Inl a) = a"
   5.242 +primrec  "the_Inr (Inr b) = b"
   5.243 +
   5.244 +datatype ('a, 'b, 'c) sum3 = In1 'a | In2 'b | In3 'c
   5.245 +
   5.246 +consts    the_In1  :: "('a, 'b, 'c) sum3 \<Rightarrow> 'a"
   5.247 +          the_In2  :: "('a, 'b, 'c) sum3 \<Rightarrow> 'b"
   5.248 +          the_In3  :: "('a, 'b, 'c) sum3 \<Rightarrow> 'c"
   5.249 +primrec  "the_In1 (In1 a) = a"
   5.250 +primrec  "the_In2 (In2 b) = b"
   5.251 +primrec  "the_In3 (In3 c) = c"
   5.252 +
   5.253 +syntax
   5.254 +	 In1l	:: "'al \<Rightarrow> ('al + 'ar, 'b, 'c) sum3"
   5.255 +	 In1r	:: "'ar \<Rightarrow> ('al + 'ar, 'b, 'c) sum3"
   5.256 +translations
   5.257 +	"In1l e" == "In1 (Inl e)"
   5.258 +	"In1r c" == "In1 (Inr c)"
   5.259 +
   5.260 +ML {*
   5.261 +fun sum3_instantiate thm = map (fn s => simplify(simpset()delsimps[not_None_eq])
   5.262 + (read_instantiate [("t","In"^s^" ?x")] thm)) ["1l","2","3","1r"]
   5.263 +*}
   5.264 +(* e.g. lemmas is_stmt_rews = is_stmt_def [of "In1l x", simplified] *)
   5.265 +
   5.266 +translations
   5.267 +  "option"<= (type) "Option.option"
   5.268 +  "list"  <= (type) "List.list"
   5.269 +  "sum3"  <= (type) "Basis.sum3"
   5.270 +
   5.271 +
   5.272 +section "quantifiers for option type"
   5.273 +
   5.274 +syntax
   5.275 +  Oall :: "[pttrn, 'a option, bool] => bool"   ("(3! _:_:/ _)" [0,0,10] 10)
   5.276 +  Oex  :: "[pttrn, 'a option, bool] => bool"   ("(3? _:_:/ _)" [0,0,10] 10)
   5.277 +
   5.278 +syntax (symbols)
   5.279 +  Oall :: "[pttrn, 'a option, bool] => bool"   ("(3\<forall>_\<in>_:/ _)"  [0,0,10] 10)
   5.280 +  Oex  :: "[pttrn, 'a option, bool] => bool"   ("(3\<exists>_\<in>_:/ _)"  [0,0,10] 10)
   5.281 +
   5.282 +translations
   5.283 +  "! x:A: P"    == "! x:o2s A. P"
   5.284 +  "? x:A: P"    == "? x:o2s A. P"
   5.285 +
   5.286 +
   5.287 +section "unique association lists"
   5.288 +
   5.289 +constdefs
   5.290 +  unique   :: "('a \<times> 'b) list \<Rightarrow> bool"
   5.291 + "unique \<equiv> nodups \<circ> map fst"
   5.292 +
   5.293 +lemma uniqueD [rule_format (no_asm)]: 
   5.294 +"unique l--> (!x y. (x,y):set l --> (!x' y'. (x',y'):set l --> x=x'-->  y=y'))"
   5.295 +apply (unfold unique_def o_def)
   5.296 +apply (induct_tac "l")
   5.297 +apply  (auto dest: fst_in_set_lemma)
   5.298 +done
   5.299 +
   5.300 +lemma unique_Nil [simp]: "unique []"
   5.301 +apply (unfold unique_def)
   5.302 +apply (simp (no_asm))
   5.303 +done
   5.304 +
   5.305 +lemma unique_Cons [simp]: "unique ((x,y)#l) = (unique l & (!y. (x,y) ~: set l))"
   5.306 +apply (unfold unique_def)
   5.307 +apply  (auto dest: fst_in_set_lemma)
   5.308 +done
   5.309 +
   5.310 +lemmas unique_ConsI = conjI [THEN unique_Cons [THEN iffD2], standard]
   5.311 +
   5.312 +lemma unique_single [simp]: "!!p. unique [p]"
   5.313 +apply auto
   5.314 +done
   5.315 +
   5.316 +lemma unique_ConsD: "unique (x#xs) ==> unique xs"
   5.317 +apply (simp add: unique_def)
   5.318 +done
   5.319 +
   5.320 +lemma unique_append [rule_format (no_asm)]: "unique l' ==> unique l -->  
   5.321 +  (!(x,y):set l. !(x',y'):set l'. x' ~= x) --> unique (l @ l')"
   5.322 +apply (induct_tac "l")
   5.323 +apply  (auto dest: fst_in_set_lemma)
   5.324 +done
   5.325 +
   5.326 +lemma unique_map_inj [rule_format (no_asm)]: "unique l --> inj f --> unique (map (%(k,x). (f k, g k x)) l)"
   5.327 +apply (induct_tac "l")
   5.328 +apply  (auto dest: fst_in_set_lemma simp add: inj_eq)
   5.329 +done
   5.330 +
   5.331 +lemma map_of_SomeI [rule_format (no_asm)]: "unique l --> (k, x) : set l --> map_of l k = Some x"
   5.332 +apply (induct_tac "l")
   5.333 +apply auto
   5.334 +done
   5.335 +
   5.336 +
   5.337 +section "list patterns"
   5.338 +
   5.339 +consts
   5.340 +  lsplit         :: "[['a, 'a list] => 'b, 'a list] => 'b"
   5.341 +defs
   5.342 +  lsplit_def:    "lsplit == %f l. f (hd l) (tl l)"
   5.343 +(*  list patterns -- extends pre-defined type "pttrn" used in abstractions *)
   5.344 +syntax
   5.345 +  "_lpttrn"    :: "[pttrn,pttrn] => pttrn"     ("_#/_" [901,900] 900)
   5.346 +translations
   5.347 +  "%y#x#xs. b"  == "lsplit (%y x#xs. b)"
   5.348 +  "%x#xs  . b"  == "lsplit (%x xs  . b)"
   5.349 +
   5.350 +lemma lsplit [simp]: "lsplit c (x#xs) = c x xs"
   5.351 +apply (unfold lsplit_def)
   5.352 +apply (simp (no_asm))
   5.353 +done
   5.354 +
   5.355 +lemma lsplit2 [simp]: "lsplit P (x#xs) y z = P x xs y z"
   5.356 +apply (unfold lsplit_def)
   5.357 +apply simp
   5.358 +done 
   5.359 +
   5.360 +
   5.361 +section "dummy pattern for quantifiers, let, etc."
   5.362 +
   5.363 +syntax
   5.364 +  "@dummy_pat"   :: pttrn    ("'_")
   5.365 +
   5.366 +parse_translation {*
   5.367 +let fun dummy_pat_tr [] = Free ("_",dummyT)
   5.368 +  | dummy_pat_tr ts = raise TERM ("dummy_pat_tr", ts);
   5.369 +in [("@dummy_pat", dummy_pat_tr)] 
   5.370 +end
   5.371 +*}
   5.372 +
   5.373 +end
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/Bali/Conform.thy	Mon Jan 28 17:00:19 2002 +0100
     6.3 @@ -0,0 +1,447 @@
     6.4 +(*  Title:      isabelle/Bali/Conform.thy
     6.5 +    ID:         $Id$
     6.6 +    Author:     David von Oheimb
     6.7 +    Copyright   1997 Technische Universitaet Muenchen
     6.8 +*)
     6.9 +
    6.10 +header {* Conformance notions for the type soundness proof for Java *}
    6.11 +
    6.12 +theory Conform = State:
    6.13 +
    6.14 +text {*
    6.15 +design issues:
    6.16 +\begin{itemize}
    6.17 +\item lconf allows for (arbitrary) inaccessible values
    6.18 +\item ''conforms'' does not directly imply that the dynamic types of all 
    6.19 +      objects on the heap are indeed existing classes. Yet this can be 
    6.20 +      inferred for all referenced objs.
    6.21 +\end{itemize}
    6.22 +*}
    6.23 +
    6.24 +types	env_ = "prog \<times> (lname, ty) table" (* same as env of WellType.thy *)
    6.25 +
    6.26 +
    6.27 +section "extension of global store"
    6.28 +
    6.29 +constdefs
    6.30 +
    6.31 +  gext    :: "st \<Rightarrow> st \<Rightarrow> bool"                ("_\<le>|_"       [71,71]   70)
    6.32 +   "s\<le>|s' \<equiv> \<forall>r. \<forall>obj\<in>globs s r: \<exists>obj'\<in>globs s' r: tag obj'= tag obj"
    6.33 +
    6.34 +lemma gext_objD: 
    6.35 +"\<lbrakk>s\<le>|s'; globs s r = Some obj\<rbrakk> 
    6.36 +\<Longrightarrow> \<exists>obj'. globs s' r = Some obj' \<and> tag obj' = tag obj"
    6.37 +apply (simp only: gext_def)
    6.38 +by force
    6.39 +
    6.40 +lemma rev_gext_objD: 
    6.41 +"\<lbrakk>globs s r = Some obj; s\<le>|s'\<rbrakk> 
    6.42 + \<Longrightarrow> \<exists>obj'. globs s' r = Some obj' \<and> tag obj' = tag obj"
    6.43 +by (auto elim: gext_objD)
    6.44 +
    6.45 +lemma init_class_obj_inited: 
    6.46 +   "init_class_obj G C s1\<le>|s2 \<Longrightarrow> inited C (globs s2)"
    6.47 +apply (unfold inited_def init_obj_def)
    6.48 +apply (auto dest!: gext_objD)
    6.49 +done
    6.50 +
    6.51 +lemma gext_refl [intro!, simp]: "s\<le>|s"
    6.52 +apply (unfold gext_def)
    6.53 +apply (fast del: fst_splitE)
    6.54 +done
    6.55 +
    6.56 +lemma gext_gupd [simp, elim!]: "\<And>s. globs s r = None \<Longrightarrow> s\<le>|gupd(r\<mapsto>x)s"
    6.57 +by (auto simp: gext_def)
    6.58 +
    6.59 +lemma gext_new [simp, elim!]: "\<And>s. globs s r = None \<Longrightarrow> s\<le>|init_obj G oi r s"
    6.60 +apply (simp only: init_obj_def)
    6.61 +apply (erule_tac gext_gupd)
    6.62 +done
    6.63 +
    6.64 +lemma gext_trans [elim]: "\<And>X. \<lbrakk>s\<le>|s'; s'\<le>|s''\<rbrakk> \<Longrightarrow> s\<le>|s''" 
    6.65 +by (force simp: gext_def)
    6.66 +
    6.67 +lemma gext_upd_gobj [intro!]: "s\<le>|upd_gobj r n v s"
    6.68 +apply (simp only: gext_def)
    6.69 +apply auto
    6.70 +apply (case_tac "ra = r")
    6.71 +apply auto
    6.72 +apply (case_tac "globs s r = None")
    6.73 +apply auto
    6.74 +done
    6.75 +
    6.76 +lemma gext_cong1 [simp]: "set_locals l s1\<le>|s2 = s1\<le>|s2"
    6.77 +by (auto simp: gext_def)
    6.78 +
    6.79 +lemma gext_cong2 [simp]: "s1\<le>|set_locals l s2 = s1\<le>|s2"
    6.80 +by (auto simp: gext_def)
    6.81 +
    6.82 +
    6.83 +lemma gext_lupd1 [simp]: "lupd(vn\<mapsto>v)s1\<le>|s2 = s1\<le>|s2"
    6.84 +by (auto simp: gext_def)
    6.85 +
    6.86 +lemma gext_lupd2 [simp]: "s1\<le>|lupd(vn\<mapsto>v)s2 = s1\<le>|s2"
    6.87 +by (auto simp: gext_def)
    6.88 +
    6.89 +
    6.90 +lemma inited_gext: "\<lbrakk>inited C (globs s); s\<le>|s'\<rbrakk> \<Longrightarrow> inited C (globs s')"
    6.91 +apply (unfold inited_def)
    6.92 +apply (auto dest: gext_objD)
    6.93 +done
    6.94 +
    6.95 +
    6.96 +section "value conformance"
    6.97 +
    6.98 +constdefs
    6.99 +
   6.100 +  conf  :: "prog \<Rightarrow> st \<Rightarrow> val \<Rightarrow> ty \<Rightarrow> bool"    ("_,_\<turnstile>_\<Colon>\<preceq>_"   [71,71,71,71] 70)
   6.101 +	   "G,s\<turnstile>v\<Colon>\<preceq>T \<equiv> \<exists>T'\<in>typeof (\<lambda>a. option_map obj_ty (heap s a)) v:G\<turnstile>T'\<preceq>T"
   6.102 +
   6.103 +lemma conf_cong [simp]: "G,set_locals l s\<turnstile>v\<Colon>\<preceq>T = G,s\<turnstile>v\<Colon>\<preceq>T"
   6.104 +by (auto simp: conf_def)
   6.105 +
   6.106 +lemma conf_lupd [simp]: "G,lupd(vn\<mapsto>va)s\<turnstile>v\<Colon>\<preceq>T = G,s\<turnstile>v\<Colon>\<preceq>T"
   6.107 +by (auto simp: conf_def)
   6.108 +
   6.109 +lemma conf_PrimT [simp]: "\<forall>dt. typeof dt v = Some (PrimT t) \<Longrightarrow> G,s\<turnstile>v\<Colon>\<preceq>PrimT t"
   6.110 +apply (simp add: conf_def)
   6.111 +done
   6.112 +
   6.113 +lemma conf_litval [rule_format (no_asm)]: 
   6.114 +  "typeof (\<lambda>a. None) v = Some T \<longrightarrow> G,s\<turnstile>v\<Colon>\<preceq>T"
   6.115 +apply (unfold conf_def)
   6.116 +apply (rule val.induct)
   6.117 +apply auto
   6.118 +done
   6.119 +
   6.120 +lemma conf_Null [simp]: "G,s\<turnstile>Null\<Colon>\<preceq>T = G\<turnstile>NT\<preceq>T"
   6.121 +by (simp add: conf_def)
   6.122 +
   6.123 +lemma conf_Addr: 
   6.124 +  "G,s\<turnstile>Addr a\<Colon>\<preceq>T = (\<exists>obj. heap s a = Some obj \<and> G\<turnstile>obj_ty obj\<preceq>T)"
   6.125 +by (auto simp: conf_def)
   6.126 +
   6.127 +lemma conf_AddrI:"\<lbrakk>heap s a = Some obj; G\<turnstile>obj_ty obj\<preceq>T\<rbrakk> \<Longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq>T"
   6.128 +apply (rule conf_Addr [THEN iffD2])
   6.129 +by fast
   6.130 +
   6.131 +lemma defval_conf [rule_format (no_asm), elim]: 
   6.132 +  "is_type G T \<longrightarrow> G,s\<turnstile>default_val T\<Colon>\<preceq>T"
   6.133 +apply (unfold conf_def)
   6.134 +apply (induct "T")
   6.135 +apply (auto intro: prim_ty.induct)
   6.136 +done
   6.137 +
   6.138 +lemma conf_widen [rule_format (no_asm), elim]: 
   6.139 +  "G\<turnstile>T\<preceq>T' \<Longrightarrow> G,s\<turnstile>x\<Colon>\<preceq>T \<longrightarrow> ws_prog G \<longrightarrow> G,s\<turnstile>x\<Colon>\<preceq>T'"
   6.140 +apply (unfold conf_def)
   6.141 +apply (rule val.induct)
   6.142 +apply (auto elim: ws_widen_trans)
   6.143 +done
   6.144 +
   6.145 +lemma conf_gext [rule_format (no_asm), elim]: 
   6.146 +  "G,s\<turnstile>v\<Colon>\<preceq>T \<longrightarrow> s\<le>|s' \<longrightarrow> G,s'\<turnstile>v\<Colon>\<preceq>T"
   6.147 +apply (unfold gext_def conf_def)
   6.148 +apply (rule val.induct)
   6.149 +apply force+
   6.150 +done
   6.151 +
   6.152 +
   6.153 +lemma conf_list_widen [rule_format (no_asm)]: 
   6.154 +"ws_prog G \<Longrightarrow>  
   6.155 +  \<forall>Ts Ts'. list_all2 (conf G s) vs Ts 
   6.156 +           \<longrightarrow>   G\<turnstile>Ts[\<preceq>] Ts' \<longrightarrow> list_all2 (conf G s) vs Ts'"
   6.157 +apply (unfold widens_def)
   6.158 +apply (rule list_all2_trans)
   6.159 +apply auto
   6.160 +done
   6.161 +
   6.162 +lemma conf_RefTD [rule_format (no_asm)]: 
   6.163 + "G,s\<turnstile>a'\<Colon>\<preceq>RefT T 
   6.164 +  \<longrightarrow> a' = Null \<or> (\<exists>a obj T'. a' = Addr a \<and> heap s a = Some obj \<and>  
   6.165 +                    obj_ty obj = T' \<and> G\<turnstile>T'\<preceq>RefT T)"
   6.166 +apply (unfold conf_def)
   6.167 +apply (induct_tac "a'")
   6.168 +apply (auto dest: widen_PrimT)
   6.169 +done
   6.170 +
   6.171 +
   6.172 +section "value list conformance"
   6.173 +
   6.174 +constdefs
   6.175 +
   6.176 +  lconf :: "prog \<Rightarrow> st \<Rightarrow> ('a, val) table \<Rightarrow> ('a, ty) table \<Rightarrow> bool"
   6.177 +                                                ("_,_\<turnstile>_[\<Colon>\<preceq>]_" [71,71,71,71] 70)
   6.178 +           "G,s\<turnstile>vs[\<Colon>\<preceq>]Ts \<equiv> \<forall>n. \<forall>T\<in>Ts n: \<exists>v\<in>vs n: G,s\<turnstile>v\<Colon>\<preceq>T"
   6.179 +
   6.180 +lemma lconfD: "\<lbrakk>G,s\<turnstile>vs[\<Colon>\<preceq>]Ts; Ts n = Some T\<rbrakk> \<Longrightarrow> G,s\<turnstile>(the (vs n))\<Colon>\<preceq>T"
   6.181 +by (force simp: lconf_def)
   6.182 +
   6.183 +
   6.184 +lemma lconf_cong [simp]: "\<And>s. G,set_locals x s\<turnstile>l[\<Colon>\<preceq>]L = G,s\<turnstile>l[\<Colon>\<preceq>]L"
   6.185 +by (auto simp: lconf_def)
   6.186 +
   6.187 +lemma lconf_lupd [simp]: "G,lupd(vn\<mapsto>v)s\<turnstile>l[\<Colon>\<preceq>]L = G,s\<turnstile>l[\<Colon>\<preceq>]L"
   6.188 +by (auto simp: lconf_def)
   6.189 +
   6.190 +(* unused *)
   6.191 +lemma lconf_new: "\<lbrakk>L vn = None; G,s\<turnstile>l[\<Colon>\<preceq>]L\<rbrakk> \<Longrightarrow> G,s\<turnstile>l(vn\<mapsto>v)[\<Colon>\<preceq>]L"
   6.192 +by (auto simp: lconf_def)
   6.193 +
   6.194 +lemma lconf_upd: "\<lbrakk>G,s\<turnstile>l[\<Colon>\<preceq>]L; G,s\<turnstile>v\<Colon>\<preceq>T; L vn = Some T\<rbrakk> \<Longrightarrow>  
   6.195 +  G,s\<turnstile>l(vn\<mapsto>v)[\<Colon>\<preceq>]L"
   6.196 +by (auto simp: lconf_def)
   6.197 +
   6.198 +lemma lconf_ext: "\<lbrakk>G,s\<turnstile>l[\<Colon>\<preceq>]L; G,s\<turnstile>v\<Colon>\<preceq>T\<rbrakk> \<Longrightarrow> G,s\<turnstile>l(vn\<mapsto>v)[\<Colon>\<preceq>]L(vn\<mapsto>T)"
   6.199 +by (auto simp: lconf_def)
   6.200 +
   6.201 +lemma lconf_map_sum [simp]: 
   6.202 + "G,s\<turnstile>l1 (+) l2[\<Colon>\<preceq>]L1 (+) L2 = (G,s\<turnstile>l1[\<Colon>\<preceq>]L1 \<and> G,s\<turnstile>l2[\<Colon>\<preceq>]L2)"
   6.203 +apply (unfold lconf_def)
   6.204 +apply safe
   6.205 +apply (case_tac [3] "n")
   6.206 +apply (force split add: sum.split)+
   6.207 +done
   6.208 +
   6.209 +lemma lconf_ext_list [rule_format (no_asm)]: "
   6.210 + \<And>X. \<lbrakk>G,s\<turnstile>l[\<Colon>\<preceq>]L\<rbrakk> \<Longrightarrow> 
   6.211 +      \<forall>vs Ts. nodups vns \<longrightarrow> length Ts = length vns 
   6.212 +      \<longrightarrow> list_all2 (conf G s) vs Ts \<longrightarrow> G,s\<turnstile>l(vns[\<mapsto>]vs)[\<Colon>\<preceq>]L(vns[\<mapsto>]Ts)"
   6.213 +apply (unfold lconf_def)
   6.214 +apply (induct_tac "vns")
   6.215 +apply  clarsimp
   6.216 +apply clarsimp
   6.217 +apply (frule list_all2_lengthD)
   6.218 +apply clarsimp
   6.219 +done
   6.220 +
   6.221 +
   6.222 +lemma lconf_deallocL: "\<lbrakk>G,s\<turnstile>l[\<Colon>\<preceq>]L(vn\<mapsto>T); L vn = None\<rbrakk> \<Longrightarrow> G,s\<turnstile>l[\<Colon>\<preceq>]L"
   6.223 +apply (simp only: lconf_def)
   6.224 +apply safe
   6.225 +apply (drule spec)
   6.226 +apply (drule ospec)
   6.227 +apply auto
   6.228 +done 
   6.229 +
   6.230 +
   6.231 +lemma lconf_gext [elim]: "\<lbrakk>G,s\<turnstile>l[\<Colon>\<preceq>]L; s\<le>|s'\<rbrakk> \<Longrightarrow> G,s'\<turnstile>l[\<Colon>\<preceq>]L"
   6.232 +apply (simp only: lconf_def)
   6.233 +apply fast
   6.234 +done
   6.235 +
   6.236 +lemma lconf_empty [simp, intro!]: "G,s\<turnstile>vs[\<Colon>\<preceq>]empty"
   6.237 +apply (unfold lconf_def)
   6.238 +apply force
   6.239 +done
   6.240 +
   6.241 +lemma lconf_init_vals [intro!]: 
   6.242 +	" \<forall>n. \<forall>T\<in>fs n:is_type G T \<Longrightarrow> G,s\<turnstile>init_vals fs[\<Colon>\<preceq>]fs"
   6.243 +apply (unfold lconf_def)
   6.244 +apply force
   6.245 +done
   6.246 +
   6.247 +
   6.248 +section "object conformance"
   6.249 +
   6.250 +constdefs
   6.251 +
   6.252 +  oconf :: "prog \<Rightarrow> st \<Rightarrow> obj \<Rightarrow> oref \<Rightarrow> bool"  ("_,_\<turnstile>_\<Colon>\<preceq>\<surd>_"  [71,71,71,71] 70)
   6.253 +	   "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r \<equiv> G,s\<turnstile>values obj[\<Colon>\<preceq>]var_tys G (tag obj) r \<and> 
   6.254 +                           (case r of 
   6.255 +		              Heap a \<Rightarrow> is_type G (obj_ty obj) 
   6.256 +                            | Stat C \<Rightarrow> True)"
   6.257 +(*
   6.258 +lemma oconf_def2:  "G,s\<turnstile>\<lparr>tag=oi,values=fs\<rparr>\<Colon>\<preceq>\<surd>r =  
   6.259 +  (G,s\<turnstile>fs[\<Colon>\<preceq>]var_tys G oi r \<and> 
   6.260 +  (case r of Heap a \<Rightarrow> is_type G (obj_ty \<lparr>tag=oi,values=fs\<rparr>) | Stat C \<Rightarrow> True))"
   6.261 +by (simp add: oconf_def Let_def)
   6.262 +*)
   6.263 +(*
   6.264 +lemma oconf_def2:  "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r =  
   6.265 +  (G,s\<turnstile>values obj[\<Colon>\<preceq>]var_tys G (tag obj) r \<and> 
   6.266 +  (case r of Heap a \<Rightarrow> is_type G (obj_ty obj) | Stat C \<Rightarrow> True))"
   6.267 +by (simp add: oconf_def Let_def)
   6.268 +*)
   6.269 +lemma oconf_is_type: "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>Heap a \<Longrightarrow> is_type G (obj_ty obj)"
   6.270 +by (auto simp: oconf_def Let_def)
   6.271 +
   6.272 +lemma oconf_lconf: "G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r \<Longrightarrow> G,s\<turnstile>values obj[\<Colon>\<preceq>]var_tys G (tag obj) r"
   6.273 +by (simp add: oconf_def) 
   6.274 +
   6.275 +lemma oconf_cong [simp]: "G,set_locals l s\<turnstile>obj\<Colon>\<preceq>\<surd>r = G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r"
   6.276 +by (auto simp: oconf_def Let_def)
   6.277 +
   6.278 +lemma oconf_init_obj_lemma: 
   6.279 +"\<lbrakk>\<And>C c. class G C = Some c \<Longrightarrow> unique (DeclConcepts.fields G C);  
   6.280 +  \<And>C c f fld. \<lbrakk>class G C = Some c; 
   6.281 +                table_of (DeclConcepts.fields G C) f = Some fld \<rbrakk> 
   6.282 +            \<Longrightarrow> is_type G (type fld);  
   6.283 +  (case r of 
   6.284 +     Heap a \<Rightarrow> is_type G (obj_ty obj) 
   6.285 +  | Stat C \<Rightarrow> is_class G C)
   6.286 +\<rbrakk> \<Longrightarrow>  G,s\<turnstile>obj \<lparr>values:=init_vals (var_tys G (tag obj) r)\<rparr>\<Colon>\<preceq>\<surd>r"
   6.287 +apply (auto simp add: oconf_def)
   6.288 +apply (drule_tac var_tys_Some_eq [THEN iffD1]) 
   6.289 +defer
   6.290 +apply (subst obj_ty_cong)
   6.291 +apply(auto dest!: fields_table_SomeD obj_ty_CInst1 obj_ty_Arr1
   6.292 +           split add: sum.split_asm obj_tag.split_asm)
   6.293 +done
   6.294 +
   6.295 +(*
   6.296 +lemma oconf_init_obj_lemma: 
   6.297 +"\<lbrakk>\<And>C c. class G C = Some c \<Longrightarrow> unique (fields G C);  
   6.298 +  \<And>C c f fld. \<lbrakk>class G C = Some c; table_of (fields G C) f = Some fld \<rbrakk> 
   6.299 +            \<Longrightarrow> is_type G (type fld);  
   6.300 +  (case r of 
   6.301 +     Heap a \<Rightarrow> is_type G (obj_ty \<lparr>tag=oi,values=fs\<rparr>) 
   6.302 +  | Stat C \<Rightarrow> is_class G C)
   6.303 +\<rbrakk> \<Longrightarrow>  G,s\<turnstile>\<lparr>tag=oi, values=init_vals (var_tys G oi r)\<rparr>\<Colon>\<preceq>\<surd>r"
   6.304 +apply (auto simp add: oconf_def)
   6.305 +apply (drule_tac var_tys_Some_eq [THEN iffD1]) 
   6.306 +defer
   6.307 +apply (subst obj_ty_eq)
   6.308 +apply(auto dest!: fields_table_SomeD split add: sum.split_asm obj_tag.split_asm)
   6.309 +done
   6.310 +*)
   6.311 +
   6.312 +
   6.313 +section "state conformance"
   6.314 +
   6.315 +constdefs
   6.316 +
   6.317 +  conforms :: "state \<Rightarrow> env_ \<Rightarrow> bool"          (     "_\<Colon>\<preceq>_"   [71,71]      70)
   6.318 +   "xs\<Colon>\<preceq>E \<equiv> let (G, L) = E; s = snd xs; l = locals s in
   6.319 +      (\<forall>r. \<forall>obj\<in>globs s r:           G,s\<turnstile>obj   \<Colon>\<preceq>\<surd>r) \<and>
   6.320 +                  \<spacespace>                   G,s\<turnstile>l    [\<Colon>\<preceq>]L\<spacespace> \<and>
   6.321 +      (\<forall>a. fst xs=Some(Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable))"
   6.322 +
   6.323 +section "conforms"
   6.324 +
   6.325 +lemma conforms_globsD: 
   6.326 +"\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); globs s r = Some obj\<rbrakk> \<Longrightarrow> G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r"
   6.327 +by (auto simp: conforms_def Let_def)
   6.328 +
   6.329 +lemma conforms_localD: "(x, s)\<Colon>\<preceq>(G, L) \<Longrightarrow> G,s\<turnstile>locals s[\<Colon>\<preceq>]L"
   6.330 +by (auto simp: conforms_def Let_def)
   6.331 +
   6.332 +lemma conforms_XcptLocD: "\<lbrakk>(x, s)\<Colon>\<preceq>(G, L); x = Some (Xcpt (Loc a))\<rbrakk> \<Longrightarrow>  
   6.333 +	  G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)"
   6.334 +by (auto simp: conforms_def Let_def)
   6.335 +
   6.336 +lemma conforms_RefTD: 
   6.337 + "\<lbrakk>G,s\<turnstile>a'\<Colon>\<preceq>RefT t; a' \<noteq> Null; (x,s) \<Colon>\<preceq>(G, L)\<rbrakk> \<Longrightarrow>  
   6.338 +   \<exists>a obj. a' = Addr a \<and> globs s (Inl a) = Some obj \<and>  
   6.339 +   G\<turnstile>obj_ty obj\<preceq>RefT t \<and> is_type G (obj_ty obj)"
   6.340 +apply (drule_tac conf_RefTD)
   6.341 +apply clarsimp
   6.342 +apply (rule conforms_globsD [THEN oconf_is_type])
   6.343 +apply auto
   6.344 +done
   6.345 +
   6.346 +lemma conforms_Jump [iff]:
   6.347 +  "((Some (Jump j), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
   6.348 +by (auto simp: conforms_def)
   6.349 +
   6.350 +lemma conforms_StdXcpt [iff]: 
   6.351 +  "((Some (Xcpt (Std xn)), s)\<Colon>\<preceq>(G, L)) = (Norm s\<Colon>\<preceq>(G, L))"
   6.352 +by (auto simp: conforms_def)
   6.353 +
   6.354 +lemma conforms_raise_if [iff]: 
   6.355 +  "((raise_if c xn x, s)\<Colon>\<preceq>(G, L)) = ((x, s)\<Colon>\<preceq>(G, L))"
   6.356 +by (auto simp: abrupt_if_def)
   6.357 +
   6.358 +
   6.359 +lemma conforms_NormI: "(x, s)\<Colon>\<preceq>(G, L) \<Longrightarrow> Norm s\<Colon>\<preceq>(G, L)"
   6.360 +by (auto simp: conforms_def Let_def)
   6.361 +
   6.362 +
   6.363 +lemma conforms_absorb [rule_format]:
   6.364 +  "(a, b)\<Colon>\<preceq>(G, L) \<longrightarrow> (absorb j a, b)\<Colon>\<preceq>(G, L)"
   6.365 +apply (rule impI)
   6.366 +apply ( case_tac a)
   6.367 +apply (case_tac "absorb j a")
   6.368 +apply auto
   6.369 +apply (case_tac "absorb j (Some a)",auto)
   6.370 +apply (erule conforms_NormI)
   6.371 +done
   6.372 +
   6.373 +lemma conformsI: "\<lbrakk>\<forall>r. \<forall>obj\<in>globs s r: G,s\<turnstile>obj\<Colon>\<preceq>\<surd>r;  
   6.374 +     G,s\<turnstile>locals s[\<Colon>\<preceq>]L;  
   6.375 +     \<forall>a. x = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)\<rbrakk> \<Longrightarrow> 
   6.376 +  (x, s)\<Colon>\<preceq>(G, L)"
   6.377 +by (auto simp: conforms_def Let_def)
   6.378 +
   6.379 +lemma conforms_xconf: "\<lbrakk>(x, s)\<Colon>\<preceq>(G,L);   
   6.380 + \<forall>a. x' = Some (Xcpt (Loc a)) \<longrightarrow> G,s\<turnstile>Addr a\<Colon>\<preceq> Class (SXcpt Throwable)\<rbrakk> \<Longrightarrow> 
   6.381 + (x',s)\<Colon>\<preceq>(G,L)"
   6.382 +by (fast intro: conformsI elim: conforms_globsD conforms_localD)
   6.383 +
   6.384 +lemma conforms_lupd: 
   6.385 + "\<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.386 +by (force intro: conformsI lconf_upd dest: conforms_globsD conforms_localD 
   6.387 +                                           conforms_XcptLocD simp: oconf_def)
   6.388 +
   6.389 +
   6.390 +lemmas conforms_allocL_aux = conforms_localD [THEN lconf_ext]
   6.391 +
   6.392 +lemma conforms_allocL: 
   6.393 +  "\<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.394 +by (force intro: conformsI dest: conforms_globsD 
   6.395 +          elim: conforms_XcptLocD conforms_allocL_aux simp: oconf_def)
   6.396 +
   6.397 +lemmas conforms_deallocL_aux = conforms_localD [THEN lconf_deallocL]
   6.398 +
   6.399 +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.400 +by (fast intro: conformsI dest: conforms_globsD 
   6.401 +         elim: conforms_XcptLocD conforms_deallocL_aux)
   6.402 +
   6.403 +lemma conforms_gext: "\<lbrakk>(x, s)\<Colon>\<preceq>(G,L); s\<le>|s';  
   6.404 +  \<forall>r. \<forall>obj\<in>globs s' r: G,s'\<turnstile>obj\<Colon>\<preceq>\<surd>r;  
   6.405 +   locals s'=locals s\<rbrakk> \<Longrightarrow> (x,s')\<Colon>\<preceq>(G,L)"
   6.406 +by (force intro!: conformsI dest: conforms_localD conforms_XcptLocD)
   6.407 +
   6.408 +
   6.409 +lemma conforms_xgext: 
   6.410 +  "\<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.411 +apply (erule_tac conforms_xconf)
   6.412 +apply (fast dest: conforms_XcptLocD)
   6.413 +done
   6.414 +
   6.415 +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.416 +\<Longrightarrow>  (x, gupd(r\<mapsto>obj)s)\<Colon>\<preceq>(G, L)"
   6.417 +apply (rule conforms_gext)
   6.418 +apply    auto
   6.419 +apply (force dest: conforms_globsD simp add: oconf_def)+
   6.420 +done
   6.421 +
   6.422 +lemma conforms_upd_gobj: "\<lbrakk>(x,s)\<Colon>\<preceq>(G, L); globs s r = Some obj; 
   6.423 +  var_tys G (tag obj) r n = Some T; G,s\<turnstile>v\<Colon>\<preceq>T\<rbrakk> \<Longrightarrow> (x,upd_gobj r n v s)\<Colon>\<preceq>(G,L)"
   6.424 +apply (rule conforms_gext)
   6.425 +apply auto
   6.426 +apply (drule (1) conforms_globsD)
   6.427 +apply (simp add: oconf_def)
   6.428 +apply safe
   6.429 +apply (rule lconf_upd)
   6.430 +apply auto
   6.431 +apply (simp only: obj_ty_cong) 
   6.432 +apply (force dest: conforms_globsD intro!: lconf_upd 
   6.433 +       simp add: oconf_def cong del: sum.weak_case_cong)
   6.434 +done
   6.435 +
   6.436 +lemma conforms_set_locals: 
   6.437 +  "\<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.438 +apply (auto intro!: conformsI dest: conforms_globsD 
   6.439 +            elim!: conforms_XcptLocD simp add: oconf_def)
   6.440 +done
   6.441 +
   6.442 +lemma conforms_return: "\<And>s'. \<lbrakk>(x,s)\<Colon>\<preceq>(G, L); (x',s')\<Colon>\<preceq>(G, L'); s\<le>|s'\<rbrakk> \<Longrightarrow>  
   6.443 +  (x',set_locals (locals s) s')\<Colon>\<preceq>(G, L)"
   6.444 +apply (rule conforms_xconf)
   6.445 +prefer 2 apply (force dest: conforms_XcptLocD)
   6.446 +apply (erule conforms_gext)
   6.447 +apply (force dest: conforms_globsD)+
   6.448 +done
   6.449 +
   6.450 +end
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/HOL/Bali/Decl.thy	Mon Jan 28 17:00:19 2002 +0100
     7.3 @@ -0,0 +1,867 @@
     7.4 +(*  Title:      isabelle/Bali/Decl.thy
     7.5 +    ID:         $Id$
     7.6 +    Author:     David von Oheimb
     7.7 +    Copyright   1997 Technische Universitaet Muenchen
     7.8 +*)
     7.9 +header {* Field, method, interface, and class declarations, whole Java programs
    7.10 +*}
    7.11 +
    7.12 +(** order is significant, because of clash for "var" **)
    7.13 +theory Decl = Term + Table:
    7.14 +
    7.15 +text {*
    7.16 +improvements:
    7.17 +\begin{itemize}
    7.18 +\item clarification and correction of some aspects of the package/access concept
    7.19 +  (Also submitted as bug report to the Java Bug Database:
    7.20 +   Bug Id: 4485402 and Bug Id: 4493343 
    7.21 +   http://developer.java.sun.com/developer/bugParade/index.jshtml
    7.22 +  )
    7.23 +\end{itemize}
    7.24 +simplifications:
    7.25 +\begin{itemize}
    7.26 +\item the only field and method modifiers are static and the access modifiers
    7.27 +\item no constructors, which may be simulated by new + suitable methods
    7.28 +\item there is just one global initializer per class, which can simulate all 
    7.29 +      others
    7.30 +
    7.31 +\item no throws clause
    7.32 +\item a void method is replaced by one that returns Unit (of dummy type Void)
    7.33 +
    7.34 +\item no interface fields
    7.35 +
    7.36 +\item every class has an explicit superclass (unused for Object)
    7.37 +\item the (standard) methods of Object and of standard exceptions are not 
    7.38 +      specified
    7.39 +
    7.40 +\item no main method
    7.41 +\end{itemize}
    7.42 +*}
    7.43 +
    7.44 +subsection {* Modifier*}
    7.45 +
    7.46 +subsubsection {* Access modifier *}
    7.47 +
    7.48 +datatype acc_modi (* access modifier *)
    7.49 +         = Private | Package | Protected | Public 
    7.50 +
    7.51 +text {* 
    7.52 +We can define a linear order for the access modifiers. With Private yielding the
    7.53 +most restrictive access and public the most liberal access policy:
    7.54 +  Private < Package < Protected < Public
    7.55 +*}
    7.56 + 
    7.57 +instance acc_modi:: ord
    7.58 +by intro_classes
    7.59 +
    7.60 +defs (overloaded)
    7.61 +less_acc_def: 
    7.62 + "a < (b::acc_modi) 
    7.63 +      \<equiv> (case a of
    7.64 +             Private    \<Rightarrow> (b=Package \<or> b=Protected \<or> b=Public)
    7.65 +           | Package    \<Rightarrow> (b=Protected \<or> b=Public)
    7.66 +           | Protected  \<Rightarrow> (b=Public)
    7.67 +           | Public     \<Rightarrow> False)"
    7.68 +le_acc_def:
    7.69 + "a \<le> (b::acc_modi) \<equiv> (a = b) \<or> (a < b)"
    7.70 +
    7.71 +instance acc_modi:: order
    7.72 +proof (intro_classes)
    7.73 +  fix x y z::acc_modi
    7.74 +  {
    7.75 +  show "x \<le> x"               \<spacespace>\<spacespace>    -- reflexivity
    7.76 +    by (auto simp add: le_acc_def)
    7.77 +  next
    7.78 +  assume "x \<le> y" "y \<le> z"           -- transitivity 
    7.79 +  thus "x \<le> z"
    7.80 +    by (auto simp add: le_acc_def less_acc_def split add: acc_modi.split)
    7.81 +  next
    7.82 +  assume "x \<le> y" "y \<le> x"           -- antisymmetry
    7.83 +  thus "x = y"
    7.84 +  proof -
    7.85 +    have "\<forall> x y. x < (y::acc_modi) \<and> y < x \<longrightarrow> False"
    7.86 +      by (auto simp add: less_acc_def split add: acc_modi.split)
    7.87 +    with prems show ?thesis
    7.88 +      by  (auto simp add: le_acc_def)
    7.89 +  qed
    7.90 +  next
    7.91 +  show "(x < y) = (x \<le> y \<and> x \<noteq> y)"
    7.92 +    by (auto simp add: le_acc_def less_acc_def split add: acc_modi.split) 
    7.93 +  }
    7.94 +qed
    7.95 +  
    7.96 +instance acc_modi:: linorder
    7.97 +proof intro_classes
    7.98 +  fix x y:: acc_modi
    7.99 +  show  "x \<le> y \<or> y \<le> x"   
   7.100 +  by (auto simp add: less_acc_def le_acc_def split add: acc_modi.split)
   7.101 +qed
   7.102 +
   7.103 +lemma acc_modi_top [simp]: "Public \<le> a \<Longrightarrow> a = Public"
   7.104 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.105 +
   7.106 +lemma acc_modi_top1 [simp, intro!]: "a \<le> Public"
   7.107 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.108 +
   7.109 +lemma acc_modi_le_Public: 
   7.110 +"a \<le> Public \<Longrightarrow> a=Private \<or> a = Package \<or> a=Protected \<or> a=Public"
   7.111 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.112 +
   7.113 +lemma acc_modi_bottom: "a \<le> Private \<Longrightarrow> a = Private"
   7.114 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.115 +
   7.116 +lemma acc_modi_Private_le: 
   7.117 +"Private \<le> a \<Longrightarrow> a=Private \<or> a = Package \<or> a=Protected \<or> a=Public"
   7.118 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.119 +
   7.120 +lemma acc_modi_Package_le: 
   7.121 +  "Package \<le> a \<Longrightarrow> a = Package \<or> a=Protected \<or> a=Public"
   7.122 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.split)
   7.123 +
   7.124 +lemma acc_modi_le_Package: 
   7.125 +  "a \<le> Package \<Longrightarrow> a=Private \<or> a = Package"
   7.126 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.127 +
   7.128 +lemma acc_modi_Protected_le: 
   7.129 +  "Protected \<le> a \<Longrightarrow> a=Protected \<or> a=Public"
   7.130 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.131 +
   7.132 +lemma acc_modi_le_Protected: 
   7.133 +  "a \<le> Protected  \<Longrightarrow> a=Private \<or> a = Package \<or> a = Protected"
   7.134 +by (auto simp add: le_acc_def less_acc_def split: acc_modi.splits)
   7.135 +
   7.136 +
   7.137 +lemmas acc_modi_le_Dests = acc_modi_top           acc_modi_le_Public
   7.138 +                           acc_modi_Private_le    acc_modi_bottom
   7.139 +                           acc_modi_Package_le    acc_modi_le_Package
   7.140 +                           acc_modi_Protected_le  acc_modi_le_Protected
   7.141 +
   7.142 +lemma acc_modi_Package_le_cases 
   7.143 + [consumes 1,case_names Package Protected Public]:
   7.144 + "Package \<le> m \<Longrightarrow> ( m = Package \<Longrightarrow> P m) \<Longrightarrow> (m=Protected \<Longrightarrow> P m) \<Longrightarrow> 
   7.145 +   (m=Public \<Longrightarrow> P m) \<Longrightarrow> P m"
   7.146 +by (auto dest: acc_modi_Package_le)
   7.147 +
   7.148 +
   7.149 +subsubsection {* Static Modifier *}
   7.150 +types stat_modi = bool (* modifier: static *)
   7.151 +
   7.152 +subsection {* Declaration (base "class" for member,interface and class
   7.153 + declarations *}
   7.154 +
   7.155 +record decl =
   7.156 +        access :: acc_modi
   7.157 +
   7.158 +translations
   7.159 +  "decl" <= (type) "\<lparr>access::acc_modi\<rparr>"
   7.160 +  "decl" <= (type) "\<lparr>access::acc_modi,\<dots>::'a\<rparr>"
   7.161 +
   7.162 +subsection {* Member (field or method)*}
   7.163 +record  member = decl +
   7.164 +         static :: stat_modi
   7.165 +
   7.166 +translations
   7.167 +  "member" <= (type) "\<lparr>access::acc_modi,static::bool\<rparr>"
   7.168 +  "member" <= (type) "\<lparr>access::acc_modi,static::bool,\<dots>::'a\<rparr>"
   7.169 +
   7.170 +subsection {* Field *}
   7.171 +
   7.172 +record field = member +
   7.173 +        type :: ty
   7.174 +translations
   7.175 +  "field" <= (type) "\<lparr>access::acc_modi, static::bool, type::ty\<rparr>"
   7.176 +  "field" <= (type) "\<lparr>access::acc_modi, static::bool, type::ty,\<dots>::'a\<rparr>"
   7.177 +
   7.178 +types     
   7.179 +        fdecl           (* field declaration, cf. 8.3 *)
   7.180 +	= "vname \<times> field"
   7.181 +
   7.182 +
   7.183 +translations
   7.184 +  "fdecl" <= (type) "vname \<times> field"
   7.185 +
   7.186 +subsection  {* Method *}
   7.187 +
   7.188 +record mhead = member +     (* method head (excluding signature) *)
   7.189 +        pars ::"vname list" (* parameter names *)
   7.190 +        resT ::ty           (* result type *)
   7.191 +
   7.192 +record mbody =                      (* method body *)
   7.193 +        lcls::  "(vname \<times> ty) list" (* local variables *)
   7.194 +        stmt:: stmt                 (* the body statement *)
   7.195 +
   7.196 +record methd = mhead + (* method in a class *)
   7.197 +        mbody::mbody
   7.198 +
   7.199 +types mdecl = "sig \<times> methd"  (* method declaration in a class *)
   7.200 +
   7.201 +
   7.202 +translations
   7.203 +  "mhead" <= (type) "\<lparr>access::acc_modi, static::bool, 
   7.204 +                      pars::vname list, resT::ty\<rparr>"
   7.205 +  "mhead" <= (type) "\<lparr>access::acc_modi, static::bool, 
   7.206 +                      pars::vname list, resT::ty,\<dots>::'a\<rparr>"
   7.207 +  "mbody" <= (type) "\<lparr>lcls::(vname \<times> ty) list,stmt::stmt\<rparr>"
   7.208 +  "mbody" <= (type) "\<lparr>lcls::(vname \<times> ty) list,stmt::stmt,\<dots>::'a\<rparr>"      
   7.209 +  "methd" <= (type) "\<lparr>access::acc_modi, static::bool, 
   7.210 +                      pars::vname list, resT::ty,mbody::mbody\<rparr>"
   7.211 +  "methd" <= (type) "\<lparr>access::acc_modi, static::bool, 
   7.212 +                      pars::vname list, resT::ty,mbody::mbody,\<dots>::'a\<rparr>"
   7.213 +  "mdecl" <= (type) "sig \<times> methd"
   7.214 +
   7.215 +
   7.216 +constdefs 
   7.217 +  mhead::"methd \<Rightarrow> mhead"
   7.218 +  "mhead m \<equiv> \<lparr>access=access m, static=static m, pars=pars m, resT=resT m\<rparr>"
   7.219 +
   7.220 +lemma access_mhead [simp]:"access (mhead m) = access m"
   7.221 +by (simp add: mhead_def)
   7.222 +
   7.223 +lemma static_mhead [simp]:"static (mhead m) = static m"
   7.224 +by (simp add: mhead_def)
   7.225 +
   7.226 +lemma pars_mhead [simp]:"pars (mhead m) = pars m"
   7.227 +by (simp add: mhead_def)
   7.228 +
   7.229 +lemma resT_mhead [simp]:"resT (mhead m) = resT m"
   7.230 +by (simp add: mhead_def)
   7.231 +
   7.232 +text {* To be able to talk uniformaly about field and method declarations we
   7.233 +introduce the notion of a member declaration (e.g. useful to define 
   7.234 +accessiblity ) *}
   7.235 +
   7.236 +datatype memberdecl = fdecl fdecl | mdecl mdecl
   7.237 +
   7.238 +datatype memberid = fid vname | mid sig
   7.239 +
   7.240 +axclass has_memberid < "type"
   7.241 +consts
   7.242 + memberid :: "'a::has_memberid \<Rightarrow> memberid"
   7.243 +
   7.244 +instance memberdecl::has_memberid
   7.245 +by (intro_classes)
   7.246 +
   7.247 +defs (overloaded)
   7.248 +memberdecl_memberid_def:
   7.249 +  "memberid m \<equiv> (case m of
   7.250 +                    fdecl (vn,f)  \<Rightarrow> fid vn
   7.251 +                  | mdecl (sig,m) \<Rightarrow> mid sig)"
   7.252 +
   7.253 +lemma memberid_fdecl_simp[simp]: "memberid (fdecl (vn,f)) = fid vn"
   7.254 +by (simp add: memberdecl_memberid_def)
   7.255 +
   7.256 +lemma memberid_fdecl_simp1: "memberid (fdecl f) = fid (fst f)"
   7.257 +by (cases f) (simp add: memberdecl_memberid_def)
   7.258 +
   7.259 +lemma memberid_mdecl_simp[simp]: "memberid (mdecl (sig,m)) = mid sig"
   7.260 +by (simp add: memberdecl_memberid_def)
   7.261 +
   7.262 +lemma memberid_mdecl_simp1: "memberid (mdecl m) = mid (fst m)"
   7.263 +by (cases m) (simp add: memberdecl_memberid_def)
   7.264 +
   7.265 +instance * :: ("type","has_memberid") has_memberid
   7.266 +by (intro_classes)
   7.267 +
   7.268 +defs (overloaded)
   7.269 +pair_memberid_def:
   7.270 +  "memberid p \<equiv> memberid (snd p)"
   7.271 +
   7.272 +lemma memberid_pair_simp[simp]: "memberid (c,m) = memberid m"
   7.273 +by (simp add: pair_memberid_def)
   7.274 +
   7.275 +lemma memberid_pair_simp1: "memberid p  = memberid (snd p)"
   7.276 +by (simp add: pair_memberid_def)
   7.277 +
   7.278 +constdefs is_field :: "qtname \<times> memberdecl \<Rightarrow> bool"
   7.279 +"is_field m \<equiv> \<exists> declC f. m=(declC,fdecl f)"
   7.280 +  
   7.281 +lemma is_fieldD: "is_field m \<Longrightarrow> \<exists> declC f. m=(declC,fdecl f)"
   7.282 +by (simp add: is_field_def)
   7.283 +
   7.284 +lemma is_fieldI: "is_field (C,fdecl f)"
   7.285 +by (simp add: is_field_def)
   7.286 +
   7.287 +constdefs is_method :: "qtname \<times> memberdecl \<Rightarrow> bool"
   7.288 +"is_method membr \<equiv> \<exists> declC m. membr=(declC,mdecl m)"
   7.289 +  
   7.290 +lemma is_methodD: "is_method membr \<Longrightarrow> \<exists> declC m. membr=(declC,mdecl m)"
   7.291 +by (simp add: is_method_def)
   7.292 +
   7.293 +lemma is_methodI: "is_method (C,mdecl m)"
   7.294 +by (simp add: is_method_def)
   7.295 +
   7.296 +
   7.297 +subsection {* Interface *}
   7.298 +
   7.299 +
   7.300 +record  ibody = decl +  (* interface body *)
   7.301 +          imethods :: "(sig \<times> mhead) list" (* method heads *)
   7.302 +
   7.303 +record  iface = ibody + (* interface *)
   7.304 +         isuperIfs:: "qtname list" (* superinterface list *)
   7.305 +types	
   7.306 +	idecl           (* interface declaration, cf. 9.1 *)
   7.307 +	= "qtname \<times> iface"
   7.308 +
   7.309 +translations
   7.310 +  "ibody" <= (type) "\<lparr>access::acc_modi,imethods::(sig \<times> mhead) list\<rparr>"
   7.311 +  "ibody" <= (type) "\<lparr>access::acc_modi,imethods::(sig \<times> mhead) list,\<dots>::'a\<rparr>"
   7.312 +  "iface" <= (type) "\<lparr>access::acc_modi,imethods::(sig \<times> mhead) list,
   7.313 +                      isuperIfs::qtname list\<rparr>"
   7.314 +  "iface" <= (type) "\<lparr>access::acc_modi,imethods::(sig \<times> mhead) list,
   7.315 +                      isuperIfs::qtname list,\<dots>::'a\<rparr>"
   7.316 +  "idecl" <= (type) "qtname \<times> iface"
   7.317 +
   7.318 +constdefs
   7.319 +  ibody :: "iface \<Rightarrow> ibody"
   7.320 +  "ibody i \<equiv> \<lparr>access=access i,imethods=imethods i\<rparr>"
   7.321 +
   7.322 +lemma access_ibody [simp]: "(access (ibody i)) = access i"
   7.323 +by (simp add: ibody_def)
   7.324 +
   7.325 +lemma imethods_ibody [simp]: "(imethods (ibody i)) = imethods i"
   7.326 +by (simp add: ibody_def)
   7.327 +
   7.328 +subsection  {* Class *}
   7.329 +record cbody = decl +          (* class body *)
   7.330 +         cfields:: "fdecl list" 
   7.331 +         methods:: "mdecl list"
   7.332 +         init   :: "stmt"       (* initializer *)
   7.333 +
   7.334 +record class = cbody +           (* class *)
   7.335 +        super   :: "qtname"      (* superclass *)
   7.336 +        superIfs:: "qtname list" (* implemented interfaces *)
   7.337 +types	
   7.338 +	cdecl           (* class declaration, cf. 8.1 *)
   7.339 +	= "qtname \<times> class"
   7.340 +
   7.341 +translations
   7.342 +  "cbody" <= (type) "\<lparr>access::acc_modi,cfields::fdecl list,
   7.343 +                      methods::mdecl list,init::stmt\<rparr>"
   7.344 +  "cbody" <= (type) "\<lparr>access::acc_modi,cfields::fdecl list,
   7.345 +                      methods::mdecl list,init::stmt,\<dots>::'a\<rparr>"
   7.346 +  "class" <= (type) "\<lparr>access::acc_modi,cfields::fdecl list,
   7.347 +                      methods::mdecl list,init::stmt,
   7.348 +                      super::qtname,superIfs::qtname list\<rparr>"
   7.349 +  "class" <= (type) "\<lparr>access::acc_modi,cfields::fdecl list,
   7.350 +                      methods::mdecl list,init::stmt,
   7.351 +                      super::qtname,superIfs::qtname list,\<dots>::'a\<rparr>"
   7.352 +  "cdecl" <= (type) "qtname \<times> class"
   7.353 +
   7.354 +constdefs
   7.355 +  cbody :: "class \<Rightarrow> cbody"
   7.356 +  "cbody c \<equiv> \<lparr>access=access c, cfields=cfields c,methods=methods c,init=init c\<rparr>"
   7.357 +
   7.358 +lemma access_cbody [simp]:"access (cbody c) = access c"
   7.359 +by (simp add: cbody_def)
   7.360 +
   7.361 +lemma cfields_cbody [simp]:"cfields (cbody c) = cfields c"
   7.362 +by (simp add: cbody_def)
   7.363 +
   7.364 +lemma methods_cbody [simp]:"methods (cbody c) = methods c"
   7.365 +by (simp add: cbody_def)
   7.366 +
   7.367 +lemma init_cbody [simp]:"init (cbody c) = init c"
   7.368 +by (simp add: cbody_def)
   7.369 +
   7.370 +
   7.371 +section "standard classes"
   7.372 +
   7.373 +consts
   7.374 +
   7.375 +  Object_mdecls  ::  "mdecl list" (* methods of Object *)
   7.376 +  SXcpt_mdecls   ::  "mdecl list" (* methods of SXcpts *)
   7.377 +  ObjectC ::         "cdecl"      (* declaration  of root      class   *)
   7.378 +  SXcptC  ::"xname \<Rightarrow> cdecl"      (* declarations of throwable classes *)
   7.379 +
   7.380 +defs 
   7.381 +
   7.382 +
   7.383 +ObjectC_def:"ObjectC  \<equiv> (Object,\<lparr>access=Public,cfields=[],methods=Object_mdecls,
   7.384 +                                  init=Skip,super=arbitrary,superIfs=[]\<rparr>)"
   7.385 +SXcptC_def:"SXcptC xn\<equiv> (SXcpt xn,\<lparr>access=Public,cfields=[],methods=SXcpt_mdecls,
   7.386 +                                   init=Skip,
   7.387 +                                   super=if xn = Throwable then Object 
   7.388 +                                                           else SXcpt Throwable,
   7.389 +                                   superIfs=[]\<rparr>)"
   7.390 +
   7.391 +lemma ObjectC_neq_SXcptC [simp]: "ObjectC \<noteq> SXcptC xn"
   7.392 +by (simp add: ObjectC_def SXcptC_def Object_def SXcpt_def)
   7.393 +
   7.394 +lemma SXcptC_inject [simp]: "(SXcptC xn = SXcptC xm) = (xn = xm)"
   7.395 +apply (simp add: SXcptC_def)
   7.396 +apply auto
   7.397 +done
   7.398 +
   7.399 +constdefs standard_classes :: "cdecl list"
   7.400 +         "standard_classes \<equiv> [ObjectC, SXcptC Throwable,
   7.401 +		SXcptC NullPointer, SXcptC OutOfMemory, SXcptC ClassCast,
   7.402 +		SXcptC NegArrSize , SXcptC IndOutBound, SXcptC ArrStore]"
   7.403 +
   7.404 +
   7.405 +section "programs"
   7.406 +
   7.407 +record prog =
   7.408 +        ifaces ::"idecl list"
   7.409 +        "classes"::"cdecl list"
   7.410 +
   7.411 +translations
   7.412 +     "prog"<= (type) "\<lparr>ifaces::idecl list,classes::cdecl list\<rparr>"
   7.413 +     "prog"<= (type) "\<lparr>ifaces::idecl list,classes::cdecl list,\<dots>::'a\<rparr>"
   7.414 +
   7.415 +syntax
   7.416 +  iface     :: "prog  \<Rightarrow> (qtname, iface) table"
   7.417 +  class     :: "prog  \<Rightarrow> (qtname, class) table"
   7.418 +  is_iface  :: "prog  \<Rightarrow> qtname  \<Rightarrow> bool"
   7.419 +  is_class  :: "prog  \<Rightarrow> qtname  \<Rightarrow> bool"
   7.420 +
   7.421 +translations
   7.422 +	   "iface G I" == "table_of (ifaces G) I"
   7.423 +	   "class G C" == "table_of (classes G) C"
   7.424 +	"is_iface G I" == "iface G I \<noteq> None"
   7.425 +	"is_class G C" == "class G C \<noteq> None"
   7.426 +
   7.427 +
   7.428 +section "is type"
   7.429 +
   7.430 +consts
   7.431 +  is_type :: "prog \<Rightarrow>     ty \<Rightarrow> bool"
   7.432 +  isrtype :: "prog \<Rightarrow> ref_ty \<Rightarrow> bool"
   7.433 +
   7.434 +primrec	"is_type G (PrimT pt)  = True"
   7.435 +	"is_type G (RefT  rt)  = isrtype G rt"
   7.436 +	"isrtype G (NullT    ) = True"
   7.437 +	"isrtype G (IfaceT tn) = is_iface G tn"
   7.438 +	"isrtype G (ClassT tn) = is_class G tn"
   7.439 +	"isrtype G (ArrayT T ) = is_type  G T"
   7.440 +
   7.441 +lemma type_is_iface: "is_type G (Iface I) \<Longrightarrow> is_iface G I"
   7.442 +by auto
   7.443 +
   7.444 +lemma type_is_class: "is_type G (Class C) \<Longrightarrow>  is_class G C"
   7.445 +by auto
   7.446 +
   7.447 +
   7.448 +section "subinterface and subclass relation, in anticipation of TypeRel.thy"
   7.449 +
   7.450 +consts 
   7.451 +  subint1  :: "prog \<Rightarrow> (qtname \<times> qtname) set"
   7.452 +  subcls1  :: "prog \<Rightarrow> (qtname \<times> qtname) set"
   7.453 +
   7.454 +defs
   7.455 +  subint1_def: "subint1 G \<equiv> {(I,J). \<exists>i\<in>iface G I: J\<in>set (isuperIfs i)}"
   7.456 +  subcls1_def: "subcls1 G \<equiv> {(C,D). C\<noteq>Object \<and> (\<exists>c\<in>class G C: super c = D)}"
   7.457 +
   7.458 +syntax
   7.459 + "@subcls1" :: "prog => [qtname, qtname] => bool" ("_|-_<:C1_" [71,71,71] 70)
   7.460 + "@subclseq":: "prog => [qtname, qtname] => bool" ("_|-_<=:C _"[71,71,71] 70)
   7.461 + "@subcls"  :: "prog => [qtname, qtname] => bool" ("_|-_<:C _"[71,71,71] 70)
   7.462 +
   7.463 +syntax (xsymbols)
   7.464 +  "@subcls1" :: "prog \<Rightarrow> [qtname, qtname] \<Rightarrow> bool" ("_\<turnstile>_\<prec>\<^sub>C\<^sub>1_"  [71,71,71] 70)
   7.465 +  "@subclseq":: "prog \<Rightarrow> [qtname, qtname] \<Rightarrow> bool" ("_\<turnstile>_\<preceq>\<^sub>C _"  [71,71,71] 70)
   7.466 +  "@subcls"  :: "prog \<Rightarrow> [qtname, qtname] \<Rightarrow> bool" ("_\<turnstile>_\<prec>\<^sub>C _"  [71,71,71] 70)
   7.467 +
   7.468 +translations
   7.469 +        "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 D" == "(C,D) \<in> subcls1 G"
   7.470 +	"G\<turnstile>C \<preceq>\<^sub>C  D" == "(C,D) \<in>(subcls1 G)^*" (* cf. 8.1.3 *)
   7.471 +        "G\<turnstile>C \<prec>\<^sub>C  D" == "(C,D) \<in>(subcls1 G)^+"
   7.472 + 
   7.473 +
   7.474 +lemma subint1I: "\<lbrakk>iface G I = Some i; J \<in> set (isuperIfs i)\<rbrakk> 
   7.475 +                 \<Longrightarrow> (I,J) \<in> subint1 G" 
   7.476 +apply (simp add: subint1_def)
   7.477 +done
   7.478 +
   7.479 +lemma subcls1I:"\<lbrakk>class G C = Some c; C \<noteq> Object\<rbrakk> \<Longrightarrow> (C,(super c)) \<in> subcls1 G"
   7.480 +apply (simp add: subcls1_def)
   7.481 +done
   7.482 +
   7.483 +
   7.484 +lemma subint1D: "(I,J)\<in>subint1 G\<Longrightarrow> \<exists>i\<in>iface G I: J\<in>set (isuperIfs i)"
   7.485 +by (simp add: subint1_def)
   7.486 +
   7.487 +lemma subcls1D: 
   7.488 +  "(C,D)\<in>subcls1 G \<Longrightarrow> C\<noteq>Object \<and> (\<exists>c. class G C = Some c \<and> (super c = D))"
   7.489 +apply (simp add: subcls1_def)
   7.490 +apply auto
   7.491 +done
   7.492 +
   7.493 +lemma subint1_def2:  
   7.494 +   "subint1 G = (\<Sigma> I\<in>{I. is_iface G I}. set (isuperIfs (the (iface G I))))"
   7.495 +apply (unfold subint1_def)
   7.496 +apply auto
   7.497 +done
   7.498 +
   7.499 +lemma subcls1_def2: 
   7.500 + "subcls1 G = (\<Sigma>C\<in>{C. is_class G C}. {D. C\<noteq>Object \<and> super (the(class G C))=D})"
   7.501 +apply (unfold subcls1_def)
   7.502 +apply auto
   7.503 +done
   7.504 +
   7.505 +lemma subcls_is_class:
   7.506 +"\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D\<rbrakk> \<Longrightarrow> \<exists> c. class G C = Some c"
   7.507 +by (auto simp add: subcls1_def dest: tranclD)
   7.508 +
   7.509 +lemma no_subcls1_Object:"G\<turnstile>Object\<prec>\<^sub>C\<^sub>1 D \<Longrightarrow> P"
   7.510 +by (auto simp add: subcls1_def)
   7.511 +
   7.512 +lemma no_subcls_Object: "G\<turnstile>Object\<prec>\<^sub>C D \<Longrightarrow> P"
   7.513 +apply (erule trancl_induct)
   7.514 +apply (auto intro: no_subcls1_Object)
   7.515 +done
   7.516 +
   7.517 +section "well-structured programs"
   7.518 +
   7.519 +constdefs
   7.520 +  ws_idecl :: "prog \<Rightarrow> qtname \<Rightarrow> qtname list \<Rightarrow> bool"
   7.521 + "ws_idecl G I si \<equiv> \<forall>J\<in>set si.  is_iface G J   \<and> (J,I)\<notin>(subint1 G)^+"
   7.522 +  
   7.523 +  ws_cdecl :: "prog \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   7.524 + "ws_cdecl G C sc \<equiv> C\<noteq>Object \<longrightarrow> is_class G sc \<and> (sc,C)\<notin>(subcls1 G)^+"
   7.525 +  
   7.526 +  ws_prog  :: "prog \<Rightarrow> bool"
   7.527 + "ws_prog G \<equiv> (\<forall>(I,i)\<in>set (ifaces  G). ws_idecl G I (isuperIfs i)) \<and> 
   7.528 +	      (\<forall>(C,c)\<in>set (classes G). ws_cdecl G C (super c))"
   7.529 +
   7.530 +
   7.531 +lemma ws_progI: 
   7.532 +"\<lbrakk>\<forall>(I,i)\<in>set (ifaces G). \<forall>J\<in>set (isuperIfs i). is_iface G J \<and> 
   7.533 +                                                (J,I) \<notin> (subint1 G)^+; 
   7.534 +  \<forall>(C,c)\<in>set (classes G). C\<noteq>Object \<longrightarrow> is_class G (super c) \<and> 
   7.535 +                                        ((super c),C) \<notin> (subcls1 G)^+  
   7.536 + \<rbrakk> \<Longrightarrow> ws_prog G"
   7.537 +apply (unfold ws_prog_def ws_idecl_def ws_cdecl_def)
   7.538 +apply (erule_tac conjI)
   7.539 +apply blast
   7.540 +done
   7.541 +
   7.542 +lemma ws_prog_ideclD: 
   7.543 +"\<lbrakk>iface G I = Some i; J\<in>set (isuperIfs i); ws_prog G\<rbrakk> \<Longrightarrow>  
   7.544 +  is_iface G J \<and> (J,I)\<notin>(subint1 G)^+"
   7.545 +apply (unfold ws_prog_def ws_idecl_def)
   7.546 +apply clarify
   7.547 +apply (drule_tac map_of_SomeD)
   7.548 +apply auto
   7.549 +done
   7.550 +
   7.551 +lemma ws_prog_cdeclD: 
   7.552 +"\<lbrakk>class G C = Some c; C\<noteq>Object; ws_prog G\<rbrakk> \<Longrightarrow>  
   7.553 +  is_class G (super c) \<and> (super c,C)\<notin>(subcls1 G)^+"
   7.554 +apply (unfold ws_prog_def ws_cdecl_def)
   7.555 +apply clarify
   7.556 +apply (drule_tac map_of_SomeD)
   7.557 +apply auto
   7.558 +done
   7.559 +
   7.560 +
   7.561 +section "well-foundedness"
   7.562 +
   7.563 +lemma finite_is_iface: "finite {I. is_iface G I}"
   7.564 +apply (fold dom_def)
   7.565 +apply (rule_tac finite_dom_map_of)
   7.566 +done
   7.567 +
   7.568 +lemma finite_is_class: "finite {C. is_class G C}"
   7.569 +apply (fold dom_def)
   7.570 +apply (rule_tac finite_dom_map_of)
   7.571 +done
   7.572 +
   7.573 +lemma finite_subint1: "finite (subint1 G)"
   7.574 +apply (subst subint1_def2)
   7.575 +apply (rule finite_SigmaI)
   7.576 +apply (rule finite_is_iface)
   7.577 +apply (simp (no_asm))
   7.578 +done
   7.579 +
   7.580 +lemma finite_subcls1: "finite (subcls1 G)"
   7.581 +apply (subst subcls1_def2)
   7.582 +apply (rule finite_SigmaI)
   7.583 +apply (rule finite_is_class)
   7.584 +apply (rule_tac B = "{super (the (class G C))}" in finite_subset)
   7.585 +apply  auto
   7.586 +done
   7.587 +
   7.588 +lemma subint1_irrefl_lemma1: 
   7.589 +  "ws_prog G \<Longrightarrow> (subint1 G)^-1 \<inter> (subint1 G)^+ = {}"
   7.590 +apply (force dest: subint1D ws_prog_ideclD conjunct2)
   7.591 +done
   7.592 +
   7.593 +lemma subcls1_irrefl_lemma1: 
   7.594 +  "ws_prog G \<Longrightarrow> (subcls1 G)^-1 \<inter> (subcls1 G)^+ = {}"
   7.595 +apply (force dest: subcls1D ws_prog_cdeclD conjunct2)
   7.596 +done
   7.597 +
   7.598 +lemmas subint1_irrefl_lemma2 = subint1_irrefl_lemma1 [THEN irrefl_tranclI']
   7.599 +lemmas subcls1_irrefl_lemma2 = subcls1_irrefl_lemma1 [THEN irrefl_tranclI']
   7.600 +
   7.601 +lemma subint1_irrefl: "\<lbrakk>(x, y) \<in> subint1 G; ws_prog G\<rbrakk> \<Longrightarrow> x \<noteq> y"
   7.602 +apply (rule irrefl_trancl_rD)
   7.603 +apply (rule subint1_irrefl_lemma2)
   7.604 +apply auto
   7.605 +done
   7.606 +
   7.607 +lemma subcls1_irrefl: "\<lbrakk>(x, y) \<in> subcls1 G; ws_prog G\<rbrakk> \<Longrightarrow> x \<noteq> y"
   7.608 +apply (rule irrefl_trancl_rD)
   7.609 +apply (rule subcls1_irrefl_lemma2)
   7.610 +apply auto
   7.611 +done
   7.612 +
   7.613 +lemmas subint1_acyclic = subint1_irrefl_lemma2 [THEN acyclicI, standard]
   7.614 +lemmas subcls1_acyclic = subcls1_irrefl_lemma2 [THEN acyclicI, standard]
   7.615 +
   7.616 +
   7.617 +lemma wf_subint1: "ws_prog G \<Longrightarrow> wf ((subint1 G)\<inverse>)"
   7.618 +by (auto intro: finite_acyclic_wf_converse finite_subint1 subint1_acyclic)
   7.619 +
   7.620 +lemma wf_subcls1: "ws_prog G \<Longrightarrow> wf ((subcls1 G)\<inverse>)"
   7.621 +by (auto intro: finite_acyclic_wf_converse finite_subcls1 subcls1_acyclic)
   7.622 +
   7.623 +
   7.624 +lemma subint1_induct: 
   7.625 +  "\<lbrakk>ws_prog G; \<And>x. \<forall>y. (x, y) \<in> subint1 G \<longrightarrow> P y \<Longrightarrow> P x\<rbrakk> \<Longrightarrow> P a"
   7.626 +apply (frule wf_subint1)
   7.627 +apply (erule wf_induct)
   7.628 +apply (simp (no_asm_use) only: converse_iff)
   7.629 +apply blast
   7.630 +done
   7.631 +
   7.632 +lemma subcls1_induct [consumes 1]:
   7.633 +  "\<lbrakk>ws_prog G; \<And>x. \<forall>y. (x, y) \<in> subcls1 G \<longrightarrow> P y \<Longrightarrow> P x\<rbrakk> \<Longrightarrow> P a"
   7.634 +apply (frule wf_subcls1)
   7.635 +apply (erule wf_induct)
   7.636 +apply (simp (no_asm_use) only: converse_iff)
   7.637 +apply blast
   7.638 +done
   7.639 +
   7.640 +lemma ws_subint1_induct: 
   7.641 + "\<lbrakk>is_iface G I; ws_prog G; \<And>I i. \<lbrakk>iface G I = Some i \<and> 
   7.642 +   (\<forall>J \<in> set (isuperIfs i). (I,J)\<in>subint1 G \<and> P J \<and> is_iface G J)\<rbrakk> \<Longrightarrow> P I
   7.643 +  \<rbrakk> \<Longrightarrow> P I"
   7.644 +apply (erule make_imp)
   7.645 +apply (rule subint1_induct)
   7.646 +apply  assumption
   7.647 +apply safe
   7.648 +apply (fast dest: subint1I ws_prog_ideclD)
   7.649 +done
   7.650 +
   7.651 +
   7.652 +lemma ws_subcls1_induct: "\<lbrakk>is_class G C; ws_prog G;  
   7.653 +  \<And>C c. \<lbrakk>class G C = Some c;  
   7.654 + (C \<noteq> Object \<longrightarrow> (C,(super c))\<in>subcls1 G \<and> 
   7.655 +                  P (super c) \<and> is_class G (super c))\<rbrakk> \<Longrightarrow> P C
   7.656 + \<rbrakk> \<Longrightarrow> P C"
   7.657 +apply (erule make_imp)
   7.658 +apply (rule subcls1_induct)
   7.659 +apply  assumption
   7.660 +apply safe
   7.661 +apply (fast dest: subcls1I ws_prog_cdeclD)
   7.662 +done
   7.663 +
   7.664 +lemma ws_class_induct [consumes 2, case_names Object Subcls]:
   7.665 +"\<lbrakk>class G C = Some c; ws_prog G; 
   7.666 +  \<And> co. class G Object = Some co \<Longrightarrow> P Object; 
   7.667 +  \<And>  C c. \<lbrakk>class G C = Some c; C \<noteq> Object; P (super c)\<rbrakk> \<Longrightarrow> P C
   7.668 + \<rbrakk> \<Longrightarrow> P C"
   7.669 +proof -
   7.670 +  assume clsC: "class G C = Some c"
   7.671 +  and    init: "\<And> co. class G Object = Some co \<Longrightarrow> P Object"
   7.672 +  and    step: "\<And>   C c. \<lbrakk>class G C = Some c; C \<noteq> Object; P (super c)\<rbrakk> \<Longrightarrow> P C"
   7.673 +  assume ws: "ws_prog G"
   7.674 +  then have "is_class G C \<Longrightarrow> P C"  
   7.675 +  proof (induct rule: subcls1_induct)
   7.676 +    fix C
   7.677 +    assume   hyp:"\<forall> S. G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S \<longrightarrow> is_class G S \<longrightarrow> P S"
   7.678 +       and iscls:"is_class G C"
   7.679 +    show "P C"
   7.680 +    proof (cases "C=Object")
   7.681 +      case True with iscls init show "P C" by auto
   7.682 +    next
   7.683 +      case False with ws step hyp iscls 
   7.684 +      show "P C" by (auto dest: subcls1I ws_prog_cdeclD)
   7.685 +    qed
   7.686 +  qed
   7.687 +  with clsC show ?thesis by simp
   7.688 +qed
   7.689 +
   7.690 +lemma ws_class_induct' [consumes 2, case_names Object Subcls]:
   7.691 +"\<lbrakk>is_class G C; ws_prog G; 
   7.692 +  \<And> co. class G Object = Some co \<Longrightarrow> P Object; 
   7.693 +  \<And> C c. \<lbrakk>class G C = Some c; C \<noteq> Object; P (super c)\<rbrakk> \<Longrightarrow> P C
   7.694 + \<rbrakk> \<Longrightarrow> P C"
   7.695 +by (blast intro: ws_class_induct)
   7.696 +
   7.697 +lemma ws_class_induct'' [consumes 2, case_names Object Subcls]:
   7.698 +"\<lbrakk>class G C = Some c; ws_prog G; 
   7.699 +  \<And> co. class G Object = Some co \<Longrightarrow> P Object co; 
   7.700 +  \<And>  C c sc. \<lbrakk>class G C = Some c; class G (super c) = Some sc;
   7.701 +            C \<noteq> Object; P (super c) sc\<rbrakk> \<Longrightarrow> P C c
   7.702 + \<rbrakk> \<Longrightarrow> P C c"
   7.703 +proof -
   7.704 +  assume clsC: "class G C = Some c"
   7.705 +  and    init: "\<And> co. class G Object = Some co \<Longrightarrow> P Object co"
   7.706 +  and    step: "\<And> C c sc . \<lbrakk>class G C = Some c; class G (super c) = Some sc;
   7.707 +                             C \<noteq> Object; P (super c) sc\<rbrakk> \<Longrightarrow> P C c"
   7.708 +  assume ws: "ws_prog G"
   7.709 +  then have "\<And> c. class G C = Some c\<Longrightarrow> P C c"  
   7.710 +  proof (induct rule: subcls1_induct)
   7.711 +    fix C c
   7.712 +    assume   hyp:"\<forall> S. G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S \<longrightarrow> (\<forall> s. class G S = Some s \<longrightarrow> P S s)"
   7.713 +       and iscls:"class G C = Some c"
   7.714 +    show "P C c"
   7.715 +    proof (cases "C=Object")
   7.716 +      case True with iscls init show "P C c" by auto
   7.717 +    next
   7.718 +      case False
   7.719 +      with ws iscls obtain sc where
   7.720 +	sc: "class G (super c) = Some sc"
   7.721 +	by (auto dest: ws_prog_cdeclD)
   7.722 +      from iscls False have "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 (super c)" by (rule subcls1I)
   7.723 +      with False ws step hyp iscls sc
   7.724 +      show "P C c" 
   7.725 +	by (auto)  
   7.726 +    qed
   7.727 +  qed
   7.728 +  with clsC show "P C c" by auto
   7.729 +qed
   7.730 +
   7.731 +lemma ws_interface_induct [consumes 2, case_names Step]:
   7.732 + (assumes is_if_I: "is_iface G I" and 
   7.733 +               ws: "ws_prog G" and
   7.734 +          hyp_sub: "\<And>I i. \<lbrakk>iface G I = Some i; 
   7.735 +                            \<forall> J \<in> set (isuperIfs i).
   7.736 +                                 (I,J)\<in>subint1 G \<and> P J \<and> is_iface G J\<rbrakk> \<Longrightarrow> P I"
   7.737 + ) "P I"
   7.738 +proof -
   7.739 +  from is_if_I ws 
   7.740 +  show "P I"
   7.741 +  proof (rule ws_subint1_induct)
   7.742 +    fix I i
   7.743 +    assume hyp: "iface G I = Some i \<and>
   7.744 +                (\<forall>J\<in>set (isuperIfs i). (I,J) \<in>subint1 G \<and> P J \<and> is_iface G J)"
   7.745 +    then have if_I: "iface G I = Some i"
   7.746 +      by blast
   7.747 +    show "P I"
   7.748 +    proof (cases "isuperIfs i")
   7.749 +      case Nil
   7.750 +      with if_I hyp_sub 
   7.751 +      show "P I" 
   7.752 +	by auto
   7.753 +    next
   7.754 +      case (Cons hd tl)
   7.755 +      with hyp if_I hyp_sub 
   7.756 +      show "P I" 
   7.757 +	by auto
   7.758 +    qed
   7.759 +  qed
   7.760 +qed
   7.761 +
   7.762 +section "general recursion operators for the interface and class hiearchies"
   7.763 +
   7.764 +consts
   7.765 +  iface_rec  :: "prog \<times> qtname \<Rightarrow>   \<spacespace>  (qtname \<Rightarrow> iface \<Rightarrow> 'a set \<Rightarrow> 'a) \<Rightarrow> 'a"
   7.766 +  class_rec  :: "prog \<times> qtname \<Rightarrow> 'a \<Rightarrow> (qtname \<Rightarrow> class \<Rightarrow> 'a     \<Rightarrow> 'a) \<Rightarrow> 'a"
   7.767 +
   7.768 +recdef iface_rec "same_fst ws_prog (\<lambda>G. (subint1 G)^-1)" 
   7.769 +"iface_rec (G,I) = 
   7.770 +  (\<lambda>f. case iface G I of 
   7.771 +         None \<Rightarrow> arbitrary 
   7.772 +       | Some i \<Rightarrow> if ws_prog G 
   7.773 +                      then f I i 
   7.774 +                               ((\<lambda>J. iface_rec (G,J) f)`set (isuperIfs i))
   7.775 +                      else arbitrary)"
   7.776 +(hints recdef_wf: wf_subint1 intro: subint1I)
   7.777 +declare iface_rec.simps [simp del]
   7.778 +
   7.779 +lemma iface_rec: 
   7.780 +"\<lbrakk>iface G I = Some i; ws_prog G\<rbrakk> \<Longrightarrow> 
   7.781 + iface_rec (G,I) f = f I i ((\<lambda>J. iface_rec (G,J) f)`set (isuperIfs i))"
   7.782 +apply (subst iface_rec.simps)
   7.783 +apply simp
   7.784 +done
   7.785 +
   7.786 +recdef class_rec "same_fst ws_prog (\<lambda>G. (subcls1 G)^-1)"
   7.787 +"class_rec(G,C) = 
   7.788 +  (\<lambda>t f. case class G C of 
   7.789 +           None \<Rightarrow> arbitrary 
   7.790 +         | Some c \<Rightarrow> if ws_prog G 
   7.791 +                        then f C c 
   7.792 +                                 (if C = Object then t 
   7.793 +                                                else class_rec (G,super c) t f)
   7.794 +                        else arbitrary)"
   7.795 +(hints recdef_wf: wf_subcls1 intro: subcls1I)
   7.796 +declare class_rec.simps [simp del]
   7.797 +
   7.798 +lemma class_rec: "\<lbrakk>class G C = Some c; ws_prog G\<rbrakk> \<Longrightarrow>  
   7.799 + class_rec (G,C) t f = 
   7.800 +   f C c (if C = Object then t else class_rec (G,super c) t f)"
   7.801 +apply (rule class_rec.simps [THEN trans [THEN fun_cong [THEN fun_cong]]])
   7.802 +apply simp
   7.803 +done
   7.804 +(*
   7.805 +lemma bar:
   7.806 + "[| P;  !!x.  P ==> Q x  |] ==> Q x"
   7.807 +by simp
   7.808 +
   7.809 +lemma metaMP: "[| A ==> B; A |] ==> B"
   7.810 +by blast
   7.811 +
   7.812 +lemma True
   7.813 +proof- 
   7.814 +  presume t: "C  ==> E"
   7.815 +  thm metaMP [OF t]
   7.816 +
   7.817 +  presume r1: "\<And> B. P \<Longrightarrow> B"
   7.818 +  presume r2: "\<And> C. C \<Longrightarrow> P"
   7.819 +  thm r1 [OF r2]
   7.820 +
   7.821 +  thm metaMP [OF t]
   7.822 +
   7.823 +lemma ws_subcls1_induct4: "\<lbrakk>is_class G C; ws_prog G;  
   7.824 +  \<And>C c. \<lbrakk>C \<noteq> Object\<longrightarrow> P (super c)\<rbrakk> \<Longrightarrow> P C
   7.825 + \<rbrakk> \<Longrightarrow> P C"
   7.826 +proof -
   7.827 +  assume cls_C: "is_class G C"
   7.828 +  and       ws: "ws_prog G"
   7.829 +  and      hyp: "\<And>C c. \<lbrakk>C \<noteq> Object\<longrightarrow> P (super c)\<rbrakk> \<Longrightarrow> P C"
   7.830 +  thm ws_subcls1_induct [OF cls_C ws hyp]
   7.831 +
   7.832 +show
   7.833 +(\<And>C c. class G C = Some c \<and>
   7.834 +       (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.835 +       ?P C) \<Longrightarrow>
   7.836 +?P C
   7.837 +  show ?thesis
   7.838 +    thm "thm ws_subcls1_induct [OF cls_C ws hyp]"
   7.839 +    apply (rule ws_subcls1_induct)
   7.840 +  proof (rule ws_subcls1_induct)
   7.841 +    fix C c
   7.842 +    assume "class G C = Some c \<and>
   7.843 +            (C \<noteq> Object \<longrightarrow>
   7.844 +              G\<turnstile>C\<prec>\<^sub>C\<^sub>1super c \<and> P (super c) \<and> is_class G (super c))"
   7.845 +    show "C \<noteq> Object \<longrightarrow> P (super  (?c C c))" 
   7.846 +apply (erule ws_subcls1_induct)
   7.847 +apply assumption
   7.848 +apply (erule conjE)
   7.849 +apply (case_tac "C=Object")
   7.850 +apply blast
   7.851 +apply (erule impE)
   7.852 +apply assumption
   7.853 +apply (erule conjE)+
   7.854 +apply (rotate_tac 2)
   7.855 +sorry
   7.856 +
   7.857 +*)
   7.858 +
   7.859 +
   7.860 +constdefs
   7.861 +imethds:: "prog \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> mhead) tables"
   7.862 +  (* methods of an interface, with overriding and inheritance, cf. 9.2 *)
   7.863 +"imethds G I 
   7.864 +  \<equiv> iface_rec (G,I)  
   7.865 +              (\<lambda>I i ts. (Un_tables ts) \<oplus>\<oplus> 
   7.866 +                        (o2s \<circ> table_of (map (\<lambda>(s,m). (s,I,m)) (imethods i))))"
   7.867 +	
   7.868 +
   7.869 +
   7.870 +end
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/HOL/Bali/DeclConcepts.thy	Mon Jan 28 17:00:19 2002 +0100
     8.3 @@ -0,0 +1,2540 @@
     8.4 +header {* Advanced concepts on Java declarations like overriding, inheritance,
     8.5 +dynamic method lookup*}
     8.6 +
     8.7 +theory DeclConcepts = TypeRel:
     8.8 +
     8.9 +section "access control (cf. 6.6), overriding and hiding (cf. 8.4.6.1)"
    8.10 +
    8.11 +constdefs
    8.12 +is_public :: "prog \<Rightarrow> qtname \<Rightarrow> bool"
    8.13 +"is_public G qn \<equiv> (case class G qn of
    8.14 +                     None       \<Rightarrow> (case iface G qn of
    8.15 +                                      None       \<Rightarrow> False
    8.16 +                                    | Some iface \<Rightarrow> access iface = Public)
    8.17 +                   | Some class \<Rightarrow> access class = Public)"
    8.18 +
    8.19 +subsection "accessibility of types (cf. 6.6.1)"
    8.20 +text {* 
    8.21 +Primitive types are always accessible, interfaces and classes are accessible
    8.22 +in their package or if they are defined public, an array type is accessible if
    8.23 +its element type is accessible *}
    8.24 + 
    8.25 +consts accessible_in   :: "prog \<Rightarrow> ty     \<Rightarrow> pname \<Rightarrow> bool"  
    8.26 +                                      ("_ \<turnstile> _ accessible'_in _" [61,61,61] 60)
    8.27 +       rt_accessible_in:: "prog \<Rightarrow> ref_ty \<Rightarrow> pname \<Rightarrow> bool" 
    8.28 +                                      ("_ \<turnstile> _ accessible'_in' _" [61,61,61] 60) 
    8.29 +primrec
    8.30 +"G\<turnstile>(PrimT p)   accessible_in pack  = True"
    8.31 +accessible_in_RefT_simp: 
    8.32 +"G\<turnstile>(RefT  r)   accessible_in pack  = G\<turnstile>r accessible_in' pack"
    8.33 +
    8.34 +"G\<turnstile>(NullT)     accessible_in' pack = True"
    8.35 +"G\<turnstile>(IfaceT I)  accessible_in' pack = ((pid I = pack) \<or> is_public G I)"
    8.36 +"G\<turnstile>(ClassT C)  accessible_in' pack = ((pid C = pack) \<or> is_public G C)"
    8.37 +"G\<turnstile>(ArrayT ty) accessible_in' pack = G\<turnstile>ty accessible_in pack"
    8.38 +
    8.39 +declare accessible_in_RefT_simp [simp del]
    8.40 +
    8.41 +constdefs
    8.42 +  is_acc_class :: "prog \<Rightarrow> pname \<Rightarrow> qtname \<Rightarrow> bool"
    8.43 +    "is_acc_class G P C \<equiv> is_class G C \<and> G\<turnstile>(Class C) accessible_in P"
    8.44 +  is_acc_iface :: "prog \<Rightarrow> pname \<Rightarrow> qtname \<Rightarrow> bool"
    8.45 +    "is_acc_iface G P I \<equiv> is_iface G I \<and> G\<turnstile>(Iface I) accessible_in P"
    8.46 +  is_acc_type  :: "prog \<Rightarrow> pname \<Rightarrow> ty     \<Rightarrow> bool"
    8.47 +    "is_acc_type  G P T \<equiv> is_type G T  \<and> G\<turnstile>T accessible_in P"
    8.48 +  is_acc_reftype  :: "prog \<Rightarrow> pname \<Rightarrow> ref_ty \<Rightarrow> bool"
    8.49 +  "is_acc_reftype  G P T \<equiv> isrtype G T  \<and> G\<turnstile>T accessible_in' P"
    8.50 +
    8.51 +lemma is_acc_classD:
    8.52 + "is_acc_class G P C \<Longrightarrow>  is_class G C \<and> G\<turnstile>(Class C) accessible_in P"
    8.53 +by (simp add: is_acc_class_def)
    8.54 +
    8.55 +lemma is_acc_class_is_class: "is_acc_class G P C \<Longrightarrow> is_class G C"
    8.56 +by (auto simp add: is_acc_class_def)
    8.57 +
    8.58 +lemma is_acc_ifaceD:
    8.59 +  "is_acc_iface G P I \<Longrightarrow> is_iface G I \<and> G\<turnstile>(Iface I) accessible_in P"
    8.60 +by (simp add: is_acc_iface_def)
    8.61 +
    8.62 +lemma is_acc_typeD:
    8.63 + "is_acc_type  G P T \<equiv> is_type G T  \<and> G\<turnstile>T accessible_in P"
    8.64 +by (simp add: is_acc_type_def)
    8.65 +
    8.66 +lemma is_acc_reftypeD:
    8.67 +"is_acc_reftype  G P T \<Longrightarrow> isrtype G T  \<and> G\<turnstile>T accessible_in' P"
    8.68 +by (simp add: is_acc_reftype_def)
    8.69 +
    8.70 +subsection "accessibility of members"
    8.71 +text {*
    8.72 +The accessibility of members is more involved as the accessibility of types.
    8.73 +We have to distinguish several cases to model the different effects of 
    8.74 +accessibility during inheritance, overriding and ordinary member access 
    8.75 +*}
    8.76 +
    8.77 +subsubsection {* Various technical conversion and selection functions *}
    8.78 +
    8.79 +text {* overloaded selector @{text accmodi} to select the access modifier 
    8.80 +out of various HOL types *}
    8.81 +
    8.82 +axclass has_accmodi < "type"
    8.83 +consts accmodi:: "'a::has_accmodi \<Rightarrow> acc_modi"
    8.84 +
    8.85 +instance acc_modi::has_accmodi
    8.86 +by (intro_classes)
    8.87 +
    8.88 +defs (overloaded)
    8.89 +acc_modi_accmodi_def: "accmodi (a::acc_modi) \<equiv> a"
    8.90 +
    8.91 +lemma acc_modi_accmodi_simp[simp]: "accmodi (a::acc_modi) = a"
    8.92 +by (simp add: acc_modi_accmodi_def)
    8.93 +
    8.94 +instance access_field_type:: ("type","type") has_accmodi
    8.95 +by (intro_classes)
    8.96 +
    8.97 +defs (overloaded)
    8.98 +decl_acc_modi_def: "accmodi (d::('a:: type) decl_scheme) \<equiv> access d"
    8.99 +
   8.100 +
   8.101 +lemma decl_acc_modi_simp[simp]: "accmodi (d::('a::type) decl_scheme) = access d"
   8.102 +by (simp add: decl_acc_modi_def)
   8.103 +
   8.104 +instance * :: ("type",has_accmodi) has_accmodi
   8.105 +by (intro_classes)
   8.106 +
   8.107 +defs (overloaded)
   8.108 +pair_acc_modi_def: "accmodi p \<equiv> (accmodi (snd p))"
   8.109 +
   8.110 +lemma pair_acc_modi_simp[simp]: "accmodi (x,a) = (accmodi a)"
   8.111 +by (simp add: pair_acc_modi_def)
   8.112 +
   8.113 +instance memberdecl :: has_accmodi
   8.114 +by (intro_classes)
   8.115 +
   8.116 +defs (overloaded)
   8.117 +memberdecl_acc_modi_def: "accmodi m \<equiv> (case m of
   8.118 +                                          fdecl f \<Rightarrow> accmodi f
   8.119 +                                        | mdecl m \<Rightarrow> accmodi m)"
   8.120 +
   8.121 +lemma memberdecl_fdecl_acc_modi_simp[simp]:
   8.122 + "accmodi (fdecl m) = accmodi m"
   8.123 +by (simp add: memberdecl_acc_modi_def)
   8.124 +
   8.125 +lemma memberdecl_mdecl_acc_modi_simp[simp]:
   8.126 + "accmodi (mdecl m) = accmodi m"
   8.127 +by (simp add: memberdecl_acc_modi_def)
   8.128 +
   8.129 +text {* overloaded selector @{text declclass} to select the declaring class 
   8.130 +out of various HOL types *}
   8.131 +
   8.132 +axclass has_declclass < "type"
   8.133 +consts declclass:: "'a::has_declclass \<Rightarrow> qtname"
   8.134 +
   8.135 +instance pid_field_type::("type","type") has_declclass
   8.136 +by (intro_classes)
   8.137 +
   8.138 +defs (overloaded)
   8.139 +qtname_declclass_def: "declclass (q::qtname) \<equiv> q"
   8.140 +
   8.141 +lemma qtname_declclass_simp[simp]: "declclass (q::qtname) = q"
   8.142 +by (simp add: qtname_declclass_def)
   8.143 +
   8.144 +instance * :: ("has_declclass","type") has_declclass
   8.145 +by (intro_classes)
   8.146 +
   8.147 +defs (overloaded)
   8.148 +pair_declclass_def: "declclass p \<equiv> declclass (fst p)"
   8.149 +
   8.150 +lemma pair_declclass_simp[simp]: "declclass (c,x) = declclass c" 
   8.151 +by (simp add: pair_declclass_def)
   8.152 +
   8.153 +text {* overloaded selector @{text is_static} to select the static modifier 
   8.154 +out of various HOL types *}
   8.155 +
   8.156 +
   8.157 +axclass has_static < "type"
   8.158 +consts is_static :: "'a::has_static \<Rightarrow> bool"
   8.159 +
   8.160 +(*
   8.161 +consts is_static :: "'a \<Rightarrow> bool"
   8.162 +*)
   8.163 +
   8.164 +instance access_field_type :: ("type","has_static") has_static
   8.165 +by (intro_classes) 
   8.166 +
   8.167 +defs (overloaded)
   8.168 +decl_is_static_def: 
   8.169 + "is_static (m::('a::has_static) decl_scheme) \<equiv> is_static (Decl.decl.more m)" 
   8.170 +
   8.171 +instance static_field_type :: ("type","type") has_static
   8.172 +by (intro_classes)
   8.173 +
   8.174 +defs (overloaded)
   8.175 +static_field_type_is_static_def: 
   8.176 + "is_static (m::(bool,'b::type) static_field_type) \<equiv> static_val m"
   8.177 +
   8.178 +lemma member_is_static_simp: "is_static (m::'a member_scheme) = static m"
   8.179 +apply (cases m)
   8.180 +apply (simp add: static_field_type_is_static_def 
   8.181 +                 decl_is_static_def Decl.member.dest_convs)
   8.182 +done
   8.183 +
   8.184 +instance * :: ("type","has_static") has_static
   8.185 +by (intro_classes)
   8.186 +
   8.187 +defs (overloaded)
   8.188 +pair_is_static_def: "is_static p \<equiv> is_static (snd p)"
   8.189 +
   8.190 +lemma pair_is_static_simp [simp]: "is_static (x,s) = is_static s"
   8.191 +by (simp add: pair_is_static_def)
   8.192 +
   8.193 +lemma pair_is_static_simp1: "is_static p = is_static (snd p)"
   8.194 +by (simp add: pair_is_static_def)
   8.195 +
   8.196 +instance memberdecl:: has_static
   8.197 +by (intro_classes)
   8.198 +
   8.199 +defs (overloaded)
   8.200 +memberdecl_is_static_def: 
   8.201 + "is_static m \<equiv> (case m of
   8.202 +                    fdecl f \<Rightarrow> is_static f
   8.203 +                  | mdecl m \<Rightarrow> is_static m)"
   8.204 +
   8.205 +lemma memberdecl_is_static_fdecl_simp[simp]:
   8.206 + "is_static (fdecl f) = is_static f"
   8.207 +by (simp add: memberdecl_is_static_def)
   8.208 +
   8.209 +lemma memberdecl_is_static_mdecl_simp[simp]:
   8.210 + "is_static (mdecl m) = is_static m"
   8.211 +by (simp add: memberdecl_is_static_def)
   8.212 +
   8.213 +lemma mhead_static_simp [simp]: "is_static (mhead m) = is_static m"
   8.214 +by (cases m) (simp add: mhead_def member_is_static_simp)
   8.215 +
   8.216 +constdefs  (* some mnemotic selectors for (qtname \<times> ('a::more) decl_scheme) 
   8.217 +            * the first component is a class or interface name
   8.218 +            * the second component is a method, field or method head *)
   8.219 +(* "declclass":: "(qtname \<times> ('a::more) decl_scheme) \<Rightarrow> qtname"*)
   8.220 +(* "declclass \<equiv> fst" *)          (* get the class component *)
   8.221 +
   8.222 + "decliface":: "(qtname \<times> ('a::type) decl_scheme) \<Rightarrow> qtname"
   8.223 + "decliface \<equiv> fst"          (* get the interface component *)
   8.224 +
   8.225 +(*
   8.226 + "member"::   "(qtname \<times> ('a::type) decl_scheme) \<Rightarrow> ('a::type) decl_scheme"
   8.227 +*)
   8.228 + "mbr"::   "(qtname \<times> memberdecl) \<Rightarrow> memberdecl"
   8.229 + "mbr \<equiv> snd"            (* get the memberdecl component *)
   8.230 +
   8.231 + "mthd"::   "('b \<times> 'a) \<Rightarrow> 'a"
   8.232 +                           (* also used for mdecl,mhead *)
   8.233 + "mthd \<equiv> snd"              (* get the method component *)
   8.234 +
   8.235 + "fld"::   "('b \<times> ('a::type) decl_scheme) \<Rightarrow> ('a::type) decl_scheme"
   8.236 +              (* also used for ((vname \<times> qtname)\<times> field) *)
   8.237 + "fld \<equiv> snd"               (* get the field component *)
   8.238 +
   8.239 +(* "accmodi" :: "('b \<times> ('a::type) decl_scheme) \<Rightarrow> acc_modi"*)
   8.240 +                           (* also used for mdecl *)
   8.241 +(* "accmodi \<equiv> access \<circ> snd"*)  (* get the access modifier *) 
   8.242 +(*
   8.243 + "is_static" ::"('b \<times> ('a::type) member_scheme) \<Rightarrow> bool" *)
   8.244 +                            (* also defined for emhead cf. WellType *)
   8.245 + (*"is_static \<equiv> static \<circ> snd"*) (* get the static modifier *)
   8.246 +
   8.247 +constdefs (* some mnemotic selectors for (vname \<times> qtname) *)
   8.248 + fname:: "(vname \<times> 'a) \<Rightarrow> vname" (* also used for fdecl *)
   8.249 + "fname \<equiv> fst"
   8.250 +  
   8.251 +  declclassf:: "(vname \<times> qtname) \<Rightarrow> qtname"
   8.252 + "declclassf \<equiv> snd"
   8.253 +
   8.254 +(*
   8.255 +lemma declclass_simp[simp]: "declclass (C,m) = C"
   8.256 +by (simp add: declclass_def)
   8.257 +*)
   8.258 +
   8.259 +lemma decliface_simp[simp]: "decliface (I,m) = I"
   8.260 +by (simp add: decliface_def) 
   8.261 +
   8.262 +lemma mbr_simp[simp]: "mbr (C,m) = m"
   8.263 +by (simp add: mbr_def)
   8.264 +
   8.265 +lemma access_mbr_simp [simp]: "(accmodi (mbr m)) = accmodi m"
   8.266 +by (cases m) (simp add:  mbr_def) 
   8.267 +
   8.268 +lemma mthd_simp[simp]: "mthd (C,m) = m"
   8.269 +by (simp add: mthd_def)
   8.270 +
   8.271 +lemma fld_simp[simp]: "fld (C,f) = f"
   8.272 +by (simp add: fld_def)
   8.273 +
   8.274 +lemma accmodi_simp[simp]: "accmodi (C,m) = access m"
   8.275 +by (simp )
   8.276 +
   8.277 +lemma access_mthd_simp [simp]: "(access (mthd m)) = accmodi m"
   8.278 +by (cases m) (simp add: mthd_def) 
   8.279 +
   8.280 +lemma access_fld_simp [simp]: "(access (fld f)) = accmodi f"
   8.281 +by (cases f) (simp add:  fld_def) 
   8.282 +
   8.283 +(*
   8.284 +lemma is_static_simp[simp]: "is_static (C,m) = static m"
   8.285 +by (simp add: is_static_def)
   8.286 +*)
   8.287 +
   8.288 +lemma static_mthd_simp[simp]: "static (mthd m) = is_static m"
   8.289 +by (cases m) (simp add:  mthd_def member_is_static_simp)
   8.290 +
   8.291 +lemma mthd_is_static_simp [simp]: "is_static (mthd m) = is_static m"
   8.292 +by (cases m) simp
   8.293 +
   8.294 +lemma static_fld_simp[simp]: "static (fld f) = is_static f"
   8.295 +by (cases f) (simp add:  fld_def member_is_static_simp)
   8.296 +
   8.297 +lemma ext_field_simp [simp]: "(declclass f,fld f) = f"
   8.298 +by (cases f) (simp add:  fld_def)
   8.299 +
   8.300 +lemma ext_method_simp [simp]: "(declclass m,mthd m) = m"
   8.301 +by (cases m) (simp add:  mthd_def)
   8.302 +
   8.303 +lemma ext_mbr_simp [simp]: "(declclass m,mbr m) = m"
   8.304 +by (cases m) (simp add: mbr_def)
   8.305 +
   8.306 +lemma fname_simp[simp]:"fname (n,c) = n"
   8.307 +by (simp add: fname_def)
   8.308 +
   8.309 +lemma declclassf_simp[simp]:"declclassf (n,c) = c"
   8.310 +by (simp add: declclassf_def)
   8.311 +
   8.312 +constdefs  (* some mnemotic selectors for (vname \<times> qtname) *)
   8.313 +  "fldname"  :: "(vname \<times> qtname) \<Rightarrow> vname" 
   8.314 +  "fldname \<equiv> fst"
   8.315 +
   8.316 +  "fldclass" :: "(vname \<times> qtname) \<Rightarrow> qtname"
   8.317 +  "fldclass \<equiv> snd"
   8.318 +
   8.319 +lemma fldname_simp[simp]: "fldname (n,c) = n"
   8.320 +by (simp add: fldname_def)
   8.321 +
   8.322 +lemma fldclass_simp[simp]: "fldclass (n,c) = c"
   8.323 +by (simp add: fldclass_def)
   8.324 +
   8.325 +lemma ext_fieldname_simp[simp]: "(fldname f,fldclass f) = f"
   8.326 +by (simp add: fldname_def fldclass_def)
   8.327 +
   8.328 +text {* Convert a qualified method declaration (qualified with its declaring 
   8.329 +class) to a qualified member declaration:  @{text methdMembr}  *}
   8.330 +
   8.331 +constdefs
   8.332 +methdMembr :: "(qtname \<times> mdecl) \<Rightarrow> (qtname \<times> memberdecl)"
   8.333 + "methdMembr m \<equiv> (fst m,mdecl (snd m))"
   8.334 +
   8.335 +lemma methdMembr_simp[simp]: "methdMembr (c,m) = (c,mdecl m)"
   8.336 +by (simp add: methdMembr_def)
   8.337 +
   8.338 +lemma accmodi_methdMembr_simp[simp]: "accmodi (methdMembr m) = accmodi m"
   8.339 +by (cases m) (simp add: methdMembr_def)
   8.340 +
   8.341 +lemma is_static_methdMembr_simp[simp]: "is_static (methdMembr m) = is_static m"
   8.342 +by (cases m) (simp add: methdMembr_def)
   8.343 +
   8.344 +lemma declclass_methdMembr_simp[simp]: "declclass (methdMembr m) = declclass m"
   8.345 +by (cases m) (simp add: methdMembr_def)
   8.346 +
   8.347 +text {* Convert a qualified method (qualified with its declaring 
   8.348 +class) to a qualified member declaration:  @{text method}  *}
   8.349 +
   8.350 +constdefs
   8.351 +method :: "sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> (qtname \<times> memberdecl)" 
   8.352 +"method sig m \<equiv> (declclass m, mdecl (sig, mthd m))"
   8.353 +
   8.354 +lemma method_simp[simp]: "method sig (C,m) = (C,mdecl (sig,m))"
   8.355 +by (simp add: method_def)
   8.356 +
   8.357 +lemma accmodi_method_simp[simp]: "accmodi (method sig m) = accmodi m"
   8.358 +by (simp add: method_def)
   8.359 +
   8.360 +lemma declclass_method_simp[simp]: "declclass (method sig m) = declclass m"
   8.361 +by (simp add: method_def)
   8.362 +
   8.363 +lemma is_static_method_simp[simp]: "is_static (method sig m) = is_static m"
   8.364 +by (cases m) (simp add: method_def)
   8.365 +
   8.366 +lemma mbr_method_simp[simp]: "mbr (method sig m) = mdecl (sig,mthd m)"
   8.367 +by (simp add: mbr_def method_def)
   8.368 +
   8.369 +lemma memberid_method_simp[simp]:  "memberid (method sig m) = mid sig"
   8.370 +  by (simp add: method_def) 
   8.371 +
   8.372 +constdefs
   8.373 +fieldm :: "vname \<Rightarrow> (qtname \<times> field) \<Rightarrow> (qtname \<times> memberdecl)" 
   8.374 +"fieldm n f \<equiv> (declclass f, fdecl (n, fld f))"
   8.375 +
   8.376 +lemma fieldm_simp[simp]: "fieldm n (C,f) = (C,fdecl (n,f))"
   8.377 +by (simp add: fieldm_def)
   8.378 +
   8.379 +lemma accmodi_fieldm_simp[simp]: "accmodi (fieldm n f) = accmodi f"
   8.380 +by (simp add: fieldm_def)
   8.381 +
   8.382 +lemma declclass_fieldm_simp[simp]: "declclass (fieldm n f) = declclass f"
   8.383 +by (simp add: fieldm_def)
   8.384 +
   8.385 +lemma is_static_fieldm_simp[simp]: "is_static (fieldm n f) = is_static f"
   8.386 +by (cases f) (simp add: fieldm_def)
   8.387 +
   8.388 +lemma mbr_fieldm_simp[simp]: "mbr (fieldm n f) = fdecl (n,fld f)"
   8.389 +by (simp add: mbr_def fieldm_def)
   8.390 +
   8.391 +lemma memberid_fieldm_simp[simp]:  "memberid (fieldm n f) = fid n"
   8.392 +by (simp add: fieldm_def) 
   8.393 +
   8.394 +text {* Select the signature out of a qualified method declaration:
   8.395 + @{text msig} *}
   8.396 +
   8.397 +constdefs msig:: "(qtname \<times> mdecl) \<Rightarrow> sig"
   8.398 +"msig m \<equiv> fst (snd m)"
   8.399 +
   8.400 +lemma msig_simp[simp]: "msig (c,(s,m)) = s"
   8.401 +by (simp add: msig_def)
   8.402 +
   8.403 +text {* Convert a qualified method (qualified with its declaring 
   8.404 +class) to a qualified method declaration:  @{text qmdecl}  *}
   8.405 +
   8.406 +constdefs qmdecl :: "sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> (qtname \<times> mdecl)"
   8.407 +"qmdecl sig m \<equiv> (declclass m, (sig,mthd m))"
   8.408 +
   8.409 +lemma qmdecl_simp[simp]: "qmdecl sig (C,m) = (C,(sig,m))"
   8.410 +by (simp add: qmdecl_def)
   8.411 +
   8.412 +lemma declclass_qmdecl_simp[simp]: "declclass (qmdecl sig m) = declclass m"
   8.413 +by (simp add: qmdecl_def)
   8.414 +
   8.415 +lemma accmodi_qmdecl_simp[simp]: "accmodi (qmdecl sig m) = accmodi m"
   8.416 +by (simp add: qmdecl_def)
   8.417 +
   8.418 +lemma is_static_qmdecl_simp[simp]: "is_static (qmdecl sig m) = is_static m"
   8.419 +by (cases m) (simp add: qmdecl_def)
   8.420 +
   8.421 +lemma msig_qmdecl_simp[simp]: "msig (qmdecl sig m) = sig"
   8.422 +by (simp add: qmdecl_def)
   8.423 +
   8.424 +lemma mdecl_qmdecl_simp[simp]:  
   8.425 + "mdecl (mthd (qmdecl sig new)) = mdecl (sig, mthd new)" 
   8.426 +by (simp add: qmdecl_def) 
   8.427 +
   8.428 +lemma methdMembr_qmdecl_simp [simp]: 
   8.429 + "methdMembr (qmdecl sig old) = method sig old"
   8.430 +by (simp add: methdMembr_def qmdecl_def method_def)
   8.431 +
   8.432 +text {* overloaded selector @{text resTy} to select the result type 
   8.433 +out of various HOL types *}
   8.434 +
   8.435 +axclass has_resTy < "type"
   8.436 +consts resTy:: "'a::has_resTy \<Rightarrow> ty"
   8.437 +
   8.438 +instance access_field_type :: ("type","has_resTy") has_resTy
   8.439 +by (intro_classes)
   8.440 +
   8.441 +defs (overloaded)
   8.442 +decl_resTy_def: 
   8.443 + "resTy (m::('a::has_resTy) decl_scheme) \<equiv> resTy (Decl.decl.more m)" 
   8.444 +
   8.445 +instance static_field_type :: ("type","has_resTy") has_resTy
   8.446 +by (intro_classes)
   8.447 +
   8.448 +defs (overloaded)
   8.449 +static_field_type_resTy_def: 
   8.450 + "resTy (m::(bool,'b::has_resTy) static_field_type) 
   8.451 +  \<equiv> resTy (static_more m)" 
   8.452 +
   8.453 +instance pars_field_type :: ("type","has_resTy") has_resTy
   8.454 +by (intro_classes)
   8.455 +
   8.456 +defs (overloaded)
   8.457 +pars_field_type_resTy_def: 
   8.458 + "resTy (m::(vname list,'b::has_resTy) pars_field_type) 
   8.459 +  \<equiv> resTy (pars_more m)" 
   8.460 +
   8.461 +instance resT_field_type :: ("type","type") has_resTy
   8.462 +by (intro_classes)
   8.463 +
   8.464 +defs (overloaded)
   8.465 +resT_field_type_resTy_def: 
   8.466 + "resTy (m::(ty,'b::type) resT_field_type) 
   8.467 +  \<equiv> resT_val m" 
   8.468 +
   8.469 +lemma mhead_resTy_simp: "resTy (m::'a mhead_scheme) = resT m"
   8.470 +apply (cases m)
   8.471 +apply (simp add: decl_resTy_def static_field_type_resTy_def 
   8.472 +                 pars_field_type_resTy_def resT_field_type_resTy_def
   8.473 +                 member.dest_convs mhead.dest_convs)
   8.474 +done
   8.475 +
   8.476 +lemma resTy_mhead [simp]:"resTy (mhead m) = resTy m"
   8.477 +by (simp add: mhead_def mhead_resTy_simp)
   8.478 +
   8.479 +instance * :: ("type","has_resTy") has_resTy
   8.480 +by (intro_classes)
   8.481 +
   8.482 +defs (overloaded)
   8.483 +pair_resTy_def: "resTy p \<equiv> resTy (snd p)"
   8.484 +
   8.485 +lemma pair_resTy_simp[simp]: "resTy (x,m) = resTy m"
   8.486 +by (simp add: pair_resTy_def)
   8.487 +
   8.488 +lemma qmdecl_resTy_simp [simp]: "resTy (qmdecl sig m) = resTy m"
   8.489 +by (cases m) (simp)
   8.490 +
   8.491 +lemma resTy_mthd [simp]:"resTy (mthd m) = resTy m"
   8.492 +by (cases m) (simp add: mthd_def )
   8.493 +
   8.494 +subsubsection "inheritable-in"
   8.495 +text {*
   8.496 +@{text "G\<turnstile>m inheritable_in P"}: m can be inherited by
   8.497 +classes in package P if:
   8.498 +\begin{itemize} 
   8.499 +\item the declaration class of m is accessible in P and
   8.500 +\item the member m is declared with protected or public access or if it is
   8.501 +      declared with default (package) access, the package of the declaration 
   8.502 +      class of m is also P. If the member m is declared with private access
   8.503 +      it is not accessible for inheritance at all.
   8.504 +\end{itemize}
   8.505 +*}
   8.506 +constdefs
   8.507 +inheritable_in:: 
   8.508 + "prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> pname \<Rightarrow> bool"
   8.509 +                  ("_ \<turnstile> _ inheritable'_in _" [61,61,61] 60)
   8.510 +"G\<turnstile>membr inheritable_in pack 
   8.511 +  \<equiv> (case (accmodi membr) of
   8.512 +       Private   \<Rightarrow> False
   8.513 +     | Package   \<Rightarrow> (pid (declclass membr)) = pack
   8.514 +     | Protected \<Rightarrow> True
   8.515 +     | Public    \<Rightarrow> True)"
   8.516 +
   8.517 +syntax
   8.518 +Method_inheritable_in::
   8.519 + "prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> pname \<Rightarrow> bool"
   8.520 +                ("_ \<turnstile>Method _ inheritable'_in _ " [61,61,61] 60)
   8.521 +
   8.522 +translations
   8.523 +"G\<turnstile>Method m inheritable_in p" == "G\<turnstile>methdMembr m inheritable_in p"
   8.524 +
   8.525 +syntax
   8.526 +Methd_inheritable_in::
   8.527 + "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> pname \<Rightarrow> bool"
   8.528 +                ("_ \<turnstile>Methd _ _ inheritable'_in _ " [61,61,61,61] 60)
   8.529 +
   8.530 +translations
   8.531 +"G\<turnstile>Methd s m inheritable_in p" == "G\<turnstile>(method s m) inheritable_in p"
   8.532 +
   8.533 +subsubsection "declared-in/undeclared-in"
   8.534 +
   8.535 +constdefs cdeclaredmethd:: "prog \<Rightarrow> qtname \<Rightarrow> (sig,methd) table"
   8.536 +"cdeclaredmethd G C 
   8.537 +  \<equiv> (case class G C of
   8.538 +       None \<Rightarrow> \<lambda> sig. None
   8.539 +     | Some c \<Rightarrow> table_of (methods c)
   8.540 +    )"
   8.541 +
   8.542 +constdefs
   8.543 +cdeclaredfield:: "prog \<Rightarrow> qtname \<Rightarrow> (vname,field) table"
   8.544 +"cdeclaredfield G C 
   8.545 +  \<equiv> (case class G C of
   8.546 +       None \<Rightarrow> \<lambda> sig. None
   8.547 +     | Some c \<Rightarrow> table_of (cfields c)
   8.548 +    )"
   8.549 +
   8.550 +
   8.551 +constdefs
   8.552 +declared_in:: "prog  \<Rightarrow> memberdecl \<Rightarrow> qtname \<Rightarrow> bool"
   8.553 +                                 ("_\<turnstile> _ declared'_in _" [61,61,61] 60)
   8.554 +"G\<turnstile>m declared_in C \<equiv> (case m of
   8.555 +                        fdecl (fn,f ) \<Rightarrow> cdeclaredfield G C fn  = Some f
   8.556 +                      | mdecl (sig,m) \<Rightarrow> cdeclaredmethd G C sig = Some m)"
   8.557 +
   8.558 +syntax
   8.559 +method_declared_in:: "prog  \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> qtname \<Rightarrow> bool"
   8.560 +                                 ("_\<turnstile>Method _ declared'_in _" [61,61,61] 60)
   8.561 +translations
   8.562 +"G\<turnstile>Method m declared_in C" == "G\<turnstile>mdecl (mthd m) declared_in C"
   8.563 +
   8.564 +syntax
   8.565 +methd_declared_in:: "prog  \<Rightarrow> sig  \<Rightarrow>(qtname \<times> methd) \<Rightarrow> qtname \<Rightarrow> bool"
   8.566 +                               ("_\<turnstile>Methd _  _ declared'_in _" [61,61,61,61] 60)
   8.567 +translations
   8.568 +"G\<turnstile>Methd s m declared_in C" == "G\<turnstile>mdecl (s,mthd m) declared_in C"
   8.569 +
   8.570 +lemma declared_in_classD:
   8.571 + "G\<turnstile>m declared_in C \<Longrightarrow> is_class G C"
   8.572 +by (cases m) 
   8.573 +   (auto simp add: declared_in_def cdeclaredmethd_def cdeclaredfield_def)
   8.574 +
   8.575 +constdefs
   8.576 +undeclared_in:: "prog  \<Rightarrow> memberid \<Rightarrow> qtname \<Rightarrow> bool"
   8.577 +                                 ("_\<turnstile> _ undeclared'_in _" [61,61,61] 60)
   8.578 +
   8.579 +"G\<turnstile>m undeclared_in C \<equiv> (case m of
   8.580 +                            fid fn  \<Rightarrow> cdeclaredfield G C fn  = None
   8.581 +                          | mid sig \<Rightarrow> cdeclaredmethd G C sig = None)"
   8.582 +
   8.583 +lemma method_declared_inI:
   8.584 +  "\<lbrakk>class G C = Some c; table_of (methods c) sig = Some m\<rbrakk> 
   8.585 +   \<Longrightarrow> G\<turnstile>mdecl (sig,m) declared_in C"
   8.586 +by (auto simp add: declared_in_def cdeclaredmethd_def)
   8.587 +
   8.588 +
   8.589 +subsubsection "members"
   8.590 +
   8.591 +consts
   8.592 +members:: "prog \<Rightarrow> (qtname \<times> (qtname \<times> memberdecl)) set"
   8.593 +(* Can't just take a function: prog \<Rightarrow> qtname \<Rightarrow> memberdecl set because
   8.594 +   the class qtname changes to the superclass in the inductive definition
   8.595 +   below
   8.596 +*)
   8.597 +
   8.598 +syntax
   8.599 +member_of:: "prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> qtname \<Rightarrow> bool"
   8.600 +                           ("_ \<turnstile> _ member'_of _" [61,61,61] 60)
   8.601 +
   8.602 +translations
   8.603 + "G\<turnstile>m member_of C" \<rightleftharpoons> "(C,m) \<in> members G"
   8.604 +
   8.605 +inductive "members G"  intros
   8.606 +
   8.607 +Immediate: "\<lbrakk>G\<turnstile>mbr m declared_in C;declclass m = C\<rbrakk> \<Longrightarrow> G\<turnstile>m member_of C"
   8.608 +Inherited: "\<lbrakk>G\<turnstile>m inheritable_in (pid C); G\<turnstile>memberid m undeclared_in C; 
   8.609 +             G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S; G\<turnstile>(Class S) accessible_in (pid C);G\<turnstile>m member_of S 
   8.610 +            \<rbrakk> \<Longrightarrow> G\<turnstile>m member_of C"
   8.611 +text {* Note that in the case of an inherited member only the members of the
   8.612 +direct superclass are concerned. If a member of a superclass of the direct
   8.613 +superclass isn't inherited in the direct superclass (not member of the
   8.614 +direct superclass) than it can't be a member of the class. E.g. If a
   8.615 +member of a class A is defined with package access it isn't member of a 
   8.616 +subclass S if S isn't in the same package as A. Any further subclasses 
   8.617 +of S will not inherit the member, regardless if they are in the same
   8.618 +package as A or not.*}
   8.619 +
   8.620 +syntax
   8.621 +method_member_of:: "prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> qtname \<Rightarrow> bool"
   8.622 +                           ("_ \<turnstile>Method _ member'_of _" [61,61,61] 60)
   8.623 +
   8.624 +translations
   8.625 + "G\<turnstile>Method m member_of C" \<rightleftharpoons> "G\<turnstile>(methdMembr m) member_of C" 
   8.626 +
   8.627 +syntax
   8.628 +methd_member_of:: "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> qtname \<Rightarrow> bool"
   8.629 +                           ("_ \<turnstile>Methd _ _ member'_of _" [61,61,61,61] 60)
   8.630 +
   8.631 +translations
   8.632 + "G\<turnstile>Methd s m member_of C" \<rightleftharpoons> "G\<turnstile>(method s m) member_of C" 
   8.633 +
   8.634 +syntax
   8.635 +fieldm_member_of:: "prog \<Rightarrow> vname \<Rightarrow> (qtname \<times> field) \<Rightarrow> qtname \<Rightarrow> bool"
   8.636 +                           ("_ \<turnstile>Field _  _ member'_of _" [61,61,61] 60)
   8.637 +
   8.638 +translations
   8.639 + "G\<turnstile>Field n f member_of C" \<rightleftharpoons> "G\<turnstile>fieldm n f member_of C" 
   8.640 +
   8.641 +constdefs
   8.642 +inherits:: "prog \<Rightarrow> qtname \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> bool"
   8.643 +                           ("_ \<turnstile> _ inherits _" [61,61,61] 60)
   8.644 +"G\<turnstile>C inherits m 
   8.645 +  \<equiv> G\<turnstile>m inheritable_in (pid C) \<and> G\<turnstile>memberid m undeclared_in C \<and> 
   8.646 +    (\<exists> S. G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S \<and> G\<turnstile>(Class S) accessible_in (pid C) \<and> G\<turnstile>m member_of S)"
   8.647 +
   8.648 +lemma inherits_member: "G\<turnstile>C inherits m \<Longrightarrow> G\<turnstile>m member_of C"
   8.649 +by (auto simp add: inherits_def intro: members.Inherited)
   8.650 +
   8.651 +
   8.652 +constdefs member_in::"prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> qtname \<Rightarrow> bool"
   8.653 +                           ("_ \<turnstile> _ member'_in _" [61,61,61] 60)
   8.654 +"G\<turnstile>m member_in C \<equiv> \<exists> provC. G\<turnstile> C \<preceq>\<^sub>C provC \<and> G \<turnstile> m member_of provC"
   8.655 +text {* A member is in a class if it is member of the class or a superclass.
   8.656 +If a member is in a class we can select this member. This additional notion
   8.657 +is necessary since not all members are inherited to subclasses. So such
   8.658 +members are not member-of the subclass but member-in the subclass.*}
   8.659 +
   8.660 +syntax
   8.661 +method_member_in:: "prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> qtname \<Rightarrow> bool"
   8.662 +                           ("_ \<turnstile>Method _ member'_in _" [61,61,61] 60)
   8.663 +
   8.664 +translations
   8.665 + "G\<turnstile>Method m member_in C" \<rightleftharpoons> "G\<turnstile>(methdMembr m) member_in C" 
   8.666 +
   8.667 +syntax
   8.668 +methd_member_in:: "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> qtname \<Rightarrow> bool"
   8.669 +                           ("_ \<turnstile>Methd _ _ member'_in _" [61,61,61,61] 60)
   8.670 +
   8.671 +translations
   8.672 + "G\<turnstile>Methd s m member_in C" \<rightleftharpoons> "G\<turnstile>(method s m) member_in C" 
   8.673 +
   8.674 +consts stat_overridesR::
   8.675 +  "prog  \<Rightarrow> ((qtname \<times> mdecl) \<times> (qtname \<times> mdecl)) set"
   8.676 +
   8.677 +lemma member_inD: "G\<turnstile>m member_in C 
   8.678 + \<Longrightarrow> \<exists> provC. G\<turnstile> C \<preceq>\<^sub>C provC \<and> G \<turnstile> m member_of provC"
   8.679 +by (auto simp add: member_in_def)
   8.680 +
   8.681 +lemma member_inI: "\<lbrakk>G \<turnstile> m member_of provC;G\<turnstile> C \<preceq>\<^sub>C provC\<rbrakk> \<Longrightarrow>  G\<turnstile>m member_in C"
   8.682 +by (auto simp add: member_in_def)
   8.683 +
   8.684 +lemma member_of_to_member_in: "G \<turnstile> m member_of C \<Longrightarrow> G \<turnstile>m member_in C"
   8.685 +by (auto intro: member_inI)
   8.686 +
   8.687 +
   8.688 +subsubsection "overriding"
   8.689 +
   8.690 +text {* Unfortunately the static notion of overriding (used during the
   8.691 +typecheck of the compiler) and the dynamic notion of overriding (used during
   8.692 +execution in the JVM) are not exactly the same. 
   8.693 +*}
   8.694 +
   8.695 +text {* Static overriding (used during the typecheck of the compiler) *}
   8.696 +syntax
   8.697 +stat_overrides:: "prog  \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> bool" 
   8.698 +                                  ("_ \<turnstile> _ overrides\<^sub>S _" [61,61,61] 60)
   8.699 +translations
   8.700 + "G\<turnstile>new overrides\<^sub>S  old" == "(new,old) \<in> stat_overridesR G "
   8.701 +
   8.702 +inductive "stat_overridesR G" intros
   8.703 +
   8.704 +Direct: "\<lbrakk>\<not> is_static new; msig new = msig old; 
   8.705 +         G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old);
   8.706 +         G\<turnstile>Method new declared_in (declclass new);  
   8.707 +         G\<turnstile>Method old declared_in (declclass old); 
   8.708 +         G\<turnstile>Method old inheritable_in pid (declclass new);
   8.709 +         G\<turnstile>(declclass new) \<prec>\<^sub>C\<^sub>1 superNew;
   8.710 +         G \<turnstile>Method old member_of superNew
   8.711 +         \<rbrakk> \<Longrightarrow> G\<turnstile>new overrides\<^sub>S old"
   8.712 +
   8.713 +Indirect: "\<lbrakk>G\<turnstile>new overrides\<^sub>S inter; G\<turnstile>inter overrides\<^sub>S old\<rbrakk>
   8.714 +           \<Longrightarrow> G\<turnstile>new overrides\<^sub>S old"
   8.715 +
   8.716 +text {* Dynamic overriding (used during the typecheck of the compiler) *}
   8.717 +consts overridesR::
   8.718 +  "prog  \<Rightarrow> ((qtname \<times> mdecl) \<times> (qtname \<times> mdecl)) set"
   8.719 +
   8.720 +
   8.721 +overrides:: "prog  \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> bool" 
   8.722 +                                  ("_ \<turnstile> _ overrides _" [61,61,61] 60)
   8.723 +translations
   8.724 + "G\<turnstile>new overrides old" == "(new,old) \<in> overridesR G "
   8.725 +
   8.726 +inductive "overridesR G" intros
   8.727 +
   8.728 +Direct: "\<lbrakk>\<not> is_static new; \<not> is_static old; accmodi new \<noteq> Private;
   8.729 +         msig new = msig old; 
   8.730 +         G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old);
   8.731 +         G\<turnstile>Method new declared_in (declclass new);  
   8.732 +         G\<turnstile>Method old declared_in (declclass old);    
   8.733 +         G\<turnstile>Method old inheritable_in pid (declclass new);
   8.734 +         G\<turnstile>resTy new \<preceq> resTy old
   8.735 +         \<rbrakk> \<Longrightarrow> G\<turnstile>new overrides old"
   8.736 +
   8.737 +Indirect: "\<lbrakk>G\<turnstile>new overrides inter; G\<turnstile>inter overrides old\<rbrakk>
   8.738 +           \<Longrightarrow> G\<turnstile>new overrides old"
   8.739 +
   8.740 +syntax
   8.741 +sig_stat_overrides:: 
   8.742 + "prog  \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> (qtname \<times> methd) \<Rightarrow> bool" 
   8.743 +                                  ("_,_\<turnstile> _ overrides\<^sub>S _" [61,61,61,61] 60)
   8.744 +translations
   8.745 + "G,s\<turnstile>new overrides\<^sub>S old" \<rightharpoonup> "G\<turnstile>(qmdecl s new) overrides\<^sub>S (qmdecl s old)" 
   8.746 +
   8.747 +syntax
   8.748 +sig_overrides:: "prog  \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> (qtname \<times> methd) \<Rightarrow> bool" 
   8.749 +                                  ("_,_\<turnstile> _ overrides _" [61,61,61,61] 60)
   8.750 +translations
   8.751 + "G,s\<turnstile>new overrides old" \<rightharpoonup> "G\<turnstile>(qmdecl s new) overrides (qmdecl s old)" 
   8.752 +
   8.753 +subsubsection "Hiding"
   8.754 +
   8.755 +constdefs hides::
   8.756 +"prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> bool" 
   8.757 +                                ("_\<turnstile> _ hides _" [61,61,61] 60)
   8.758 +"G\<turnstile>new hides old
   8.759 +  \<equiv> is_static new \<and> msig new = msig old \<and>
   8.760 +    G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old) \<and>
   8.761 +    G\<turnstile>Method new declared_in (declclass new) \<and>
   8.762 +    G\<turnstile>Method old declared_in (declclass old) \<and> 
   8.763 +    G\<turnstile>Method old inheritable_in pid (declclass new)"
   8.764 +
   8.765 +syntax
   8.766 +sig_hides:: "prog  \<Rightarrow> sig \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> bool" 
   8.767 +                                  ("_,_\<turnstile> _ hides _" [61,61,61,61] 60)
   8.768 +translations
   8.769 + "G,s\<turnstile>new hides old" \<rightharpoonup> "G\<turnstile>(qmdecl s new) hides (qmdecl s old)" 
   8.770 +
   8.771 +lemma hidesI:
   8.772 +"\<lbrakk>is_static new; msig new = msig old;
   8.773 +  G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old);
   8.774 +  G\<turnstile>Method new declared_in (declclass new);
   8.775 +  G\<turnstile>Method old declared_in (declclass old);
   8.776 +  G\<turnstile>Method old inheritable_in pid (declclass new)
   8.777 + \<rbrakk> \<Longrightarrow> G\<turnstile>new hides old"
   8.778 +by (auto simp add: hides_def)
   8.779 +
   8.780 +lemma hidesD:
   8.781 +"\<lbrakk>G\<turnstile>new hides old\<rbrakk> \<Longrightarrow>  
   8.782 +  declclass new \<noteq> Object \<and> is_static new \<and> msig new = msig old \<and> 
   8.783 +  G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old) \<and>
   8.784 +  G\<turnstile>Method new declared_in (declclass new) \<and>   
   8.785 +  G\<turnstile>Method old declared_in (declclass old)"
   8.786 +by (auto simp add: hides_def)
   8.787 +
   8.788 +lemma overrides_commonD:
   8.789 +"\<lbrakk>G\<turnstile>new overrides old\<rbrakk> \<Longrightarrow>  
   8.790 +  declclass new \<noteq> Object \<and> \<not> is_static new \<and> \<not> is_static old \<and>
   8.791 +  accmodi new \<noteq> Private \<and> 
   8.792 +  msig new = msig old  \<and>
   8.793 +  G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old) \<and>
   8.794 +  G\<turnstile>Method new declared_in (declclass new) \<and>   
   8.795 +  G\<turnstile>Method old declared_in (declclass old)"
   8.796 +by (induct set: overridesR) (auto intro: trancl_trans)
   8.797 +
   8.798 +lemma ws_overrides_commonD:
   8.799 +"\<lbrakk>G\<turnstile>new overrides old;ws_prog G\<rbrakk> \<Longrightarrow>  
   8.800 +  declclass new \<noteq> Object \<and> \<not> is_static new \<and> \<not> is_static old \<and>
   8.801 +  accmodi new \<noteq> Private \<and> G\<turnstile>resTy new \<preceq> resTy old \<and>
   8.802 +  msig new = msig old  \<and>
   8.803 +  G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old) \<and>
   8.804 +  G\<turnstile>Method new declared_in (declclass new) \<and>   
   8.805 +  G\<turnstile>Method old declared_in (declclass old)"
   8.806 +by (induct set: overridesR) (auto intro: trancl_trans ws_widen_trans)
   8.807 +
   8.808 +lemma stat_overrides_commonD:
   8.809 +"\<lbrakk>G\<turnstile>new overrides\<^sub>S old\<rbrakk> \<Longrightarrow>  
   8.810 +  declclass new \<noteq> Object \<and> \<not> is_static new \<and> msig new = msig old \<and> 
   8.811 +  G\<turnstile>(declclass new) \<prec>\<^sub>C (declclass old) \<and>
   8.812 +  G\<turnstile>Method new declared_in (declclass new) \<and>   
   8.813 +  G\<turnstile>Method old declared_in (declclass old)"
   8.814 +by (induct set: stat_overridesR) (auto intro: trancl_trans)
   8.815 +
   8.816 +lemma overrides_eq_sigD: 
   8.817 + "\<lbrakk>G\<turnstile>new overrides old\<rbrakk> \<Longrightarrow> msig old=msig new"
   8.818 +by (auto dest: overrides_commonD)
   8.819 +
   8.820 +lemma hides_eq_sigD: 
   8.821 + "\<lbrakk>G\<turnstile>new hides old\<rbrakk> \<Longrightarrow> msig old=msig new"
   8.822 +by (auto simp add: hides_def)
   8.823 +
   8.824 +subsubsection "permits access" 
   8.825 +constdefs 
   8.826 +permits_acc:: 
   8.827 + "prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.828 +                   ("_ \<turnstile> _ in _ permits'_acc'_to _" [61,61,61,61] 60)
   8.829 +
   8.830 +"G\<turnstile>membr in class permits_acc_to accclass 
   8.831 +  \<equiv> (case (accmodi membr) of
   8.832 +       Private   \<Rightarrow> (declclass membr = accclass)
   8.833 +     | Package   \<Rightarrow> (pid (declclass membr) = pid accclass)
   8.834 +     | Protected \<Rightarrow> (pid (declclass membr) = pid accclass)
   8.835 +                    \<or>
   8.836 +                    (G\<turnstile>accclass \<prec>\<^sub>C declclass membr \<and> G\<turnstile>class \<preceq>\<^sub>C accclass) 
   8.837 +     | Public    \<Rightarrow> True)"
   8.838 +text {*
   8.839 +The subcondition of the @{term "Protected"} case: 
   8.840 +@{term "G\<turnstile>accclass \<prec>\<^sub>C declclass membr"} could also be relaxed to:
   8.841 +@{term "G\<turnstile>accclass \<preceq>\<^sub>C declclass membr"} since in case both classes are the
   8.842 +same the other condition @{term "(pid (declclass membr) = pid accclass)"}
   8.843 +holds anyway.
   8.844 +*} 
   8.845 +
   8.846 +text {* Like in case of overriding, the static and dynamic accessibility 
   8.847 +of members is not uniform.
   8.848 +\begin{itemize}
   8.849 +\item Statically the class/interface of the member must be accessible for the
   8.850 +      member to be accessible. During runtime this is not necessary. For
   8.851 +      Example, if a class is accessible and we are allowed to access a member
   8.852 +      of this class (statically) we expect that we can access this member in 
   8.853 +      an arbitrary subclass (during runtime). It's not intended to restrict
   8.854 +      the access to accessible subclasses during runtime.
   8.855 +\item Statically the member we want to access must be "member of" the class.
   8.856 +      Dynamically it must only be "member in" the class.
   8.857 +\end{itemize} 
   8.858 +*} 
   8.859 +
   8.860 +
   8.861 +consts
   8.862 +accessible_fromR:: 
   8.863 + "prog \<Rightarrow> qtname \<Rightarrow> ((qtname \<times> memberdecl) \<times>  qtname) set"
   8.864 +
   8.865 +syntax 
   8.866 +accessible_from:: 
   8.867 + "prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.868 +                   ("_ \<turnstile> _ of _ accessible'_from _" [61,61,61,61] 60)
   8.869 +
   8.870 +translations
   8.871 +"G\<turnstile>membr of cls accessible_from accclass"  
   8.872 + \<rightleftharpoons> "(membr,cls) \<in> accessible_fromR G accclass"
   8.873 +
   8.874 +syntax 
   8.875 +method_accessible_from:: 
   8.876 + "prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.877 +                   ("_ \<turnstile>Method _ of _ accessible'_from _" [61,61,61,61] 60)
   8.878 +
   8.879 +translations
   8.880 +"G\<turnstile>Method m of cls accessible_from accclass"  
   8.881 + \<rightleftharpoons> "G\<turnstile>methdMembr m of cls accessible_from accclass"  
   8.882 +
   8.883 +syntax 
   8.884 +methd_accessible_from:: 
   8.885 + "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.886 +                 ("_ \<turnstile>Methd _ _ of _ accessible'_from _" [61,61,61,61,61] 60)
   8.887 +
   8.888 +translations
   8.889 +"G\<turnstile>Methd s m of cls accessible_from accclass"  
   8.890 + \<rightleftharpoons> "G\<turnstile>(method s m) of cls accessible_from accclass"  
   8.891 +
   8.892 +syntax 
   8.893 +field_accessible_from:: 
   8.894 + "prog \<Rightarrow> vname \<Rightarrow> (qtname \<times> field) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.895 +                 ("_ \<turnstile>Field _  _ of _ accessible'_from _" [61,61,61,61,61] 60)
   8.896 +
   8.897 +translations
   8.898 +"G\<turnstile>Field fn f of C accessible_from accclass"  
   8.899 + \<rightleftharpoons> "G\<turnstile>(fieldm fn f) of C accessible_from accclass" 
   8.900 +
   8.901 +inductive "accessible_fromR G accclass" intros
   8.902 +immediate:  "\<lbrakk>G\<turnstile>membr member_of class;
   8.903 +              G\<turnstile>(Class class) accessible_in (pid accclass);
   8.904 +              G\<turnstile>membr in class permits_acc_to accclass 
   8.905 +             \<rbrakk> \<Longrightarrow> G\<turnstile>membr of class accessible_from accclass"
   8.906 +
   8.907 +overriding: "\<lbrakk>G\<turnstile>membr member_of class;
   8.908 +              G\<turnstile>(Class class) accessible_in (pid accclass);
   8.909 +              membr=(C,mdecl new);
   8.910 +              G\<turnstile>(C,new) overrides\<^sub>S old; 
   8.911 +              G\<turnstile>class \<prec>\<^sub>C sup;
   8.912 +              G\<turnstile>Method old of sup accessible_from accclass
   8.913 +             \<rbrakk>\<Longrightarrow> G\<turnstile>membr of class accessible_from accclass"
   8.914 +
   8.915 +consts
   8.916 +dyn_accessible_fromR:: 
   8.917 + "prog \<Rightarrow> qtname \<Rightarrow> ((qtname \<times> memberdecl) \<times>  qtname) set"
   8.918 +
   8.919 +syntax 
   8.920 +dyn_accessible_from:: 
   8.921 + "prog \<Rightarrow> (qtname \<times> memberdecl) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.922 +                   ("_ \<turnstile> _ in _ dyn'_accessible'_from _" [61,61,61,61] 60)
   8.923 +
   8.924 +translations
   8.925 +"G\<turnstile>membr in C dyn_accessible_from accC"  
   8.926 + \<rightleftharpoons> "(membr,C) \<in> dyn_accessible_fromR G accC"
   8.927 +
   8.928 +syntax 
   8.929 +method_dyn_accessible_from:: 
   8.930 + "prog \<Rightarrow> (qtname \<times> mdecl) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.931 +                 ("_ \<turnstile>Method _ in _ dyn'_accessible'_from _" [61,61,61,61] 60)
   8.932 +
   8.933 +translations
   8.934 +"G\<turnstile>Method m in C dyn_accessible_from accC"  
   8.935 + \<rightleftharpoons> "G\<turnstile>methdMembr m in C dyn_accessible_from accC"  
   8.936 +
   8.937 +syntax 
   8.938 +methd_dyn_accessible_from:: 
   8.939 + "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.940 +             ("_ \<turnstile>Methd _ _ in _ dyn'_accessible'_from _" [61,61,61,61,61] 60)
   8.941 +
   8.942 +translations
   8.943 +"G\<turnstile>Methd s m in C dyn_accessible_from accC"  
   8.944 + \<rightleftharpoons> "G\<turnstile>(method s m) in C dyn_accessible_from accC"  
   8.945 +
   8.946 +syntax 
   8.947 +field_dyn_accessible_from:: 
   8.948 + "prog \<Rightarrow> vname \<Rightarrow> (qtname \<times> field) \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool"
   8.949 +         ("_ \<turnstile>Field _ _ in _ dyn'_accessible'_from _" [61,61,61,61,61] 60)
   8.950 +
   8.951 +translations
   8.952 +"G\<turnstile>Field fn f in dynC dyn_accessible_from accC"  
   8.953 + \<rightleftharpoons> "G\<turnstile>(fieldm fn f) in dynC dyn_accessible_from accC"
   8.954 +  
   8.955 +(* #### Testet JVM noch über den Bytecodeverifier hinaus ob der
   8.956 + statische Typ accessible ist bevor es den Zugriff erlaubt 
   8.957 + \<longrightarrow> Test mit Reflektion\<dots>
   8.958 +*)
   8.959 +inductive "dyn_accessible_fromR G accclass" intros
   8.960 +immediate:  "\<lbrakk>G\<turnstile>membr member_in class;
   8.961 +              G\<turnstile>membr in class permits_acc_to accclass 
   8.962 +             \<rbrakk> \<Longrightarrow> G\<turnstile>membr in class dyn_accessible_from accclass"
   8.963 +
   8.964 +overriding: "\<lbrakk>G\<turnstile>membr member_in class;
   8.965 +              membr=(C,mdecl new);
   8.966 +              G\<turnstile>(C,new) overrides old; 
   8.967 +              G\<turnstile>class \<prec>\<^sub>C sup;
   8.968 +              G\<turnstile>Method old in sup dyn_accessible_from accclass
   8.969 +             \<rbrakk>\<Longrightarrow> G\<turnstile>membr in class dyn_accessible_from accclass"
   8.970 +
   8.971 +
   8.972 +lemma accessible_from_commonD: "G\<turnstile>m of C accessible_from S
   8.973 + \<Longrightarrow> G\<turnstile>m member_of C \<and> G\<turnstile>(Class C) accessible_in (pid S)"
   8.974 +by (auto elim: accessible_fromR.induct)
   8.975 +
   8.976 +lemma declared_not_undeclared:
   8.977 +  "G\<turnstile>m declared_in C \<Longrightarrow> \<not> G\<turnstile> memberid m undeclared_in C"
   8.978 +by (cases m) (auto simp add: declared_in_def undeclared_in_def)
   8.979 +
   8.980 +lemma not_undeclared_declared:
   8.981 +  "\<not> G\<turnstile> membr_id undeclared_in C \<Longrightarrow> (\<exists> m. G\<turnstile>m declared_in C \<and> 
   8.982 +                                           membr_id = memberid m)"
   8.983 +proof -
   8.984 +  assume not_undecl:"\<not> G\<turnstile> membr_id undeclared_in C"
   8.985 +  show ?thesis (is "?P membr_id")
   8.986 +  proof (cases membr_id)
   8.987 +    case (fid vname)
   8.988 +    with not_undecl
   8.989 +    obtain fld where
   8.990 +      "G\<turnstile>fdecl (vname,fld) declared_in C" 
   8.991 +      by (auto simp add: undeclared_in_def declared_in_def
   8.992 +                         cdeclaredfield_def)
   8.993 +    with fid show ?thesis 
   8.994 +      by auto
   8.995 +  next
   8.996 +    case (mid sig)
   8.997 +    with not_undecl
   8.998 +    obtain mthd where
   8.999 +      "G\<turnstile>mdecl (sig,mthd) declared_in C" 
  8.1000 +      by (auto simp add: undeclared_in_def declared_in_def
  8.1001 +                         cdeclaredmethd_def)
  8.1002 +    with mid show ?thesis 
  8.1003 +      by auto
  8.1004 +  qed
  8.1005 +qed
  8.1006 +
  8.1007 +lemma unique_declared_in:
  8.1008 + "\<lbrakk>G\<turnstile>m declared_in C; G\<turnstile>n declared_in C; memberid m = memberid n\<rbrakk>
  8.1009 + \<Longrightarrow> m = n"
  8.1010 +by (auto simp add: declared_in_def cdeclaredmethd_def cdeclaredfield_def
  8.1011 +            split: memberdecl.splits)
  8.1012 +
  8.1013 +lemma unique_member_of: 
  8.1014 + (assumes n: "G\<turnstile>n member_of C" and  
  8.1015 +          m: "G\<turnstile>m member_of C" and
  8.1016 +       eqid: "memberid n = memberid m"
  8.1017 + ) "n=m"
  8.1018 +proof -
  8.1019 +  from n m eqid  
  8.1020 +  show "n=m"
  8.1021 +  proof (induct)
  8.1022 +    case (Immediate C n)
  8.1023 +    assume member_n: "G\<turnstile> mbr n declared_in C" "declclass n = C"
  8.1024 +    assume eqid: "memberid n = memberid m"
  8.1025 +    assume "G \<turnstile> m member_of C"
  8.1026 +    then show "n=m"
  8.1027 +    proof (cases)
  8.1028 +      case (Immediate _ m')
  8.1029 +      with eqid 
  8.1030 +      have "m=m'"
  8.1031 +           "memberid n = memberid m" 
  8.1032 +           "G\<turnstile> mbr m declared_in C" 
  8.1033 +           "declclass m = C"
  8.1034 +	by auto
  8.1035 +      with member_n   
  8.1036 +      show ?thesis
  8.1037 +	by (cases n, cases m) 
  8.1038 +           (auto simp add: declared_in_def 
  8.1039 +                           cdeclaredmethd_def cdeclaredfield_def
  8.1040 +                    split: memberdecl.splits)
  8.1041 +    next
  8.1042 +      case (Inherited _ _ m')
  8.1043 +      then have "G\<turnstile> memberid m undeclared_in C"
  8.1044 +	by simp
  8.1045 +      with eqid member_n
  8.1046 +      show ?thesis
  8.1047 +	by (cases n) (auto dest: declared_not_undeclared)
  8.1048 +    qed
  8.1049 +  next
  8.1050 +    case (Inherited C S n)
  8.1051 +    assume undecl: "G\<turnstile> memberid n undeclared_in C"
  8.1052 +    assume  super: "G\<turnstile>C\<prec>\<^sub>C\<^sub>1S"
  8.1053 +    assume    hyp: "\<lbrakk>G \<turnstile> m member_of S; memberid n = memberid m\<rbrakk> \<Longrightarrow> n = m"
  8.1054 +    assume   eqid: "memberid n = memberid m"
  8.1055 +    assume "G \<turnstile> m member_of C"
  8.1056 +    then show "n=m"
  8.1057 +    proof (cases)
  8.1058 +      case Immediate
  8.1059 +      then have "G\<turnstile> mbr m declared_in C" by simp
  8.1060 +      with eqid undecl
  8.1061 +      show ?thesis
  8.1062 +	by (cases m) (auto dest: declared_not_undeclared)
  8.1063 +    next
  8.1064 +      case Inherited 
  8.1065 +      with super have "G \<turnstile> m member_of S"
  8.1066 +	by (auto dest!: subcls1D)
  8.1067 +      with eqid hyp
  8.1068 +      show ?thesis 
  8.1069 +	by blast
  8.1070 +    qed
  8.1071 +  qed
  8.1072 +qed
  8.1073 +
  8.1074 +lemma member_of_is_classD: "G\<turnstile>m member_of C \<Longrightarrow> is_class G C"
  8.1075 +proof (induct set: members)
  8.1076 +  case (Immediate C m)
  8.1077 +  assume "G\<turnstile> mbr m declared_in C"
  8.1078 +  then show "is_class G C"
  8.1079 +    by (cases "mbr m")
  8.1080 +       (auto simp add: declared_in_def cdeclaredmethd_def cdeclaredfield_def)
  8.1081 +next
  8.1082 +  case (Inherited C S m)  
  8.1083 +  assume "G\<turnstile>C\<prec>\<^sub>C\<^sub>1S" and "is_class G S"
  8.1084 +  then show "is_class G C"
  8.1085 +    by - (rule subcls_is_class2,auto)
  8.1086 +qed
  8.1087 +
  8.1088 +lemma member_of_declC: 
  8.1089 + "G\<turnstile>m member_of C 
  8.1090 +  \<Longrightarrow> G\<turnstile>mbr m declared_in (declclass m)"
  8.1091 +by (induct set: members) auto
  8.1092 +
  8.1093 +lemma member_of_member_of_declC:
  8.1094 + "G\<turnstile>m member_of C 
  8.1095 +  \<Longrightarrow> G\<turnstile>m member_of (declclass m)"
  8.1096 +by (auto dest: member_of_declC intro: members.Immediate)
  8.1097 +
  8.1098 +lemma member_of_class_relation:
  8.1099 +  "G\<turnstile>m member_of C \<Longrightarrow> G\<turnstile>C \<preceq>\<^sub>C declclass m"
  8.1100 +proof (induct set: members)
  8.1101 +  case (Immediate C m)
  8.1102 +  then show "G\<turnstile>C \<preceq>\<^sub>C declclass m" by simp
  8.1103 +next
  8.1104 +  case (Inherited C S m)
  8.1105 +  then show "G\<turnstile>C \<preceq>\<^sub>C declclass m" 
  8.1106 +    by (auto dest: r_into_rtrancl intro: rtrancl_trans)
  8.1107 +qed
  8.1108 +
  8.1109 +lemma member_in_class_relation:
  8.1110 +  "G\<turnstile>m member_in C \<Longrightarrow> G\<turnstile>C \<preceq>\<^sub>C declclass m"
  8.1111 +by (auto dest: member_inD member_of_class_relation
  8.1112 +        intro: rtrancl_trans)
  8.1113 +
  8.1114 +lemma member_of_Package: 
  8.1115 + "\<lbrakk>G\<turnstile>m member_of C; accmodi m = Package\<rbrakk> 
  8.1116 +  \<Longrightarrow> pid (declclass m) = pid C" 
  8.1117 +proof -
  8.1118 +  assume   member: "G\<turnstile>m member_of C"
  8.1119 +  then show " accmodi m = Package \<Longrightarrow> ?thesis" (is "PROP ?P m C")
  8.1120 +  proof (induct rule: members.induct)
  8.1121 +    fix C m
  8.1122 +    assume     C: "declclass m = C"
  8.1123 +    then show "pid (declclass m) = pid C"
  8.1124 +      by simp
  8.1125 +  next
  8.1126 +    fix C S m  
  8.1127 +    assume inheritable: "G \<turnstile> m inheritable_in pid C"
  8.1128 +    assume         hyp: "PROP ?P m S" and
  8.1129 +           package_acc: "accmodi m = Package" 
  8.1130 +    with inheritable package_acc hyp
  8.1131 +    show "pid (declclass m) = pid C" 
  8.1132 +      by (auto simp add: inheritable_in_def)
  8.1133 +  qed
  8.1134 +qed
  8.1135 +
  8.1136 +lemma dyn_accessible_from_commonD: "G\<turnstile>m in C dyn_accessible_from S
  8.1137 + \<Longrightarrow> G\<turnstile>m member_in C"
  8.1138 +by (auto elim: dyn_accessible_fromR.induct)
  8.1139 +
  8.1140 +(* ### Gilt nicht für wf_progs!dynmaisches Override, 
  8.1141 +  da die accmodi Bedingung nur für stat override gilt! *)
  8.1142 +(*
  8.1143 +lemma override_Package:
  8.1144 + "\<lbrakk>G\<turnstile>new overrides old; 
  8.1145 +  \<And> new old. G\<turnstile>new overrides old \<Longrightarrow> accmodi old \<le> accmodi new;
  8.1146 +  accmodi old = Package; accmodi new = Package\<rbrakk>
  8.1147 +  \<Longrightarrow> pid (declclass old) = pid (declclass new)"
  8.1148 +proof - 
  8.1149 +  assume wf: "\<And> new old. G\<turnstile>new overrides old \<Longrightarrow> accmodi old \<le> accmodi new"
  8.1150 +  assume ovverride: "G\<turnstile>new overrides old"
  8.1151 +  then show "\<lbrakk>accmodi old = Package;accmodi new = Package\<rbrakk> \<Longrightarrow> ?thesis"
  8.1152 +    (is "?Pack old \<Longrightarrow> ?Pack new \<Longrightarrow> ?EqPid old new")
  8.1153 +  proof (induct rule: overridesR.induct)
  8.1154 +    case Direct
  8.1155 +    fix new old
  8.1156 +    assume "accmodi old = Package"
  8.1157 +           "G \<turnstile> methdMembr old inheritable_in pid (declclass new)"
  8.1158 +    then show "pid (declclass old) =  pid (declclass new)"
  8.1159 +      by (auto simp add: inheritable_in_def)
  8.1160 +  next
  8.1161 +    case (Indirect inter new old)
  8.1162 +    assume accmodi_old: "accmodi old = Package" and
  8.1163 +           accmodi_new: "accmodi new = Package" 
  8.1164 +    assume "G \<turnstile> new overrides inter"
  8.1165 +    with wf have le_inter_new: "accmodi inter \<le> accmodi new"
  8.1166 +      by blast
  8.1167 +    assume "G \<turnstile> inter overrides old"
  8.1168 +    with wf have le_old_inter: "accmodi old \<le> accmodi inter"
  8.1169 +      by blast
  8.1170 +    from accmodi_old accmodi_new le_inter_new le_old_inter
  8.1171 +    have "accmodi inter = Package"
  8.1172 +      by(auto simp add: le_acc_def less_acc_def)
  8.1173 +    with Indirect accmodi_old accmodi_new
  8.1174 +    show "?EqPid old new"
  8.1175 +      by auto
  8.1176 +  qed
  8.1177 +qed
  8.1178 +
  8.1179 +lemma stat_override_Package:
  8.1180 + "\<lbrakk>G\<turnstile>new overrides\<^sub>S old; 
  8.1181 +  \<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new;
  8.1182 +  accmodi old = Package; accmodi new = Package\<rbrakk>
  8.1183 +  \<Longrightarrow> pid (declclass old) = pid (declclass new)"
  8.1184 +proof - 
  8.1185 +  assume wf: "\<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new"
  8.1186 +  assume ovverride: "G\<turnstile>new overrides\<^sub>S old"
  8.1187 +  then show "\<lbrakk>accmodi old = Package;accmodi new = Package\<rbrakk> \<Longrightarrow> ?thesis"
  8.1188 +    (is "?Pack old \<Longrightarrow> ?Pack new \<Longrightarrow> ?EqPid old new")
  8.1189 +  proof (induct rule: stat_overridesR.induct)
  8.1190 +    case Direct
  8.1191 +    fix new old
  8.1192 +    assume "accmodi old = Package"
  8.1193 +           "G \<turnstile> methdMembr old inheritable_in pid (declclass new)"
  8.1194 +    then show "pid (declclass old) =  pid (declclass new)"
  8.1195 +      by (auto simp add: inheritable_in_def)
  8.1196 +  next
  8.1197 +    case (Indirect inter new old)
  8.1198 +    assume accmodi_old: "accmodi old = Package" and
  8.1199 +           accmodi_new: "accmodi new = Package" 
  8.1200 +    assume "G \<turnstile> new overrides\<^sub>S inter"
  8.1201 +    with wf have le_inter_new: "accmodi inter \<le> accmodi new"
  8.1202 +      by blast
  8.1203 +    assume "G \<turnstile> inter overrides\<^sub>S old"
  8.1204 +    with wf have le_old_inter: "accmodi old \<le> accmodi inter"
  8.1205 +      by blast
  8.1206 +    from accmodi_old accmodi_new le_inter_new le_old_inter
  8.1207 +    have "accmodi inter = Package"
  8.1208 +      by(auto simp add: le_acc_def less_acc_def)
  8.1209 +    with Indirect accmodi_old accmodi_new
  8.1210 +    show "?EqPid old new"
  8.1211 +      by auto
  8.1212 +  qed
  8.1213 +qed
  8.1214 +
  8.1215 +*)
  8.1216 +lemma no_Private_stat_override: 
  8.1217 + "\<lbrakk>G\<turnstile>new overrides\<^sub>S old\<rbrakk> \<Longrightarrow> accmodi old \<noteq> Private"
  8.1218 +by (induct set:  stat_overridesR) (auto simp add: inheritable_in_def)
  8.1219 +
  8.1220 +lemma no_Private_override: "\<lbrakk>G\<turnstile>new overrides old\<rbrakk> \<Longrightarrow> accmodi old \<noteq> Private"
  8.1221 +by (induct set: overridesR) (auto simp add: inheritable_in_def)
  8.1222 +
  8.1223 +lemma permits_acc_inheritance:
  8.1224 + "\<lbrakk>G\<turnstile>m in statC permits_acc_to accC; G\<turnstile>dynC \<preceq>\<^sub>C statC
  8.1225 +  \<rbrakk> \<Longrightarrow> G\<turnstile>m in dynC permits_acc_to accC"
  8.1226 +by (cases "accmodi m")
  8.1227 +   (auto simp add: permits_acc_def
  8.1228 +            intro: subclseq_trans) 
  8.1229 +
  8.1230 +lemma field_accessible_fromD:
  8.1231 + "\<lbrakk>G\<turnstile>membr of C accessible_from accC;is_field membr\<rbrakk> 
  8.1232 +  \<Longrightarrow> G\<turnstile>membr member_of C \<and>
  8.1233 +      G\<turnstile>(Class C) accessible_in (pid accC) \<and>
  8.1234 +      G\<turnstile>membr in C permits_acc_to accC"
  8.1235 +by (cases set: accessible_fromR)
  8.1236 +   (auto simp add: is_field_def split: memberdecl.splits) 
  8.1237 +
  8.1238 +lemma field_accessible_from_permits_acc_inheritance:
  8.1239 +"\<lbrakk>G\<turnstile>membr of statC accessible_from accC; is_field membr; G \<turnstile> dynC \<preceq>\<^sub>C statC\<rbrakk>
  8.1240 +\<Longrightarrow> G\<turnstile>membr in dynC permits_acc_to accC"
  8.1241 +by (auto dest: field_accessible_fromD intro: permits_acc_inheritance)
  8.1242 +
  8.1243 +
  8.1244 +(*
  8.1245 +lemma accessible_Package:
  8.1246 + "\<lbrakk>G \<turnstile> m of C accessible_from S;accmodi m = Package;
  8.1247 +   \<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new\<rbrakk>
  8.1248 +  \<Longrightarrow> pid S = pid C \<and> pid C = pid (declclass m)"
  8.1249 +proof -
  8.1250 +  assume wf: "\<And> new old. G\<turnstile>new overrides\<^sub>S old \<Longrightarrow> accmodi old \<le> accmodi new"
  8.1251 +  assume "G \<turnstile> m of C accessible_from S"
  8.1252 +  then show "accmodi m = Package \<Longrightarrow> pid S = pid C \<and> pid C = pid (declclass m)"
  8.1253 +    (is "?Pack m \<Longrightarrow> ?P C m")
  8.1254 +  proof (induct rule: accessible_fromR.induct)
  8.1255 +    fix C m
  8.1256 +    assume "G\<turnstile>m member_of C"
  8.1257 +           "G \<turnstile> m in C permits_acc_to S"
  8.1258 +           "accmodi m = Package"      
  8.1259 +    then show "?P C m"
  8.1260 +      by (auto dest: member_of_Package simp add: permits_acc_def)
  8.1261 +  next
  8.1262 +    fix declC C new newm old Sup
  8.1263 +    assume member_new: "G \<turnstile> new member_of C" and 
  8.1264 +                acc_C: "G \<turnstile> Class C accessible_in pid S" and
  8.1265 +                  new: "new = (declC, mdecl newm)" and
  8.1266 +             override: "G \<turnstile> (declC, newm) overrides\<^sub>S old" and
  8.1267 +         subcls_C_Sup: "G\<turnstile>C \<prec>\<^sub>C Sup" and
  8.1268 +              acc_old: "G \<turnstile> methdMembr old of Sup accessible_from S" and
  8.1269 +                  hyp: "?Pack (methdMembr old) \<Longrightarrow> ?P Sup (methdMembr old)" and
  8.1270 +          accmodi_new: "accmodi new = Package"
  8.1271 +    from override wf 
  8.1272 +    have accmodi_weaken: "accmodi old \<le> accmodi newm"
  8.1273 +      by (cases old,cases newm) auto
  8.1274 +    from override new
  8.1275 +    have "accmodi old \<noteq> Private"
  8.1276 +      by (simp add: no_Private_stat_override)
  8.1277 +    with accmodi_weaken accmodi_new new
  8.1278 +    have accmodi_old: "accmodi old = Package"
  8.1279 +      by (cases "accmodi old") (auto simp add: le_acc_def less_acc_def) 
  8.1280 +    with hyp 
  8.1281 +    have P_sup: "?P Sup (methdMembr old)"
  8.1282 +      by (simp)
  8.1283 +    from wf override new accmodi_old accmodi_new
  8.1284 +    have eq_pid_new_old: "pid (declclass new) = pid (declclass old)"
  8.1285 +      by (auto dest: stat_override_Package) 
  8.1286 +    from member_new accmodi_new
  8.1287 +    have "pid (declclass new) = pid C"
  8.1288 +      by (auto dest: member_of_Package)
  8.1289 +    with eq_pid_new_old P_sup show "?P C new"
  8.1290 +      by auto
  8.1291 +  qed
  8.1292 +qed
  8.1293 +*)
  8.1294 +lemma accessible_fieldD: 
  8.1295 + "\<lbrakk>G\<turnstile>membr of C accessible_from accC; is_field membr\<rbrakk>
  8.1296 + \<Longrightarrow> G\<turnstile>membr member_of C \<and>
  8.1297 +     G\<turnstile>(Class C) accessible_in (pid accC) \<and>
  8.1298 +     G\<turnstile>membr in C permits_acc_to accC"
  8.1299 +by (induct rule: accessible_fromR.induct) (auto dest: is_fieldD)
  8.1300 +      
  8.1301 +(* lemmata:
  8.1302 + Wegen  G\<turnstile>Super accessible_in (pid C) folgt:
  8.1303 +  G\<turnstile>m declared_in C; G\<turnstile>m member_of D; accmodi m = Package (G\<turnstile>D \<preceq>\<^sub>C C)
  8.1304 +  \<Longrightarrow> pid C = pid D 
  8.1305 +
  8.1306 +  C package
  8.1307 +  m public in C
  8.1308 +  für alle anderen D: G\<turnstile>m undeclared_in C
  8.1309 +  m wird in alle subklassen vererbt, auch aus dem Package heraus!
  8.1310 +
  8.1311 +  G\<turnstile>m member_of C \<Longrightarrow> \<exists> D. G\<turnstile>C \<preceq>\<^sub>C D \<and> G\<turnstile>m declared_in D
  8.1312 +*)
  8.1313 +
  8.1314 +(* Begriff (C,m) overrides (D,m)
  8.1315 +    3 Fälle: Direkt,
  8.1316 +             Indirekt über eine Zwischenklasse (ohne weiteres override)
  8.1317 +             Indirekt über override
  8.1318 +*)
  8.1319 +   
  8.1320 +(*
  8.1321 +"G\<turnstile>m member_of C \<equiv> 
  8.1322 +constdefs declares_method:: "prog \<Rightarrow> sig \<Rightarrow> qtname \<Rightarrow> methd \<Rightarrow> bool"
  8.1323 +                                 ("_,_\<turnstile> _ declares'_method _" [61,61,61,61] 60)
  8.1324 +"G,sig\<turnstile>C declares_method m \<equiv> cdeclaredmethd G C sig = Some m" 
  8.1325 +
  8.1326 +constdefs is_declared:: "prog \<Rightarrow> sig \<Rightarrow> (qtname \<times> methd) \<Rightarrow> bool"
  8.1327 +"is_declared G sig em \<equiv> G,sig\<turnstile>declclass em declares_method mthd em"
  8.1328 +*)
  8.1329 +
  8.1330 +lemma member_of_Private:
  8.1331 +"\<lbrakk>G\<turnstile>m member_of C; accmodi m = Private\<rbrakk> \<Longrightarrow> declclass m = C"
  8.1332 +by (induct set: members) (auto simp add: inheritable_in_def)
  8.1333 +
  8.1334 +lemma member_of_subclseq_declC:
  8.1335 +  "G\<turnstile>m member_of C \<Longrightarrow> G\<turnstile>C \<preceq>\<^sub>C declclass m"
  8.1336 +by (induct set: members) (auto dest: r_into_rtrancl intro: rtrancl_trans)
  8.1337 +
  8.1338 +lemma member_of_inheritance:
  8.1339 +  (assumes    m: "G\<turnstile>m member_of D" and 
  8.1340 +     subclseq_D_C: "G\<turnstile>D \<preceq>\<^sub>C C" and
  8.1341 +     subclseq_C_m: "G\<turnstile>C \<preceq>\<^sub>C declclass m" and
  8.1342 +               ws: "ws_prog G" 
  8.1343 +  ) "G\<turnstile>m member_of C"
  8.1344 +proof -
  8.1345 +  from m subclseq_D_C subclseq_C_m
  8.1346 +  show ?thesis
  8.1347 +  proof (induct)
  8.1348 +    case (Immediate D m)
  8.1349 +    assume "declclass m = D" and
  8.1350 +           "G\<turnstile>D\<preceq>\<^sub>C C" and "G\<turnstile>C\<preceq>\<^sub>C declclass m"
  8.1351 +    with ws have "D=C" 
  8.1352 +      by (auto intro: subclseq_acyclic)
  8.1353 +    with Immediate 
  8.1354 +    show "G\<turnstile>m member_of C"
  8.1355 +      by (auto intro: members.Immediate)
  8.1356 +  next
  8.1357 +    case (Inherited D S m)
  8.1358 +    assume member_of_D_props: 
  8.1359 +            "G \<turnstile> m inheritable_in pid D" 
  8.1360 +            "G\<turnstile> memberid m undeclared_in D"  
  8.1361 +            "G \<turnstile> Class S accessible_in pid D" 
  8.1362 +            "G \<turnstile> m member_of S"
  8.1363 +    assume super: "G\<turnstile>D\<prec>\<^sub>C\<^sub>1S"
  8.1364 +    assume hyp: "\<lbrakk>G\<turnstile>S\<preceq>\<^sub>C C; G\<turnstile>C\<preceq>\<^sub>C declclass m\<rbrakk> \<Longrightarrow> G \<turnstile> m member_of C"
  8.1365 +    assume subclseq_C_m: "G\<turnstile>C\<preceq>\<^sub>C declclass m"
  8.1366 +    assume "G\<turnstile>D\<preceq>\<^sub>C C"
  8.1367 +    then show "G\<turnstile>m member_of C"
  8.1368 +    proof (cases rule: subclseq_cases)
  8.1369 +      case Eq
  8.1370 +      assume "D=C" 
  8.1371 +      with super member_of_D_props 
  8.1372 +      show ?thesis
  8.1373 +	by (auto intro: members.Inherited)
  8.1374 +    next
  8.1375 +      case Subcls
  8.1376 +      assume "G\<turnstile>D\<prec>\<^sub>C C"
  8.1377 +      with super 
  8.1378 +      have "G\<turnstile>S\<preceq>\<^sub>C C"
  8.1379 +	by (auto dest: subcls1D subcls_superD)
  8.1380 +      with subclseq_C_m hyp show ?thesis
  8.1381 +	by blast
  8.1382 +    qed
  8.1383 +  qed
  8.1384 +qed
  8.1385 +
  8.1386 +lemma member_of_subcls:
  8.1387 +  (assumes    old: "G\<turnstile>old member_of C" and 
  8.1388 +              new: "G\<turnstile>new member_of D" and
  8.1389 +             eqid: "memberid new = memberid old" and
  8.1390 +     subclseq_D_C: "G\<turnstile>D \<preceq>\<^sub>C C" and 
  8.1391 +   subcls_new_old: "G\<turnstile>declclass new \<prec>\<^sub>C declclass old" and
  8.1392 +               ws: "ws_prog G"
  8.1393 +  ) "G\<turnstile>D \<prec>\<^sub>C C"
  8.1394 +proof -
  8.1395 +  from old 
  8.1396 +  have subclseq_C_old: "G\<turnstile>C \<preceq>\<^sub>C declclass old"
  8.1397 +    by (auto dest: member_of_subclseq_declC)
  8.1398 +  from new 
  8.1399 +  have subclseq_D_new: "G\<turnstile>D \<preceq>\<^sub>C declclass new"
  8.1400 +    by (auto dest: member_of_subclseq_declC)
  8.1401 +  from subcls_new_old ws
  8.1402 +  have neq_new_old: "new\<noteq>old"
  8.1403 +    by (cases new,cases old) (auto dest: subcls_irrefl)
  8.1404 +  from subclseq_D_new subclseq_D_C
  8.1405 +  have "G\<turnstile>(declclass new) \<preceq>\<^sub>C C \<or> G\<turnstile>C \<preceq>\<^sub>C (declclass new)" 
  8.1406 +    by (rule subcls_compareable)
  8.1407 +  then have "G\<turnstile>(declclass new) \<preceq>\<^sub>C C"
  8.1408 +  proof
  8.1409 +    assume "G\<turnstile>declclass new\<preceq>\<^sub>C C" then show ?thesis .
  8.1410 +  next
  8.1411 +    assume "G\<turnstile>C \<preceq>\<^sub>C (declclass new)"
  8.1412 +    with new subclseq_D_C ws 
  8.1413 +    have "G\<turnstile>new member_of C"
  8.1414 +      by (blast intro: member_of_inheritance)
  8.1415 +    with eqid old 
  8.1416 +    have "new=old"
  8.1417 +      by (blast intro: unique_member_of)
  8.1418 +    with neq_new_old 
  8.1419 +    show ?thesis
  8.1420 +      by contradiction
  8.1421 +  qed
  8.1422 +  then show ?thesis
  8.1423 +  proof (cases rule: subclseq_cases)
  8.1424 +    case Eq
  8.1425 +    assume "declclass new = C"
  8.1426 +    with new have "G\<turnstile>new member_of C"
  8.1427 +      by (auto dest: member_of_member_of_declC)
  8.1428 +    with eqid old 
  8.1429 +    have "new=old"
  8.1430 +      by (blast intro: unique_member_of)
  8.1431 +    with neq_new_old 
  8.1432 +    show ?thesis
  8.1433 +      by contradiction
  8.1434 +  next
  8.1435 +    case Subcls
  8.1436 +    assume "G\<turnstile>declclass new\<prec>\<^sub>C C"
  8.1437 +    with subclseq_D_new
  8.1438 +    show "G\<turnstile>D\<prec>\<^sub>C C"
  8.1439 +      by (rule rtrancl_trancl_trancl)
  8.1440 +  qed
  8.1441 +qed
  8.1442 +
  8.1443 +corollary member_of_overrides_subcls:
  8.1444 + "\<lbrakk>G\<turnstile>Methd sig old member_of C; G\<turnstile>Methd sig new member_of D;G\<turnstile>D \<preceq>\<^sub>C C;
  8.1445 +   G,sig\<turnstile>new overrides old; ws_prog G\<rbrakk>
  8.1446 + \<Longrightarrow> G\<turnstile>D \<prec>\<^sub>C C"
  8.1447 +by (drule overrides_commonD) (auto intro: member_of_subcls)    
  8.1448 +
  8.1449 +corollary member_of_stat_overrides_subcls:
  8.1450 + "\<lbrakk>G\<turnstile>Methd sig old member_of C; G\<turnstile>Methd sig new member_of D;G\<turnstile>D \<preceq>\<^sub>C C;
  8.1451 +   G,sig\<turnstile>new overrides\<^sub>S old; ws_prog G\<rbrakk>
  8.1452 + \<Longrightarrow> G\<turnstile>D \<prec>\<^sub>C C"
  8.1453 +by (drule stat_overrides_commonD) (auto intro: member_of_subcls)    
  8.1454 +
  8.1455 +
  8.1456 +
  8.1457 +lemma inherited_field_access: 
  8.1458 + (assumes stat_acc: "G\<turnstile>membr of statC accessible_from accC" and
  8.1459 +          is_field: "is_field membr" and 
  8.1460 +          subclseq: "G \<turnstile> dynC \<preceq>\<^sub>C statC"
  8.1461 + ) "G\<turnstile>membr in dynC dyn_accessible_from accC"
  8.1462 +proof -
  8.1463 +  from stat_acc is_field subclseq 
  8.1464 +  show ?thesis
  8.1465 +    by (auto dest: accessible_fieldD 
  8.1466 +            intro: dyn_accessible_fromR.immediate 
  8.1467 +                   member_inI 
  8.1468 +                   permits_acc_inheritance)
  8.1469 +qed
  8.1470 +
  8.1471 +lemma accessible_inheritance:
  8.1472 + (assumes stat_acc: "G\<turnstile>m of statC accessible_from accC" and
  8.1473 +          subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  8.1474 +       member_dynC: "G\<turnstile>m member_of dynC" and
  8.1475 +          dynC_acc: "G\<turnstile>(Class dynC) accessible_in (pid accC)"
  8.1476 + ) "G\<turnstile>m of dynC accessible_from accC"
  8.1477 +proof -
  8.1478 +  from stat_acc
  8.1479 +  have member_statC: "G\<turnstile>m member_of statC" 
  8.1480 +    by (auto dest: accessible_from_commonD)
  8.1481 +  from stat_acc
  8.1482 +  show ?thesis
  8.1483 +  proof (cases)
  8.1484 +    case immediate
  8.1485 +    with member_dynC member_statC subclseq dynC_acc
  8.1486 +    show ?thesis
  8.1487 +      by (auto intro: accessible_fromR.immediate permits_acc_inheritance)
  8.1488 +  next
  8.1489 +    case overriding
  8.1490 +    with member_dynC subclseq dynC_acc
  8.1491 +    show ?thesis
  8.1492 +      by (auto intro: accessible_fromR.overriding rtrancl_trancl_trancl)
  8.1493 +  qed
  8.1494 +qed
  8.1495 +
  8.1496 +section "fields and methods"
  8.1497 +
  8.1498 +
  8.1499 +types
  8.1500 +  fspec = "vname \<times> qtname"
  8.1501 +
  8.1502 +translations 
  8.1503 +  "fspec" <= (type) "vname \<times> qtname" 
  8.1504 +
  8.1505 +constdefs
  8.1506 +imethds:: "prog \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> mhead) tables"
  8.1507 +"imethds G I 
  8.1508 +  \<equiv> iface_rec (G,I)  
  8.1509 +              (\<lambda>I i ts. (Un_tables ts) \<oplus>\<oplus> 
  8.1510 +                        (o2s \<circ> table_of (map (\<lambda>(s,m). (s,I,m)) (imethods i))))"
  8.1511 +text {* methods of an interface, with overriding and inheritance, cf. 9.2 *}
  8.1512 +
  8.1513 +constdefs
  8.1514 +accimethds:: "prog \<Rightarrow> pname \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> mhead) tables"
  8.1515 +"accimethds G pack I
  8.1516 +  \<equiv> if G\<turnstile>Iface I accessible_in pack 
  8.1517 +       then imethds G I
  8.1518 +       else \<lambda> k. {}"
  8.1519 +text {* only returns imethds if the interface is accessible *}
  8.1520 +
  8.1521 +constdefs
  8.1522 +methd:: "prog \<Rightarrow> qtname  \<Rightarrow> (sig,qtname \<times> methd) table"
  8.1523 +
  8.1524 +"methd G C 
  8.1525 + \<equiv> class_rec (G,C) empty
  8.1526 +             (\<lambda>C c subcls_mthds. 
  8.1527 +               filter_tab (\<lambda>sig m. G\<turnstile>C inherits method sig m)
  8.1528 +                          subcls_mthds 
  8.1529 +               ++ 
  8.1530 +               table_of (map (\<lambda>(s,m). (s,C,m)) (methods c)))"
  8.1531 +text {* @{term "methd G C"}: methods of a class C (statically visible from C), 
  8.1532 +     with inheritance and hiding cf. 8.4.6;
  8.1533 +     Overriding is captured by @{text dynmethd}.
  8.1534 +     Every new method with the same signature coalesces the
  8.1535 +     method of a superclass. *}
  8.1536 +
  8.1537 +constdefs                      
  8.1538 +accmethd:: "prog \<Rightarrow> qtname \<Rightarrow> qtname  \<Rightarrow> (sig,qtname \<times> methd) table"
  8.1539 +"accmethd G S C 
  8.1540 + \<equiv> filter_tab (\<lambda>sig m. G\<turnstile>method sig m of C accessible_from S) 
  8.1541 +              (methd G C)"
  8.1542 +text {* @{term "accmethd G S C"}: only those methods of @{term "methd G C"}, 
  8.1543 +        accessible from S *}
  8.1544 +
  8.1545 +text {* Note the class component in the accessibility filter. The class where
  8.1546 +    method @{term m} is declared (@{term declC}) isn't necessarily accessible 
  8.1547 +    from the current scope @{term S}. The method can be made accessible 
  8.1548 +    through inheritance, too.
  8.1549 +    So we must test accessibility of method @{term m} of class @{term C} 
  8.1550 +    (not @{term "declclass m"}) *}
  8.1551 +
  8.1552 +constdefs 
  8.1553 +dynmethd:: "prog  \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> methd) table"
  8.1554 +"dynmethd G statC dynC  
  8.1555 +  \<equiv> \<lambda> sig. 
  8.1556 +     (if G\<turnstile>dynC \<preceq>\<^sub>C statC
  8.1557 +        then (case methd G statC sig of
  8.1558 +                None \<Rightarrow> None
  8.1559 +              | Some statM 
  8.1560 +                  \<Rightarrow> (class_rec (G,dynC) empty
  8.1561 +                       (\<lambda>C c subcls_mthds. 
  8.1562 +                          subcls_mthds
  8.1563 +                          ++
  8.1564 +                          (filter_tab 
  8.1565 +                            (\<lambda> _ dynM. G,sig\<turnstile>dynM overrides statM \<or> dynM=statM)
  8.1566 +                            (methd G C) ))
  8.1567 +                      ) sig
  8.1568 +              )
  8.1569 +        else None)"
  8.1570 +(*
  8.1571 +"dynmethd G statC dynC  
  8.1572 +  \<equiv> \<lambda> sig. 
  8.1573 +     (if G\<turnstile>dynC \<preceq>\<^sub>C statC
  8.1574 +        then (case methd G statC sig of
  8.1575 +                None \<Rightarrow> None
  8.1576 +              | Some statM 
  8.1577 +                    \<Rightarrow> (class_rec (G,statC) empty
  8.1578 +                         (\<lambda>C c subcls_mthds. 
  8.1579 +                            subcls_mthds
  8.1580 +                            ++
  8.1581 +                            (filter_tab 
  8.1582 +                              (\<lambda> _ dynM. G,sig\<turnstile>dynM overrides statM)  
  8.1583 +                              (table_of (map (\<lambda>(s,m). (s,C,m)) (methods c)))))
  8.1584 +                        ) sig
  8.1585 +              )
  8.1586 +        else None)"*)
  8.1587 +text {* @{term "dynmethd G statC dynC"}: dynamic method lookup of a reference 
  8.1588 +        with dynamic class @{term dynC} and static class @{term statC} *}
  8.1589 +text {* Note some kind of duality between @{term methd} and @{term dynmethd} 
  8.1590 +        in the @{term class_rec} arguments. Whereas @{term methd} filters the 
  8.1591 +        subclass methods (to get only the inherited ones), @{term dynmethd} 
  8.1592 +        filters the new methods (to get only those methods which actually
  8.1593 +        override the methods of the static class) *}
  8.1594 +
  8.1595 +constdefs 
  8.1596 +dynimethd:: "prog \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> methd) table"
  8.1597 +"dynimethd G I dynC 
  8.1598 +  \<equiv> \<lambda> sig. if imethds G I sig \<noteq> {}
  8.1599 +               then methd G dynC sig
  8.1600 +               else dynmethd G Object dynC sig"
  8.1601 +text {* @{term "dynimethd G I dynC"}: dynamic method lookup of a reference with 
  8.1602 +        dynamic class dynC and static interface type I *}
  8.1603 +text {* 
  8.1604 +   When calling an interface method, we must distinguish if the method signature
  8.1605 +   was defined in the interface or if it must be an Object method in the other
  8.1606 +   case. If it was an interface method we search the class hierarchy
  8.1607 +   starting at the dynamic class of the object up to Object to find the 
  8.1608 +   first matching method (@{term methd}). Since all interface methods have 
  8.1609 +   public access the method can't be coalesced due to some odd visibility 
  8.1610 +   effects like in case of dynmethd. The method will be inherited or 
  8.1611 +   overridden in all classes from the first class implementing the interface 
  8.1612 +   down to the actual dynamic class.
  8.1613 + *}
  8.1614 +
  8.1615 +constdefs
  8.1616 +dynlookup::"prog  \<Rightarrow> ref_ty \<Rightarrow> qtname \<Rightarrow> (sig,qtname \<times> methd) table"
  8.1617 +"dynlookup G statT dynC
  8.1618 +  \<equiv> (case statT of
  8.1619 +       NullT        \<Rightarrow> empty
  8.1620 +     | IfaceT I     \<Rightarrow> dynimethd G I      dynC
  8.1621 +     | ClassT statC \<Rightarrow> dynmethd  G statC  dynC
  8.1622 +     | ArrayT ty    \<Rightarrow> dynmethd  G Object dynC)"
  8.1623 +text {* @{term "dynlookup G statT dynC"}: dynamic lookup of a method within the 
  8.1624 +    static reference type statT and the dynamic class dynC. 
  8.1625 +    In a wellformd context statT will not be NullT and in case
  8.1626 +    statT is an array type, dynC=Object *}
  8.1627 +
  8.1628 +constdefs
  8.1629 +fields:: "prog \<Rightarrow> qtname \<Rightarrow> ((vname \<times> qtname) \<times> field) list"
  8.1630 +"fields G C 
  8.1631 +  \<equiv> class_rec (G,C) [] (\<lambda>C c ts. map (\<lambda>(n,t). ((n,C),t)) (cfields c) @ ts)"
  8.1632 +text {* @{term "fields G C"} 
  8.1633 +     list of fields of a class, including all the fields of the superclasses
  8.1634 +     (private, inherited and hidden ones) not only the accessible ones
  8.1635 +     (an instance of a object allocates all these fields *}
  8.1636 +
  8.1637 +constdefs
  8.1638 +accfield:: "prog \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> (vname, qtname  \<times>  field) table"
  8.1639 +"accfield G S C
  8.1640 +  \<equiv> let field_tab = table_of((map (\<lambda>((n,d),f).(n,(d,f)))) (fields G C))
  8.1641 +    in filter_tab (\<lambda>n (declC,f). G\<turnstile> (declC,fdecl (n,f)) of C accessible_from S)
  8.1642 +                  field_tab"
  8.1643 +text  {* @{term "accfield G C S"}: fields of a class @{term C} which are 
  8.1644 +         accessible from scope of class
  8.1645 +         @{term S} with inheritance and hiding, cf. 8.3 *}
  8.1646 +text {* note the class component in the accessibility filter (see also 
  8.1647 +        @{term methd}).
  8.1648 +   The class declaring field @{term f} (@{term declC}) isn't necessarily 
  8.1649 +   accessible from scope @{term S}. The field can be made visible through 
  8.1650 +   inheritance, too. So we must test accessibility of field @{term f} of class 
  8.1651 +   @{term C} (not @{term "declclass f"}) *} 
  8.1652 +
  8.1653 +constdefs
  8.1654 +
  8.1655 +  is_methd :: "prog \<Rightarrow> qtname  \<Rightarrow> sig \<Rightarrow> bool"
  8.1656 + "is_methd G \<equiv> \<lambda>C sig. is_class G C \<and> methd G C sig \<noteq> None"
  8.1657 +
  8.1658 +constdefs efname:: "((vname \<times> qtname) \<times> field) \<Rightarrow> (vname \<times> qtname)"
  8.1659 +"efname \<equiv> fst"
  8.1660 +
  8.1661 +lemma efname_simp[simp]:"efname (n,f) = n"
  8.1662 +by (simp add: efname_def) 
  8.1663 +
  8.1664 +
  8.1665 +subsection "imethds"
  8.1666 +
  8.1667 +lemma imethds_rec: "\<lbrakk>iface G I = Some i; ws_prog G\<rbrakk> \<Longrightarrow>  
  8.1668 +  imethds G I = Un_tables ((\<lambda>J. imethds  G J)`set (isuperIfs i)) \<oplus>\<oplus>  
  8.1669 +                      (o2s \<circ> table_of (map (\<lambda>(s,mh). (s,I,mh)) (imethods i)))"
  8.1670 +apply (unfold imethds_def)
  8.1671 +apply (rule iface_rec [THEN trans])
  8.1672 +apply auto
  8.1673 +done
  8.1674 +
  8.1675 +
  8.1676 +(* local lemma *)
  8.1677 +lemma imethds_norec:
  8.1678 +  "\<lbrakk>iface G md = Some i; ws_prog G; table_of (imethods i) sig = Some mh\<rbrakk> \<Longrightarrow>  
  8.1679 +  (md, mh) \<in> imethds G md sig"
  8.1680 +apply (subst imethds_rec)
  8.1681 +apply assumption+
  8.1682 +apply (rule iffD2)
  8.1683 +apply (rule overrides_t_Some_iff)
  8.1684 +apply (rule disjI1)
  8.1685 +apply (auto elim: table_of_map_SomeI)
  8.1686 +done
  8.1687 +
  8.1688 +lemma imethds_declI: "\<lbrakk>m \<in> imethds G I sig; ws_prog G; is_iface G I\<rbrakk> \<Longrightarrow> 
  8.1689 +  (\<exists>i. iface G (decliface m) = Some i \<and> 
  8.1690 +  table_of (imethods i) sig = Some (mthd m)) \<and>  
  8.1691 +  (I,decliface m) \<in> (subint1 G)^* \<and> m \<in> imethds G (decliface m) sig"
  8.1692 +apply (erule make_imp)
  8.1693 +apply (rule ws_subint1_induct, assumption, assumption)
  8.1694 +apply (subst imethds_rec, erule conjunct1, assumption)
  8.1695 +apply (force elim: imethds_norec intro: rtrancl_into_rtrancl2)
  8.1696 +done
  8.1697 +
  8.1698 +lemma imethds_cases [consumes 3, case_names NewMethod InheritedMethod]:
  8.1699 + (assumes im: "im \<in> imethds G I sig" and  
  8.1700 +         ifI: "iface G I = Some i" and
  8.1701 +          ws: "ws_prog G" and
  8.1702 +     hyp_new:  "table_of (map (\<lambda>(s, mh). (s, I, mh)) (imethods i)) sig 
  8.1703 +                = Some im \<Longrightarrow> P" and
  8.1704 +     hyp_inh: "\<And> J. \<lbrakk>J \<in> set (isuperIfs i); im \<in> imethds G J sig\<rbrakk> \<Longrightarrow> P"
  8.1705 +  ) "P"
  8.1706 +proof -
  8.1707 +  from ifI ws im hyp_new hyp_inh
  8.1708 +  show "P"
  8.1709 +    by (auto simp add: imethds_rec)
  8.1710 +qed
  8.1711 +
  8.1712 +subsection "accimethd"
  8.1713 +
  8.1714 +lemma accimethds_simp [simp]: 
  8.1715 +"G\<turnstile>Iface I accessible_in pack \<Longrightarrow> accimethds G pack I = imethds G I"
  8.1716 +by (simp add: accimethds_def)
  8.1717 +
  8.1718 +lemma accimethdsD:
  8.1719 + "im \<in> accimethds G pack I sig 
  8.1720 +  \<Longrightarrow> im \<in> imethds G I sig \<and> G\<turnstile>Iface I accessible_in pack"
  8.1721 +by (auto simp add: accimethds_def)
  8.1722 +
  8.1723 +lemma accimethdsI: 
  8.1724 +"\<lbrakk>im \<in> imethds G I sig;G\<turnstile>Iface I accessible_in pack\<rbrakk>
  8.1725 + \<Longrightarrow> im \<in> accimethds G pack I sig"
  8.1726 +by simp
  8.1727 +
  8.1728 +subsection "methd"
  8.1729 +
  8.1730 +lemma methd_rec: "\<lbrakk>class G C = Some c; ws_prog G\<rbrakk> \<Longrightarrow>  
  8.1731 +  methd G C 
  8.1732 +    = (if C = Object 
  8.1733 +          then empty 
  8.1734 +          else filter_tab (\<lambda>sig m. G\<turnstile>C inherits method sig m)
  8.1735 +                          (methd G (super c))) 
  8.1736 +      ++ table_of (map (\<lambda>(s,m). (s,C,m)) (methods c))"
  8.1737 +apply (unfold methd_def)
  8.1738 +apply (erule class_rec [THEN trans], assumption)
  8.1739 +apply (simp)
  8.1740 +done
  8.1741 +
  8.1742 +(* local lemma *)
  8.1743 +lemma methd_norec: 
  8.1744 + "\<lbrakk>class G declC = Some c; ws_prog G;table_of (methods c) sig = Some m\<rbrakk> 
  8.1745 +  \<Longrightarrow> methd G declC sig = Some (declC, m)"
  8.1746 +apply (simp only: methd_rec)
  8.1747 +apply (rule disjI1 [THEN override_Some_iff [THEN iffD2]])
  8.1748 +apply (auto elim: table_of_map_SomeI)
  8.1749 +done
  8.1750 +
  8.1751 +
  8.1752 +lemma methd_declC: 
  8.1753 +"\<lbrakk>methd G C sig = Some m; ws_prog G;is_class G C\<rbrakk> \<Longrightarrow>
  8.1754 + (\<exists>d. class G (declclass m)=Some d \<and> table_of (methods d) sig=Some (mthd m)) \<and> 
  8.1755 + G\<turnstile>C \<preceq>\<^sub>C (declclass m) \<and> methd G (declclass m) sig = Some m"   
  8.1756 +apply (erule make_imp)
  8.1757 +apply (rule ws_subcls1_induct, assumption, assumption)
  8.1758 +apply (subst methd_rec, assumption)
  8.1759 +apply (case_tac "Ca=Object")
  8.1760 +apply   (force elim: methd_norec )
  8.1761 +
  8.1762 +apply   simp
  8.1763 +apply   (case_tac "table_of (map (\<lambda>(s, m). (s, Ca, m)) (methods c)) sig")
  8.1764 +apply     (force intro: rtrancl_into_rtrancl2)
  8.1765 +
  8.1766 +apply     (auto intro: methd_norec)
  8.1767 +done
  8.1768 +
  8.1769 +lemma methd_inheritedD:
  8.1770 +  "\<lbrakk>class G C = Some c; ws_prog G;methd G C sig = Some m\<rbrakk>
  8.1771 +  \<Longrightarrow>  (declclass m \<noteq> C \<longrightarrow> G \<turnstile>C inherits method sig m)"
  8.1772 +by (auto simp add: methd_rec)
  8.1773 +
  8.1774 +lemma methd_diff_cls:
  8.1775 +"\<lbrakk>ws_prog G; is_class G C; is_class G D;
  8.1776 + methd G C sig = m; methd G D sig = n; m\<noteq>n
  8.1777 +\<rbrakk> \<Longrightarrow> C\<noteq>D"
  8.1778 +by (auto simp add: methd_rec)
  8.1779 +
  8.1780 +lemma method_declared_inI: 
  8.1781 + "\<lbrakk>table_of (methods c) sig = Some m; class G C = Some c\<rbrakk>
  8.1782 +  \<Longrightarrow> G\<turnstile>mdecl (sig,m) declared_in C"
  8.1783 +by (auto simp add: cdeclaredmethd_def declared_in_def)
  8.1784 +
  8.1785 +lemma methd_declared_in_declclass: 
  8.1786 + "\<lbrakk>methd G C sig = Some m; ws_prog G;is_class G C\<rbrakk> 
  8.1787 + \<Longrightarrow> G\<turnstile>Methd sig m declared_in (declclass m)"
  8.1788 +by (auto dest: methd_declC method_declared_inI)
  8.1789 +
  8.1790 +lemma member_methd:
  8.1791 + (assumes member_of: "G\<turnstile>Methd sig m member_of C" and
  8.1792 +                 ws: "ws_prog G"
  8.1793 + ) "methd G C sig = Some m"
  8.1794 +proof -
  8.1795 +  from member_of 
  8.1796 +  have iscls_C: "is_class G C" 
  8.1797 +    by (rule member_of_is_classD)
  8.1798 +  from iscls_C ws member_of
  8.1799 +  show ?thesis (is "?Methd C")
  8.1800 +  proof (induct rule: ws_class_induct')
  8.1801 +    case (Object co)
  8.1802 +    assume "G \<turnstile>Methd sig m member_of Object"
  8.1803 +    then have "G\<turnstile>Methd sig m declared_in Object \<and> declclass m = Object"
  8.1804 +      by (cases set: members) (cases m, auto dest: subcls1D)
  8.1805 +    with ws Object 
  8.1806 +    show "?Methd Object"
  8.1807 +      by (cases m)
  8.1808 +         (auto simp add: declared_in_def cdeclaredmethd_def methd_rec
  8.1809 +                  intro:  table_of_mapconst_SomeI)
  8.1810 +  next
  8.1811 +    case (Subcls C c)
  8.1812 +    assume clsC: "class G C = Some c" and
  8.1813 +      neq_C_Obj: "C \<noteq> Object" and
  8.1814 +            hyp: "G \<turnstile>Methd sig m member_of super c \<Longrightarrow> ?Methd (super c)" and
  8.1815 +      member_of: "G \<turnstile>Methd sig m member_of C"
  8.1816 +    from member_of
  8.1817 +    show "?Methd C"
  8.1818 +    proof (cases)
  8.1819 +      case (Immediate Ca membr)
  8.1820 +      then have "Ca=C" "membr = method sig m" and 
  8.1821 +                "G\<turnstile>Methd sig m declared_in C" "declclass m = C"
  8.1822 +	by (cases m,auto)
  8.1823 +      with clsC 
  8.1824 +      have "table_of (map (\<lambda>(s, m). (s, C, m)) (methods c)) sig = Some m"
  8.1825 +	by (cases m)
  8.1826 +	   (auto simp add: declared_in_def cdeclaredmethd_def
  8.1827 +	            intro: table_of_mapconst_SomeI)
  8.1828 +      with clsC neq_C_Obj ws 
  8.1829 +      show ?thesis
  8.1830 +	by (simp add: methd_rec)
  8.1831 +    next
  8.1832 +      case (Inherited Ca S membr)
  8.1833 +      with clsC
  8.1834 +      have eq_Ca_C: "Ca=C" and
  8.1835 +            undecl: "G\<turnstile>mid sig undeclared_in C" and
  8.1836 +             super: "G \<turnstile>Methd sig m member_of (super c)"
  8.1837 +	by (auto dest: subcls1D)
  8.1838 +      from eq_Ca_C clsC undecl 
  8.1839 +      have "table_of (map (\<lambda>(s, m). (s, C, m)) (methods c)) sig = None"
  8.1840 +	by (auto simp add: undeclared_in_def cdeclaredmethd_def
  8.1841 +	            intro: table_of_mapconst_NoneI)
  8.1842 +      moreover
  8.1843 +      from Inherited have "G \<turnstile> C inherits (method sig m)"
  8.1844 +	by (auto simp add: inherits_def)
  8.1845 +      moreover
  8.1846 +      note clsC neq_C_Obj ws super hyp 
  8.1847 +      ultimately
  8.1848 +      show ?thesis
  8.1849 +	by (auto simp add: methd_rec intro: filter_tab_SomeI)
  8.1850 +    qed
  8.1851 +  qed
  8.1852 +qed
  8.1853 +
  8.1854 +(*unused*)
  8.1855 +lemma finite_methd:"ws_prog G \<Longrightarrow> finite {methd G C sig |sig C. is_class G C}"
  8.1856 +apply (rule finite_is_class [THEN finite_SetCompr2])
  8.1857 +apply (intro strip)
  8.1858 +apply (erule_tac ws_subcls1_induct, assumption)
  8.1859 +apply (subst methd_rec)
  8.1860 +apply (assumption)
  8.1861 +apply (auto intro!: finite_range_map_of finite_range_filter_tab finite_range_map_of_override)
  8.1862 +done
  8.1863 +
  8.1864 +lemma finite_dom_methd:
  8.1865 + "\<lbrakk>ws_prog G; is_class G C\<rbrakk> \<Longrightarrow> finite (dom (methd G C))"
  8.1866 +apply (erule_tac ws_subcls1_induct)
  8.1867 +apply assumption
  8.1868 +apply (subst methd_rec)
  8.1869 +apply (assumption)
  8.1870 +apply (auto intro!: finite_dom_map_of finite_dom_filter_tab)
  8.1871 +done
  8.1872 +
  8.1873 +
  8.1874 +subsection "accmethd"
  8.1875 +
  8.1876 +lemma accmethd_SomeD:
  8.1877 +"accmethd G S C sig = Some m
  8.1878 + \<Longrightarrow> methd G C sig = Some m \<and> G\<turnstile>method sig m of C accessible_from S"
  8.1879 +by (auto simp add: accmethd_def dest: filter_tab_SomeD)
  8.1880 +
  8.1881 +lemma accmethd_SomeI:
  8.1882 +"\<lbrakk>methd G C sig = Some m; G\<turnstile>method sig m of C accessible_from S\<rbrakk> 
  8.1883 + \<Longrightarrow> accmethd G S C sig = Some m"
  8.1884 +by (auto simp add: accmethd_def intro: filter_tab_SomeI)
  8.1885 +
  8.1886 +lemma accmethd_declC: 
  8.1887 +"\<lbrakk>accmethd G S C sig = Some m; ws_prog G; is_class G C\<rbrakk> \<Longrightarrow>
  8.1888 + (\<exists>d. class G (declclass m)=Some d \<and> 
  8.1889 +  table_of (methods d) sig=Some (mthd m)) \<and> 
  8.1890 + G\<turnstile>C \<preceq>\<^sub>C (declclass m) \<and> methd G (declclass m) sig = Some m \<and> 
  8.1891 + G\<turnstile>method sig m of C accessible_from S"
  8.1892 +by (auto dest: accmethd_SomeD methd_declC accmethd_SomeI)
  8.1893 +
  8.1894 +
  8.1895 +lemma finite_dom_accmethd:
  8.1896 + "\<lbrakk>ws_prog G; is_class G C\<rbrakk> \<Longrightarrow> finite (dom (accmethd G S C))"
  8.1897 +by (auto simp add: accmethd_def intro: finite_dom_filter_tab finite_dom_methd)
  8.1898 +
  8.1899 +
  8.1900 +subsection "dynmethd"
  8.1901 +
  8.1902 +lemma dynmethd_rec:
  8.1903 +"\<lbrakk>class G dynC = Some c; ws_prog G\<rbrakk> \<Longrightarrow>  
  8.1904 + dynmethd G statC dynC sig
  8.1905 +   = (if G\<turnstile>dynC \<preceq>\<^sub>C statC
  8.1906 +        then (case methd G statC sig of
  8.1907 +                None \<Rightarrow> None
  8.1908 +              | Some statM 
  8.1909 +                  \<Rightarrow> (case methd G dynC sig of
  8.1910 +                        None \<Rightarrow> dynmethd G statC (super c) sig
  8.1911 +                      | Some dynM \<Rightarrow> 
  8.1912 +                          (if G,sig\<turnstile> dynM overrides statM \<or> dynM = statM 
  8.1913 +                              then Some dynM
  8.1914 +                              else (dynmethd G statC (super c) sig)
  8.1915 +                      )))
  8.1916 +         else None)" 
  8.1917 +   (is "_ \<Longrightarrow> _ \<Longrightarrow> ?Dynmethd_def dynC sig  = ?Dynmethd_rec dynC c sig") 
  8.1918 +proof -
  8.1919 +  assume clsDynC: "class G dynC = Some c" and 
  8.1920 +              ws: "ws_prog G"
  8.1921 +  then show "?Dynmethd_def dynC sig  = ?Dynmethd_rec dynC c sig" 
  8.1922 +  proof (induct rule: ws_class_induct'')
  8.1923 +    case (Object co)
  8.1924 +    show "?Dynmethd_def Object sig = ?Dynmethd_rec Object co sig"
  8.1925 +    proof (cases "G\<turnstile>Object \<preceq>\<^sub>C statC") 
  8.1926 +      case False
  8.1927 +      then show ?thesis by (simp add: dynmethd_def)
  8.1928 +    next
  8.1929 +      case True
  8.1930 +      then have eq_statC_Obj: "statC = Object" ..
  8.1931 +      show ?thesis 
  8.1932 +      proof (cases "methd G statC sig")
  8.1933 +	case None then show ?thesis by (simp add: dynmethd_def)
  8.1934 +      next
  8.1935 +	case Some
  8.1936 +	with True Object ws eq_statC_Obj 
  8.1937 +	show ?thesis
  8.1938 +	  by (auto simp add: dynmethd_def class_rec
  8.1939 +                      intro: filter_tab_SomeI)
  8.1940 +      qed
  8.1941 +    qed
  8.1942 +  next  
  8.1943 +    case (Subcls dynC c sc)
  8.1944 +    show "?Dynmethd_def dynC sig = ?Dynmethd_rec dynC c sig"
  8.1945 +    proof (cases "G\<turnstile>dynC \<preceq>\<^sub>C statC") 
  8.1946 +      case False
  8.1947 +      then show ?thesis by (simp add: dynmethd_def)
  8.1948 +    next
  8.1949 +      case True
  8.1950 +      note subclseq_dynC_statC = True
  8.1951 +      show ?thesis
  8.1952 +      proof (cases "methd G statC sig")
  8.1953 +	case None then show ?thesis by (simp add: dynmethd_def)
  8.1954 +      next
  8.1955 +	case (Some statM)
  8.1956 +	note statM = Some
  8.1957 +	let "?filter C" = 
  8.1958 +              "filter_tab
  8.1959 +                (\<lambda>_ dynM. G,sig \<turnstile> dynM overrides statM \<or> dynM = statM)
  8.1960 +                (methd G C)"
  8.1961 +        let "?class_rec C" =
  8.1962 +              "(class_rec (G, C) empty
  8.1963 +                           (\<lambda>C c subcls_mthds. subcls_mthds ++ (?filter C)))"
  8.1964 +	from statM Subcls ws subclseq_dynC_statC
  8.1965 +	have dynmethd_dynC_def:
  8.1966 +             "?Dynmethd_def dynC sig =
  8.1967 +                ((?class_rec (super c)) 
  8.1968 +                 ++
  8.1969 +                (?filter dynC)) sig"
  8.1970 +         by (simp (no_asm_simp) only: dynmethd_def class_rec)
  8.1971 +	    auto
  8.1972 +       show ?thesis
  8.1973 +       proof (cases "dynC = statC")
  8.1974 +	 case True
  8.1975 +	 with subclseq_dynC_statC statM dynmethd_dynC_def
  8.1976 +	 have "?Dynmethd_def dynC sig = Some statM"
  8.1977 +	   by (auto intro: override_find_right filter_tab_SomeI)
  8.1978 +	 with subclseq_dynC_statC True Some 
  8.1979 +	 show ?thesis
  8.1980 +	   by auto
  8.1981 +       next
  8.1982 +	 case False
  8.1983 +	 with subclseq_dynC_statC Subcls 
  8.1984 +	 have subclseq_super_statC: "G\<turnstile>(super c) \<preceq>\<^sub>C statC"
  8.1985 +	   by (blast dest: subclseq_superD)
  8.1986 +	 show ?thesis
  8.1987 +	 proof (cases "methd G dynC sig") 
  8.1988 +	   case None
  8.1989 +	   then have "?filter dynC sig = None"
  8.1990 +	     by (rule filter_tab_None)
  8.1991 +           then have "?Dynmethd_def dynC sig=?class_rec (super c) sig"
  8.1992 +	     by (simp add: dynmethd_dynC_def)
  8.1993 +	   with  subclseq_super_statC statM None
  8.1994 +	   have "?Dynmethd_def dynC sig = ?Dynmethd_def (super c) sig"
  8.1995 +	     by (auto simp add: empty_def dynmethd_def)
  8.1996 +           with None subclseq_dynC_statC statM
  8.1997 +	   show ?thesis 
  8.1998 +	     by simp
  8.1999 +	 next
  8.2000 +	   case (Some dynM)
  8.2001 +	   note dynM = Some
  8.2002 +	   let ?Termination = "G \<turnstile> qmdecl sig dynM overrides qmdecl sig statM \<or>
  8.2003 +                               dynM = statM"
  8.2004 +	   show ?thesis
  8.2005 +	   proof (cases "?filter dynC sig")
  8.2006 +	     case None
  8.2007 +	     with dynM 
  8.2008 +	     have no_termination: "\<not> ?Termination"
  8.2009 +	       by (simp add: filter_tab_def)
  8.2010 +	     from None 
  8.2011 +	     have "?Dynmethd_def dynC sig=?class_rec (super c) sig"
  8.2012 +	       by (simp add: dynmethd_dynC_def)
  8.2013 +	     with subclseq_super_statC statM dynM no_termination
  8.2014 +	     show ?thesis
  8.2015 +	       by (auto simp add: empty_def dynmethd_def)
  8.2016 +	   next
  8.2017 +	     case Some
  8.2018 +	     with dynM
  8.2019 +	     have termination: "?Termination"
  8.2020 +	       by (auto)
  8.2021 +	     with Some dynM
  8.2022 +	     have "?Dynmethd_def dynC sig=Some dynM"
  8.2023 +	      by (auto simp add: dynmethd_dynC_def)
  8.2024 +	     with subclseq_super_statC statM dynM termination
  8.2025 +	     show ?thesis
  8.2026 +	       by (auto simp add: dynmethd_def)
  8.2027 +	   qed
  8.2028 +	 qed
  8.2029 +       qed
  8.2030 +     qed
  8.2031 +   qed
  8.2032 + qed
  8.2033 +qed
  8.2034 +	       
  8.2035 +lemma dynmethd_C_C:"\<lbrakk>is_class G C; ws_prog G\<rbrakk> 
  8.2036 +\<Longrightarrow> dynmethd G C C sig = methd G C sig"          
  8.2037 +apply (auto simp add: dynmethd_rec)
  8.2038 +done
  8.2039 + 
  8.2040 +lemma dynmethdSomeD: 
  8.2041 + "\<lbrakk>dynmethd G statC dynC sig = Some dynM; is_class G dynC; ws_prog G\<rbrakk> 
  8.2042 +  \<Longrightarrow> G\<turnstile>dynC \<preceq>\<^sub>C statC \<and> (\<exists> statM. methd G statC sig = Some statM)"
  8.2043 +apply clarify
  8.2044 +apply rotate_tac
  8.2045 +by (auto simp add: dynmethd_rec)
  8.2046 + 
  8.2047 +lemma dynmethd_Some_cases [consumes 3, case_names Static Overrides]:
  8.2048 +  (assumes dynM: "dynmethd G statC dynC sig = Some dynM" and
  8.2049 +        is_cls_dynC: "is_class G dynC" and
  8.2050 +                 ws: "ws_prog G" and
  8.2051 +         hyp_static: "methd G statC sig = Some dynM \<Longrightarrow> P" and
  8.2052 +       hyp_override: "\<And> statM. \<lbrakk>methd G statC sig = Some statM;dynM\<noteq>statM;
  8.2053 +                       G,sig\<turnstile>dynM overrides statM\<rbrakk> \<Longrightarrow> P"
  8.2054 +   ) "P"
  8.2055 +proof -
  8.2056 +  from is_cls_dynC obtain dc where clsDynC: "class G dynC = Some dc" by blast
  8.2057 +  from clsDynC ws dynM hyp_static hyp_override
  8.2058 +  show "P"
  8.2059 +  proof (induct rule: ws_class_induct)
  8.2060 +    case (Object co)
  8.2061 +    with ws  have "statC = Object" 
  8.2062 +      by (auto simp add: dynmethd_rec)
  8.2063 +    with ws Object show ?thesis by (auto simp add: dynmethd_C_C)
  8.2064 +  next
  8.2065 +    case (Subcls C c)
  8.2066 +    with ws show ?thesis
  8.2067 +      by (auto simp add: dynmethd_rec)
  8.2068 +  qed
  8.2069 +qed
  8.2070 +
  8.2071 +lemma no_override_in_Object:
  8.2072 +  (assumes     dynM: "dynmethd G statC dynC sig = Some dynM" and
  8.2073 +            is_cls_dynC: "is_class G dynC" and
  8.2074 +                     ws: "ws_prog G" and
  8.2075 +                  statM: "methd G statC sig = Some statM" and
  8.2076 +         neq_dynM_statM: "dynM\<noteq>statM"
  8.2077 +   )
  8.2078 +   "dynC \<noteq> Object"
  8.2079 +proof -
  8.2080 +  from is_cls_dynC obtain dc where clsDynC: "class G dynC = Some dc" by blast
  8.2081 +  from clsDynC ws dynM statM neq_dynM_statM 
  8.2082 +  show ?thesis (is "?P dynC")
  8.2083 +  proof (induct rule: ws_class_induct)
  8.2084 +    case (Object co)
  8.2085 +    with ws  have "statC = Object" 
  8.2086 +      by (auto simp add: dynmethd_rec)
  8.2087 +    with ws Object show "?P Object" by (auto simp add: dynmethd_C_C)
  8.2088 +  next
  8.2089 +    case (Subcls dynC c)
  8.2090 +    with ws show "?P dynC"
  8.2091 +      by (auto simp add: dynmethd_rec)
  8.2092 +  qed
  8.2093 +qed
  8.2094 +
  8.2095 +
  8.2096 +lemma dynmethd_Some_rec_cases [consumes 3, 
  8.2097 +                               case_names Static Override  Recursion]:
  8.2098 +(assumes     dynM: "dynmethd G statC dynC sig = Some dynM" and
  8.2099 +                clsDynC: "class G dynC = Some c" and
  8.2100 +                     ws: "ws_prog G" and
  8.2101 +             hyp_static: "methd G statC sig = Some dynM \<Longrightarrow> P" and
  8.2102 +           hyp_override: "\<And> statM. \<lbrakk>methd G statC sig = Some statM;
  8.2103 +                                     methd G dynC sig = Some dynM; statM\<noteq>dynM;
  8.2104 +                                     G,sig\<turnstile> dynM overrides statM\<rbrakk> \<Longrightarrow> P" and
  8.2105 +
  8.2106 +          hyp_recursion: "\<lbrakk>dynC\<noteq>Object;
  8.2107 +                           dynmethd G statC (super c) sig = Some dynM\<rbrakk> \<Longrightarrow> P" 
  8.2108 +  ) "P"
  8.2109 +proof -
  8.2110 +  from clsDynC have "is_class G dynC" by simp
  8.2111 +  note no_override_in_Object' = no_override_in_Object [OF dynM this ws]
  8.2112 +  from ws clsDynC dynM hyp_static hyp_override hyp_recursion
  8.2113 +  show ?thesis
  8.2114 +    by (auto simp add: dynmethd_rec dest: no_override_in_Object')
  8.2115 +qed
  8.2116 +
  8.2117 +lemma dynmethd_declC: 
  8.2118 +"\<lbrakk>dynmethd G statC dynC sig = Some m;
  8.2119 +  is_class G statC;ws_prog G
  8.2120 + \<rbrakk> \<Longrightarrow>
  8.2121 +  (\<exists>d. class G (declclass m)=Some d \<and> table_of (methods d) sig=Some (mthd m)) \<and>
  8.2122 +  G\<turnstile>dynC \<preceq>\<^sub>C (declclass m) \<and> methd G (declclass m) sig = Some m"
  8.2123 +proof - 
  8.2124 +  assume  is_cls_statC: "is_class G statC" 
  8.2125 +  assume            ws: "ws_prog G"  
  8.2126 +  assume             m: "dynmethd G statC dynC sig = Some m"
  8.2127 +  from m 
  8.2128 +  have "G\<turnstile>dynC \<preceq>\<^sub>C statC" by (auto simp add: dynmethd_def)
  8.2129 +  from this is_cls_statC 
  8.2130 +  have is_cls_dynC: "is_class G dynC" by (rule subcls_is_class2)
  8.2131 +  from is_cls_dynC ws m  
  8.2132 +  show ?thesis (is "?P dynC") 
  8.2133 +  proof (induct rule: ws_class_induct')
  8.2134 +    case (Object co)
  8.2135 +    with ws have "statC=Object" by (auto simp add: dynmethd_rec)
  8.2136 +    with ws Object  
  8.2137 +    show "?P Object" 
  8.2138 +      by (auto simp add: dynmethd_C_C dest: methd_declC)
  8.2139 +  next
  8.2140 +    case (Subcls dynC c)
  8.2141 +    assume   hyp: "dynmethd G statC (super c) sig = Some m \<Longrightarrow> ?P (super c)" and
  8.2142 +         clsDynC: "class G dynC = Some c"  and
  8.2143 +              m': "dynmethd G statC dynC sig = Some m" and
  8.2144 +    neq_dynC_Obj: "dynC \<noteq> Object"
  8.2145 +    from ws this obtain statM where
  8.2146 +      subclseq_dynC_statC: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and 
  8.2147 +                     statM: "methd G statC sig = Some statM"
  8.2148 +      by (blast dest: dynmethdSomeD)
  8.2149 +    from clsDynC neq_dynC_Obj 
  8.2150 +    have subclseq_dynC_super: "G\<turnstile>dynC \<preceq>\<^sub>C (super c)" 
  8.2151 +      by (auto intro: subcls1I) 
  8.2152 +    from m' clsDynC ws 
  8.2153 +    show "?P dynC"
  8.2154 +    proof (cases rule: dynmethd_Some_rec_cases) 
  8.2155 +      case Static
  8.2156 +      with is_cls_statC ws subclseq_dynC_statC 
  8.2157 +      show ?thesis 
  8.2158 +	by (auto intro: rtrancl_trans dest: methd_declC)
  8.2159 +    next
  8.2160 +      case Override
  8.2161 +      with clsDynC ws 
  8.2162 +      show ?thesis 
  8.2163 +	by (auto dest: methd_declC)
  8.2164 +    next
  8.2165 +      case Recursion
  8.2166 +      with hyp subclseq_dynC_super 
  8.2167 +      show ?thesis 
  8.2168 +	by (auto intro: rtrancl_trans) 
  8.2169 +    qed
  8.2170 +  qed
  8.2171 +qed
  8.2172 +
  8.2173 +lemma methd_Some_dynmethd_Some:
  8.2174 +  (assumes    statM: "methd G statC sig = Some statM" and 
  8.2175 +           subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  8.2176 +       is_cls_statC: "is_class G statC" and
  8.2177 +                 ws: "ws_prog G"
  8.2178 +   ) "\<exists> dynM. dynmethd G statC dynC sig = Some dynM"
  8.2179 +   (is "?P dynC")
  8.2180 +proof -
  8.2181 +  from subclseq is_cls_statC 
  8.2182 +  have is_cls_dynC: "is_class G dynC" by (rule subcls_is_class2)
  8.2183 +  then obtain dc where
  8.2184 +    clsDynC: "class G dynC = Some dc" by blast
  8.2185 +  from clsDynC ws subclseq 
  8.2186 +  show "?thesis"
  8.2187 +  proof (induct rule: ws_class_induct)
  8.2188 +    case (Object co)
  8.2189 +    with ws  have "statC = Object" 
  8.2190 +      by (auto)
  8.2191 +    with ws Object statM
  8.2192 +    show "?P Object"  
  8.2193 +      by (auto simp add: dynmethd_C_C)
  8.2194 +  next
  8.2195 +    case (Subcls dynC dc)
  8.2196 +    assume clsDynC': "class G dynC = Some dc"
  8.2197 +    assume neq_dynC_Obj: "dynC \<noteq> Object"
  8.2198 +    assume hyp: "G\<turnstile>super dc\<preceq>\<^sub>C statC \<Longrightarrow> ?P (super dc)"
  8.2199 +    assume subclseq': "G\<turnstile>dynC\<preceq>\<^sub>C statC"
  8.2200 +    then
  8.2201 +    show "?P dynC"
  8.2202 +    proof (cases rule: subclseq_cases)
  8.2203 +      case Eq
  8.2204 +      with ws statM clsDynC' 
  8.2205 +      show ?thesis
  8.2206 +	by (auto simp add: dynmethd_rec)
  8.2207 +    next
  8.2208 +      case Subcls
  8.2209 +      assume "G\<turnstile>dynC\<prec>\<^sub>C statC"
  8.2210 +      from this clsDynC' 
  8.2211 +      have "G\<turnstile>super dc\<preceq>\<^sub>C statC" by (rule subcls_superD)
  8.2212 +      with hyp ws clsDynC' subclseq' statM
  8.2213 +      show ?thesis
  8.2214 +	by (auto simp add: dynmethd_rec)
  8.2215 +    qed
  8.2216 +  qed
  8.2217 +qed
  8.2218 +
  8.2219 +lemma dynmethd_cases [consumes 4, case_names Static Overrides]:
  8.2220 +  (assumes    statM: "methd G statC sig = Some statM" and 
  8.2221 +           subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  8.2222 +       is_cls_statC: "is_class G statC" and
  8.2223 +                 ws: "ws_prog G" and
  8.2224 +         hyp_static: "dynmethd G statC dynC sig = Some statM \<Longrightarrow> P" and
  8.2225 +       hyp_override: "\<And> dynM. \<lbrakk>dynmethd G statC dynC sig = Some dynM;
  8.2226 +                                 dynM\<noteq>statM;
  8.2227 +                           G,sig\<turnstile>dynM overrides statM\<rbrakk> \<Longrightarrow> P"
  8.2228 +   ) "P"
  8.2229 +proof -
  8.2230 +  from subclseq is_cls_statC 
  8.2231 +  have is_cls_dynC: "is_class G dynC" by (rule subcls_is_class2)
  8.2232 +  then obtain dc where
  8.2233 +    clsDynC: "class G dynC = Some dc" by blast
  8.2234 +  from statM subclseq is_cls_statC ws 
  8.2235 +  obtain dynM
  8.2236 +    where dynM: "dynmethd G statC dynC sig = Some dynM"
  8.2237 +    by (blast dest: methd_Some_dynmethd_Some)
  8.2238 +  from dynM is_cls_dynC ws 
  8.2239 +  show ?thesis
  8.2240 +  proof (cases rule: dynmethd_Some_cases)
  8.2241 +    case Static
  8.2242 +    with hyp_static dynM statM show ?thesis by simp
  8.2243 +  next
  8.2244 +    case Overrides
  8.2245 +    with hyp_override dynM statM show ?thesis by simp
  8.2246 +  qed
  8.2247 +qed
  8.2248 +
  8.2249 +lemma ws_dynmethd:
  8.2250 +  (assumes statM: "methd G statC sig = Some statM" and
  8.2251 +        subclseq: "G\<turnstile>dynC \<preceq>\<^sub>C statC" and
  8.2252 +    is_cls_statC: "is_class G statC" and
  8.2253 +              ws: "ws_prog G"
  8.2254 +   )
  8.2255 +   "\<exists> dynM. dynmethd G statC dynC sig = Some dynM \<and>
  8.2256 +            is_static dynM = is_static statM \<and> G\<turnstile>resTy dynM\<preceq>resTy statM"
  8.2257 +proof - 
  8.2258 +  from statM subclseq is_cls_statC ws
  8.2259 +  show ?thesis
  8.2260 +  proof (cases rule: dynmethd_cases)
  8.2261 +    case Static
  8.2262 +    with statM 
  8.2263 +    show ?thesis
  8.2264 +      by simp
  8.2265 +  next
  8.2266 +    case Overrides
  8.2267 +    with ws
  8.2268 +    show ?thesis
  8.2269 +      by (auto dest: ws_overrides_commonD)
  8.2270 +  qed
  8.2271 +qed
  8.2272 +
  8.2273 +(*
  8.2274 +lemma dom_dynmethd: 
  8.2275 +  "dom (dynmethd G statC dynC) \<subseteq> dom (methd G statC) \<union> dom (methd G dynC)"
  8.2276 +by (auto simp add: dynmethd_def dom_def)
  8.2277 +
  8.2278 +lemma finite_dom_dynmethd:
  8.2279 + "\<lbrakk>ws_prog G; is_class G statC; is_class G dynC\<rbrakk> 
  8.2280 +  \<Longrightarrow> finite (dom (dynmethd G statC dynC))"
  8.2281 +apply (rule_tac B="dom (methd G statC) \<union> dom (methd G dynC)" in finite_subset)
  8.2282 +apply (rule dom_dynmethd)
  8.2283 +apply (rule finite_UnI)
  8.2284 +apply (drule (2) finite_dom_methd)+
  8.2285 +done
  8.2286 +*)
  8.2287 +(*
  8.2288 +lemma dynmethd_SomeD: 
  8.2289 +"\<lbrakk>ws_prog G; is_class G statC; is_class G dynC;
  8.2290 + methd G statC sig = Some sm; dynmethd G statC dynC sig = Some dm; sm \<noteq> dm
  8.2291 + \<rbrakk> \<Longrightarrow> G\<turnstile>dynC \<prec>\<^sub>C statC \<and> 
  8.2292 +       (declclass dm \<noteq> dynC \<longrightarrow> G \<turnstile> dm accessible_through_inheritance_in dynC)"
  8.2293 +by (auto simp add: dynmethd_def 
  8.2294 +         dest: methd_inheritedD methd_diff_cls
  8.2295 +         intro: rtrancl_into_trancl3)
  8.2296 +*)
  8.2297 +
  8.2298 +subsection "dynlookup"
  8.2299 +
  8.2300 +lemma dynlookup_cases [consumes 1, case_names NullT IfaceT ClassT ArrayT]:
  8.2301 +"\<lbrakk>dynlookup G statT dynC sig = x;
  8.2302 +           \<lbrakk>statT = NullT       ; empty sig = x                  \<rbrakk> \<Longrightarrow> P;
  8.2303 +  \<And> I.    \<lbrakk>statT = IfaceT I    ; dynimethd G I      dynC sig = x\<rbrakk> \<Longrightarrow> P;
  8.2304 +  \<And> statC.\<lbrakk>statT = ClassT statC; dynmethd  G statC  dynC sig = x\<rbrakk> \<Longrightarrow> P;
  8.2305 +  \<And> ty.   \<lbrakk>statT = ArrayT ty   ; dynmethd  G Object dynC sig = x\<rbrakk> \<Longrightarrow> P
  8.2306 + \<rbrakk> \<Longrightarrow> P"
  8.2307 +by (cases statT) (auto simp add: dynlookup_def)
  8.2308 +
  8.2309 +subsection "fields"
  8.2310 +
  8.2311 +lemma fields_rec: "\<lbrakk>class G C = Some c; ws_prog G\<rbrakk> \<Longrightarrow>  
  8.2312 +  fields G C = map (\<lambda>(fn,ft). ((fn,C),ft)) (cfields c) @  
  8.2313 +  (if C = Object then [] else fields G (super c))"
  8.2314 +apply (simp only: fields_def)
  8.2315 +apply (erule class_rec [THEN trans])
  8.2316 +apply assumption
  8.2317 +apply clarsimp
  8.2318 +done
  8.2319 +
  8.2320 +(* local lemma *)
  8.2321 +lemma fields_norec: 
  8.2322 +"\<lbrakk>class G fd = Some c; ws_prog G;  table_of (cfields c) fn = Some f\<rbrakk> 
  8.2323 + \<Longrightarrow> table_of (fields G fd) (fn,fd) = Some f"
  8.2324 +apply (subst fields_rec)
  8.2325 +apply assumption+
  8.2326 +apply (subst map_of_override [symmetric])
  8.2327 +apply (rule disjI1 [THEN override_Some_iff [THEN iffD2]])
  8.2328 +apply (auto elim: table_of_map2_SomeI)
  8.2329 +done
  8.2330 +
  8.2331 +(* local lemma *)
  8.2332 +lemma table_of_fieldsD:
  8.2333 +"table_of (map (\<lambda>(fn,ft). ((fn,C),ft)) (cfields c)) efn = Some f
  8.2334 +\<Longrightarrow> (declclassf efn) = C \<and> table_of (cfields c) (fname efn) = Some f"
  8.2335 +apply (case_tac "efn")
  8.2336 +by auto
  8.2337 +
  8.2338 +lemma fields_declC: 
  8.2339 + "\<lbrakk>table_of (fields G C) efn = Some f; ws_prog G; is_class G C\<rbrakk> \<Longrightarrow>  
  8.2340 +  (\<exists>d. class G (declclassf efn) = Some d \<and> 
  8.2341 +                    table_of (cfields d) (fname efn)=Some f) \<and> 
  8.2342 +  G\<turnstile>C \<preceq>\<^sub>C (declclassf efn)  \<and> table_of (fields G (declclassf efn)) efn = Some f"
  8.2343 +apply (erule make_imp)
  8.2344 +apply (rule ws_subcls1_induct, assumption, assumption)
  8.2345 +apply (subst fields_rec, assumption)
  8.2346 +apply clarify
  8.2347 +apply (simp only: map_of_override [symmetric] del: map_of_override)
  8.2348 +apply (case_tac "table_of (map (split (\<lambda>fn. Pair (fn, Ca))) (cfields c)) efn") 
  8.2349 +apply   (force intro:rtrancl_into_rtrancl2 simp add: override_def)
  8.2350 +
  8.2351 +apply   (frule_tac fd="Ca" in fields_norec)
  8.2352 +apply     assumption
  8.2353 +apply     blast
  8.2354 +apply   (frule table_of_fieldsD)  
  8.2355 +apply   (frule_tac n="table_of (map (split (\<lambda>fn. Pair (fn, Ca))) (cfields c))"
  8.2356 +              and  m="table_of (if Ca = Object then [] else fields G (super c))"
  8.2357 +         in override_find_right)
  8.2358 +apply   (case_tac "efn")
  8.2359 +apply   (simp)
  8.2360 +done
  8.2361 +
  8.2362 +lemma fields_emptyI: "\<And>y. \<lbrakk>ws_prog G; class G C = Some c;cfields c = [];  
  8.2363 +  C \<noteq> Object \<longrightarrow> class G (super c) = Some y \<and> fields G (super c) = []\<rbrakk> \<Longrightarrow>  
  8.2364 +  fields G C = []"
  8.2365 +apply (subst fields_rec)
  8.2366 +apply assumption
  8.2367 +apply auto
  8.2368 +done
  8.2369 +
  8.2370 +(* easier than with table_of *)
  8.2371 +lemma fields_mono_lemma: 
  8.2372 +"\<lbrakk>x \<in> set (fields G C); G\<turnstile>D \<preceq>\<^sub>C C; ws_prog G\<rbrakk> 
  8.2373 + \<Longrightarrow> x \<in> set (fields G D)"
  8.2374 +apply (erule make_imp)
  8.2375 +apply (erule converse_rtrancl_induct)
  8.2376 +apply  fast
  8.2377 +apply (drule subcls1D)
  8.2378 +apply clarsimp
  8.2379 +apply (subst fields_rec)
  8.2380 +apply   auto
  8.2381 +done
  8.2382 +
  8.2383 +
  8.2384 +lemma ws_unique_fields_lemma: 
  8.2385 + "\<lbrakk>(efn,fd)  \<in> set (fields G (super c)); fc \<in> set (cfields c); ws_prog G;  
  8.2386 +   fname efn = fname fc; declclassf efn = C;
  8.2387 +   class G C = Some c; C \<noteq> Object; class G (super c) = Some d\<rbrakk> \<Longrightarrow> R"
  8.2388 +apply (frule_tac ws_prog_cdeclD [THEN conjunct2], assumption, assumption)
  8.2389 +apply (drule_tac weak_map_of_SomeI)
  8.2390 +apply (frule_tac subcls1I [THEN subcls1_irrefl], assumption, assumption)
  8.2391 +apply (auto dest: fields_declC [THEN conjunct2 [THEN conjunct1[THEN rtranclD]]])
  8.2392 +done
  8.2393 +
  8.2394 +lemma ws_unique_fields: "\<lbrakk>is_class G C; ws_prog G; 
  8.2395 +       \<And>C c. \<lbrakk>class G C = Some c\<rbrakk> \<Longrightarrow> unique (cfields c) \<rbrakk> \<Longrightarrow>
  8.2396 +      unique (fields G C)" 
  8.2397 +apply (rule ws_subcls1_induct, assumption, assumption)
  8.2398 +apply (subst fields_rec, assumption)            
  8.2399 +apply (auto intro!: unique_map_inj injI 
  8.2400 +            elim!: unique_append ws_unique_fields_lemma fields_norec
  8.2401 +            )
  8.2402 +done
  8.2403 +
  8.2404 +
  8.2405 +subsection "accfield"
  8.2406 +
  8.2407 +lemma accfield_fields: 
  8.2408 + "accfield G S C fn = Some f 
  8.2409 +  \<Longrightarrow> table_of (fields G C) (fn, declclass f) = Some (fld f)"
  8.2410 +apply (simp only: accfield_def Let_def)
  8.2411 +apply (rule table_of_remap_SomeD)
  8.2412 +apply (auto dest: filter_tab_SomeD)
  8.2413 +done
  8.2414 +
  8.2415 +
  8.2416 +lemma accfield_declC_is_class: 
  8.2417 + "\<lbrakk>is_class G C; accfield G S C en = Some (fd, f); ws_prog G\<rbrakk> \<Longrightarrow>  
  8.2418 +   is_class G fd"
  8.2419 +apply (drule accfield_fields)
  8.2420 +apply (drule fields_declC [THEN conjunct1], assumption)
  8.2421 +apply auto
  8.2422 +done
  8.2423 +
  8.2424 +lemma accfield_accessibleD: 
  8.2425 +  "accfield G S C fn = Some f \<Longrightarrow> G\<turnstile>Field fn f of C accessible_from S"
  8.2426 +by (auto simp add: accfield_def Let_def)
  8.2427 +
  8.2428 +subsection "is methd"
  8.2429 +
  8.2430 +lemma is_methdI: 
  8.2431 +"\<lbrakk>class G C = Some y; methd G C sig = Some b\<rbrakk> \<Longrightarrow> is_methd G C sig"
  8.2432 +apply (unfold is_methd_def)
  8.2433 +apply auto
  8.2434 +done
  8.2435 +
  8.2436 +lemma is_methdD: 
  8.2437 +"is_methd G C sig \<Longrightarrow> class G C \<noteq> None \<and> methd G C sig \<noteq> None"
  8.2438 +apply (unfold is_methd_def)
  8.2439 +apply auto
  8.2440 +done
  8.2441 +
  8.2442 +lemma finite_is_methd: 
  8.2443 + "ws_prog G \<Longrightarrow> finite (Collect (split (is_methd G)))"
  8.2444 +apply (unfold is_methd_def)
  8.2445 +apply (subst SetCompr_Sigma_eq)
  8.2446 +apply (rule finite_is_class [THEN finite_SigmaI])
  8.2447 +apply (simp only: mem_Collect_eq)
  8.2448 +apply (fold dom_def)
  8.2449 +apply (erule finite_dom_methd)
  8.2450 +apply assumption
  8.2451 +done
  8.2452 +
  8.2453 +section "calculation of the superclasses of a class"
  8.2454 +
  8.2455 +constdefs 
  8.2456 + superclasses:: "prog \<Rightarrow> qtname \<Rightarrow> qtname set"
  8.2457 + "superclasses G C \<equiv> class_rec (G,C) {} 
  8.2458 +                       (\<lambda> C c superclss. (if C=Object 
  8.2459 +                                            then {} 
  8.2460 +                                            else insert (super c) superclss))"
  8.2461 +   
  8.2462 +lemma superclasses_rec: "\<lbrakk>class G C = Some c; ws_prog G\<rbrakk> \<Longrightarrow>  
  8.2463 + superclasses G C 
  8.2464 + = (if (C=Object) 
  8.2465 +       then {}
  8.2466 +       else insert (super c) (superclasses G (super c)))"
  8.2467 +apply (unfold superclasses_def)
  8.2468 +apply (erule class_rec [THEN trans], assumption)
  8.2469 +apply (simp)
  8.2470 +done
  8.2471 +
  8.2472 +lemma superclasses_mono:
  8.2473 +"\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D;ws_prog G; class G C = Some c;
  8.2474 +  \<And> C c. \<lbrakk>class G C = Some c;C\<noteq>Object\<rbrakk> \<Longrightarrow> \<exists> sc. class G (super c) = Some sc;
  8.2475 +  x\<in>superclasses G D 
  8.2476 +\<rbrakk> \<Longrightarrow> x\<in>superclasses G C" 
  8.2477 +proof -
  8.2478 +  
  8.2479 +  assume     ws: "ws_prog G"          and 
  8.2480 +          cls_C: "class G C = Some c" and
  8.2481 +             wf: "\<And>C c. \<lbrakk>class G C = Some c; C \<noteq> Object\<rbrakk>
  8.2482 +                  \<Longrightarrow> \<exists>sc. class G (super c) = Some sc"
  8.2483 +  assume clsrel: "G\<turnstile>C\<prec>\<^sub>C D"           
  8.2484 +  thus "\<And> c. \<lbrakk>class G C = Some c; x\<in>superclasses G D\<rbrakk>\<Longrightarrow>
  8.2485 +        x\<in>superclasses G C" (is "PROP ?P C"  
  8.2486 +                             is "\<And> c. ?CLS C c \<Longrightarrow> ?SUP D \<Longrightarrow> ?SUP C")
  8.2487 +  proof (induct ?P C  rule: converse_trancl_induct)
  8.2488 +    fix C c
  8.2489 +    assume "G\<turnstile>C\<prec>\<^sub>C\<^sub>1D" "class G C = Some c" "x \<in> superclasses G D"
  8.2490 +    with wf ws show "?SUP C"
  8.2491 +      by (auto    intro: no_subcls1_Object 
  8.2492 +               simp add: superclasses_rec subcls1_def)
  8.2493 +  next
  8.2494 +    fix C S c
  8.2495 +    assume clsrel': "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S" "G\<turnstile>S \<prec>\<^sub>C D"
  8.2496 +       and    hyp : "\<And> s. \<lbrakk>class G S = Some s; x \<in> superclasses G D\<rbrakk>
  8.2497 +                           \<Longrightarrow> x \<in> superclasses G S"
  8.2498 +       and  cls_C': "class G C = Some c"
  8.2499 +       and       x: "x \<in> superclasses G D"
  8.2500 +    moreover note wf ws
  8.2501 +    moreover from calculation 
  8.2502 +    have "?SUP S" 
  8.2503 +      by (force intro: no_subcls1_Object simp add: subcls1_def)
  8.2504 +    moreover from calculation 
  8.2505 +    have "super c = S" 
  8.2506 +      by (auto intro: no_subcls1_Object simp add: subcls1_def)
  8.2507 +    ultimately show "?SUP C" 
  8.2508 +      by (auto intro: no_subcls1_Object simp add: superclasses_rec)
  8.2509 +  qed
  8.2510 +qed
  8.2511 +
  8.2512 +lemma subclsEval:
  8.2513 +"\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D;ws_prog G; class G C = Some c;
  8.2514 +  \<And> C c. \<lbrakk>class G C = Some c;C\<noteq>Object\<rbrakk> \<Longrightarrow> \<exists> sc. class G (super c) = Some sc 
  8.2515 + \<rbrakk> \<Longrightarrow> D\<in>superclasses G C" 
  8.2516 +proof -
  8.2517 +  note converse_trancl_induct 
  8.2518 +       = converse_trancl_induct [consumes 1,case_names Single Step]
  8.2519 +  assume 
  8.2520 +             ws: "ws_prog G"          and 
  8.2521 +          cls_C: "class G C = Some c" and
  8.2522 +             wf: "\<And>C c. \<lbrakk>class G C = Some c; C \<noteq> Object\<rbrakk>
  8.2523 +                  \<Longrightarrow> \<exists>sc. class G (super c) = Some sc"
  8.2524 +  assume clsrel: "G\<turnstile>C\<prec>\<^sub>C D"           
  8.2525 +  thus "\<And> c. class G C = Some c\<Longrightarrow> D\<in>superclasses G C" 
  8.2526 +    (is "PROP ?P C"  is "\<And> c. ?CLS C c  \<Longrightarrow> ?SUP C")
  8.2527 +  proof (induct ?P C  rule: converse_trancl_induct)
  8.2528 +    fix C c
  8.2529 +    assume "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 D" "class G C = Some c"
  8.2530 +    with ws wf show "?SUP C"
  8.2531 +      by (auto intro: no_subcls1_Object simp add: superclasses_rec subcls1_def)
  8.2532 +  next
  8.2533 +    fix C S c
  8.2534 +    assume "G\<turnstile>C \<prec>\<^sub>C\<^sub>1 S" "G\<turnstile>S\<prec>\<^sub>C D" 
  8.2535 +           "\<And>s. class G S = Some s \<Longrightarrow> D \<in> superclasses G S"
  8.2536 +           "class G C = Some c" 
  8.2537 +    with ws wf show "?SUP C"
  8.2538 +      by - (rule superclasses_mono,
  8.2539 +            auto dest: no_subcls1_Object simp add: subcls1_def )
  8.2540 +  qed
  8.2541 +qed
  8.2542 +
  8.2543 +end
  8.2544 \ No newline at end of file
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/Bali/Eval.thy	Mon Jan 28 17:00:19 2002 +0100
     9.3 @@ -0,0 +1,993 @@
     9.4 +(*  Title:      isabelle/Bali/Eval.thy
     9.5 +    ID:         $Id$
     9.6 +    Author:     David von Oheimb
     9.7 +    Copyright   1997 Technische Universitaet Muenchen
     9.8 +*)
     9.9 +header {* Operational evaluation (big-step) semantics of Java expressions and 
    9.10 +          statements
    9.11 +*}
    9.12 +
    9.13 +theory Eval = State + DeclConcepts:
    9.14 +
    9.15 +text {*
    9.16 +
    9.17 +improvements over Java Specification 1.0:
    9.18 +\begin{itemize}
    9.19 +\item dynamic method lookup does not need to consider the return type 
    9.20 +      (cf.15.11.4.4)
    9.21 +\item throw raises a NullPointer exception if a null reference is given, and 
    9.22 +      each throw of a standard exception yield a fresh exception object 
    9.23 +      (was not specified)
    9.24 +\item if there is not enough memory even to allocate an OutOfMemory exception,
    9.25 +  evaluation/execution fails, i.e. simply stops (was not specified)
    9.26 +\item array assignment checks lhs (and may throw exceptions) before evaluating 
    9.27 +      rhs
    9.28 +\item fixed exact positions of class initializations 
    9.29 +      (immediate at first active use)
    9.30 +\end{itemize}
    9.31 +
    9.32 +design issues:
    9.33 +\begin{itemize}
    9.34 +\item evaluation vs. (single-step) transition semantics
    9.35 +  evaluation semantics chosen, because:
    9.36 +  \begin{itemize} 
    9.37 +  \item[++] less verbose and therefore easier to read (and to handle in proofs)
    9.38 +  \item[+]  more abstract
    9.39 +  \item[+]  intermediate values (appearing in recursive rules) need not be 
    9.40 +     stored explicitly, e.g. no call body construct or stack of invocation 
    9.41 +     frames containing local variables and return addresses for method calls 
    9.42 +     needed
    9.43 +  \item[+]  convenient rule induction for subject reduction theorem
    9.44 +  \item[-]  no interleaving (for parallelism) can be described
    9.45 +  \item[-]  stating a property of infinite executions requires the meta-level 
    9.46 +     argument that this property holds for any finite prefixes of it 
    9.47 +     (e.g. stopped using a counter that is decremented to zero and then 
    9.48 +     throwing an exception)
    9.49 +  \end{itemize}
    9.50 +\item unified evaluation for variables, expressions, expression lists, 
    9.51 +      statements
    9.52 +\item the value entry in statement rules is redundant 
    9.53 +\item the value entry in rules is irrelevant in case of exceptions, but its full
    9.54 +  inclusion helps to make the rule structure independent of exception occurence.
    9.55 +\item as irrelevant value entries are ignored, it does not matter if they are 
    9.56 +      unique.
    9.57 +  For simplicity, (fixed) arbitrary values are preferred over "free" values.
    9.58 +\item the rule format is such that the start state may contain an exception.
    9.59 +  \begin{itemize}
    9.60 +  \item[++] faciliates exception handling
    9.61 +  \item[+]  symmetry
    9.62 +  \end{itemize}
    9.63 +\item the rules are defined carefully in order to be applicable even in not
    9.64 +  type-correct situations (yielding undefined values),
    9.65 +  e.g. @{text "the_Addr (Val (Bool b)) = arbitrary"}.
    9.66 +  \begin{itemize}
    9.67 +  \item[++] fewer rules 
    9.68 +  \item[-]  less readable because of auxiliary functions like @{text the_Addr}
    9.69 +  \end{itemize}
    9.70 +  Alternative: "defensive" evaluation throwing some InternalError exception
    9.71 +               in case of (impossible, for correct programs) type mismatches
    9.72 +\item there is exactly one rule per syntactic construct
    9.73 +  \begin{itemize}
    9.74 +  \item[+] no redundancy in case distinctions
    9.75 +  \end{itemize}
    9.76 +\item halloc fails iff there is no free heap address. When there is
    9.77 +  only one free heap address left, it returns an OutOfMemory exception.
    9.78 +  In this way it is guaranteed that when an OutOfMemory exception is thrown for
    9.79 +  the first time, there is a free location on the heap to allocate it.
    9.80 +\item the allocation of objects that represent standard exceptions is deferred 
    9.81 +      until execution of any enclosing catch clause, which is transparent to 
    9.82 +      the program.
    9.83 +  \begin{itemize}
    9.84 +  \item[-]  requires an auxiliary execution relation
    9.85 +  \item[++] avoids copies of allocation code and awkward case distinctions 
    9.86 +           (whether there is enough memory to allocate the exception) in 
    9.87 +            evaluation rules
    9.88 +  \end{itemize}
    9.89 +\item unfortunately @{text new_Addr} is not directly executable because of 
    9.90 +      Hilbert operator.
    9.91 +\end{itemize}
    9.92 +simplifications:
    9.93 +\begin{itemize}
    9.94 +\item local variables are initialized with default values 
    9.95 +      (no definite assignment)
    9.96 +\item garbage collection not considered, therefore also no finalizers
    9.97 +\item stack overflow and memory overflow during class initialization not 
    9.98 +      modelled
    9.99 +\item exceptions in initializations not replaced by ExceptionInInitializerError
   9.100 +\end{itemize}
   9.101 +*}
   9.102 +
   9.103 +types vvar  =         "val \<times> (val \<Rightarrow> state \<Rightarrow> state)"
   9.104 +      vals  =        "(val, vvar, val list) sum3"
   9.105 +translations
   9.106 +     "vvar" <= (type) "val \<times> (val \<Rightarrow> state \<Rightarrow> state)"
   9.107 +     "vals" <= (type)"(val, vvar, val list) sum3"
   9.108 +
   9.109 +syntax (xsymbols)
   9.110 +  dummy_res :: "vals" ("\<diamondsuit>")
   9.111 +translations
   9.112 +  "\<diamondsuit>" == "In1 Unit"
   9.113 +
   9.114 +constdefs
   9.115 +  arbitrary3 :: "('al + 'ar, 'b, 'c) sum3 \<Rightarrow> vals"
   9.116 + "arbitrary3 \<equiv> sum3_case (In1 \<circ> sum_case (\<lambda>x. arbitrary) (\<lambda>x. Unit))
   9.117 +                     (\<lambda>x. In2 arbitrary) (\<lambda>x. In3 arbitrary)"
   9.118 +
   9.119 +lemma [simp]: "arbitrary3 (In1l x) = In1 arbitrary"
   9.120 +by (simp add: arbitrary3_def)
   9.121 +
   9.122 +lemma [simp]: "arbitrary3 (In1r x) = \<diamondsuit>"
   9.123 +by (simp add: arbitrary3_def)
   9.124 +
   9.125 +lemma [simp]: "arbitrary3 (In2  x) = In2 arbitrary"
   9.126 +by (simp add: arbitrary3_def)
   9.127 +
   9.128 +lemma [simp]: "arbitrary3 (In3  x) = In3 arbitrary"
   9.129 +by (simp add: arbitrary3_def)
   9.130 +
   9.131 +
   9.132 +section "exception throwing and catching"
   9.133 +
   9.134 +constdefs
   9.135 +  throw :: "val \<Rightarrow> abopt \<Rightarrow> abopt"
   9.136 + "throw a' x \<equiv> abrupt_if True (Some (Xcpt (Loc (the_Addr a')))) (np a' x)"
   9.137 +
   9.138 +lemma throw_def2: 
   9.139 + "throw a' x = abrupt_if True (Some (Xcpt (Loc (the_Addr a')))) (np a' x)"
   9.140 +apply (unfold throw_def)
   9.141 +apply (simp (no_asm))
   9.142 +done
   9.143 +
   9.144 +constdefs
   9.145 +  fits    :: "prog \<Rightarrow> st \<Rightarrow> val \<Rightarrow> ty \<Rightarrow> bool" ("_,_\<turnstile>_ fits _"[61,61,61,61]60)
   9.146 + "G,s\<turnstile>a' fits T  \<equiv> (\<exists>rt. T=RefT rt) \<longrightarrow> a'=Null \<or> G\<turnstile>obj_ty(lookup_obj s a')\<preceq>T"
   9.147 +
   9.148 +lemma fits_Null [simp]: "G,s\<turnstile>Null fits T"
   9.149 +by (simp add: fits_def)
   9.150 +
   9.151 +
   9.152 +lemma fits_Addr_RefT [simp]:
   9.153 +  "G,s\<turnstile>Addr a fits RefT t = G\<turnstile>obj_ty (the (heap s a))\<preceq>RefT t"
   9.154 +by (simp add: fits_def)
   9.155 +
   9.156 +lemma fitsD: "\<And>X. G,s\<turnstile>a' fits T \<Longrightarrow> (\<exists>pt. T = PrimT pt) \<or>  
   9.157 +  (\<exists>t. T = RefT t) \<and> a' = Null \<or>  
   9.158 +  (\<exists>t. T = RefT t) \<and> a' \<noteq> Null \<and>  G\<turnstile>obj_ty (lookup_obj s a')\<preceq>T"
   9.159 +apply (unfold fits_def)
   9.160 +apply (case_tac "\<exists>pt. T = PrimT pt")
   9.161 +apply  simp_all
   9.162 +apply (case_tac "T")
   9.163 +defer 
   9.164 +apply (case_tac "a' = Null")
   9.165 +apply  simp_all
   9.166 +done
   9.167 +
   9.168 +constdefs
   9.169 +  catch ::"prog \<Rightarrow> state \<Rightarrow> qtname \<Rightarrow> bool"      ("_,_\<turnstile>catch _"[61,61,61]60)
   9.170 + "G,s\<turnstile>catch C\<equiv>\<exists>xc. abrupt s=Some (Xcpt xc) \<and> 
   9.171 +                    G,store s\<turnstile>Addr (the_Loc xc) fits Class C"
   9.172 +
   9.173 +lemma catch_Norm [simp]: "\<not>G,Norm s\<turnstile>catch tn"
   9.174 +apply (unfold catch_def)
   9.175 +apply (simp (no_asm))
   9.176 +done
   9.177 +
   9.178 +lemma catch_XcptLoc [simp]: 
   9.179 +  "G,(Some (Xcpt (Loc a)),s)\<turnstile>catch C = G,s\<turnstile>Addr a fits Class C"
   9.180 +apply (unfold catch_def)
   9.181 +apply (simp (no_asm))
   9.182 +done
   9.183 +
   9.184 +constdefs
   9.185 +  new_xcpt_var :: "vname \<Rightarrow> state \<Rightarrow> state"
   9.186 + "new_xcpt_var vn \<equiv> 
   9.187 +     \<lambda>(x,s). Norm (lupd(VName vn\<mapsto>Addr (the_Loc (the_Xcpt (the x)))) s)"
   9.188 +
   9.189 +lemma new_xcpt_var_def2 [simp]: 
   9.190 + "new_xcpt_var vn (x,s) = 
   9.191 +    Norm (lupd(VName vn\<mapsto>Addr (the_Loc (the_Xcpt (the x)))) s)"
   9.192 +apply (unfold new_xcpt_var_def)
   9.193 +apply (simp (no_asm))
   9.194 +done
   9.195 +
   9.196 +
   9.197 +
   9.198 +section "misc"
   9.199 +
   9.200 +constdefs
   9.201 +
   9.202 +  assign     :: "('a \<Rightarrow> state \<Rightarrow> state) \<Rightarrow> 'a \<Rightarrow> state \<Rightarrow> state"
   9.203 + "assign f v \<equiv> \<lambda>(x,s). let (x',s') = (if x = None then f v else id) (x,s)
   9.204 +		   in  (x',if x' = None then s' else s)"
   9.205 +
   9.206 +(*
   9.207 +lemma assign_Norm_Norm [simp]: 
   9.208 +"f v \<lparr>abrupt=None,store=s\<rparr> = \<lparr>abrupt=None,store=s'\<rparr> 
   9.209 + \<Longrightarrow> assign f v \<lparr>abrupt=None,store=s\<rparr> = \<lparr>abrupt=None,store=s'\<rparr>"
   9.210 +by (simp add: assign_def Let_def)
   9.211 +*)
   9.212 +
   9.213 +lemma assign_Norm_Norm [simp]: 
   9.214 +"f v (Norm s) = Norm s' \<Longrightarrow> assign f v (Norm s) = Norm s'"
   9.215 +by (simp add: assign_def Let_def)
   9.216 +
   9.217 +(*
   9.218 +lemma assign_Norm_Some [simp]: 
   9.219 +  "\<lbrakk>abrupt (f v \<lparr>abrupt=None,store=s\<rparr>) = Some y\<rbrakk> 
   9.220 +   \<Longrightarrow> assign f v \<lparr>abrupt=None,store=s\<rparr> = \<lparr>abrupt=Some y,store =s\<rparr>"
   9.221 +by (simp add: assign_def Let_def split_beta)
   9.222 +*)
   9.223 +
   9.224 +lemma assign_Norm_Some [simp]: 
   9.225 +  "\<lbrakk>abrupt (f v (Norm s)) = Some y\<rbrakk> 
   9.226 +   \<Longrightarrow> assign f v (Norm s) = (Some y,s)"
   9.227 +by (simp add: assign_def Let_def split_beta)
   9.228 +
   9.229 +
   9.230 +lemma assign_Some [simp]: 
   9.231 +"assign f v (Some x,s) = (Some x,s)" 
   9.232 +by (simp add: assign_def Let_def split_beta)
   9.233 +
   9.234 +lemma assign_supd [simp]: 
   9.235 +"assign (\<lambda>v. supd (f v)) v (x,s)  
   9.236 +  = (x, if x = None then f v s else s)"
   9.237 +apply auto
   9.238 +done
   9.239 +
   9.240 +lemma assign_raise_if [simp]: 
   9.241 +  "assign (\<lambda>v (x,s). ((raise_if (b s v) xcpt) x, f v s)) v (x, s) =  
   9.242 +  (raise_if (b s v) xcpt x, if x=None \<and> \<not>b s v then f v s else s)"
   9.243 +apply (case_tac "x = None")
   9.244 +apply auto
   9.245 +done
   9.246 +
   9.247 +(*
   9.248 +lemma assign_raise_if [simp]: 
   9.249 +  "assign (\<lambda>v s. \<lparr>abrupt=(raise_if (b (store s) v) xcpt) (abrupt s),
   9.250 +                  store = f v (store s)\<rparr>) v s =  
   9.251 +  \<lparr>abrupt=raise_if (b (store s) v) xcpt (abrupt s),
   9.252 +   store= if (abrupt s)=None \<and> \<not>b (store s) v 
   9.253 +             then f v (store s) else (store s)\<rparr>"
   9.254 +apply (case_tac "abrupt s = None")
   9.255 +apply auto
   9.256 +done
   9.257 +*)
   9.258 +
   9.259 +constdefs
   9.260 +
   9.261 +  init_comp_ty :: "ty \<Rightarrow> stmt"
   9.262 + "init_comp_ty T \<equiv> if (\<exists>C. T = Class C) then Init (the_Class T) else Skip"
   9.263 +
   9.264 +lemma init_comp_ty_PrimT [simp]: "init_comp_ty (PrimT pt) = Skip"
   9.265 +apply (unfold init_comp_ty_def)
   9.266 +apply (simp (no_asm))
   9.267 +done
   9.268 +
   9.269 +constdefs
   9.270 +
   9.271 +(*
   9.272 +  target  :: "inv_mode \<Rightarrow> st \<Rightarrow> val \<Rightarrow> ref_ty \<Rightarrow> qtname"
   9.273 + "target m s a' t 
   9.274 +    \<equiv> if m = IntVir
   9.275 +	 then obj_class (lookup_obj s a') 
   9.276 +         else the_Class (RefT t)"
   9.277 +*)
   9.278 +
   9.279 + invocation_class  :: "inv_mode \<Rightarrow> st \<Rightarrow> val \<Rightarrow> ref_ty \<Rightarrow> qtname"
   9.280 + "invocation_class m s a' statT 
   9.281 +    \<equiv> (case m of
   9.282 +         Static \<Rightarrow> if (\<exists> statC. statT = ClassT statC) 
   9.283 +                      then the_Class (RefT statT) 
   9.284 +                      else Object
   9.285 +       | SuperM \<Rightarrow> the_Class (RefT statT)
   9.286 +       | IntVir \<Rightarrow> obj_class (lookup_obj s a'))"
   9.287 +
   9.288 +invocation_declclass::"prog \<Rightarrow> inv_mode \<Rightarrow> st \<Rightarrow> val \<Rightarrow> ref_ty \<Rightarrow> sig \<Rightarrow> qtname"
   9.289 +"invocation_declclass G m s a' statT sig 
   9.290 +   \<equiv> declclass (the (dynlookup G statT 
   9.291 +                                (invocation_class m s a' statT)
   9.292 +                                sig))" 
   9.293 +  
   9.294 +lemma invocation_class_IntVir [simp]: 
   9.295 +"invocation_class IntVir s a' statT = obj_class (lookup_obj s a')"
   9.296 +by (simp add: invocation_class_def)
   9.297 +
   9.298 +lemma dynclass_SuperM [simp]: 
   9.299 + "invocation_class SuperM s a' statT = the_Class (RefT statT)"
   9.300 +by (simp add: invocation_class_def)
   9.301 +(*
   9.302 +lemma invocation_class_notIntVir [simp]: 
   9.303 + "m \<noteq> IntVir \<Longrightarrow> invocation_class m s a' statT = the_Class (RefT statT)"
   9.304 +by (simp add: invocation_class_def)
   9.305 +*)
   9.306 +
   9.307 +lemma invocation_class_Static [simp]: 
   9.308 +  "invocation_class Static s a' statT = (if (\<exists> statC. statT = ClassT statC) 
   9.309 +                                            then the_Class (RefT statT) 
   9.310 +                                            else Object)"
   9.311 +by (simp add: invocation_class_def)
   9.312 +
   9.313 +constdefs
   9.314 +  init_lvars :: "prog \<Rightarrow> qtname \<Rightarrow> sig \<Rightarrow> inv_mode \<Rightarrow> val \<Rightarrow> val list \<Rightarrow>
   9.315 +		   state \<Rightarrow> state"
   9.316 + "init_lvars G C sig mode a' pvs 
   9.317 +   \<equiv> \<lambda> (x,s). 
   9.318 +      let m = mthd (the (methd G C sig));
   9.319 +          l = \<lambda> k. 
   9.320 +              (case k of
   9.321 +                 EName e 
   9.322 +                   \<Rightarrow> (case e of 
   9.323 +                         VNam v \<Rightarrow> (init_vals (table_of (lcls (mbody m)))
   9.324 +                                                     ((pars m)[\<mapsto>]pvs)) v
   9.325 +                       | Res    \<Rightarrow> Some (default_val (resTy m)))
   9.326 +               | This 
   9.327 +                   \<Rightarrow> (if mode=Static then None else Some a'))
   9.328 +      in set_lvars l (if mode = Static then x else np a' x,s)"
   9.329 +
   9.330 +
   9.331 +
   9.332 +lemma init_lvars_def2: "init_lvars G C sig mode a' pvs (x,s) =  
   9.333 +  set_lvars 
   9.334 +    (\<lambda> k. 
   9.335 +       (case k of
   9.336 +          EName e 
   9.337 +            \<Rightarrow> (case e of 
   9.338 +                  VNam v 
   9.339 +                  \<Rightarrow> (init_vals 
   9.340 +                       (table_of (lcls (mbody (mthd (the (methd G C sig))))))
   9.341 +                                 ((pars (mthd (the (methd G C sig))))[\<mapsto>]pvs)) v
   9.342 +               | Res \<Rightarrow> Some (default_val (resTy (mthd (the (methd G C sig))))))
   9.343 +        | This 
   9.344 +            \<Rightarrow> (if mode=Static then None else Some a')))
   9.345 +    (if mode = Static then x else np a' x,s)"
   9.346 +apply (unfold init_lvars_def)
   9.347 +apply (simp (no_asm) add: Let_def)
   9.348 +done
   9.349 +
   9.350 +constdefs
   9.351 +  body :: "prog \<Rightarrow> qtname \<Rightarrow> sig \<Rightarrow> expr"
   9.352 + "body G C sig \<equiv> let m = the (methd G C sig) 
   9.353 +                 in Body (declclass m) (stmt (mbody (mthd m)))"
   9.354 +
   9.355 +lemma body_def2: 
   9.356 +"body G C sig = Body  (declclass (the (methd G C sig))) 
   9.357 +                      (stmt (mbody (mthd (the (methd G C sig)))))"
   9.358 +apply (unfold body_def Let_def)
   9.359 +apply auto
   9.360 +done
   9.361 +
   9.362 +section "variables"
   9.363 +
   9.364 +constdefs
   9.365 +
   9.366 +  lvar :: "lname \<Rightarrow> st \<Rightarrow> vvar"
   9.367 + "lvar vn s \<equiv> (the (locals s vn), \<lambda>v. supd (lupd(vn\<mapsto>v)))"
   9.368 +
   9.369 +  fvar :: "qtname \<Rightarrow> bool \<Rightarrow> vname \<Rightarrow> val \<Rightarrow> state \<Rightarrow> vvar \<times> state"
   9.370 + "fvar C stat fn a' s 
   9.371 +    \<equiv> let (oref,xf) = if stat then (Stat C,id)
   9.372 +                              else (Heap (the_Addr a'),np a');
   9.373 +	          n = Inl (fn,C); 
   9.374 +                  f = (\<lambda>v. supd (upd_gobj oref n v)) 
   9.375 +      in ((the (values (the (globs (store s) oref)) n),f),abupd xf s)"
   9.376 +
   9.377 +  avar :: "prog \<Rightarrow> val \<Rightarrow> val \<Rightarrow> state \<Rightarrow> vvar \<times> state"
   9.378 + "avar G i' a' s 
   9.379 +    \<equiv> let   oref = Heap (the_Addr a'); 
   9.380 +               i = the_Intg i'; 
   9.381 +               n = Inr i;
   9.382 +        (T,k,cs) = the_Arr (globs (store s) oref); 
   9.383 +               f = (\<lambda>v (x,s). (raise_if (\<not>G,s\<turnstile>v fits T) 
   9.384 +                                           ArrStore x
   9.385 +                              ,upd_gobj oref n v s)) 
   9.386 +      in ((the (cs n),f)
   9.387 +         ,abupd (raise_if (\<not>i in_bounds k) IndOutBound \<circ> np a') s)"
   9.388 +
   9.389 +lemma fvar_def2: "fvar C stat fn a' s =  
   9.390 +  ((the 
   9.391 +     (values 
   9.392 +      (the (globs (store s) (if stat then Stat C else Heap (the_Addr a')))) 
   9.393 +      (Inl (fn,C)))
   9.394 +   ,(\<lambda>v. supd (upd_gobj (if stat then Stat C else Heap (the_Addr a')) 
   9.395 +                        (Inl (fn,C)) 
   9.396 +                        v)))
   9.397 +  ,abupd (if stat then id else np a') s)
   9.398 +  "
   9.399 +apply (unfold fvar_def)
   9.400 +apply (simp (no_asm) add: Let_def split_beta)
   9.401 +done
   9.402 +
   9.403 +lemma avar_def2: "avar G i' a' s =  
   9.404 +  ((the ((snd(snd(the_Arr (globs (store s) (Heap (the_Addr a')))))) 
   9.405 +           (Inr (the_Intg i')))
   9.406 +   ,(\<lambda>v (x,s').  (raise_if (\<not>G,s'\<turnstile>v fits (fst(the_Arr (globs (store s)
   9.407 +                                                   (Heap (the_Addr a')))))) 
   9.408 +                            ArrStore x
   9.409 +                 ,upd_gobj  (Heap (the_Addr a')) 
   9.410 +                               (Inr (the_Intg i')) v s')))
   9.411 +  ,abupd (raise_if (\<not>(the_Intg i') in_bounds (fst(snd(the_Arr (globs (store s) 
   9.412 +                   (Heap (the_Addr a'))))))) IndOutBound \<circ> np a')
   9.413 +          s)"
   9.414 +apply (unfold avar_def)
   9.415 +apply (simp (no_asm) add: Let_def split_beta)
   9.416 +done
   9.417 +
   9.418 +
   9.419 +section "evaluation judgments"
   9.420 +
   9.421 +consts
   9.422 +  eval   :: "prog \<Rightarrow> (state \<times> term    \<times> vals \<times> state) set"
   9.423 +  halloc::  "prog \<Rightarrow> (state \<times> obj_tag \<times> loc  \<times> state) set"
   9.424 +  sxalloc:: "prog \<Rightarrow> (state                  \<times> state) set"
   9.425 +
   9.426 +
   9.427 +syntax
   9.428 +eval ::"[prog,state,term,vals*state]=>bool"("_|-_ -_>-> _"  [61,61,80,   61]60)
   9.429 +exec ::"[prog,state,stmt      ,state]=>bool"("_|-_ -_-> _"   [61,61,65,   61]60)
   9.430 +evar ::"[prog,state,var  ,vvar,state]=>bool"("_|-_ -_=>_-> _"[61,61,90,61,61]60)
   9.431 +eval_::"[prog,state,expr ,val, state]=>bool"("_|-_ -_->_-> _"[61,61,80,61,61]60)
   9.432 +evals::"[prog,state,expr list ,
   9.433 +		    val  list ,state]=>bool"("_|-_ -_#>_-> _"[61,61,61,61,61]60)
   9.434 +hallo::"[prog,state,obj_tag,
   9.435 +	             loc,state]=>bool"("_|-_ -halloc _>_-> _"[61,61,61,61,61]60)
   9.436 +sallo::"[prog,state        ,state]=>bool"("_|-_ -sxalloc-> _"[61,61,      61]60)
   9.437 +
   9.438 +syntax (xsymbols)
   9.439 +eval ::"[prog,state,term,vals\<times>state]\<Rightarrow>bool" ("_\<turnstile>_ \<midarrow>_\<succ>\<rightarrow> _"  [61,61,80,   61]60)
   9.440 +exec ::"[prog,state,stmt      ,state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>_\<rightarrow> _"   [61,61,65,   61]60)
   9.441 +evar ::"[prog,state,var  ,vvar,state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>_=\<succ>_\<rightarrow> _"[61,61,90,61,61]60)
   9.442 +eval_::"[prog,state,expr ,val ,state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>_-\<succ>_\<rightarrow> _"[61,61,80,61,61]60)
   9.443 +evals::"[prog,state,expr list ,
   9.444 +		    val  list ,state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>_\<doteq>\<succ>_\<rightarrow> _"[61,61,61,61,61]60)
   9.445 +hallo::"[prog,state,obj_tag,
   9.446 +	             loc,state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>halloc _\<succ>_\<rightarrow> _"[61,61,61,61,61]60)
   9.447 +sallo::"[prog,state,        state]\<Rightarrow>bool"("_\<turnstile>_ \<midarrow>sxalloc\<rightarrow> _"[61,61,      61]60)
   9.448 +
   9.449 +translations
   9.450 +  "G\<turnstile>s \<midarrow>t   \<succ>\<rightarrow>  w___s' " == "(s,t,w___s') \<in> eval G"
   9.451 +  "G\<turnstile>s \<midarrow>t   \<succ>\<rightarrow> (w,  s')" <= "(s,t,w,  s') \<in> eval G"
   9.452 +  "G\<turnstile>s \<midarrow>t   \<succ>\<rightarrow> (w,x,s')" <= "(s,t,w,x,s') \<in> eval G"
   9.453 +  "G\<turnstile>s \<midarrow>c    \<rightarrow>  (x,s')" <= "G\<turnstile>s \<midarrow>In1r c\<succ>\<rightarrow> (\<diamondsuit>,x,s')"
   9.454 +  "G\<turnstile>s \<midarrow>c    \<rightarrow>     s' " == "G\<turnstile>s \<midarrow>In1r c\<succ>\<rightarrow> (\<diamondsuit>  ,  s')"
   9.455 +  "G\<turnstile>s \<midarrow>e-\<succ>v \<rightarrow>  (x,s')" <= "G\<turnstile>s \<midarrow>In1l e\<succ>\<rightarrow> (In1 v ,x,s')"
   9.456 +  "G\<turnstile>s \<midarrow>e-\<succ>v \<rightarrow>     s' " == "G\<turnstile>s \<midarrow>In1l e\<succ>\<rightarrow> (In1 v ,  s')"
   9.457 +  "G\<turnstile>s \<midarrow>e=\<succ>vf\<rightarrow>  (x,s')" <= "G\<turnstile>s \<midarrow>In2  e\<succ>\<rightarrow> (In2 vf,x,s')"
   9.458 +  "G\<turnstile>s \<midarrow>e=\<succ>vf\<rightarrow>     s' " == "G\<turnstile>s \<midarrow>In2  e\<succ>\<rightarrow> (In2 vf,  s')"
   9.459 +  "G\<turnstile>s \<midarrow>e\<doteq>\<succ>v \<rightarrow>  (x,s')" <= "G\<turnstile>s \<midarrow>In3  e\<succ>\<rightarrow> (In3 v ,x,s')"
   9.460 +  "G\<turnstile>s \<midarrow>e\<doteq>\<succ>v \<rightarrow>     s' " == "G\<turnstile>s \<midarrow>In3  e\<succ>\<rightarrow> (In3 v ,  s')"
   9.461 +  "G\<turnstile>s \<midarrow>halloc oi\<succ>a\<rightarrow> (x,s')" <= "(s,oi,a,x,s') \<in> halloc G"
   9.462 +  "G\<turnstile>s \<midarrow>halloc oi\<succ>a\<rightarrow>    s' " == "(s,oi,a,  s') \<in> halloc G"
   9.463 +  "G\<turnstile>s \<midarrow>sxalloc\<rightarrow>     (x,s')" <= "(s     ,x,s') \<in> sxalloc G"
   9.464 +  "G\<turnstile>s \<midarrow>sxalloc\<rightarrow>        s' " == "(s     ,  s') \<in> sxalloc G"
   9.465 +
   9.466 +inductive "halloc G" intros (* allocating objects on the heap, cf. 12.5 *)
   9.467 +
   9.468 +  Abrupt: 
   9.469 +  "G\<turnstile>(Some x,s) \<midarrow>halloc oi\<succ>arbitrary\<rightarrow> (Some x,s)"
   9.470 +
   9.471 +  New:	  "\<lbrakk>new_Addr (heap s) = Some a; 
   9.472 +	    (x,oi') = (if atleast_free (heap s) (Suc (Suc 0)) then (None,oi)
   9.473 +		       else (Some (Xcpt (Loc a)),CInst (SXcpt OutOfMemory)))\<rbrakk>
   9.474 +            \<Longrightarrow>
   9.475 +	    G\<turnstile>Norm s \<midarrow>halloc oi\<succ>a\<rightarrow> (x,init_obj G oi' (Heap a) s)"
   9.476 +
   9.477 +inductive "sxalloc G" intros (* allocating exception objects for
   9.478 +	 	 	      standard exceptions (other than OutOfMemory) *)
   9.479 +
   9.480 +  Norm:	 "G\<turnstile> Norm              s   \<midarrow>sxalloc\<rightarrow>  Norm             s"
   9.481 +
   9.482 +  XcptL: "G\<turnstile>(Some (Xcpt (Loc a) ),s)  \<midarrow>sxalloc\<rightarrow> (Some (Xcpt (Loc a)),s)"
   9.483 +
   9.484 +  SXcpt: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>halloc (CInst (SXcpt xn))\<succ>a\<rightarrow> (x,s1)\<rbrakk> \<Longrightarrow>
   9.485 +	  G\<turnstile>(Some (Xcpt (Std xn)),s0) \<midarrow>sxalloc\<rightarrow> (Some (Xcpt (Loc a)),s1)"
   9.486 +
   9.487 +
   9.488 +inductive "eval G" intros
   9.489 +
   9.490 +(* propagation of abrupt completion *)
   9.491 +
   9.492 +  (* cf. 14.1, 15.5 *)
   9.493 +  Abrupt: 
   9.494 +   "G\<turnstile>(Some xc,s) \<midarrow>t\<succ>\<rightarrow> (arbitrary3 t,(Some xc,s))"
   9.495 +
   9.496 +
   9.497 +(* execution of statements *)
   9.498 +
   9.499 +  (* cf. 14.5 *)
   9.500 +  Skip:	 			    "G\<turnstile>Norm s \<midarrow>Skip\<rightarrow> Norm s"
   9.501 +
   9.502 +  (* cf. 14.7 *)
   9.503 +  Expr:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<rightarrow> s1\<rbrakk> \<Longrightarrow>
   9.504 +				  G\<turnstile>Norm s0 \<midarrow>Expr e\<rightarrow> s1"
   9.505 +
   9.506 +  Lab:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c \<rightarrow> s1\<rbrakk> \<Longrightarrow>
   9.507 +                                G\<turnstile>Norm s0 \<midarrow>l\<bullet> c\<rightarrow> abupd (absorb (Break l)) s1"
   9.508 +  (* cf. 14.2 *)
   9.509 +  Comp:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c1 \<rightarrow> s1;
   9.510 +	  G\<turnstile>     s1 \<midarrow>c2 \<rightarrow> s2\<rbrakk> \<Longrightarrow>
   9.511 +				 G\<turnstile>Norm s0 \<midarrow>c1;; c2\<rightarrow> s2"
   9.512 +
   9.513 +
   9.514 +  (* cf. 14.8.2 *)
   9.515 +  If:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1;
   9.516 +	  G\<turnstile>     s1\<midarrow>(if the_Bool b then c1 else c2)\<rightarrow> s2\<rbrakk> \<Longrightarrow>
   9.517 +		       G\<turnstile>Norm s0 \<midarrow>If(e) c1 Else c2 \<rightarrow> s2"
   9.518 +
   9.519 +  (* cf. 14.10, 14.10.1 *)
   9.520 +  (*      G\<turnstile>Norm s0 \<midarrow>If(e) (c;; While(e) c) Else Skip\<rightarrow> s3 *)
   9.521 +  (* A "continue jump" from the while body c is handled by 
   9.522 +     this rule. If a continue jump with the proper label was invoked inside c
   9.523 +     this label (Cont l) is deleted out of the abrupt component of the state 
   9.524 +     before the iterative evaluation of the while statement.
   9.525 +     A "break jump" is handled by the Lab Statement (Lab l (while\<dots>).
   9.526 +  *)
   9.527 +  Loop:	"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1;
   9.528 +	  if normal s1 \<and> the_Bool b 
   9.529 +             then (G\<turnstile>s1 \<midarrow>c\<rightarrow> s2 \<and> 
   9.530 +                   G\<turnstile>(abupd (absorb (Cont l)) s2) \<midarrow>l\<bullet> While(e) c\<rightarrow> s3)
   9.531 +	     else s3 = s1\<rbrakk> \<Longrightarrow>
   9.532 +