diff --git a/thys/AI_Planning_Languages_Semantics/SASP_Checker.thy b/thys/AI_Planning_Languages_Semantics/SASP_Checker.thy
--- a/thys/AI_Planning_Languages_Semantics/SASP_Checker.thy
+++ b/thys/AI_Planning_Languages_Semantics/SASP_Checker.thy
@@ -1,347 +1,347 @@
 theory SASP_Checker
 imports SASP_Semantics
   "HOL-Library.Code_Target_Nat"
 begin
 
 section \<open>An Executable Checker for Multi-Valued Planning Problem Solutions\<close>
 
 
   subsection \<open>Auxiliary Lemmas\<close>
   lemma map_of_leI:
     assumes "distinct (map fst l)"
     assumes "\<And>k v. (k,v)\<in>set l \<Longrightarrow> m k = Some v"
     shows "map_of l \<subseteq>\<^sub>m m"  
     using assms
     by (metis (no_types, opaque_lifting) domIff map_le_def map_of_SomeD not_Some_eq)  
 
   lemma [simp]: "fst \<circ> (\<lambda>(a, b, c, d). (f a b c d, g a b c d)) = (\<lambda>(a,b,c,d). f a b c d)"
     by auto
       
   lemma map_mp: "m\<subseteq>\<^sub>mm' \<Longrightarrow> m k = Some v \<Longrightarrow> m' k = Some v"    
     by (auto simp: map_le_def dom_def)
       
       
   lemma map_add_map_of_fold: 
     fixes ps and m :: "'a \<rightharpoonup> 'b"
     assumes "distinct (map fst ps)"
     shows "m ++ map_of ps = fold (\<lambda>(k, v) m. m(k \<mapsto> v)) ps m"
   proof -
-    have X1: "fold (\<lambda>(k, v) m. m(k \<mapsto> v)) ps m(a \<mapsto> b) 
+    have X1: "(fold (\<lambda>(k, v) m. m(k \<mapsto> v)) ps m)(a \<mapsto> b) 
             = fold (\<lambda>(k, v) m. m(k \<mapsto> v)) ps (m(a \<mapsto> b))" 
       if "a \<notin> fst ` set ps"
       for a b ps and m :: "'a \<rightharpoonup> 'b"
       using that
       by (induction ps arbitrary: m) (auto simp: fun_upd_twist)
     
     show ?thesis
       using assms
       by (induction ps arbitrary: m) (auto simp: X1)
   qed    
 
   
 
   subsection \<open>Well-formedness Check\<close>
   lemmas wf_code_thms = 
       ast_problem.astDom_def ast_problem.astI_def ast_problem.astG_def ast_problem.ast\<delta>_def
       ast_problem.numVars_def ast_problem.numVals_def 
       ast_problem.wf_partial_state_def ast_problem.wf_operator_def ast_problem.well_formed_def
       
       
   declare wf_code_thms[code]
       
   export_code ast_problem.well_formed in SML
 
     
   subsection \<open>Execution\<close>  
     
   definition match_pre :: "ast_precond \<Rightarrow> state \<Rightarrow> bool" where
     "match_pre \<equiv> \<lambda>(x,v) s. s x = Some v"
     
   definition match_pres :: "ast_precond list \<Rightarrow> state \<Rightarrow> bool" where 
     "match_pres pres s \<equiv> \<forall>pre\<in>set pres. match_pre pre s"
     
   definition match_implicit_pres :: "ast_effect list \<Rightarrow> state \<Rightarrow> bool" where
     "match_implicit_pres effs s \<equiv> \<forall>(_,x,vp,_)\<in>set effs. 
       (case vp of None \<Rightarrow> True | Some v \<Rightarrow> s x = Some v)"
     
   definition enabled_opr' :: "ast_operator \<Rightarrow> state \<Rightarrow> bool" where 
     "enabled_opr' \<equiv> \<lambda>(name,pres,effs,cost) s. match_pres pres s \<and> match_implicit_pres effs s"
       
   definition eff_enabled' :: "state \<Rightarrow> ast_effect \<Rightarrow> bool" where
     "eff_enabled' s \<equiv> \<lambda>(pres,_,_,_). match_pres pres s"
     
   definition "execute_opr' \<equiv> \<lambda>(name,_,effs,_) s. 
     let effs = filter (eff_enabled' s) effs
     in fold (\<lambda>(_,x,_,v) s. s(x\<mapsto>v)) effs s
   "  
 
   definition lookup_operator' :: "ast_problem \<Rightarrow> name \<rightharpoonup> ast_operator" 
     where "lookup_operator' \<equiv> \<lambda>(D,I,G,\<delta>) name. find (\<lambda>(n,_,_,_). n=name) \<delta>"
     
   definition enabled' :: "ast_problem \<Rightarrow> name \<Rightarrow> state \<Rightarrow> bool" where
     "enabled' problem name s \<equiv> 
       case lookup_operator' problem name of 
         Some \<pi> \<Rightarrow> enabled_opr' \<pi> s
       | None \<Rightarrow> False"
 
   definition execute' :: "ast_problem \<Rightarrow> name \<Rightarrow> state \<Rightarrow> state" where
     "execute' problem name s \<equiv> 
       case lookup_operator' problem name of 
         Some \<pi> \<Rightarrow> execute_opr' \<pi> s
       | None \<Rightarrow> undefined"
     
     
   context wf_ast_problem begin  
     
     lemma match_pres_correct:
       assumes D: "distinct (map fst pres)"
       assumes "s\<in>valid_states"  
       shows "match_pres pres s \<longleftrightarrow> s\<in>subsuming_states (map_of pres)"
     proof -
       have "match_pres pres s \<longleftrightarrow> map_of pres \<subseteq>\<^sub>m s"
         unfolding match_pres_def match_pre_def
         apply (auto split: prod.splits)
         using map_le_def map_of_SomeD apply fastforce  
         by (metis (full_types) D domIff map_le_def map_of_eq_Some_iff option.simps(3))
     
       with assms show ?thesis          
         unfolding subsuming_states_def 
         by auto
     qed
        
     lemma match_implicit_pres_correct:
       assumes D: "distinct (map (\<lambda>(_, v, _, _). v) effs)"
       assumes "s\<in>valid_states"  
       shows "match_implicit_pres effs s \<longleftrightarrow> s\<in>subsuming_states (map_of (implicit_pres effs))"
     proof -
       from assms show ?thesis
         unfolding subsuming_states_def 
         unfolding match_implicit_pres_def implicit_pres_def
         apply (auto 
             split: prod.splits option.splits 
             simp: distinct_map_filter
             intro!: map_of_leI)
         apply (force simp: distinct_map_filter split: prod.split elim: map_mp)  
         done  
     qed
           
     lemma enabled_opr'_correct:
       assumes V: "s\<in>valid_states"
       assumes "lookup_operator name = Some \<pi>"  
       shows "enabled_opr' \<pi> s \<longleftrightarrow> enabled name s"  
       using lookup_operator_wf[OF assms(2)] assms
       unfolding enabled_opr'_def enabled_def wf_operator_def
       by (auto 
           simp: match_pres_correct[OF _ V] match_implicit_pres_correct[OF _ V]
           simp: wf_partial_state_def
           split: option.split
           )  
        
     lemma eff_enabled'_correct:
       assumes V: "s\<in>valid_states"
       assumes "case eff of (pres,_,_,_) \<Rightarrow> wf_partial_state pres"  
       shows "eff_enabled' s eff \<longleftrightarrow> eff_enabled s eff"  
       using assms  
       unfolding eff_enabled'_def eff_enabled_def wf_partial_state_def
       by (auto simp: match_pres_correct)  
     
     
     lemma execute_opr'_correct:
       assumes V: "s\<in>valid_states"
       assumes LO: "lookup_operator name = Some \<pi>"  
       shows "execute_opr' \<pi> s = execute name s"  
     proof (cases \<pi>)
       case [simp]: (fields name pres effs)
         
       have [simp]: "filter (eff_enabled' s) effs = filter (eff_enabled s) effs"  
         apply (rule filter_cong[OF refl])
         apply (rule eff_enabled'_correct[OF V])
         using lookup_operator_wf[OF LO]  
         unfolding wf_operator_def by auto  
           
       have X1: "distinct (map fst (map (\<lambda>(_, x, _, y). (x, y)) (filter (eff_enabled s) effs)))"
         using lookup_operator_wf[OF LO]
         unfolding wf_operator_def 
         by (auto simp: distinct_map_filter)
         
       term "filter (eff_enabled s) effs"    
           
       have [simp]: 
         "fold (\<lambda>(_, x, _, v) s. s(x \<mapsto> v)) l s =
          fold (\<lambda>(k, v) m. m(k \<mapsto> v)) (map (\<lambda>(_, x, _, y). (x, y)) l) s" 
         for l :: "ast_effect list"
         by (induction l arbitrary: s) auto
           
       show ?thesis 
         unfolding execute_opr'_def execute_def using LO
         by (auto simp: map_add_map_of_fold[OF X1])
     qed
         
       
     lemma lookup_operator'_correct: 
       "lookup_operator' problem name = lookup_operator name"
       unfolding lookup_operator'_def lookup_operator_def
       unfolding ast\<delta>_def  
       by (auto split: prod.split)  
         
     lemma enabled'_correct:
       assumes V: "s\<in>valid_states"
       shows "enabled' problem name s = enabled name s"
       unfolding enabled'_def  
       using enabled_opr'_correct[OF V]
       by (auto split: option.splits simp: enabled_def lookup_operator'_correct)  
         
     lemma execute'_correct:
       assumes V: "s\<in>valid_states"
       assumes "enabled name s"      (* Intentionally put this here, also we could resolve non-enabled case by reflexivity (undefined=undefined) *)
       shows "execute' problem name s = execute name s"  
       unfolding execute'_def  
       using execute_opr'_correct[OF V] \<open>enabled name s\<close>
       by (auto split: option.splits simp: enabled_def lookup_operator'_correct)  
         
         
         
   end    
 
   context ast_problem 
   begin  
     
     fun simulate_plan :: "plan \<Rightarrow> state \<rightharpoonup> state" where
       "simulate_plan [] s = Some s"
     | "simulate_plan (\<pi>#\<pi>s) s = (
         if enabled \<pi> s then 
           let s' = execute \<pi> s in
           simulate_plan \<pi>s s'
         else
           None
       )"  
     
     lemma simulate_plan_correct: "simulate_plan \<pi>s s = Some s' \<longleftrightarrow> path_to s \<pi>s s'"
       by (induction s \<pi>s s' rule: path_to.induct) auto  
       
     definition check_plan :: "plan \<Rightarrow> bool" where
       "check_plan \<pi>s = (
         case simulate_plan \<pi>s I of 
           None \<Rightarrow> False 
         | Some s' \<Rightarrow> s' \<in> G)"
       
     lemma check_plan_correct: "check_plan \<pi>s \<longleftrightarrow> valid_plan \<pi>s"
       unfolding check_plan_def valid_plan_def 
       by (auto split: option.split simp: simulate_plan_correct[symmetric])
       
   end  
     
   fun simulate_plan' :: "ast_problem \<Rightarrow> plan \<Rightarrow> state \<rightharpoonup> state" where
     "simulate_plan' problem [] s = Some s"
   | "simulate_plan' problem (\<pi>#\<pi>s) s = (
       if enabled' problem \<pi> s then
         let s = execute' problem \<pi> s in
         simulate_plan' problem \<pi>s s
       else
         None
     )"  
     
   text \<open>Avoiding duplicate lookup.\<close>
   (*[code]  *)  
   lemma simulate_plan'_code[code]:
     "simulate_plan' problem [] s = Some s"
     "simulate_plan' problem (\<pi>#\<pi>s) s = (
       case lookup_operator' problem \<pi> of
         None \<Rightarrow> None
       | Some \<pi> \<Rightarrow> 
           if enabled_opr' \<pi> s then 
             simulate_plan' problem \<pi>s (execute_opr' \<pi> s)
           else None
     )"
     by (auto simp: enabled'_def execute'_def split: option.split)
     
     
   definition initial_state' :: "ast_problem \<Rightarrow> state" where
     "initial_state' problem \<equiv> let astI = ast_problem.astI problem in (
        \<lambda>v. if v<length astI then Some (astI!v) else None
      )"
       
   definition check_plan' :: "ast_problem \<Rightarrow> plan \<Rightarrow> bool" where
     "check_plan' problem \<pi>s = (
       case simulate_plan' problem \<pi>s (initial_state' problem) of 
         None \<Rightarrow> False 
       | Some s' \<Rightarrow> match_pres (ast_problem.astG problem) s')"
       
       
   context wf_ast_problem 
   begin  
     
     lemma simulate_plan'_correct:
       assumes "s\<in>valid_states"
       shows "simulate_plan' problem \<pi>s s = simulate_plan \<pi>s s"
       using assms
       apply (induction \<pi>s s rule: simulate_plan.induct)
       apply (auto simp: enabled'_correct execute'_correct execute_preserves_valid)  
       done
         
     lemma simulate_plan'_correct_paper: (* For presentation in paper. 
         Summarizing intermediate refinement step. *)
       assumes "s\<in>valid_states"
       shows "simulate_plan' problem \<pi>s s = Some s'
             \<longleftrightarrow> path_to s \<pi>s s'"
       using simulate_plan'_correct[OF assms] simulate_plan_correct by simp
       
         
     lemma initial_state'_correct: 
       "initial_state' problem = I"
       unfolding initial_state'_def I_def by (auto simp: Let_def)
 
     lemma check_plan'_correct:
       "check_plan' problem \<pi>s = check_plan \<pi>s"
     proof -
       have D: "distinct (map fst astG)" using wf_goal unfolding wf_partial_state_def by auto 
         
       have S'V: "s'\<in>valid_states" if "simulate_plan \<pi>s I = Some s'" for s'
         using that by (auto simp: simulate_plan_correct path_to_pres_valid[OF I_valid])
           
       show ?thesis
         unfolding check_plan'_def check_plan_def
         by (auto 
             split: option.splits 
             simp: initial_state'_correct simulate_plan'_correct[OF I_valid]
             simp: match_pres_correct[OF D S'V] G_def
             )
     qed  
         
   end
 
     
   (* Overall checker *)  
     
   definition verify_plan :: "ast_problem \<Rightarrow> plan \<Rightarrow> String.literal + unit" where
     "verify_plan problem \<pi>s = (
       if ast_problem.well_formed problem then
         if check_plan' problem \<pi>s then Inr () else Inl (STR ''Invalid plan'')
       else Inl (STR ''Problem not well formed'')
     )"
 
   lemma verify_plan_correct:
     "verify_plan problem \<pi>s = Inr () 
     \<longleftrightarrow> ast_problem.well_formed problem \<and> ast_problem.valid_plan problem \<pi>s"
   proof -
     {
       assume "ast_problem.well_formed problem"
       then interpret wf_ast_problem by unfold_locales
           
       from check_plan'_correct check_plan_correct 
       have "check_plan' problem \<pi>s = valid_plan \<pi>s" by simp
     } 
     then show ?thesis  
       unfolding verify_plan_def
       by auto  
   qed
 
   definition nat_opt_of_integer :: "integer \<Rightarrow> nat option" where
        "nat_opt_of_integer i = (if (i \<ge> 0) then Some (nat_of_integer i) else None)"
 
   (*Export functions, which includes constructors*)
   export_code verify_plan nat_of_integer integer_of_nat nat_opt_of_integer Inl Inr String.explode String.implode
     in SML
     module_name SASP_Checker_Exported
 
 end
diff --git a/thys/Automatic_Refinement/Lib/Misc.thy b/thys/Automatic_Refinement/Lib/Misc.thy
--- a/thys/Automatic_Refinement/Lib/Misc.thy
+++ b/thys/Automatic_Refinement/Lib/Misc.thy
@@ -1,4507 +1,4507 @@
 (*  Title:       Miscellaneous Definitions and Lemmas
     Author:      Peter Lammich <peter.lammich@uni-muenster.de>
     Maintainer:  Peter Lammich <peter.lammich@uni-muenster.de>
                  Thomas Tuerk <tuerk@in.tum.de>
 *)
 
 (*
   CHANGELOG:
     2010-05-09: Removed AC, AI locales, they are superseeded by concepts
                   from OrderedGroups
     2010-09-22: Merges with ext/Aux
     2017-06-12: Added a bunch of lemmas from various other projects
 
 *)
 
 section \<open>Miscellaneous Definitions and Lemmas\<close>
 
 theory Misc
 imports Main
   "HOL-Library.Multiset"
   "HOL-ex.Quicksort"
   "HOL-Library.Option_ord"
   "HOL-Library.Infinite_Set"
   "HOL-Eisbach.Eisbach"
 begin
 text_raw \<open>\label{thy:Misc}\<close>
 
   
 subsection \<open>Isabelle Distribution Move Proposals\<close>  
 
 subsubsection \<open>Pure\<close>  
 lemma TERMI: "TERM x" unfolding Pure.term_def .
   
   
 subsubsection \<open>HOL\<close>  
 (* Stronger disjunction elimination rules. *)
 lemma disjE1: "\<lbrakk> P \<or> Q; P \<Longrightarrow> R; \<lbrakk>\<not>P;Q\<rbrakk> \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
   by metis
 lemma disjE2: "\<lbrakk> P \<or> Q; \<lbrakk>P; \<not>Q\<rbrakk> \<Longrightarrow> R; Q \<Longrightarrow> R \<rbrakk> \<Longrightarrow> R"
   by blast
 
 lemma imp_mp_iff[simp]: 
   "a \<and> (a \<longrightarrow> b) \<longleftrightarrow> a \<and> b" 
   "(a \<longrightarrow> b) \<and> a \<longleftrightarrow> a \<and> b" (* is Inductive.imp_conj_iff, but not in simpset by default *)
   by blast+
     
 lemma atomize_Trueprop_eq[atomize]: "(Trueprop x \<equiv> Trueprop y) \<equiv> Trueprop (x=y)"
   apply rule
   apply (rule)
   apply (erule equal_elim_rule1)
   apply assumption
   apply (erule equal_elim_rule2)
   apply assumption
   apply simp
   done
   
 subsubsection \<open>Set\<close>    
 lemma inter_compl_diff_conv[simp]: "A \<inter> -B = A - B" by auto
 lemma pair_set_inverse[simp]: "{(a,b). P a b}\<inverse> = {(b,a). P a b}"
   by auto
 
 lemma card_doubleton_eq_2_iff[simp]: "card {a,b} = 2 \<longleftrightarrow> a\<noteq>b" by auto
 
     
 subsubsection \<open>List\<close>  
 (* TODO: Move, analogous to List.length_greater_0_conv *) 
 thm List.length_greater_0_conv  
 lemma length_ge_1_conv[iff]: "Suc 0 \<le> length l \<longleftrightarrow> l\<noteq>[]"
   by (cases l) auto
   
 \<comment> \<open>Obtains a list from the pointwise characterization of its elements\<close>
 lemma obtain_list_from_elements:
   assumes A: "\<forall>i<n. (\<exists>li. P li i)"
   obtains l where
     "length l = n"
     "\<forall>i<n. P (l!i) i"
 proof -
   from A have "\<exists>l. length l=n \<and> (\<forall>i<n. P (l!i) i)"
   proof (induct n)
     case 0 thus ?case by simp
   next
     case (Suc n)
     then obtain l where IH: "length l = n" "(\<forall>i<n. P(l!i) i)" by auto
     moreover from Suc.prems obtain ln where "P ln n" by auto
     ultimately have "length (l@[ln]) = Suc n" "(\<forall>i<Suc n. P((l@[ln])!i) i)"
       by (auto simp add: nth_append dest: less_antisym)
     thus ?case by blast
   qed
   thus ?thesis using that by (blast)
 qed
   
 lemma distinct_sorted_mono:
   assumes S: "sorted l"
   assumes D: "distinct l"
   assumes B: "i<j" "j<length l"
   shows "l!i < l!j"
 proof -
   from S B have "l!i \<le> l!j"
     by (simp add: sorted_iff_nth_mono)
   also from nth_eq_iff_index_eq[OF D] B have "l!i \<noteq> l!j"
     by auto
   finally show ?thesis .
 qed
 
 lemma distinct_sorted_strict_mono_iff:
   assumes "distinct l" "sorted l"
   assumes "i<length l" "j<length l"
   shows "l!i<l!j \<longleftrightarrow> i<j"
   using assms
   by (metis distinct_sorted_mono leI less_le_not_le
     order.strict_iff_order)
 
 lemma distinct_sorted_mono_iff:
   assumes "distinct l" "sorted l"
   assumes "i<length l" "j<length l"
   shows "l!i\<le>l!j \<longleftrightarrow> i\<le>j"
   by (metis assms distinct_sorted_strict_mono_iff leD le_less_linear)
   
     
 (* List.thy has:
  declare map_eq_Cons_D [dest!]  Cons_eq_map_D [dest!] 
 
   We could, analogously, declare rules for "map _ _ = _@_" as dest!,
   or use elim!, or declare the _conv-rule as simp
 *)  
    
 lemma map_eq_appendE: 
   assumes "map f ls = fl@fl'"
   obtains l l' where "ls=l@l'" and "map f l=fl" and  "map f l' = fl'"
   using assms  
 proof (induction fl arbitrary: ls thesis)
   case (Cons x xs)
     then obtain l ls' where [simp]: "ls = l#ls'" "f l = x" by force
     with Cons.prems(2) have "map f ls' = xs @ fl'" by simp
     from Cons.IH[OF _ this] obtain ll ll' where "ls' = ll @ ll'" "map f ll = xs" "map f ll' = fl'" .
     with Cons.prems(1)[of "l#ll" ll'] show thesis by simp
 qed simp
 
 lemma map_eq_append_conv: "map f ls = fl@fl' \<longleftrightarrow> (\<exists>l l'. ls = l@l' \<and> map f l = fl \<and> map f l' = fl')"
   by (auto elim!: map_eq_appendE)
   
 lemmas append_eq_mapE = map_eq_appendE[OF sym]
   
 lemma append_eq_map_conv: "fl@fl' = map f ls \<longleftrightarrow> (\<exists>l l'. ls = l@l' \<and> map f l = fl \<and> map f l' = fl')"
   by (auto elim!: append_eq_mapE)
   
   
 lemma distinct_mapI: "distinct (map f l) \<Longrightarrow> distinct l"
   by (induct l) auto
     
 lemma map_distinct_upd_conv: 
   "\<lbrakk>i<length l; distinct l\<rbrakk> \<Longrightarrow> (map f l)[i := x] = map (f(l!i := x)) l"
   \<comment> \<open>Updating a mapped distinct list is equal to updating the 
     mapping function\<close>
   by (auto simp: nth_eq_iff_index_eq intro: nth_equalityI)
 
     
 lemma zip_inj: "\<lbrakk>length a = length b; length a' = length b'; zip a b = zip a' b'\<rbrakk> \<Longrightarrow> a=a' \<and> b=b'"
 proof (induct a b arbitrary: a' b' rule: list_induct2)
   case Nil
   then show ?case by (cases a'; cases b'; auto)
 next
   case (Cons x xs y ys)
   then show ?case by (cases a'; cases b'; auto)
 qed
 
 lemma zip_eq_zip_same_len[simp]:
   "\<lbrakk> length a = length b; length a' = length b' \<rbrakk> \<Longrightarrow>
   zip a b = zip a' b' \<longleftrightarrow> a=a' \<and> b=b'"
   by (auto dest: zip_inj)
     
     
 lemma upt_merge[simp]: "i\<le>j \<and> j\<le>k \<Longrightarrow> [i..<j]@[j..<k] = [i..<k]"
   by (metis le_Suc_ex upt_add_eq_append)
   
 (* Maybe this should go into List.thy, next to snoc_eq_iff_butlast *)
 lemma snoc_eq_iff_butlast':
   "(ys = xs @ [x]) \<longleftrightarrow> (ys \<noteq> [] \<and> butlast ys = xs \<and> last ys = x)"
   by auto
 
 (* Case distinction how two elements of a list can be related to each other *)
 lemma list_match_lel_lel:
   assumes "c1 @ qs # c2 = c1' @ qs' # c2'"
   obtains
     (left) c21' where "c1 = c1' @ qs' # c21'" "c2' = c21' @ qs # c2"
   | (center) "c1' = c1" "qs' = qs" "c2' = c2"
   | (right) c21 where "c1' = c1 @ qs # c21" "c2 = c21 @ qs' # c2'"
   using assms  
   apply (clarsimp simp: append_eq_append_conv2)  
   subgoal for us by (cases us) auto
   done    
     
 lemma xy_in_set_cases[consumes 2, case_names EQ XY YX]:
   assumes A: "x\<in>set l" "y\<in>set l"
   and C:
   "!!l1 l2. \<lbrakk> x=y; l=l1@y#l2 \<rbrakk> \<Longrightarrow> P"
   "!!l1 l2 l3. \<lbrakk> x\<noteq>y; l=l1@x#l2@y#l3 \<rbrakk> \<Longrightarrow> P"
   "!!l1 l2 l3. \<lbrakk> x\<noteq>y; l=l1@y#l2@x#l3 \<rbrakk> \<Longrightarrow> P"
   shows P
 proof (cases "x=y")
   case True with A(1) obtain l1 l2 where "l=l1@y#l2" by (blast dest: split_list)
   with C(1) True show ?thesis by blast
 next
   case False
   from A(1) obtain l1 l2 where S1: "l=l1@x#l2" by (blast dest: split_list)
   from A(2) obtain l1' l2' where S2: "l=l1'@y#l2'" by (blast dest: split_list)
   from S1 S2 have M: "l1@x#l2 = l1'@y#l2'" by simp
   thus P proof (cases rule: list_match_lel_lel[consumes 1, case_names 1 2 3])
     case (1 c) with S1 have "l=l1'@y#c@x#l2" by simp
     with C(3) False show ?thesis by blast
   next
     case 2 with False have False by blast
     thus ?thesis ..
   next
     case (3 c) with S1 have "l=l1@x#c@y#l2'" by simp
     with C(2) False show ?thesis by blast
   qed
 qed
     
     
 lemma list_e_eq_lel[simp]:
   "[e] = l1@e'#l2 \<longleftrightarrow> l1=[] \<and> e'=e \<and> l2=[]"
   "l1@e'#l2 = [e] \<longleftrightarrow> l1=[] \<and> e'=e \<and> l2=[]"
   apply (cases l1, auto) []
   apply (cases l1, auto) []
   done
 
 lemma list_ee_eq_leel[simp]:
   "([e1,e2] = l1@e1'#e2'#l2) \<longleftrightarrow> (l1=[] \<and> e1=e1' \<and> e2=e2' \<and> l2=[])"
   "(l1@e1'#e2'#l2 = [e1,e2]) \<longleftrightarrow> (l1=[] \<and> e1=e1' \<and> e2=e2' \<and> l2=[])"
   apply (cases l1, auto) []
   apply (cases l1, auto) []
   done
 
 
 subsubsection \<open>Transitive Closure\<close>
 
 text \<open>A point-free induction rule for elements reachable from an initial set\<close>
 lemma rtrancl_reachable_induct[consumes 0, case_names base step]:
   assumes I0: "I \<subseteq> INV"
   assumes IS: "E``INV \<subseteq> INV"
   shows "E\<^sup>*``I \<subseteq> INV"
   by (metis I0 IS Image_closed_trancl Image_mono subset_refl)
   
 
 lemma acyclic_empty[simp, intro!]: "acyclic {}" by (unfold acyclic_def) auto
 
 lemma acyclic_union:
   "acyclic (A\<union>B) \<Longrightarrow> acyclic A"
   "acyclic (A\<union>B) \<Longrightarrow> acyclic B"
   by (metis Un_upper1 Un_upper2 acyclic_subset)+
     
    
 text \<open>Here we provide a collection of miscellaneous definitions and helper lemmas\<close>
 
 subsection "Miscellaneous (1)"
 
 text \<open>This stuff is used in this theory itself, and thus occurs in first place or is simply not sorted into any other section of this theory.\<close>
 
 lemma IdD: "(a,b)\<in>Id \<Longrightarrow> a=b" by simp
 
 text \<open>Conversion Tag\<close>    
 definition [simp]: "CNV x y \<equiv> x=y"
 lemma CNV_I: "CNV x x" by simp
 lemma CNV_eqD: "CNV x y \<Longrightarrow> x=y" by simp
 lemma CNV_meqD: "CNV x y \<Longrightarrow> x\<equiv>y" by simp
    
 (* TODO: Move. Shouldn't this be detected by simproc? *)
 lemma ex_b_b_and_simp[simp]: "(\<exists>b. b \<and> Q b) \<longleftrightarrow> Q True" by auto
 lemma ex_b_not_b_and_simp[simp]: "(\<exists>b. \<not>b \<and> Q b) \<longleftrightarrow> Q False" by auto
     
 method repeat_all_new methods m = m;(repeat_all_new \<open>m\<close>)?
     
     
 subsubsection "AC-operators"
 
 text \<open>Locale to declare AC-laws as simplification rules\<close>
 locale Assoc =
   fixes f
   assumes assoc[simp]: "f (f x y) z = f x (f y z)"
 
 locale AC = Assoc +
   assumes commute[simp]: "f x y = f y x"
 
 lemma (in AC) left_commute[simp]: "f x (f y z) = f y (f x z)"
   by (simp only: assoc[symmetric]) simp
 
 lemmas (in AC) AC_simps = commute assoc left_commute
 
 text \<open>Locale to define functions from surjective, unique relations\<close>
 locale su_rel_fun =
   fixes F and f
   assumes unique: "\<lbrakk>(A,B)\<in>F; (A,B')\<in>F\<rbrakk> \<Longrightarrow> B=B'"
   assumes surjective: "\<lbrakk>!!B. (A,B)\<in>F \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   assumes f_def: "f A == THE B. (A,B)\<in>F"
 
 lemma (in su_rel_fun) repr1: "(A,f A)\<in>F" proof (unfold f_def)
   obtain B where "(A,B)\<in>F" by (rule surjective)
   with theI[where P="\<lambda>B. (A,B)\<in>F", OF this] show "(A, THE x. (A, x) \<in> F) \<in> F" by (blast intro: unique)
 qed
 
 lemma (in su_rel_fun) repr2: "(A,B)\<in>F \<Longrightarrow> B=f A" using repr1
   by (blast intro: unique)
 
 lemma (in su_rel_fun) repr: "(f A = B) = ((A,B)\<in>F)" using repr1 repr2
   by (blast)
 
     \<comment> \<open>Contract quantification over two variables to pair\<close>
 lemma Ex_prod_contract: "(\<exists>a b. P a b) \<longleftrightarrow> (\<exists>z. P (fst z) (snd z))"
   by auto
 
 lemma All_prod_contract: "(\<forall>a b. P a b) \<longleftrightarrow> (\<forall>z. P (fst z) (snd z))"
   by auto
 
 
 lemma nat_geq_1_eq_neqz: "x\<ge>1 \<longleftrightarrow> x\<noteq>(0::nat)"
   by auto
 
 lemma nat_in_between_eq:
   "(a<b \<and> b\<le>Suc a) \<longleftrightarrow> b = Suc a"
   "(a\<le>b \<and> b<Suc a) \<longleftrightarrow> b = a"
   by auto
 
 lemma Suc_n_minus_m_eq: "\<lbrakk> n\<ge>m; m>1 \<rbrakk> \<Longrightarrow> Suc (n - m) = n - (m - 1)"
   by simp
 
 lemma Suc_to_right: "Suc n = m \<Longrightarrow> n = m - Suc 0" by simp
 lemma Suc_diff[simp]: "\<And>n m. n\<ge>m \<Longrightarrow> m\<ge>1 \<Longrightarrow> Suc (n - m) = n - (m - 1)"
   by simp
 
 lemma if_not_swap[simp]: "(if \<not>c then a else b) = (if c then b else a)" by auto
 lemma all_to_meta: "Trueprop (\<forall>a. P a) \<equiv> (\<And>a. P a)"
   apply rule
   by auto
 
 lemma imp_to_meta: "Trueprop (P\<longrightarrow>Q) \<equiv> (P\<Longrightarrow>Q)"
   apply rule
   by auto
 
 
 (* for some reason, there is no such rule in HOL *)
 lemma iffI2: "\<lbrakk>P \<Longrightarrow> Q; \<not> P \<Longrightarrow> \<not> Q\<rbrakk> \<Longrightarrow> P \<longleftrightarrow> Q"
 by metis
 
 lemma iffExI:
   "\<lbrakk> \<And>x. P x \<Longrightarrow> Q x; \<And>x. Q x \<Longrightarrow> P x \<rbrakk> \<Longrightarrow> (\<exists>x. P x) \<longleftrightarrow> (\<exists>x. Q x)"
 by metis
 
 lemma bex2I[intro?]: "\<lbrakk> (a,b)\<in>S; (a,b)\<in>S \<Longrightarrow> P a b \<rbrakk> \<Longrightarrow> \<exists>a b. (a,b)\<in>S \<and> P a b"
   by blast
 
     
 (* TODO: Move lemma to HOL! *)  
 lemma cnv_conj_to_meta: "(P \<and> Q \<Longrightarrow> PROP X) \<equiv> (\<lbrakk>P;Q\<rbrakk> \<Longrightarrow> PROP X)"
   by (rule BNF_Fixpoint_Base.conj_imp_eq_imp_imp)
     
     
 
 subsection \<open>Sets\<close>
   lemma remove_subset: "x\<in>S \<Longrightarrow> S-{x} \<subset> S" by auto
 
   lemma subset_minus_empty: "A\<subseteq>B \<Longrightarrow> A-B = {}" by auto
 
   lemma insert_minus_eq: "x\<noteq>y \<Longrightarrow> insert x A - {y} = insert x (A - {y})" by auto
       
   lemma set_notEmptyE: "\<lbrakk>S\<noteq>{}; !!x. x\<in>S \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
     by (metis equals0I)
 
   lemma subset_Collect_conv: "S \<subseteq> Collect P \<longleftrightarrow> (\<forall>x\<in>S. P x)"
     by auto
 
   lemma memb_imp_not_empty: "x\<in>S \<Longrightarrow> S\<noteq>{}"
     by auto
 
   lemma disjoint_mono: "\<lbrakk> a\<subseteq>a'; b\<subseteq>b'; a'\<inter>b'={} \<rbrakk> \<Longrightarrow> a\<inter>b={}" by auto
 
   lemma disjoint_alt_simp1: "A-B = A \<longleftrightarrow> A\<inter>B = {}" by auto
   lemma disjoint_alt_simp2: "A-B \<noteq> A \<longleftrightarrow> A\<inter>B \<noteq> {}" by auto
   lemma disjoint_alt_simp3: "A-B \<subset> A \<longleftrightarrow> A\<inter>B \<noteq> {}" by auto
 
   lemma disjointI[intro?]: "\<lbrakk> \<And>x. \<lbrakk>x\<in>a; x\<in>b\<rbrakk> \<Longrightarrow> False \<rbrakk> \<Longrightarrow> a\<inter>b={}"
     by auto
 
 
   lemmas set_simps = subset_minus_empty disjoint_alt_simp1 disjoint_alt_simp2 disjoint_alt_simp3 Un_absorb1 Un_absorb2
 
   lemma set_minus_singleton_eq: "x\<notin>X \<Longrightarrow> X-{x} = X"
     by auto
 
   lemma set_diff_diff_left: "A-B-C = A-(B\<union>C)"
     by auto
 
 
   lemma image_update[simp]: "x\<notin>A \<Longrightarrow> f(x:=n)`A = f`A"
     by auto
 
   lemma eq_or_mem_image_simp[simp]: "{f l |l. l = a \<or> l\<in>B} = insert (f a) {f l|l. l\<in>B}" by blast
       
   lemma set_union_code [code_unfold]:
     "set xs \<union> set ys = set (xs @ ys)"
     by auto
 
   lemma in_fst_imageE:
     assumes "x \<in> fst`S"
     obtains y where "(x,y)\<in>S"
     using assms by auto
 
   lemma in_snd_imageE:
     assumes "y \<in> snd`S"
     obtains x where "(x,y)\<in>S"
     using assms by auto
 
   lemma fst_image_mp: "\<lbrakk>fst`A \<subseteq> B; (x,y)\<in>A \<rbrakk> \<Longrightarrow> x\<in>B"
     by (metis Domain.DomainI fst_eq_Domain in_mono)
 
   lemma snd_image_mp: "\<lbrakk>snd`A \<subseteq> B; (x,y)\<in>A \<rbrakk> \<Longrightarrow> y\<in>B"
     by (metis Range.intros rev_subsetD snd_eq_Range)
 
   lemma inter_eq_subsetI: "\<lbrakk> S\<subseteq>S'; A\<inter>S' = B\<inter>S' \<rbrakk> \<Longrightarrow> A\<inter>S = B\<inter>S"
     by auto
 
 text \<open>
   Decompose general union over sum types.
 \<close>
 lemma Union_plus:
   "(\<Union> x \<in> A <+> B. f x) = (\<Union> a \<in> A. f (Inl a)) \<union> (\<Union>b \<in> B. f (Inr b))"
 by auto
 
 lemma Union_sum:
   "(\<Union>x. f (x::'a+'b)) = (\<Union>l. f (Inl l)) \<union> (\<Union>r. f (Inr r))"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<Union>x \<in> UNIV <+> UNIV. f x)"
     by simp
   thus ?thesis
     by (simp only: Union_plus)
 qed
 
   
 
 
   subsubsection \<open>Finite Sets\<close>
 
   lemma card_1_singletonI: "\<lbrakk>finite S; card S = 1; x\<in>S\<rbrakk> \<Longrightarrow> S={x}"
   proof (safe, rule ccontr, goal_cases)
     case prems: (1 x')
     hence "finite (S-{x})" "S-{x} \<noteq> {}" by auto
     hence "card (S-{x}) \<noteq> 0" by auto
     moreover from prems(1-3) have "card (S-{x}) = 0" by auto
     ultimately have False by simp
     thus ?case ..
   qed
 
   lemma card_insert_disjoint': "\<lbrakk>finite A; x \<notin> A\<rbrakk> \<Longrightarrow> card (insert x A) - Suc 0 = card A"
     by (drule (1) card_insert_disjoint) auto
 
   lemma card_eq_UNIV[simp]: "card (S::'a::finite set) = card (UNIV::'a set) \<longleftrightarrow> S=UNIV"
   proof (auto)
     fix x
     assume A: "card S = card (UNIV::'a set)"
     show "x\<in>S" proof (rule ccontr)
       assume "x\<notin>S" hence "S\<subset>UNIV" by auto
       with psubset_card_mono[of UNIV S] have "card S < card (UNIV::'a set)" by auto
       with A show False by simp
     qed
   qed
 
   lemma card_eq_UNIV2[simp]: "card (UNIV::'a set) = card (S::'a::finite set) \<longleftrightarrow> S=UNIV"
     using card_eq_UNIV[of S] by metis
 
   lemma card_ge_UNIV[simp]: "card (UNIV::'a::finite set) \<le> card (S::'a set) \<longleftrightarrow> S=UNIV"
     using card_mono[of "UNIV::'a::finite set" S, simplified]
     by auto
 
   lemmas length_remdups_card = length_remdups_concat[of "[l]", simplified] for l
 
   lemma fs_contract: "fst ` { p | p. f (fst p) (snd p) \<in> S } = { a . \<exists>b. f a b \<in> S }"
     by (simp add: image_Collect)
 
 lemma finite_Collect: "finite S \<Longrightarrow> inj f \<Longrightarrow> finite {a. f a : S}"
 by(simp add: finite_vimageI vimage_def[symmetric])
 
   \<comment> \<open>Finite sets have an injective mapping to an initial segments of the
       natural numbers\<close>
   (* This lemma is also in the standard library (from Isabelle2009-1 on)
       as @{thm [source] Finite_Set.finite_imp_inj_to_nat_seg}. However, it is formulated with HOL's
       \<exists> there rather then with the meta-logic obtain *)
   lemma finite_imp_inj_to_nat_seg':
     fixes A :: "'a set"
     assumes A: "finite A"
     obtains f::"'a \<Rightarrow> nat" and n::"nat" where
       "f`A = {i. i<n}"
       "inj_on f A"
     by (metis A finite_imp_inj_to_nat_seg)
 
   lemma lists_of_len_fin1: "finite P \<Longrightarrow> finite (lists P \<inter> { l. length l = n })"
   proof (induct n)
     case 0 thus ?case by auto
   next
     case (Suc n)
     have "lists P \<inter> { l. length l = Suc n }
           = (\<lambda>(a,l). a#l) ` (P \<times> (lists P \<inter> {l. length l = n}))"
       apply auto
       apply (case_tac x)
       apply auto
       done
     moreover from Suc have "finite \<dots>" by auto
     ultimately show ?case by simp
   qed
 
   lemma lists_of_len_fin2: "finite P \<Longrightarrow> finite (lists P \<inter> { l. n = length l })"
   proof -
     assume A: "finite P"
     have S: "{ l. n = length l } = { l. length l = n }" by auto
     have "finite (lists P \<inter> { l. n = length l })
       \<longleftrightarrow> finite (lists P \<inter> { l. length l = n })"
       by (subst S) simp
 
     thus ?thesis using lists_of_len_fin1[OF A] by auto
   qed
 
   lemmas lists_of_len_fin = lists_of_len_fin1 lists_of_len_fin2
 
 
   (* Try (simp only: cset_fin_simps, fastforce intro: cset_fin_intros) when reasoning about finiteness of collected sets *)
   lemmas cset_fin_simps = Ex_prod_contract fs_contract[symmetric] image_Collect[symmetric]
   lemmas cset_fin_intros = finite_imageI finite_Collect inj_onI
 
 
 lemma Un_interval:
   fixes b1 :: "'a::linorder"
   assumes "b1\<le>b2" and "b2\<le>b3"
   shows "{ f i | i. b1\<le>i \<and> i<b2 } \<union> { f i | i. b2\<le>i \<and> i<b3 }
     = {f i | i. b1\<le>i \<and> i<b3}"
   using assms
   apply -
   apply rule
   apply safe []
   apply (rule_tac x=i in exI, auto) []
   apply (rule_tac x=i in exI, auto) []
   apply rule
   apply simp
   apply (elim exE, simp)
   apply (case_tac "i<b2")
   apply (rule disjI1)
   apply (rule_tac x=i in exI, auto) []
   apply (rule disjI2)
   apply (rule_tac x=i in exI, auto) []
   done
 
 text \<open>
   The standard library proves that a generalized union is finite
   if the index set is finite and if for every index the component
   set is itself finite. Conversely, we show that every component
   set must be finite when the union is finite.
 \<close>
 lemma finite_UNION_then_finite:
   "finite (\<Union>(B ` A)) \<Longrightarrow> a \<in> A \<Longrightarrow> finite (B a)"
 by (metis Set.set_insert UN_insert Un_infinite)
 
 lemma finite_if_eq_beyond_finite: "finite S \<Longrightarrow> finite {s. s - S = s' - S}"
 proof (rule finite_subset[where B="(\<lambda>s. s \<union> (s' - S)) ` Pow S"], clarsimp)
   fix s
   have "s = (s \<inter> S) \<union> (s - S)"
     by auto
   also assume "s - S = s' - S"
   finally show "s \<in> (\<lambda>s. s \<union> (s' - S)) ` Pow S" by blast
 qed blast
 
 lemma distinct_finite_subset:
   assumes "finite x"
   shows "finite {ys. set ys \<subseteq> x \<and> distinct ys}" (is "finite ?S")
 proof (rule finite_subset)
   from assms show "?S \<subseteq> {ys. set ys \<subseteq> x \<and> length ys \<le> card x}"
     by clarsimp (metis distinct_card card_mono)
   from assms show "finite ..." by (rule finite_lists_length_le)
 qed
 
 lemma distinct_finite_set:
   shows "finite {ys. set ys = x \<and> distinct ys}" (is "finite ?S")
 proof (cases "finite x")
   case False hence "{ys. set ys = x} = {}" by auto
   thus ?thesis by simp
 next
   case True show ?thesis
   proof (rule finite_subset)
     show "?S \<subseteq> {ys. set ys \<subseteq> x \<and> length ys \<le> card x}"
       using distinct_card by force
     from True show "finite ..." by (rule finite_lists_length_le)
   qed
 qed
 
 lemma finite_set_image:
   assumes f: "finite (set ` A)"
   and dist: "\<And>xs. xs \<in> A \<Longrightarrow> distinct xs"
   shows "finite A"
 proof (rule finite_subset)
   from f show "finite (set -` (set ` A) \<inter> {xs. distinct xs})"
   proof (induct rule: finite_induct)
     case (insert x F)
     have "finite (set -` {x} \<inter> {xs. distinct xs})"
       apply (simp add: vimage_def)
       by (metis Collect_conj_eq distinct_finite_set)
     with insert show ?case
       apply (subst vimage_insert)
       apply (subst Int_Un_distrib2)
       apply (rule finite_UnI)
         apply simp_all
       done
   qed simp
   moreover from dist show "A \<subseteq> ..."
     by (auto simp add: vimage_image_eq)
 qed
 
 
 subsubsection \<open>Infinite Set\<close>
 lemma INFM_nat_inductI:
   assumes P0: "P (0::nat)"
   assumes PS: "\<And>i. P i \<Longrightarrow> \<exists>j>i. P j \<and> Q j"
   shows "\<exists>\<^sub>\<infinity>i. Q i"
 proof -
   have "\<forall>i. \<exists>j>i. P j \<and> Q j" proof
     fix i
     show "\<exists>j>i. P j \<and> Q j"
       apply (induction i)
       using PS[OF P0] apply auto []
       by (metis PS Suc_lessI)
   qed
   thus ?thesis unfolding INFM_nat by blast
 qed
 
 subsection \<open>Functions\<close>
 
 lemma fun_neq_ext_iff: "m\<noteq>m' \<longleftrightarrow> (\<exists>x. m x \<noteq> m' x)" by auto  
 
 definition "inv_on f A x == SOME y. y\<in>A \<and> f y = x"
 
 lemma inv_on_f_f[simp]: "\<lbrakk>inj_on f A; x\<in>A\<rbrakk> \<Longrightarrow> inv_on f A (f x) = x"
   by (auto simp add: inv_on_def inj_on_def)
 
 lemma f_inv_on_f: "\<lbrakk> y\<in>f`A \<rbrakk> \<Longrightarrow> f (inv_on f A y) = y"
   by (auto simp add: inv_on_def intro: someI2)
 
 lemma inv_on_f_range: "\<lbrakk> y \<in> f`A \<rbrakk> \<Longrightarrow> inv_on f A y \<in> A"
   by (auto simp add: inv_on_def intro: someI2)
 
 lemma inj_on_map_inv_f [simp]: "\<lbrakk>set l \<subseteq> A; inj_on f A\<rbrakk> \<Longrightarrow> map (inv_on f A) (map f l) = l"
   apply (simp)
   apply (induct l)
   apply auto
   done
 
 lemma comp_cong_right: "x = y \<Longrightarrow> f o x = f o y" by (simp)
 lemma comp_cong_left: "x = y \<Longrightarrow> x o f = y o f" by (simp)
 
 lemma fun_comp_eq_conv: "f o g = fg \<longleftrightarrow> (\<forall>x. f (g x) = fg x)"
   by auto
 
 abbreviation comp2 (infixl "oo" 55) where "f oo g \<equiv> \<lambda>x. f o (g x)"
 abbreviation comp3 (infixl "ooo" 55) where "f ooo g \<equiv> \<lambda>x. f oo (g x)"
 
 notation
   comp2  (infixl "\<circ>\<circ>" 55) and
   comp3  (infixl "\<circ>\<circ>\<circ>" 55)
 
 definition [code_unfold, simp]: "swap_args2 f x y \<equiv> f y x"
   
 
 subsection \<open>Multisets\<close>
 
 (*
   The following is a syntax extension for multisets. Unfortunately, it depends on a change in the Library/Multiset.thy, so it is commented out here, until it will be incorporated
   into Library/Multiset.thy by its maintainers.
 
   The required change in Library/Multiset.thy is removing the syntax for single:
      - single :: "'a => 'a multiset"    ("{#_#}")
      + single :: "'a => 'a multiset"
 
   And adding the following translations instead:
 
      + syntax
      + "_multiset" :: "args \<Rightarrow> 'a multiset" ("{#(_)#}")
 
      + translations
      +   "{#x, xs#}" == "{#x#} + {#xs#}"
      +   "{# x #}" == "single x"
 
   This translates "{# \<dots> #}" into a sum of singletons, that is parenthesized to the right. ?? Can we also achieve left-parenthesizing ??
 
 *)
 
 
   (* Let's try what happens if declaring AC-rules for multiset union as simp-rules *)
 (*declare union_ac[simp] -- don't do it !*)
 
 
 lemma count_mset_set_finite_iff:
   "finite S \<Longrightarrow> count (mset_set S) a = (if a \<in> S then 1 else 0)"
   by simp
 
 lemma ex_Melem_conv: "(\<exists>x. x \<in># A) = (A \<noteq> {#})"
   by (simp add: ex_in_conv)
 
 subsubsection \<open>Count\<close>
         lemma count_ne_remove: "\<lbrakk> x ~= t\<rbrakk> \<Longrightarrow> count S x = count (S-{#t#}) x"
           by (auto)
   lemma mset_empty_count[simp]: "(\<forall>p. count M p = 0) = (M={#})"
     by (auto simp add: multiset_eq_iff)
 
 subsubsection \<open>Union, difference and intersection\<close>
 
   lemma size_diff_se: "t \<in># S \<Longrightarrow> size S = size (S - {#t#}) + 1" proof (unfold size_multiset_overloaded_eq)
                 let ?SIZE = "sum (count S) (set_mset S)"
                 assume A: "t \<in># S"
                 from A have SPLITPRE: "finite (set_mset S) & {t}\<subseteq>(set_mset S)" by auto
                 hence "?SIZE = sum (count S) (set_mset S - {t}) + sum (count S) {t}" by (blast dest: sum.subset_diff)
                 hence "?SIZE = sum (count S) (set_mset S - {t}) + count (S) t" by auto
                 moreover with A have "count S t = count (S-{#t#}) t + 1" by auto
                 ultimately have D: "?SIZE = sum (count S) (set_mset S - {t}) + count (S-{#t#}) t + 1" by (arith)
                 moreover have "sum (count S) (set_mset S - {t}) = sum (count (S-{#t#})) (set_mset S - {t})" proof -
                         have "\<forall>x\<in>(set_mset S - {t}). count S x = count (S-{#t#}) x" by (auto iff add: count_ne_remove)
                         thus ?thesis by simp
                 qed
                 ultimately have D: "?SIZE = sum (count (S-{#t#})) (set_mset S - {t}) + count (S-{#t#}) t + 1" by (simp)
                 moreover
                 { assume CASE: "t \<notin># S - {#t#}"
                         from CASE have "set_mset S - {t} = set_mset (S - {#t#})"
                           by (auto simp add: in_diff_count split: if_splits)
                         with CASE D have "?SIZE = sum (count (S-{#t#})) (set_mset (S - {#t#})) + 1"
                           by (simp add: not_in_iff)
                 }
                 moreover
                 { assume CASE: "t \<in># S - {#t#}"
                         from CASE have "t \<in># S" by (rule in_diffD)
                         with CASE have 1: "set_mset S = set_mset (S-{#t#})"
                           by (auto simp add: in_diff_count split: if_splits)
                         moreover from D have "?SIZE = sum (count (S-{#t#})) (set_mset S - {t}) + sum (count (S-{#t#})) {t} + 1" by simp
                         moreover from SPLITPRE sum.subset_diff have "sum (count (S-{#t#})) (set_mset S) = sum (count (S-{#t#})) (set_mset S - {t}) + sum (count (S-{#t#})) {t}" by (blast)
                         ultimately have "?SIZE = sum (count (S-{#t#})) (set_mset (S-{#t#})) + 1" by simp
                 }
                 ultimately show "?SIZE = sum (count (S-{#t#})) (set_mset (S - {#t#})) + 1" by blast
         qed
 
   (* TODO: Check whether this proof can be done simpler *)
   lemma mset_union_diff_comm: "t \<in># S \<Longrightarrow> T + (S - {#t#}) = (T + S) - {#t#}" proof -
     assume "t \<in># S"
     then obtain S' where S: "S = add_mset t S'"
       by (metis insert_DiffM)
     then show ?thesis
       by auto
   qed
 
 (*  lemma mset_diff_diff_left: "A-B-C = A-((B::'a multiset)+C)" proof -
     have "\<forall>e . count (A-B-C) e = count (A-(B+C)) e" by auto
     thus ?thesis by (simp add: multiset_eq_conv_count_eq)
   qed
 
   lemma mset_diff_commute: "A-B-C = A-C-(B::'a multiset)" proof -
     have "A-B-C = A-(B+C)" by (simp add: mset_diff_diff_left)
     also have "\<dots> = A-(C+B)" by (simp add: union_commute)
     thus ?thesis by (simp add: mset_diff_diff_left)
   qed
 
   lemma mset_diff_same_empty[simp]: "(S::'a multiset) - S = {#}"
   proof -
     have "\<forall>e . count (S-S) e = 0" by auto
     hence "\<forall>e . ~ (e : set_mset (S-S))" by auto
     hence "set_mset (S-S) = {}" by blast
     thus ?thesis by (auto)
   qed
 *)
     
   lemma mset_right_cancel_union: "\<lbrakk>a \<in># A+B; ~(a \<in># B)\<rbrakk> \<Longrightarrow> a\<in>#A"
     by (simp)
   lemma mset_left_cancel_union: "\<lbrakk>a \<in># A+B; ~(a \<in># A)\<rbrakk> \<Longrightarrow> a\<in>#B"
     by (simp)
 
   lemmas mset_cancel_union = mset_right_cancel_union mset_left_cancel_union
 
   lemma mset_right_cancel_elem: "\<lbrakk>a \<in># A+{#b#}; a~=b\<rbrakk> \<Longrightarrow> a\<in>#A"
     by simp
 
   lemma mset_left_cancel_elem: "\<lbrakk>a \<in># {#b#}+A; a~=b\<rbrakk> \<Longrightarrow> a\<in>#A"
     by simp
 
   lemmas mset_cancel_elem = mset_right_cancel_elem mset_left_cancel_elem
 
   lemma mset_diff_cancel1elem[simp]: "~(a \<in># B) \<Longrightarrow> {#a#}-B = {#a#}"
     by (auto simp add: not_in_iff intro!: multiset_eqI)
 
 (*  lemma diff_union_inverse[simp]: "A + B - B = (A::'a multiset)"
     by (auto iff add: multiset_eq_conv_count_eq)
 
   lemma diff_union_inverse2[simp]: "B + A - B = (A::'a multiset)"
     by (auto iff add: multiset_eq_conv_count_eq)
 *)
   (*lemma union_diff_assoc_se2: "t \<in># A \<Longrightarrow> (A+B)-{#t#} = (A-{#t#}) + B"
     by (auto iff add: multiset_eq_conv_count_eq)
   lemmas union_diff_assoc_se = union_diff_assoc_se1 union_diff_assoc_se2*)
 
         lemma union_diff_assoc: "C-B={#} \<Longrightarrow> (A+B)-C = A + (B-C)"
           by (simp add: multiset_eq_iff)
 
   lemmas mset_neutral_cancel1 = union_left_cancel[where N="{#}", simplified] union_right_cancel[where N="{#}", simplified]
   declare mset_neutral_cancel1[simp]
 
   lemma mset_union_2_elem: "{#a, b#} = add_mset c M \<Longrightarrow> {#a#}=M & b=c | a=c & {#b#}=M"
     by (auto simp: add_eq_conv_diff)
 
   lemma mset_un_cases[cases set, case_names left right]:
     "\<lbrakk>a \<in># A + B; a \<in># A \<Longrightarrow> P; a \<in># B \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
     by (auto)
 
   lemma mset_unplusm_dist_cases[cases set, case_names left right]:
     assumes A: "{#s#}+A = B+C"
     assumes L: "\<lbrakk>B={#s#}+(B-{#s#}); A=(B-{#s#})+C\<rbrakk> \<Longrightarrow> P"
     assumes R: "\<lbrakk>C={#s#}+(C-{#s#}); A=B+(C-{#s#})\<rbrakk> \<Longrightarrow> P"
     shows P
   proof -
     from A[symmetric] have "s \<in># B+C" by simp
     thus ?thesis proof (cases rule: mset_un_cases)
       case left hence 1: "B={#s#}+(B-{#s#})" by simp
       with A have "{#s#}+A = {#s#}+((B-{#s#})+C)" by (simp add: union_ac)
       hence 2: "A = (B-{#s#})+C" by (simp)
       from L[OF 1 2] show ?thesis .
     next
       case right hence 1: "C={#s#}+(C-{#s#})" by simp
       with A have "{#s#}+A = {#s#}+(B+(C-{#s#}))" by (simp add: union_ac)
       hence 2: "A = B+(C-{#s#})" by (simp)
       from R[OF 1 2] show ?thesis .
     qed
   qed
 
   lemma mset_unplusm_dist_cases2[cases set, case_names left right]:
     assumes A: "B+C = {#s#}+A"
     assumes L: "\<lbrakk>B={#s#}+(B-{#s#}); A=(B-{#s#})+C\<rbrakk> \<Longrightarrow> P"
     assumes R: "\<lbrakk>C={#s#}+(C-{#s#}); A=B+(C-{#s#})\<rbrakk> \<Longrightarrow> P"
     shows P
     using mset_unplusm_dist_cases[OF A[symmetric]] L R by blast
 
   lemma mset_single_cases[cases set, case_names loc env]:
     assumes A: "add_mset s c = add_mset r' c'"
     assumes CASES: "\<lbrakk>s=r'; c=c'\<rbrakk> \<Longrightarrow> P" "\<lbrakk>c'={#s#}+(c'-{#s#}); c={#r'#}+(c-{#r'#}); c-{#r'#} = c'-{#s#} \<rbrakk> \<Longrightarrow> P"
     shows "P"
   proof -
     { assume CASE: "s=r'"
       with A have "c=c'" by simp
       with CASE CASES have ?thesis by auto
     } moreover {
       assume CASE: "s\<noteq>r'"
       have "s \<in># {#s#}+c" by simp
       with A have "s \<in># {#r'#}+c'" by simp
       with CASE have "s \<in># c'" by simp
       hence 1: "c' = {#s#} + (c' - {#s#})" by simp
       with A have "{#s#}+c = {#s#}+({#r'#}+(c' - {#s#}))" by (auto simp add: union_ac)
       hence 2: "c={#r'#}+(c' - {#s#})" by (auto)
       hence 3: "c-{#r'#} = (c' - {#s#})" by auto
       from 1 2 3 CASES have ?thesis by auto
     } ultimately show ?thesis by blast
   qed
 
   lemma mset_single_cases'[cases set, case_names loc env]:
     assumes A: "add_mset s c = add_mset r' c'"
     assumes CASES: "\<lbrakk>s=r'; c=c'\<rbrakk> \<Longrightarrow> P" "!!cc. \<lbrakk>c'={#s#}+cc; c={#r'#}+cc; c'-{#s#}=cc; c-{#r'#}=cc\<rbrakk> \<Longrightarrow> P"
     shows "P"
     using A  CASES by (auto elim!: mset_single_cases)
 
   lemma mset_single_cases2[cases set, case_names loc env]:
     assumes A: "add_mset s c = add_mset r' c'"
     assumes CASES: "\<lbrakk>s=r'; c=c'\<rbrakk> \<Longrightarrow> P" "\<lbrakk>c'=(c'-{#s#})+{#s#}; c=(c-{#r'#})+{#r'#}; c-{#r'#} = c'-{#s#} \<rbrakk> \<Longrightarrow> P"
     shows "P"
   proof -
     from A have "add_mset s c = add_mset r' c'" by (simp add: union_ac)
     thus ?thesis using CASES by (cases rule: mset_single_cases) simp_all
   qed
 
   lemma mset_single_cases2'[cases set, case_names loc env]:
     assumes A: "add_mset s c = add_mset r' c'"
     assumes CASES: "\<lbrakk>s=r'; c=c'\<rbrakk> \<Longrightarrow> P" "!!cc. \<lbrakk>c'=cc+{#s#}; c=cc+{#r'#}; c'-{#s#}=cc; c-{#r'#}=cc\<rbrakk> \<Longrightarrow> P"
     shows "P"
     using A  CASES by (auto elim!: mset_single_cases2)
 
   lemma mset_un_single_un_cases [consumes 1, case_names left right]:
     assumes A: "add_mset a A = B + C"
       and CASES: "a \<in># B \<Longrightarrow> A = (B - {#a#}) + C \<Longrightarrow> P"
         "a \<in># C \<Longrightarrow> A = B + (C - {#a#}) \<Longrightarrow> P" shows "P"
   proof -
     have "a \<in># A+{#a#}" by simp
     with A have "a \<in># B+C" by auto
     thus ?thesis proof (cases rule: mset_un_cases)
       case left hence "B=B-{#a#}+{#a#}" by auto
       with A have "A+{#a#} = (B-{#a#})+C+{#a#}" by (auto simp add: union_ac)
       hence "A=(B-{#a#})+C" by simp
       with CASES(1)[OF left] show ?thesis by blast
     next
       case right hence "C=C-{#a#}+{#a#}" by auto
       with A have "A+{#a#} = B+(C-{#a#})+{#a#}" by (auto simp add: union_ac)
       hence "A=B+(C-{#a#})" by simp
       with CASES(2)[OF right] show ?thesis by blast
     qed
   qed
 
       (* TODO: Can this proof be done more automatically ? *)
   lemma mset_distrib[consumes 1, case_names dist]: assumes A: "(A::'a multiset)+B = M+N" "!!Am An Bm Bn. \<lbrakk>A=Am+An; B=Bm+Bn; M=Am+Bm; N=An+Bn\<rbrakk> \<Longrightarrow> P" shows "P"
   proof -
     have BN_MA: "B - N = M - A"
       by (metis (no_types) add_diff_cancel_right assms(1) union_commute)
     have H: "A = A\<inter># C + (A - C) \<inter># D" if "A + B = C + D" for A B C D :: "'a multiset"
       by (metis add.commute diff_intersect_left_idem mset_subset_eq_add_left subset_eq_diff_conv
           subset_mset.add_diff_inverse subset_mset.inf_absorb1 subset_mset.inf_le1 that)
     have A': "A = A\<inter># M + (A - M) \<inter># N"
       using A(1) H by blast
     moreover have B': "B = (B - N) \<inter># M + B\<inter># N"
       using A(1) H[of B A N M] by (auto simp: ac_simps)
     moreover have "M = A \<inter># M + (B - N) \<inter># M"
       using H[of M N A B] BN_MA[symmetric] A(1) by (metis (no_types) diff_intersect_left_idem
           diff_union_cancelR multiset_inter_commute subset_mset.diff_add subset_mset.inf.cobounded1
           union_commute)
     moreover have "N = (A - M) \<inter># N + B \<inter># N"
       by (metis A' assms(1) diff_union_cancelL inter_union_distrib_left inter_union_distrib_right
           mset_subset_eq_multiset_union_diff_commute subset_mset.inf.cobounded1 subset_mset.inf.commute)
     ultimately show P
       using A(2) by blast
   qed
 
 
 subsubsection \<open>Singleton multisets\<close>
 
 lemma mset_size_le1_cases[case_names empty singleton,consumes 1]: "\<lbrakk> size M \<le> Suc 0; M={#} \<Longrightarrow> P; !!m. M={#m#} \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   by (cases M) auto
 
 lemma diff_union_single_conv2: "a \<in># J \<Longrightarrow> J + I - {#a#} = (J - {#a#}) + I"
   by simp
 
 lemmas diff_union_single_convs = diff_union_single_conv diff_union_single_conv2
 
 lemma mset_contains_eq: "(m \<in># M) = ({#m#}+(M-{#m#})=M)"
   using diff_single_trivial by fastforce
 
 
 subsubsection \<open>Pointwise ordering\<close>
 
 
   (*declare mset_le_trans[trans] Seems to be in there now. Why is this not done in Multiset.thy or order-class ? *)
 
   lemma mset_le_incr_right1: "a\<subseteq>#(b::'a multiset) \<Longrightarrow> a\<subseteq>#b+c" using mset_subset_eq_mono_add[of a b "{#}" c, simplified] .
   lemma mset_le_incr_right2: "a\<subseteq>#(b::'a multiset) \<Longrightarrow> a\<subseteq>#c+b" using mset_le_incr_right1
     by (auto simp add: union_commute)
   lemmas mset_le_incr_right = mset_le_incr_right1 mset_le_incr_right2
 
   lemma mset_le_decr_left1: "a+c\<subseteq>#(b::'a multiset) \<Longrightarrow> a\<subseteq>#b" using mset_le_incr_right1 mset_subset_eq_mono_add_right_cancel
     by blast
   lemma mset_le_decr_left2: "c+a\<subseteq>#(b::'a multiset) \<Longrightarrow> a\<subseteq>#b" using mset_le_decr_left1
     by (auto simp add: union_ac)
   lemma mset_le_add_mset_decr_left1: "add_mset c a\<subseteq>#(b::'a multiset) \<Longrightarrow> a\<subseteq>#b"
     by (simp add: mset_subset_eq_insertD subset_mset.dual_order.strict_implies_order)
   lemma mset_le_add_mset_decr_left2: "add_mset c a\<subseteq>#(b::'a multiset) \<Longrightarrow> {#c#}\<subseteq>#b"
     by (simp add: mset_subset_eq_insertD subset_mset.dual_order.strict_implies_order)
 
   lemmas mset_le_decr_left = mset_le_decr_left1 mset_le_decr_left2 mset_le_add_mset_decr_left1
     mset_le_add_mset_decr_left2
 
   lemma mset_le_subtract: "A\<subseteq>#B \<Longrightarrow> A-C \<subseteq># B-(C::'a multiset)"
     apply (unfold subseteq_mset_def count_diff)
     apply clarify
     apply (subgoal_tac "count A a \<le> count B a")
     apply arith
     apply simp
     done
 
   lemma mset_union_subset: "A+B \<subseteq># C \<Longrightarrow> A\<subseteq>#C \<and> B\<subseteq>#(C::'a multiset)"
     by (auto dest: mset_le_decr_left)
 
   lemma mset_le_add_mset: "add_mset x B \<subseteq># C \<Longrightarrow> {#x#}\<subseteq>#C \<and> B\<subseteq>#(C::'a multiset)"
     by (auto dest: mset_le_decr_left)
 
   lemma mset_le_subtract_left: "A+B \<subseteq># (X::'a multiset) \<Longrightarrow> B \<subseteq># X-A \<and> A\<subseteq>#X"
     by (auto dest: mset_le_subtract[of "A+B" "X" "A"] mset_union_subset)
   lemma mset_le_subtract_right: "A+B \<subseteq># (X::'a multiset) \<Longrightarrow> A \<subseteq># X-B \<and> B\<subseteq>#X"
     by (auto dest: mset_le_subtract[of "A+B" "X" "B"] mset_union_subset)
 
   lemma mset_le_subtract_add_mset_left: "add_mset x B \<subseteq># (X::'a multiset) \<Longrightarrow> B \<subseteq># X-{#x#} \<and> {#x#}\<subseteq>#X"
     by (auto dest: mset_le_subtract[of "add_mset x B" "X" "{#x#}"] mset_le_add_mset)
 
   lemma mset_le_subtract_add_mset_right: "add_mset x B \<subseteq># (X::'a multiset) \<Longrightarrow> {#x#} \<subseteq># X-B \<and> B\<subseteq>#X"
     by (auto dest: mset_le_subtract[of "add_mset x B" "X" "B"] mset_le_add_mset)
 
   lemma mset_le_addE: "\<lbrakk> xs \<subseteq># (ys::'a multiset); !!zs. ys=xs+zs \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P" using mset_subset_eq_exists_conv
     by blast
 
   declare subset_mset.diff_add[simp, intro]
 
   lemma mset_2dist2_cases:
     assumes A: "{#a#}+{#b#} \<subseteq># A+B"
     assumes CASES: "{#a#}+{#b#} \<subseteq># A \<Longrightarrow> P" "{#a#}+{#b#} \<subseteq># B \<Longrightarrow> P" "\<lbrakk>a \<in># A; b \<in># B\<rbrakk> \<Longrightarrow> P" "\<lbrakk>a \<in># B; b \<in># A\<rbrakk> \<Longrightarrow> P"
     shows "P"
   proof -
     { assume C: "a \<in># A" "b \<in># A-{#a#}"
       with mset_subset_eq_mono_add[of "{#a#}" "{#a#}" "{#b#}" "A-{#a#}"] have "{#a#}+{#b#} \<subseteq># A" by auto
     } moreover {
       assume C: "a \<in># A" "\<not> (b \<in># A-{#a#})"
       with A have "b \<in># B"
         by (metis diff_union_single_conv2 mset_le_subtract_left mset_subset_eq_insertD mset_un_cases)
     } moreover {
       assume C: "\<not> (a \<in># A)" "b \<in># B-{#a#}"
       with A have "a \<in># B"
         by (auto dest: mset_subset_eqD)
        with C mset_subset_eq_mono_add[of "{#a#}" "{#a#}" "{#b#}" "B-{#a#}"] have "{#a#}+{#b#} \<subseteq># B" by auto
     } moreover {
       assume C: "\<not> (a \<in># A)" "\<not> (b \<in># B-{#a#})"
       with A have "a \<in># B \<and> b \<in># A"
         apply (intro conjI)
          apply (auto dest!: mset_subset_eq_insertD simp: insert_union_subset_iff; fail)[]
         by (metis mset_diff_cancel1elem mset_le_subtract_left multiset_diff_union_assoc
             single_subset_iff subset_eq_diff_conv)
     } ultimately show P using CASES by blast
   qed
 
 
   lemma mset_union_subset_s: "{#a#}+B \<subseteq># C \<Longrightarrow> a \<in># C \<and> B \<subseteq># C"
     by (drule mset_union_subset) simp
 
   (* TODO: Check which of these lemmas are already introduced by order-classes ! *)
 
 
   lemma mset_le_single_cases[consumes 1, case_names empty singleton]: "\<lbrakk>M\<subseteq>#{#a#}; M={#} \<Longrightarrow> P; M={#a#} \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
     by (induct M) auto
 
   lemma mset_le_distrib[consumes 1, case_names dist]: "\<lbrakk>(X::'a multiset)\<subseteq>#A+B; !!Xa Xb. \<lbrakk>X=Xa+Xb; Xa\<subseteq>#A; Xb\<subseteq>#B\<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (auto elim!: mset_le_addE mset_distrib)
 
 lemma mset_le_mono_add_single: "\<lbrakk>a \<in># ys; b \<in># ws\<rbrakk> \<Longrightarrow> {#a#} + {#b#} \<subseteq># ys + ws"
   by (meson mset_subset_eq_mono_add single_subset_iff)
 
   lemma mset_size1elem: "\<lbrakk>size P \<le> 1; q \<in># P\<rbrakk> \<Longrightarrow> P={#q#}"
     by (auto elim: mset_size_le1_cases)
   lemma mset_size2elem: "\<lbrakk>size P \<le> 2; {#q#}+{#q'#} \<subseteq># P\<rbrakk> \<Longrightarrow> P={#q#}+{#q'#}"
     by (auto elim: mset_le_addE)
 
 
 subsubsection \<open>Image under function\<close>
 
 notation image_mset (infixr "`#" 90)
 
 lemma mset_map_split_orig: "!!M1 M2. \<lbrakk>f `# P = M1+M2; !!P1 P2. \<lbrakk>P=P1+P2; f `# P1 = M1; f `# P2 = M2\<rbrakk> \<Longrightarrow> Q \<rbrakk> \<Longrightarrow> Q"
   by (induct P) (force elim!: mset_un_single_un_cases)+
 
 lemma mset_map_id: "\<lbrakk>!!x. f (g x) = x\<rbrakk> \<Longrightarrow> f `# g `# X = X"
   by (induct X) auto
 
 text \<open>The following is a very specialized lemma. Intuitively, it splits the original multiset
   by a splitting of some pointwise supermultiset of its image.
 
   Application:
   This lemma came in handy when proving the correctness of a constraint system that collects at most k sized submultisets of the sets of spawned threads.
 \<close>
 lemma mset_map_split_orig_le: assumes A: "f `# P \<subseteq># M1+M2" and EX: "!!P1 P2. \<lbrakk>P=P1+P2; f `# P1 \<subseteq># M1; f `# P2 \<subseteq># M2\<rbrakk> \<Longrightarrow> Q" shows "Q"
   using A EX by (auto elim: mset_le_distrib mset_map_split_orig)
 
 
 subsection \<open>Lists\<close>
 
 
 lemma len_greater_imp_nonempty[simp]: "length l > x \<Longrightarrow> l\<noteq>[]"
   by auto
 
 lemma list_take_induct_tl2:
   "\<lbrakk>length xs = length ys; \<forall>n<length xs. P (ys ! n) (xs ! n)\<rbrakk>
     \<Longrightarrow> \<forall>n < length (tl xs). P ((tl ys) ! n) ((tl xs) ! n)"
 by (induct xs ys rule: list_induct2) auto
 
 lemma not_distinct_split_distinct:
   assumes "\<not> distinct xs"
   obtains y ys zs where "distinct ys" "y \<in> set ys" "xs = ys@[y]@zs"
 using assms
 proof (induct xs rule: rev_induct)
   case Nil thus ?case by simp
 next
   case (snoc x xs) thus ?case by (cases "distinct xs") auto
 qed
 
 lemma distinct_length_le:
   assumes d: "distinct ys"
   and eq: "set ys = set xs"
   shows "length ys \<le> length xs"
 proof -
   from d have "length ys = card (set ys)" by (simp add: distinct_card)
   also from eq List.card_set have "card (set ys) = length (remdups xs)" by simp
   also have "... \<le> length xs" by simp
   finally show ?thesis .
 qed
 
 lemma find_SomeD:
   "List.find P xs = Some x \<Longrightarrow> P x"
   "List.find P xs = Some x \<Longrightarrow> x\<in>set xs"
   by (auto simp add: find_Some_iff)
 
 lemma in_hd_or_tl_conv[simp]: "l\<noteq>[] \<Longrightarrow> x=hd l \<or> x\<in>set (tl l) \<longleftrightarrow> x\<in>set l"
   by (cases l) auto
 
 lemma length_dropWhile_takeWhile:
   assumes "x < length (dropWhile P xs)"
   shows "x + length (takeWhile P xs) < length xs"
   using assms
   by (induct xs) auto
 
 text \<open>Elim-version of @{thm neq_Nil_conv}.\<close>  
 lemma neq_NilE: 
   assumes "l\<noteq>[]"
   obtains x xs where "l=x#xs" 
   using assms by (metis list.exhaust)
 
     
 lemma length_Suc_rev_conv: "length xs = Suc n \<longleftrightarrow> (\<exists>ys y. xs=ys@[y] \<and> length ys = n)"
   by (cases xs rule: rev_cases) auto
 
     
 subsubsection \<open>List Destructors\<close>
 lemma not_hd_in_tl:
   "x \<noteq> hd xs \<Longrightarrow> x \<in> set xs \<Longrightarrow> x \<in> set (tl xs)"
 by (induct xs) simp_all
 
 lemma distinct_hd_tl:
   "distinct xs \<Longrightarrow> x = hd xs \<Longrightarrow> x \<notin> set (tl (xs))"
 by (induct xs) simp_all
 
 lemma in_set_tlD: "x \<in> set (tl xs) \<Longrightarrow> x \<in> set xs"
 by (induct xs) simp_all
 
 lemma nth_tl: "xs \<noteq> [] \<Longrightarrow> tl xs ! n = xs ! Suc n"
 by (induct xs) simp_all
 
 lemma tl_subset:
   "xs \<noteq> [] \<Longrightarrow> set xs \<subseteq> A \<Longrightarrow> set (tl xs) \<subseteq> A"
 by (metis in_set_tlD rev_subsetD subsetI)
 
 lemma tl_last:
   "tl xs \<noteq> [] \<Longrightarrow> last xs = last (tl xs)"
 by (induct xs) simp_all
 
 lemma tl_obtain_elem:
   assumes "xs \<noteq> []" "tl xs = []"
   obtains e where "xs = [e]"
 using assms
 by (induct xs rule: list_nonempty_induct) simp_all
 
 lemma butlast_subset:
   "xs \<noteq> [] \<Longrightarrow> set xs \<subseteq> A \<Longrightarrow> set (butlast xs) \<subseteq> A"
 by (metis in_set_butlastD rev_subsetD subsetI)
 
 lemma butlast_rev_tl:
   "xs \<noteq> [] \<Longrightarrow> butlast (rev xs) = rev (tl xs)"
 by (induct xs rule: rev_induct) simp_all
 
 lemma hd_butlast:
   "length xs > 1 \<Longrightarrow> hd (butlast xs) = hd xs"
 by (induct xs) simp_all
 
 lemma butlast_upd_last_eq[simp]: "length l \<ge> 2 \<Longrightarrow>
   (butlast l) [ length l - 2 := x ] = take (length l - 2) l @ [x]"
   apply (case_tac l rule: rev_cases)
   apply simp
   apply simp
   apply (case_tac ys rule: rev_cases)
   apply simp
   apply simp
   done
 
 lemma distinct_butlast_swap[simp]: 
   "distinct pq \<Longrightarrow> distinct (butlast (pq[i := last pq]))"
   apply (cases pq rule: rev_cases)
   apply (auto simp: list_update_append distinct_list_update split: nat.split)
   done
 
 subsubsection \<open>Splitting list according to structure of other list\<close>
 context begin
 private definition "SPLIT_ACCORDING m l \<equiv> length l = length m"
 
 private lemma SPLIT_ACCORDINGE: 
   assumes "length m = length l"
   obtains "SPLIT_ACCORDING m l"
   unfolding SPLIT_ACCORDING_def using assms by auto
 
 private lemma SPLIT_ACCORDING_simp:
   "SPLIT_ACCORDING m (l1@l2) \<longleftrightarrow> (\<exists>m1 m2. m=m1@m2 \<and> SPLIT_ACCORDING m1 l1 \<and> SPLIT_ACCORDING m2 l2)"
   "SPLIT_ACCORDING m (x#l') \<longleftrightarrow> (\<exists>y m'. m=y#m' \<and> SPLIT_ACCORDING m' l')"
   apply (fastforce simp: SPLIT_ACCORDING_def intro: exI[where x = "take (length l1) m"] exI[where x = "drop (length l1) m"])
   apply (cases m;auto simp: SPLIT_ACCORDING_def)
   done
 
 text \<open>Split structure of list @{term m} according to structure of list @{term l}.\<close>
 method split_list_according for m :: "'a list" and l :: "'b list" =
   (rule SPLIT_ACCORDINGE[of m l],
     (simp; fail),
     ( simp only: SPLIT_ACCORDING_simp,
       elim exE conjE, 
       simp only: SPLIT_ACCORDING_def
     )
   ) 
 end
   
     
     
 subsubsection \<open>\<open>list_all2\<close>\<close>
 lemma list_all2_induct[consumes 1, case_names Nil Cons]:
   assumes "list_all2 P l l'"
   assumes "Q [] []"
   assumes "\<And>x x' ls ls'. \<lbrakk> P x x'; list_all2 P ls ls'; Q ls ls' \<rbrakk>
     \<Longrightarrow> Q (x#ls) (x'#ls')"
   shows "Q l l'"
   using list_all2_lengthD[OF assms(1)] assms
   apply (induct rule: list_induct2)
   apply auto
   done
 
 
 subsubsection \<open>Indexing\<close>    
 
 lemma ran_nth_set_encoding_conv[simp]: 
   "ran (\<lambda>i. if i<length l then Some (l!i) else None) = set l"
   apply safe
   apply (auto simp: ran_def split: if_split_asm) []
   apply (auto simp: in_set_conv_nth intro: ranI) []
   done
 
 lemma nth_image_indices[simp]: "(!) l ` {0..<length l} = set l"
   by (auto simp: in_set_conv_nth)
 
 lemma nth_update_invalid[simp]:"\<not>i<length l \<Longrightarrow> l[j:=x]!i = l!i"  
   apply (induction l arbitrary: i j)
   apply (auto split: nat.splits)
   done
 
 lemma nth_list_update': "l[i:=x]!j = (if i=j \<and> i<length l then x else l!j)"  
   by auto
 
 lemma last_take_nth_conv: "n \<le> length l \<Longrightarrow> n\<noteq>0 \<Longrightarrow> last (take n l) = l!(n - 1)"
   apply (induction l arbitrary: n)
   apply (auto simp: take_Cons split: nat.split)
   done
 
 lemma nth_append_first[simp]: "i<length l \<Longrightarrow> (l@l')!i = l!i"
   by (simp add: nth_append) 
     
 lemma in_set_image_conv_nth: "f x \<in> f`set l \<longleftrightarrow> (\<exists>i<length l. f (l!i) = f x)"
   by (auto simp: in_set_conv_nth) (metis image_eqI nth_mem)
 
 lemma set_image_eq_pointwiseI: 
   assumes "length l = length l'"
   assumes "\<And>i. i<length l \<Longrightarrow> f (l!i) = f (l'!i)"  
   shows "f`set l = f`set l'"
   using assms
   by (fastforce simp: in_set_conv_nth in_set_image_conv_nth)
   
 lemma insert_swap_set_eq: "i<length l \<Longrightarrow> insert (l!i) (set (l[i:=x])) = insert x (set l)"
   by (auto simp: in_set_conv_nth nth_list_update split: if_split_asm)
     
     
 subsubsection \<open>Reverse lists\<close>
   lemma neq_Nil_revE: 
     assumes "l\<noteq>[]" 
     obtains ll e  where "l = ll@[e]"
     using assms by (cases l rule: rev_cases) auto
       
   lemma neq_Nil_rev_conv: "l\<noteq>[] \<longleftrightarrow> (\<exists>xs x. l = xs@[x])"
     by (cases l rule: rev_cases) auto
 
   text \<open>Caution: Same order of case variables in snoc-case as @{thm [source] rev_exhaust}, the other way round than @{thm [source] rev_induct} !\<close>
   lemma length_compl_rev_induct[case_names Nil snoc]: "\<lbrakk>P []; !! l e . \<lbrakk>!! ll . length ll <= length l \<Longrightarrow> P ll\<rbrakk> \<Longrightarrow> P (l@[e])\<rbrakk> \<Longrightarrow> P l"
     apply(induct_tac l rule: length_induct)
     apply(case_tac "xs" rule: rev_cases)
     apply(auto)
   done
 
   lemma list_append_eq_Cons_cases[consumes 1]: "\<lbrakk>ys@zs = x#xs; \<lbrakk>ys=[]; zs=x#xs\<rbrakk> \<Longrightarrow> P; !!ys'. \<lbrakk> ys=x#ys'; ys'@zs=xs \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (auto iff add: append_eq_Cons_conv)
   lemma list_Cons_eq_append_cases[consumes 1]: "\<lbrakk>x#xs = ys@zs; \<lbrakk>ys=[]; zs=x#xs\<rbrakk> \<Longrightarrow> P; !!ys'. \<lbrakk> ys=x#ys'; ys'@zs=xs \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (auto iff add: Cons_eq_append_conv)
 
 lemma map_of_rev_distinct[simp]:
   "distinct (map fst m) \<Longrightarrow> map_of (rev m) = map_of m"
   apply (induct m)
     apply simp
 
     apply simp
     apply (subst map_add_comm)
       apply force
       apply simp
   done
 
 
 \<comment> \<open>Tail-recursive, generalized @{const rev}. May also be used for
       tail-recursively getting a list with all elements of the two
       operands, if the order does not matter, e.g. when implementing
       sets by lists.\<close>
 fun revg where
   "revg [] b = b" |
   "revg (a#as) b = revg as (a#b)"
 
 lemma revg_fun[simp]: "revg a b = rev a @ b"
   by (induct a arbitrary: b)
       auto
 
 lemma rev_split_conv[simp]:
   "l \<noteq> [] \<Longrightarrow> rev (tl l) @ [hd l] = rev l"
 by (induct l) simp_all
 
 lemma rev_butlast_is_tl_rev: "rev (butlast l) = tl (rev l)"
   by (induct l) auto
 
 lemma hd_last_singletonI:
   "\<lbrakk>xs \<noteq> []; hd xs = last xs; distinct xs\<rbrakk> \<Longrightarrow> xs = [hd xs]"
   by (induct xs rule: list_nonempty_induct) auto
 
 lemma last_filter:
   "\<lbrakk>xs \<noteq> []; P (last xs)\<rbrakk> \<Longrightarrow> last (filter P xs) = last xs"
   by (induct xs rule: rev_nonempty_induct) simp_all
 
 (* As the following two rules are similar in nature to list_induct2',
    they are named accordingly. *)
 lemma rev_induct2' [case_names empty snocl snocr snoclr]:
   assumes empty: "P [] []"
   and snocl: "\<And>x xs. P (xs@[x]) []"
   and snocr: "\<And>y ys. P [] (ys@[y])"
   and snoclr: "\<And>x xs y ys.  P xs ys  \<Longrightarrow> P (xs@[x]) (ys@[y])"
   shows "P xs ys"
 proof (induct xs arbitrary: ys rule: rev_induct)
   case Nil thus ?case using empty snocr
     by (cases ys rule: rev_exhaust) simp_all
 next
   case snoc thus ?case using snocl snoclr
     by (cases ys rule: rev_exhaust) simp_all
 qed
 
 lemma rev_nonempty_induct2' [case_names single snocl snocr snoclr, consumes 2]:
   assumes "xs \<noteq> []" "ys \<noteq> []"
   assumes single': "\<And>x y. P [x] [y]"
   and snocl: "\<And>x xs y. xs \<noteq> [] \<Longrightarrow> P (xs@[x]) [y]"
   and snocr: "\<And>x y ys. ys \<noteq> [] \<Longrightarrow> P [x] (ys@[y])"
   and snoclr: "\<And>x xs y ys. \<lbrakk>P xs ys; xs \<noteq> []; ys\<noteq>[]\<rbrakk>  \<Longrightarrow> P (xs@[x]) (ys@[y])"
   shows "P xs ys"
   using assms(1,2)
 proof (induct xs arbitrary: ys rule: rev_nonempty_induct)
   case single then obtain z zs where "ys = zs@[z]" by (metis rev_exhaust)
   thus ?case using single' snocr
     by (cases "zs = []") simp_all
 next
   case (snoc x xs) then obtain z zs where zs: "ys = zs@[z]" by (metis rev_exhaust)
   thus ?case using snocl snoclr snoc
     by (cases "zs = []") simp_all
 qed
 
 
 subsubsection "Folding"
 
 text "Ugly lemma about foldl over associative operator with left and right neutral element"
 lemma foldl_A1_eq: "!!i. \<lbrakk> !! e. f n e = e; !! e. f e n = e; !!a b c. f a (f b c) = f (f a b) c \<rbrakk> \<Longrightarrow> foldl f i ww = f i (foldl f n ww)"
 proof (induct ww)
   case Nil thus ?case by simp
 next
   case (Cons a ww i) note IHP[simplified]=this
   have "foldl f i (a # ww) = foldl f (f i a) ww" by simp
   also from IHP have "\<dots> = f (f i a) (foldl f n ww)" by blast
   also from IHP(4) have "\<dots> = f i (f a (foldl f n ww))" by simp
   also from IHP(1)[OF IHP(2,3,4), where i=a] have "\<dots> = f i (foldl f a ww)" by simp
   also from IHP(2)[of a] have "\<dots> = f i (foldl f (f n a) ww)" by simp
   also have "\<dots> = f i (foldl f n (a#ww))" by simp
   finally show ?case .
 qed
 
 
 lemmas foldl_conc_empty_eq = foldl_A1_eq[of "(@)" "[]", simplified]
 lemmas foldl_un_empty_eq = foldl_A1_eq[of "(\<union>)" "{}", simplified, OF Un_assoc[symmetric]]
 
 lemma foldl_set: "foldl (\<union>) {} l = \<Union>{x. x\<in>set l}"
   apply (induct l)
   apply simp_all
   apply (subst foldl_un_empty_eq)
   apply auto
   done
 
 lemma (in monoid_mult) foldl_absorb1: "x*foldl (*) 1 zs = foldl (*) x zs"
   apply (rule sym)
   apply (rule foldl_A1_eq)
   apply (auto simp add: mult.assoc)
 done
 
 text \<open>Towards an invariant rule for foldl\<close>
 lemma foldl_rule_aux:
   fixes I :: "'\<sigma> \<Rightarrow> 'a list \<Rightarrow> bool"
   assumes initial: "I \<sigma>0 l0"
   assumes step: "!!l1 l2 x \<sigma>. \<lbrakk> l0=l1@x#l2; I \<sigma> (x#l2) \<rbrakk> \<Longrightarrow> I (f \<sigma> x) l2"
   shows "I (foldl f \<sigma>0 l0) []"
   using initial step
   apply (induct l0 arbitrary: \<sigma>0)
   apply auto
   done
 
 lemma foldl_rule_aux_P:
   fixes I :: "'\<sigma> \<Rightarrow> 'a list \<Rightarrow> bool"
   assumes initial: "I \<sigma>0 l0"
   assumes step: "!!l1 l2 x \<sigma>. \<lbrakk> l0=l1@x#l2; I \<sigma> (x#l2) \<rbrakk> \<Longrightarrow> I (f \<sigma> x) l2"
   assumes final: "!!\<sigma>. I \<sigma> [] \<Longrightarrow> P \<sigma>"
   shows "P (foldl f \<sigma>0 l0)"
 using foldl_rule_aux[of I \<sigma>0 l0, OF initial, OF step] final
 by simp
 
 
 lemma foldl_rule:
   fixes I :: "'\<sigma> \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool"
   assumes initial: "I \<sigma>0 [] l0"
   assumes step: "!!l1 l2 x \<sigma>. \<lbrakk> l0=l1@x#l2; I \<sigma> l1 (x#l2) \<rbrakk> \<Longrightarrow> I (f \<sigma> x) (l1@[x]) l2"
   shows "I (foldl f \<sigma>0 l0) l0 []"
   using initial step
   apply (rule_tac I="\<lambda>\<sigma> lr. \<exists>ll. l0=ll@lr \<and> I \<sigma> ll lr" in foldl_rule_aux_P)
   apply auto
   done
 
 text \<open>
   Invariant rule for foldl. The invariant is parameterized with
   the state, the list of items that have already been processed and
   the list of items that still have to be processed.
 \<close>
 lemma foldl_rule_P:
   fixes I :: "'\<sigma> \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool"
   \<comment> \<open>The invariant holds for the initial state, no items processed yet and all items to be processed:\<close>
   assumes initial: "I \<sigma>0 [] l0"
   \<comment> \<open>The invariant remains valid if one item from the list is processed\<close>
   assumes step: "!!l1 l2 x \<sigma>. \<lbrakk> l0=l1@x#l2; I \<sigma> l1 (x#l2) \<rbrakk> \<Longrightarrow> I (f \<sigma> x) (l1@[x]) l2"
   \<comment> \<open>The proposition follows from the invariant in the final state, i.e. all items processed and nothing to be processed\<close>
   assumes final: "!!\<sigma>. I \<sigma> l0 [] \<Longrightarrow> P \<sigma>"
   shows "P (foldl f \<sigma>0 l0)"
   using foldl_rule[of I, OF initial step] by (simp add: final)
 
 
 text \<open>Invariant reasoning over @{const foldl} for distinct lists. Invariant rule makes no
   assumptions about ordering.\<close>
 lemma distinct_foldl_invar:
   "\<lbrakk> distinct S; I (set S) \<sigma>0;
      \<And>x it \<sigma>. \<lbrakk>x \<in> it; it \<subseteq> set S; I it \<sigma>\<rbrakk> \<Longrightarrow> I (it - {x}) (f \<sigma> x)
    \<rbrakk> \<Longrightarrow> I {} (foldl f \<sigma>0 S)"
 proof (induct S arbitrary: \<sigma>0)
   case Nil thus ?case by auto
 next
   case (Cons x S)
 
   note [simp] = Cons.prems(1)[simplified]
 
   show ?case
     apply simp
     apply (rule Cons.hyps)
   proof -
     from Cons.prems(1) show "distinct S" by simp
     from Cons.prems(3)[of x "set (x#S)", simplified,
                        OF Cons.prems(2)[simplified]]
     show "I (set S) (f \<sigma>0 x)" .
     fix xx it \<sigma>
     assume A: "xx\<in>it" "it \<subseteq> set S" "I it \<sigma>"
     show "I (it - {xx}) (f \<sigma> xx)" using A(2)
       apply (rule_tac Cons.prems(3))
       apply (simp_all add: A(1,3))
       apply blast
       done
   qed
 qed
 
 lemma foldl_length_aux: "foldl (\<lambda>i x. Suc i) a l = a + length l"
   by (induct l arbitrary: a) auto
 
 lemmas foldl_length[simp] = foldl_length_aux[where a=0, simplified]
 
 lemma foldr_length_aux: "foldr (\<lambda>x i. Suc i) l a = a + length l"
   by (induct l arbitrary: a rule: rev_induct) auto
 
 lemmas foldr_length[simp] = foldr_length_aux[where a=0, simplified]
 
 context comp_fun_commute begin
 
 lemma foldl_f_commute: "f a (foldl (\<lambda>a b. f b a) b xs) = foldl (\<lambda>a b. f b a) (f a b) xs"
 by(induct xs arbitrary: b)(simp_all add: fun_left_comm)
 
 lemma foldr_conv_foldl: "foldr f xs a = foldl (\<lambda>a b. f b a) a xs"
 by(induct xs arbitrary: a)(simp_all add: foldl_f_commute)
 
 end
 
 lemma filter_conv_foldr:
   "filter P xs = foldr (\<lambda>x xs. if P x then x # xs else xs) xs []"
 by(induct xs) simp_all
 
 lemma foldr_Cons: "foldr Cons xs [] = xs"
 by(induct xs) simp_all
 
 lemma foldr_snd_zip:
   "length xs \<ge> length ys \<Longrightarrow> foldr (\<lambda>(x, y). f y) (zip xs ys) b = foldr f ys b"
 proof(induct ys arbitrary: xs)
   case (Cons y ys) thus ?case by(cases xs) simp_all
 qed simp
 
 lemma foldl_snd_zip:
   "length xs \<ge> length ys \<Longrightarrow> foldl (\<lambda>b (x, y). f b y) b (zip xs ys) = foldl f b ys"
 proof(induct ys arbitrary: xs b)
   case (Cons y ys) thus ?case by(cases xs) simp_all
 qed simp
 
 lemma fst_foldl: "fst (foldl (\<lambda>(a, b) x. (f a x, g a b x)) (a, b) xs) = foldl f a xs"
 by(induct xs arbitrary: a b) simp_all
 
 lemma foldl_foldl_conv_concat: "foldl (foldl f) a xs = foldl f a (concat xs)"
 by(induct xs arbitrary: a) simp_all
 
 lemma foldl_list_update:
   "n < length xs \<Longrightarrow> foldl f a (xs[n := x]) = foldl f (f (foldl f a (take n xs)) x) (drop (Suc n) xs)"
 by(simp add: upd_conv_take_nth_drop)
 
 lemma map_by_foldl:
   fixes l :: "'a list" and f :: "'a \<Rightarrow> 'b"
   shows "foldl (\<lambda>l x. l@[f x]) [] l = map f l"
 proof -
   {
     fix l'
     have "foldl (\<lambda>l x. l@[f x]) l' l = l'@map f l"
       by (induct l arbitrary: l') auto
   } thus ?thesis by simp
 qed
 
 
 subsubsection \<open>Sorting\<close>
 
 lemma sorted_in_between:
   assumes A: "0\<le>i" "i<j" "j<length l"
   assumes S: "sorted l"
   assumes E: "l!i \<le> x" "x<l!j"
   obtains k where "i\<le>k" and "k<j" and "l!k\<le>x" and "x<l!(k+1)"
 proof -
   from A E have "\<exists>k. i\<le>k \<and> k<j \<and> l!k\<le>x \<and> x<l!(k+1)"
   proof (induct "j-i" arbitrary: i j)
     case (Suc d)
     show ?case proof (cases "l!(i+1) \<le> x")
       case True
       from True Suc.hyps have "d = j - (i + 1)" by simp
       moreover from True have "i+1 < j"
         by (metis Suc.prems Suc_eq_plus1 Suc_lessI not_less)
       moreover from True have "0\<le>i+1" by simp
       ultimately obtain k where
         "i+1\<le>k" "k<j" "l!k \<le> x" "x<l!(k+1)"
         using Suc.hyps(1)[of j "i+1"] Suc.prems True
         by auto
       thus ?thesis by (auto dest: Suc_leD)
     next
       case False
       show ?thesis proof (cases "x<(l!(j - 1))")
         case True
         from True Suc.hyps have "d = j - (i + 1)" by simp
         moreover from True Suc.prems have "i < j - 1"
           by (metis Suc_eq_plus1 Suc_lessI diff_Suc_1 less_diff_conv not_le)
         moreover from True Suc.prems have "j - 1 < length l" by simp
         ultimately obtain k where
           "i\<le>k" "k<j - 1" "l!k \<le> x" "x<l!(k+1)"
           using Suc.hyps(1)[of "j - 1" i] Suc.prems True
           by auto
         thus ?thesis by (auto dest: Suc_leD)
       next
         case False thus ?thesis using Suc
           apply clarsimp
           by (metis Suc_leI add_0_iff add_diff_inverse diff_Suc_1 le_add2 lessI
               not0_implies_Suc not_less)
       qed
     qed
   qed simp
   thus ?thesis by (blast intro: that)
 qed
 
 lemma sorted_hd_last:
   "\<lbrakk>sorted l; l\<noteq>[]\<rbrakk> \<Longrightarrow> hd l \<le> last l"
 by (metis eq_iff hd_Cons_tl last_in_set not_hd_in_tl sorted_wrt.simps(2))
 
 lemma (in linorder) sorted_hd_min:
   "\<lbrakk>xs \<noteq> []; sorted xs\<rbrakk> \<Longrightarrow> \<forall>x \<in> set xs. hd xs \<le> x"
 by (induct xs, auto)
 
 lemma sorted_append_bigger:
   "\<lbrakk>sorted xs; \<forall>x \<in> set xs. x \<le> y\<rbrakk> \<Longrightarrow> sorted (xs @ [y])"
 proof (induct xs)
   case Nil
   then show ?case by simp
 next
   case (Cons x xs)
   then have s: "sorted xs" by (cases xs) simp_all
   from Cons have a: "\<forall>x\<in>set xs. x \<le> y" by simp
   from Cons(1)[OF s a] Cons(2-) show ?case by (cases xs) simp_all
 qed
 
 lemma sorted_filter':
   "sorted l \<Longrightarrow> sorted (filter P l)"
   using sorted_filter[where f=id, simplified] .
 
 subsubsection \<open>Map\<close>
 (* List.thy has:
  declare map_eq_Cons_D [dest!]  Cons_eq_map_D [dest!] *)  
 lemma map_eq_consE: "\<lbrakk>map f ls = fa#fl; !!a l. \<lbrakk> ls=a#l; f a=fa; map f l = fl \<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by auto
 
 lemma map_fst_mk_snd[simp]: "map fst (map (\<lambda>x. (x,k)) l) = l" by (induct l) auto
 lemma map_snd_mk_fst[simp]: "map snd (map (\<lambda>x. (k,x)) l) = l" by (induct l) auto
 lemma map_fst_mk_fst[simp]: "map fst (map (\<lambda>x. (k,x)) l) = replicate (length l) k" by (induct l) auto
 lemma map_snd_mk_snd[simp]: "map snd (map (\<lambda>x. (x,k)) l) = replicate (length l) k" by (induct l) auto
 
 lemma map_zip1: "map (\<lambda>x. (x,k)) l = zip l (replicate (length l) k)" by (induct l) auto
 lemma map_zip2: "map (\<lambda>x. (k,x)) l = zip (replicate (length l) k) l" by (induct l) auto
 lemmas map_zip=map_zip1 map_zip2
 
 (* TODO/FIXME: hope nobody changes nth to be underdefined! *)
 lemma map_eq_nth_eq:
   assumes A: "map f l = map f l'"
   shows "f (l!i) = f (l'!i)"
 proof -
   from A have "length l = length l'"
     by (metis length_map)
   thus ?thesis using A
     apply (induct arbitrary: i rule: list_induct2)
     apply simp
     apply (simp add: nth_def split: nat.split)
     done
 qed
 
 lemma map_upd_eq:
   "\<lbrakk>i<length l \<Longrightarrow> f (l!i) = f x\<rbrakk> \<Longrightarrow> map f (l[i:=x]) = map f l"
   by (metis list_update_beyond list_update_id map_update not_le_imp_less)
 
 
 
 
 lemma inj_map_inv_f [simp]: "inj f \<Longrightarrow> map (inv f) (map f l) = l"
   by (simp)
 
 lemma inj_on_map_the: "\<lbrakk>D \<subseteq> dom m; inj_on m D\<rbrakk> \<Longrightarrow> inj_on (the\<circ>m) D"
   apply (rule inj_onI)
   apply simp
   apply (case_tac "m x")
   apply (case_tac "m y")
   apply (auto intro: inj_onD) [1]
   apply (auto intro: inj_onD) [1]
   apply (case_tac "m y")
   apply (auto intro: inj_onD) [1]
   apply simp
   apply (rule inj_onD)
   apply assumption
   apply auto
   done
 
     
 
 lemma map_consI:
   "w=map f ww \<Longrightarrow> f a#w = map f (a#ww)"
   "w@l=map f ww@l \<Longrightarrow> f a#w@l = map f (a#ww)@l"
   by auto
 
 
 lemma restrict_map_subset_eq:
   fixes R
   shows "\<lbrakk>m |` R = m'; R'\<subseteq>R\<rbrakk> \<Longrightarrow> m|` R' = m' |` R'"
   by (auto simp add: Int_absorb1)
 
 lemma restrict_map_self[simp]: "m |` dom m = m"
   apply (rule ext)
   apply (case_tac "m x")
   apply (auto simp add: restrict_map_def)
   done
 
 lemma restrict_map_UNIV[simp]: "f |` UNIV = f"
   by (auto simp add: restrict_map_def)
 
 lemma restrict_map_inv[simp]: "f |` (- dom f) = Map.empty"
   by (auto simp add: restrict_map_def intro: ext)
 
 lemma restrict_map_upd: "(f |` S)(k \<mapsto> v) = f(k\<mapsto>v) |` (insert k S)"
   by (auto simp add: restrict_map_def intro: ext)
 
 lemma map_upd_eq_restrict: "m (x:=None) = m |` (-{x})"
   by (auto intro: ext)
 
 declare Map.finite_dom_map_of [simp, intro!]
 
 lemma dom_const'[simp]: "dom (\<lambda>x. Some (f x)) = UNIV"
   by auto
 
 lemma restrict_map_eq :
   "((m |` A) k = None) \<longleftrightarrow> (k \<notin> dom m \<inter> A)"
   "((m |` A) k = Some v) \<longleftrightarrow> (m k = Some v \<and> k \<in> A)"
 unfolding restrict_map_def
 by (simp_all add: dom_def)
 
 
 definition "rel_of m P == {(k,v). m k = Some v \<and> P (k, v)}"
 lemma rel_of_empty[simp]: "rel_of Map.empty P = {}"
     by (auto simp add: rel_of_def)
 
 lemma remove1_tl: "xs \<noteq> [] \<Longrightarrow> remove1 (hd xs) xs = tl xs"
   by (cases xs) auto
 
 lemma set_oo_map_alt: "(set \<circ>\<circ> map) f = (\<lambda>l. f ` set l)" by auto
     
 subsubsection "Filter and Revert"
 primrec filter_rev_aux where
   "filter_rev_aux a P [] = a"
 | "filter_rev_aux a P (x#xs) = (
      if P x then filter_rev_aux (x#a) P xs else filter_rev_aux a P xs)"
 
 lemma filter_rev_aux_alt: "filter_rev_aux a P l = filter P (rev l) @ a"
   by (induct l arbitrary: a) auto
 
 definition "filter_rev == filter_rev_aux []"
 lemma filter_rev_alt: "filter_rev P l = filter P (rev l)"
   unfolding filter_rev_def by (simp add: filter_rev_aux_alt)
 
 definition "remove_rev x == filter_rev (Not o (=) x)"
 lemma remove_rev_alt_def :
   "remove_rev x xs = (filter (\<lambda>y. y \<noteq> x) (rev xs))"
   unfolding remove_rev_def
   apply (simp add: filter_rev_alt comp_def)
   by metis
 
 subsubsection "zip"
 
 declare zip_map_fst_snd[simp]  
 
 lemma pair_list_split: "\<lbrakk> !!l1 l2. \<lbrakk> l = zip l1 l2; length l1=length l2; length l=length l2 \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
 proof (induct l arbitrary: P)
   case Nil thus ?case by auto
 next
   case (Cons a l) from Cons.hyps obtain l1 l2 where IHAPP: "l=zip l1 l2" "length l1 = length l2" "length l=length l2" .
   obtain a1 a2 where [simp]: "a=(a1,a2)" by (cases a) auto
   from IHAPP have "a#l = zip (a1#l1) (a2#l2)" "length (a1#l1) = length (a2#l2)" "length (a#l) = length (a2#l2)"
     by (simp_all only:) (simp_all (no_asm_use))
   with Cons.prems show ?case by blast
 qed
 
 lemma set_zip_cart: "x\<in>set (zip l l') \<Longrightarrow> x\<in>set l \<times> set l'"
   by (auto simp add: set_zip)
 
 
 lemma map_prod_fun_zip: "map (\<lambda>(x, y). (f x, g y)) (zip xs ys) = zip (map f xs) (map g ys)"
 proof(induct xs arbitrary: ys)
   case Nil thus ?case by simp
 next
   case (Cons x xs) thus ?case by(cases ys) simp_all
 qed
 
 
 subsubsection \<open>Generalized Zip\<close>
 text \<open>Zip two lists element-wise, where the combination of two elements is specified by a function. Note that this function is underdefined for lists of different length.\<close>
 fun zipf :: "('a\<Rightarrow>'b\<Rightarrow>'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list" where
   "zipf f [] [] = []" |
   "zipf f (a#as) (b#bs) = f a b # zipf f as bs"
 
 
 lemma zipf_zip: "\<lbrakk>length l1 = length l2\<rbrakk> \<Longrightarrow> zipf Pair l1 l2 = zip l1 l2"
   apply (induct l1 arbitrary: l2)
   apply auto
   apply (case_tac l2)
   apply auto
   done
 
   \<comment> \<open>All quantification over zipped lists\<close>
 fun list_all_zip where
   "list_all_zip P [] [] \<longleftrightarrow> True" |
   "list_all_zip P (a#as) (b#bs) \<longleftrightarrow> P a b \<and> list_all_zip P as bs" |
   "list_all_zip P _ _ \<longleftrightarrow> False"
 
 lemma list_all_zip_alt: "list_all_zip P as bs \<longleftrightarrow> length as = length bs \<and> (\<forall>i<length as. P (as!i) (bs!i))"
   apply (induct P\<equiv>P as bs rule: list_all_zip.induct)
   apply auto
   apply (case_tac i)
   apply auto
   done
 
 lemma list_all_zip_map1: "list_all_zip P (List.map f as) bs \<longleftrightarrow> list_all_zip (\<lambda>a b. P (f a) b) as bs"
   apply (induct as arbitrary: bs)
   apply (case_tac bs)
   apply auto [2]
   apply (case_tac bs)
   apply auto [2]
   done
 
 lemma list_all_zip_map2: "list_all_zip P as (List.map f bs) \<longleftrightarrow> list_all_zip (\<lambda>a b. P a (f b)) as bs"
   apply (induct as arbitrary: bs)
   apply (case_tac bs)
   apply auto [2]
   apply (case_tac bs)
   apply auto [2]
   done
 
 declare list_all_zip_alt[mono]
 
 lemma lazI[intro?]: "\<lbrakk> length a = length b; !!i. i<length b \<Longrightarrow> P (a!i) (b!i) \<rbrakk>
   \<Longrightarrow> list_all_zip P a b"
   by (auto simp add: list_all_zip_alt)
 
 lemma laz_conj[simp]: "list_all_zip (\<lambda>x y. P x y \<and> Q x y) a b
                        \<longleftrightarrow> list_all_zip P a b \<and> list_all_zip Q a b"
   by (auto simp add: list_all_zip_alt)
 
 lemma laz_len: "list_all_zip P a b \<Longrightarrow> length a = length b"
   by (simp add: list_all_zip_alt)
 
 lemma laz_eq: "list_all_zip (=) a b \<longleftrightarrow> a=b"
   apply (induct a arbitrary: b)
   apply (case_tac b)
   apply simp
   apply simp
   apply (case_tac b)
   apply simp
   apply simp
   done
 
 
 lemma laz_swap_ex:
   assumes A: "list_all_zip (\<lambda>a b. \<exists>c. P a b c) A B"
   obtains C where
     "list_all_zip (\<lambda>a c. \<exists>b. P a b c) A C"
     "list_all_zip (\<lambda>b c. \<exists>a. P a b c) B C"
 proof -
   from A have
     [simp]: "length A = length B" and
     IC: "\<forall>i<length B. \<exists>ci. P (A!i) (B!i) ci"
     by (auto simp add: list_all_zip_alt)
   from obtain_list_from_elements[OF IC] obtain C where
     "length C = length B"
     "\<forall>i<length B. P (A!i) (B!i) (C!i)" .
   thus ?thesis
     by (rule_tac that) (auto simp add: list_all_zip_alt)
 qed
 
 lemma laz_weak_Pa[simp]:
   "list_all_zip (\<lambda>a b. P a) A B \<longleftrightarrow> (length A = length B) \<and> (\<forall>a\<in>set A. P a)"
   by (auto simp add: list_all_zip_alt set_conv_nth)
 
 lemma laz_weak_Pb[simp]:
   "list_all_zip (\<lambda>a b. P b) A B \<longleftrightarrow> (length A = length B) \<and> (\<forall>b\<in>set B. P b)"
   by (force simp add: list_all_zip_alt set_conv_nth)
 
 
 
 subsubsection "Collecting Sets over Lists"
 
 definition "list_collect_set f l == \<Union>{ f a | a. a\<in>set l }"
 lemma list_collect_set_simps[simp]:
   "list_collect_set f [] = {}"
   "list_collect_set f [a] = f a"
   "list_collect_set f (a#l) = f a \<union> list_collect_set f l"
   "list_collect_set f (l@l') = list_collect_set f l \<union> list_collect_set f l'"
 by (unfold list_collect_set_def) auto
 
 lemma list_collect_set_map_simps[simp]:
   "list_collect_set f (map x []) = {}"
   "list_collect_set f (map x [a]) = f (x a)"
   "list_collect_set f (map x (a#l)) = f (x a) \<union> list_collect_set f (map x l)"
   "list_collect_set f (map x (l@l')) = list_collect_set f (map x l) \<union> list_collect_set f (map x l')"
 by simp_all
 
 lemma list_collect_set_alt: "list_collect_set f l = \<Union>{ f (l!i) | i. i<length l }"
   apply (induct l)
   apply simp
   apply safe
   apply auto
   apply (rule_tac x="f (l!i)" in exI)
   apply simp
   apply (rule_tac x="Suc i" in exI)
   apply simp
   apply (case_tac i)
   apply auto
   done
 
 lemma list_collect_set_as_map: "list_collect_set f l = \<Union>(set (map f l))"
   by (unfold list_collect_set_def) auto
 
 subsubsection \<open>Sorted List with arbitrary Relations\<close>
 
 lemma (in linorder) sorted_wrt_rev_linord [simp] :
   "sorted_wrt (\<ge>) l \<longleftrightarrow> sorted (rev l)"
 by (simp add: sorted_wrt_rev)
 
 lemma (in linorder) sorted_wrt_map_linord [simp] :
   "sorted_wrt (\<lambda>(x::'a \<times> 'b) y. fst x \<le> fst y) l
   \<longleftrightarrow> sorted (map fst l)"
 by (simp add: sorted_wrt_map)
 
 lemma (in linorder) sorted_wrt_map_rev_linord [simp] :
   "sorted_wrt (\<lambda>(x::'a \<times> 'b) y. fst x \<ge> fst y) l
   \<longleftrightarrow> sorted (rev (map fst l))"
 by (induct l) (auto simp add: sorted_append)
 
     
 subsubsection \<open>Take and Drop\<close>
   lemma take_update[simp]: "take n (l[i:=x]) = (take n l)[i:=x]"
     apply (induct l arbitrary: n i)
     apply (auto split: nat.split)
     apply (case_tac n)
     apply simp_all
     apply (case_tac n)
     apply simp_all
     done
 
   lemma take_update_last: "length list>n \<Longrightarrow> (take (Suc n) list) [n:=x] = take n list @ [x]"
     by (induct list arbitrary: n)
        (auto split: nat.split)
 
   lemma drop_upd_irrelevant: "m < n \<Longrightarrow> drop n (l[m:=x]) = drop n l"
     apply (induct n arbitrary: l m)
     apply simp
     apply (case_tac l)
     apply (auto split: nat.split)
     done
 
 lemma set_drop_conv:
   "set (drop n l) =  { l!i | i. n\<le>i \<and> i < length l }" (is "?L=?R")
 proof (intro equalityI subsetI)
   fix x
   assume "x\<in>?L"
   then obtain i where L: "i<length l - n" and X: "x = drop n l!i"
     by (auto simp add: in_set_conv_nth)
   note X
   also have "\<dots> = l!(n+i)" using L by simp
   finally show "x\<in>?R" using L by auto
 next
   fix x
   assume "x\<in>?R"
   then obtain i where L: "n\<le>i" "i<length l" and X: "x=l!i" by blast
   note X
   moreover have "l!i = drop n l ! (i - n)" and "(i-n) < length l - n" using L
     by (auto)
   ultimately show "x\<in>?L"
     by (auto simp add: in_set_conv_nth)
 qed
 
 lemma filter_upt_take_conv:
   "[i\<leftarrow>[n..<m]. P (take m l ! i) ] = [i\<leftarrow>[n..<m]. P (l ! i) ]"
   by (rule filter_cong) (simp_all)
 
 lemma in_set_drop_conv_nth: "x\<in>set (drop n l) \<longleftrightarrow> (\<exists>i. n\<le>i \<and> i<length l \<and> x = l!i)"
   apply (clarsimp simp: in_set_conv_nth)
   apply safe
   apply simp
   apply (metis le_add2 less_diff_conv add.commute)
   apply (rule_tac x="i-n" in exI)
   apply auto []
   done
 
 lemma Union_take_drop_id: "\<Union>(set (drop n l)) \<union> \<Union>(set (take n l)) = \<Union>(set l)"
   by (metis Union_Un_distrib append_take_drop_id set_union_code sup_commute)
 
 
 lemma Un_set_drop_extend: "\<lbrakk>j\<ge>Suc 0; j < length l\<rbrakk>
   \<Longrightarrow> l ! (j - Suc 0) \<union> \<Union>(set (drop j l)) = \<Union>(set (drop (j - Suc 0) l))"
   apply safe
   apply simp_all
   apply (metis diff_Suc_Suc diff_zero gr0_implies_Suc in_set_drop_conv_nth
     le_refl less_eq_Suc_le order.strict_iff_order)
   apply (metis Nat.diff_le_self set_drop_subset_set_drop subset_code(1))
   by (metis diff_Suc_Suc gr0_implies_Suc in_set_drop_conv_nth
     less_eq_Suc_le order.strict_iff_order minus_nat.diff_0)
 
 lemma drop_take_drop_unsplit:
   "i\<le>j \<Longrightarrow> drop i (take j l) @ drop j l = drop i l"
 proof -
   assume "i \<le> j"
   then obtain skf where "i + skf = j"
     by (metis le_iff_add)
   thus "drop i (take j l) @ drop j l = drop i l"
     by (metis append_take_drop_id diff_add_inverse drop_drop drop_take
       add.commute)
 qed
 
 lemma drop_last_conv[simp]: "l\<noteq>[] \<Longrightarrow> drop (length l - Suc 0) l = [last l]"
   by (cases l rule: rev_cases) auto
 
 lemma take_butlast_conv[simp]: "take (length l - Suc 0) l = butlast l"
   by (cases l rule: rev_cases) auto
 
   lemma drop_takeWhile:
     assumes "i\<le>length (takeWhile P l)"
     shows "drop i (takeWhile P l) = takeWhile P (drop i l)"  
     using assms
   proof (induction l arbitrary: i)
     case Nil thus ?case by auto
   next
     case (Cons x l) thus ?case  
       by (cases i) auto
   qed    
   
 lemma less_length_takeWhile_conv: "i < length (takeWhile P l) \<longleftrightarrow> (i<length l \<and> (\<forall>j\<le>i. P (l!j)))"  
   apply safe
   subgoal using length_takeWhile_le less_le_trans by blast
   subgoal by (metis dual_order.strict_trans2 nth_mem set_takeWhileD takeWhile_nth)
   subgoal by (meson less_le_trans not_le_imp_less nth_length_takeWhile)
   done
   
 lemma eq_len_takeWhile_conv: "i=length (takeWhile P l) 
   \<longleftrightarrow> i\<le>length l \<and> (\<forall>j<i. P (l!j)) \<and> (i<length l \<longrightarrow> \<not>P (l!i))"  
   apply safe
   subgoal using length_takeWhile_le less_le_trans by blast
   subgoal by (auto simp: less_length_takeWhile_conv)
   subgoal using nth_length_takeWhile by blast 
   subgoal by (metis length_takeWhile_le nth_length_takeWhile order.order_iff_strict) 
   subgoal by (metis dual_order.strict_trans2 leI less_length_takeWhile_conv linorder_neqE_nat nth_length_takeWhile) 
   done
     
     
 subsubsection \<open>Up-to\<close>
 
 lemma upt_eq_append_conv: "i\<le>j \<Longrightarrow> [i..<j] = xs@ys \<longleftrightarrow> (\<exists>k. i\<le>k \<and> k\<le>j \<and> [i..<k] = xs \<and> [k..<j] = ys)"
 proof (rule iffI)
   assume "[i..<j] = xs @ ys"  
   and "i\<le>j"
   thus "\<exists>k\<ge>i. k \<le> j \<and> [i..<k] = xs \<and> [k..<j] = ys"
     apply (induction xs arbitrary: i)
     apply (auto; fail)
     apply (clarsimp simp: upt_eq_Cons_conv)
     by (meson Suc_le_eq less_imp_le_nat)
 qed auto
   
 lemma map_nth_upt_drop_take_conv: "N \<le> length l \<Longrightarrow> map (nth l) [M..<N] = drop M (take N l)"
   by (induction N) (auto simp: take_Suc_conv_app_nth)
     
 lemma upt_eq_lel_conv:
   "[l..<h] = is1@i#is2 \<longleftrightarrow> is1 = [l..<i] \<and> is2 = [Suc i..<h] \<and> l\<le>i \<and> i<h"
   apply (rule)
   subgoal
     apply (induction is1 arbitrary: l)
     apply (auto simp: upt_eq_Cons_conv) []
     apply (clarsimp simp: upt_eq_Cons_conv)
     using Suc_le_eq upt_rec by auto
   subgoal by (auto simp: upt_conv_Cons[symmetric])
   done
 
    
 lemma map_add_upt': "map (\<lambda>i. i + ofs) [a..<b] = [a+ofs..<b + ofs]"
   by (induct b) simp_all
     
     
 subsubsection \<open>Last and butlast\<close>
 lemma butlast_upt: "butlast [m..<n] = [m..<n - 1]"
   apply (cases "m<n")
     apply (cases n)
       apply simp
     apply simp
   apply simp
   done
 
 (*lemma butlast_upt: "n<m \<Longrightarrow> butlast [n..<m] = [n..<m - 1]"
   apply (cases "[n..<m]" rule: rev_cases)
   apply simp
   apply (cases m)
   apply simp
   apply simp
   done*)
 
 lemma butlast_update': "(butlast l) [i:=x] = butlast (l[i:=x])"
   by (metis butlast_conv_take butlast_list_update length_butlast take_update)
 
 
 lemma take_minus_one_conv_butlast:
   "n\<le>length l \<Longrightarrow> take (n - Suc 0) l = butlast (take n l)"
   by (simp add: butlast_take)
 
 lemma butlast_eq_cons_conv: "butlast l = x#xs \<longleftrightarrow> (\<exists>xl. l=x#xs@[xl])"
   by (metis Cons_eq_appendI append_butlast_last_id butlast.simps
     butlast_snoc eq_Nil_appendI)
 
 lemma butlast_eq_consE:
   assumes "butlast l = x#xs"
   obtains xl where "l=x#xs@[xl]"
   using assms
   by (auto simp: butlast_eq_cons_conv)
 
 lemma drop_eq_ConsD: "drop n xs = x # xs' \<Longrightarrow> drop (Suc n) xs = xs'"
 by(induct xs arbitrary: n)(simp_all add: drop_Cons split: nat.split_asm)
 
 subsubsection \<open>List Slices\<close>  
   text \<open>Based on Lars Hupel's code.\<close>  
 definition slice :: "nat \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
 "slice from to list = take (to - from) (drop from list)"
 
 lemma slice_len[simp]: "\<lbrakk> from \<le> to; to \<le> length xs \<rbrakk> \<Longrightarrow> length (slice from to xs) = to - from"
 unfolding slice_def
 by simp
 
 lemma slice_head: "\<lbrakk> from < to; to \<le> length xs \<rbrakk> \<Longrightarrow> hd (slice from to xs) = xs ! from"
 unfolding slice_def
 proof -
   assume a1: "from < to"
   assume "to \<le> length xs"
   then have "\<And>n. to - (to - n) \<le> length (take to xs)"
     by (metis (no_types) slice_def diff_le_self drop_take length_drop slice_len)
   then show "hd (take (to - from) (drop from xs)) = xs ! from"
     using a1 by (metis diff_diff_cancel drop_take hd_drop_conv_nth leI le_antisym less_or_eq_imp_le nth_take)
 qed
 
 lemma slice_eq_bounds_empty[simp]: "slice i i xs = []"
 unfolding slice_def by auto
 
 lemma slice_nth: "\<lbrakk> from < to; to \<le> length xs; i < to - from \<rbrakk> \<Longrightarrow> slice from to xs ! i = xs ! (from + i)"
 unfolding slice_def
 by (induction "to - from" arbitrary: "from" to i) simp+
 
 lemma slice_prepend: "\<lbrakk> i \<le> k; k \<le> length xs \<rbrakk> \<Longrightarrow> let p = length ys in slice i k xs = slice (i + p) (k + p) (ys @ xs)"
 unfolding slice_def Let_def
 by force
 
 lemma slice_Nil[simp]: "slice begin end [] = []"  
   unfolding slice_def by auto
   
 lemma slice_Cons: "slice begin end (x#xs) 
   = (if begin=0 \<and> end>0 then x#slice begin (end-1) xs else slice (begin - 1) (end - 1) xs)"
   unfolding slice_def
   by (auto simp: take_Cons' drop_Cons')
 
 lemma slice_complete[simp]: "slice 0 (length xs) xs = xs"
   unfolding slice_def
   by simp
 
   
   
 subsubsection \<open>Miscellaneous\<close>
   lemma length_compl_induct[case_names Nil Cons]: "\<lbrakk>P []; !! e l . \<lbrakk>!! ll . length ll <= length l \<Longrightarrow> P ll\<rbrakk> \<Longrightarrow> P (e#l)\<rbrakk> \<Longrightarrow> P l"
     apply(induct_tac l rule: length_induct)
     apply(case_tac "xs")
     apply(auto)
   done
 
   lemma in_set_list_format: "\<lbrakk> e\<in>set l; !!l1 l2. l=l1@e#l2 \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   proof (induct l arbitrary: P)
     case Nil thus ?case by auto
   next
     case (Cons a l) show ?case proof (cases "a=e")
       case True with Cons show ?thesis by force
     next
       case False with Cons.prems(1) have "e\<in>set l" by auto
       with Cons.hyps obtain l1 l2 where "l=l1@e#l2" by blast
       hence "a#l = (a#l1)@e#l2" by simp
       with Cons.prems(2) show P by blast
     qed
   qed
 
 lemma in_set_upd_cases:
   assumes "x\<in>set (l[i:=y])"
   obtains "i<length l" and "x=y" | "x\<in>set l"
   by (metis assms in_set_conv_nth length_list_update nth_list_update_eq
     nth_list_update_neq)
 
 lemma in_set_upd_eq_aux:
   assumes "i<length l"
   shows "x\<in>set (l[i:=y]) \<longleftrightarrow> x=y \<or> (\<forall>y. x\<in>set (l[i:=y]))"
   by (metis in_set_upd_cases assms list_update_overwrite
     set_update_memI)
 
 lemma in_set_upd_eq:
   assumes "i<length l"
   shows "x\<in>set (l[i:=y]) \<longleftrightarrow> x=y \<or> (x\<in>set l \<and> (\<forall>y. x\<in>set (l[i:=y])))"
   by (metis in_set_upd_cases in_set_upd_eq_aux assms)
 
 
   text \<open>Simultaneous induction over two lists, prepending an element to one of the lists in each step\<close>
   lemma list_2pre_induct[case_names base left right]: assumes BASE: "P [] []" and LEFT: "!!e w1' w2. P w1' w2 \<Longrightarrow> P (e#w1') w2" and RIGHT: "!!e w1 w2'. P w1 w2' \<Longrightarrow> P w1 (e#w2')" shows "P w1 w2"
   proof -
     { \<comment> \<open>The proof is done by induction over the sum of the lengths of the lists\<close>
       fix n
       have "!!w1 w2. \<lbrakk>length w1 + length w2 = n; P [] []; !!e w1' w2. P w1' w2 \<Longrightarrow> P (e#w1') w2; !!e w1 w2'. P w1 w2' \<Longrightarrow> P w1 (e#w2') \<rbrakk> \<Longrightarrow> P w1 w2 "
         apply (induct n)
         apply simp
         apply (case_tac w1)
         apply auto
         apply (case_tac w2)
         apply auto
         done
     } from this[OF _ BASE LEFT RIGHT] show ?thesis by blast
   qed
 
 
   lemma list_decomp_1: "length l=1 \<Longrightarrow> \<exists>a. l=[a]"
     by (case_tac l, auto)
 
   lemma list_decomp_2: "length l=2 \<Longrightarrow> \<exists>a b. l=[a,b]"
     by (case_tac l, auto simp add: list_decomp_1)
 
 
 
   lemma list_rest_coinc: "\<lbrakk>length s2 \<le> length s1; s1@r1 = s2@r2\<rbrakk> \<Longrightarrow> \<exists>r1p. r2=r1p@r1"
     by (metis append_eq_append_conv_if)
 
   lemma list_tail_coinc: "n1#r1 = n2#r2 \<Longrightarrow> n1=n2 & r1=r2"
     by (auto)
 
 
   lemma last_in_set[intro]: "\<lbrakk>l\<noteq>[]\<rbrakk> \<Longrightarrow> last l \<in> set l"
     by (induct l) auto
 
   lemma empty_append_eq_id[simp]: "(@) [] = (\<lambda>x. x)" by auto
       
   lemma op_conc_empty_img_id[simp]: "((@) [] ` L) = L" by auto
 
 
   lemma distinct_match: "\<lbrakk> distinct (al@e#bl) \<rbrakk> \<Longrightarrow> (al@e#bl = al'@e#bl') \<longleftrightarrow> (al=al' \<and> bl=bl')"
   proof (rule iffI, induct al arbitrary: al')
     case Nil thus ?case by (cases al') auto
   next
     case (Cons a al) note Cprems=Cons.prems note Chyps=Cons.hyps
     show ?case proof (cases al')
       case Nil with Cprems have False by auto
       thus ?thesis ..
     next
       case [simp]: (Cons a' all')
       with Cprems have [simp]: "a=a'" and P: "al@e#bl = all'@e#bl'" by auto
       from Cprems(1) have D: "distinct (al@e#bl)" by auto
       from Chyps[OF D P] have [simp]: "al=all'" "bl=bl'" by auto
       show ?thesis by simp
     qed
   qed simp
 
 
   lemma prop_match: "\<lbrakk> list_all P al; \<not>P e; \<not>P e'; list_all P bl \<rbrakk> \<Longrightarrow> (al@e#bl = al'@e'#bl') \<longleftrightarrow> (al=al' \<and> e=e' \<and> bl=bl')"
     apply (rule iffI, induct al arbitrary: al')
     apply (case_tac al', fastforce, fastforce)+
     done
 
   lemmas prop_matchD = rev_iffD1[OF _ prop_match[where P=P]] for P
 
   declare distinct_tl[simp]
 
 
 lemma list_se_match[simp]:
   "l1 \<noteq> [] \<Longrightarrow> l1@l2 = [a] \<longleftrightarrow> l1 = [a] \<and> l2 = []"
   "l2 \<noteq> [] \<Longrightarrow> l1@l2 = [a] \<longleftrightarrow> l1 = [] \<and> l2 = [a]"
   "l1 \<noteq> [] \<Longrightarrow> [a] = l1@l2 \<longleftrightarrow> l1 = [a] \<and> l2 = []"
   "l2 \<noteq> [] \<Longrightarrow> [a] = l1@l2 \<longleftrightarrow> l1 = [] \<and> l2 = [a]"
   apply (cases l1, simp_all)
   apply (cases l1, simp_all)
   apply (cases l1, auto) []
   apply (cases l1, auto) []
   done
 
 
 
 
 
     (* Placed here because it depends on xy_in_set_cases *)
 lemma distinct_map_eq: "\<lbrakk> distinct (List.map f l); f x = f y; x\<in>set l; y\<in>set l \<rbrakk> \<Longrightarrow> x=y"
   by (erule (2) xy_in_set_cases) auto
 
 
 
 lemma upt_append:
   assumes "i<j"
   shows "[0..<i]@[i..<j] = [0..<j]"
   using assms
   apply (induct j)
   apply simp
   apply (case_tac "i=j")
   apply auto
   done
 
 
 
 lemma upt_filter_extend:
   assumes LE: "u\<le>u'"
   assumes NP: "\<forall>i. u\<le>i \<and> i<u' \<longrightarrow> \<not>P i"
   shows "[i\<leftarrow>[0..<u]. P i] = [i\<leftarrow>[0..<u']. P i]"
 proof (cases "u=u'")
   case True thus ?thesis by simp
 next
   case False hence "u<u'" using LE by simp
   hence "[0..<u'] = [0..<u]@[u ..<u']"
     by (simp add: upt_append)
   hence "[i\<leftarrow>[0..<u']. P i] = [i\<leftarrow>[0..<u]. P i] @ [i\<leftarrow>[u..<u']. P i]"
     by simp
   also have "[i\<leftarrow>[u..<u']. P i] = []" using NP
     by (auto simp: filter_empty_conv)
   finally show ?thesis by simp
 qed
 
 
 lemma filter_upt_last:
   assumes E: "[k\<leftarrow>[0..<length l] . P (l!k)] = js @ [j]"
   assumes "j<i" and "i<length l"
   shows "\<not> P (l!i)"
 proof
   assume A: "P (l!i)"
   have "[0..<length l] = [0..<i]@[i..<length l]" using \<open>i<length l\<close>
     by (simp add: upt_append)
   also have "[i..<length l] = i#[Suc i..<length l]" using \<open>i<length l\<close>
     by (auto simp: upt_conv_Cons)
   finally
   have "[k\<leftarrow>[0..<i] . P (l!k)]@i#[k\<leftarrow>[Suc i..<length l] . P (l!k)] = js@[j]"
     unfolding E[symmetric]
     using \<open>P (l!i)\<close> by simp
   hence "j = last (i#[k\<leftarrow>[Suc i..<length l] . P (l!k)])"
     by (metis last_appendR last_snoc list.distinct(1))
   also have "\<dots> \<ge> i"
   proof -
     have "sorted (i#[k\<leftarrow>[Suc i..<length l] . P (l!k)])" (is "sorted ?l")
       by (simp add: sorted_filter[where f=id, simplified])
     hence "hd ?l \<le> last ?l"
       by (rule sorted_hd_last) simp
     thus ?thesis by simp
   qed
   finally have "i\<le>j" . thus False using \<open>j<i\<close> by simp
 qed
 
 lemma all_set_conv_nth: "(\<forall>x\<in>set l. P x) \<longleftrightarrow> (\<forall>i<length l. P (l!i))"
   by (auto intro: all_nth_imp_all_set)
 
 (* TODO: Special case of upt_eq_Nil_conv. Find cases where the latter does not work \<dots>
 *)    
 lemma upt_0_eq_Nil_conv[simp]: "[0..<j] = [] \<longleftrightarrow> j=0"
   by auto
 
 lemma filter_eq_snocD: "filter P l = l'@[x] \<Longrightarrow> x\<in>set l \<and> P x"
 proof -
   assume A: "filter P l = l'@[x]"
   hence "x\<in>set (filter P l)" by simp
   thus ?thesis by simp
 qed
 
 lemma lists_image_witness:
   assumes A: "x\<in>lists (f`Q)"
   obtains xo where "xo\<in>lists Q" "x=map f xo"
 proof -
   have "\<lbrakk> x\<in>lists (f`Q) \<rbrakk> \<Longrightarrow> \<exists>xo\<in>lists Q. x=map f xo"
   proof (induct x)
     case Nil thus ?case by auto
   next
     case (Cons x xs)
     then obtain xos where "xos\<in>lists Q" "xs=map f xos" by force
     moreover from Cons.prems have "x\<in>f`Q" by auto
     then obtain xo where "xo\<in>Q" "x=f xo" by auto
     ultimately show ?case
       by (rule_tac x="xo#xos" in bexI) auto
   qed
   thus ?thesis
     apply (simp_all add: A)
     apply (erule_tac bexE)
     apply (rule_tac that)
     apply assumption+
     done
 qed
 
 
 lemma map_of_None_filterD:
   "map_of xs x = None \<Longrightarrow> map_of (filter P xs) x = None"
 by(induct xs) auto
 
 lemma map_of_concat: "map_of (concat xss) = foldr (\<lambda>xs f. f ++ map_of xs) xss Map.empty"
 by(induct xss) simp_all
 
 lemma map_of_Some_split:
   "map_of xs k = Some v \<Longrightarrow> \<exists>ys zs. xs = ys @ (k, v) # zs \<and> map_of ys k = None"
 proof(induct xs)
   case (Cons x xs)
   obtain k' v' where x: "x = (k', v')" by(cases x)
   show ?case
   proof(cases "k' = k")
     case True
     with \<open>map_of (x # xs) k = Some v\<close> x have "x # xs = [] @ (k, v) # xs" "map_of [] k = None" by simp_all
     thus ?thesis by blast
   next
     case False
     with \<open>map_of (x # xs) k = Some v\<close> x
     have "map_of xs k = Some v" by simp
     from \<open>map_of xs k = Some v \<Longrightarrow> \<exists>ys zs. xs = ys @ (k, v) # zs \<and> map_of ys k = None\<close>[OF this]
     obtain ys zs where "xs = ys @ (k, v) # zs" "map_of ys k = None" by blast
     with False x have "x # xs = (x # ys) @ (k, v) # zs" "map_of (x # ys) k = None" by simp_all
     thus ?thesis by blast
   qed
 qed simp
 
 lemma map_add_find_left:
   "g k = None \<Longrightarrow> (f ++ g) k = f k"
 by(simp add: map_add_def)
 
 lemma map_add_left_None:
   "f k = None \<Longrightarrow> (f ++ g) k = g k"
 by(simp add: map_add_def split: option.split)
 
 lemma map_of_Some_filter_not_in:
   "\<lbrakk> map_of xs k = Some v; \<not> P (k, v); distinct (map fst xs) \<rbrakk> \<Longrightarrow> map_of (filter P xs) k = None"
 apply(induct xs)
 apply(auto)
 apply(auto simp add: map_of_eq_None_iff)
 done
 
 lemma distinct_map_fst_filterI: "distinct (map fst xs) \<Longrightarrow> distinct (map fst (filter P xs))"
 by(induct xs) auto
 
 lemma distinct_map_fstD: "\<lbrakk> distinct (map fst xs); (x, y) \<in> set xs; (x, z) \<in> set xs \<rbrakk> \<Longrightarrow> y = z"
 by(induct xs)(fastforce elim: notE rev_image_eqI)+
 
 
 
 lemma concat_filter_neq_Nil:
   "concat [ys\<leftarrow>xs. ys \<noteq> Nil] = concat xs"
 by(induct xs) simp_all
 
 lemma distinct_concat':
   "\<lbrakk>distinct [ys\<leftarrow>xs. ys \<noteq> Nil]; \<And>ys. ys \<in> set xs \<Longrightarrow> distinct ys;
    \<And>ys zs. \<lbrakk>ys \<in> set xs; zs \<in> set xs; ys \<noteq> zs\<rbrakk> \<Longrightarrow> set ys \<inter> set zs = {}\<rbrakk>
   \<Longrightarrow> distinct (concat xs)"
 by(erule distinct_concat[of "[ys\<leftarrow>xs. ys \<noteq> Nil]", unfolded concat_filter_neq_Nil]) auto
 
 lemma distinct_idx:
   assumes "distinct (map f l)"
   assumes "i<length l"
   assumes "j<length l"
   assumes "f (l!i) = f (l!j)"
   shows "i=j"
   by (metis assms distinct_conv_nth length_map nth_map)
 
 lemma replicate_Suc_conv_snoc:
   "replicate (Suc n) x = replicate n x @ [x]"
 by (metis replicate_Suc replicate_append_same)
 
 
 lemma filter_nth_ex_nth:
   assumes "n < length (filter P xs)"
   shows "\<exists>m. n \<le> m \<and> m < length xs \<and> filter P xs ! n = xs ! m \<and> filter P (take m xs) = take n (filter P xs)"
 using assms
 proof(induct xs rule: rev_induct)
   case Nil thus ?case by simp
 next
   case (snoc x xs)
   show ?case
   proof(cases "P x")
     case [simp]: False
     from \<open>n < length (filter P (xs @ [x]))\<close> have "n < length (filter P xs)" by simp
     hence "\<exists>m\<ge>n. m < length xs \<and> filter P xs ! n = xs ! m \<and> filter P (take m xs) = take n (filter P xs)" by(rule snoc)
     thus ?thesis by(auto simp add: nth_append)
   next
     case [simp]: True
     show ?thesis
     proof(cases "n = length (filter P xs)")
       case False
       with \<open>n < length (filter P (xs @ [x]))\<close> have "n < length (filter P xs)" by simp
       moreover hence "\<exists>m\<ge>n. m < length xs \<and> filter P xs ! n = xs ! m \<and> filter P (take m xs) = take n (filter P xs)"
         by(rule snoc)
       ultimately show ?thesis by(auto simp add: nth_append)
     next
       case [simp]: True
       hence "filter P (xs @ [x]) ! n = (xs @ [x]) ! length xs" by simp
       moreover have "length xs < length (xs @ [x])" by simp
       moreover have "length xs \<ge> n" by simp
       moreover have "filter P (take (length xs) (xs @ [x])) = take n (filter P (xs @ [x]))" by simp
       ultimately show ?thesis by blast
     qed
   qed
 qed
 
 lemma set_map_filter:
   "set (List.map_filter g xs) = {y. \<exists>x. x \<in> set xs \<and> g x = Some y}"
   by (induct xs) (auto simp add: List.map_filter_def set_eq_iff)
 
     
     
     
     
 
 subsection \<open>Quicksort by Relation\<close>
 
 text \<open>A functional implementation of quicksort on lists. It it similar to the
 one in Isabelle/HOL's example directory. However, it uses tail-recursion for append and arbitrary
 relations.\<close>
 
 fun partition_rev :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<times> 'a list) \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> 'a list)" where
    "partition_rev P (yes, no) [] = (yes, no)"
  | "partition_rev P (yes, no) (x # xs) =
       partition_rev P (if P x then (x # yes, no) else (yes, x # no)) xs"
 
 lemma partition_rev_filter_conv :
   "partition_rev P (yes, no) xs = (rev (filter P xs) @ yes,  rev (filter (Not \<circ> P) xs) @ no)"
 by (induct xs arbitrary: yes no) (simp_all)
 
 function quicksort_by_rel :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   "quicksort_by_rel R sl [] = sl"
 | "quicksort_by_rel R sl (x#xs) =
    (let (xs_s, xs_b) = partition_rev (\<lambda>y. R y x) ([],[]) xs in
     quicksort_by_rel R (x # (quicksort_by_rel R sl xs_b)) xs_s)"
 by pat_completeness simp_all
 termination
 by (relation "measure (\<lambda>(_, _, xs). length xs)")
    (simp_all add: partition_rev_filter_conv less_Suc_eq_le)
 
 lemma quicksort_by_rel_remove_acc :
   "quicksort_by_rel R sl xs = (quicksort_by_rel R [] xs @ sl)"
 proof (induct xs arbitrary: sl rule: measure_induct_rule[of "length"])
   case (less xs)
   note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis by simp
   next
     case (Cons x xs') note xs_eq[simp] = this
 
     obtain xs1 xs2 where part_rev_eq[simp]: "partition_rev (\<lambda>y. R y x) ([], []) xs' = (xs1, xs2)"
       by (rule prod.exhaust)
 
     from part_rev_eq[symmetric]
     have length_le: "length xs1 < length xs" "length xs2 < length xs"
       unfolding partition_rev_filter_conv by (simp_all add: less_Suc_eq_le)
 
     note ind_hyp1a = ind_hyp[OF length_le(1), of "x # quicksort_by_rel R [] xs2"]
     note ind_hyp1b = ind_hyp[OF length_le(1), of "x # quicksort_by_rel R [] xs2 @ sl"]
     note ind_hyp2 = ind_hyp[OF length_le(2), of sl]
 
     show ?thesis by (simp add: ind_hyp1a ind_hyp1b ind_hyp2)
   qed
 qed
 
 lemma quicksort_by_rel_remove_acc_guared :
   "sl \<noteq> [] \<Longrightarrow> quicksort_by_rel R sl xs = (quicksort_by_rel R [] xs @ sl)"
 by (metis quicksort_by_rel_remove_acc)
 
 lemma quicksort_by_rel_permutes [simp]:
   "mset (quicksort_by_rel R sl xs) = mset (xs @ sl)"
 proof (induct xs arbitrary: sl rule: measure_induct_rule[of "length"])
   case (less xs)
   note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis by simp
   next
     case (Cons x xs') note xs_eq[simp] = this
 
     obtain xs1 xs2 where part_rev_eq[simp]: "partition_rev (\<lambda>y. R y x) ([], []) xs' = (xs1, xs2)"
       by (rule prod.exhaust)
 
     from part_rev_eq[symmetric] have xs'_multi_eq : "mset xs' = mset xs1 + mset xs2"
       unfolding partition_rev_filter_conv
       by (simp add: mset_filter)
 
     from part_rev_eq[symmetric]
     have length_le: "length xs1 < length xs" "length xs2 < length xs"
       unfolding partition_rev_filter_conv by (simp_all add: less_Suc_eq_le)
 
     note ind_hyp[OF length_le(1)] ind_hyp[OF length_le(2)]
     thus ?thesis by (simp add: xs'_multi_eq union_assoc)
   qed
 qed
 
 lemma set_quicksort_by_rel [simp]: "set (quicksort_by_rel R sl xs) = set (xs @ sl)"
   unfolding set_mset_comp_mset [symmetric] o_apply by simp
 
 lemma sorted_wrt_quicksort_by_rel:
   fixes R:: "'x \<Rightarrow> 'x \<Rightarrow> bool"
   assumes lin : "\<And>x y. (R x y) \<or> (R y x)"
       and trans_R: "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z"
   shows "sorted_wrt R (quicksort_by_rel R [] xs)"
 proof (induct xs rule: measure_induct_rule[of "length"])
   case (less xs)
   note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis by simp
   next
     case (Cons x xs') note xs_eq[simp] = this
 
     obtain xs1 xs2 where part_rev_eq[simp]: "partition_rev (\<lambda>y. R y x) ([], []) xs' = (xs1, xs2)"
       by (rule prod.exhaust)
 
     from part_rev_eq[symmetric] have xs1_props: "\<And>y. y \<in> set xs1 \<Longrightarrow> (R y x)" and
                                      xs2_props: "\<And>y. y \<in> set xs2 \<Longrightarrow> \<not>(R y x)"
       unfolding partition_rev_filter_conv
       by simp_all
 
     from xs2_props lin have xs2_props': "\<And>y. y \<in> set xs2 \<Longrightarrow> (R x y)" by blast
     from xs2_props' xs1_props trans_R have xs1_props':
       "\<And>y1 y2. y1 \<in> set xs1 \<Longrightarrow> y2 \<in> set xs2 \<Longrightarrow> (R y1 y2)"
       by metis
 
     from part_rev_eq[symmetric]
     have length_le: "length xs1 < length xs" "length xs2 < length xs"
       unfolding partition_rev_filter_conv by (simp_all add: less_Suc_eq_le)
 
     note ind_hyps = ind_hyp[OF length_le(1)] ind_hyp[OF length_le(2)]
     thus ?thesis
       by (simp add: quicksort_by_rel_remove_acc_guared sorted_wrt_append Ball_def
                     xs1_props xs2_props' xs1_props')
   qed
 qed
 
 lemma sorted_quicksort_by_rel:
   "sorted (quicksort_by_rel (\<le>) [] xs)"
   by (rule sorted_wrt_quicksort_by_rel) auto
 
 lemma sort_quicksort_by_rel:
   "sort = quicksort_by_rel (\<le>) []"
   apply (rule ext, rule properties_for_sort)
   apply(simp_all add: sorted_quicksort_by_rel)
 done
 
 lemma [code]: "quicksort = quicksort_by_rel (\<le>) []"
   apply (subst sort_quicksort[symmetric])
   by (rule sort_quicksort_by_rel)
 
 subsection \<open>Mergesort by Relation\<close>
 
 text \<open>A functional implementation of mergesort on lists. It it similar to the
 one in Isabelle/HOL's example directory. However, it uses tail-recursion for append and arbitrary
 relations.\<close>
 
 fun mergesort_by_rel_split :: "('a list \<times> 'a list) \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> 'a list)" where
    "mergesort_by_rel_split (xs1, xs2) [] = (xs1, xs2)"
  | "mergesort_by_rel_split (xs1, xs2) [x] = (x # xs1, xs2)"
  | "mergesort_by_rel_split (xs1, xs2) (x1 # x2 # xs) =
     mergesort_by_rel_split (x1 # xs1, x2 # xs2) xs"
 
 lemma list_induct_first2 [consumes 0, case_names Nil Sing Cons2]:
 assumes "P []" "\<And>x. P [x]" "\<And>x1 x2 xs. P xs \<Longrightarrow> P (x1 # x2 #xs)"
 shows "P xs"
 proof (induct xs rule: length_induct)
   case (1 xs) note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis using assms(1) by simp
   next
     case (Cons x1 xs') note xs_eq[simp] = this
     thus ?thesis
     proof (cases xs')
       case Nil thus ?thesis using assms(2) by simp
     next
       case (Cons x2 xs'') note xs'_eq[simp] = this
       show ?thesis
         by (simp add: ind_hyp assms(3))
     qed
   qed
 qed
 
 lemma mergesort_by_rel_split_length :
   "length (fst (mergesort_by_rel_split (xs1, xs2) xs)) = length xs1 + (length xs div 2) + (length xs mod 2) \<and>
    length (snd (mergesort_by_rel_split (xs1, xs2) xs)) = length xs2 + (length xs div 2)"
 by (induct xs arbitrary: xs1 xs2 rule: list_induct_first2)
    (simp_all)
 
 lemma mset_mergesort_by_rel_split [simp]:
   "mset (fst (mergesort_by_rel_split (xs1, xs2) xs)) +
    mset (snd (mergesort_by_rel_split (xs1, xs2) xs)) =
    mset xs + mset xs1 + mset xs2"
   apply (induct xs arbitrary: xs1 xs2 rule: list_induct_first2)
   apply (simp_all add: ac_simps)
 done
 
 fun mergesort_by_rel_merge :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "mergesort_by_rel_merge R (x#xs) (y#ys) =
      (if R x y then x # mergesort_by_rel_merge R xs (y#ys) else y # mergesort_by_rel_merge R (x#xs) ys)"
 | "mergesort_by_rel_merge R xs [] = xs"
 | "mergesort_by_rel_merge R [] ys = ys"
 
 declare mergesort_by_rel_merge.simps [simp del]
 
 lemma mergesort_by_rel_merge_simps[simp] :
   "mergesort_by_rel_merge R (x#xs) (y#ys) =
      (if R x y then x # mergesort_by_rel_merge R xs (y#ys) else y # mergesort_by_rel_merge R (x#xs) ys)"
   "mergesort_by_rel_merge R xs [] = xs"
   "mergesort_by_rel_merge R [] ys = ys"
   apply (simp_all add: mergesort_by_rel_merge.simps)
   apply (cases ys)
   apply (simp_all add: mergesort_by_rel_merge.simps)
 done
 
 lemma mergesort_by_rel_merge_induct [consumes 0, case_names Nil1 Nil2 Cons1 Cons2]:
 assumes "\<And>xs::'a list. P xs []" "\<And>ys::'b list. P [] ys"
         "\<And>x xs y ys. R x y \<Longrightarrow> P xs (y # ys) \<Longrightarrow> P (x # xs) (y # ys)"
         "\<And>x xs y ys. \<not>(R x y) \<Longrightarrow> P (x # xs) ys \<Longrightarrow> P (x # xs) (y # ys)"
 shows "P xs ys"
 proof (induct xs arbitrary: ys)
   case Nil thus ?case using assms(2) by simp
 next
   case (Cons x xs) note P_xs = this
   show ?case
   proof (induct ys)
     case Nil thus ?case using assms(1) by simp
   next
     case (Cons y ys) note P_x_xs_ys = this
     show ?case using assms(3,4)[of x y xs ys] P_x_xs_ys P_xs by metis
   qed
 qed
 
 lemma mset_mergesort_by_rel_merge [simp]:
   "mset (mergesort_by_rel_merge R xs ys) = mset xs + mset ys"
 by (induct R xs ys rule: mergesort_by_rel_merge.induct) (simp_all add: ac_simps)
 
 lemma set_mergesort_by_rel_merge [simp]:
   "set (mergesort_by_rel_merge R xs ys) = set xs \<union> set ys"
   by (induct R xs ys rule: mergesort_by_rel_merge.induct) auto
 
 lemma sorted_wrt_mergesort_by_rel_merge [simp]:
   assumes lin : "\<And>x y. (R x y) \<or> (R y x)"
       and trans_R: "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z"
   shows  "sorted_wrt R (mergesort_by_rel_merge R xs ys) \<longleftrightarrow>
           sorted_wrt R xs \<and> sorted_wrt R ys"
 proof (induct xs ys rule: mergesort_by_rel_merge_induct[where R = R])
   case Nil1 thus ?case by simp
 next
   case Nil2 thus ?case by simp
 next
   case (Cons1 x xs y ys) thus ?case
     by (simp add: Ball_def) (metis trans_R)
 next
   case (Cons2 x xs y ys) thus ?case
     apply (auto simp add: Ball_def)
     apply (metis lin)
     apply (metis lin trans_R)
   done
 qed
 
 function mergesort_by_rel :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list"
 where
   "mergesort_by_rel R xs =
     (if length xs < 2 then xs else
      (mergesort_by_rel_merge R
        (mergesort_by_rel R (fst (mergesort_by_rel_split ([], []) xs)))
        (mergesort_by_rel R (snd (mergesort_by_rel_split ([], []) xs)))))"
 by auto
 termination
 by (relation "measure (\<lambda>(_, xs). length xs)")
   (simp_all add: mergesort_by_rel_split_length not_less minus_div_mult_eq_mod [symmetric])
 
 declare mergesort_by_rel.simps [simp del]
 
 lemma mergesort_by_rel_simps [simp, code] :
   "mergesort_by_rel R [] = []"
   "mergesort_by_rel R [x] = [x]"
   "mergesort_by_rel R (x1 # x2 # xs) =
    (let (xs1, xs2) = (mergesort_by_rel_split ([x1], [x2]) xs) in
    mergesort_by_rel_merge R (mergesort_by_rel R xs1) (mergesort_by_rel R xs2))"
 apply (simp add: mergesort_by_rel.simps)
 apply (simp add: mergesort_by_rel.simps)
 apply (simp add: mergesort_by_rel.simps[of _ "x1 # x2 # xs"] split: prod.splits)
 done
 
 lemma mergesort_by_rel_permutes [simp]:
   "mset (mergesort_by_rel R xs) = mset xs"
 proof (induct xs rule: length_induct)
   case (1 xs) note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis by simp
   next
     case (Cons x1 xs') note xs_eq[simp] = this
     show ?thesis
     proof (cases xs')
       case Nil thus ?thesis by simp
     next
       case (Cons x2 xs'') note xs'_eq[simp] = this
 
       have "length (fst (mergesort_by_rel_split ([], []) xs)) < length xs"
            "length (snd (mergesort_by_rel_split ([], []) xs)) < length xs"
         by (simp_all add: mergesort_by_rel_split_length)
       with ind_hyp show ?thesis
         unfolding mergesort_by_rel.simps[of _ xs]
         by (simp add: ac_simps)
     qed
   qed
 qed
 
 lemma set_mergesort_by_rel [simp]: "set (mergesort_by_rel R xs) = set xs"
   unfolding set_mset_comp_mset [symmetric] o_apply by simp
 
 lemma sorted_wrt_mergesort_by_rel:
   fixes R:: "'x \<Rightarrow> 'x \<Rightarrow> bool"
   assumes lin : "\<And>x y. (R x y) \<or> (R y x)"
       and trans_R: "\<And>x y z. R x y \<Longrightarrow> R y z \<Longrightarrow> R x z"
   shows "sorted_wrt R (mergesort_by_rel R xs)"
 proof (induct xs rule: measure_induct_rule[of "length"])
   case (less xs)
   note ind_hyp = this
 
   show ?case
   proof (cases xs)
     case Nil thus ?thesis by simp
   next
     case (Cons x xs') note xs_eq[simp] = this
     thus ?thesis
     proof (cases xs')
       case Nil thus ?thesis by simp
     next
       case (Cons x2 xs'') note xs'_eq[simp] = this
 
       have "length (fst (mergesort_by_rel_split ([], []) xs)) < length xs"
            "length (snd (mergesort_by_rel_split ([], []) xs)) < length xs"
         by (simp_all add: mergesort_by_rel_split_length)
       with ind_hyp show ?thesis
         unfolding mergesort_by_rel.simps[of _ xs]
         by (simp add: sorted_wrt_mergesort_by_rel_merge[OF lin trans_R])
     qed
   qed
 qed
 
 lemma sorted_mergesort_by_rel:
   "sorted (mergesort_by_rel (\<le>) xs)"
 by (rule sorted_wrt_mergesort_by_rel) auto
 
 lemma sort_mergesort_by_rel:
   "sort = mergesort_by_rel (\<le>)"
   apply (rule ext, rule properties_for_sort)
   apply(simp_all add: sorted_mergesort_by_rel)
 done
 
 definition "mergesort = mergesort_by_rel (\<le>)"
 
 lemma sort_mergesort: "sort = mergesort"
   unfolding mergesort_def by (rule sort_mergesort_by_rel)
 
 subsubsection \<open>Mergesort with Remdup\<close>
 term merge
 
 fun merge :: "'a::{linorder} list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
    "merge [] l2 = l2"
  | "merge l1 [] = l1"
  | "merge (x1 # l1) (x2 # l2) =
     (if (x1 < x2) then x1 # (merge l1 (x2 # l2)) else
      (if (x1 = x2) then x1 # (merge l1 l2) else x2 # (merge (x1 # l1) l2)))"
 
 lemma merge_correct :
 assumes l1_OK: "distinct l1 \<and> sorted l1"
 assumes l2_OK: "distinct l2 \<and> sorted l2"
 shows "distinct (merge l1 l2) \<and> sorted (merge l1 l2) \<and> set (merge l1 l2) = set l1 \<union> set l2"
 using assms
 proof (induct l1 arbitrary: l2)
   case Nil thus ?case by simp
 next
   case (Cons x1 l1 l2)
   note x1_l1_props = Cons(2)
   note l2_props = Cons(3)
 
   from x1_l1_props have l1_props: "distinct l1 \<and> sorted l1"
                     and x1_nin_l1: "x1 \<notin> set l1"
                     and x1_le: "\<And>x. x \<in> set l1 \<Longrightarrow> x1 \<le> x"
     by (simp_all add: Ball_def)
 
   note ind_hyp_l1 = Cons(1)[OF l1_props]
 
   show ?case
   using l2_props
   proof (induct l2)
     case Nil with x1_l1_props show ?case by simp
   next
     case (Cons x2 l2)
     note x2_l2_props = Cons(2)
     from x2_l2_props have l2_props: "distinct l2 \<and> sorted l2"
                     and x2_nin_l2: "x2 \<notin> set l2"
                     and x2_le: "\<And>x. x \<in> set l2 \<Longrightarrow> x2 \<le> x"
     by (simp_all add: Ball_def)
 
     note ind_hyp_l2 = Cons(1)[OF l2_props]
     show ?case
     proof (cases "x1 < x2")
       case True note x1_less_x2 = this
 
       from ind_hyp_l1[OF x2_l2_props] x1_less_x2 x1_nin_l1 x1_le x2_le
       show ?thesis
         apply (auto simp add: Ball_def)
         apply (metis linorder_not_le)
         apply (metis linorder_not_less xt1(6) xt1(9))
       done
     next
       case False note x2_le_x1 = this
 
       show ?thesis
       proof (cases "x1 = x2")
         case True note x1_eq_x2 = this
 
         from ind_hyp_l1[OF l2_props] x1_le x2_le x2_nin_l2 x1_eq_x2 x1_nin_l1
         show ?thesis by (simp add: x1_eq_x2 Ball_def)
       next
         case False note x1_neq_x2 = this
         with x2_le_x1 have x2_less_x1 : "x2 < x1" by auto
 
         from ind_hyp_l2 x2_le_x1 x1_neq_x2 x2_le x2_nin_l2 x1_le
         show ?thesis
           apply (simp add: x2_less_x1 Ball_def)
           apply (metis linorder_not_le x2_less_x1 xt1(7))
         done
       qed
     qed
   qed
 qed
 
 function merge_list :: "'a::{linorder} list list \<Rightarrow> 'a list list \<Rightarrow> 'a list" where
    "merge_list [] [] = []"
  | "merge_list [] [l] = l"
  | "merge_list (la # acc2) [] = merge_list [] (la # acc2)"
  | "merge_list (la # acc2) [l] = merge_list [] (l # la # acc2)"
  | "merge_list acc2 (l1 # l2 # ls) =
     merge_list ((merge l1 l2) # acc2) ls"
 by pat_completeness simp_all
 termination
 by (relation "measure (\<lambda>(acc, ls). 3 * length acc + 2 * length ls)") (simp_all)
 
 lemma merge_list_correct :
 assumes ls_OK: "\<And>l. l \<in> set ls \<Longrightarrow> distinct l \<and> sorted l"
 assumes as_OK: "\<And>l. l \<in> set as \<Longrightarrow> distinct l \<and> sorted l"
 shows "distinct (merge_list as ls) \<and> sorted (merge_list as ls) \<and>
        set (merge_list as ls) = set (concat (as @ ls))"
 using assms
 proof (induct as ls rule: merge_list.induct)
   case 1 thus ?case by simp
 next
   case 2 thus ?case by simp
 next
   case 3 thus ?case by simp
 next
   case 4 thus ?case by auto
 next
   case (5 acc l1 l2 ls)
   note ind_hyp = 5(1)
   note l12_l_OK = 5(2)
   note acc_OK = 5(3)
 
   from l12_l_OK acc_OK merge_correct[of l1 l2]
     have set_merge_eq: "set (merge l1 l2) = set l1 \<union> set l2" by auto
 
   from l12_l_OK acc_OK merge_correct[of l1 l2]
   have "distinct (merge_list (merge l1 l2 # acc) ls) \<and>
         sorted (merge_list (merge l1 l2 # acc) ls) \<and>
         set (merge_list (merge l1 l2 # acc) ls) =
         set (concat ((merge l1 l2 # acc) @ ls))"
     by (rule_tac ind_hyp) auto
   with set_merge_eq show ?case by auto
 qed
 
 
 definition mergesort_remdups where
   "mergesort_remdups xs = merge_list [] (map (\<lambda>x. [x]) xs)"
 
 lemma mergesort_remdups_correct :
   "distinct (mergesort_remdups l)
   \<and> sorted (mergesort_remdups l)
   \<and> (set (mergesort_remdups l) = set l)"
 proof -
   let ?l' = "map (\<lambda>x. [x]) l"
 
   { fix xs
     assume "xs \<in> set ?l'"
     then obtain x where xs_eq: "xs = [x]" by auto
     hence "distinct xs \<and> sorted xs" by simp
   } note l'_OK = this
 
   from merge_list_correct[of "?l'" "[]", OF l'_OK]
   show ?thesis unfolding mergesort_remdups_def by simp
 qed
 
 (* TODO: Move *)
 lemma ex1_eqI: "\<lbrakk>\<exists>!x. P x; P a; P b\<rbrakk> \<Longrightarrow> a=b"
   by blast
 
 lemma remdup_sort_mergesort_remdups:
   "remdups o sort = mergesort_remdups" (is "?lhs=?rhs")
 proof
   fix l
   have "set (?lhs l) = set l" and "sorted (?lhs l)" and "distinct (?lhs l)"
     by simp_all
   moreover note mergesort_remdups_correct
   ultimately show "?lhs l = ?rhs l"
     by (auto intro!: ex1_eqI[OF finite_sorted_distinct_unique[OF finite_set]])
 qed
 
 subsection \<open>Native Integers\<close>  
 lemma int_of_integer_less_iff: "int_of_integer x < int_of_integer y \<longleftrightarrow> x<y"
   by (simp add: less_integer_def)
 
 lemma nat_of_integer_less_iff: "x\<ge>0 \<Longrightarrow> y\<ge>0 \<Longrightarrow> nat_of_integer x < nat_of_integer y \<longleftrightarrow> x<y"
   unfolding nat_of_integer.rep_eq
   by (auto simp: int_of_integer_less_iff nat_less_eq_zless int_of_integer_less_iff[of 0, simplified])
   
   
 subsection "Natural Numbers"
 lemma exists_leI:
   assumes hyp: "(\<forall>n' < n. \<not> P n') \<Longrightarrow> P (n::nat)"
   shows "\<exists>n' \<le> n. P n'"
 proof (rule classical)
   assume contra: "\<not> (\<exists>n'\<le>n. P n')"
   hence "\<forall>n' < n. \<not> P n'" by auto
   hence "P n" by (rule hyp)
   thus "\<exists>n'\<le>n. P n'" by auto
 qed
 
 subsubsection \<open>Induction on nat\<close>
   lemma nat_compl_induct[case_names 0 Suc]: "\<lbrakk>P 0; \<And>n . \<forall>nn. nn \<le> n \<longrightarrow> P nn \<Longrightarrow> P (Suc n)\<rbrakk> \<Longrightarrow> P n"
     apply(induct_tac n rule: nat_less_induct)
     apply(case_tac n)
     apply(auto)
   done
 
   lemma nat_compl_induct'[case_names 0 Suc]: "\<lbrakk>P 0; !! n . \<lbrakk>!! nn . nn \<le> n \<Longrightarrow> P nn\<rbrakk> \<Longrightarrow> P (Suc n)\<rbrakk> \<Longrightarrow> P n"
     apply(induct_tac n rule: nat_less_induct)
     apply(case_tac n)
     apply(auto)
   done
 
   lemma nz_le_conv_less: "0<k \<Longrightarrow> k \<le> m \<Longrightarrow> k - Suc 0 < m"
     by auto
       
   lemma min_Suc_gt[simp]: 
     "a<b \<Longrightarrow> min (Suc a) b = Suc a"  
     "a<b \<Longrightarrow> min b (Suc a) = Suc a"  
     by auto
     
     
 subsection \<open>Integer\<close>
 
 text \<open>Some setup from \<open>int\<close> transferred to \<open>integer\<close>\<close>
 
 lemma atLeastLessThanPlusOne_atLeastAtMost_integer: "{l..<u+1} = {l..(u::integer)}"
   apply (auto simp add: atLeastAtMost_def atLeastLessThan_def)
   including integer.lifting
   apply transfer
   apply simp
   done
 
 lemma atLeastPlusOneAtMost_greaterThanAtMost_integer: "{l+1..u} = {l<..(u::integer)}"
   including integer.lifting
   by (auto simp add: atLeastAtMost_def greaterThanAtMost_def, transfer, simp)
 
 lemma atLeastPlusOneLessThan_greaterThanLessThan_integer:
     "{l+1..<u} = {l<..<u::integer}"
   including integer.lifting
   by (auto simp add: atLeastLessThan_def greaterThanLessThan_def, transfer, simp)
 
 lemma image_atLeastZeroLessThan_integer: "0 \<le> u \<Longrightarrow>
     {(0::integer)..<u} = of_nat ` {..<nat_of_integer u}"
   including integer.lifting
   apply (unfold image_def lessThan_def)
   apply auto
   apply (rule_tac x = "nat_of_integer x" in exI)
   apply transfer
   apply (auto simp add: zless_nat_eq_int_zless [THEN sym])
   apply transfer
   apply simp
   done
 
 lemma image_add_integer_atLeastLessThan:
     "(%x. x + (l::integer)) ` {0..<u-l} = {l..<u}"
   apply (auto simp add: image_def)
   apply (rule_tac x = "x - l" in bexI)
   apply auto
   done
 
 lemma finite_atLeastZeroLessThan_integer: "finite {(0::integer)..<u}"
   apply (cases "0 \<le> u")
   apply (subst image_atLeastZeroLessThan_integer, assumption)
   apply (rule finite_imageI)
   apply auto
   done
 
 lemma finite_atLeastLessThan_integer [iff]: "finite {l..<u::integer}"
   apply (subgoal_tac "(%x. x + l) ` {0..<u-l} = {l..<u}")
   apply (erule subst)
   apply (rule finite_imageI)
   apply (rule finite_atLeastZeroLessThan_integer)
   apply (rule image_add_integer_atLeastLessThan)
   done
 
 lemma finite_atLeastAtMost_integer [iff]: "finite {l..(u::integer)}"
   by (subst atLeastLessThanPlusOne_atLeastAtMost_integer [THEN sym], simp)
 
 lemma finite_greaterThanAtMost_integer [iff]: "finite {l<..(u::integer)}"
   by (subst atLeastPlusOneAtMost_greaterThanAtMost_integer [THEN sym], simp)
 
 lemma finite_greaterThanLessThan_integer [iff]: "finite {l<..<u::integer}"
   by (subst atLeastPlusOneLessThan_greaterThanLessThan_integer [THEN sym], simp)
 
 
 subsection \<open>Functions of type @{typ "bool\<Rightarrow>bool"}\<close>
   lemma boolfun_cases_helper: "g=(\<lambda>x. False) | g=(\<lambda>x. x) | g=(\<lambda>x. True) | g= (\<lambda>x. \<not>x)"
   proof -
     { assume "g False" "g True"
       hence "g = (\<lambda>x. True)" by (rule_tac ext, case_tac x, auto)
     } moreover {
       assume "g False" "\<not>g True"
       hence "g = (\<lambda>x. \<not>x)" by (rule_tac ext, case_tac x, auto)
     } moreover {
       assume "\<not>g False" "g True"
       hence "g = (\<lambda>x. x)" by (rule_tac ext, case_tac x, auto)
     } moreover {
       assume "\<not>g False" "\<not>g True"
       hence "g = (\<lambda>x. False)" by (rule_tac ext, case_tac x, auto)
     } ultimately show ?thesis by fast
   qed
 
   lemma boolfun_cases[case_names False Id True Neg]: "\<lbrakk>g=(\<lambda>x. False) \<Longrightarrow> P; g=(\<lambda>x. x) \<Longrightarrow> P; g=(\<lambda>x. True) \<Longrightarrow> P; g=(\<lambda>x. \<not>x) \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   proof -
     note boolfun_cases_helper[of g]
     moreover assume "g=(\<lambda>x. False) \<Longrightarrow> P" "g=(\<lambda>x. x) \<Longrightarrow> P" "g=(\<lambda>x. True) \<Longrightarrow> P" "g=(\<lambda>x. \<not>x) \<Longrightarrow> P"
     ultimately show ?thesis by fast
   qed
 
 
 subsection \<open>Definite and indefinite description\<close>
         text "Combined definite and indefinite description for binary predicate"
   lemma some_theI: assumes EX: "\<exists>a b . P a b" and BUN: "!! b1 b2 . \<lbrakk>\<exists>a . P a b1; \<exists>a . P a b2\<rbrakk> \<Longrightarrow> b1=b2"
     shows "P (SOME a . \<exists>b . P a b) (THE b . \<exists>a . P a b)"
   proof -
                 from EX have "\<exists>b. P (SOME a. \<exists>b. P a b) b" by (rule someI_ex)
                 moreover from EX have "\<exists>b. \<exists>a. P a b" by blast
     with BUN theI'[of "\<lambda>b. \<exists>a. P a b"] have "\<exists>a. P a (THE b. \<exists>a. P a b)" by (unfold Ex1_def, blast)
                 moreover note BUN
                 ultimately show ?thesis by (fast)
         qed
 
   lemma some_insert_self[simp]: "S\<noteq>{} \<Longrightarrow> insert (SOME x. x\<in>S) S = S"
     by (auto intro: someI)
 
   lemma some_elem[simp]: "S\<noteq>{} \<Longrightarrow> (SOME x. x\<in>S) \<in> S"
     by (auto intro: someI)
 
 subsubsection\<open>Hilbert Choice with option\<close>
 
 definition Eps_Opt where
   "Eps_Opt P = (if (\<exists>x. P x) then Some (SOME x. P x) else None)"
 
 lemma some_opt_eq_trivial[simp] :
   "Eps_Opt (\<lambda>y. y = x) = Some x"
 unfolding Eps_Opt_def by simp
 
 lemma some_opt_sym_eq_trivial[simp] :
   "Eps_Opt ((=) x) = Some x"
 unfolding Eps_Opt_def by simp
 
 lemma some_opt_false_trivial[simp] :
   "Eps_Opt (\<lambda>_. False) = None"
 unfolding Eps_Opt_def by simp
 
 lemma Eps_Opt_eq_None[simp] :
   "Eps_Opt P = None \<longleftrightarrow> \<not>(Ex P)"
 unfolding Eps_Opt_def by simp
 
 lemma Eps_Opt_eq_Some_implies :
   "Eps_Opt P = Some x \<Longrightarrow> P x"
 unfolding Eps_Opt_def
 by (metis option.inject option.simps(2) someI_ex)
 
 lemma Eps_Opt_eq_Some :
 assumes P_prop: "\<And>x'. P x \<Longrightarrow> P x' \<Longrightarrow> x' = x"
 shows "Eps_Opt P = Some x \<longleftrightarrow> P x"
 using P_prop
 unfolding Eps_Opt_def
 by (metis option.inject option.simps(2) someI_ex)
 
 subsection \<open>Product Type\<close>
 
 lemma nested_case_prod_simp: "(\<lambda>(a,b) c. f a b c) x y =
   (case_prod (\<lambda>a b. f a b y) x)"
   by (auto split: prod.split)
 
 lemma fn_fst_conv: "(\<lambda>x. (f (fst x))) = (\<lambda>(a,_). f a)"
   by auto
 lemma fn_snd_conv: "(\<lambda>x. (f (snd x))) = (\<lambda>(_,b). f b)"
   by auto
 
 fun pairself where
   "pairself f (a,b) = (f a, f b)"
 
 lemma pairself_image_eq[simp]:
   "pairself f ` {(a,b). P a b} = {(f a, f b)| a b. P a b}"
   by force
 
 lemma pairself_image_cart[simp]: "pairself f ` (A\<times>B) = f`A \<times> f`B"
   by (auto simp: image_def)
 
 lemma in_prod_fst_sndI: "fst x \<in> A \<Longrightarrow> snd x \<in> B \<Longrightarrow> x\<in>A\<times>B"
   by (cases x) auto
 
 lemma inj_Pair[simp]:
   "inj_on (\<lambda>x. (x,c x)) S"
   "inj_on (\<lambda>x. (c x,x)) S"
   by (auto intro!: inj_onI)
 
 declare Product_Type.swap_inj_on[simp]
 
 lemma img_fst [intro]:
   assumes "(a,b) \<in> S"
   shows "a \<in> fst ` S"
 by (rule image_eqI[OF _ assms]) simp
 
 lemma img_snd [intro]:
   assumes "(a,b) \<in> S"
   shows "b \<in> snd ` S"
 by (rule image_eqI[OF _ assms]) simp
 
 lemma range_prod:
   "range f \<subseteq> (range (fst \<circ> f)) \<times> (range (snd \<circ> f))"
 proof
   fix y
   assume "y \<in> range f"
   then obtain x where y: "y = f x" by auto
   hence "y = (fst(f x), snd(f x))"
     by simp
   thus "y \<in> (range (fst \<circ> f)) \<times> (range (snd \<circ> f))"
     by (fastforce simp add: image_def)
 qed
 
 lemma finite_range_prod:
   assumes fst: "finite (range (fst \<circ> f))"
   and     snd: "finite (range (snd \<circ> f))"
   shows "finite (range f)"
 proof -
   from fst snd have "finite (range (fst \<circ> f) \<times> range (snd \<circ> f))"
     by (rule finite_SigmaI)
   thus ?thesis
     by (rule finite_subset[OF range_prod])
 qed
 
 lemma fstE:
   "x = (a,b) \<Longrightarrow> P (fst x) \<Longrightarrow> P a"
 by (metis fst_conv)
 
 lemma sndE:
   "x = (a,b) \<Longrightarrow> P (snd x) \<Longrightarrow> P b"
 by (metis snd_conv)
 
 subsubsection \<open>Uncurrying\<close>
 
 (* TODO: Move to HOL/Product_Type? Lars H: "It's equal to case_prod, should use an abbreviation"*)
 definition uncurry :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c" where
   "uncurry f \<equiv> \<lambda>(a,b). f a b"
 
 lemma uncurry_apply[simp]: "uncurry f (a,b) = f a b"
   unfolding uncurry_def
   by simp
 
 lemma curry_uncurry_id[simp]: "curry (uncurry f) = f"
   unfolding uncurry_def
   by simp
 
 lemma uncurry_curry_id[simp]: "uncurry (curry f) = f"
   unfolding uncurry_def
   by simp
 
 lemma do_curry: "f (a,b) = curry f a b" by simp
 lemma do_uncurry: "f a b = uncurry f (a,b)" by simp
   
 subsection \<open>Sum Type\<close>    
 lemma map_sum_Inr_conv: "map_sum fl fr s = Inr y \<longleftrightarrow> (\<exists>x. s=Inr x \<and> y = fr x)"
   by (cases s) auto
 lemma map_sum_Inl_conv: "map_sum fl fr s = Inl y \<longleftrightarrow> (\<exists>x. s=Inl x \<and> y = fl x)"
   by (cases s) auto
   
   
 subsection \<open>Directed Graphs and Relations\<close>
 
   subsubsection "Reflexive-Transitive Closure"
   lemma r_le_rtrancl[simp]: "S\<subseteq>S\<^sup>*" by auto
   lemma rtrancl_mono_rightI: "S\<subseteq>S' \<Longrightarrow> S\<subseteq>S'\<^sup>*" by auto
 
   lemma trancl_sub:
     "R \<subseteq> R\<^sup>+"
   by auto
 
   lemma trancl_single[simp]:
     "{(a,b)}\<^sup>+ = {(a,b)}"
     by (auto simp: trancl_insert)
 
 
   text \<open>Pick first non-reflexive step\<close>
   lemma converse_rtranclE'[consumes 1, case_names base step]:
     assumes "(u,v)\<in>R\<^sup>*"
     obtains "u=v"
     | vh where "u\<noteq>vh" and "(u,vh)\<in>R" and "(vh,v)\<in>R\<^sup>*"
     using assms
     apply (induct rule: converse_rtrancl_induct)
     apply auto []
     apply (case_tac "y=z")
     apply auto
     done
 
   lemma in_rtrancl_insert: "x\<in>R\<^sup>* \<Longrightarrow> x\<in>(insert r R)\<^sup>*"
     by (metis in_mono rtrancl_mono subset_insertI)
 
 
   lemma rtrancl_apply_insert: "R\<^sup>*``(insert x S) = insert x (R\<^sup>*``(S\<union>R``{x}))"
     apply (auto)
     apply (erule converse_rtranclE)
     apply auto [2]
     apply (erule converse_rtranclE)
     apply (auto intro: converse_rtrancl_into_rtrancl) [2]
     done
 
 
 
 
   text \<open>A path in a graph either does not use nodes from S at all, or it has a prefix leading to a node in S and a suffix that does not use nodes in S\<close>
   lemma rtrancl_last_visit[cases set, case_names no_visit last_visit_point]:
     shows
     "\<lbrakk> (q,q')\<in>R\<^sup>*;
        (q,q')\<in>(R-UNIV\<times>S)\<^sup>* \<Longrightarrow> P;
        !!qt. \<lbrakk> qt\<in>S; (q,qt)\<in>R\<^sup>+; (qt,q')\<in>(R-UNIV\<times>S)\<^sup>* \<rbrakk> \<Longrightarrow> P
      \<rbrakk> \<Longrightarrow> P"
   proof (induct rule: converse_rtrancl_induct[case_names refl step])
     case refl thus ?case by auto
   next
     case (step q qh)
     show P proof (rule step.hyps(3))
       assume A: "(qh,q')\<in>(R-UNIV\<times>S)\<^sup>*"
       show P proof (cases "qh\<in>S")
         case False
         with step.hyps(1) A have "(q,q')\<in>(R-UNIV\<times>S)\<^sup>*"
           by (auto intro: converse_rtrancl_into_rtrancl)
         with step.prems(1) show P .
       next
         case True
         from step.hyps(1) have "(q,qh)\<in>R\<^sup>+" by auto
         with step.prems(2) True A show P by blast
       qed
     next
       fix qt
       assume A: "qt\<in>S" "(qh,qt)\<in>R\<^sup>+" "(qt,q')\<in>(R-UNIV\<times>S)\<^sup>*"
       with step.hyps(1) have "(q,qt)\<in>R\<^sup>+" by auto
       with step.prems(2) A(1,3) show P by blast
     qed
   qed
 
   text \<open>Less general version of \<open>rtrancl_last_visit\<close>, but there's a short automatic proof\<close>
   lemma rtrancl_last_visit': "\<lbrakk> (q,q')\<in>R\<^sup>*; (q,q')\<in>(R-UNIV\<times>S)\<^sup>* \<Longrightarrow> P; !!qt. \<lbrakk> qt\<in>S; (q,qt)\<in>R\<^sup>*; (qt,q')\<in>(R-UNIV\<times>S)\<^sup>* \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (induct rule: converse_rtrancl_induct) (auto intro: converse_rtrancl_into_rtrancl)
 
   lemma rtrancl_last_visit_node:
     assumes "(s,s')\<in>R\<^sup>*"
     shows "s\<noteq>sh \<and> (s,s')\<in>(R \<inter> (UNIV \<times> (-{sh})))\<^sup>* \<or>
             (s,sh)\<in>R\<^sup>* \<and> (sh,s')\<in>(R \<inter> (UNIV \<times> (-{sh})))\<^sup>*"
     using assms
   proof (induct rule: converse_rtrancl_induct)
     case base thus ?case by auto
   next
     case (step s st)
     moreover {
       assume P: "(st,s')\<in> (R \<inter> UNIV \<times> - {sh})\<^sup>*"
       {
         assume "st=sh" with step have ?case
           by auto
       } moreover {
         assume "st\<noteq>sh"
         with \<open>(s,st)\<in>R\<close> have "(s,st)\<in>(R \<inter> UNIV \<times> - {sh})\<^sup>*" by auto
         also note P
         finally have ?case by blast
       } ultimately have ?case by blast
     } moreover {
       assume P: "(st, sh) \<in> R\<^sup>* \<and> (sh, s') \<in> (R \<inter> UNIV \<times> - {sh})\<^sup>*"
       with step(1) have ?case
         by (auto dest: converse_rtrancl_into_rtrancl)
     } ultimately show ?case by blast
   qed
 
   text \<open>Find last point where a path touches a set\<close>
   lemma rtrancl_last_touch: "\<lbrakk> (q,q')\<in>R\<^sup>*; q\<in>S; !!qt. \<lbrakk> qt\<in>S; (q,qt)\<in>R\<^sup>*; (qt,q')\<in>(R-UNIV\<times>S)\<^sup>* \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (erule rtrancl_last_visit') auto
 
   text \<open>A path either goes over edge once, or not at all\<close>
   lemma trancl_over_edgeE:
     assumes "(u,w)\<in>(insert (v1,v2) E)\<^sup>+"
     obtains "(u,w)\<in>E\<^sup>+"
     | "(u,v1)\<in>E\<^sup>*" and "(v2,w)\<in>E\<^sup>*"
     using assms
   proof induct
     case (base z) thus ?thesis
       by (metis insertE prod.inject r_into_trancl' rtrancl_eq_or_trancl)
   next
     case (step y z) thus ?thesis
       by (metis (opaque_lifting, no_types)
         Pair_inject insertE rtrancl.simps trancl.simps trancl_into_rtrancl)
   qed
 
   lemma rtrancl_image_advance: "\<lbrakk>q\<in>R\<^sup>* `` Q0; (q,x)\<in>R\<rbrakk> \<Longrightarrow> x\<in>R\<^sup>* `` Q0"
     by (auto intro: rtrancl_into_rtrancl)
 
   lemma trancl_image_by_rtrancl: "(E\<^sup>+)``Vi \<union> Vi = (E\<^sup>*)``Vi"
     by (metis Image_Id Un_Image rtrancl_trancl_reflcl)
 
   lemma reachable_mono: "\<lbrakk>R\<subseteq>R'; X\<subseteq>X'\<rbrakk> \<Longrightarrow> R\<^sup>*``X \<subseteq> R'\<^sup>*``X'"
     by (metis Image_mono rtrancl_mono)
 
   lemma finite_reachable_advance:
     "\<lbrakk> finite (E\<^sup>*``{v0}); (v0,v)\<in>E\<^sup>* \<rbrakk> \<Longrightarrow> finite (E\<^sup>*``{v})"
     by (erule finite_subset[rotated]) auto
 
 lemma rtrancl_mono_mp: "U\<subseteq>V \<Longrightarrow> x\<in>U\<^sup>* \<Longrightarrow> x\<in>V\<^sup>*" by (metis in_mono rtrancl_mono)
 lemma trancl_mono_mp: "U\<subseteq>V \<Longrightarrow> x\<in>U\<^sup>+ \<Longrightarrow> x\<in>V\<^sup>+" by (metis trancl_mono)
 
 lemma rtrancl_mapI: "(a,b)\<in>E\<^sup>* \<Longrightarrow> (f a, f b)\<in>(pairself f `E)\<^sup>*"
   apply (induction rule: rtrancl_induct)
   apply (force intro: rtrancl.intros)+
   done
 
 lemma rtrancl_image_advance_rtrancl:
   assumes "q \<in> R\<^sup>*``Q0"
   assumes "(q,x) \<in> R\<^sup>*"
   shows "x \<in> R\<^sup>*``Q0"
   using assms
   by (metis rtrancl_idemp rtrancl_image_advance)
 
 lemma nth_step_trancl:
   "\<And>n m. \<lbrakk> \<And> n. n < length xs - 1 \<Longrightarrow> (xs ! Suc n, xs ! n) \<in> R \<rbrakk> \<Longrightarrow> n < length xs \<Longrightarrow> m < n \<Longrightarrow> (xs ! n, xs ! m) \<in> R\<^sup>+"
 proof (induction xs)
   case (Cons x xs)
   hence "\<And>n. n < length xs - 1 \<Longrightarrow> (xs ! Suc n, xs ! n) \<in> R"
     apply clarsimp
     by (metis One_nat_def diff_Suc_eq_diff_pred nth_Cons_Suc zero_less_diff)
   note IH = this[THEN Cons.IH]
 
   from Cons obtain n' where n': "Suc n' = n" by (cases n) blast+
 
   show ?case
   proof (cases m)
     case "0" with Cons have "xs \<noteq> []" by auto
     with "0" Cons.prems(1)[of m] have "(xs ! 0, x) \<in> R" by simp
     moreover from IH[where m = 0] have "\<And>n. n < length xs \<Longrightarrow> n > 0 \<Longrightarrow> (xs ! n, xs ! 0) \<in> R\<^sup>+" by simp
     ultimately have "\<And>n. n < length xs \<Longrightarrow> (xs ! n, x) \<in> R\<^sup>+" by (metis trancl_into_trancl gr0I r_into_trancl')
     with Cons "0" show ?thesis by auto
   next
     case (Suc m') with Cons.prems n' have "n' < length xs" "m' < n'" by auto
     with IH have "(xs ! n', xs ! m') \<in> R\<^sup>+" by simp
     with Suc n' show ?thesis by auto
   qed
 qed simp
 
 lemma Image_empty_trancl_Image_empty:
   "R `` {v} = {} \<Longrightarrow> R\<^sup>+ `` {v} = {}"
   unfolding Image_def
   by (auto elim: converse_tranclE)
 
 lemma Image_empty_rtrancl_Image_id:
   "R `` {v} = {} \<Longrightarrow> R\<^sup>* `` {v} = {v}"
   unfolding Image_def
   by (auto elim: converse_rtranclE)
 
 lemma trans_rtrancl_eq_reflcl:
   "trans A \<Longrightarrow> A^* = A^="
   by (simp add: rtrancl_trancl_reflcl)
 
 lemma refl_on_reflcl_Image:
   "refl_on B A \<Longrightarrow> C \<subseteq> B \<Longrightarrow> A^= `` C = A `` C"
   by (auto simp add: Image_def dest: refl_onD)
 
 lemma Image_absorb_rtrancl:
   "\<lbrakk> trans A; refl_on B A; C \<subseteq> B \<rbrakk> \<Longrightarrow> A^* `` C = A `` C"
   by (simp add: trans_rtrancl_eq_reflcl refl_on_reflcl_Image)
 
 lemma trancl_Image_unfold_left: "E\<^sup>+``S = E\<^sup>*``E``S"
   by (auto simp: trancl_unfold_left)
 
 lemma trancl_Image_unfold_right: "E\<^sup>+``S = E``E\<^sup>*``S"
   by (auto simp: trancl_unfold_right)
 
 lemma trancl_Image_advance_ss: "(u,v)\<in>E \<Longrightarrow> E\<^sup>+``{v} \<subseteq> E\<^sup>+``{u}"
   by auto
 
 lemma rtrancl_Image_advance_ss: "(u,v)\<in>E \<Longrightarrow> E\<^sup>*``{v} \<subseteq> E\<^sup>*``{u}"
   by auto
 
 (* FIXME: nicer name *)
 lemma trancl_union_outside:
   assumes "(v,w) \<in> (E\<union>U)\<^sup>+"
   and "(v,w) \<notin> E\<^sup>+"
   shows "\<exists>x y. (v,x) \<in> (E\<union>U)\<^sup>* \<and> (x,y) \<in> U \<and> (y,w) \<in> (E\<union>U)\<^sup>*"
 using assms
 proof (induction)
   case base thus ?case by auto
 next
   case (step w x)
   show ?case
   proof (cases "(v,w)\<in>E\<^sup>+")
     case True
     from step have "(v,w)\<in>(E\<union>U)\<^sup>*" by simp
     moreover from True step have "(w,x) \<in> U" by (metis Un_iff trancl.simps)
     moreover have "(x,x) \<in> (E\<union>U)\<^sup>*" by simp
     ultimately show ?thesis by blast
   next
     case False with step.IH obtain a b where "(v,a) \<in> (E\<union>U)\<^sup>*" "(a,b) \<in> U" "(b,w) \<in> (E\<union>U)\<^sup>*" by blast
     moreover with step have "(b,x) \<in> (E\<union>U)\<^sup>*" by (metis rtrancl_into_rtrancl)
     ultimately show ?thesis by blast
   qed
 qed
 
 lemma trancl_restrict_reachable:
   assumes "(u,v) \<in> E\<^sup>+"
   assumes "E``S \<subseteq> S"
   assumes "u\<in>S"
   shows "(u,v) \<in> (E\<inter>S\<times>S)\<^sup>+"
   using assms
   by (induction rule: converse_trancl_induct)
      (auto intro: trancl_into_trancl2)
 
 lemma rtrancl_image_unfold_right: "E``E\<^sup>*``V \<subseteq> E\<^sup>*``V"
   by (auto intro: rtrancl_into_rtrancl)
 
 
 lemma trancl_Image_in_Range:
   "R\<^sup>+ `` V \<subseteq> Range R"
 by (auto elim: trancl.induct)
 
 lemma rtrancl_Image_in_Field:
   "R\<^sup>* `` V \<subseteq> Field R \<union> V"
 proof -
   from trancl_Image_in_Range have "R\<^sup>+ `` V \<subseteq> Field R"
     unfolding Field_def by fast
   hence "R\<^sup>+ `` V \<union> V \<subseteq> Field R \<union> V" by blast
   with trancl_image_by_rtrancl show ?thesis by metis
 qed
 
 lemma rtrancl_sub_insert_rtrancl:
   "R\<^sup>* \<subseteq> (insert x R)\<^sup>*"
 by (auto elim: rtrancl.induct rtrancl_into_rtrancl)
 
 lemma trancl_sub_insert_trancl:
   "R\<^sup>+ \<subseteq> (insert x R)\<^sup>+"
 by (auto elim: trancl.induct trancl_into_trancl)
 
 lemma Restr_rtrancl_mono:
   "(v,w) \<in> (Restr E U)\<^sup>* \<Longrightarrow> (v,w) \<in> E\<^sup>*"
   by (metis inf_le1 rtrancl_mono subsetCE)
 
 lemma Restr_trancl_mono:
   "(v,w) \<in> (Restr E U)\<^sup>+ \<Longrightarrow> (v,w) \<in> E\<^sup>+"
   by (metis inf_le1 trancl_mono)
 
 
 
 
 
 
 
 
   subsubsection "Converse Relation"
 
   lemmas converse_add_simps = converse_Times trancl_converse[symmetric] converse_Un converse_Int
 
   lemma dom_ran_disj_comp[simp]: "Domain R \<inter> Range R = {} \<Longrightarrow> R O R = {}"
     by auto
 
   lemma below_Id_inv[simp]: "R\<inverse>\<subseteq>Id \<longleftrightarrow> R\<subseteq>Id" by (auto)
     
     
   subsubsection "Cyclicity"
 
   lemma cyclicE: "\<lbrakk>\<not>acyclic g; !!x. (x,x)\<in>g\<^sup>+ \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
     by (unfold acyclic_def) blast
 
   lemma acyclic_insert_cyclic: "\<lbrakk>acyclic g; \<not>acyclic (insert (x,y) g)\<rbrakk> \<Longrightarrow> (y,x)\<in>g\<^sup>*"
     by (unfold acyclic_def) (auto simp add: trancl_insert)
 
 
   text \<open>
     This lemma makes a case distinction about a path in a graph where a couple of edges with the same
     endpoint have been inserted: If there is a path from a to b, then there's such a path in the original graph, or
     there's a path that uses an inserted edge only once.
 
     Originally, this lemma was used to reason about the graph of an updated acquisition history. Any path in
     this graph is either already contained in the original graph, or passes via an
     inserted edge. Because all the inserted edges point to the same target node, in the
     second case, the path can be short-circuited to use exactly one inserted edge.
 \<close>
   lemma trancl_multi_insert[cases set, case_names orig via]:
     "\<lbrakk> (a,b)\<in>(r\<union>X\<times>{m})\<^sup>+;
       (a,b)\<in>r\<^sup>+ \<Longrightarrow> P;
        !!x. \<lbrakk> x\<in>X; (a,x)\<in>r\<^sup>*; (m,b)\<in>r\<^sup>* \<rbrakk> \<Longrightarrow> P
     \<rbrakk> \<Longrightarrow> P"
   proof (induct arbitrary: P rule: trancl_induct)
     case (base b) thus ?case by auto
   next
     case (step b c) show ?case proof (rule step.hyps(3))
       assume A: "(a,b)\<in>r\<^sup>+"
       note step.hyps(2)
       moreover {
         assume "(b,c)\<in>r"
         with A have "(a,c)\<in>r\<^sup>+" by auto
         with step.prems have P by blast
       } moreover {
         assume "b\<in>X" "c=m"
         with A have P by (rule_tac step.prems(2)) simp+
       } ultimately show P by auto
     next
       fix x
       assume A: "x \<in> X" "(a, x) \<in> r\<^sup>*" "(m, b) \<in> r\<^sup>*"
       note step.hyps(2)
       moreover {
         assume "(b,c)\<in>r"
         with A(3) have "(m,c)\<in>r\<^sup>*" by auto
         with step.prems(2)[OF A(1,2)] have P by blast
       } moreover {
         assume "b\<in>X" "c=m"
         with A have P by (rule_tac step.prems(2)) simp+
       } ultimately show P by auto
     qed
   qed
 
   text \<open>
     Version of @{thm [source] trancl_multi_insert} for inserted edges with the same startpoint.
 \<close>
   lemma trancl_multi_insert2[cases set, case_names orig via]:
     "\<lbrakk>(a,b)\<in>(r\<union>{m}\<times>X)\<^sup>+; (a,b)\<in>r\<^sup>+ \<Longrightarrow> P; !!x. \<lbrakk> x\<in>X; (a,m)\<in>r\<^sup>*; (x,b)\<in>r\<^sup>* \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   proof goal_cases
     case prems: 1 from prems(1) have "(b,a)\<in>((r\<union>{m}\<times>X)\<^sup>+)\<inverse>" by simp
     also have "((r\<union>{m}\<times>X)\<^sup>+)\<inverse> = (r\<inverse>\<union>X\<times>{m})\<^sup>+" by (simp add: converse_add_simps)
     finally have "(b, a) \<in> (r\<inverse> \<union> X \<times> {m})\<^sup>+" .
     thus ?case
       by (auto elim!: trancl_multi_insert
                intro: prems(2,3)
             simp add: trancl_converse rtrancl_converse
     )
   qed
 
 lemma cyclic_subset:
   "\<lbrakk> \<not> acyclic R; R \<subseteq> S \<rbrakk> \<Longrightarrow> \<not> acyclic S"
   unfolding acyclic_def
   by (blast intro: trancl_mono)
 
 
 
 
 
   subsubsection \<open>Wellfoundedness\<close>
   lemma wf_min: assumes A: "wf R" "R\<noteq>{}" "!!m. m\<in>Domain R - Range R \<Longrightarrow> P" shows P proof -
     have H: "!!x. wf R \<Longrightarrow> \<forall>y. (x,y)\<in>R \<longrightarrow> x\<in>Domain R - Range R \<or> (\<exists>m. m\<in>Domain R - Range R)"
       by (erule_tac wf_induct_rule[where P="\<lambda>x. \<forall>y. (x,y)\<in>R \<longrightarrow> x\<in>Domain R - Range R \<or> (\<exists>m. m\<in>Domain R - Range R)"]) auto
     from A(2) obtain x y where "(x,y)\<in>R" by auto
     with A(1,3) H show ?thesis by blast
   qed
 
   lemma finite_wf_eq_wf_converse: "finite R \<Longrightarrow> wf (R\<inverse>) \<longleftrightarrow> wf R"
     by (metis acyclic_converse finite_acyclic_wf finite_acyclic_wf_converse wf_acyclic)
 
   lemma wf_max: assumes A: "wf (R\<inverse>)" "R\<noteq>{}" and C: "!!m. m\<in>Range R - Domain R \<Longrightarrow> P" shows "P"
   proof -
     from A(2) have NE: "R\<inverse>\<noteq>{}" by auto
     from wf_min[OF A(1) NE] obtain m where "m\<in>Range R - Domain R" by auto
     thus P by (blast intro: C)
   qed
 
     \<comment> \<open>Useful lemma to show well-foundedness of some process approaching a finite upper bound\<close>
   lemma wf_bounded_supset: "finite S \<Longrightarrow> wf {(Q',Q). Q'\<supset>Q \<and> Q'\<subseteq> S}"
   proof -
     assume [simp]: "finite S"
     hence [simp]: "!!x. finite (S-x)" by auto
     have "{(Q',Q). Q\<subset>Q' \<and> Q'\<subseteq> S} \<subseteq> inv_image ({(s'::nat,s). s'<s}) (\<lambda>Q. card (S-Q))"
     proof (intro subsetI, case_tac x, simp)
       fix a b
       assume A: "b\<subset>a \<and> a\<subseteq>S"
       hence "S-a \<subset> S-b" by blast
       thus "card (S-a) < card (S-b)" by (auto simp add: psubset_card_mono)
     qed
     moreover have "wf ({(s'::nat,s). s'<s})" by (rule wf_less)
     ultimately show ?thesis by (blast intro: wf_inv_image wf_subset)
   qed
 
   lemma wf_no_path: "Domain R \<inter> Range R = {} \<Longrightarrow> wf R"
     apply (rule wf_no_loop)
     by simp
 
 text \<open>Extend a wf-relation by a break-condition\<close>
 definition "brk_rel R \<equiv>
     {((False,x),(False,y)) | x y. (x,y)\<in>R}
   \<union> {((True,x),(False,y)) | x y. True}"
 
 lemma brk_rel_wf[simp,intro!]:
   assumes WF[simp]: "wf R"
   shows "wf (brk_rel R)"
 proof -
   have "wf {((False,x),(False,y)) | x y. (x,y)\<in>R}"
   proof -
     have "{((False,x),(False,y)) | x y. (x,y)\<in>R} \<subseteq> inv_image R snd"
       by auto
     from wf_subset[OF wf_inv_image[OF WF] this] show ?thesis .
   qed
   moreover have "wf {((True,x),(False,y)) | x y. True}"
     by (rule wf_no_path) auto
   ultimately show ?thesis
     unfolding brk_rel_def
     apply (subst Un_commute)
     by (blast intro: wf_Un)
 qed
 
 
 subsubsection \<open>Restrict Relation\<close>
 definition rel_restrict :: "('a \<times> 'a) set \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set"
 where
   "rel_restrict R A \<equiv> {(v,w). (v,w) \<in> R \<and> v \<notin> A \<and> w \<notin> A}"
 
 lemma rel_restrict_alt_def:
   "rel_restrict R A = R \<inter> (-A) \<times> (-A)"
 unfolding rel_restrict_def
 by auto
 
 lemma rel_restrict_empty[simp]:
   "rel_restrict R {} = R"
 by (simp add: rel_restrict_def)
 
 lemma rel_restrict_notR:
   assumes "(x,y) \<in> rel_restrict A R"
   shows "x \<notin> R" and "y \<notin> R"
 using assms
 unfolding rel_restrict_def
 by auto
 
 lemma rel_restrict_sub:
   "rel_restrict R A \<subseteq> R"
 unfolding rel_restrict_def
 by auto
 
 lemma rel_restrict_Int_empty:
   "A \<inter> Field R = {} \<Longrightarrow> rel_restrict R A = R"
 unfolding rel_restrict_def Field_def
 by auto
 
 lemma Domain_rel_restrict:
   "Domain (rel_restrict R A) \<subseteq> Domain R - A"
 unfolding rel_restrict_def
 by auto
 
 lemma Range_rel_restrict:
   "Range (rel_restrict R A) \<subseteq> Range R - A"
 unfolding rel_restrict_def
 by auto
 
 lemma Field_rel_restrict:
   "Field (rel_restrict R A) \<subseteq> Field R - A"
 unfolding rel_restrict_def Field_def
 by auto
 
 lemma rel_restrict_compl:
   "rel_restrict R A \<inter> rel_restrict R (-A) = {}"
 unfolding rel_restrict_def
 by auto
 
 lemma finite_rel_restrict:
   "finite R \<Longrightarrow> finite (rel_restrict R A)"
 by (metis finite_subset rel_restrict_sub)
 
 lemma R_subset_Field: "R \<subseteq> Field R \<times> Field R"
   unfolding Field_def
   by auto
 
 lemma homo_rel_restrict_mono:
   "R \<subseteq> B \<times> B \<Longrightarrow> rel_restrict R A \<subseteq> (B - A) \<times> (B - A)"
 proof -
   assume A: "R \<subseteq> B \<times> B"
   hence "Field R \<subseteq> B" unfolding Field_def by auto
   with Field_rel_restrict have "Field (rel_restrict R A) \<subseteq> B - A"
     by (metis Diff_mono order_refl order_trans)
   with R_subset_Field show ?thesis by blast
 qed
 
 lemma rel_restrict_union:
   "rel_restrict R (A \<union> B) = rel_restrict (rel_restrict R A) B"
 unfolding rel_restrict_def
 by auto
 
 lemma rel_restrictI:
   "x \<notin> R \<Longrightarrow> y \<notin> R \<Longrightarrow> (x,y) \<in> E \<Longrightarrow> (x,y) \<in> rel_restrict E R"
 unfolding rel_restrict_def
 by auto
 
 lemma rel_restrict_lift:
   "(x,y) \<in> rel_restrict E R \<Longrightarrow> (x,y) \<in> E"
 unfolding rel_restrict_def
 by simp
 
 lemma rel_restrict_trancl_mem:
   "(a,b) \<in> (rel_restrict A R)\<^sup>+ \<Longrightarrow> (a,b) \<in> rel_restrict (A\<^sup>+) R"
 by (induction rule: trancl_induct) (auto simp add: rel_restrict_def)
 
 lemma rel_restrict_trancl_sub:
   "(rel_restrict A R)\<^sup>+ \<subseteq> rel_restrict (A\<^sup>+) R"
 by (metis subrelI rel_restrict_trancl_mem)
 
 lemma rel_restrict_mono:
   "A \<subseteq> B \<Longrightarrow> rel_restrict A R \<subseteq> rel_restrict B R"
 unfolding rel_restrict_def by auto
 
 lemma rel_restrict_mono2:
   "R \<subseteq> S \<Longrightarrow> rel_restrict A S \<subseteq> rel_restrict A R"
 unfolding rel_restrict_def by auto
 
 lemma rel_restrict_Sigma_sub:
   "rel_restrict ((A\<times>A)\<^sup>+) R \<subseteq> ((A - R) \<times> (A - R))\<^sup>+"
 unfolding rel_restrict_def
 by auto (metis DiffI converse_tranclE mem_Sigma_iff r_into_trancl tranclE)
 
 
 lemma finite_reachable_restrictedI:
   assumes F: "finite Q"
   assumes I: "I\<subseteq>Q"
   assumes R: "Range E \<subseteq> Q"
   shows "finite (E\<^sup>*``I)"
 proof -
   from I R have "E\<^sup>*``I \<subseteq> Q"
     by (force elim: rtrancl.cases)
   also note F
   finally (finite_subset) show ?thesis .
 qed
 
 context begin
   private lemma rtrancl_restrictI_aux:
     assumes "(u,v)\<in>(E-UNIV\<times>R)\<^sup>*"
     assumes "u\<notin>R"
     shows "(u,v)\<in>(rel_restrict E R)\<^sup>* \<and> v\<notin>R"
     using assms
     by (induction) (auto simp: rel_restrict_def intro: rtrancl.intros)
 
   corollary rtrancl_restrictI:
     assumes "(u,v)\<in>(E-UNIV\<times>R)\<^sup>*"
     assumes "u\<notin>R"
     shows "(u,v)\<in>(rel_restrict E R)\<^sup>*"
     using rtrancl_restrictI_aux[OF assms] ..
 end
 
 lemma E_closed_restr_reach_cases:
   assumes P: "(u,v)\<in>E\<^sup>*"
   assumes CL: "E``R \<subseteq> R"
   obtains "v\<in>R" | "u\<notin>R" "(u,v)\<in>(rel_restrict E R)\<^sup>*"
   using P
 proof (cases rule: rtrancl_last_visit[where S=R])
   case no_visit
   show ?thesis proof (cases "u\<in>R")
     case True with P have "v\<in>R"
       using rtrancl_reachable_induct[OF _ CL, where I="{u}"]
       by auto
     thus ?thesis ..
   next
     case False with no_visit have "(u,v)\<in>(rel_restrict E R)\<^sup>*"
       by (rule rtrancl_restrictI)
     with False show ?thesis ..
   qed
 next
   case (last_visit_point x)
   from \<open>(x, v) \<in> (E - UNIV \<times> R)\<^sup>*\<close> have "(x,v)\<in>E\<^sup>*"
     by (rule rtrancl_mono_mp[rotated]) auto
   with \<open>x\<in>R\<close> have "v\<in>R"
     using rtrancl_reachable_induct[OF _ CL, where I="{x}"]
     by auto
   thus ?thesis ..
 qed
 
 lemma rel_restrict_trancl_notR:
   assumes "(v,w) \<in> (rel_restrict E R)\<^sup>+"
   shows "v \<notin> R" and "w \<notin> R"
   using assms
   by (metis rel_restrict_trancl_mem rel_restrict_notR)+
 
 lemma rel_restrict_tranclI:
   assumes "(x,y) \<in> E\<^sup>+"
   and "x \<notin> R" "y \<notin> R"
   and "E `` R \<subseteq> R"
   shows "(x,y) \<in> (rel_restrict E R)\<^sup>+"
   using assms
   proof (induct)
     case base thus ?case by (metis r_into_trancl rel_restrictI)
   next
     case (step y z) hence "y \<notin> R" by auto
     with step show ?case by (metis trancl_into_trancl rel_restrictI)
   qed
 
 
 subsubsection \<open>Single-Valued Relations\<close>
 lemma single_valued_inter1: "single_valued R \<Longrightarrow> single_valued (R\<inter>S)"
   by (auto intro: single_valuedI dest: single_valuedD)
 
 lemma single_valued_inter2: "single_valued R \<Longrightarrow> single_valued (S\<inter>R)"
   by (auto intro: single_valuedI dest: single_valuedD)
 
 lemma single_valued_below_Id: "R\<subseteq>Id \<Longrightarrow> single_valued R"
   by (auto intro: single_valuedI)
   
 
 subsubsection \<open>Bijective Relations\<close>
 definition "bijective R \<equiv>
   (\<forall>x y z. (x,y)\<in>R \<and> (x,z)\<in>R \<longrightarrow> y=z) \<and>
   (\<forall>x y z. (x,z)\<in>R \<and> (y,z)\<in>R \<longrightarrow> x=y)"
 
 lemma bijective_alt: "bijective R \<longleftrightarrow> single_valued R \<and> single_valued (R\<inverse>)"
   unfolding bijective_def single_valued_def by blast
 
 lemma bijective_Id[simp, intro!]: "bijective Id"
   by (auto simp: bijective_def)
 
 lemma bijective_Empty[simp, intro!]: "bijective {}"
   by (auto simp: bijective_def)
 
 subsubsection \<open>Miscellaneous\<close>
 
   lemma pair_vimage_is_Image[simp]: "(Pair u -` E) = E``{u}"
     by auto
 
 lemma fst_in_Field: "fst ` R \<subseteq> Field R"
   by (simp add: Field_def fst_eq_Domain)
 
 lemma snd_in_Field: "snd ` R \<subseteq> Field R"
   by (simp add: Field_def snd_eq_Range)
 
 lemma ran_map_of:
   "ran (map_of xs) \<subseteq> snd ` set (xs)"
 by (induct xs) (auto simp add: ran_def)
 
 lemma Image_subset_snd_image:
   "A `` B \<subseteq> snd ` A"
 unfolding Image_def image_def
 by force
 
 lemma finite_Image_subset:
   "finite (A `` B) \<Longrightarrow> C \<subseteq> A \<Longrightarrow> finite (C `` B)"
 by (metis Image_mono order_refl rev_finite_subset)
 
 lemma finite_Field_eq_finite[simp]: "finite (Field R) \<longleftrightarrow> finite R"
   by (metis finite_cartesian_product finite_subset R_subset_Field finite_Field)
 
 
 
 definition "fun_of_rel R x \<equiv> SOME y. (x,y)\<in>R"
 
 lemma for_in_RI(*[intro]*): "x\<in>Domain R \<Longrightarrow> (x,fun_of_rel R x)\<in>R"
   unfolding fun_of_rel_def
   by (auto intro: someI)
 
 lemma Field_not_elem:
   "v \<notin> Field R \<Longrightarrow> \<forall>(x,y) \<in> R. x \<noteq> v \<and> y \<noteq> v"
 unfolding Field_def by auto
 
 lemma Sigma_UNIV_cancel[simp]: "(A \<times> X - A \<times> UNIV) = {}" by auto
 
 lemma same_fst_trancl[simp]: "(same_fst P R)\<^sup>+ = same_fst P (\<lambda>x. (R x)\<^sup>+)"
 proof -
   {
     fix x y
     assume "(x,y)\<in>(same_fst P R)\<^sup>+"
     hence "(x,y)\<in>same_fst P (\<lambda>x. (R x)\<^sup>+)"
       by induction (auto simp: same_fst_def)
   } moreover {
     fix f f' x y
     assume "((f,x),(f',y))\<in>same_fst P (\<lambda>x. (R x)\<^sup>+)"
     hence [simp]: "f'=f" "P f" and 1: "(x,y)\<in>(R f)\<^sup>+" by (auto simp: same_fst_def)
     from 1 have "((f,x),(f',y))\<in>(same_fst P R)\<^sup>+"
       apply induction
       subgoal by (rule r_into_trancl) auto
       subgoal by (erule trancl_into_trancl) auto
       done
   } ultimately show ?thesis by auto
 qed  
     
 
 subsection \<open>\<open>option\<close> Datatype\<close>
 lemma le_some_optE: "\<lbrakk>Some m\<le>x; !!m'. \<lbrakk>x=Some m'; m\<le>m'\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   by (cases x) auto
 
 
 lemma not_Some_eq2[simp]: "(\<forall>x y. v \<noteq> Some (x,y)) = (v = None)"
   by (cases v) auto
 
 
 subsection "Maps"
   primrec the_default where
     "the_default _ (Some x) = x"
   | "the_default x None = x"
 
   declare map_add_dom_app_simps[simp]  
   declare map_add_upd_left[simp]  
 
   lemma ran_add[simp]: "dom f \<inter> dom g = {} \<Longrightarrow> ran (f++g) = ran f \<union> ran g" by (fastforce simp add: ran_def map_add_def split: option.split_asm option.split)
 
   lemma nempty_dom: "\<lbrakk>e\<noteq>Map.empty; !!m. m\<in>dom e \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
     by (subgoal_tac "dom e \<noteq> {}") (blast, auto)
 
 
 
   lemma le_map_dom_mono: "m\<le>m' \<Longrightarrow> dom m \<subseteq> dom m'"
     apply (safe)
     apply (drule_tac x=x in le_funD)
     apply simp
     apply (erule le_some_optE)
     apply simp
     done
 
   lemma map_add_first_le: fixes m::"'a\<rightharpoonup>('b::order)" shows "\<lbrakk> m\<le>m' \<rbrakk> \<Longrightarrow> m++n \<le> m'++n"
     apply (rule le_funI)
     apply (auto simp add: map_add_def split: option.split elim: le_funE)
     done
 
   lemma map_add_distinct_le: shows "\<lbrakk> m\<le>m'; n\<le>n'; dom m' \<inter> dom n' = {} \<rbrakk> \<Longrightarrow> m++n \<le> m'++n'"
     apply (rule le_funI)
     apply (auto simp add: map_add_def split: option.split)
     apply (fastforce elim: le_funE)
     apply (drule le_map_dom_mono)
     apply (drule le_map_dom_mono)
     apply (case_tac "m x")
     apply simp
     apply (force)
     apply (fastforce dest!: le_map_dom_mono)
     apply (erule le_funE)
     apply (erule_tac x=x in le_funE)
     apply simp
     done
 
   lemma map_add_left_comm: assumes A: "dom A \<inter> dom B = {}" shows "A ++ (B ++ C) = B ++ (A ++ C)"
   proof -
     have "A ++ (B ++ C) = (A++B)++C" by simp
     also have "\<dots> = (B++A)++C" by (simp add: map_add_comm[OF A])
     also have "\<dots> = B++(A++C)" by simp
     finally show ?thesis .
   qed
   lemmas map_add_ac = map_add_assoc map_add_comm map_add_left_comm
 
   lemma le_map_restrict[simp]: fixes m :: "'a \<rightharpoonup> ('b::order)" shows "m |` X \<le> m"
     by (rule le_funI) (simp add: restrict_map_def)
 
 lemma map_of_distinct_upd:
   "x \<notin> set (map fst xs) \<Longrightarrow> [x \<mapsto> y] ++ map_of xs = (map_of xs) (x \<mapsto> y)"
   by (induct xs) (auto simp add: fun_upd_twist)
 
 lemma map_of_distinct_upd2:
   assumes "x \<notin> set(map fst xs)"
   "x \<notin> set (map fst ys)"
   shows "map_of (xs @ (x,y) # ys) = (map_of (xs @ ys))(x \<mapsto> y)"
   apply(insert assms)
   apply(induct xs)
   apply (auto intro: ext)
   done
 
 lemma map_of_distinct_upd3:
   assumes "x \<notin> set(map fst xs)"
   "x \<notin> set (map fst ys)"
   shows "map_of (xs @ (x,y) # ys) = (map_of (xs @ (x,y') # ys))(x \<mapsto> y)"
   apply(insert assms)
   apply(induct xs)
   apply (auto intro: ext)
   done
 
 lemma map_of_distinct_upd4:
   assumes "x \<notin> set(map fst xs)"
   "x \<notin> set (map fst ys)"
   shows "map_of (xs @ ys) = (map_of (xs @ (x,y) # ys))(x := None)"
   using assms by (induct xs) (auto simp: map_of_eq_None_iff)
 
 lemma map_of_distinct_lookup:
   assumes "x \<notin> set(map fst xs)"
   "x \<notin> set (map fst ys)"
   shows "map_of (xs @ (x,y) # ys) x = Some y"
 proof -
   have "map_of (xs @ (x,y) # ys) = (map_of (xs @ ys)) (x \<mapsto> y)"
     using assms map_of_distinct_upd2 by simp
   thus ?thesis
     by simp
 qed
 
 lemma ran_distinct:
   assumes dist: "distinct (map fst al)"
   shows "ran (map_of al) = snd ` set al"
 using assms proof (induct al)
   case Nil then show ?case by simp
 next
   case (Cons kv al)
   then have "ran (map_of al) = snd ` set al" by simp
   moreover from Cons.prems have "map_of al (fst kv) = None"
     by (simp add: map_of_eq_None_iff)
   ultimately show ?case by (simp only: map_of.simps ran_map_upd) simp
 qed
 
 lemma ran_is_image:
   "ran M = (the \<circ> M) ` (dom M)"
 unfolding ran_def dom_def image_def
 by auto
 
 lemma map_card_eq_iff:
   assumes finite: "finite (dom M)"
   and card_eq: "card (dom M) = card (ran M)"
   and indom: "x \<in> dom M"
   shows "(M x = M y) \<longleftrightarrow> (x = y)"
 proof -
   from ran_is_image finite card_eq have *: "inj_on (the \<circ> M) (dom M)" using eq_card_imp_inj_on by metis
   thus ?thesis
   proof (cases "y \<in> dom M")
     case False with indom show ?thesis by auto
   next
     case True with indom have "the (M x) = the (M y) \<longleftrightarrow> (x = y)" using inj_on_eq_iff[OF *] by auto
     thus ?thesis by auto
   qed
 qed
 
 lemma map_dom_ran_finite:
   "finite (dom M) \<Longrightarrow> finite (ran M)"
 by (simp add: ran_is_image)
 
 lemma map_update_eta_repair[simp]:
   (* An update operation may get simplified, if it happens to be eta-expanded.
     This lemma tries to repair some common expressions *)
   "dom (\<lambda>x. if x=k then Some v else m x) = insert k (dom m)"
   "m k = None \<Longrightarrow> ran (\<lambda>x. if x=k then Some v else m x) = insert v (ran m)"
   apply auto []
   apply (force simp: ran_def)
   done
 
 lemma map_leI[intro?]: "\<lbrakk>\<And>x v. m1 x = Some v \<Longrightarrow> m2 x = Some v\<rbrakk> \<Longrightarrow> m1\<subseteq>\<^sub>mm2"
   unfolding map_le_def by force
 lemma map_leD: "m1\<subseteq>\<^sub>mm2 \<Longrightarrow> m1 k = Some v \<Longrightarrow> m2 k = Some v"
   unfolding map_le_def by force
     
 lemma map_restrict_insert_none_simp: "m x = None \<Longrightarrow> m|`(-insert x s) = m|`(-s)"
   by (auto intro!: ext simp:restrict_map_def)
 
 (* TODO: Move *)
 lemma eq_f_restr_conv: "s\<subseteq>dom (f A) \<and> A = f A |` (-s) \<longleftrightarrow> A \<subseteq>\<^sub>m f A \<and> s = dom (f A) - dom A"
   apply auto
   subgoal by (metis map_leI restrict_map_eq(2))
   subgoal by (metis ComplD restrict_map_eq(2))
   subgoal by (metis Compl_iff restrict_in)
   subgoal by (force simp: map_le_def restrict_map_def)
   done
   
 corollary eq_f_restr_ss_eq: "\<lbrakk> s\<subseteq>dom (f A) \<rbrakk> \<Longrightarrow> A = f A |` (-s) \<longleftrightarrow> A \<subseteq>\<^sub>m f A \<and> s = dom (f A) - dom A"
   using eq_f_restr_conv by blast
     
     
     
   subsubsection \<open>Simultaneous Map Update\<close>
   definition "map_mmupd m K v k \<equiv> if k\<in>K then Some v else m k"
   lemma map_mmupd_empty[simp]: "map_mmupd m {} v = m"
     by (auto simp: map_mmupd_def)
 
   lemma mmupd_in_upd[simp]: "k\<in>K \<Longrightarrow> map_mmupd m K v k = Some v"
     by (auto simp: map_mmupd_def)
 
   lemma mmupd_notin_upd[simp]: "k\<notin>K \<Longrightarrow> map_mmupd m K v k = m k"
     by (auto simp: map_mmupd_def)
 
   lemma map_mmupdE:
     assumes "map_mmupd m K v k = Some x"
     obtains "k\<notin>K" "m k = Some x"
           | "k\<in>K" "x=v"
     using assms by (auto simp: map_mmupd_def split: if_split_asm)      
 
   lemma dom_mmupd[simp]: "dom (map_mmupd m K v) = dom m \<union> K"  
     by (auto simp: map_mmupd_def split: if_split_asm)      
 
   lemma le_map_mmupd_not_dom[simp, intro!]: "m \<subseteq>\<^sub>m map_mmupd m (K-dom m) v" 
     by (auto simp: map_le_def)
 
   lemma map_mmupd_update_less: "K\<subseteq>K' \<Longrightarrow> map_mmupd m (K - dom m) v \<subseteq>\<^sub>m map_mmupd m (K'-dom m) v"
     by (auto simp: map_le_def map_mmupd_def)
 
     
 
 subsection\<open>Connection between Maps and Sets of Key-Value Pairs\<close>
 
 definition map_to_set where
   "map_to_set m = {(k, v) . m k = Some v}"
 
 definition set_to_map where
   "set_to_map S k = Eps_Opt (\<lambda>v. (k, v) \<in> S)"
 
 lemma set_to_map_simp :
 assumes inj_on_fst: "inj_on fst S"
 shows "(set_to_map S k = Some v) \<longleftrightarrow> (k, v) \<in> S"
 proof (cases "\<exists>v. (k, v) \<in> S")
   case True
   note kv_ex = this
   then obtain v' where kv'_in: "(k, v') \<in> S" by blast
 
   with inj_on_fst have kv''_in: "\<And>v''. (k, v'') \<in> S \<longleftrightarrow> v' = v''"
     unfolding inj_on_def Ball_def
     by auto
 
   show ?thesis
     unfolding set_to_map_def
     by (simp add: kv_ex kv''_in)
 next
   case False
   hence kv''_nin: "\<And>v''. (k, v'') \<notin> S" by simp
   thus ?thesis
     by (simp add: set_to_map_def)
 qed
 
 lemma inj_on_fst_map_to_set :
   "inj_on fst (map_to_set m)"
 unfolding map_to_set_def inj_on_def by simp
 
 lemma map_to_set_inverse :
    "set_to_map (map_to_set m) = m"
 proof
   fix k
   show "set_to_map (map_to_set m) k = m k"
   proof (cases "m k")
     case None note mk_eq = this
     hence "\<And>v. (k, v) \<notin> map_to_set m"
       unfolding map_to_set_def by simp
     with set_to_map_simp [OF inj_on_fst_map_to_set, of m k]
     show ?thesis unfolding mk_eq by auto
   next
     case (Some v) note mk_eq = this
     hence "(k, v) \<in> map_to_set m"
       unfolding map_to_set_def by simp
     with set_to_map_simp [OF inj_on_fst_map_to_set, of m k v]
     show ?thesis unfolding mk_eq by auto
   qed
 qed
 
 lemma set_to_map_inverse :
 assumes inj_on_fst_S: "inj_on fst S"
 shows "map_to_set (set_to_map S) = S"
 proof (rule set_eqI)
   fix kv
   from set_to_map_simp [OF inj_on_fst_S, of "fst kv" "snd kv"]
   show "(kv \<in> map_to_set (set_to_map S)) = (kv \<in> S)"
     unfolding map_to_set_def
     by auto
 qed
 
 lemma map_to_set_empty[simp]: "map_to_set Map.empty = {}"
   unfolding map_to_set_def by simp
 
 lemma set_to_map_empty[simp]: "set_to_map {} = Map.empty"
   unfolding set_to_map_def[abs_def] by simp
 
 lemma map_to_set_empty_iff: "map_to_set m = {} \<longleftrightarrow> m = Map.empty"
                             "{} = map_to_set m \<longleftrightarrow> m = Map.empty"
   unfolding map_to_set_def by auto
 
 lemma set_to_map_empty_iff: "set_to_map S = Map.empty \<longleftrightarrow> S = {}" (is ?T1)
                             "Map.empty = set_to_map S \<longleftrightarrow> S = {}" (is ?T2)
 proof -
   show T1: ?T1
     apply (simp only: set_eq_iff)
     apply (simp only: fun_eq_iff)
     apply (simp add: set_to_map_def)
     apply auto
   done
   from T1 show ?T2 by auto
 qed
 
 lemma map_to_set_upd[simp]: "map_to_set (m (k \<mapsto> v)) = insert (k, v) (map_to_set m - {(k, v') |v'. True})"
   unfolding map_to_set_def
   apply (simp add: set_eq_iff)
   apply metis
 done
 
 lemma set_to_map_insert:
 assumes k_nin: "fst kv \<notin> fst ` S"
 shows "set_to_map (insert kv S) = (set_to_map S) (fst kv \<mapsto> snd kv)"
 proof
   fix k'
   obtain k v where kv_eq[simp]: "kv = (k, v)" by (rule prod.exhaust)
 
   from k_nin have k_nin': "\<And>v'. (k, v') \<notin> S"
     by (auto simp add: image_iff Ball_def)
 
-  show "set_to_map (insert kv S) k' = (set_to_map S(fst kv \<mapsto> snd kv)) k'"
+  show "set_to_map (insert kv S) k' = ((set_to_map S)(fst kv \<mapsto> snd kv)) k'"
     by (simp add: set_to_map_def k_nin')
 qed
 
 lemma map_to_set_dom :
   "dom m = fst ` (map_to_set m)"
 unfolding dom_def map_to_set_def
 by (auto simp add: image_iff)
 
 lemma map_to_set_ran :
   "ran m = snd ` (map_to_set m)"
 unfolding ran_def map_to_set_def
 by (auto simp add: image_iff)
 
 lemma set_to_map_dom :
   "dom (set_to_map S) = fst ` S"
 unfolding set_to_map_def[abs_def] dom_def
 by (auto simp add: image_iff Bex_def)
 
 lemma set_to_map_ran :
   "ran (set_to_map S) \<subseteq> snd ` S"
 unfolding set_to_map_def[abs_def] ran_def subset_iff
 by (auto simp add: image_iff Bex_def)
    (metis Eps_Opt_eq_Some)
 
 lemma finite_map_to_set:
 "finite (map_to_set m) = finite (dom m)"
 unfolding map_to_set_def map_to_set_dom
   apply (intro iffI finite_imageI)
   apply assumption
   apply (rule finite_imageD[of fst])
   apply assumption
   apply (simp add: inj_on_def)
 done
 
 lemma card_map_to_set :
   "card (map_to_set m) = card (dom m)"
 unfolding map_to_set_def map_to_set_dom
   apply (rule card_image[symmetric])
   apply (simp add: inj_on_def)
 done
 
 lemma map_of_map_to_set :
 "distinct (map fst l) \<Longrightarrow>
  map_of l = m \<longleftrightarrow> set l = map_to_set m"
 proof (induct l arbitrary: m)
   case Nil thus ?case by (simp add: map_to_set_empty_iff) blast
 next
   case (Cons kv l m)
   obtain k v where kv_eq[simp]: "kv = (k, v)" by (rule prod.exhaust)
 
   from Cons(2) have dist_l: "distinct (map fst l)" and kv'_nin: "\<And>v'. (k, v') \<notin> set l"
     by (auto simp add: image_iff)
   note ind_hyp = Cons(1)[OF dist_l]
 
   from kv'_nin have l_eq: "set (kv # l) = map_to_set m \<longleftrightarrow> (set l = map_to_set (m (k := None))) \<and> m k = Some v"
     apply (simp add: map_to_set_def restrict_map_def set_eq_iff)
     apply (auto)
     apply (metis)
     apply (metis option.inject)
   done
 
   from kv'_nin have m_eq: "map_of (kv # l) = m \<longleftrightarrow> map_of l = (m (k := None)) \<and> m k = Some v"
     apply (simp add: fun_eq_iff restrict_map_def map_of_eq_None_iff image_iff Ball_def)
     apply metis
   done
 
   show ?case
     unfolding m_eq l_eq
     using ind_hyp[of "m (k := None)"]
     by metis
 qed
 
 lemma map_to_set_map_of :
 "distinct (map fst l) \<Longrightarrow> map_to_set (map_of l) = set l"
 by (metis map_of_map_to_set)
 
 subsubsection \<open>Mapping empty set to None\<close>
 definition "dflt_None_set S \<equiv> if S={} then None else Some S"
 
 lemma the_dflt_None_empty[simp]: "dflt_None_set {} = None"
   unfolding dflt_None_set_def by simp
 
 lemma the_dflt_None_nonempty[simp]: "S\<noteq>{} \<Longrightarrow> dflt_None_set S = Some S"
   unfolding dflt_None_set_def by simp
 
 lemma the_dflt_None_set[simp]: "the_default {} (dflt_None_set x) = x"
   unfolding dflt_None_set_def by auto
 
 subsection \<open>Orderings\<close>
 
   
   
 lemma (in order) min_arg_le[simp]:
   "n \<le> min m n \<longleftrightarrow> min m n = n"
   "m \<le> min m n \<longleftrightarrow> min m n = m"
   by (auto simp: min_def)
 
 lemma (in linorder) min_arg_not_ge[simp]:
   "\<not> min m n < m \<longleftrightarrow> min m n = m"
   "\<not> min m n < n \<longleftrightarrow> min m n = n"
   by (auto simp: min_def)
 
 lemma (in linorder) min_eq_arg[simp]:
   "min m n = m \<longleftrightarrow> m\<le>n"
   "min m n = n \<longleftrightarrow> n\<le>m"
   by (auto simp: min_def)
 
 lemma min_simps[simp]:
   "a<(b::'a::order) \<Longrightarrow> min a b = a"
   "b<(a::'a::order) \<Longrightarrow> min a b = b"
   by (auto simp add: min_def dest: less_imp_le)
 
 lemma (in -) min_less_self_conv[simp]: 
   "min a b < a \<longleftrightarrow> b < (a::_::linorder)" 
   "min a b < b \<longleftrightarrow> a < (b::_::linorder)" 
   by (auto simp: min_def)
     
 lemma ord_eq_le_eq_trans: "\<lbrakk> a=b; b\<le>c; c=d \<rbrakk> \<Longrightarrow> a\<le>d" by auto
 
 lemma zero_comp_diff_simps[simp]: 
   "(0::'a::linordered_idom) \<le> a - b \<longleftrightarrow> b \<le> a" 
   "(0::'a::linordered_idom) < a - b \<longleftrightarrow> b < a" 
   by auto
     
 
 subsubsection \<open>Termination Measures\<close>    
 text \<open>Lexicographic measure, assuming upper bound for second component\<close>
 lemma mlex_fst_decrI:
   fixes a a' b b' N :: nat
   assumes "a<a'"
   assumes "b<N" "b'<N"
   shows "a*N + b < a'*N + b'"
 proof -  
   have "a*N + b + 1 \<le> a*N + N" using \<open>b<N\<close> by linarith 
   also have "\<dots> \<le> a'*N" using \<open>a<a'\<close>
     by (metis Suc_leI ab_semigroup_add_class.add.commute 
       ab_semigroup_mult_class.mult.commute mult_Suc_right mult_le_mono2) 
   also have "\<dots> \<le> a'*N + b'" by auto
   finally show ?thesis by auto
 qed      
   
 lemma mlex_leI:
   fixes a a' b b' N :: nat
   assumes "a\<le>a'"
   assumes "b\<le>b'"
   shows "a*N + b \<le> a'*N + b'"
   using assms
   by (auto intro!: add_mono)
     
 lemma mlex_snd_decrI:
   fixes a a' b b' N :: nat
   assumes "a=a'"
   assumes "b<b'"
   shows "a*N + b < a'*N + b'"
   using assms
   by (auto)
 
 lemma mlex_bound:  
   fixes a b :: nat
   assumes "a<A"
   assumes "b<N"
   shows "a*N + b < A*N"
   using assms
   using mlex_fst_decrI by fastforce
     
 subsection \<open>CCPOs\<close>
 
 context ccpo
 begin
 
 lemma ccpo_Sup_mono:
   assumes C: "Complete_Partial_Order.chain (\<le>) A"
     "Complete_Partial_Order.chain (\<le>) B"
   assumes B: "\<forall>x\<in>A. \<exists>y\<in>B. x\<le>y"
   shows "Sup A \<le> Sup B"
 proof (rule ccpo_Sup_least)
   fix x
   assume "x\<in>A"
   with B obtain y where I: "y\<in>B" and L: "x\<le>y" by blast
   note L
   also from I ccpo_Sup_upper have "y\<le>Sup B" by (blast intro: C)
   finally show "x\<le>Sup B" .
 qed (rule C)
 
 lemma fixp_mono:
   assumes M: "monotone (\<le>) (\<le>) f" "monotone (\<le>) (\<le>) g"
   assumes LE: "\<And>Z. f Z \<le> g Z"
   shows "ccpo_class.fixp f \<le> ccpo_class.fixp g"
   unfolding fixp_def[abs_def]
   apply (rule ccpo_Sup_mono)
   apply (rule chain_iterates M)+
 proof rule
   fix x
   assume "x\<in>ccpo_class.iterates f"
   thus "\<exists>y\<in>ccpo_class.iterates g. x\<le>y"
   proof (induct)
     case (step x)
     then obtain y where I: "y\<in>ccpo_class.iterates g" and L: "x\<le>y" by blast
     hence "g y \<in> ccpo_class.iterates g" and "f x \<le> g y"
       apply -
       apply (erule iterates.step)
       apply (rule order_trans)
       apply (erule monotoneD[OF M(1)])
       apply (rule LE)
       done
     thus "\<exists>y\<in>ccpo_class.iterates g. f x \<le> y" ..
   next
     case (Sup M)
     define N where "N = {SOME y. y\<in>ccpo_class.iterates g \<and> x\<le>y | x. x\<in>M}"
 
     have N1: "\<forall>y\<in>N. y\<in>ccpo_class.iterates g \<and> (\<exists>x\<in>M. x\<le>y)"
       unfolding N_def
       apply auto
       apply (metis (lifting) Sup.hyps(2) tfl_some)
       by (metis (lifting) Sup.hyps(2) tfl_some)
 
     have N2: "\<forall>x\<in>M. \<exists>y\<in>N. x\<le>y"
       unfolding N_def
       apply auto
       by (metis (lifting) Sup.hyps(2) tfl_some)
 
     have "N \<subseteq> ccpo_class.iterates g" using Sup
       using N1 by auto
     hence C_chain: "Complete_Partial_Order.chain (\<le>) N"
       using chain_iterates[OF M(2)]
       unfolding chain_def by auto
 
     have "Sup N \<in> ccpo_class.iterates g" and "Sup M \<le> Sup N"
       apply -
       apply (rule iterates.Sup[OF C_chain])
       using N1 apply blast
       apply (rule ccpo_Sup_mono)
       apply (rule Sup.hyps)
       apply (rule C_chain)
       apply (rule N2)
       done
 
     thus ?case by blast
   qed
 qed
 
 end
 
   
 subsection \<open>Code\<close>  
 text \<open>Constant for code-abort. If that gets executed, an abort-exception is raised.\<close>  
 definition [simp]: "CODE_ABORT f = f ()"
 declare [[code abort: CODE_ABORT]]
   
   
 end
diff --git a/thys/Concurrent_Revisions/Renaming.thy b/thys/Concurrent_Revisions/Renaming.thy
--- a/thys/Concurrent_Revisions/Renaming.thy
+++ b/thys/Concurrent_Revisions/Renaming.thy
@@ -1,292 +1,292 @@
 section Renaming
 
 text \<open>Similar to the bound variables of lambda calculus, location and revision identifiers are meaningless
   names. This theory contains all of the definitions and results required for renaming data structures
   and proving renaming-equivalence.\<close>
 
 theory Renaming
   imports Occurrences
 begin
 
 subsection Definitions
 
 abbreviation rename_val :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) val \<Rightarrow> ('r,'l,'v) val" ("\<R>\<^sub>V") where
   "\<R>\<^sub>V \<alpha> \<beta> v \<equiv> map_val \<alpha> \<beta> id v"
 
 abbreviation rename_expr :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) expr \<Rightarrow> ('r,'l,'v) expr" ("\<R>\<^sub>E") where
   "\<R>\<^sub>E \<alpha> \<beta> e \<equiv> map_expr \<alpha> \<beta> id e"
 
 abbreviation rename_cntxt :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) cntxt \<Rightarrow> ('r,'l,'v) cntxt" ("\<R>\<^sub>C") where
   "\<R>\<^sub>C \<alpha> \<beta> \<E> \<equiv> map_cntxt \<alpha> \<beta> id \<E>"
 
 definition is_store_renaming :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) store \<Rightarrow> ('r,'l,'v) store \<Rightarrow> bool" where 
   "is_store_renaming \<alpha> \<beta> \<sigma> \<sigma>' \<equiv> \<forall>l. case \<sigma> l of None \<Rightarrow> \<sigma>' (\<beta> l) = None | Some v \<Rightarrow> \<sigma>' (\<beta> l) = Some (\<R>\<^sub>V \<alpha> \<beta> v)"
 
 notation Option.bind (infixl "\<bind>" 80)
 
 fun \<R>\<^sub>S :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) store \<Rightarrow> ('r,'l,'v) store" where
   "\<R>\<^sub>S \<alpha> \<beta> \<sigma> l = \<sigma> (inv \<beta> l) \<bind> (\<lambda>v. Some (\<R>\<^sub>V \<alpha> \<beta> v))"
 
 lemma \<R>\<^sub>S_implements_renaming: "bij \<beta> \<Longrightarrow> is_store_renaming \<alpha> \<beta> \<sigma> (\<R>\<^sub>S \<alpha> \<beta> \<sigma>)"
 proof -
   assume "bij \<beta>"
   hence "inj \<beta>" using bij_def by auto
   thus ?thesis by (auto simp add: is_store_renaming_def option.case_eq_if)
 qed
 
 fun \<R>\<^sub>L :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) local_state \<Rightarrow> ('r,'l,'v) local_state" where
   "\<R>\<^sub>L \<alpha> \<beta> (\<sigma>,\<tau>,e) = (\<R>\<^sub>S \<alpha> \<beta> \<sigma>, \<R>\<^sub>S \<alpha> \<beta> \<tau>, \<R>\<^sub>E \<alpha> \<beta> e)"
 
 definition is_global_renaming :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" where 
   "is_global_renaming \<alpha> \<beta> s s' \<equiv> \<forall>r. case s r of None \<Rightarrow> s' (\<alpha> r) = None | Some ls \<Rightarrow> s' (\<alpha> r) = Some (\<R>\<^sub>L \<alpha> \<beta> ls)"
 
 fun \<R>\<^sub>G :: "('r \<Rightarrow> 'r) \<Rightarrow> ('l \<Rightarrow> 'l) \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state" where
   "\<R>\<^sub>G \<alpha> \<beta> s r = s (inv \<alpha> r) \<bind> (\<lambda>ls. Some (\<R>\<^sub>L \<alpha> \<beta> ls))"
 
 lemma \<R>\<^sub>G_implements_renaming: "bij \<alpha> \<Longrightarrow> is_global_renaming \<alpha> \<beta> s (\<R>\<^sub>G \<alpha> \<beta> s)"
 proof -
   assume "bij \<alpha>"
   hence "inj \<alpha>" using bij_def by auto
   thus ?thesis by (auto simp add: is_global_renaming_def option.case_eq_if)
 qed
 
 subsection \<open>Introduction rules\<close>
 
 lemma \<R>\<^sub>SI [intro]:
   assumes
     bij_\<beta>: "bij \<beta>" and
     none_case: "\<And>l. \<sigma> l = None \<Longrightarrow> \<sigma>' (\<beta> l) = None" and
     some_case: "\<And>l v. \<sigma> l = Some v \<Longrightarrow> \<sigma>' (\<beta> l) = Some (\<R>\<^sub>V \<alpha> \<beta> v)"
   shows
     "\<R>\<^sub>S \<alpha> \<beta> \<sigma> = \<sigma>'"
 proof (rule ext, subst \<R>\<^sub>S.simps)
   fix l
   show "\<sigma> (inv \<beta> l) \<bind> (\<lambda>v. Some (\<R>\<^sub>V \<alpha> \<beta> v)) = \<sigma>' l" (is "?lhs = \<sigma>' l")
   proof (cases "\<sigma> (inv \<beta> l) = None")
     case True
     have lhs_none: "?lhs = None" by (simp add: True)
     have "\<sigma>' (\<beta> (inv \<beta> l)) = None" by (simp add: none_case True)
     hence rhs_none: "\<sigma>' l = None" by (simp add: bij_\<beta> bijection.intro bijection.inv_right)
     show ?thesis by (simp add: lhs_none rhs_none)
   next
     case False
     from this obtain v where is_some: "\<sigma> (inv \<beta> l) = Some v" by blast
     hence lhs_some: "?lhs = Some (\<R>\<^sub>V \<alpha> \<beta> v)" by auto
     have "\<sigma>' (\<beta> (inv \<beta> l)) = Some (\<R>\<^sub>V \<alpha> \<beta> v)" by (simp add: is_some some_case)
     hence rhs_some: "\<sigma>' l = Some (\<R>\<^sub>V \<alpha> \<beta> v)" by (simp add: bij_\<beta> bijection.intro bijection.inv_right)
     then show ?thesis by (simp add: lhs_some)
   qed
 qed
 
 lemma \<R>\<^sub>GI [intro]: 
   assumes
     bij_\<alpha>: "bij \<alpha>" and
     none_case: "\<And>r. s r = None \<Longrightarrow> s' (\<alpha> r) = None" and
     some_case: "\<And>r \<sigma> \<tau> e. s r = Some (\<sigma>,\<tau>,e) \<Longrightarrow> s' (\<alpha> r) = Some (\<R>\<^sub>L \<alpha> \<beta> (\<sigma>,\<tau>,e))"
   shows
     "\<R>\<^sub>G \<alpha> \<beta> s = s'"
 proof (rule ext, subst \<R>\<^sub>G.simps)
   fix r
   show "s (inv \<alpha> r) \<bind> (\<lambda>ls. Some (\<R>\<^sub>L \<alpha> \<beta> ls)) = s' r" (is "?lhs = s' r")
   proof (cases "s (inv \<alpha> r) = None")
     case True
     have lhs_none: "?lhs = None" by (simp add: True)
     have "s' (\<alpha> (inv \<alpha> r)) = None" by (simp add: none_case True)
     hence rhs_none: "s' r = None" by (simp add: bij_\<alpha> bijection.intro bijection.inv_right)
     show ?thesis by (simp add: lhs_none rhs_none)
   next
     case False
     from this obtain ls where "s (inv \<alpha> r) = Some ls" by blast
     from this obtain \<sigma> \<tau> e where is_some: "s (inv \<alpha> r) = Some (\<sigma>, \<tau>, e)" by (cases ls) blast
     hence lhs_some: "?lhs = Some (\<R>\<^sub>L \<alpha> \<beta> (\<sigma>, \<tau>, e))" by auto
     have "s' (\<alpha> (inv \<alpha> r)) = Some (\<R>\<^sub>L \<alpha> \<beta> (\<sigma>, \<tau>, e))" by (simp add: is_some some_case)
     hence rhs_some: "s' r = Some (\<R>\<^sub>L \<alpha> \<beta> (\<sigma>, \<tau>, e))" by (simp add: bij_\<alpha> bijection.intro bijection.inv_right)
     then show ?thesis by (simp add: lhs_some)
   qed
 qed
 
 subsection \<open>Renaming-equivalence\<close>
 
 subsubsection Identity
 
 declare val.map_id [simp]
 declare expr.map_id [simp]
 declare cntxt.map_id [simp]
 lemma \<R>\<^sub>S_id [simp]: "\<R>\<^sub>S id id \<sigma> = \<sigma>" by auto
 lemma \<R>\<^sub>L_id [simp]: "\<R>\<^sub>L id id ls = ls" by (cases ls) simp
 lemma \<R>\<^sub>G_id [simp]: "\<R>\<^sub>G id id s = s" by auto
 
 subsubsection Composition
 
 declare val.map_comp [simp]
 declare expr.map_comp [simp]
 declare cntxt.map_comp [simp]
 lemma \<R>\<^sub>S_comp [simp]: "\<lbrakk> bij \<beta>; bij \<beta>' \<rbrakk> \<Longrightarrow> \<R>\<^sub>S \<alpha>' \<beta>' (\<R>\<^sub>S \<alpha> \<beta> s) = \<R>\<^sub>S (\<alpha>' \<circ> \<alpha>) (\<beta>' \<circ> \<beta>) s"
   by (auto simp add: o_inv_distrib)
 lemma \<R>\<^sub>L_comp [simp]: "\<lbrakk> bij \<beta>; bij \<beta>' \<rbrakk> \<Longrightarrow> \<R>\<^sub>L \<alpha>' \<beta>' (\<R>\<^sub>L \<alpha> \<beta> ls) = \<R>\<^sub>L (\<alpha>' \<circ> \<alpha>) (\<beta>' \<circ> \<beta>) ls"
   by (cases ls) simp
 lemma \<R>\<^sub>G_comp [simp]: "\<lbrakk> bij \<alpha>; bij \<alpha>'; bij \<beta>; bij \<beta>' \<rbrakk> \<Longrightarrow> \<R>\<^sub>G \<alpha>' \<beta>' (\<R>\<^sub>G \<alpha> \<beta> s) = \<R>\<^sub>G (\<alpha>' \<circ> \<alpha>) (\<beta>' \<circ> \<beta>) s"
   by (rule ext) (auto simp add: o_inv_distrib)
 
 subsubsection Inverse
 
 lemma \<R>\<^sub>V_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>V (inv \<alpha>) (inv \<beta>) v' = v) = (\<R>\<^sub>V \<alpha> \<beta> v = v')"
   by (auto simp add: bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 lemma \<R>\<^sub>E_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>E (inv \<alpha>) (inv \<beta>) e' = e) = (\<R>\<^sub>E \<alpha> \<beta> e = e')"
   by (auto simp add: bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 lemma \<R>\<^sub>C_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>C (inv \<alpha>) (inv \<beta>) \<E>' = \<E>) = (\<R>\<^sub>C \<alpha> \<beta> \<E> = \<E>')"
   by (auto simp add: bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 lemma \<R>\<^sub>S_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>S (inv \<alpha>) (inv \<beta>) \<sigma>' = \<sigma>) = (\<R>\<^sub>S \<alpha> \<beta> \<sigma> = \<sigma>')"
   by (auto simp add: bij_imp_bij_inv bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 lemma \<R>\<^sub>L_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>L (inv \<alpha>) (inv \<beta>) ls' = ls) = (\<R>\<^sub>L \<alpha> \<beta> ls = ls')"
   by (auto simp add: bij_imp_bij_inv bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 lemma \<R>\<^sub>G_inv [simp]: "\<lbrakk> bij \<alpha>; bij \<beta> \<rbrakk> \<Longrightarrow> (\<R>\<^sub>G (inv \<alpha>) (inv \<beta>) s' = s) = (\<R>\<^sub>G \<alpha> \<beta> s = s')"
   by (auto simp add: bij_imp_bij_inv bijection.intro bijection.inv_comp_right bijection.inv_comp_left)
 
 subsubsection Equivalence
 
 definition eq_states :: "('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" ("_ \<approx> _" [100, 100]) where
   "s \<approx> s' \<equiv> \<exists>\<alpha> \<beta>. bij \<alpha> \<and> bij \<beta> \<and> \<R>\<^sub>G \<alpha> \<beta> s = s'"
 
 lemma eq_statesI [intro]:
   "\<R>\<^sub>G \<alpha> \<beta> s = s' \<Longrightarrow> bij \<alpha> \<Longrightarrow> bij \<beta> \<Longrightarrow> s \<approx> s'"
   using eq_states_def by auto
 
 lemma eq_statesE [elim]:
   "s \<approx> s' \<Longrightarrow> (\<And>\<alpha> \<beta>. \<R>\<^sub>G \<alpha> \<beta> s = s' \<Longrightarrow> bij \<alpha> \<Longrightarrow> bij \<beta> \<Longrightarrow> P) \<Longrightarrow> P"
   using eq_states_def by blast
 
 lemma \<alpha>\<beta>_refl: "s \<approx> s" by (rule eq_statesI[of id id s]) auto
  
 lemma \<alpha>\<beta>_trans: "s \<approx> s' \<Longrightarrow> s' \<approx> s'' \<Longrightarrow> s \<approx> s''"
 proof -
   assume "s \<approx> s'"
   from this obtain \<alpha> \<beta> where s_s': "bij \<alpha>" "bij \<beta>" "\<R>\<^sub>G \<alpha> \<beta> s = s'" by blast
   assume "s' \<approx> s''"
   from this obtain \<alpha>' \<beta>' where s'_s'': "bij \<alpha>'" "bij \<beta>'" "\<R>\<^sub>G \<alpha>' \<beta>' s' = s''" by blast
   show "s \<approx> s''" by (rule eq_statesI[of "\<alpha>' \<circ> \<alpha>" "\<beta>' \<circ> \<beta>"]) (use s_s' s'_s'' in \<open>auto simp add: bij_comp\<close>)
 qed
 
 lemma \<alpha>\<beta>_sym: "s \<approx> s' \<Longrightarrow> s' \<approx> s"
 proof -
   assume "s \<approx> s'"
   from this obtain \<alpha> \<beta> where s_s': "bij \<alpha>" "bij \<beta>" "\<R>\<^sub>G \<alpha> \<beta> s = s'" by blast
   show "s' \<approx> s" by (rule eq_statesI[of "inv \<alpha>" "inv \<beta>"]) (use s_s' in \<open>auto simp add: bij_imp_bij_inv\<close>)
 qed
 
 subsection \<open>Distributive laws\<close>
 
 subsubsection Expression
 
 lemma renaming_distr_completion [simp]:
   "\<R>\<^sub>E \<alpha> \<beta> (\<E>[e]) = ((\<R>\<^sub>C \<alpha> \<beta> \<E>)[\<R>\<^sub>E \<alpha> \<beta> e])"
   by (induct \<E>) simp+
 
 subsubsection Store
 
 lemma renaming_distr_combination [simp]: 
   "\<R>\<^sub>S \<alpha> \<beta> (\<sigma>;;\<tau>) = (\<R>\<^sub>S \<alpha> \<beta> \<sigma>;;\<R>\<^sub>S \<alpha> \<beta> \<tau>)"
   by (rule ext) auto
 
 lemma renaming_distr_store [simp]:
-  "bij \<beta> \<Longrightarrow> \<R>\<^sub>S \<alpha> \<beta> (\<sigma>(l \<mapsto> v)) = \<R>\<^sub>S \<alpha> \<beta> \<sigma>(\<beta> l \<mapsto> \<R>\<^sub>V \<alpha> \<beta> v)"
+  "bij \<beta> \<Longrightarrow> \<R>\<^sub>S \<alpha> \<beta> (\<sigma>(l \<mapsto> v)) = (\<R>\<^sub>S \<alpha> \<beta> \<sigma>)(\<beta> l \<mapsto> \<R>\<^sub>V \<alpha> \<beta> v)"
   by (auto simp add: bijection.intro bijection.inv_left_eq_iff)
 
 (* distribution law for local follows from the definition *)
 
 subsubsection Global 
 
 lemma renaming_distr_global [simp]:
-  "bij \<alpha> \<Longrightarrow> \<R>\<^sub>G \<alpha> \<beta> (s(r \<mapsto> ls)) = \<R>\<^sub>G \<alpha> \<beta> s(\<alpha> r \<mapsto> \<R>\<^sub>L \<alpha> \<beta> ls)"
+  "bij \<alpha> \<Longrightarrow> \<R>\<^sub>G \<alpha> \<beta> (s(r \<mapsto> ls)) = (\<R>\<^sub>G \<alpha> \<beta> s)(\<alpha> r \<mapsto> \<R>\<^sub>L \<alpha> \<beta> ls)"
   "bij \<alpha> \<Longrightarrow> \<R>\<^sub>G \<alpha> \<beta> (s(r := None)) = (\<R>\<^sub>G \<alpha> \<beta> s)(\<alpha> r := None)"
   by (auto simp add: bijection.intro bijection.inv_left_eq_iff)
 
 subsection \<open>Miscellaneous laws\<close>
 
 lemma rename_empty [simp]:
   "\<R>\<^sub>S \<alpha> \<beta> \<epsilon> = \<epsilon>"
   "\<R>\<^sub>G \<alpha> \<beta> \<epsilon> = \<epsilon>"
   by auto
 
 subsection Swaps
 
 lemma swap_bij: 
   "bij (id(x := x', x' := x))" (is "bij ?f")
 proof (rule bijI)
   show "inj ?f" by (simp add: inj_on_def)
   show "surj ?f"
   proof
     show "UNIV \<subseteq> range (id(x := x', x' := x))"
     proof (rule subsetI)
       fix y
       assume "y \<in> (UNIV :: 'a set)"
       show "y \<in> range (id(x := x', x' := x))" by (cases "y = x"; cases "y = x'") auto
     qed
   qed simp
 qed
 
 lemma id_trivial_update [simp]: "id(x := x) = id" by auto (* for solving trivial peaks *)
 
 lemma eliminate_renaming_val_expr [simp]:
   fixes
     v :: "('r,'l,'v) val" and
     e :: "('r,'l,'v) expr"
   shows
     "l \<notin> LID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V \<alpha> (\<beta>(l := l')) v = \<R>\<^sub>V \<alpha> \<beta> v"
     "l \<notin> LID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E \<alpha> (\<beta>(l := l')) e = \<R>\<^sub>E \<alpha> \<beta> e"
     "r \<notin> RID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V (\<alpha>(r := r')) \<beta> v = \<R>\<^sub>V \<alpha> \<beta> v"
     "r \<notin> RID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E (\<alpha>(r := r')) \<beta> e = \<R>\<^sub>E \<alpha> \<beta> e"
 proof -
   have "(\<forall>\<alpha> \<beta> r r'. r \<notin> RID\<^sub>V v \<longrightarrow> \<R>\<^sub>V (\<alpha>(r := r')) \<beta> v = \<R>\<^sub>V \<alpha> \<beta> v) \<and>
     (\<forall>\<alpha> \<beta> r r'. r \<notin> RID\<^sub>E e \<longrightarrow> \<R>\<^sub>E (\<alpha>(r := r')) \<beta> e = \<R>\<^sub>E \<alpha> \<beta> e)"
     by (induct rule: val_expr.induct) simp+
   thus 
     "r \<notin> RID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V (\<alpha>(r := r')) \<beta> v = \<R>\<^sub>V \<alpha> \<beta> v" 
     "r \<notin> RID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E (\<alpha>(r := r')) \<beta> e = \<R>\<^sub>E \<alpha> \<beta> e"
     by simp+
   have "(\<forall>\<alpha> \<beta> l l'. l \<notin> LID\<^sub>V v \<longrightarrow> \<R>\<^sub>V \<alpha> (\<beta>(l := l')) v = \<R>\<^sub>V \<alpha> \<beta> v) \<and>
     (\<forall>\<alpha> \<beta> l l'. l \<notin> LID\<^sub>E e \<longrightarrow> \<R>\<^sub>E \<alpha> (\<beta>(l := l')) e = \<R>\<^sub>E \<alpha> \<beta> e)"
     by (induct rule: val_expr.induct) simp+
   thus 
     "l \<notin> LID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V \<alpha> (\<beta>(l := l')) v = \<R>\<^sub>V \<alpha> \<beta> v" and
     "l \<notin> LID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E \<alpha> (\<beta>(l := l')) e = \<R>\<^sub>E \<alpha> \<beta> e"
     by simp+
 qed
 
 lemma eliminate_renaming_cntxt [simp]:
   "r \<notin> RID\<^sub>C \<E> \<Longrightarrow> \<R>\<^sub>C (\<alpha>(r := r')) \<beta> \<E> = \<R>\<^sub>C \<alpha> \<beta> \<E>"
   "l \<notin> LID\<^sub>C \<E> \<Longrightarrow> \<R>\<^sub>C \<alpha> (\<beta>(l := l')) \<E> = \<R>\<^sub>C \<alpha> \<beta> \<E>"
   by (induct \<E> rule: cntxt.induct) auto
 
 lemma eliminate_swap_val [simp, intro]:
   "r \<notin> RID\<^sub>V v \<Longrightarrow> r' \<notin> RID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V (id(r := r', r' := r)) id v = v"
   "l \<notin> LID\<^sub>V v \<Longrightarrow> l' \<notin> LID\<^sub>V v \<Longrightarrow> \<R>\<^sub>V id (id(l := l', l' := l)) v = v"
   by simp+
 
 lemma eliminate_swap_expr [simp, intro]:
   "r \<notin> RID\<^sub>E e \<Longrightarrow> r' \<notin> RID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E (id(r := r', r' := r)) id e = e"
   "l \<notin> LID\<^sub>E e \<Longrightarrow> l' \<notin> LID\<^sub>E e \<Longrightarrow> \<R>\<^sub>E id (id(l := l', l' := l)) e = e"
   by simp+
 
 lemma eliminate_swap_cntxt [simp, intro]:
   "r \<notin> RID\<^sub>C \<E> \<Longrightarrow> r' \<notin> RID\<^sub>C \<E> \<Longrightarrow> \<R>\<^sub>C (id(r := r', r' := r)) id \<E> = \<E>"
   "l \<notin> LID\<^sub>C \<E> \<Longrightarrow> l' \<notin> LID\<^sub>C \<E> \<Longrightarrow> \<R>\<^sub>C id (id(l := l', l' := l)) \<E> = \<E>"
   by simp+
 
 lemma eliminate_swap_store_rid [simp, intro]:
   "r \<notin> RID\<^sub>S \<sigma> \<Longrightarrow> r' \<notin> RID\<^sub>S \<sigma> \<Longrightarrow> \<R>\<^sub>S (id(r := r', r' := r)) id \<sigma> = \<sigma>"
   by (rule \<R>\<^sub>SI) (auto simp add: swap_bij RID\<^sub>S_def domIff ranI)
 
 lemma eliminate_swap_store_lid [simp, intro]:
   "l \<notin> LID\<^sub>S \<sigma> \<Longrightarrow> l' \<notin> LID\<^sub>S \<sigma> \<Longrightarrow> \<R>\<^sub>S id (id(l := l', l' := l)) \<sigma> = \<sigma>"
   by (rule \<R>\<^sub>SI) (auto simp add: swap_bij LID\<^sub>S_def domIff ranI)
 
 lemma eliminate_swap_global_rid [simp, intro]:
   "r \<notin> RID\<^sub>G s \<Longrightarrow> r' \<notin> RID\<^sub>G s \<Longrightarrow> \<R>\<^sub>G (id(r := r', r' := r)) id s = s"
   by (rule \<R>\<^sub>GI[OF swap_bij], ((rule sym, auto)[1])+)
 
 lemma eliminate_swap_global_lid [simp, intro]:
   "l \<notin> LID\<^sub>G s \<Longrightarrow> l' \<notin> LID\<^sub>G s \<Longrightarrow> \<R>\<^sub>G id (id(l := l', l' := l)) s = s"
   by (rule \<R>\<^sub>GI) (auto simp add: ID_distr_global_conditional)
 
 end
diff --git a/thys/Containers/RBT_ext.thy b/thys/Containers/RBT_ext.thy
--- a/thys/Containers/RBT_ext.thy
+++ b/thys/Containers/RBT_ext.thy
@@ -1,358 +1,358 @@
 (*  Title:      Containers/RBT_ext.thy
     Author:     Andreas Lochbihler, KIT *)
 
 theory RBT_ext
 imports
   "HOL-Library.RBT_Impl"
   Containers_Auxiliary
   List_Fusion
 begin
 
 section \<open>More on red-black trees\<close>
 
 subsection \<open>More lemmas\<close>
 
 context linorder begin
 
 lemma is_rbt_fold_rbt_insert_impl:
   "is_rbt t \<Longrightarrow> is_rbt (RBT_Impl.fold rbt_insert t' t)"
 by(simp add: rbt_insert_def is_rbt_fold_rbt_insertwk)
 
 lemma rbt_sorted_fold_insert: "rbt_sorted t \<Longrightarrow> rbt_sorted (RBT_Impl.fold rbt_insert t' t)"
 by(induct t' arbitrary: t)(simp_all add: rbt_insert_rbt_sorted)
 
-lemma rbt_lookup_rbt_insert': "rbt_sorted t \<Longrightarrow> rbt_lookup (rbt_insert k v t) = rbt_lookup t(k \<mapsto> v)"
+lemma rbt_lookup_rbt_insert': "rbt_sorted t \<Longrightarrow> rbt_lookup (rbt_insert k v t) = (rbt_lookup t)(k \<mapsto> v)"
 by(simp add: rbt_insert_def rbt_lookup_rbt_insertwk fun_eq_iff split: option.split)
 
 lemma rbt_lookup_fold_rbt_insert_impl:
   "rbt_sorted t2 \<Longrightarrow> 
   rbt_lookup (RBT_Impl.fold rbt_insert t1 t2) = rbt_lookup t2 ++ map_of (rev (RBT_Impl.entries t1))"
 proof(induction t1 arbitrary: t2)
   case Empty thus ?case by simp
 next
   case (Branch c l x k r)
   show ?case using Branch.prems
     by(simp add: map_add_def Branch.IH rbt_insert_rbt_sorted rbt_sorted_fold_insert rbt_lookup_rbt_insert' fun_eq_iff split: option.split)
 qed
 
 end
 
 subsection \<open>Build the cross product of two RBTs\<close>
 
 context fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c \<Rightarrow> 'd \<Rightarrow> 'e" begin
 
 definition alist_product :: "('a \<times> 'b) list \<Rightarrow> ('c \<times> 'd) list \<Rightarrow> (('a \<times> 'c) \<times> 'e) list"
 where "alist_product xs ys = concat (map (\<lambda>(a, b). map (\<lambda>(c, d). ((a, c), f a b c d)) ys) xs)"
 
 lemma alist_product_simps [simp]:
   "alist_product [] ys = []"
   "alist_product xs [] = []"
   "alist_product ((a, b) # xs) ys = map (\<lambda>(c, d). ((a, c), f a b c d)) ys @ alist_product xs ys"
 by(simp_all add: alist_product_def)
 
 lemma append_alist_product_conv_fold:
   "zs @ alist_product xs ys = rev (fold (\<lambda>(a, b). fold (\<lambda>(c, d) rest. ((a, c), f a b c d) # rest) ys) xs (rev zs))"
 proof(induction xs arbitrary: zs)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   obtain a b where x: "x = (a, b)" by(cases x)
   have "\<And>zs. fold (\<lambda>(c, d). (#) ((a, c), f a b c d)) ys zs =
     rev (map (\<lambda>(c, d). ((a, c), f a b c d)) ys) @ zs"
     by(induct ys) auto
   with Cons.IH[of "zs @ map (\<lambda>(c, d). ((a, c), f a b c d)) ys"] x
   show ?case by simp
 qed
 
 lemma alist_product_code [code]:
   "alist_product xs ys =
   rev (fold (\<lambda>(a, b). fold (\<lambda>(c, d) rest. ((a, c), f a b c d) # rest) ys) xs [])"
 using append_alist_product_conv_fold[of "[]" xs ys]
 by simp
 
 lemma set_alist_product:
   "set (alist_product xs ys) =
   (\<lambda>((a, b), (c, d)). ((a, c), f a b c d)) ` (set xs \<times> set ys)"
 by(auto 4 3 simp add: alist_product_def intro: rev_image_eqI rev_bexI)
 
 lemma distinct_alist_product:
   "\<lbrakk> distinct (map fst xs); distinct (map fst ys) \<rbrakk>
   \<Longrightarrow> distinct (map fst (alist_product xs ys))"
 proof(induct xs)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   obtain a b where x: "x = (a, b)" by(cases x)
   have "distinct (map (fst \<circ> (\<lambda>(c, d). ((a, c), f a b c d))) ys)"
     using \<open>distinct (map fst ys)\<close> by(induct ys)(auto intro: rev_image_eqI)
   thus ?case using Cons x by(auto simp add: set_alist_product intro: rev_image_eqI)
 qed
 
 lemma map_of_alist_product:
   "map_of (alist_product xs ys) (a, c) = 
   (case map_of xs a of None \<Rightarrow> None
    | Some b \<Rightarrow> map_option (f a b c) (map_of ys c))"
 proof(induction xs)
   case Nil thus ?case by simp
 next
   case (Cons x xs)
   obtain a b where x: "x = (a, b)" by (cases x)
   let ?map = "map (\<lambda>(c, d). ((a, c), f a b c d)) ys"
   have "map_of ?map (a, c) = map_option (f a b c) (map_of ys c)"
     by(induct ys) auto
   moreover {
     fix a' assume "a' \<noteq> a"
     hence "map_of ?map (a', c) = None"
       by(induct ys) auto }
   ultimately show ?case using x Cons.IH
     by(auto simp add: map_add_def split: option.split)
 qed
 
 definition rbt_product :: "('a, 'b) rbt \<Rightarrow> ('c, 'd) rbt \<Rightarrow> ('a \<times> 'c, 'e) rbt"
 where
   "rbt_product rbt1 rbt2 = rbtreeify (alist_product (RBT_Impl.entries rbt1) (RBT_Impl.entries rbt2))"
 
 lemma rbt_product_code [code]:
   "rbt_product rbt1 rbt2 =
    rbtreeify (rev (RBT_Impl.fold (\<lambda>a b. RBT_Impl.fold (\<lambda>c d rest. ((a, c), f a b c d) # rest) rbt2) rbt1 []))"
 unfolding rbt_product_def alist_product_code RBT_Impl.fold_def ..
 
 end
 
 context
   fixes leq_a :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>\<^sub>a" 50) 
   and less_a :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>\<^sub>a" 50) 
   and leq_b :: "'b \<Rightarrow> 'b \<Rightarrow> bool" (infix "\<sqsubseteq>\<^sub>b" 50) 
   and less_b :: "'b \<Rightarrow> 'b \<Rightarrow> bool" (infix "\<sqsubset>\<^sub>b" 50) 
   assumes lin_a: "class.linorder leq_a less_a" 
   and lin_b: "class.linorder leq_b less_b"
 begin
 
 abbreviation (input) less_eq_prod' :: "('a \<times> 'b) \<Rightarrow> ('a \<times> 'b) \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 where "less_eq_prod' \<equiv> less_eq_prod leq_a less_a leq_b"
 
 abbreviation (input) less_prod' :: "('a \<times> 'b) \<Rightarrow> ('a \<times> 'b) \<Rightarrow> bool" (infix "\<sqsubset>" 50)
 where "less_prod' \<equiv> less_prod leq_a less_a less_b"
 
 lemmas linorder_prod = linorder_prod[OF lin_a lin_b]
 
 lemma sorted_alist_product: 
   assumes xs: "linorder.sorted leq_a (map fst xs)" "distinct (map fst xs)"
   and ys: "linorder.sorted (\<sqsubseteq>\<^sub>b) (map fst ys)"
   shows "linorder.sorted (\<sqsubseteq>) (map fst (alist_product f xs ys))"
 proof -
   interpret a: linorder "(\<sqsubseteq>\<^sub>a)" "(\<sqsubset>\<^sub>a)" by(fact lin_a)
 
   note [simp] = 
     linorder.sorted0[OF linorder_prod] linorder.sorted1[OF linorder_prod]
     linorder.sorted_append[OF linorder_prod]
     linorder.sorted1[OF lin_b]
 
   show ?thesis using xs
   proof(induction xs)
     case Nil show ?case by simp
   next
     case (Cons x xs)
     obtain a b where x: "x = (a, b)" by(cases x)
     have "linorder.sorted (\<sqsubseteq>) (map fst (map (\<lambda>(c, d). ((a, c), f a b c d)) ys))"
       using ys by(induct ys) auto
     thus ?case using x Cons
       by(fastforce simp add: set_alist_product a.not_less dest: bspec a.order_antisym intro: rev_image_eqI)
   qed
 qed
 
 lemma is_rbt_rbt_product:
   "\<lbrakk> ord.is_rbt (\<sqsubset>\<^sub>a) rbt1; ord.is_rbt (\<sqsubset>\<^sub>b) rbt2 \<rbrakk>
   \<Longrightarrow> ord.is_rbt (\<sqsubset>) (rbt_product f rbt1 rbt2)"
 unfolding rbt_product_def
 by(blast intro: linorder.is_rbt_rbtreeify[OF linorder_prod] sorted_alist_product linorder.rbt_sorted_entries[OF lin_a] ord.is_rbt_rbt_sorted linorder.distinct_entries[OF lin_a] linorder.rbt_sorted_entries[OF lin_b] distinct_alist_product linorder.distinct_entries[OF lin_b])
 
 lemma rbt_lookup_rbt_product:
   "\<lbrakk> ord.is_rbt (\<sqsubset>\<^sub>a) rbt1; ord.is_rbt (\<sqsubset>\<^sub>b) rbt2 \<rbrakk>
   \<Longrightarrow> ord.rbt_lookup (\<sqsubset>) (rbt_product f rbt1 rbt2) (a, c) =
      (case ord.rbt_lookup (\<sqsubset>\<^sub>a) rbt1 a of None \<Rightarrow> None
       | Some b \<Rightarrow> map_option (f a b c) (ord.rbt_lookup (\<sqsubset>\<^sub>b) rbt2 c))"
 by(simp add: rbt_product_def linorder.rbt_lookup_rbtreeify[OF linorder_prod] linorder.is_rbt_rbtreeify[OF linorder_prod] sorted_alist_product linorder.rbt_sorted_entries[OF lin_a] ord.is_rbt_rbt_sorted linorder.distinct_entries[OF lin_a] linorder.rbt_sorted_entries[OF lin_b] distinct_alist_product linorder.distinct_entries[OF lin_b] map_of_alist_product linorder.map_of_entries[OF lin_a] linorder.map_of_entries[OF lin_b] cong: option.case_cong)
 
 end
 
 hide_const less_eq_prod' less_prod'
 
 subsection \<open>Build an RBT where keys are paired with themselves\<close>
 
 primrec RBT_Impl_diag :: "('a, 'b) rbt \<Rightarrow> ('a \<times> 'a, 'b) rbt"
 where
   "RBT_Impl_diag rbt.Empty = rbt.Empty"
 | "RBT_Impl_diag (rbt.Branch c l k v r) = rbt.Branch c (RBT_Impl_diag l) (k, k) v (RBT_Impl_diag r)"
 
 lemma entries_RBT_Impl_diag:
   "RBT_Impl.entries (RBT_Impl_diag t) = map (\<lambda>(k, v). ((k, k), v)) (RBT_Impl.entries t)"
 by(induct t) simp_all
 
 lemma keys_RBT_Impl_diag:
   "RBT_Impl.keys (RBT_Impl_diag t) = map (\<lambda>k. (k, k)) (RBT_Impl.keys t)"
 by(simp add: RBT_Impl.keys_def entries_RBT_Impl_diag split_beta)
 
 lemma rbt_sorted_RBT_Impl_diag:
   "ord.rbt_sorted lt t \<Longrightarrow> ord.rbt_sorted (less_prod leq lt lt) (RBT_Impl_diag t)"
 by(induct t)(auto simp add: ord.rbt_sorted.simps ord.rbt_less_prop ord.rbt_greater_prop keys_RBT_Impl_diag)
 
 lemma bheight_RBT_Impl_diag:
   "bheight (RBT_Impl_diag t) = bheight t"
 by(induct t) simp_all
 
 lemma inv_RBT_Impl_diag:
   assumes "inv1 t" "inv2 t"
   shows "inv1 (RBT_Impl_diag t)" "inv2 (RBT_Impl_diag t)"
   and "color_of t = color.B \<Longrightarrow> color_of (RBT_Impl_diag t) = color.B"
 using assms by(induct t)(auto simp add: bheight_RBT_Impl_diag)
 
 lemma is_rbt_RBT_Impl_diag:
   "ord.is_rbt lt t \<Longrightarrow> ord.is_rbt (less_prod leq lt lt) (RBT_Impl_diag t)"
 by(simp add: ord.is_rbt_def rbt_sorted_RBT_Impl_diag inv_RBT_Impl_diag)
 
 lemma (in linorder) rbt_lookup_RBT_Impl_diag:
   "ord.rbt_lookup (less_prod (\<le>) (<) (<)) (RBT_Impl_diag t) =
   (\<lambda>(k, k'). if k = k' then ord.rbt_lookup (<) t k else None)"
 by(induct t)(auto simp add: ord.rbt_lookup.simps fun_eq_iff)
 
 subsection \<open>Folding and quantifiers over RBTs\<close>
 
 definition RBT_Impl_fold1 :: "('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('a, unit) RBT_Impl.rbt \<Rightarrow> 'a"
 where "RBT_Impl_fold1 f rbt = fold f (tl (RBT_Impl.keys rbt)) (hd (RBT_Impl.keys rbt))"
 
 lemma RBT_Impl_fold1_simps [simp, code]:
   "RBT_Impl_fold1 f rbt.Empty = undefined"
   "RBT_Impl_fold1 f (Branch c rbt.Empty k v r) = RBT_Impl.fold (\<lambda>k v. f k) r k"
   "RBT_Impl_fold1 f (Branch c (Branch c' l' k' v' r') k v r) = 
    RBT_Impl.fold (\<lambda>k v. f k) r (f k (RBT_Impl_fold1 f (Branch c' l' k' v' r')))"
 by(simp_all add: RBT_Impl_fold1_def RBT_Impl.keys_def fold_map RBT_Impl.fold_def split_def o_def tl_append hd_def split: list.split)
 
 definition RBT_Impl_rbt_all :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool"
 where [code del]: "RBT_Impl_rbt_all P rbt = (\<forall>(k, v) \<in> set (RBT_Impl.entries rbt). P k v)"
 
 lemma RBT_Impl_rbt_all_simps [simp, code]:
   "RBT_Impl_rbt_all P rbt.Empty \<longleftrightarrow> True"
   "RBT_Impl_rbt_all P (Branch c l k v r) \<longleftrightarrow> P k v \<and> RBT_Impl_rbt_all P l \<and> RBT_Impl_rbt_all P r"
 by(auto simp add: RBT_Impl_rbt_all_def)
 
 definition RBT_Impl_rbt_ex :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool"
 where [code del]: "RBT_Impl_rbt_ex P rbt = (\<exists>(k, v) \<in> set (RBT_Impl.entries rbt). P k v)"
 
 lemma RBT_Impl_rbt_ex_simps [simp, code]:
   "RBT_Impl_rbt_ex P rbt.Empty \<longleftrightarrow> False"
   "RBT_Impl_rbt_ex P (Branch c l k v r) \<longleftrightarrow> P k v \<or> RBT_Impl_rbt_ex P l \<or> RBT_Impl_rbt_ex P r"
 by(auto simp add: RBT_Impl_rbt_ex_def)
 
 subsection \<open>List fusion for RBTs\<close>
 
 type_synonym ('a, 'b, 'c) rbt_generator_state = "('c \<times> ('a, 'b) RBT_Impl.rbt) list \<times> ('a, 'b) RBT_Impl.rbt"
 
 fun rbt_has_next :: "('a, 'b, 'c) rbt_generator_state \<Rightarrow> bool"
 where
   "rbt_has_next ([], rbt.Empty) = False"
 | "rbt_has_next _ = True"
 
 fun rbt_keys_next :: "('a, 'b, 'a) rbt_generator_state \<Rightarrow> 'a \<times> ('a, 'b, 'a) rbt_generator_state"
 where
   "rbt_keys_next ((k, t) # kts, rbt.Empty) = (k, kts, t)"
 | "rbt_keys_next (kts, rbt.Branch c l k v r) = rbt_keys_next ((k, r) # kts, l)"
 
 lemma rbt_generator_induct [case_names empty split shuffle]:
   assumes "P ([], rbt.Empty)"
   and "\<And>k t kts. P (kts, t) \<Longrightarrow> P ((k, t) # kts, rbt.Empty)"
   and "\<And>kts c l k v r. P ((f k v, r) # kts, l) \<Longrightarrow> P (kts, Branch c l k v r)"
   shows "P ktst"
 using assms
 apply(induction_schema)
 apply pat_completeness
 apply(relation "measure (\<lambda>(kts, t). size_list (\<lambda>(k, t). size_rbt (\<lambda>_. 1) (\<lambda>_. 1) t) kts + size_rbt (\<lambda>_. 1) (\<lambda>_. 1) t)")
 apply simp_all
 done
 
 lemma terminates_rbt_keys_generator:
   "terminates (rbt_has_next, rbt_keys_next)"
 proof
   fix ktst :: "('a \<times> ('a, 'b) rbt) list \<times> ('a, 'b) rbt"
   show "ktst \<in> terminates_on (rbt_has_next, rbt_keys_next)"
     by(induct ktst taking: "\<lambda>k _. k" rule: rbt_generator_induct)(auto 4 3 intro: terminates_on.intros elim: terminates_on.cases)
 qed
 
 lift_definition rbt_keys_generator :: "('a, ('a, 'b, 'a) rbt_generator_state) generator"
   is "(rbt_has_next, rbt_keys_next)"
 by(rule terminates_rbt_keys_generator)
 
 definition rbt_init :: "('a, 'b) rbt \<Rightarrow> ('a, 'b, 'c) rbt_generator_state"
 where "rbt_init = Pair []"
 
 lemma has_next_rbt_keys_generator [simp]:
   "list.has_next rbt_keys_generator = rbt_has_next"
 by transfer simp
 
 lemma next_rbt_keys_generator [simp]:
   "list.next rbt_keys_generator = rbt_keys_next"
 by transfer simp
 
 lemma unfoldr_rbt_keys_generator_aux:
   "list.unfoldr rbt_keys_generator (kts, t) = 
   RBT_Impl.keys t @ concat (map (\<lambda>(k, t). k # RBT_Impl.keys t) kts)"
 proof(induct "(kts, t)" arbitrary: kts t taking: "\<lambda>k _. k" rule: rbt_generator_induct)
   case empty thus ?case
     by(simp add: list.unfoldr.simps)
 next
   case split thus ?case
     by(subst list.unfoldr.simps) simp
 next
   case shuffle thus ?case
     by(subst list.unfoldr.simps)(subst (asm) list.unfoldr.simps, simp)
 qed
 
 corollary unfoldr_rbt_keys_generator:
   "list.unfoldr rbt_keys_generator (rbt_init t) = RBT_Impl.keys t"
 by(simp add: unfoldr_rbt_keys_generator_aux rbt_init_def)
 
 fun rbt_entries_next :: 
   "('a, 'b, 'a \<times> 'b) rbt_generator_state \<Rightarrow> ('a \<times> 'b) \<times> ('a, 'b, 'a \<times> 'b) rbt_generator_state"
 where
   "rbt_entries_next ((kv, t) # kts, rbt.Empty) = (kv, kts, t)"
 | "rbt_entries_next (kts, rbt.Branch c l k v r) = rbt_entries_next (((k, v), r) # kts, l)"
 
 lemma terminates_rbt_entries_generator:
   "terminates (rbt_has_next, rbt_entries_next)"
 proof(rule terminatesI)
   fix ktst :: "('a, 'b, 'a \<times> 'b) rbt_generator_state"
   show "ktst \<in> terminates_on (rbt_has_next, rbt_entries_next)"
     by(induct ktst taking: Pair rule: rbt_generator_induct)(auto 4 3 intro: terminates_on.intros elim: terminates_on.cases)
 qed
 
 lift_definition rbt_entries_generator :: "('a \<times> 'b, ('a, 'b, 'a \<times> 'b) rbt_generator_state) generator"
   is "(rbt_has_next, rbt_entries_next)"
 by(rule terminates_rbt_entries_generator)
 
 lemma has_next_rbt_entries_generator [simp]:
   "list.has_next rbt_entries_generator = rbt_has_next"
 by transfer simp
 
 lemma next_rbt_entries_generator [simp]:
   "list.next rbt_entries_generator = rbt_entries_next"
 by transfer simp
 
 lemma unfoldr_rbt_entries_generator_aux:
   "list.unfoldr rbt_entries_generator (kts, t) = 
   RBT_Impl.entries t @ concat (map (\<lambda>(k, t). k # RBT_Impl.entries t) kts)"
 proof(induct "(kts, t)" arbitrary: kts t taking: Pair rule: rbt_generator_induct)
   case empty thus ?case
     by(simp add: list.unfoldr.simps)
 next
   case split thus ?case
     by(subst list.unfoldr.simps) simp
 next
   case shuffle thus ?case
     by(subst list.unfoldr.simps)(subst (asm) list.unfoldr.simps, simp)
 qed
 
 corollary unfoldr_rbt_entries_generator:
   "list.unfoldr rbt_entries_generator (rbt_init t) = RBT_Impl.entries t"
 by(simp add: unfoldr_rbt_entries_generator_aux rbt_init_def)
 
 end
diff --git a/thys/CoreC++/Determinism.thy b/thys/CoreC++/Determinism.thy
--- a/thys/CoreC++/Determinism.thy
+++ b/thys/CoreC++/Determinism.thy
@@ -1,2115 +1,2115 @@
 (*  Title:       CoreC++
     Author:      Daniel Wasserrab
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 *)
 
 section \<open>Determinism Proof\<close>
 
 theory Determinism
 imports TypeSafe
 begin
 
 subsection\<open>Some lemmas\<close>
 
 lemma maps_nth:
   "\<lbrakk>(E(xs [\<mapsto>] ys)) x = Some y; length xs = length ys; distinct xs\<rbrakk> 
   \<Longrightarrow> \<forall>i. x = xs!i \<and> i < length xs \<longrightarrow> y = ys!i"
 proof (induct xs arbitrary: ys E)
   case Nil thus ?case by simp
 next
   case (Cons x' xs')
   have map:"(E(x' # xs' [\<mapsto>] ys)) x = Some y"
     and length:"length (x'#xs') = length ys"
     and dist:"distinct (x'#xs')"
     and IH:"\<And>ys E. \<lbrakk>(E(xs' [\<mapsto>] ys)) x = Some y; length xs' = length ys; 
                      distinct xs'\<rbrakk> 
          \<Longrightarrow> \<forall>i. x = xs'!i \<and> i < length xs' \<longrightarrow> y = ys!i" by fact+
   from length obtain y' ys' where ys:"ys = y'#ys'" by(cases ys) auto
   { fix i assume x:"x = (x'#xs')!i" and i:"i < length(x'#xs')"
     have "y = ys!i"
     proof(cases i)
       case 0 with x map ys dist show ?thesis by simp
     next
       case (Suc n)
       with x i have x':"x = xs'!n" and n:"n < length xs'" by simp_all
-      from map ys have map':"(E(x' \<mapsto> y')(xs' [\<mapsto>] ys')) x = Some y" by simp
+      from map ys have map':"(E(x' \<mapsto> y', xs' [\<mapsto>] ys')) x = Some y" by simp
       from length ys have length':"length xs' = length ys'" by simp
       from dist have dist':"distinct xs'" by simp
       from IH[OF map' length' dist'] 
       have "\<forall>i. x = xs'!i \<and> i < length xs' \<longrightarrow> y = ys'!i" .
       with x' n have "y = ys'!n" by simp
       with ys n Suc show ?thesis by simp
     qed }
   thus ?case by simp
 qed
 
 
 lemma nth_maps:"\<lbrakk>length pns = length Ts; distinct pns; i < length Ts\<rbrakk> 
   \<Longrightarrow> (E(pns [\<mapsto>] Ts)) (pns!i) = Some (Ts!i)"
 proof (induct i arbitrary: E pns Ts)
   case 0
   have dist:"distinct pns" and length:"length pns = length Ts"
     and i_length:"0 < length Ts" by fact+
   from i_length obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
   with length obtain p' pns' where "pns = p'#pns'" by(cases pns) auto
   with Ts dist show ?case by simp
 next
   case (Suc n)
   have i_length:"Suc n < length Ts" and dist:"distinct pns"
     and length:"length pns = length Ts" by fact+
   from Suc obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
   with length obtain p' pns' where pns:"pns = p'#pns'" by(cases pns) auto
   with Ts length dist have length':"length pns' = length Ts'" 
     and dist':"distinct pns'" and notin:"p' \<notin> set pns'" by simp_all
   from i_length Ts have n_length:"n < length Ts'" by simp
-  with length' dist' have map:"(E(p' \<mapsto> T')(pns' [\<mapsto>] Ts')) (pns'!n) = Some(Ts'!n)" by fact
-  with notin have "(E(p' \<mapsto> T')(pns' [\<mapsto>] Ts')) p' = Some T'" by simp
+  with length' dist' have map:"(E(p' \<mapsto> T', pns' [\<mapsto>] Ts')) (pns'!n) = Some(Ts'!n)" by fact
+  with notin have "(E(p' \<mapsto> T', pns' [\<mapsto>] Ts')) p' = Some T'" by simp
   with pns Ts map show ?case by simp
 qed
 
 lemma casts_casts_eq_result:
   fixes s :: state
   assumes casts:"P \<turnstile> T casts v to v'" and casts':"P \<turnstile> T casts v to w'" 
   and type:"is_type P T" and wte:"P,E \<turnstile> e :: T'" and leq:"P \<turnstile> T' \<le> T"
   and eval:"P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>Val v,(h,l)\<rangle>" and sconf:"P,E \<turnstile> s \<surd>"
   and wf:"wf_C_prog P"
   shows "v' = w'"
 proof(cases "\<forall>C. T \<noteq> Class C")
   case True
   with casts casts' show ?thesis
     by(auto elim:casts_to.cases)
 next
   case False
   then obtain C where T:"T = Class C" by auto
   with type have "is_class P C" by simp
   with wf T leq have "T' = NT \<or> (\<exists>D. T' = Class D \<and> P \<turnstile> Path D to C unique)"
     by(simp add:widen_Class)
   thus ?thesis
   proof(rule disjE)
     assume "T' = NT"
     with wf eval sconf wte have "v = Null"
       by(fastforce dest:eval_preserves_type)
     with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
   next
     assume "\<exists>D. T' = Class D \<and> P \<turnstile> Path D to C unique"
     then obtain D where T':"T' = Class D" 
       and path_unique:"P \<turnstile> Path D to C unique" by auto
     with wf eval sconf wte
     have "P,E,h \<turnstile> Val v : T' \<or> P,E,h \<turnstile> Val v : NT"
       by(fastforce dest:eval_preserves_type)
     thus ?thesis
     proof(rule disjE)
       assume "P,E,h \<turnstile> Val v : T'"
       with T' obtain a Cs C' S where h:"h a = Some(C',S)" and v:"v = Ref(a,Cs)"
         and last:"last Cs = D"
         by(fastforce dest:typeof_Class_Subo)
       from casts' v last T obtain Cs' Ds where "P \<turnstile> Path D to C via Cs'"
         and "Ds = Cs@\<^sub>pCs'" and "w' = Ref(a,Ds)"
         by(auto elim:casts_to.cases)
       with casts T v last path_unique show ?thesis
         by auto(erule casts_to.cases,auto simp:path_via_def path_unique_def)
     next
       assume "P,E,h \<turnstile> Val v : NT"
       with wf eval sconf wte have "v = Null"
         by(fastforce dest:eval_preserves_type)
       with casts casts' show ?thesis by(fastforce elim:casts_to.cases)
     qed
   qed
 qed
 
 lemma Casts_Casts_eq_result:
   assumes wf:"wf_C_prog P"
   shows "\<lbrakk>P \<turnstile> Ts Casts vs to vs'; P \<turnstile> Ts Casts vs to ws'; \<forall>T \<in> set Ts. is_type P T;
           P,E \<turnstile> es [::] Ts'; P \<turnstile> Ts' [\<le>] Ts; P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h,l)\<rangle>;
           P,E \<turnstile> s \<surd>\<rbrakk>
       \<Longrightarrow> vs' = ws'"
 proof (induct vs arbitrary: vs' ws' Ts Ts' es s)
   case Nil thus ?case by (auto elim!:Casts_to.cases)
 next
   case (Cons x xs)
   have CastsCons:"P \<turnstile> Ts Casts x # xs to vs'" 
     and CastsCons':"P \<turnstile> Ts Casts x # xs to ws'"
     and type:"\<forall>T \<in> set Ts. is_type P T" 
     and wtes:"P,E \<turnstile> es [::] Ts'" and subs:"P \<turnstile> Ts' [\<le>] Ts"
     and evals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val (x#xs),(h,l)\<rangle>"
     and sconf:"P,E \<turnstile> s \<surd>"
     and IH:"\<And>vs' ws' Ts Ts' es s. 
     \<lbrakk>P \<turnstile> Ts Casts xs to vs'; P \<turnstile> Ts Casts xs to ws'; \<forall>T \<in> set Ts. is_type P T; 
      P,E \<turnstile> es [::] Ts'; P \<turnstile> Ts' [\<le>] Ts; P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val xs,(h,l)\<rangle>;
      P,E \<turnstile> s \<surd>\<rbrakk> 
      \<Longrightarrow> vs' = ws'" by fact+
   from CastsCons obtain y ys S Ss where vs':"vs' = y#ys" and Ts:"Ts = S#Ss"
     apply -
     apply(frule length_Casts_vs,cases Ts,auto)
     apply(frule length_Casts_vs',cases vs',auto)
     done
   with CastsCons have casts:"P \<turnstile> S casts x to y" and Casts:"P \<turnstile> Ss Casts xs to ys"
     by(auto elim:Casts_to.cases)
   from Ts type have type':"is_type P S" and types':"\<forall>T \<in> set Ss. is_type P T"
     by auto
   from Ts CastsCons' obtain z zs where ws':"ws' = z#zs"
     by simp(frule length_Casts_vs',cases ws',auto)
   with Ts CastsCons' have casts':"P \<turnstile> S casts x to z" 
     and Casts':"P \<turnstile> Ss Casts xs to zs"
     by(auto elim:Casts_to.cases)
   from Ts subs obtain U Us where Ts':"Ts' = U#Us" and subs':"P \<turnstile> Us [\<le>] Ss"
     and sub:"P \<turnstile> U \<le> S" by(cases Ts',auto simp:fun_of_def)
   from wtes Ts' obtain e' es' where es:"es = e'#es'" and wte':"P,E \<turnstile> e' :: U"
     and wtes':"P,E \<turnstile> es' [::] Us" by(cases es) auto
   with evals obtain h' l' where eval:"P,E \<turnstile> \<langle>e',s\<rangle> \<Rightarrow> \<langle>Val x,(h',l')\<rangle>"
     and evals':"P,E \<turnstile> \<langle>es',(h',l')\<rangle> [\<Rightarrow>] \<langle>map Val xs,(h,l)\<rangle>"
     by (auto elim:evals.cases)
   from wf eval wte' sconf have "P,E \<turnstile> (h',l') \<surd>" by(rule eval_preserves_sconf)
   from IH[OF Casts Casts' types' wtes' subs' evals' this] have eq:"ys = zs" .
   from casts casts' type' wte' sub eval sconf wf have "y = z"
     by(rule casts_casts_eq_result)
   with eq vs' ws' show ?case by simp
 qed
 
 
 
 lemma Casts_conf: assumes wf: "wf_C_prog P"
   shows "P \<turnstile> Ts Casts vs to vs' \<Longrightarrow> 
   (\<And>es s Ts'. \<lbrakk> P,E \<turnstile> es [::] Ts'; P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h,l)\<rangle>; P,E \<turnstile> s \<surd>;
              P \<turnstile> Ts' [\<le>] Ts\<rbrakk> \<Longrightarrow> 
      \<forall>i < length Ts. P,h \<turnstile> vs'!i :\<le> Ts!i)"
 proof(induct rule:Casts_to.induct)
   case Casts_Nil thus ?case by simp
 next
   case (Casts_Cons T v v' Ts vs vs')
   have casts:"P \<turnstile> T casts v to v'" and wtes:"P,E \<turnstile> es [::] Ts'" 
     and evals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val (v#vs),(h,l)\<rangle>"
     and subs:"P \<turnstile> Ts' [\<le>] (T#Ts)" and sconf:"P,E \<turnstile> s \<surd>"
     and IH:"\<And>es s Ts'.\<lbrakk>P,E \<turnstile> es [::] Ts'; P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h,l)\<rangle>; 
                    P,E \<turnstile> s \<surd>; P \<turnstile> Ts' [\<le>] Ts\<rbrakk>
                \<Longrightarrow> \<forall>i<length Ts. P,h \<turnstile> vs' ! i :\<le> Ts ! i" by fact+
   from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
   with subs have sub':"P \<turnstile> U \<le> T" and subs':"P \<turnstile> Us [\<le>] Ts" 
     by (simp_all add:fun_of_def)
   from wtes Ts' obtain e' es' where es:"es = e'#es'" by(cases es) auto
   with Ts' wtes have wte':"P,E \<turnstile> e' :: U" and wtes':"P,E \<turnstile> es' [::] Us" by auto
   from es evals obtain s' where eval':"P,E \<turnstile> \<langle>e',s\<rangle> \<Rightarrow> \<langle>Val v,s'\<rangle>"
     and evals':"P,E \<turnstile> \<langle>es',s'\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h,l)\<rangle>" 
     by(auto elim:evals.cases)
   from wf eval' wte' sconf have sconf':"P,E \<turnstile> s' \<surd>" by(rule eval_preserves_sconf)
   from evals' have hext:"hp s' \<unlhd> h" by(cases s',auto intro:evals_hext)
   from wf eval' sconf wte' have "P,E,(hp s') \<turnstile> Val v :\<^bsub>NT\<^esub> U"
     by(rule eval_preserves_type)
   with hext have wtrt:"P,E,h \<turnstile> Val v :\<^bsub>NT\<^esub> U"
     by(cases U,auto intro:hext_typeof_mono)
   from casts wtrt sub' have "P,h \<turnstile> v' :\<le> T"
   proof(induct rule:casts_to.induct)
     case (casts_prim T'' v'')
     have "\<forall>C. T'' \<noteq> Class C" and "P,E,h \<turnstile> Val v'' :\<^bsub>NT\<^esub> U" and "P \<turnstile> U \<le> T''" by fact+
     thus ?case by(cases T'') auto
   next
     case (casts_null C) thus ?case by simp
   next
     case (casts_ref Cs C Cs' Ds a)
     have path:"P \<turnstile> Path last Cs to C via Cs'"
       and Ds:"Ds = Cs @\<^sub>p Cs'"
       and wtref:"P,E,h \<turnstile> ref (a, Cs) :\<^bsub>NT\<^esub> U" by fact+
     from wtref obtain D S where subo:"Subobjs P D Cs" and h:"h a = Some(D,S)"
       by(cases U,auto split:if_split_asm)
     from path Ds have last:"C = last Ds"  
       by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
     from subo path Ds wf have "Subobjs P D Ds"
       by(fastforce intro:Subobjs_appendPath simp:path_via_def)
     with last h show ?case by simp
   qed
   with IH[OF wtes' evals' sconf' subs'] show ?case
     by(auto simp:nth_Cons,case_tac i,auto)
 qed
 
 
 lemma map_Val_throw_False:"map Val vs = map Val ws @ throw ex # es \<Longrightarrow> False"
 proof (induct vs arbitrary: ws)
   case Nil thus ?case by simp
 next
   case (Cons v' vs')
   have eq:"map Val (v'#vs') = map Val ws @ throw ex # es"
     and IH:"\<And>ws'. map Val vs' = map Val ws' @ throw ex # es \<Longrightarrow> False" by fact+
   from eq obtain w' ws' where ws:"ws = w'#ws'" by(cases ws) auto
   from eq have "tl(map Val (v'#vs')) = tl(map Val ws @ throw ex # es)" by simp
   hence "map Val vs' = tl(map Val ws @ throw ex # es)" by simp
   with ws have "map Val vs' = map Val ws' @ throw ex # es" by simp
   from IH[OF this] show ?case .
 qed
 
 lemma map_Val_throw_eq:"map Val vs @ throw ex # es = map Val ws @ throw ex' # es' 
   \<Longrightarrow> vs = ws \<and> ex = ex' \<and> es = es'"
   apply(clarsimp simp:append_eq_append_conv2)
   apply(erule disjE)
    apply(case_tac us)
     apply(fastforce elim:map_injective simp:inj_on_def)
    apply(fastforce dest:map_Val_throw_False)
   apply(case_tac us)
    apply(fastforce elim:map_injective simp:inj_on_def)
   apply(fastforce dest:sym[THEN map_Val_throw_False])
   done
 
 
 subsection \<open>The proof\<close>
 
 lemma deterministic_big_step:
 assumes wf:"wf_C_prog P"
 shows "P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Longrightarrow> 
        (\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s \<surd>\<rbrakk> 
        \<Longrightarrow> e\<^sub>1 = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2)"
   and "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es\<^sub>1,s\<^sub>1\<rangle> \<Longrightarrow> 
        (\<And>es\<^sub>2 s\<^sub>2 Ts. \<lbrakk>P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s \<surd>\<rbrakk> 
         \<Longrightarrow> es\<^sub>1 = es\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2)"
 proof (induct rule:eval_evals.inducts)
   case New thus ?case by(auto elim: eval_cases)
 next
   case NewFail thus ?case by(auto elim: eval_cases)
 next
   case (StaticUpCast E e s\<^sub>0 a Cs s\<^sub>1 C Cs' Ds e\<^sub>2 s\<^sub>2)
   have eval:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and path_via:"P \<turnstile> Path last Cs to C via Cs'" and Ds:"Ds = Cs @\<^sub>p Cs'" 
     and wt:"P,E \<turnstile> \<lparr>C\<rparr>e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
             \<Longrightarrow> ref (a,Cs) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where "class":"is_class P C" and wte:"P,E \<turnstile> e :: Class D"
     and disj:"P \<turnstile> Path D to C unique \<or> 
               (P \<turnstile> C \<preceq>\<^sup>* D \<and> (\<forall>Cs. P \<turnstile> Path C to D via Cs \<longrightarrow> Subobjs\<^sub>R P C Cs))"
     by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
       and path_via':"P \<turnstile> Path last Xs to C via Xs'"
       and ref:"e\<^sub>2 = ref (a',Xs@\<^sub>pXs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte have last:"last Cs = D"
       by(auto dest:eval_preserves_type split:if_split_asm)
     from disj show "ref (a,Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2"
     proof (rule disjE)
       assume "P \<turnstile> Path D to C unique"
       with path_via path_via' eq last have "Cs' = Xs'"
         by(fastforce simp add:path_via_def path_unique_def)
       with eq ref Ds show ?thesis by simp
     next
       assume "P \<turnstile> C \<preceq>\<^sup>* D \<and> (\<forall>Cs. P \<turnstile> Path C to D via Cs  \<longrightarrow> Subobjs\<^sub>R P C Cs)"
       with "class" wf obtain Cs'' where "P \<turnstile> Path C to D via Cs''"
         by(auto dest:leq_implies_path)
       with path_via path_via' wf eq last have "Cs' = Xs'"
         by(auto dest:path_via_reverse)
       with eq ref Ds show ?thesis by simp
     qed
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
       and ref:"e\<^sub>2 = ref (a',Xs@[C])"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs@C#Xs' \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence subo:"Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
     with eq last have leq:"P \<turnstile> C \<preceq>\<^sup>* D" by(fastforce dest:Subobjs_subclass)
     from path_via last have "P \<turnstile> D \<preceq>\<^sup>* C"
       by(auto dest:Subobjs_subclass simp:path_via_def)
     with leq wf have CeqD:"C = D" by(rule subcls_asym2)
     with last path_via wf have "Cs' = [D]" by(fastforce intro:path_via_C)
     with Ds last have Ds':"Ds = Cs" by(simp add:appendPath_def)
     from subo CeqD last eq wf have "Xs' = []" by(auto dest:mdc_eq_last)
     with eq Ds' ref show "ref (a,Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "ref (a,Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>" and notin:"C \<notin> set Xs"
       and notleq:"\<not> P \<turnstile> last Xs \<preceq>\<^sup>* C" and throw:"e\<^sub>2 = THROW ClassCast"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte have last:"last Cs = D" and notempty:"Cs \<noteq> []"
       by(auto dest!:eval_preserves_type Subobjs_nonempty split:if_split_asm)
     from disj have "C = D"
     proof(rule disjE)
       assume path_unique:"P \<turnstile> Path D to C unique"
       with last have "P \<turnstile> D \<preceq>\<^sup>* C" 
         by(fastforce dest:Subobjs_subclass simp:path_unique_def)
       with notleq last eq show ?thesis by simp
     next
       assume ass:"P \<turnstile> C \<preceq>\<^sup>* D \<and> 
                   (\<forall>Cs. P \<turnstile> Path C to D via Cs  \<longrightarrow> Subobjs\<^sub>R P C Cs)"
       with "class" wf obtain Cs'' where path_via':"P \<turnstile> Path C to D via Cs''"
         by(auto dest:leq_implies_path)
       with path_via wf eq last have "Cs'' = [D]"
         by(fastforce dest:path_via_reverse)
       with ass path_via' have "Subobjs\<^sub>R P C [D]" by simp
       thus ?thesis by(fastforce dest:hd_SubobjsR)
     qed
     with last notin eq notempty show "ref (a,Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2"
       by(fastforce intro:last_in_set)
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "ref (a,Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (StaticDownCast E e s\<^sub>0 a Cs C Cs' s\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>" 
     and eval':"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a,Cs@[C]@Cs'),s\<^sub>1\<rangle>"
     and wt:"P,E \<turnstile> \<lparr>C\<rparr>e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                       \<Longrightarrow> ref(a,Cs@[C]@Cs') = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D"
     and disj:"P \<turnstile> Path D to C unique \<or> 
               (P \<turnstile> C \<preceq>\<^sup>* D \<and> (\<forall>Cs. P \<turnstile> Path C to D via Cs \<longrightarrow> Subobjs\<^sub>R P C Cs))"
     by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>" 
       and path_via:"P \<turnstile> Path last Xs to C via Xs'"
       and ref:"e\<^sub>2 = ref (a',Xs@\<^sub>pXs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs@[C]@Cs' = Xs \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence "P \<turnstile> Path C to D via C#Cs'" 
       by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
     with eq last path_via wf have "Xs' = [C] \<and> Cs' = [] \<and> C = D"
       apply clarsimp
       apply(split if_split_asm)
       by(simp,drule path_via_reverse,simp,simp)+
     with ref eq show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by(fastforce simp:appendPath_def)
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
       and ref:"e\<^sub>2 = ref (a',Xs@[C])"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs@[C]@Cs' = Xs@C#Xs' \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     from subo wf have notin:"C \<notin> set Cs" by -(rule unique2,simp)
     from subo wf have "C \<notin> set Cs'"  by -(rule unique1,simp,simp)
     with notin eq have "Cs = Xs \<and> Cs' = Xs'"
       by -(rule only_one_append,simp+)
     with eq ref show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs a' 
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>" and notin:"C \<notin> set Xs"
     from IH[OF eval_ref wte sconf] have "a = a' \<and> Cs@[C]@Cs' = Xs \<and> s\<^sub>1 = s\<^sub>2" 
       by simp
     with notin show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fastforce
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (StaticCastNull E e s\<^sub>0 s\<^sub>1 C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> \<lparr>C\<rparr>e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>" and "e\<^sub>2 = null"
     with IH[OF eval_null wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs a' 
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (StaticCastFail E e s\<^sub>0 a Cs s\<^sub>1 C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and notleq:"\<not> P \<turnstile> last Cs \<preceq>\<^sup>* C" and notin:"C \<notin> set Cs"
     and wt:"P,E \<turnstile> \<lparr>C\<rparr>e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow>ref (a, Cs) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
       and path_via:"P \<turnstile> Path last Xs to C via Xs'"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with path_via wf have "P \<turnstile> last Cs \<preceq>\<^sup>* C" 
       by(auto dest:Subobjs_subclass simp:path_via_def)
     with notleq show "THROW ClassCast = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] have "a = a' \<and> Cs = Xs@C#Xs' \<and> s\<^sub>1 = s\<^sub>2" by simp
     with notin show "THROW ClassCast = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "THROW ClassCast = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs a' 
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>"
       and throw:"e\<^sub>2 = THROW ClassCast"
     from IH[OF eval_ref wte sconf] have "a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with throw show "THROW ClassCast = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "THROW ClassCast = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed 
 next
   case (StaticCastThrow E e s\<^sub>0 e' s\<^sub>1 C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> \<lparr>C\<rparr>e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                    \<Longrightarrow> throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
     from IH[OF eval_ref wte sconf] show " throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e'' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e'',s\<^sub>2\<rangle>"
       and throw:"e\<^sub>2 = throw e''"
     from IH[OF eval_throw wte sconf] throw show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (StaticUpDynCast E e s\<^sub>0 a Cs s\<^sub>1 C Cs' Ds e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and path_via:"P \<turnstile> Path last Cs to C via Cs'" 
     and path_unique:"P \<turnstile> Path last Cs to C unique"
     and Ds:"Ds = Cs@\<^sub>pCs'" and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> ref(a,Cs) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
       and path_via':"P \<turnstile> Path last Xs to C via Xs'"
       and ref:"e\<^sub>2 = ref (a',Xs@\<^sub>pXs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte have last:"last Cs = D"
       by(auto dest:eval_preserves_type split:if_split_asm)
     with path_unique path_via path_via' eq have "Xs' = Cs'"
       by(fastforce simp:path_via_def path_unique_def)
     with eq Ds ref show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
       and ref:"e\<^sub>2 = ref (a',Xs@[C])"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs@C#Xs' \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last Cs = D" and "Subobjs P C' (Xs@C#Xs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence "Subobjs P C (C#Xs')" by(fastforce intro:Subobjs_Subobjs)
     with last eq have "P \<turnstile> Path C to D via C#Xs'" 
       by(simp add:path_via_def)
     with path_via wf last have "Xs' = [] \<and> Cs' = [C] \<and> C = D" 
       by(fastforce dest:path_via_reverse)
     with eq Ds ref show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by (simp add:appendPath_def)
   next
     fix Xs Xs' D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>"
       and h:"h a' = Some(D',S)" and path_via':"P \<turnstile> Path D' to C via Xs'"
       and path_unique':"P \<turnstile> Path D' to C unique" and s2:"s\<^sub>2 = (h,l)"
       and ref:"e\<^sub>2 = ref(a',Xs')"
     from IH[OF eval_ref wte sconf] s2 have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with wf eval_ref sconf wte h have "last Cs = D"
       and "Subobjs P D' Cs"
       by(auto dest:eval_preserves_type split:if_split_asm)
     with path_via wf have "P \<turnstile> Path D' to C via Cs@\<^sub>pCs'"
       by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym] 
                    dest:Subobjs_nonempty simp:path_via_def)
     with path_via' path_unique' Ds have "Xs' = Ds"
       by(fastforce simp:path_via_def path_unique_def)
     with eq ref show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>"
       and not_unique:"\<not> P \<turnstile> Path last Xs to C unique" and s2:"s\<^sub>2 = (h,l)"
     from IH[OF eval_ref wte sconf] s2 have eq:"a = a' \<and> Cs = Xs \<and> s\<^sub>1 = s\<^sub>2" by simp
     with path_unique not_unique show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "ref (a, Ds) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (StaticDownDynCast E e s\<^sub>0 a Cs C Cs' s\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> ref(a,Cs@[C]@Cs') = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>" 
       and path_via:"P \<turnstile> Path last Xs to C via Xs'"
       and ref:"e\<^sub>2 = ref (a',Xs@\<^sub>pXs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs@[C]@Cs' = Xs \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last(C#Cs') = D" and "Subobjs P C' (Cs@[C]@Cs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence "P \<turnstile> Path C to D via C#Cs'" 
       by(fastforce intro:Subobjs_Subobjs simp:path_via_def)
     with eq last path_via wf have "Xs' = [C] \<and> Cs' = [] \<and> C = D"
       apply clarsimp
       apply(split if_split_asm)
       by(simp,drule path_via_reverse,simp,simp)+
     with ref eq show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by(fastforce simp:appendPath_def)
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
       and ref:"e\<^sub>2 = ref (a',Xs@[C])"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs@[C]@Cs' = Xs@C#Xs' \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte obtain C' where 
       last:"last(C#Xs') = D" and subo:"Subobjs P C' (Cs@[C]@Cs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     from subo wf have notin:"C \<notin> set Cs" by -(rule unique2,simp)
     from subo wf have "C \<notin> set Cs'"  by -(rule unique1,simp,simp)
     with notin eq have "Cs = Xs \<and> Cs' = Xs'"
       by -(rule only_one_append,simp+)
     with eq ref show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>"
       and h:"h a' = Some(D',S)" and path_via:"P \<turnstile> Path D' to C via Xs'"
       and path_unique:"P \<turnstile> Path D' to C unique" and s2:"s\<^sub>2 = (h,l)"
       and ref:"e\<^sub>2 = ref(a',Xs')"
     from IH[OF eval_ref wte sconf] s2 have eq:"a = a' \<and> Cs@[C]@Cs' = Xs \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte h have "Subobjs P D' (Cs@[C]@Cs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence "Subobjs P D' (Cs@[C])" by(fastforce intro:appendSubobj)
     with path_via path_unique have "Xs' = Cs@[C]" 
       by(fastforce simp:path_via_def path_unique_def)
     with eq ref show "ref(a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "ref (a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>"
       and notin:"C \<notin> set Xs" and s2:"s\<^sub>2 = (h,l)"
     from IH[OF eval_ref wte sconf] s2 have "a = a' \<and> Cs@[C]@Cs' = Xs \<and> s\<^sub>1 = s\<^sub>2"
       by simp
     with notin show "ref (a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fastforce
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "ref (a,Cs@[C]) = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (DynCast E e s\<^sub>0 a Cs h l D S C Cs' e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and path_via:"P \<turnstile> Path D to C via Cs'" and path_unique:"P \<turnstile> Path D to C unique"
     and h:"h a = Some(D,S)" and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> ref(a,Cs) = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by fact+
   from wt obtain D' where wte:"P,E \<turnstile> e :: Class D'" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>"
       and path_via':"P \<turnstile> Path last Xs to C via Xs'"
       and ref:"e\<^sub>2 = ref (a',Xs@\<^sub>pXs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> (h,l) = s\<^sub>2" by simp
     with wf eval_ref sconf wte h have "last Cs = D'"
       and "Subobjs P D Cs"
       by(auto dest:eval_preserves_type split:if_split_asm)
     with path_via' wf eq have "P \<turnstile> Path D to C via Xs@\<^sub>pXs'"
       by(fastforce intro:Subobjs_appendPath appendPath_last[THEN sym] 
                    dest:Subobjs_nonempty simp:path_via_def)
     with path_via path_unique have "Cs' = Xs@\<^sub>pXs'"
       by(fastforce simp:path_via_def path_unique_def)
     with ref eq show "ref(a,Cs') = e\<^sub>2 \<and> (h, l) = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
       and ref:"e\<^sub>2 = ref (a',Xs@[C])"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs@C#Xs' \<and> (h,l) = s\<^sub>2"
       by simp
     with wf eval_ref sconf wte h have "Subobjs P D (Xs@[C]@Xs')"
       by(auto dest:eval_preserves_type split:if_split_asm)
     hence "Subobjs P D (Xs@[C])" by(fastforce intro:appendSubobj)
     with path_via path_unique have "Cs' = Xs@[C]" 
       by(fastforce simp:path_via_def path_unique_def)
     with eq ref show "ref(a,Cs') = e\<^sub>2 \<and> (h, l) = s\<^sub>2" by simp
   next
     fix Xs Xs' D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
       and h':"h' a' = Some(D'',S')" and path_via':"P \<turnstile> Path D'' to C via Xs'"
       and s2:"s\<^sub>2 = (h',l')" and ref:"e\<^sub>2 = ref(a',Xs')"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> h = h' \<and> l = l'"
       by simp
     with h h' path_via path_via' path_unique s2 ref
     show "ref(a,Cs') = e\<^sub>2 \<and> (h,l) = s\<^sub>2"
       by(fastforce simp:path_via_def path_unique_def)
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "ref(a,Cs') = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix Xs D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
       and h':"h' a' = Some(D'',S')" and not_unique:"\<not> P \<turnstile> Path D'' to C unique"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> h = h' \<and> l = l'"
       by simp
     with h h' path_unique not_unique show "ref(a,Cs') = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "ref (a,Cs') = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   qed
 next
   case (DynCastNull E e s\<^sub>0 s\<^sub>1 C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>"
     from IH[OF eval_ref wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>" and "e\<^sub>2 = null"
     with IH[OF eval_null wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs D' S a' h l
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h,l)\<rangle>" and s2:"s\<^sub>2 = (h,l)"
     from IH[OF eval_ref wte sconf] s2 show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (DynCastFail E e s\<^sub>0 a Cs h l D S C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and h:"h a = Some(D,S)" and not_unique1:"\<not> P \<turnstile> Path D to C unique"
     and not_unique2:"\<not> P \<turnstile> Path last Cs to C unique" and notin:"C \<notin> set Cs"
     and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                    \<Longrightarrow> ref (a, Cs) = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by fact+
   from wt obtain D' where wte:"P,E \<turnstile> e :: Class D'" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<^sub>2\<rangle>"
       and path_unique:"P \<turnstile> Path last Xs to C unique"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs \<and> (h,l) = s\<^sub>2" by simp
     with path_unique not_unique2 show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] have eq:"a = a' \<and> Cs = Xs@C#Xs' \<and> (h,l) = s\<^sub>2"
       by simp
     with notin show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by fastforce
   next
     fix Xs Xs' D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
       and h':"h' a' = Some(D'',S')" and path_unique:"P \<turnstile> Path D'' to C unique"
     from IH[OF eval_ref wte sconf] have "a = a' \<and> Cs = Xs \<and> h = h' \<and> l = l'"
       by simp
     with h h' not_unique1 path_unique show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix Xs D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
       and null:"e\<^sub>2 = null" and s2:"s\<^sub>2 = (h',l')"
     from IH[OF eval_ref wte sconf] null s2 show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "null = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   qed
 next
   case (DynCastThrow E e s\<^sub>0 e' s\<^sub>1 C e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> Cast C e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                    \<Longrightarrow> throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain D where wte:"P,E \<turnstile> e :: Class D" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a',Xs),s\<^sub>2\<rangle>" 
     from IH[OF eval_ref wte sconf] show " throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' a'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs@C#Xs'),s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs Xs' D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix Xs D'' S' a' h' l'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),(h',l')\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e'' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e'',s\<^sub>2\<rangle>"
       and throw:"e\<^sub>2 = throw e''"
     from IH[OF eval_throw wte sconf] throw show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case Val thus ?case by(auto elim: eval_cases)
 next
   case (BinOp E e\<^sub>1 s\<^sub>0 v\<^sub>1 s\<^sub>1 e\<^sub>2 v\<^sub>2 s\<^sub>2 bop v e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and binop:"binop (bop, v\<^sub>1, v\<^sub>2) = Some v"
     and wt:"P,E \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> Val v\<^sub>1 = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                      \<Longrightarrow> Val v\<^sub>2 = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain T\<^sub>1 T\<^sub>2 where wte1:"P,E \<turnstile> e\<^sub>1 :: T\<^sub>1" and wte2:"P,E \<turnstile> e\<^sub>2 :: T\<^sub>2"
     by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s w w\<^sub>1 w\<^sub>2
     assume eval_val1:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w\<^sub>1,s\<rangle>"
       and eval_val2:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w\<^sub>2,s\<^sub>2'\<rangle>"
       and binop':"binop(bop,w\<^sub>1,w\<^sub>2) = Some w" and e2':"e\<^sub>2' = Val w"
     from IH1[OF eval_val1 wte1 sconf] have w1:"v\<^sub>1 = w\<^sub>1" and s:"s = s\<^sub>1" by simp_all
     with wf eval_val1 wte1 sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_val2[simplified s] wte2 this] have "v\<^sub>2 = w\<^sub>2" and s2:"s\<^sub>2 = s\<^sub>2'"
       by simp_all
     with w1 binop binop' have "w = v" by simp
     with e2' s2 show "Val v = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix e assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte1 sconf] show "Val v = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix e s w 
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       and eval_throw:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw e,s\<^sub>2'\<rangle>"
     from IH1[OF eval_val wte1 sconf] have s:"s = s\<^sub>1" by simp_all
     with wf eval_val wte1 sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_throw[simplified s] wte2 this] show "Val v = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   qed
 next
   case (BinOpThrow1 E e\<^sub>1 s\<^sub>0 e s\<^sub>1 bop e\<^sub>2 e\<^sub>2' s\<^sub>2 T)
    have eval:"P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2\<rangle>"
      and wt:"P,E \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
      and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> throw e = ei \<and> s\<^sub>1 = si" by fact+
    from wt obtain T\<^sub>1 T\<^sub>2 where wte1:"P,E \<turnstile> e\<^sub>1 :: T\<^sub>1" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s w w\<^sub>1 w\<^sub>2
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w\<^sub>1,s\<rangle>"
     from IH[OF eval_val wte1 sconf] show "throw e = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e' 
     assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>" and throw:"e\<^sub>2' = throw e'"
     from IH[OF eval_throw wte1 sconf] throw show "throw e = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix e s w 
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
     from IH[OF eval_val wte1 sconf] show "throw e = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (BinOpThrow2 E e\<^sub>1 s\<^sub>0 v\<^sub>1 s\<^sub>1 e\<^sub>2 e s\<^sub>2 bop e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> Val v\<^sub>1 = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain T\<^sub>1 T\<^sub>2 where wte1:"P,E \<turnstile> e\<^sub>1 :: T\<^sub>1" and wte2:"P,E \<turnstile> e\<^sub>2 :: T\<^sub>2"
     by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s w w\<^sub>1 w\<^sub>2
     assume eval_val1:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w\<^sub>1,s\<rangle>"
       and eval_val2:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w\<^sub>2,s\<^sub>2'\<rangle>"
     from IH1[OF eval_val1 wte1 sconf] have s:"s = s\<^sub>1" by simp_all
     with wf eval_val1 wte1 sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_val2[simplified s] wte2 this] show "throw e = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   next
     fix e' 
     assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte1 sconf] show "throw e = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix e' s w 
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       and eval_throw:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2'\<rangle>"
       and throw:"e\<^sub>2' = throw e'"
     from IH1[OF eval_val wte1 sconf] have s:"s = s\<^sub>1" by simp_all
     with wf eval_val wte1 sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_throw[simplified s] wte2 this] throw
     show "throw e = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   qed
 next
   case Var thus ?case by(auto elim: eval_cases)    
 next
   case (LAss E e s\<^sub>0 v h l V T v' l' e\<^sub>2 s\<^sub>2 T')
   have eval:"P,E \<turnstile> \<langle>V:=e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and env:"E V = Some T" and casts:"P \<turnstile> T casts v to v'" and l':"l' = l(V \<mapsto> v')"
     and wt:"P,E \<turnstile> V:=e :: T'" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> Val v = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by fact+
   from wt env obtain T'' where wte:"P,E \<turnstile> e :: T''" and leq:"P \<turnstile> T'' \<le> T" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix U h' l'' w w'
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,(h',l'')\<rangle>" and env':"E V = Some U"
       and casts':"P \<turnstile> U casts w to w'" and e2:"e\<^sub>2 = Val w'" 
       and s2:"s\<^sub>2 = (h',l''(V \<mapsto> w'))"
     from env env' have UeqT:"U = T" by simp
     from IH[OF eval_val wte sconf] have eq:"v = w \<and> h = h' \<and> l = l''" by simp
     from sconf env have "is_type P T"
       by(clarsimp simp:sconf_def envconf_def)
     with casts casts' eq UeqT wte leq eval_val sconf wf have "v' = w'"
       by(auto intro:casts_casts_eq_result)
     with e2 s2 l' eq show "Val v' = e\<^sub>2 \<and> (h, l') = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "Val v' = e\<^sub>2 \<and> (h, l') = s\<^sub>2" by simp
   qed
 next
   case (LAssThrow E e s\<^sub>0 e' s\<^sub>1 V e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>V:=e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> V:=e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain T'' where wte:"P,E \<turnstile> e :: T''" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix U h' l'' w w'
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,(h',l'')\<rangle>"
     from IH[OF eval_val wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
     from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (FAcc E e s\<^sub>0 a Cs' h l D S Ds Cs fs F v e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and eval':"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref (a, Cs'),(h,l)\<rangle>"
     and h:"h a = Some(D,S)" and Ds:"Ds = Cs'@\<^sub>pCs"
     and S:"(Ds,fs) \<in> S" and fs:"fs F = Some v"
     and wt:"P,E \<turnstile> e\<bullet>F{Cs} :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> ref (a, Cs') = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval_preserves_sconf[OF wf eval' wte sconf] h have oconf:"P,h \<turnstile> (D,S) \<surd>"
     by(simp add:sconf_def hconf_def)
   from eval show ?case
   proof(rule eval_cases)
     fix Xs' D' S' a' fs' h' l' v'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs'),(h',l')\<rangle>"
     and h':"h' a' = Some(D',S')" and S':"(Xs'@\<^sub>pCs,fs') \<in> S'"
     and fs':"fs' F = Some v'" and e2:"e\<^sub>2 = Val v'" and s2:"s\<^sub>2 = (h',l')"
     from IH[OF eval_ref wte sconf] h h'
     have eq:"a = a' \<and> Cs' = Xs' \<and> h = h' \<and> l = l' \<and> D = D' \<and> S = S'" by simp
     with oconf S S' Ds have "fs = fs'" by (auto simp:oconf_def)
     with fs fs' have "v = v'" by simp
     with e2 s2 eq show "Val v = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "Val v = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "Val v = e\<^sub>2 \<and> (h,l) = s\<^sub>2" by simp
   qed
 next
   case (FAccNull E e s\<^sub>0 s\<^sub>1 F Cs e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> e\<bullet>F{Cs} :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> null = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs' D' S' a' fs' h' l' v'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs'),(h',l')\<rangle>"
     from IH[OF eval_ref wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = THROW NullPointer"
     from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" 
       by simp
   next
     fix e' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw e',s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (FAccThrow E e s\<^sub>0 e' s\<^sub>1 F Cs e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> e\<bullet>F{Cs} :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs' D' S' a' fs' h' l' v'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs'),(h',l')\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
     from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (FAss E e\<^sub>1 s\<^sub>0 a Cs' s\<^sub>1 e\<^sub>2 v h\<^sub>2 l\<^sub>2 D S F T Cs v' Ds fs fs' S' h\<^sub>2' e\<^sub>2' s\<^sub>2 T')
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2\<rangle>"
     and eval':"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a,Cs'),s\<^sub>1\<rangle>"
     and eval'':"P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2,l\<^sub>2)\<rangle>"
     and h2:"h\<^sub>2 a = Some(D, S)"
     and has_least:"P \<turnstile> last Cs' has least F:T via Cs"
     and casts:"P \<turnstile> T casts v to v'" and Ds:"Ds = Cs'@\<^sub>pCs"
     and S:"(Ds, fs) \<in> S" and fs':"fs' = fs(F \<mapsto> v')"
     and S':"S' = S - {(Ds, fs)} \<union> {(Ds, fs')}"
     and h2':"h\<^sub>2' = h\<^sub>2(a \<mapsto> (D, S'))"
     and wt:"P,E \<turnstile> e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 :: T'" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> ref(a,Cs') = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> Val v = ei \<and> (h\<^sub>2,l\<^sub>2) = si" by fact+
   from wt obtain C T'' where wte1:"P,E \<turnstile> e\<^sub>1 :: Class C" 
     and has_least':"P \<turnstile> C has least F:T' via Cs"
     and wte2:"P,E \<turnstile> e\<^sub>2 :: T''" and leq:"P \<turnstile> T'' \<le> T'"
     by auto
   from wf eval' wte1 sconf have "last Cs' = C"
     by(auto dest!:eval_preserves_type split:if_split_asm)
   with has_least has_least' have TeqT':"T = T'" by (fastforce intro:sees_field_fun)
   from eval show ?case
   proof(rule eval_cases)
     fix Xs D' S'' U a' fs'' h l s w w'
     assume eval_ref:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       and eval_val:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w,(h,l)\<rangle>"
       and h:"h a' = Some(D',S'')"
       and has_least'':"P \<turnstile> last Xs has least F:U via Cs"
       and casts':"P \<turnstile> U casts w to w'"
       and S'':"(Xs@\<^sub>pCs,fs'') \<in> S''" and e2':"e\<^sub>2' = Val w'"
       and s2:"s\<^sub>2 = (h(a'\<mapsto>(D',insert (Xs@\<^sub>pCs,fs''(F \<mapsto> w')) 
                                      (S''-{(Xs@\<^sub>pCs,fs'')}))),l)"
     from IH1[OF eval_ref wte1 sconf] have eq:"a = a' \<and> Cs' = Xs \<and> s\<^sub>1 = s" by simp
     with wf eval_ref wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF _ wte2 this] eval_val eq have eq':"v = w \<and> h = h\<^sub>2 \<and> l = l\<^sub>2" by auto
     from has_least'' eq has_least have UeqT:"U = T" by (fastforce intro:sees_field_fun)
     from has_least wf have "is_type P T" by(rule least_field_is_type)
     with casts casts' eq eq' UeqT TeqT' wte2 leq eval_val sconf' wf have v':"v' = w'"
       by(auto intro!:casts_casts_eq_result)
     from eval_preserves_sconf[OF wf eval'' wte2 sconf'] h2
     have oconf:"P,h\<^sub>2 \<turnstile> (D,S) \<surd>"
       by(simp add:sconf_def hconf_def)
     from eq eq' h2 h have "S = S''" by simp
     with oconf eq S S' S'' Ds have "fs = fs''" by (auto simp:oconf_def)
     with h2' h h2 eq eq' s2 S' Ds fs' v' e2' show "Val v' = e\<^sub>2' \<and> (h\<^sub>2',l\<^sub>2) = s\<^sub>2"
       by simp
   next
     fix s w assume eval_null:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
     from IH1[OF eval_null wte1 sconf] show "Val v' = e\<^sub>2' \<and> (h\<^sub>2',l\<^sub>2) = s\<^sub>2" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
     from IH1[OF eval_throw wte1 sconf] show "Val v' = e\<^sub>2' \<and> (h\<^sub>2',l\<^sub>2) = s\<^sub>2" by simp
   next
     fix ex s w
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
       and eval_throw:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
     from IH1[OF eval_val wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_throw[simplified eq] wte2 this]
     show "Val v' = e\<^sub>2' \<and> (h\<^sub>2',l\<^sub>2) = s\<^sub>2" by simp
   qed
 next
   case (FAssNull E e\<^sub>1 s\<^sub>0 s\<^sub>1 e\<^sub>2 v s\<^sub>2 F Cs e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> null = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> Val v = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain C T'' where wte1:"P,E \<turnstile> e\<^sub>1 :: Class C" 
     and wte2:"P,E \<turnstile> e\<^sub>2 :: T''" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs D' S'' U a' fs'' h l s w w'
     assume eval_ref:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
     from IH1[OF eval_ref wte1 sconf] show "THROW NullPointer = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   next
     fix s w 
     assume eval_null:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
       and eval_val:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w,s\<^sub>2'\<rangle>"
       and e2':"e\<^sub>2' = THROW NullPointer"
     from IH1[OF eval_null wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_null wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_val[simplified eq] wte2 this] e2'
     show "THROW NullPointer = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte1 sconf] show "THROW NullPointer = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" 
       by simp
   next
     fix ex s w
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       and eval_throw:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_val wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_throw[simplified eq] wte2 this] 
     show "THROW NullPointer = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (FAssThrow1 E e\<^sub>1 s\<^sub>0 e' s\<^sub>1 F Cs e\<^sub>2 e\<^sub>2' s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2\<rangle>" 
     and wt:"P,E \<turnstile> e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain C T'' where wte1:"P,E \<turnstile> e\<^sub>1 :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs D' S'' U a' fs'' h l s w w'
     assume eval_ref:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
     from IH[OF eval_ref wte1 sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix s w 
     assume eval_null:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
     from IH[OF eval_null wte1 sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex
     assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2':"e\<^sub>2' = throw ex"
     from IH[OF eval_throw wte1 sconf] e2' show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex s w assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
     from IH[OF eval_val wte1 sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (FAssThrow2 E e\<^sub>1 s\<^sub>0 v s\<^sub>1 e\<^sub>2 e' s\<^sub>2 F Cs e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>" 
     and wt:"P,E \<turnstile> e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> Val v = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain C T'' where wte1:"P,E \<turnstile> e\<^sub>1 :: Class C" 
     and wte2:"P,E \<turnstile> e\<^sub>2 :: T''" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix Xs D' S'' U a' fs'' h l s w w'
     assume eval_ref:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       and eval_val:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w,(h,l)\<rangle>"
     from IH1[OF eval_ref wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_ref wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   next
     fix s w 
     assume eval_null:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
       and eval_val:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val w,s\<^sub>2'\<rangle>"
     from IH1[OF eval_null wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_null wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_val[simplified eq] wte2 this] show "throw e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'"
       by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte1 sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix ex s w
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       and eval_throw:"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>" and e2':"e\<^sub>2' = throw ex"
     from IH1[OF eval_val wte1 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte1 sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval_throw[simplified eq] wte2 this] e2' 
     show "throw e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (CallObjThrow E e s\<^sub>0 e' s\<^sub>1 Copt M es e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> Call e Copt M es :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by(cases Copt)auto
   show ?case
   proof(cases Copt)
     assume "Copt = None"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex
       assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
       from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix es' ex' s w ws assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       from IH[OF eval_val wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
       from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     qed
   next
     fix C' assume "Copt = Some C'"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>(C'::)M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex
       assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
       from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix es' ex' s w ws assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       from IH[OF eval_val wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix C'' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
       from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
     qed
   qed
 next
   case (CallParamsThrow E e s\<^sub>0 v s\<^sub>1 es vs ex es' s\<^sub>2 Copt M e\<^sub>2 s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> Call e Copt M es :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> Val v = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>esi si Ts. \<lbrakk>P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>esi,si\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                       \<Longrightarrow> map Val vs @ throw ex # es' = esi \<and> s\<^sub>2 = si" by fact+
   from wt obtain C Ts where wte:"P,E \<turnstile> e :: Class C" and wtes:"P,E \<turnstile> es [::] Ts" 
     by(cases Copt)auto
   show ?case
   proof(cases Copt)
     assume "Copt = None"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2'\<rangle>"
       from IH1[OF eval_throw wte sconf] show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     next
       fix es'' ex' s w ws
       assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
         and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es'',s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = throw ex'"
       from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_throw[simplified eq] wtes this] e2
       have "vs = ws \<and> ex = ex' \<and> es' = es'' \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:map_Val_throw_eq)
       with e2 show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     next
       fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,(h,l)\<rangle>"
       from IH1[OF eval_ref wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_ref wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this]
       show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:sym[THEN map_Val_throw_False])
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = THROW NullPointer"
       from IH1[OF eval_null wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_null wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this] 
       show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:sym[THEN map_Val_throw_False])
     qed
   next
     fix C' assume "Copt = Some C'"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>(C'::)M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2'\<rangle>"
       from IH1[OF eval_throw wte sconf] show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     next
       fix es'' ex' s w ws
       assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
         and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es'',s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = throw ex'"
       from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_throw[simplified eq] wtes this] e2
       have "vs = ws \<and> ex = ex' \<and> es' = es'' \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:map_Val_throw_eq)
       with e2 show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     next
       fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,(h,l)\<rangle>"
       from IH1[OF eval_ref wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_ref wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this]
       show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:sym[THEN map_Val_throw_False])
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = THROW NullPointer"
       from IH1[OF eval_null wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_null wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this] 
       show "throw ex = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
         by(fastforce dest:sym[THEN map_Val_throw_False])
     qed
   qed
 next
   case (Call E e s\<^sub>0 a Cs s\<^sub>1 es vs h\<^sub>2 l\<^sub>2 C S M Ts' T' pns' body' Ds Ts T pns
              body Cs' vs' l\<^sub>2' new_body e' h\<^sub>3 l\<^sub>3 e\<^sub>2 s\<^sub>2 T'')
   have eval:"P,E \<turnstile> \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and eval':"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
     and eval'':"P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>" and h2:"h\<^sub>2 a = Some(C,S)"
     and has_least:"P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
     and selects:"P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
     and length:"length vs = length pns" and Casts:"P \<turnstile> Ts Casts vs to vs'"
     and l2':"l\<^sub>2' = [this \<mapsto> Ref (a, Cs'), pns [\<mapsto>] vs']"
     and new_body:"new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body)"
     and eval_body:"P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
                                             \<langle>new_body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle>"
     and wt:"P,E \<turnstile> e\<bullet>M(es) :: T''" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> ref (a,Cs) = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>esi si Ts. \<lbrakk>P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>esi,si\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                       \<Longrightarrow> map Val vs = esi \<and> (h\<^sub>2,l\<^sub>2) = si"
     and IH3:"\<And>ei si T. 
     \<lbrakk>P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> \<langle>new_body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>;
      P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> new_body :: T;
      P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> (h\<^sub>2,l\<^sub>2') \<surd>\<rbrakk>
   \<Longrightarrow> e' = ei \<and> (h\<^sub>3, l\<^sub>3) = si" by fact+
   from wt obtain D Ss Ss' m Cs'' where wte:"P,E \<turnstile> e :: Class D" 
     and has_least':"P \<turnstile> D has least M = (Ss,T'',m) via Cs''"
     and wtes:"P,E \<turnstile> es [::] Ss'" and subs:"P \<turnstile> Ss' [\<le>] Ss" by auto
   from eval_preserves_type[OF wf eval' sconf wte]
   have last:"last Cs = D" by (auto split:if_split_asm)
   with has_least has_least' wf
   have eq:"Ts' = Ss \<and> T' = T'' \<and> (pns',body') = m \<and> Ds = Cs''"
     by(fastforce dest:wf_sees_method_fun)
   from wf selects have param_type:"\<forall>T \<in> set Ts. is_type P T" 
     and return_type:"is_type P T" and TnotNT:"T \<noteq> NT"
     by(auto dest:select_method_wf_mdecl simp:wf_mdecl_def)
   from selects wf have subo:"Subobjs P C Cs'"
     by(induct rule:SelectMethodDef.induct,
        auto simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                  MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
   with wf have "class":"is_class P (last Cs')" by(auto intro!:Subobj_last_isClass)
   from eval'' have hext:"hp s\<^sub>1 \<unlhd> h\<^sub>2" by (cases s\<^sub>1,auto intro: evals_hext)
   from wf eval' sconf wte last have "P,E,(hp s\<^sub>1) \<turnstile> ref(a,Cs) :\<^bsub>NT\<^esub> Class(last Cs)"
     by -(rule eval_preserves_type,simp_all)
   with hext have "P,E,h\<^sub>2 \<turnstile> ref(a,Cs) :\<^bsub>NT\<^esub> Class(last Cs)"
     by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
   with h2 have "Subobjs P C Cs" by (auto split:if_split_asm)
   hence "P \<turnstile> Path C to (last Cs) via Cs"
     by (auto simp:path_via_def split:if_split_asm)
   with selects has_least wf have param_types:"Ts' = Ts \<and> P \<turnstile> T \<le> T'"
     by -(rule select_least_methods_subtypes,simp_all)
   from wf selects have wt_body:"P,[this\<mapsto>Class(last Cs'),pns[\<mapsto>]Ts] \<turnstile> body :: T"
     and this_not_pns:"this \<notin> set pns" and length:"length pns = length Ts"
     and dist:"distinct pns"
     by(auto dest!:select_method_wf_mdecl simp:wf_mdecl_def)
   have "P,[this\<mapsto>Class(last Cs'),pns[\<mapsto>]Ts] \<turnstile> new_body :: T'"
   proof(cases "\<exists>C. T' = Class C")
     case False with wt_body new_body param_types show ?thesis by(cases T') auto
   next
     case True
     then obtain D' where T':"T' = Class D'" by auto
     with wf has_least have "class":"is_class P D'"
       by(fastforce dest:has_least_wf_mdecl simp:wf_mdecl_def)
     with wf T' TnotNT param_types obtain D'' where T:"T = Class D''"
       by(fastforce dest:widen_Class)
     with wf return_type T' param_types have "P \<turnstile> Path D'' to D' unique"
       by(simp add:Class_widen_Class)
     with wt_body "class" T T' new_body show ?thesis by auto
   qed
   hence wt_new_body:"P,E(this\<mapsto>Class(last Cs'),pns[\<mapsto>]Ts) \<turnstile> new_body :: T'"
     by(fastforce intro:wt_env_mono)
   from eval show ?case
   proof(rule eval_cases)
     fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2\<rangle>"
     from IH1[OF eval_throw wte sconf] show "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>2) = s\<^sub>2" by simp
   next
     fix es'' ex' s w ws
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
       and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es'',s\<^sub>2\<rangle>"
     from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>2) = s\<^sub>2"
       by(fastforce dest:map_Val_throw_False)
   next
     fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' s ws ws'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,(h,l)\<rangle>"
       and h:"h a' = Some(C',S')" 
       and has_least'':"P \<turnstile> last Xs has least M = (Us',U',pns''',body''') via Ds'"
       and selects':"P \<turnstile> (C',Xs@\<^sub>pDs') selects M = (Us,U,pns'',body'') via Xs'"
       and length':"length ws = length pns''" and Casts':"P \<turnstile> Us Casts ws to ws'"
       and eval_body':"P,E(this \<mapsto> Class (last Xs'), pns'' [\<mapsto>] Us) \<turnstile> 
       \<langle>case U' of Class D \<Rightarrow> \<lparr>D\<rparr>body'' | _ \<Rightarrow> body'',
         (h,[this \<mapsto> Ref(a',Xs'), pns'' [\<mapsto>] ws'])\<rangle> \<Rightarrow> \<langle>e\<^sub>2,(h',l')\<rangle>"
       and s2:"s\<^sub>2 = (h',l)"
     from IH1[OF eval_ref wte sconf] have eq1:"a = a' \<and> Cs = Xs" and s:"s = s\<^sub>1" 
       by simp_all
     with has_least has_least'' wf have eq2:"T' = U' \<and> Ts' = Us' \<and> Ds = Ds'"
       by(fastforce dest:wf_sees_method_fun)
     from s wf eval_ref wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF evals_vals[simplified s] wtes this]
     have eq3:"vs = ws \<and> h\<^sub>2 = h \<and> l\<^sub>2 = l"
       by(fastforce elim:map_injective simp:inj_on_def)
     with eq1 h2 h have eq4:"C = C' \<and> S = S'" by simp
     with eq1 eq2 selects selects' wf
     have eq5:"Ts = Us \<and> T = U \<and> pns'' = pns \<and> body'' = body \<and> Cs' = Xs'"
       by simp(drule_tac mthd'="(Us,U,pns'',body'')" in wf_select_method_fun,auto)
     with subs eq param_types have "P \<turnstile> Ss' [\<le>] Us" by simp
     with wf Casts Casts' param_type wtes evals_vals sconf' s eq eq2 eq3 eq5
     have eq6:"vs' = ws'"
       by(fastforce intro:Casts_Casts_eq_result)
     with eval_body' l2' eq1 eq2 eq3 eq5 new_body  
     have eval_body'':"P,E(this \<mapsto> Class(last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
                            \<langle>new_body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e\<^sub>2,(h',l')\<rangle>"
       by fastforce
     from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E \<turnstile> (h\<^sub>2,l\<^sub>2) \<surd>"
       by(fastforce intro:evals_preserves_sconf)
     have "P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> (h\<^sub>2,l\<^sub>2') \<surd>"
     proof(auto simp:sconf_def)
       from sconf'' show "P \<turnstile> h\<^sub>2 \<surd>" by(simp add:sconf_def)
     next
       { fix V v assume map:"[this \<mapsto> Ref (a,Cs'), pns [\<mapsto>] vs'] V = Some v"
         have "\<exists>T. (E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts)) V = Some T \<and> 
                    P,h\<^sub>2 \<turnstile> v :\<le> T"
         proof(cases "V \<in> set (this#pns)")
           case False with map show ?thesis by simp
         next
           case True
           hence "V = this \<or> V \<in> set pns" by simp
           thus ?thesis
           proof(rule disjE)
             assume V:"V = this"
             with map this_not_pns have "v = Ref(a,Cs')" by simp
             with V h2 subo this_not_pns have 
               "(E(this \<mapsto> Class (last Cs'),pns [\<mapsto>] Ts)) V = Some(Class (last Cs'))"
               and "P,h\<^sub>2 \<turnstile> v :\<le> Class (last Cs')" by simp_all
             thus ?thesis by simp
           next
             assume "V \<in> set pns"
             then obtain i where V:"V = pns!i" and length_i:"i < length pns"
               by(auto simp:in_set_conv_nth)
             from Casts have "length Ts = length vs'"
               by(induct rule:Casts_to.induct,auto)
             with length have "length pns = length vs'" by simp
             with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
             from length dist length_i
-            have env:"(E(this \<mapsto> Class (last Cs'))(pns [\<mapsto>] Ts)) (pns!i) = Some(Ts!i)"
+            have env:"(E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts)) (pns!i) = Some(Ts!i)"
               by(rule_tac E="E(this \<mapsto> Class (last Cs'))" in nth_maps,simp_all)
             from wf Casts wtes subs eq param_types eval'' sconf'
             have "\<forall>i < length Ts. P,h\<^sub>2 \<turnstile> vs'!i :\<le> Ts!i"
               by simp(rule Casts_conf,auto)
             with length_i length env V v show ?thesis by simp
           qed
         qed }
       thus "P,h\<^sub>2 \<turnstile> l\<^sub>2' (:\<le>)\<^sub>w E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts)"
         using l2' by(simp add:lconf_def)
     next
       { fix V Tx assume env:"(E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts)) V = Some Tx"
         have "is_type P Tx"
         proof(cases "V \<in> set (this#pns)")
           case False
           with env sconf'' show ?thesis
             by(clarsimp simp:sconf_def envconf_def)
         next
           case True
           hence "V = this \<or> V \<in> set pns" by simp
           thus ?thesis
           proof(rule disjE)
             assume "V = this"
             with env this_not_pns have "Tx = Class(last Cs')" by simp
             with "class" show ?thesis by simp
           next
             assume "V \<in> set pns"
             then obtain i where V:"V = pns!i" and length_i:"i < length pns"
               by(auto simp:in_set_conv_nth)
             with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
             with length_i length have "Tx \<in> set Ts"
               by(fastforce simp:in_set_conv_nth)
             with param_type show ?thesis by simp
           qed
         qed }
       thus "P \<turnstile> E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<surd>" by (simp add:envconf_def)
     qed
     from IH3[OF eval_body'' wt_new_body this] have "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>3) = (h',l')" .
     with eq3 s2 show "e' = e\<^sub>2 \<and> (h\<^sub>3,l\<^sub>2) = s\<^sub>2" by simp
   next
     fix s ws
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
     from IH1[OF eval_null wte sconf] show "e' = e\<^sub>2 \<and> (h\<^sub>3,l\<^sub>2) = s\<^sub>2" by simp
   qed
 next
   case (StaticCall E e s\<^sub>0 a Cs s\<^sub>1 es vs h\<^sub>2 l\<^sub>2 C Cs'' M Ts T pns body  Cs'
                    Ds vs' l\<^sub>2' e' h\<^sub>3 l\<^sub>3 e\<^sub>2 s\<^sub>2 T')
   have eval:"P,E \<turnstile> \<langle>e\<bullet>(C::)M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and eval':"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
     and eval'':"P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2, l\<^sub>2)\<rangle>"
     and path_unique:"P \<turnstile> Path last Cs to C unique" 
     and path_via:"P \<turnstile> Path last Cs to C via Cs''"
     and has_least:"P \<turnstile> C has least M = (Ts,T,pns,body) via Cs'"
     and Ds:"Ds = (Cs@\<^sub>pCs'')@\<^sub>pCs'" and length:"length vs = length pns"
     and Casts:"P \<turnstile> Ts Casts vs to vs'"
     and l2':"l\<^sub>2' = [this \<mapsto> Ref (a, Ds), pns [\<mapsto>] vs']"
     and eval_body:"P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> 
                                              \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle>"
     and wt:"P,E \<turnstile> e\<bullet>(C::)M(es) :: T'" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> ref (a,Cs) = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>esi si Ts. 
              \<lbrakk>P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>esi,si\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> map Val vs = esi \<and> (h\<^sub>2,l\<^sub>2) = si"
     and IH3:"\<And>ei si T.
    \<lbrakk>P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>;
     P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> body :: T;
     P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> (h\<^sub>2,l\<^sub>2') \<surd>\<rbrakk>
                     \<Longrightarrow> e' = ei \<and> (h\<^sub>3, l\<^sub>3) = si" by fact+
   from wt has_least wf obtain C' Ts' where wte:"P,E \<turnstile> e :: Class C'"
       and wtes:"P,E \<turnstile> es [::] Ts'" and subs:"P \<turnstile> Ts' [\<le>] Ts"
     by(auto dest:wf_sees_method_fun)
   from eval_preserves_type[OF wf eval' sconf wte]
   have last:"last Cs = C'" by (auto split:if_split_asm)
   from wf has_least have param_type:"\<forall>T \<in> set Ts. is_type P T" 
     and return_type:"is_type P T" and TnotNT:"T \<noteq> NT"
     by(auto dest:has_least_wf_mdecl simp:wf_mdecl_def)
   from path_via have last':"last Cs'' = last(Cs@\<^sub>pCs'')"
     by(fastforce intro!:appendPath_last Subobjs_nonempty simp:path_via_def)
   from eval'' have hext:"hp s\<^sub>1 \<unlhd> h\<^sub>2" by (cases s\<^sub>1,auto intro: evals_hext)
   from wf eval' sconf wte last have "P,E,(hp s\<^sub>1) \<turnstile> ref(a,Cs) :\<^bsub>NT\<^esub> Class(last Cs)"
     by -(rule eval_preserves_type,simp_all)
   with hext have "P,E,h\<^sub>2 \<turnstile> ref(a,Cs) :\<^bsub>NT\<^esub> Class(last Cs)"
     by(auto intro:WTrt_hext_mono dest:hext_objD split:if_split_asm)
   then obtain D S where h2:"h\<^sub>2 a = Some(D,S)" and "Subobjs P D Cs"
     by (auto split:if_split_asm)
   with path_via wf have "Subobjs P D (Cs@\<^sub>pCs'')" and "last Cs'' = C"
     by(auto intro:Subobjs_appendPath simp:path_via_def)
   with has_least wf last' Ds have subo:"Subobjs P D Ds"
     by(fastforce intro:Subobjs_appendPath simp:LeastMethodDef_def MethodDefs_def)
   with wf have "class":"is_class P (last Ds)" by(auto intro!:Subobj_last_isClass)
   from has_least wf obtain D' where "Subobjs P D' Cs'"
     by(auto simp:LeastMethodDef_def MethodDefs_def)
   with Ds have last_Ds:"last Cs' = last Ds"
     by(fastforce intro!:appendPath_last Subobjs_nonempty)
   with wf has_least have "P,[this\<mapsto>Class(last Ds),pns[\<mapsto>]Ts] \<turnstile> body :: T"
     and this_not_pns:"this \<notin> set pns" and length:"length pns = length Ts"
     and dist:"distinct pns"
     by(auto dest!:has_least_wf_mdecl simp:wf_mdecl_def)
   hence wt_body:"P,E(this\<mapsto>Class(last Ds),pns[\<mapsto>]Ts) \<turnstile> body :: T"
     by(fastforce intro:wt_env_mono)
   from eval show ?case
   proof(rule eval_cases)
     fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2\<rangle>"
     from IH1[OF eval_throw wte sconf] show "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>2) = s\<^sub>2" by simp
   next
     fix es'' ex' s w ws
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
       and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es'',s\<^sub>2\<rangle>"
     from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF evals_throw[simplified eq] wtes this] show "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>2) = s\<^sub>2"
       by(fastforce dest:map_Val_throw_False)
   next
     fix Xs Xs' Xs'' U Us a' body' h h' l l' pns' s ws ws'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,(h,l)\<rangle>"
       and path_unique':"P \<turnstile> Path last Xs to C unique"
       and path_via':"P \<turnstile> Path last Xs to C via Xs''"
       and has_least':"P \<turnstile> C has least M = (Us,U,pns',body') via Xs'"
       and length':"length ws = length pns'"
       and Casts':"P \<turnstile> Us Casts ws to ws'"
       and eval_body':"P,E(this \<mapsto> Class(last((Xs@\<^sub>pXs'')@\<^sub>pXs')),pns' [\<mapsto>] Us) \<turnstile> 
       \<langle>body',(h,[this \<mapsto> Ref(a',(Xs@\<^sub>pXs'')@\<^sub>pXs'),pns' [\<mapsto>] ws'])\<rangle> \<Rightarrow> \<langle>e\<^sub>2,(h',l')\<rangle>"
       and s2:"s\<^sub>2 = (h',l)"
     from IH1[OF eval_ref wte sconf] have eq1:"a = a' \<and> Cs = Xs" and s:"s = s\<^sub>1" 
       by simp_all
     from has_least has_least' wf 
     have eq2:"T = U \<and> Ts = Us \<and> Cs' = Xs' \<and> pns = pns' \<and> body = body'"
       by(fastforce dest:wf_sees_method_fun)
     from s wf eval_ref wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF evals_vals[simplified s] wtes this]
     have eq3:"vs = ws \<and> h\<^sub>2 = h \<and> l\<^sub>2 = l"
       by(fastforce elim:map_injective simp:inj_on_def)
     from path_unique path_via path_via' eq1 have "Cs'' = Xs''" 
       by(fastforce simp:path_unique_def path_via_def)
     with Ds eq1 eq2 have Ds':"Ds = (Xs@\<^sub>pXs'')@\<^sub>pXs'" by simp
     from wf Casts Casts' param_type wtes subs evals_vals sconf' s eq2 eq3
     have eq4:"vs' = ws'"
       by(fastforce intro:Casts_Casts_eq_result)
     with eval_body' Ds' l2' eq1 eq2 eq3
     have eval_body'':"P,E(this \<mapsto> Class(last Ds),pns [\<mapsto>] Ts) \<turnstile> 
                             \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e\<^sub>2,(h',l')\<rangle>"
       by simp
     from wf evals_vals wtes sconf' s eq3 have sconf'':"P,E \<turnstile> (h\<^sub>2,l\<^sub>2) \<surd>"
       by(fastforce intro:evals_preserves_sconf)
     have "P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> (h\<^sub>2,l\<^sub>2') \<surd>"
     proof(auto simp:sconf_def)
       from sconf'' show "P \<turnstile> h\<^sub>2 \<surd>" by(simp add:sconf_def)
     next
       { fix V v assume map:"[this \<mapsto> Ref (a,Ds), pns [\<mapsto>] vs'] V = Some v"
         have "\<exists>T. (E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts)) V = Some T \<and> 
                    P,h\<^sub>2 \<turnstile> v :\<le> T"
         proof(cases "V \<in> set (this#pns)")
           case False with map show ?thesis by simp
         next
           case True
           hence "V = this \<or> V \<in> set pns" by simp
           thus ?thesis
           proof(rule disjE)
             assume V:"V = this"
             with map this_not_pns have "v = Ref(a,Ds)" by simp
             with V h2 subo this_not_pns have
               "(E(this \<mapsto> Class (last Ds),pns [\<mapsto>] Ts)) V = Some(Class (last Ds))"
               and "P,h\<^sub>2 \<turnstile> v :\<le> Class (last Ds)" by simp_all
             thus ?thesis by simp
           next
             assume "V \<in> set pns"
             then obtain i where V:"V = pns!i" and length_i:"i < length pns"
               by(auto simp:in_set_conv_nth)
             from Casts have "length Ts = length vs'"
               by(induct rule:Casts_to.induct,auto)
             with length have "length pns = length vs'" by simp
             with map dist V length_i have v:"v = vs'!i" by(fastforce dest:maps_nth)
             from length dist length_i
-            have env:"(E(this \<mapsto> Class (last Ds))(pns [\<mapsto>] Ts)) (pns!i) = Some(Ts!i)"
+            have env:"(E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts)) (pns!i) = Some(Ts!i)"
               by(rule_tac E="E(this \<mapsto> Class (last Ds))" in nth_maps,simp_all)
             from wf Casts wtes subs eval'' sconf'
             have "\<forall>i < length Ts. P,h\<^sub>2 \<turnstile> vs'!i :\<le> Ts!i"
               by -(rule Casts_conf,auto)
             with length_i length env V v show ?thesis by simp
           qed
         qed }
       thus "P,h\<^sub>2 \<turnstile> l\<^sub>2' (:\<le>)\<^sub>w E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts)"
         using l2' by(simp add:lconf_def)
     next
       { fix V Tx assume env:"(E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts)) V = Some Tx"
         have "is_type P Tx"
         proof(cases "V \<in> set (this#pns)")
           case False
           with env sconf'' show ?thesis
             by(clarsimp simp:sconf_def envconf_def)
         next
           case True
           hence "V = this \<or> V \<in> set pns" by simp
           thus ?thesis
           proof(rule disjE)
             assume "V = this"
             with env this_not_pns have "Tx = Class(last Ds)" by simp
             with "class" show ?thesis by simp
           next
             assume "V \<in> set pns"
             then obtain i where V:"V = pns!i" and length_i:"i < length pns"
               by(auto simp:in_set_conv_nth)
             with dist length env have "Tx = Ts!i" by(fastforce dest:maps_nth)
             with length_i length have "Tx \<in> set Ts"
               by(fastforce simp:in_set_conv_nth)
             with param_type show ?thesis by simp
           qed
         qed }
       thus "P \<turnstile> E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<surd>" by (simp add:envconf_def)
     qed
     from IH3[OF eval_body'' wt_body this] have "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>3) = (h',l')" .
     with eq3 s2 show "e' = e\<^sub>2 \<and> (h\<^sub>3, l\<^sub>2) = s\<^sub>2" by simp
   next
     fix s ws
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
     from IH1[OF eval_null wte sconf] show "e' = e\<^sub>2 \<and> (h\<^sub>3,l\<^sub>2) = s\<^sub>2" by simp
   qed
 next
   case (CallNull E e s\<^sub>0 s\<^sub>1 es vs s\<^sub>2 Copt M e\<^sub>2 s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> Call e Copt M es :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
     \<Longrightarrow> null = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>esi si Ts. \<lbrakk>P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>esi,si\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
     \<Longrightarrow> map Val vs = esi \<and> s\<^sub>2 = si" by fact+
   from wt obtain C Ts where wte:"P,E \<turnstile> e :: Class C" and wtes:"P,E \<turnstile> es [::] Ts" 
     by(cases Copt)auto
   show ?case
   proof(cases Copt)
     assume "Copt = None"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2'\<rangle>"
       from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" 
         by simp
     next
       fix es' ex' s w ws
       assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
         and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es',s\<^sub>2'\<rangle>"
       from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_throw[simplified eq] wtes this] 
       show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by(fastforce dest:map_Val_throw_False)
     next
       fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" 
         by simp
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = THROW NullPointer"
       from IH1[OF eval_null wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_null wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this] e2
       show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     qed
   next
     fix C' assume "Copt = Some C'"
     with eval have "P,E \<turnstile> \<langle>e\<bullet>(C'::)M(es),s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>" by simp
     thus ?thesis
     proof(rule eval_cases)
       fix ex' assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex',s\<^sub>2'\<rangle>"
       from IH1[OF eval_throw wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" 
         by simp
     next
       fix es' ex' s w ws
       assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
         and evals_throw:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws@throw ex'#es',s\<^sub>2'\<rangle>"
       from IH1[OF eval_val wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_val wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_throw[simplified eq] wtes this] 
       show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by(fastforce dest:map_Val_throw_False)
     next
       fix C' Xs Xs' Ds' S' U U' Us Us' a' body'' body''' h h' l l' pns'' pns''' 
           s ws ws'
       assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref(a',Xs),s\<rangle>"
       from IH1[OF eval_ref wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" 
         by simp
     next
       fix s ws
       assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val ws,s\<^sub>2'\<rangle>"
         and e2:"e\<^sub>2 = THROW NullPointer"
       from IH1[OF eval_null wte sconf] have eq:"s = s\<^sub>1" by simp
       with wf eval_null wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
         by(fastforce intro:eval_preserves_sconf)
       from IH2[OF evals_vals[simplified eq] wtes this] e2
       show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
     qed
   qed
 next
   case (Block E V T e\<^sub>0 h\<^sub>0 l\<^sub>0 e\<^sub>1 h\<^sub>1 l\<^sub>1 e\<^sub>2 s\<^sub>2 T')
   have eval:"P,E \<turnstile> \<langle>{V:T; e\<^sub>0},(h\<^sub>0, l\<^sub>0)\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> {V:T; e\<^sub>0} :: T'" and sconf:"P,E \<turnstile> (h\<^sub>0, l\<^sub>0) \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T'. \<lbrakk>P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0, l\<^sub>0(V := None))\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; 
                P,E(V \<mapsto> T) \<turnstile> e\<^sub>0 :: T'; P,E(V \<mapsto> T) \<turnstile> (h\<^sub>0, l\<^sub>0(V := None)) \<surd>\<rbrakk>
     \<Longrightarrow> e\<^sub>1 = e\<^sub>2 \<and> (h\<^sub>1, l\<^sub>1) = s\<^sub>2" by fact+
   from wt have type:"is_type P T" and wte:"P,E(V \<mapsto> T) \<turnstile> e\<^sub>0 :: T'" by auto
   from sconf type have sconf':"P,E(V \<mapsto> T) \<turnstile> (h\<^sub>0, l\<^sub>0(V := None)) \<surd>"
     by(auto simp:sconf_def lconf_def envconf_def)
   from eval obtain h l where 
     eval':"P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0,l\<^sub>0(V:=None))\<rangle> \<Rightarrow> \<langle>e\<^sub>2,(h,l)\<rangle>"
     and s2:"s\<^sub>2 = (h,l(V:=l\<^sub>0 V))" by (auto elim:eval_cases)
   from IH[OF eval' wte sconf'] s2 show ?case by simp
 next
   case (Seq E e\<^sub>0 s\<^sub>0 v s\<^sub>1 e\<^sub>1 e\<^sub>2 s\<^sub>2 e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>0;; e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> e\<^sub>0;; e\<^sub>1 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>0 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> Val v = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk> 
                      \<Longrightarrow> e\<^sub>2 = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain T' where wte0:"P,E \<turnstile> e\<^sub>0 :: T'" and wte1:"P,E \<turnstile> e\<^sub>1 :: T" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s w 
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>" 
       and eval':"P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     from IH1[OF eval_val wte0 sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_val wte0 sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval'[simplified eq] wte1 this] show "e\<^sub>2 = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" .
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte0 sconf] show "e\<^sub>2 = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (SeqThrow E e\<^sub>0 s\<^sub>0 e s\<^sub>1 e\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>e\<^sub>0;; e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> e\<^sub>0;; e\<^sub>1 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>0 :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                      \<Longrightarrow> throw e = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain T' where wte0:"P,E \<turnstile> e\<^sub>0 :: T'" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s w 
     assume eval_val:"P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
     from IH[OF eval_val wte0 sconf] show "throw e = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
     from IH[OF eval_throw wte0 sconf] e2 show "throw e = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (CondT E e s\<^sub>0 s\<^sub>1 e\<^sub>1 e' s\<^sub>2 e\<^sub>2 e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> true = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>1 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk> 
                     \<Longrightarrow> e' = ei \<and> s\<^sub>2 = si" by fact+
   from wt have wte:"P,E \<turnstile> e :: Boolean" and wte1:"P,E \<turnstile> e\<^sub>1 :: T" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s 
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>" and eval':"P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     from IH1[OF eval_true wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_true wte sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval'[simplified eq] wte1 this] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" .
   next
     fix s assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<rangle>"
     from IH1[OF eval_false wte sconf] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte sconf] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (CondF E e s\<^sub>0 s\<^sub>1 e\<^sub>2 e' s\<^sub>2 e\<^sub>1 e\<^sub>2' s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> false = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e\<^sub>2 :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk> 
                     \<Longrightarrow> e' = ei \<and> s\<^sub>2 = si" by fact+
   from wt have wte:"P,E \<turnstile> e :: Boolean" and wte2:"P,E \<turnstile> e\<^sub>2 :: T" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s 
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH1[OF eval_true wte sconf] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix s
     assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<rangle>"
       and eval':"P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2'\<rangle>"
     from IH1[OF eval_false wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_false wte sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF eval'[simplified eq] wte2 this] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" .
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte sconf] show "e' = e\<^sub>2' \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (CondThrow E e s\<^sub>0 e' s\<^sub>1 e\<^sub>1 e\<^sub>2 e\<^sub>2' s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2',s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>1 = si" by fact+
   from wt have wte:"P,E \<turnstile> e :: Boolean" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix s 
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH[OF eval_true wte sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix s assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<rangle>"
     from IH[OF eval_false wte sconf] show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2':"e\<^sub>2' = throw ex"
     from IH[OF eval_throw wte sconf] e2' show "throw e' = e\<^sub>2' \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (WhileF E e s\<^sub>0 s\<^sub>1 c e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> while (e) c :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>e\<^sub>2 s\<^sub>2 T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> false = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by fact+
   from wt have wte:"P,E \<turnstile> e :: Boolean" by auto
   from eval show ?case
   proof(rule eval_cases)
     assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = unit"
     from IH[OF eval_false wte sconf] e2 show "unit = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix s s' w
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH[OF eval_true wte sconf] show "unit = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "unit = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex s
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH[OF eval_true wte sconf] show "unit = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (WhileT E e s\<^sub>0 s\<^sub>1 c v\<^sub>1 s\<^sub>2 e\<^sub>3 s\<^sub>3 e\<^sub>2 s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> while (e) c :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> true = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> c :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk> 
                     \<Longrightarrow> Val v\<^sub>1 = ei \<and> s\<^sub>2 = si"
     and IH3:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>while (e) c,s\<^sub>2\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> while (e) c :: T; 
                          P,E \<turnstile> s\<^sub>2 \<surd>\<rbrakk>
                     \<Longrightarrow> e\<^sub>3 = ei \<and> s\<^sub>3 = si" by fact+
   from wt obtain T' where wte:"P,E \<turnstile> e :: Boolean" and wtc:"P,E \<turnstile> c :: T'" by auto
   from eval show ?case
   proof(rule eval_cases)
     assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>2'\<rangle>"
     from IH1[OF eval_false wte sconf] show "e\<^sub>3 = e\<^sub>2 \<and> s\<^sub>3 = s\<^sub>2'" by simp
   next
     fix s s' w
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>" 
       and eval_val:"P,E \<turnstile> \<langle>c,s\<rangle> \<Rightarrow> \<langle>Val w,s'\<rangle>"
       and eval_while:"P,E \<turnstile> \<langle>while (e) c,s'\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>"
     from IH1[OF eval_true wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_true wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val[simplified eq] wtc this] have eq':"s' = s\<^sub>2" by simp
    with wf eval_val wtc sconf' eq have "P,E \<turnstile> s\<^sub>2 \<surd>"
      by(fastforce intro:eval_preserves_sconf)
    from IH3[OF eval_while[simplified eq'] wt this] show "e\<^sub>3 = e\<^sub>2 \<and> s\<^sub>3 = s\<^sub>2'" .
  next
    fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
    from IH1[OF eval_throw wte sconf] show "e\<^sub>3 = e\<^sub>2 \<and> s\<^sub>3 = s\<^sub>2'" by simp
  next
    fix ex s
    assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>" 
      and eval_throw:"P,E \<turnstile> \<langle>c,s\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_true wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_true wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified eq] wtc this] show "e\<^sub>3 = e\<^sub>2 \<and> s\<^sub>3 = s\<^sub>2'" by simp
  qed
 next
   case (WhileCondThrow E e s\<^sub>0 e' s\<^sub>1 c e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> while (e) c :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk>
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>1 = si" by fact+
   from wt have wte:"P,E \<turnstile> e :: Boolean" by auto
   from eval show ?case
   proof(rule eval_cases)
     assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>2\<rangle>"
     from IH[OF eval_false wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix s s' w
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH[OF eval_true wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
     from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex s
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>"
     from IH[OF eval_true wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (WhileBodyThrow E e s\<^sub>0 s\<^sub>1 c e' s\<^sub>2 e\<^sub>2 s\<^sub>2' T)
   have eval:"P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> while (e) c :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> true = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> c :: T; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                    \<Longrightarrow> throw e' = ei \<and> s\<^sub>2 = si" by fact+
   from wt obtain T' where wte:"P,E \<turnstile> e :: Boolean" and wtc:"P,E \<turnstile> c :: T'" by auto
   from eval show ?case
   proof(rule eval_cases)
     assume eval_false:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>false,s\<^sub>2'\<rangle>"
     from IH1[OF eval_false wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix s s' w
     assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>" 
       and eval_val:"P,E \<turnstile> \<langle>c,s\<rangle> \<Rightarrow> \<langle>Val w,s'\<rangle>"
     from IH1[OF eval_true wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_true wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_val[simplified eq] wtc this] show "throw e' = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
      by simp
  next
    fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
    from IH1[OF eval_throw wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
  next
    fix ex s
    assume eval_true:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>true,s\<rangle>" 
      and eval_throw:"P,E \<turnstile> \<langle>c,s\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>" and e2:"e\<^sub>2 = throw ex"
    from IH1[OF eval_true wte sconf] have eq:"s = s\<^sub>1" by simp
     with wf eval_true wte sconf have sconf':"P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
    from IH2[OF eval_throw[simplified eq] wtc this] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'"
      by simp
  qed
 next
   case (Throw E e s\<^sub>0 r s\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> throw e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                    \<Longrightarrow> ref r = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix r'
     assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref r',s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = Throw r'"
     from IH[OF eval_ref wte sconf] e2 show "Throw r = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "Throw r = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "Throw r = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (ThrowNull E e s\<^sub>0 s\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> throw e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                    \<Longrightarrow> null = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix r' assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref r',s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = THROW NullPointer"
     from IH[OF eval_null wte sconf] e2 show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" 
       by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>"
     from IH[OF eval_throw wte sconf] show "THROW NullPointer = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case (ThrowThrow E e s\<^sub>0 e' s\<^sub>1 e\<^sub>2 s\<^sub>2 T)
   have eval:"P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> throw e :: T" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain C where wte:"P,E \<turnstile> e :: Class C" by auto
   from eval show ?case
   proof(rule eval_cases)
     fix r' assume eval_ref:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ref r',s\<^sub>2\<rangle>"
     from IH[OF eval_ref wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     assume eval_null:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>null,s\<^sub>2\<rangle>"
     from IH[OF eval_null wte sconf] show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and e2:"e\<^sub>2 = throw ex"
     from IH[OF eval_throw wte sconf] e2 show "throw e' = e\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 next
   case Nil thus ?case by (auto elim:evals_cases)
 next
   case (Cons E e s\<^sub>0 v s\<^sub>1 es es' s\<^sub>2 es\<^sub>2 s\<^sub>2' Ts)
   have evals:"P,E \<turnstile> \<langle>e#es,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>es\<^sub>2,s\<^sub>2'\<rangle>"
     and wt:"P,E \<turnstile> e#es [::] Ts" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH1:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> Val v = ei \<and> s\<^sub>1 = si"
     and IH2:"\<And>esi si Ts. \<lbrakk>P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>esi,si\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s\<^sub>1 \<surd>\<rbrakk>
                     \<Longrightarrow> es' = esi \<and> s\<^sub>2 = si" by fact+
   from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
   with wt have wte:"P,E \<turnstile> e :: T'" and wtes:"P,E \<turnstile> es [::] Ts'" by auto
   from evals show ?case
   proof(rule evals_cases)
     fix es'' s w
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
       and evals_vals:"P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es'',s\<^sub>2'\<rangle>" and es2:"es\<^sub>2 = Val w#es''"
     from IH1[OF eval_val wte sconf] have s:"s = s\<^sub>1" and v:"v = w" by simp_all
     with wf eval_val wte sconf have "P,E \<turnstile> s\<^sub>1 \<surd>"
       by(fastforce intro:eval_preserves_sconf)
     from IH2[OF evals_vals[simplified s] wtes this] have "es' = es'' \<and> s\<^sub>2 = s\<^sub>2'" .
     with es2 v show "Val v # es' = es\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
   next
     fix ex assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2'\<rangle>"
     from IH1[OF eval_throw wte sconf] show "Val v # es' = es\<^sub>2 \<and> s\<^sub>2 = s\<^sub>2'" by simp
   qed
 next
   case (ConsThrow E e s\<^sub>0 e' s\<^sub>1 es es\<^sub>2 s\<^sub>2 Ts)
   have evals:"P,E \<turnstile> \<langle>e#es,s\<^sub>0\<rangle> [\<Rightarrow>] \<langle>es\<^sub>2,s\<^sub>2\<rangle>"
     and wt:"P,E \<turnstile> e#es [::] Ts" and sconf:"P,E \<turnstile> s\<^sub>0 \<surd>"
     and IH:"\<And>ei si T. \<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>ei,si\<rangle>; P,E \<turnstile> e :: T; P,E \<turnstile> s\<^sub>0 \<surd>\<rbrakk> 
                     \<Longrightarrow> throw e' = ei \<and> s\<^sub>1 = si" by fact+
   from wt obtain T' Ts' where Ts:"Ts = T'#Ts'" by(cases Ts) auto
   with wt have wte:"P,E \<turnstile> e :: T'" by auto
   from evals show ?case
   proof(rule evals_cases)
     fix es'' s w
     assume eval_val:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>Val w,s\<rangle>"
     from IH[OF eval_val wte sconf] show "throw e'#es = es\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   next
     fix ex 
     assume eval_throw:"P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow> \<langle>throw ex,s\<^sub>2\<rangle>" and es2:"es\<^sub>2 = throw ex#es"
     from IH[OF eval_throw wte sconf] es2 show "throw e'#es = es\<^sub>2 \<and> s\<^sub>1 = s\<^sub>2" by simp
   qed
 qed
 
 
 end
diff --git a/thys/CoreC++/Equivalence.thy b/thys/CoreC++/Equivalence.thy
--- a/thys/CoreC++/Equivalence.thy
+++ b/thys/CoreC++/Equivalence.thy
@@ -1,2835 +1,2835 @@
 (*  Title:       CoreC++
 
     Author:      Daniel Wasserrab
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 
     Based on the Jinja theory J/Equivalence.thy by Tobias Nipkow
 *)
 
 section \<open>Equivalence of Big Step and Small Step Semantics\<close>
 
 theory Equivalence imports BigStep SmallStep WWellForm begin
 
 
 subsection\<open>Some casts-lemmas\<close>
 
 lemma assumes wf:"wf_prog wf_md P"
 shows casts_casts:
 "P \<turnstile> T casts v to v' \<Longrightarrow> P \<turnstile> T casts v' to v'"
 
 proof(induct rule:casts_to.induct)
   case casts_prim thus ?case by(rule casts_to.casts_prim)
 next
   case (casts_null C) thus ?case by(rule casts_to.casts_null)
 next
   case (casts_ref Cs C Cs' Ds a)
   have path_via:"P \<turnstile> Path last Cs to C via Cs'" and Ds:"Ds = Cs @\<^sub>p Cs'" by fact+
   with wf have "last Cs' = C" and "Cs' \<noteq> []" and "class": "is_class P C"
     by(auto intro!:Subobjs_nonempty Subobj_last_isClass simp:path_via_def)
   with Ds have last:"last Ds = C"
     by -(drule_tac Cs' = "Cs" in appendPath_last,simp)
   hence Ds':"Ds = Ds @\<^sub>p [C]" by(simp add:appendPath_def)
   from last "class" have "P \<turnstile> Path last Ds to C via [C]"
     by(fastforce intro:Subobjs_Base simp:path_via_def)
   with Ds' show ?case by(fastforce intro:casts_to.casts_ref)
 qed
 
 
 
 lemma casts_casts_eq:
 "\<lbrakk> P \<turnstile> T casts v to v; P \<turnstile> T casts v to v'; wf_prog wf_md P \<rbrakk> \<Longrightarrow> v = v'"
 
   apply -
   apply(erule casts_to.cases)
     apply clarsimp
     apply(erule casts_to.cases)
       apply simp
      apply simp
     apply (simp (asm_lr))
    apply(erule casts_to.cases)
      apply simp
     apply simp
    apply simp
   apply simp
   apply(erule casts_to.cases)
     apply simp
    apply simp
   apply clarsimp
   apply(erule appendPath_path_via)
   by auto
 
 
 
 lemma assumes wf:"wf_prog wf_md P"
 shows None_lcl_casts_values:
 "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow>
   (\<And>V. \<lbrakk>l V = None; E V = Some T; l' V = Some v'\<rbrakk>
   \<Longrightarrow> P \<turnstile> T casts v' to v')"
 and "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow>
   (\<And>V. \<lbrakk>l V = None; E V = Some T; l' V = Some v'\<rbrakk>
   \<Longrightarrow> P \<turnstile> T casts v' to v')"
 
 proof(induct rule:red_reds_inducts)
   case (RedLAss E V T' w w' h l V')
   have env:"E V = Some T'" and env':"E V' = Some T"
     and l:"l V' = None" and lupd:"(l(V \<mapsto> w')) V' = Some v'"
     and casts:"P \<turnstile> T' casts w to w'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with lupd have v':"v' = w'" by simp
     from True env env' have "T = T'" by simp
     with v' casts wf show ?thesis by(fastforce intro:casts_casts)
   next
     case False
     with lupd have "l V' = Some v'" by(fastforce split:if_split_asm)
     with l show ?thesis by simp
   qed
 next
   case (BlockRedNone E V T' e h l e' h' l' V')
   have l:"l V' = None"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and IH:"\<And>V'. \<lbrakk>(l(V := None)) V' = None; (E(V \<mapsto> T')) V' = Some T; 
                    l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True 
     with l'upd l show ?thesis by fastforce
   next
     case False
     with l  l'upd have lnew:"(l(V := None)) V' = None"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' l'new] show ?thesis .
   qed
 next
   case (BlockRedSome E V T' e h l e' h' l' v V')
   have l:"l V' = None"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and IH:"\<And>V'. \<lbrakk>(l(V := None)) V' = None; (E(V \<mapsto> T')) V' = Some T; 
                    l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with l l'upd show ?thesis by fastforce
   next
     case False
     with l  l'upd have lnew:"(l(V := None)) V' = None"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' l'new] show ?thesis .
   qed
 next
   case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
   have l:"l V' = None"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and IH:"\<And>V'. \<lbrakk>(l(V \<mapsto> w')) V' = None; (E(V \<mapsto> T')) V' = Some T; 
                    l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with l l'upd show ?thesis by fastforce
   next
     case False
     with l  l'upd have lnew:"(l(V \<mapsto> w')) V' = None"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' l'new] show ?thesis .
   qed
 qed (auto intro:casts_casts wf)
 
 
 
 lemma assumes wf:"wf_prog wf_md P"
 shows Some_lcl_casts_values:
 "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow>
   (\<And>V. \<lbrakk>l V = Some v; E V = Some T;
       P \<turnstile> T casts v'' to v; l' V = Some v'\<rbrakk>
   \<Longrightarrow> P \<turnstile> T casts v' to v')"
 and "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow>
   (\<And>V. \<lbrakk>l V = Some v; E V = Some T;
       P \<turnstile> T casts v'' to v; l' V = Some v'\<rbrakk>
   \<Longrightarrow> P \<turnstile> T casts v' to v')"
 
 proof(induct rule:red_reds_inducts)
   case (RedNew h a h' C' E l V)
   have l1:"l V = Some v" and l2:"l V = Some v'"
     and casts:"P \<turnstile> T casts v'' to v " by fact+
   from l1 l2 have eq:"v = v'" by simp
   with casts wf show ?case by(fastforce intro:casts_casts)
 next
   case (RedLAss E V T' w w' h l V')
   have l:"l V' = Some v" and lupd:"(l(V \<mapsto> w')) V' = Some v'"
     and T'casts:"P \<turnstile> T' casts w to w'"
     and env:"E V = Some T'" and env':"E V' = Some T"
     and casts:"P \<turnstile> T casts v'' to v" by fact+
   show ?case
   proof (cases "V = V'")
     case True
     with lupd have v':"v' = w'" by simp
     from True env env' have "T = T'" by simp
     with T'casts v' wf show ?thesis by(fastforce intro:casts_casts)
   next
     case False
     with l lupd have "v = v'" by (auto split:if_split_asm)
     with casts wf show ?thesis by(fastforce intro:casts_casts)
   qed
 next
   case (RedFAss h a D S Cs' F T' Cs w w' Ds fs E l V)
   have l1:"l V = Some v" and l2:"l V = Some v'"
     and hp:"h a = Some(D, S)"
     and T'casts:"P \<turnstile> T' casts w to w'"
     and casts:"P \<turnstile> T casts v'' to v" by fact+
   from l1 l2 have eq:"v = v'" by simp
   with casts wf show ?case by(fastforce intro:casts_casts)
 next
   case (BlockRedNone E V T' e h l e' h' l' V')
   have l':"l' V = None" and l:"l V' = Some v"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and casts:"P \<turnstile> T casts v'' to v"
     and IH:"\<And>V'. \<lbrakk>(l(V := None)) V' = Some v; (E(V \<mapsto> T')) V' = Some T; 
                   P \<turnstile> T casts v'' to v ; l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with l' l'upd have "l V = Some v'" by auto
     with True l have eq:"v = v'" by simp
     with casts wf show ?thesis by(fastforce intro:casts_casts)
   next
     case False
     with l  l'upd have lnew:"(l(V := None)) V' = Some v"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' casts l'new] show ?thesis .
   qed
 next
   case (BlockRedSome E V T' e h l e' h' l' w V')
   have l':"l' V = Some w" and l:"l V' = Some v"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and casts:"P \<turnstile> T casts v'' to v"
     and IH:"\<And>V'. \<lbrakk>(l(V := None)) V' = Some v; (E(V \<mapsto> T')) V' = Some T; 
                    P \<turnstile> T casts v'' to v ; l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with l' l'upd have "l V = Some v'" by auto
     with True l have eq:"v = v'" by simp
     with casts wf show ?thesis by(fastforce intro:casts_casts)
   next
     case False
     with l  l'upd have lnew:"(l(V := None)) V' = Some v"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' casts l'new] show ?thesis .
   qed
 next
   case (InitBlockRed E V T' e h l w' e' h' l' w'' w V')
   have l:"l V' = Some v" and l':"l' V = Some w''"
     and l'upd:"(l'(V := l V)) V' = Some v'" and env:"E V' = Some T"
     and casts:"P \<turnstile> T casts v'' to v"
     and IH:"\<And>V'. \<lbrakk>(l(V \<mapsto> w')) V' = Some v; (E(V \<mapsto> T')) V' = Some T; 
                    P \<turnstile> T casts v'' to v ; l' V' = Some v'\<rbrakk>
             \<Longrightarrow> P \<turnstile> T casts v' to v'" by fact+
   show ?case
   proof(cases "V = V'")
     case True
     with l' l'upd have "l V = Some v'" by auto
     with True l have eq:"v = v'" by simp
     with casts wf show ?thesis by(fastforce intro:casts_casts)
   next
     case False
     with l  l'upd have lnew:"(l(V \<mapsto> w')) V' = Some v"
       and l'new:"l' V' = Some v'" by (auto split:if_split_asm)
     from env False have env':"(E(V \<mapsto> T')) V' = Some T" by fastforce
     from IH[OF lnew env' casts l'new] show ?thesis .
   qed
 qed (auto intro:casts_casts wf)
 
   
 
 
 subsection\<open>Small steps simulate big step\<close>
 
 subsection \<open>Cast\<close>
 
 lemma StaticCastReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>\<lparr>C\<rparr>e',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply (simp add:StaticCastRed)
 done
 
 
 lemma StaticCastRedsNull:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule StaticCastReds)
 apply(simp add:RedStaticCastNull)
 done
 
 
 lemma StaticUpCastReds:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s'\<rangle>; P \<turnstile> Path last Cs to C via Cs'; Ds = Cs@\<^sub>pCs' \<rbrakk> 
   \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Ds),s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule StaticCastReds)
 apply(fastforce intro:RedStaticUpCast)
 done
 
 
 lemma StaticDownCastReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs@[C]@Cs'),s'\<rangle>
   \<Longrightarrow>  P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs@[C]),s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule StaticCastReds)
 apply simp
 apply(subgoal_tac "P,E \<turnstile> \<langle>\<lparr>C\<rparr>ref(a,Cs@[C]@Cs'),s'\<rangle> \<rightarrow> \<langle>ref(a,Cs@[C]),s'\<rangle>")
  apply simp
 apply(rule RedStaticDownCast)
 done
 
 
 lemma StaticCastRedsFail:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s'\<rangle>; C \<notin> set Cs; \<not> P \<turnstile> (last Cs) \<preceq>\<^sup>* C \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>THROW ClassCast,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule StaticCastReds)
 apply(fastforce intro:RedStaticCastFail)
 done
 
 
 lemma StaticCastRedsThrow:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule StaticCastReds)
 apply(simp add:red_reds.StaticCastThrow)
 done
 
 
 lemma DynCastReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>Cast C e',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply (simp add:DynCastRed)
 done
 
 
 lemma DynCastRedsNull:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply(simp add:RedDynCastNull)
 done
 
 
 lemma DynCastRedsRef:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s'\<rangle>; hp s' a = Some (D,S); P \<turnstile> Path D to C via Cs';
      P \<turnstile> Path D to C unique \<rbrakk> 
  \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs'),s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply(fastforce intro:RedDynCast)
 done
 
 
 lemma StaticUpDynCastReds:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s'\<rangle>; P \<turnstile> Path last Cs to C unique;
   P \<turnstile> Path last Cs to C via Cs'; Ds = Cs@\<^sub>pCs' \<rbrakk> 
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>ref(a,Ds),s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply(fastforce intro:RedStaticUpDynCast)
 done
 
 
 lemma StaticDownDynCastReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs@[C]@Cs'),s'\<rangle>
   \<Longrightarrow>  P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs@[C]),s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply simp
 apply(subgoal_tac "P,E \<turnstile> \<langle>Cast C (ref(a,Cs@[C]@Cs')),s'\<rangle> \<rightarrow> \<langle>ref(a,Cs@[C]),s'\<rangle>")
  apply simp
 apply(rule RedStaticDownDynCast)
 done
 
 
 lemma DynCastRedsFail:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s'\<rangle>; hp s' a = Some (D,S); \<not> P \<turnstile> Path D to C unique;
     \<not> P \<turnstile> Path last Cs to C unique; C \<notin> set Cs \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply(fastforce intro:RedDynCastFail)
 done
 
 
 lemma DynCastRedsThrow:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule DynCastReds)
 apply(simp add:red_reds.DynCastThrow)
 done
 
 
 subsection \<open>LAss\<close>
 
 lemma LAssReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>V:=e,s\<rangle> \<rightarrow>* \<langle>V:=e',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:LAssRed)
 done
 
 
 lemma LAssRedsVal:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Val v,(h',l')\<rangle>; E V = Some T; P \<turnstile> T casts v to v'\<rbrakk> 
   \<Longrightarrow> P,E \<turnstile> \<langle> V:=e,s\<rangle> \<rightarrow>* \<langle>Val v',(h',l'(V\<mapsto>v'))\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule LAssReds)
 apply(simp add:RedLAss)
 done
 
 
 lemma LAssRedsThrow:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle> V:=e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule LAssReds)
 apply(simp add:red_reds.LAssThrow)
 done
 
 
 subsection \<open>BinOp\<close>
 
 lemma BinOp1Reds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle> e \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>e' \<guillemotleft>bop\<guillemotright> e\<^sub>2, s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:BinOpRed1)
 done
 
 
 lemma BinOp2Reds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>(Val v) \<guillemotleft>bop\<guillemotright> e, s\<rangle> \<rightarrow>* \<langle>(Val v) \<guillemotleft>bop\<guillemotright> e', s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:BinOpRed2)
 done
 
 
 lemma BinOpRedsVal:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Val v\<^sub>2,s\<^sub>2\<rangle>; 
      binop(bop,v\<^sub>1,v\<^sub>2) = Some v \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v,s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule BinOp1Reds)
 apply(rule rtrancl_into_rtrancl)
  apply(erule BinOp2Reds)
 apply(simp add:RedBinOp)
 done
 
 
 lemma BinOpRedsThrow1:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>Throw r, s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule BinOp1Reds)
 apply(simp add:red_reds.BinOpThrow1)
 done
 
 
 lemma BinOpRedsThrow2:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle>\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule BinOp1Reds)
 apply(rule rtrancl_into_rtrancl)
  apply(erule BinOp2Reds)
 apply(simp add:red_reds.BinOpThrow2)
 done
 
 
 subsection \<open>FAcc\<close>
 
 lemma FAccReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs}, s\<rangle> \<rightarrow>* \<langle>e'\<bullet>F{Cs}, s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:FAccRed)
 done
 
 
 lemma FAccRedsVal:
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ref(a,Cs'),s'\<rangle>; hp s' a = Some(D,S); 
     Ds = Cs'@\<^sub>pCs; (Ds,fs) \<in> S; fs F = Some v \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<rangle> \<rightarrow>* \<langle>Val v,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAccReds)
 apply (fastforce intro:RedFAcc)
 done
 
 
 lemma FAccRedsNull:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<rangle> \<rightarrow>* \<langle>THROW NullPointer,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAccReds)
 apply(simp add:RedFAccNull)
 done
 
 
 lemma FAccRedsThrow:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAccReds)
 apply(simp add:red_reds.FAccThrow)
 done
 
 
 subsection \<open>FAss\<close>
 
 lemma FAssReds1:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs}:=e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>e'\<bullet>F{Cs}:=e\<^sub>2, s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:FAssRed1)
 done
 
 
 lemma FAssReds2:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>Val v\<bullet>F{Cs}:=e, s\<rangle> \<rightarrow>* \<langle>Val v\<bullet>F{Cs}:=e', s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:FAssRed2)
 done
 
 
 lemma FAssRedsVal:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>ref(a,Cs'),s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Val v,(h\<^sub>2,l\<^sub>2)\<rangle>; 
     h\<^sub>2 a = Some(D,S); P \<turnstile> (last Cs') has least F:T via Cs; P \<turnstile> T casts v to v';
     Ds = Cs'@\<^sub>pCs; (Ds,fs) \<in> S \<rbrakk> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* 
         \<langle>Val v',(h\<^sub>2(a\<mapsto>(D,insert (Ds,fs(F\<mapsto>v')) (S - {(Ds,fs)}))),l\<^sub>2)\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule FAssReds1)
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAssReds2)
 apply(fastforce intro:RedFAss)
 done
 
 
 lemma FAssRedsNull:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>null,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Val v,s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>THROW NullPointer, s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule FAssReds1)
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAssReds2)
 apply(simp add:RedFAssNull)
 done
 
 
 lemma FAssRedsThrow1:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs}:=e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>Throw r, s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAssReds1)
 apply(simp add:red_reds.FAssThrow1)
 done
 
 
 lemma FAssRedsThrow2:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule FAssReds1)
 apply(rule rtrancl_into_rtrancl)
  apply(erule FAssReds2)
 apply(simp add:red_reds.FAssThrow2)
 done
 
 
 subsection \<open>;;\<close>
 
 lemma  SeqReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e;;e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>e';;e\<^sub>2, s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:SeqRed)
 done
 
 
 lemma SeqRedsThrow:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e;;e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>Throw r, s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule SeqReds)
 apply(simp add:red_reds.SeqThrow)
 done
 
 
 lemma SeqReds2:
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<rightarrow>* \<langle>e\<^sub>2',s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1;;e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>e\<^sub>2',s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule SeqReds)
 apply(rule_tac b="(e\<^sub>2,s\<^sub>1)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedSeq)
 apply assumption
 done
 
 
 
 subsection \<open>If\<close>
 
 lemma CondReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<rangle> \<rightarrow>* \<langle>if (e') e\<^sub>1 else e\<^sub>2,s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:CondRed)
 done
 
 
 lemma CondRedsThrow:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2, s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule CondReds)
 apply(simp add:red_reds.CondThrow)
 done
 
 
 lemma CondReds2T:
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>1, s\<^sub>1\<rangle> \<rightarrow>* \<langle>e',s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>e',s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule CondReds)
 apply(rule_tac b="(e\<^sub>1, s\<^sub>1)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedCondT)
 apply assumption
 done
 
 
 lemma CondReds2F:
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>false,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2, s\<^sub>1\<rangle> \<rightarrow>* \<langle>e',s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2, s\<^sub>0\<rangle> \<rightarrow>* \<langle>e',s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule CondReds)
 apply(rule_tac b="(e\<^sub>2, s\<^sub>1)" in  converse_rtrancl_into_rtrancl)
  apply(simp add:RedCondF)
 apply assumption
 done
 
 
 
 subsection \<open>While\<close>
 
 lemma WhileFReds:
   "P,E \<turnstile> \<langle>b,s\<rangle> \<rightarrow>* \<langle>false,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>while (b) c,s\<rangle> \<rightarrow>* \<langle>unit,s'\<rangle>"
 
 apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedWhile)
 apply(rule rtrancl_into_rtrancl)
  apply(erule CondReds)
 apply(simp add:RedCondF)
 done
 
 
 lemma WhileRedsThrow:
   "P,E \<turnstile> \<langle>b,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>while (b) c,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedWhile)
 apply(rule rtrancl_into_rtrancl)
  apply(erule CondReds)
 apply(simp add:red_reds.CondThrow)
 done
 
 
 lemma WhileTReds:
   "\<lbrakk> P,E \<turnstile> \<langle>b,s\<^sub>0\<rangle> \<rightarrow>* \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Val v\<^sub>1,s\<^sub>2\<rangle>; P,E \<turnstile> \<langle>while (b) c,s\<^sub>2\<rangle> \<rightarrow>* \<langle>e,s\<^sub>3\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>while (b) c,s\<^sub>0\<rangle> \<rightarrow>* \<langle>e,s\<^sub>3\<rangle>"
 
 apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s\<^sub>0)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedWhile)
 apply(rule rtrancl_trans)
  apply(erule CondReds)
 apply(rule_tac b="(c;;while(b) c,s\<^sub>1)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedCondT)
 apply(rule rtrancl_trans)
  apply(erule SeqReds)
 apply(rule_tac b="(while(b) c,s\<^sub>2)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedSeq)
 apply assumption
 done
 
 
 lemma WhileTRedsThrow:
   "\<lbrakk> P,E \<turnstile> \<langle>b,s\<^sub>0\<rangle> \<rightarrow>* \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>while (b) c,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw r,s\<^sub>2\<rangle>"
 
 apply(rule_tac b="(if(b) (c;;while(b) c) else unit, s\<^sub>0)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedWhile)
 apply(rule rtrancl_trans)
  apply(erule CondReds)
 apply(rule_tac b="(c;;while(b) c,s\<^sub>1)" in converse_rtrancl_into_rtrancl)
  apply(simp add:RedCondT)
 apply(rule rtrancl_trans)
  apply(erule SeqReds)
 apply(rule_tac b="(Throw r,s\<^sub>2)" in converse_rtrancl_into_rtrancl)
  apply(simp add:red_reds.SeqThrow)
 apply simp
 done
 
 
 subsection \<open>Throw\<close>
 
 lemma ThrowReds:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>throw e,s\<rangle> \<rightarrow>* \<langle>throw e',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:ThrowRed)
 done
 
 
 lemma ThrowRedsNull:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>null,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>throw e,s\<rangle> \<rightarrow>* \<langle>THROW NullPointer,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule ThrowReds)
 apply(simp add:RedThrowNull)
 done
 
 
 lemma ThrowRedsThrow:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>throw e,s\<rangle> \<rightarrow>* \<langle>Throw r,s'\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule ThrowReds)
 apply(simp add:red_reds.ThrowThrow)
 done
 
 
 subsection \<open>InitBlock\<close>
 
 lemma assumes wf:"wf_prog wf_md P"
 shows InitBlockReds_aux:
 "P,E(V \<mapsto> T) \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow>
   \<forall>h l h' l' v v'. s = (h,l(V\<mapsto>v')) \<longrightarrow> 
                    P \<turnstile> T casts v to v' \<longrightarrow> s' = (h',l') \<longrightarrow>
                    (\<exists>v'' w. P,E \<turnstile> \<langle>{V:T := Val v; e},(h,l)\<rangle> \<rightarrow>* 
                                 \<langle>{V:T := Val v''; e'},(h',l'(V:=(l V)))\<rangle> \<and>
                             P \<turnstile> T casts v'' to w)"
 proof (erule converse_rtrancl_induct2)
   { fix h l h' l' v v'
     assume "s' = (h, l(V \<mapsto> v'))" and "s' = (h', l')"
     hence h:"h = h'" and l':"l' = l(V \<mapsto> v')" by simp_all
     hence "P,E \<turnstile> \<langle>{V:T; V:=Val v;; e'},(h, l)\<rangle> \<rightarrow>*
                  \<langle>{V:T; V:=Val v;; e'},(h', l'(V := l V))\<rangle>"
       by(fastforce simp: fun_upd_same simp del:fun_upd_apply) }
   hence "\<forall>h l h' l' v v'.
          s' = (h, l(V \<mapsto> v')) \<longrightarrow>
            P \<turnstile> T casts v to v'  \<longrightarrow>
              s' = (h', l') \<longrightarrow>
                P,E \<turnstile> \<langle>{V:T; V:=Val v;; e'},(h, l)\<rangle> \<rightarrow>*
                      \<langle>{V:T; V:=Val v;; e'},(h', l'(V := l V))\<rangle> \<and>
                P \<turnstile> T casts v to v'"
     by auto
   thus "\<forall>h l h' l' v v'.
        s' = (h, l(V \<mapsto> v')) \<longrightarrow>
          P \<turnstile> T casts v to v'  \<longrightarrow>
            s' = (h', l') \<longrightarrow>
              (\<exists>v'' w. P,E \<turnstile> \<langle>{V:T; V:=Val v;; e'},(h, l)\<rangle> \<rightarrow>*
                             \<langle>{V:T; V:=Val v'';; e'},(h', l'(V := l V))\<rangle> \<and>
                       P \<turnstile> T casts v'' to w)"
     by auto
 next
   fix e s e'' s''
   assume Red:"((e,s),e'',s'') \<in> Red P (E(V \<mapsto> T))"
     and reds:"P,E(V \<mapsto> T) \<turnstile> \<langle>e'',s''\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
     and IH:"\<forall>h l h' l' v v'.
            s'' = (h, l(V \<mapsto> v')) \<longrightarrow>
              P \<turnstile> T casts v to v'  \<longrightarrow>
                s' = (h', l') \<longrightarrow>
                  (\<exists>v'' w. P,E \<turnstile> \<langle>{V:T; V:=Val v;; e''},(h, l)\<rangle> \<rightarrow>*
                                 \<langle>{V:T; V:=Val v'';; e'},(h', l'(V := l V))\<rangle> \<and>
                           P \<turnstile> T casts v'' to w)"
   { fix h l h' l' v v'
     assume s:"s = (h, l(V \<mapsto> v'))" and s':"s' = (h', l')"
       and casts:"P \<turnstile> T casts v to v'"
     obtain h'' l'' where s'':"s'' = (h'',l'')" by (cases s'') auto
     with Red s have "V \<in> dom l''" by (fastforce dest:red_lcl_incr)
     then obtain v'' where l'':"l'' V = Some v''" by auto
     with Red s s'' casts
     have step:"P,E \<turnstile> \<langle>{V:T := Val v; e},(h, l)\<rangle> \<rightarrow>  
               \<langle>{V:T := Val v''; e''}, (h'',l''(V := l V))\<rangle>"
       by(fastforce intro:InitBlockRed)
     from Red s s'' l'' casts wf
     have casts':"P \<turnstile> T casts v'' to v''" by(fastforce intro:Some_lcl_casts_values)
     with IH s'' s' l'' obtain v''' w
       where "P,E \<turnstile> \<langle>{V:T := Val v''; e''}, (h'',l''(V := l V))\<rangle> \<rightarrow>*
                    \<langle>{V:T := Val v'''; e'},(h', l'(V := l V))\<rangle> \<and>
              P \<turnstile> T casts v''' to w"
       apply simp
       apply (erule_tac x = "l''(V := l V)" in allE)
       apply (erule_tac x = "v''" in allE)
       apply (erule_tac x = "v''" in allE)
       by(auto intro:ext)
     with step have "\<exists>v'' w. P,E \<turnstile> \<langle>{V:T; V:=Val v;; e},(h, l)\<rangle> \<rightarrow>*
                                    \<langle>{V:T; V:=Val v'';; e'},(h', l'(V := l V))\<rangle> \<and>
                             P \<turnstile> T casts v'' to w"
       apply(rule_tac x="v'''" in exI)
       apply auto
        apply (rule converse_rtrancl_into_rtrancl)
       by simp_all }
   thus "\<forall>h l h' l' v v'.
              s = (h, l(V \<mapsto> v')) \<longrightarrow>
              P \<turnstile> T casts v to v'  \<longrightarrow>
              s' = (h', l') \<longrightarrow>
              (\<exists>v'' w. P,E \<turnstile> \<langle>{V:T; V:=Val v;; e},(h, l)\<rangle> \<rightarrow>*
                             \<langle>{V:T; V:=Val v'';; e'},(h', l'(V := l V))\<rangle> \<and>
                       P \<turnstile> T casts v'' to w)"
     by auto
 qed
 
 
 
 lemma InitBlockReds:
  "\<lbrakk>P,E(V \<mapsto> T) \<turnstile> \<langle>e, (h,l(V\<mapsto>v'))\<rangle> \<rightarrow>* \<langle>e', (h',l')\<rangle>; 
    P \<turnstile> T casts v to v'; wf_prog wf_md P \<rbrakk> \<Longrightarrow>
   \<exists>v'' w. P,E \<turnstile> \<langle>{V:T := Val v; e}, (h,l)\<rangle> \<rightarrow>* 
               \<langle>{V:T := Val v''; e'}, (h',l'(V:=(l V)))\<rangle> \<and>
           P \<turnstile> T casts v'' to w"
 by(blast dest:InitBlockReds_aux)
 
 lemma InitBlockRedsFinal:
   assumes reds:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h,l(V\<mapsto>v'))\<rangle> \<rightarrow>* \<langle>e',(h',l')\<rangle>"
   and final:"final e'" and casts:"P \<turnstile> T casts v to v'"
   and wf:"wf_prog wf_md P"
   shows "P,E \<turnstile> \<langle>{V:T := Val v; e},(h,l)\<rangle> \<rightarrow>* \<langle>e',(h', l'(V := l V))\<rangle>"
 proof -
   from reds casts wf obtain v'' and w
     where steps:"P,E \<turnstile> \<langle>{V:T := Val v; e},(h,l)\<rangle> \<rightarrow>* 
                         \<langle>{V:T := Val v''; e'}, (h',l'(V:=(l V)))\<rangle>"
     and casts':"P \<turnstile> T casts v'' to w"
     by (auto dest:InitBlockReds)
   from final casts casts'
   have step:"P,E \<turnstile> \<langle>{V:T := Val v''; e'}, (h',l'(V:=(l V)))\<rangle> \<rightarrow>
                     \<langle>e',(h',l'(V := l V))\<rangle>"
     by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
   from step steps show ?thesis
     by(fastforce intro:rtrancl_into_rtrancl)
 qed
 
 
 
 subsection \<open>Block\<close>
 
 lemma BlockRedsFinal:
 assumes reds: "P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2,l\<^sub>2)\<rangle>" and fin: "final e\<^sub>2"
   and wf:"wf_prog wf_md P"
 shows "\<And>h\<^sub>0 l\<^sub>0. s\<^sub>0 = (h\<^sub>0,l\<^sub>0(V:=None)) \<Longrightarrow> P,E \<turnstile> \<langle>{V:T; e\<^sub>0},(h\<^sub>0,l\<^sub>0)\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2,l\<^sub>2(V:=l\<^sub>0 V))\<rangle>"
 
 using reds
 proof (induct rule:converse_rtrancl_induct2)
   case refl thus ?case
     by(fastforce intro:finalE[OF fin] RedBlock BlockThrow
                 simp del:fun_upd_apply)
 next
   case (step e\<^sub>0 s\<^sub>0 e\<^sub>1 s\<^sub>1)
   have Red: "((e\<^sub>0,s\<^sub>0),e\<^sub>1,s\<^sub>1) \<in> Red P (E(V \<mapsto> T))"
    and reds: "P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2,l\<^sub>2)\<rangle>"
    and IH: "\<And>h l. s\<^sub>1 = (h,l(V := None))
                 \<Longrightarrow> P,E \<turnstile> \<langle>{V:T; e\<^sub>1},(h,l)\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2, l\<^sub>2(V := l V))\<rangle>"
    and s\<^sub>0: "s\<^sub>0 = (h\<^sub>0, l\<^sub>0(V := None))" by fact+
   obtain h\<^sub>1 l\<^sub>1 where s\<^sub>1: "s\<^sub>1 = (h\<^sub>1,l\<^sub>1)" by fastforce
   show ?case
   proof cases
     assume "assigned V e\<^sub>0"
     then obtain v e where e\<^sub>0: "e\<^sub>0 = V:= Val v;; e"
       by (unfold assigned_def)blast
     from Red e\<^sub>0 s\<^sub>0 obtain v' where e\<^sub>1: "e\<^sub>1 = Val v';;e" 
       and s\<^sub>1: "s\<^sub>1 = (h\<^sub>0, l\<^sub>0(V \<mapsto> v'))" and casts:"P \<turnstile> T casts v to v'"
       by auto
     from e\<^sub>1 fin have "e\<^sub>1 \<noteq> e\<^sub>2" by (auto simp:final_def)
     then obtain e' s' where red1: "P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
       and reds': "P,E(V \<mapsto> T) \<turnstile> \<langle>e',s'\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2,l\<^sub>2)\<rangle>"
       using converse_rtranclE2[OF reds] by simp blast
     from red1 e\<^sub>1 have es': "e' = e" "s' = s\<^sub>1" by auto
     show ?thesis using e\<^sub>0 s\<^sub>1 es' reds'
         by(fastforce intro!: InitBlockRedsFinal[OF _ fin casts wf] 
                     simp del:fun_upd_apply)
   next
     assume unass: "\<not> assigned V e\<^sub>0"
     show ?thesis
     proof (cases "l\<^sub>1 V")
       assume None: "l\<^sub>1 V = None"
       hence "P,E \<turnstile> \<langle>{V:T; e\<^sub>0},(h\<^sub>0,l\<^sub>0)\<rangle> \<rightarrow> \<langle>{V:T; e\<^sub>1},(h\<^sub>1, l\<^sub>1(V := l\<^sub>0 V))\<rangle>"
         using s\<^sub>0 s\<^sub>1 Red by(simp add: BlockRedNone[OF _ _ unass])
       moreover
       have "P,E \<turnstile> \<langle>{V:T; e\<^sub>1},(h\<^sub>1, l\<^sub>1(V := l\<^sub>0 V))\<rangle> \<rightarrow>* \<langle>e\<^sub>2,(h\<^sub>2, l\<^sub>2(V := l\<^sub>0 V))\<rangle>"
         using IH[of _ "l\<^sub>1(V := l\<^sub>0 V)"] s\<^sub>1 None by(simp add:fun_upd_idem)
       ultimately show ?case
         by(rule_tac b="({V:T; e\<^sub>1},(h\<^sub>1, l\<^sub>1(V := l\<^sub>0 V)))" in converse_rtrancl_into_rtrancl,simp)
     next
       fix v assume Some: "l\<^sub>1 V = Some v"
       with Red Some s\<^sub>0 s\<^sub>1 wf
       have casts:"P \<turnstile> T casts v to v"
         by(fastforce intro:None_lcl_casts_values)
       from Some
       have "P,E \<turnstile> \<langle>{V:T;e\<^sub>0},(h\<^sub>0,l\<^sub>0)\<rangle> \<rightarrow> \<langle>{V:T := Val v; e\<^sub>1},(h\<^sub>1,l\<^sub>1(V := l\<^sub>0 V))\<rangle>"
         using s\<^sub>0 s\<^sub>1 Red by(simp add: BlockRedSome[OF _ _ unass])
       moreover
       have "P,E \<turnstile> \<langle>{V:T := Val v; e\<^sub>1},(h\<^sub>1,l\<^sub>1(V:= l\<^sub>0 V))\<rangle> \<rightarrow>*
                 \<langle>e\<^sub>2,(h\<^sub>2,l\<^sub>2(V:=l\<^sub>0 V))\<rangle>"
         using InitBlockRedsFinal[OF _ fin casts wf,of _ _ "l\<^sub>1(V:=l\<^sub>0 V)" V] 
           Some reds s\<^sub>1
         by (simp add:fun_upd_idem)
       ultimately show ?case 
         by(rule_tac b="({V:T; V:=Val v;; e\<^sub>1},(h\<^sub>1, l\<^sub>1(V := l\<^sub>0 V)))" in converse_rtrancl_into_rtrancl,simp)
     qed
   qed
 qed
 
 
 
 
 subsection \<open>List\<close>
 
 lemma ListReds1:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e#es,s\<rangle> [\<rightarrow>]* \<langle>e' # es,s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:ListRed1)
 done
 
 
 lemma ListReds2:
   "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>Val v # es,s\<rangle> [\<rightarrow>]* \<langle>Val v # es',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:ListRed2)
 done
 
 
 lemma ListRedsVal:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>es',s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e#es,s\<^sub>0\<rangle> [\<rightarrow>]* \<langle>Val v # es',s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule ListReds1)
 apply(erule ListReds2)
 done
 
 
 subsection \<open>Call\<close>
 
 text\<open>First a few lemmas on what happens to free variables during redction.\<close>
 
 
 lemma assumes wf: "wwf_prog P"
 shows Red_fv: "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> fv e' \<subseteq> fv e"
   and  "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> fvs es' \<subseteq> fvs es"
 proof (induct rule:red_reds_inducts)
   case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs bs new_body E)
   hence "fv body \<subseteq> {this} \<union> set pns"
     using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
   with RedCall.hyps show ?case
     by(cases T') auto
 next
   case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a a' b)
   hence "fv body \<subseteq> {this} \<union> set pns"
     using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
   with RedStaticCall.hyps show ?case
     by auto
 qed auto
 
 
 
 lemma Red_dom_lcl:
   "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> dom l' \<subseteq> dom l \<union> fv e" and
   "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> dom l' \<subseteq> dom l \<union> fvs es"
 
 proof (induct rule:red_reds_inducts)
   case RedLAss thus ?case by(force split:if_splits)
 next
   case CallParams thus ?case by(force split:if_splits)
 next
   case BlockRedNone thus ?case by clarsimp (fastforce split:if_splits)
 next
   case BlockRedSome thus ?case by clarsimp (fastforce split:if_splits)
 next
   case InitBlockRed thus ?case by clarsimp (fastforce split:if_splits)
 qed auto
 
 
 
 lemma Reds_dom_lcl:
   "\<lbrakk> wwf_prog P; P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow>* \<langle>e',(h',l')\<rangle> \<rbrakk> \<Longrightarrow> dom l' \<subseteq> dom l \<union> fv e"
 
 apply(erule converse_rtrancl_induct_red)
  apply blast
 apply(blast dest: Red_fv Red_dom_lcl)
 done
 
 
 text\<open>Now a few lemmas on the behaviour of blocks during reduction.\<close>
 
 
 lemma override_on_upd_lemma:
   "(override_on f (g(a\<mapsto>b)) A)(a := g a) = override_on f g (insert a A)"
 
 apply(rule ext)
 apply(simp add:override_on_def)
 done
 
 declare fun_upd_apply[simp del] map_upds_twist[simp del]
 
 
 
 
 lemma assumes wf:"wf_prog wf_md P"
   shows blocksReds:
   "\<And>l\<^sub>0 E vs'. \<lbrakk> length Vs = length Ts; length vs = length Ts; 
         distinct Vs; \<^cancel>\<open>\<forall>T\<in>set Ts. is_type P T;\<close> P \<turnstile> Ts Casts vs to vs';
         P,E(Vs [\<mapsto>] Ts) \<turnstile> \<langle>e, (h\<^sub>0,l\<^sub>0(Vs [\<mapsto>] vs'))\<rangle> \<rightarrow>* \<langle>e', (h\<^sub>1,l\<^sub>1)\<rangle> \<rbrakk>
   \<Longrightarrow> \<exists>vs''. P,E \<turnstile> \<langle>blocks(Vs,Ts,vs,e), (h\<^sub>0,l\<^sub>0)\<rangle> \<rightarrow>* 
                    \<langle>blocks(Vs,Ts,vs'',e'), (h\<^sub>1,override_on l\<^sub>1 l\<^sub>0 (set Vs))\<rangle> \<and> 
              (\<exists>ws. P \<turnstile> Ts Casts vs'' to ws) \<and> length vs = length vs''"
 
 proof(induct Vs Ts vs e rule:blocks_old_induct)
   case (5 V Vs T Ts v vs e)
   have length1:"length (V#Vs) = length (T#Ts)"
     and length2:"length (v#vs) = length (T#Ts)"
     and dist:"distinct (V#Vs)"
     and casts:"P \<turnstile> (T#Ts) Casts (v#vs) to vs'"
     and reds:"P,E(V#Vs [\<mapsto>] T#Ts) \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0(V#Vs [\<mapsto>] vs'))\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>1,l\<^sub>1)\<rangle>"
     and IH:"\<And>l\<^sub>0 E vs''. \<lbrakk>length Vs = length Ts; length vs = length Ts; 
        distinct Vs; P \<turnstile> Ts Casts vs to vs'';
        P,E(Vs [\<mapsto>] Ts) \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0(Vs [\<mapsto>] vs''))\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>1,l\<^sub>1)\<rangle>\<rbrakk>
         \<Longrightarrow> \<exists>vs''. P,E \<turnstile> \<langle>blocks (Vs,Ts,vs,e),(h\<^sub>0,l\<^sub>0)\<rangle> \<rightarrow>*
                          \<langle>blocks (Vs,Ts,vs'',e'),(h\<^sub>1, override_on l\<^sub>1 l\<^sub>0 (set Vs))\<rangle> \<and>
                    (\<exists>ws. P \<turnstile> Ts Casts vs'' to ws) \<and> length vs = length vs''" by fact+
   from length1 have length1':"length Vs = length Ts" by simp
   from length2 have length2':"length vs = length Ts" by simp
   from dist have dist':"distinct Vs" by simp
   from casts obtain x xs where vs':"vs' = x#xs"
     by(cases vs',auto dest:length_Casts_vs')
   with reds
-  have reds':"P,E(V \<mapsto> T)(Vs [\<mapsto>] Ts) \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0(V \<mapsto> x)(Vs [\<mapsto>] xs))\<rangle> 
+  have reds':"P,E(V \<mapsto> T, Vs [\<mapsto>] Ts) \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0(V \<mapsto> x, Vs [\<mapsto>] xs))\<rangle> 
                                     \<rightarrow>* \<langle>e',(h\<^sub>1,l\<^sub>1)\<rangle>"
     by simp
   from casts vs' have casts':"P \<turnstile> Ts Casts vs to xs" 
     and cast':"P \<turnstile> T casts v to x"
     by(auto elim:Casts_to.cases)
   from IH[OF length1' length2' dist' casts' reds']
   obtain vs'' ws
     where blocks:"P,E(V \<mapsto> T) \<turnstile> \<langle>blocks (Vs, Ts, vs, e),(h\<^sub>0, l\<^sub>0(V \<mapsto> x))\<rangle> \<rightarrow>*
              \<langle>blocks (Vs, Ts, vs'', e'),(h\<^sub>1, override_on l\<^sub>1 (l\<^sub>0(V \<mapsto> x)) (set Vs))\<rangle>"
     and castsws:"P \<turnstile> Ts Casts vs'' to ws"
     and lengthvs'':"length vs = length vs''" by auto
   from InitBlockReds[OF blocks cast' wf] obtain v'' w where
     blocks':"P,E \<turnstile> \<langle>{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h\<^sub>0, l\<^sub>0)\<rangle> \<rightarrow>*
                    \<langle>{V:T; V:=Val v'';; blocks (Vs, Ts, vs'', e')},
                     (h\<^sub>1, (override_on l\<^sub>1 (l\<^sub>0(V \<mapsto> x)) (set Vs))(V := l\<^sub>0 V))\<rangle>"
     and "P \<turnstile> T casts v'' to w" by auto
   with castsws have "P \<turnstile> T#Ts Casts v''#vs'' to w#ws"
     by -(rule Casts_Cons)
   with blocks' lengthvs'' show ?case
     by(rule_tac x="v''#vs''" in exI,auto simp:override_on_upd_lemma)
 next
   case (6 e)
   have casts:"P \<turnstile> [] Casts [] to vs'" 
     and step:"P,E([] [\<mapsto>] []) \<turnstile> \<langle>e,(h\<^sub>0, l\<^sub>0([] [\<mapsto>] vs'))\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>1, l\<^sub>1)\<rangle>" by fact+
   from casts have "vs' = []" by(fastforce dest:length_Casts_vs')
   with step have "P,E \<turnstile> \<langle>e,(h\<^sub>0, l\<^sub>0)\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>1, l\<^sub>1)\<rangle>" by simp
   with casts show ?case by auto
 qed simp_all
 
 
 
 lemma assumes wf:"wf_prog wf_md P"
   shows blocksFinal:
  "\<And>E l vs'. \<lbrakk> length Vs = length Ts; length vs = length Ts;
            \<^cancel>\<open>\<forall>T\<in>set Ts. is_type P T;\<close> final e; P \<turnstile> Ts Casts vs to vs' \<rbrakk> \<Longrightarrow>
        P,E \<turnstile> \<langle>blocks(Vs,Ts,vs,e), (h,l)\<rangle> \<rightarrow>* \<langle>e, (h,l)\<rangle>"
 
 proof(induct Vs Ts vs e rule:blocks_old_induct)
   case (5 V Vs T Ts v vs e)
   have length1:"length (V # Vs) = length (T # Ts)"
     and length2:"length (v # vs) = length (T # Ts)"
     and final:"final e" and casts:"P \<turnstile> T # Ts Casts v # vs to vs'"
     and IH:"\<And>E l vs'. \<lbrakk>length Vs = length Ts; length vs = length Ts; final e;
                    P \<turnstile> Ts Casts vs to vs' \<rbrakk>
                   \<Longrightarrow> P,E \<turnstile> \<langle>blocks (Vs, Ts, vs, e),(h, l)\<rangle> \<rightarrow>* \<langle>e,(h, l)\<rangle>" by fact+
   from length1 length2
   have length1':"length Vs = length Ts" and length2':"length vs = length Ts"
     by simp_all
   from casts obtain x xs where vs':"vs' = x#xs"
     by(cases vs',auto dest:length_Casts_vs')
   with casts have casts':"P \<turnstile> Ts Casts vs to xs" 
     and cast':"P \<turnstile> T casts v to x"
     by(auto elim:Casts_to.cases)
   from InitBlockReds[OF IH[OF length1' length2' final casts'] cast' wf, of V l]
   obtain v'' w
     where blocks:"P,E \<turnstile> \<langle>{V:T; V:=Val v;; blocks (Vs, Ts, vs, e)},(h, l)\<rangle> \<rightarrow>*
                         \<langle>{V:T; V:=Val v'';; e},(h,l)\<rangle>"
     and "P \<turnstile> T casts v'' to w" by auto blast
   with final have "P,E \<turnstile> \<langle>{V:T; V:=Val v'';; e},(h,l)\<rangle> \<rightarrow> \<langle>e,(h,l)\<rangle>"
     by(auto elim!:finalE intro:RedInitBlock InitBlockThrow)
   with blocks show ?case
     by -(rule_tac b="({V:T; V:=Val v'';; e},(h, l))" in rtrancl_into_rtrancl,simp_all)
 qed auto
 
 
 
 lemma assumes wfmd:"wf_prog wf_md P"
   and wf: "length Vs = length Ts" "length vs = length Ts" "distinct Vs" 
   and casts:"P \<turnstile> Ts Casts vs to vs'"
   and reds: "P,E(Vs [\<mapsto>] Ts) \<turnstile> \<langle>e, (h\<^sub>0, l\<^sub>0(Vs [\<mapsto>] vs'))\<rangle> \<rightarrow>* \<langle>e', (h\<^sub>1, l\<^sub>1)\<rangle>"
   and fin: "final e'" and l2: "l\<^sub>2 = override_on l\<^sub>1 l\<^sub>0 (set Vs)"
 shows blocksRedsFinal: "P,E \<turnstile> \<langle>blocks(Vs,Ts,vs,e), (h\<^sub>0, l\<^sub>0)\<rangle> \<rightarrow>* \<langle>e', (h\<^sub>1,l\<^sub>2)\<rangle>"
 
 proof -
   obtain vs'' ws where blocks:"P,E \<turnstile> \<langle>blocks(Vs,Ts,vs,e), (h\<^sub>0, l\<^sub>0)\<rangle> \<rightarrow>* 
                                   \<langle>blocks(Vs,Ts,vs'',e'), (h\<^sub>1,l\<^sub>2)\<rangle>"
     and length:"length vs = length vs''"
     and casts':"P \<turnstile> Ts Casts vs'' to ws"
     using l2 blocksReds[OF wfmd wf casts reds]
      by auto
    have "P,E \<turnstile> \<langle>blocks(Vs,Ts,vs'',e'), (h\<^sub>1,l\<^sub>2)\<rangle> \<rightarrow>* \<langle>e', (h\<^sub>1,l\<^sub>2)\<rangle>"
      using blocksFinal[OF wfmd _ _ fin casts'] wf length by simp
    with blocks show ?thesis by simp
 qed
 
 
 
 
 text\<open>An now the actual method call reduction lemmas.\<close>
 
 lemma CallRedsObj:
  "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> 
   P,E \<turnstile> \<langle>Call e Copt M es,s\<rangle> \<rightarrow>* \<langle>Call e' Copt M es,s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:CallObj)
 done
 
 
 lemma CallRedsParams:
  "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle> \<Longrightarrow> 
   P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<rightarrow>* \<langle>Call (Val v) Copt M es',s'\<rangle>"
 
 apply(erule rtrancl_induct2)
  apply blast
 apply(erule rtrancl_into_rtrancl)
 apply(simp add:CallParams)
 done
 
 
 
 
 lemma cast_lcl:
   "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>Val v',(h,l)\<rangle> \<Longrightarrow>
    P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l')\<rangle> \<rightarrow> \<langle>Val v',(h,l')\<rangle>"
 
 apply(erule red.cases)
 apply(auto intro:red_reds.intros)
 apply(subgoal_tac "P,E \<turnstile> \<langle>\<lparr>C\<rparr>ref (a,Cs@[C]@Cs'),(h,l')\<rangle> \<rightarrow> \<langle>ref (a,Cs@[C]),(h,l')\<rangle>")
  apply simp
 apply(rule RedStaticDownCast)
 done
 
 
 lemma cast_env:
   "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>Val v',(h,l)\<rangle> \<Longrightarrow> 
    P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>Val v',(h,l)\<rangle>"
 
 apply(erule red.cases)
 apply(auto intro:red_reds.intros)
 apply(subgoal_tac "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>ref (a,Cs@[C]@Cs'),(h,l)\<rangle> \<rightarrow> \<langle>ref (a,Cs@[C]),(h,l)\<rangle>")
  apply simp
 apply(rule RedStaticDownCast)
 done
 
 
 lemma Cast_step_Cast_or_fin:
 "P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> final e' \<or> (\<exists>e''. e' = \<lparr>C\<rparr>e'')"
 by(induct rule:rtrancl_induct2,auto elim:red.cases simp:final_def)
 
 lemma Cast_red:"P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<Longrightarrow> 
   (\<And>e\<^sub>1. \<lbrakk>e = \<lparr>C\<rparr>e\<^sub>0; e' = \<lparr>C\<rparr>e\<^sub>1\<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>0,s\<rangle> \<rightarrow>* \<langle>e\<^sub>1,s'\<rangle>)"
 
 proof(induct rule:rtrancl_induct2)
   case refl thus ?case by simp
 next
   case (step e'' s'' e' s')
   have step:"P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e'',s''\<rangle>"
     and Red:"((e'', s''), e', s') \<in> Red P E"
     and cast:"e = \<lparr>C\<rparr>e\<^sub>0" and cast':"e' = \<lparr>C\<rparr>e\<^sub>1"
     and IH:"\<And>e\<^sub>1. \<lbrakk>e = \<lparr>C\<rparr>e\<^sub>0; e'' = \<lparr>C\<rparr>e\<^sub>1\<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>0,s\<rangle> \<rightarrow>* \<langle>e\<^sub>1,s''\<rangle>" by fact+
   from Red have red:"P,E \<turnstile> \<langle>e'',s''\<rangle> \<rightarrow> \<langle>e',s'\<rangle>" by simp
   from step cast have "final e'' \<or> (\<exists>ex. e'' = \<lparr>C\<rparr>ex)"
     by simp(rule Cast_step_Cast_or_fin)
   thus ?case
   proof(rule disjE)
     assume "final e''"
     with red show ?thesis by(auto simp:final_def)
   next
     assume "\<exists>ex. e'' = \<lparr>C\<rparr>ex"
     then obtain ex where e'':"e'' = \<lparr>C\<rparr>ex" by blast
     with cast' red have "P,E \<turnstile> \<langle>ex,s''\<rangle> \<rightarrow> \<langle>e\<^sub>1,s'\<rangle>"
       by(auto elim:red.cases)
     with  IH[OF cast e''] show ?thesis
       by(rule_tac b="(ex,s'')" in rtrancl_into_rtrancl,simp_all)
   qed
 qed
 
 
 lemma Cast_final:"\<lbrakk>P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>; final e'\<rbrakk> \<Longrightarrow>
 \<exists>e'' s''. P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e'',s''\<rangle> \<and> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e'',s''\<rangle> \<rightarrow> \<langle>e',s'\<rangle> \<and> final e''"
 
 proof(induct rule:rtrancl_induct2)
   case refl thus ?case by (simp add:final_def)
 next
   case (step e'' s'' e' s')
   have step:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<rangle> \<rightarrow>* \<langle>e'',s''\<rangle>"
     and Red:"((e'', s''), e', s') \<in> Red P E"
     and final:"final e'"
     and IH:"final e'' \<Longrightarrow> 
    \<exists>ex sx. P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ex,sx\<rangle> \<and> P,E \<turnstile> \<langle>\<lparr>C\<rparr>ex,sx\<rangle> \<rightarrow> \<langle>e'',s''\<rangle> \<and> final ex" by fact+
   from Red have red:"P,E \<turnstile> \<langle>e'',s''\<rangle> \<rightarrow> \<langle>e',s'\<rangle>" by simp
   from step have "final e'' \<or> (\<exists>ex. e'' = \<lparr>C\<rparr>ex)" by(rule Cast_step_Cast_or_fin)
   thus ?case
   proof(rule disjE)
     assume "final e''"
     with red show ?thesis by(auto simp:final_def)
   next
     assume "\<exists>ex. e'' = \<lparr>C\<rparr>ex"
     then obtain ex where e'':"e'' = \<lparr>C\<rparr>ex" by blast
     with red final have final':"final ex"
       by(auto elim:red.cases simp:final_def)
     from step e'' have "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>ex,s''\<rangle>"
       by(fastforce intro:Cast_red)
     with e'' red final' show ?thesis by blast
   qed
 qed
 
 
 lemma Cast_final_eq:
   assumes red:"P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h,l)\<rangle>"
   and final:"final e" and final':"final e'"
   shows "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>e,(h,l')\<rangle> \<rightarrow> \<langle>e',(h,l')\<rangle>"
 
 proof -
   from red final show ?thesis
   proof(auto simp:final_def)
     fix v assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>e',(h,l)\<rangle>"
     with final' show "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l')\<rangle> \<rightarrow> \<langle>e',(h,l')\<rangle>"
     proof(auto simp:final_def)
       fix v' assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>Val v',(h,l)\<rangle>"
       thus "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l')\<rangle> \<rightarrow> \<langle>Val v',(h,l')\<rangle>"
         by(auto intro:cast_lcl cast_env)
     next
       fix a Cs assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l)\<rangle> \<rightarrow> \<langle>Throw (a,Cs),(h,l)\<rangle>"
       thus "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Val v),(h,l')\<rangle> \<rightarrow> \<langle>Throw (a,Cs),(h,l')\<rangle>"
         by(auto elim:red.cases intro!:RedStaticCastFail)
     qed
   next
     fix a Cs assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l)\<rangle> \<rightarrow> \<langle>e',(h,l)\<rangle>"
     with final' show "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l')\<rangle> \<rightarrow> \<langle>e',(h,l')\<rangle>"
     proof(auto simp:final_def)
       fix v assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l)\<rangle> \<rightarrow> \<langle>Val v,(h,l)\<rangle>"
       thus "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l')\<rangle> \<rightarrow> \<langle>Val v,(h,l')\<rangle>"
         by(auto elim:red.cases)
     next
       fix a' Cs'
       assume "P,E \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l)\<rangle> \<rightarrow> \<langle>Throw (a',Cs'),(h,l)\<rangle>"
       thus "P,E' \<turnstile> \<langle>\<lparr>C\<rparr>(Throw (a,Cs)),(h,l')\<rangle> \<rightarrow> \<langle>Throw (a',Cs'),(h,l')\<rangle>"
         by(auto elim:red.cases intro:red_reds.StaticCastThrow)
     qed
   qed
 qed
 
 
 
 lemma CallRedsFinal:
 assumes wwf: "wwf_prog P"
 and "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
       "P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
 and hp: "h\<^sub>2 a = Some(C,S)"
 and "method": "P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
 and select: "P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
 and size: "size vs = size pns"
 and casts: "P \<turnstile> Ts Casts vs to vs'"
 and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref(a,Cs'), pns[\<mapsto>]vs']"
 and body_case:"new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body  | _ \<Rightarrow> body)"
 and body: "P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> \<langle>new_body,(h\<^sub>2,l\<^sub>2')\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>3)\<rangle>"
 and final:"final ef"
 shows "P,E \<turnstile> \<langle>e\<bullet>M(es), s\<^sub>0\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>2)\<rangle>"
 proof -
   have wf: "size Ts = size pns \<and> distinct pns \<and> this \<notin> set pns"
     and wt: "fv body \<subseteq> {this} \<union> set pns"
     using assms by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
   have "dom l\<^sub>3 \<subseteq> {this} \<union> set pns"
     using Reds_dom_lcl[OF wwf body] wt l\<^sub>2' set_take_subset body_case
     by (cases T') force+
   hence eql\<^sub>2: "override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns) = l\<^sub>2"
     by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
   from wwf select have "is_class P (last Cs')"
     by (auto elim!:SelectMethodDef.cases intro:Subobj_last_isClass 
              simp:LeastMethodDef_def FinalOverriderMethodDef_def 
                   OverriderMethodDefs_def MinimalMethodDefs_def MethodDefs_def)
   hence "P \<turnstile> Class (last Cs') casts Ref(a,Cs') to Ref(a,Cs')"
     by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
   with casts
   have casts':"P \<turnstile> Class (last Cs')#Ts Casts Ref(a,Cs')#vs to  Ref(a,Cs')#vs'"
     by -(rule Casts_Cons)
   have 1:"P,E \<turnstile> \<langle>e\<bullet>M(es),s\<^sub>0\<rangle> \<rightarrow>* \<langle>(ref(a,Cs))\<bullet>M(es),s\<^sub>1\<rangle>" by(rule CallRedsObj)(rule assms(2))
   have 2:"P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(es),s\<^sub>1\<rangle> \<rightarrow>*
                  \<langle>(ref(a,Cs))\<bullet>M(map Val vs),(h\<^sub>2,l\<^sub>2)\<rangle>"
     by(rule CallRedsParams)(rule assms(3))
   from body[THEN Red_lcl_add, of l\<^sub>2]
   have body': "P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
              \<langle>new_body,(h\<^sub>2,l\<^sub>2(this\<mapsto> Ref(a,Cs'), pns[\<mapsto>]vs'))\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>2++l\<^sub>3)\<rangle>"
     by (simp add:l\<^sub>2')
   show ?thesis
   proof(cases "\<forall>C. T'\<noteq> Class C")
     case True
     hence "P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow> 
                  \<langle>blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h\<^sub>2,l\<^sub>2)\<rangle>"
       using hp "method" select size wf
       by -(rule RedCall,auto,cases T',auto)
     hence 3:"P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* 
                    \<langle>blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h\<^sub>2,l\<^sub>2)\<rangle>"
       by(simp add:r_into_rtrancl)
     have "P,E \<turnstile> \<langle>blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* 
                 \<langle>ef,(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
       using True wf body' wwf size final casts' body_case
       by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all,cases T',auto)
     with 1 2 3 show ?thesis using eql\<^sub>2
       by simp
   next
     case False
     then obtain D where T':"T' = Class D" by auto
     with final body' body_case obtain s' e' where 
       body'':"P,E(this \<mapsto> Class (last Cs'),pns [\<mapsto>] Ts) \<turnstile> 
                            \<langle>body,(h\<^sub>2,l\<^sub>2(this\<mapsto> Ref(a,Cs'), pns[\<mapsto>]vs'))\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
       and final':"final e'" 
       and cast:"P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> \<langle>\<lparr>D\<rparr>e',s'\<rangle> \<rightarrow> 
                                                            \<langle>ef,(h\<^sub>3,l\<^sub>2++l\<^sub>3)\<rangle>"
       by(cases T')(auto dest:Cast_final)
     from T' have "P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow> 
                  \<langle>\<lparr>D\<rparr>blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body), (h\<^sub>2,l\<^sub>2)\<rangle>"
       using hp "method" select size wf
       by -(rule RedCall,auto)
     hence 3:"P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* 
                   \<langle>\<lparr>D\<rparr>blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body),(h\<^sub>2,l\<^sub>2)\<rangle>"
       by(simp add:r_into_rtrancl)
     from cast final have eq:"s' = (h\<^sub>3,l\<^sub>2++l\<^sub>3)"
       by(auto elim:red.cases simp:final_def)
     hence "P,E \<turnstile> \<langle>blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body), (h\<^sub>2,l\<^sub>2)\<rangle>
                  \<rightarrow>* \<langle>e',(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
       using wf body'' wwf size final' casts'
       by -(rule_tac vs'="Ref(a,Cs')#vs'" in blocksRedsFinal,simp_all)
     hence "P,E \<turnstile> \<langle>\<lparr>D\<rparr>(blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)),(h\<^sub>2,l\<^sub>2)\<rangle>
              \<rightarrow>* \<langle>\<lparr>D\<rparr>e',(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
       by(rule StaticCastReds)
     moreover
     have "P,E \<turnstile> \<langle>\<lparr>D\<rparr>e',(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle> \<rightarrow> 
                 \<langle>ef,(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
       using eq cast final final'
       by(fastforce intro:Cast_final_eq)
     ultimately
     have "P,E \<turnstile> \<langle>\<lparr>D\<rparr>(blocks(this#pns, Class (last Cs')#Ts, Ref(a,Cs')#vs,body)), 
                   (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
       by(rule_tac b="(\<lparr>D\<rparr>e',(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns)))"
         in rtrancl_into_rtrancl,simp_all)
     with 1 2 3 show ?thesis using eql\<^sub>2
       by simp
   qed
 qed
 
 
 lemma StaticCallRedsFinal:
 assumes wwf: "wwf_prog P"
 and "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
       "P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
 and path_unique: "P \<turnstile> Path (last Cs) to C unique"
 and path_via: "P \<turnstile> Path (last Cs) to C via Cs''" 
 and Ds: "Ds = (Cs@\<^sub>pCs'')@\<^sub>pCs'"
 and least: "P \<turnstile> C has least M = (Ts,T,pns,body) via Cs'"
 and size: "size vs = size pns"
 and casts: "P \<turnstile> Ts Casts vs to vs'"
 and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref(a,Ds), pns[\<mapsto>]vs']"
 and body: "P,E(this\<mapsto>Class(last Ds), pns[\<mapsto>]Ts) \<turnstile> \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>3)\<rangle>"
 and final:"final ef"
 shows "P,E \<turnstile> \<langle>e\<bullet>(C::)M(es), s\<^sub>0\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>2)\<rangle>"
 proof -
   have wf: "size Ts = size pns \<and> distinct pns \<and> this \<notin> set pns \<and> 
             (\<forall>T\<in>set Ts. is_type P T)"
     and wt: "fv body \<subseteq> {this} \<union> set pns"
     using assms by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
   have "dom l\<^sub>3 \<subseteq> {this} \<union> set pns"
     using Reds_dom_lcl[OF wwf body] wt l\<^sub>2' set_take_subset
     by force
   hence eql\<^sub>2: "override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns) = l\<^sub>2"
     by(fastforce simp add:map_add_def override_on_def fun_eq_iff)
   from wwf least have "Cs' \<noteq> []"
     by (auto elim!:Subobjs_nonempty simp:LeastMethodDef_def MethodDefs_def)
   with Ds have "last Cs' = last Ds" by(fastforce intro:appendPath_last)
   with wwf least have "is_class P (last Ds)"
     by(auto dest:Subobj_last_isClass simp:LeastMethodDef_def MethodDefs_def)
   hence "P \<turnstile> Class (last Ds) casts Ref(a,Ds) to Ref(a,Ds)"
     by(auto intro!:casts_ref Subobjs_Base simp:path_via_def appendPath_def)
   with casts
   have casts':"P \<turnstile> Class (last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
     by -(rule Casts_Cons)
   have 1:"P,E \<turnstile> \<langle>e\<bullet>(C::)M(es),s\<^sub>0\<rangle> \<rightarrow>* \<langle>(ref(a,Cs))\<bullet>(C::)M(es),s\<^sub>1\<rangle>"
     by(rule CallRedsObj)(rule assms(2))
   have 2:"P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>(C::)M(es),s\<^sub>1\<rangle> \<rightarrow>*
                  \<langle>(ref(a,Cs))\<bullet>(C::)M(map Val vs),(h\<^sub>2,l\<^sub>2)\<rangle>"
     by(rule CallRedsParams)(rule assms(3))
   from body[THEN Red_lcl_add, of l\<^sub>2]
   have body': "P,E(this\<mapsto>Class(last Ds), pns[\<mapsto>]Ts) \<turnstile> 
               \<langle>body,(h\<^sub>2,l\<^sub>2(this\<mapsto> Ref(a,Ds), pns[\<mapsto>]vs'))\<rangle> \<rightarrow>* \<langle>ef,(h\<^sub>3,l\<^sub>2++l\<^sub>3)\<rangle>"
     by (simp add:l\<^sub>2')
   have "P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>(C::)M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>
               \<langle>blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body), (h\<^sub>2,l\<^sub>2)\<rangle>"
     using path_unique path_via least size wf Ds
     by -(rule RedStaticCall,auto)
   hence 3:"P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>(C::)M(map Val vs), (h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* 
                    \<langle>blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body), (h\<^sub>2,l\<^sub>2)\<rangle>"
     by(simp add:r_into_rtrancl)
   have "P,E \<turnstile> \<langle>blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),(h\<^sub>2,l\<^sub>2)\<rangle> \<rightarrow>* 
                 \<langle>ef,(h\<^sub>3,override_on (l\<^sub>2++l\<^sub>3) l\<^sub>2 ({this} \<union> set pns))\<rangle>"
     using wf body' wwf size final casts'
     by -(rule_tac vs'="Ref(a,Ds)#vs'" in blocksRedsFinal,simp_all)
   with 1 2 3 show ?thesis using eql\<^sub>2
     by simp
 qed
 
 
 
 lemma CallRedsThrowParams:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Val v,s\<^sub>1\<rangle>;  
     P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs\<^sub>1 @ Throw ex # es\<^sub>2,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw ex,s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule CallRedsObj)
 apply(rule rtrancl_into_rtrancl)
  apply(erule CallRedsParams)
 apply(simp add:CallThrowParams)
 done
 
 
 
 lemma CallRedsThrowObj:
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw ex,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<rightarrow>* \<langle>Throw ex,s\<^sub>1\<rangle>"
 
 apply(rule rtrancl_into_rtrancl)
  apply(erule CallRedsObj)
 apply(simp add:CallThrowObj)
 done
 
 
 
 lemma CallRedsNull:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>null,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<rightarrow>* \<langle>THROW NullPointer,s\<^sub>2\<rangle>"
 
 apply(rule rtrancl_trans)
  apply(erule CallRedsObj)
 apply(rule rtrancl_into_rtrancl)
  apply(erule CallRedsParams)
 apply(simp add:RedCallNull)
 done
 
 
 
 subsection \<open>The main Theorem\<close>
 
 lemma assumes wwf: "wwf_prog P"
 shows big_by_small: "P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
 and bigs_by_smalls: "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
 
 proof (induct rule: eval_evals.inducts)
   case New thus ?case by (auto simp:RedNew)
 next
   case NewFail thus ?case by (auto simp:RedNewFail)
 next
   case StaticUpCast thus ?case by(simp add:StaticUpCastReds)
 next
   case StaticDownCast thus ?case by(simp add:StaticDownCastReds)
 next
   case StaticCastNull thus ?case by(simp add:StaticCastRedsNull)
 next
   case StaticCastFail thus ?case by(simp add:StaticCastRedsFail)
 next
   case StaticCastThrow thus ?case by(auto dest!:eval_final simp:StaticCastRedsThrow)
 next
   case StaticUpDynCast thus ?case by(simp add:StaticUpDynCastReds)
 next
   case StaticDownDynCast thus ?case by(simp add:StaticDownDynCastReds)
 next
   case DynCast thus ?case by(fastforce intro:DynCastRedsRef)
 next
   case DynCastNull thus ?case by(simp add:DynCastRedsNull)
 next
   case DynCastFail thus ?case by(fastforce intro!:DynCastRedsFail)
 next
   case DynCastThrow thus ?case by(auto dest!:eval_final simp:DynCastRedsThrow)
 next
   case Val thus ?case by simp
 next
   case BinOp thus ?case by(fastforce simp:BinOpRedsVal)
 next
   case BinOpThrow1 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow1)
 next
   case BinOpThrow2 thus ?case by(fastforce dest!:eval_final simp: BinOpRedsThrow2)
 next
   case Var thus ?case by (fastforce simp:RedVar)
 next
   case LAss thus ?case by(fastforce simp: LAssRedsVal)
 next
   case LAssThrow thus ?case by(fastforce dest!:eval_final simp: LAssRedsThrow)
 next
   case FAcc thus ?case by(fastforce intro:FAccRedsVal)
 next
   case FAccNull thus ?case by(simp add:FAccRedsNull)
 next
   case FAccThrow thus ?case by(fastforce dest!:eval_final simp:FAccRedsThrow)
 next
   case FAss thus ?case by(fastforce simp:FAssRedsVal)
 next
   case FAssNull thus ?case by(fastforce simp:FAssRedsNull)
 next
   case FAssThrow1 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow1)
 next
   case FAssThrow2 thus ?case by(fastforce dest!:eval_final simp:FAssRedsThrow2)
 next
   case CallObjThrow thus ?case by(fastforce dest!:eval_final simp:CallRedsThrowObj)
 next
   case CallNull thus ?case thm CallRedsNull by(simp add:CallRedsNull)
 next
   case CallParamsThrow thus ?case
     by(fastforce dest!:evals_final simp:CallRedsThrowParams)
 next
   case (Call E e s\<^sub>0 a Cs s\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C S M Ts' T' pns' body' Ds Ts T pns
              body Cs' vs' l\<^sub>2' new_body e' h\<^sub>3 l\<^sub>3)
   have IHe: "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
     and IHes: "P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
     and h\<^sub>2a: "h\<^sub>2 a = Some(C,S)"
     and "method": "P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
     and select: "P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
     and same_length: "length vs = length pns"
     and casts: "P \<turnstile> Ts Casts vs to vs'"
     and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref (a,Cs'), pns[\<mapsto>]vs']"
     and body_case: "new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body)"
     and eval_body: "P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
                       \<langle>new_body,(h\<^sub>2, l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>"
     and IHbody: "P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
                       \<langle>new_body,(h\<^sub>2, l\<^sub>2')\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>" by fact+
   from wwf select same_length have lengthTs:"length Ts = length vs"
     by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)
   show "P,E \<turnstile> \<langle>e\<bullet>M(ps),s\<^sub>0\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>3, l\<^sub>2)\<rangle>"
     using "method" select same_length l\<^sub>2' h\<^sub>2a casts body_case
       IHbody eval_final[OF eval_body]
     by(fastforce intro!:CallRedsFinal[OF wwf IHe IHes])
 next
   case (StaticCall E e s\<^sub>0 a Cs s\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C Cs'' M Ts T pns body Cs'
                    Ds vs' l\<^sub>2' e' h\<^sub>3 l\<^sub>3)
  have IHe: "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<rightarrow>* \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
    and IHes: "P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<rightarrow>]* \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
    and path_unique: "P \<turnstile> Path last Cs to C unique"
    and path_via: "P \<turnstile> Path last Cs to C via Cs''"
    and least: "P \<turnstile> C has least M = (Ts, T, pns, body) via Cs'"
    and Ds: "Ds = (Cs @\<^sub>p Cs'') @\<^sub>p Cs'"
    and same_length: "length vs = length pns"
    and casts: "P \<turnstile> Ts Casts vs to vs'"
    and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref (a,Ds), pns[\<mapsto>]vs']"
    and eval_body: "P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> 
                          \<langle>body,(h\<^sub>2, l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>"
    and IHbody: "P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> 
                       \<langle>body,(h\<^sub>2, l\<^sub>2')\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>" by fact+
  from wwf least same_length have lengthTs:"length Ts = length vs"
     by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)
   show "P,E \<turnstile> \<langle>e\<bullet>(C::)M(ps),s\<^sub>0\<rangle> \<rightarrow>* \<langle>e',(h\<^sub>3, l\<^sub>2)\<rangle>"
     using path_unique path_via least Ds same_length l\<^sub>2' casts
       IHbody eval_final[OF eval_body]
     by(fastforce intro!:StaticCallRedsFinal[OF wwf IHe IHes])
 next
   case Block with wwf show ?case by(fastforce simp: BlockRedsFinal dest:eval_final)
 next
   case Seq thus ?case by(fastforce simp:SeqReds2)
 next
   case SeqThrow thus ?case by(fastforce dest!:eval_final simp: SeqRedsThrow)
 next
   case CondT thus ?case by(fastforce simp:CondReds2T)
 next
   case CondF thus ?case by(fastforce simp:CondReds2F)
 next
   case CondThrow thus ?case by(fastforce dest!:eval_final simp:CondRedsThrow)
 next
   case WhileF thus ?case by(fastforce simp:WhileFReds)
 next
   case WhileT thus ?case by(fastforce simp: WhileTReds)
 next
   case WhileCondThrow thus ?case by(fastforce dest!:eval_final simp: WhileRedsThrow)
 next
   case WhileBodyThrow thus ?case by(fastforce dest!:eval_final simp: WhileTRedsThrow)
 next
   case Throw thus ?case by(fastforce simp:ThrowReds)
 next
   case ThrowNull thus ?case by(fastforce simp:ThrowRedsNull)
 next
   case ThrowThrow thus ?case by(fastforce dest!:eval_final simp:ThrowRedsThrow)
 next
   case Nil thus ?case by simp
 next
   case Cons thus ?case
     by(fastforce intro!:Cons_eq_appendI[OF refl refl] ListRedsVal)
 next
   case ConsThrow thus ?case by(fastforce elim: ListReds1)
 qed
 
 
 
 subsection\<open>Big steps simulates small step\<close>
 
 
 text \<open>The big step equivalent of \<open>RedWhile\<close>:\<close> 
 
 lemma unfold_while: 
   "P,E \<turnstile> \<langle>while(b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>  =  P,E \<turnstile> \<langle>if(b) (c;;while(b) c) else (unit),s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 
 proof
   assume "P,E \<turnstile> \<langle>while (b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
   thus "P,E \<turnstile> \<langle>if (b) (c;; while (b) c) else unit,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     by cases (fastforce intro: eval_evals.intros)+
 next
   assume "P,E \<turnstile> \<langle>if (b) (c;; while (b) c) else unit,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
   thus "P,E \<turnstile> \<langle>while (b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
   proof (cases)
     fix ex
     assume e': "e' = throw ex"
     assume "P,E \<turnstile> \<langle>b,s\<rangle> \<Rightarrow> \<langle>throw ex,s'\<rangle>"  
     hence "P,E \<turnstile> \<langle>while(b) c,s\<rangle> \<Rightarrow> \<langle>throw ex,s'\<rangle>" by (rule WhileCondThrow)
     with e' show ?thesis by simp
   next
     fix s\<^sub>1
     assume eval_false: "P,E \<turnstile> \<langle>b,s\<rangle> \<Rightarrow> \<langle>false,s\<^sub>1\<rangle>"
     and eval_unit: "P,E \<turnstile> \<langle>unit,s\<^sub>1\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     with eval_unit have "s' = s\<^sub>1" "e' = unit" by (auto elim: eval_cases)
     moreover from eval_false have "P,E \<turnstile> \<langle>while (b) c,s\<rangle> \<Rightarrow> \<langle>unit,s\<^sub>1\<rangle>"
       by - (rule WhileF, simp)
     ultimately show ?thesis by simp
   next
     fix s\<^sub>1
     assume eval_true: "P,E \<turnstile> \<langle>b,s\<rangle> \<Rightarrow> \<langle>true,s\<^sub>1\<rangle>"
     and eval_rest: "P,E \<turnstile> \<langle>c;; while (b) c,s\<^sub>1\<rangle>\<Rightarrow>\<langle>e',s'\<rangle>"
     from eval_rest show ?thesis
     proof (cases)
       fix s\<^sub>2 v\<^sub>1
       assume "P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v\<^sub>1,s\<^sub>2\<rangle>" "P,E \<turnstile> \<langle>while (b) c,s\<^sub>2\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
       with eval_true show "P,E \<turnstile> \<langle>while(b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by (rule WhileT)
     next
       fix ex
       assume "P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw ex,s'\<rangle>" "e' = throw ex"
       with eval_true show "P,E \<turnstile> \<langle>while(b) c,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by (iprover intro: WhileBodyThrow)
     qed
   qed
 qed
 
 
 
 lemma blocksEval:
   "\<And>Ts vs l l' E. \<lbrakk>size ps = size Ts; size ps = size vs; 
                     P,E \<turnstile> \<langle>blocks(ps,Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle> \<rbrakk>
     \<Longrightarrow> \<exists> l'' vs'. P,E(ps [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(ps[\<mapsto>]vs'))\<rangle> \<Rightarrow> \<langle>e',(h',l'')\<rangle> \<and>
                    P \<turnstile> Ts Casts vs to vs' \<and> length vs' = length vs"
 
 proof (induct ps)
   case Nil then show ?case by(fastforce intro:Casts_Nil)
 next
   case (Cons p ps')
   have length_eqs: "length (p # ps') = length Ts" 
                    "length (p # ps') = length vs"
     and IH:"\<And>Ts vs l l' E. \<lbrakk>length ps' = length Ts; length ps' = length vs;
                              P,E \<turnstile> \<langle>blocks (ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle>\<rbrakk>
   \<Longrightarrow> \<exists>l'' vs'. P,E(ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(ps' [\<mapsto>] vs'))\<rangle> \<Rightarrow> \<langle>e',(h', l'')\<rangle> \<and>
                 P \<turnstile> Ts Casts vs to vs' \<and> length vs' = length vs" by fact+
   then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
   obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
   with length_eqs Ts have length1:"length ps' = length Ts'" 
     and length2:"length ps' = length vs'" by simp_all
   have "P,E \<turnstile> \<langle>blocks (p # ps', Ts, vs, e),(h,l)\<rangle> \<Rightarrow> \<langle>e',(h', l')\<rangle>" by fact
   with Ts vs
   have blocks:"P,E \<turnstile> \<langle>{p:T := Val v; blocks (ps',Ts',vs',e)},(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle>"
     by simp
   then obtain l''' v' where
     eval_ps': "P,E(p \<mapsto> T) \<turnstile> \<langle>blocks (ps',Ts',vs',e),(h,l(p\<mapsto>v'))\<rangle> \<Rightarrow> \<langle>e',(h',l''')\<rangle>"
     and l''': "l'=l'''(p:=l p)"
     and casts:"P \<turnstile> T casts v to v'"
     by(auto elim!: eval_cases simp:fun_upd_same)
   from IH[OF length1 length2 eval_ps'] obtain l'' vs'' where
-    "P,E(p \<mapsto> T)(ps' [\<mapsto>] Ts') \<turnstile> \<langle>e,(h, l(p\<mapsto>v')(ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
+    "P,E(p \<mapsto> T, ps' [\<mapsto>] Ts') \<turnstile> \<langle>e,(h, l(p\<mapsto>v', ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                        \<langle>e',(h',l'')\<rangle>"
     and "P \<turnstile> Ts' Casts vs' to vs''"
     and "length vs'' = length vs'" by auto
   with Ts vs casts show ?case
     by -(rule_tac x="l''" in exI,rule_tac x="v'#vs''" in exI,simp,
          rule Casts_Cons)
 qed
 
 
 
 lemma CastblocksEval:
   "\<And>Ts vs l l' E. \<lbrakk>size ps = size Ts; size ps = size vs; 
                    P,E \<turnstile> \<langle>\<lparr>C'\<rparr>(blocks(ps,Ts,vs,e)),(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle> \<rbrakk>
     \<Longrightarrow> \<exists> l'' vs'. P,E(ps [\<mapsto>] Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(ps[\<mapsto>]vs'))\<rangle> \<Rightarrow> \<langle>e',(h',l'')\<rangle> \<and>
                    P \<turnstile> Ts Casts vs to vs' \<and> length vs' = length vs"
 
 proof (induct ps)
   case Nil then show ?case by(fastforce intro:Casts_Nil)
 next
   case (Cons p ps')
   have length_eqs: "length (p # ps') = length Ts" 
                    "length (p # ps') = length vs" by fact+
   then obtain T Ts' where Ts: "Ts = T#Ts'" by (cases "Ts") simp
   obtain v vs' where vs: "vs = v#vs'" using length_eqs by (cases "vs") simp
   with length_eqs Ts have length1:"length ps' = length Ts'" 
     and length2:"length ps' = length vs'" by simp_all
   have "P,E \<turnstile> \<langle>\<lparr>C'\<rparr>(blocks (p # ps', Ts, vs, e)),(h,l)\<rangle> \<Rightarrow> \<langle>e',(h', l')\<rangle>" by fact
   moreover
   { fix a Cs Cs'
     assume blocks:"P,E \<turnstile> \<langle>blocks(p#ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>ref (a,Cs),(h',l')\<rangle>"
       and path_via:"P \<turnstile> Path last Cs to C' via Cs'"
       and e':"e' = ref(a,Cs@\<^sub>pCs')"
     from blocks length_eqs obtain l'' vs''
       where eval:"P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                  \<langle>ref (a,Cs),(h',l'')\<rangle>"
       and casts:"P \<turnstile> Ts Casts vs to vs''"
       and length:"length vs'' = length vs"
       by -(drule blocksEval,auto)
     from eval path_via have 
       "P,E(p#ps'[\<mapsto>]Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> \<langle>ref(a,Cs@\<^sub>pCs'),(h',l'')\<rangle>"
       by(auto intro:StaticUpCast)
     with e' casts length have ?case by simp blast }
   moreover
   { fix a Cs Cs'
     assume blocks:"P,E \<turnstile> \<langle>blocks(p#ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> 
                          \<langle>ref (a,Cs@C'# Cs'),(h',l')\<rangle>"
       and e':"e' = ref (a,Cs@[C'])"
     from blocks length_eqs obtain l'' vs''
       where eval:"P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                  \<langle>ref (a,Cs@C'# Cs'),(h',l'')\<rangle>"
       and casts:"P \<turnstile> Ts Casts vs to vs''"
       and length:"length vs'' = length vs"
       by -(drule blocksEval,auto)
     from eval have "P,E(p#ps'[\<mapsto>]Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                              \<langle>ref(a,Cs@[C']),(h',l'')\<rangle>"
       by(auto intro:StaticDownCast)
     with e' casts length have ?case by simp blast }
   moreover
   { assume "P,E \<turnstile> \<langle>blocks(p#ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>null,(h',l')\<rangle>"
     and e':"e' = null"
     with length_eqs obtain l'' vs''
       where eval:"P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                  \<langle>null,(h',l'')\<rangle>"
       and casts:"P \<turnstile> Ts Casts vs to vs''"
       and length:"length vs'' = length vs"
       by -(drule blocksEval,auto)
     from eval have "P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                                \<langle>null,(h',l'')\<rangle>"
       by(auto intro:StaticCastNull)
     with e' casts length have ?case by simp blast }
   moreover
   { fix a Cs
     assume blocks:"P,E \<turnstile> \<langle>blocks(p#ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>ref (a,Cs),(h',l')\<rangle>"
       and notin:"C' \<notin> set Cs" and leq:"\<not> P \<turnstile> (last Cs) \<preceq>\<^sup>* C'"
       and  e':"e' = THROW ClassCast"
     from blocks length_eqs obtain l'' vs''
       where eval:"P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                  \<langle>ref (a,Cs),(h',l'')\<rangle>"
       and casts:"P \<turnstile> Ts Casts vs to vs''"
       and length:"length vs'' = length vs"
       by -(drule blocksEval,auto)
     from eval notin leq have 
       "P,E(p#ps'[\<mapsto>]Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                           \<langle>THROW ClassCast,(h',l'')\<rangle>"
       by(auto intro:StaticCastFail)
     with e' casts length have ?case by simp blast }
   moreover
   { fix r assume "P,E \<turnstile> \<langle>blocks(p#ps',Ts,vs,e),(h,l)\<rangle> \<Rightarrow> \<langle>throw r,(h',l')\<rangle>"
     and e':"e' = throw r"
      with length_eqs obtain l'' vs''
       where eval:"P,E(p#ps' [\<mapsto>] Ts) \<turnstile> \<langle>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                                  \<langle>throw r,(h',l'')\<rangle>"
       and casts:"P \<turnstile> Ts Casts vs to vs''"
       and length:"length vs'' = length vs"
       by -(drule blocksEval,auto)
     from eval have 
       "P,E(p#ps'[\<mapsto>]Ts) \<turnstile> \<langle>\<lparr>C'\<rparr>e,(h,l(p#ps'[\<mapsto>]vs''))\<rangle> \<Rightarrow> 
                           \<langle>throw r,(h',l'')\<rangle>"
       by(auto intro:eval_evals.StaticCastThrow)
     with e' casts length have ?case by simp blast }
   ultimately show ?case
     by -(erule eval_cases,fastforce+)
 qed
 
 
 
 lemma
 assumes wf: "wwf_prog P"
 shows eval_restrict_lcl:
   "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> (\<And>W. fv e \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e,(h,l|`W)\<rangle> \<Rightarrow> \<langle>e',(h',l'|`W)\<rangle>)"
 and "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<Rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> (\<And>W. fvs es \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>es,(h,l|`W)\<rangle> [\<Rightarrow>] \<langle>es',(h',l'|`W)\<rangle>)"
 
 proof(induct rule:eval_evals_inducts)
   case (Block E V T e\<^sub>0 h\<^sub>0 l\<^sub>0 e\<^sub>1 h\<^sub>1 l\<^sub>1)
   have IH: "\<And>W. fv e\<^sub>0 \<subseteq> W \<Longrightarrow> 
                  P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0,l\<^sub>0(V:=None)|`W)\<rangle> \<Rightarrow> \<langle>e\<^sub>1,(h\<^sub>1,l\<^sub>1|`W)\<rangle>" by fact
   (*have type:"is_type P T" .*)
   have "fv({V:T; e\<^sub>0}) \<subseteq> W" by fact
   hence "fv e\<^sub>0 - {V} \<subseteq> W" by simp_all
   hence "fv e\<^sub>0 \<subseteq> insert V W" by fast
   with IH[OF this]
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0, (l\<^sub>0|`W)(V := None))\<rangle> \<Rightarrow> \<langle>e\<^sub>1,(h\<^sub>1, l\<^sub>1|`insert V W)\<rangle>"
     by fastforce
   from eval_evals.Block[OF this] show ?case by fastforce
 next
   case Seq thus ?case by simp (blast intro:eval_evals.Seq)
 next
   case New thus ?case by(simp add:eval_evals.intros)
 next
   case NewFail thus ?case by(simp add:eval_evals.intros)
 next
   case StaticUpCast thus ?case by simp (blast intro:eval_evals.StaticUpCast)
 next
   case (StaticDownCast E e h l a Cs C Cs' h' l')
   have IH:"\<And>W. fv e \<subseteq> W \<Longrightarrow> 
                 P,E \<turnstile> \<langle>e,(h,l |` W)\<rangle> \<Rightarrow> \<langle>ref(a,Cs@[C]@Cs'),(h',l' |` W)\<rangle>" by fact
   have "fv (\<lparr>C\<rparr>e) \<subseteq> W" by fact
   hence "fv e \<subseteq> W" by simp
   from IH[OF this] show ?case by(rule eval_evals.StaticDownCast)
 next
   case StaticCastNull thus ?case by simp (blast intro:eval_evals.StaticCastNull)
 next
   case StaticCastFail thus ?case by simp (blast intro:eval_evals.StaticCastFail)
 next
   case StaticCastThrow thus ?case by(simp add:eval_evals.intros)
 next
   case DynCast thus ?case by simp (blast intro:eval_evals.DynCast)
 next
   case StaticUpDynCast thus ?case by simp (blast intro:eval_evals.StaticUpDynCast)
 next
   case (StaticDownDynCast E e h l a Cs C Cs' h' l')
   have IH:"\<And>W. fv e \<subseteq> W \<Longrightarrow> 
                 P,E \<turnstile> \<langle>e,(h,l |` W)\<rangle> \<Rightarrow> \<langle>ref(a,Cs@[C]@Cs'),(h',l' |` W)\<rangle>" by fact
   have "fv (Cast C e) \<subseteq> W" by fact
   hence "fv e \<subseteq> W" by simp
   from IH[OF this] show ?case by(rule eval_evals.StaticDownDynCast)
 next
   case DynCastNull thus ?case by simp (blast intro:eval_evals.DynCastNull)
 next
   case DynCastFail thus ?case by simp (blast intro:eval_evals.DynCastFail)
 next
   case DynCastThrow thus ?case by(simp add:eval_evals.intros)
 next
   case Val thus ?case by(simp add:eval_evals.intros)
 next
   case BinOp thus ?case by simp (blast intro:eval_evals.BinOp)
 next
   case BinOpThrow1 thus ?case by simp (blast intro:eval_evals.BinOpThrow1)
 next
   case BinOpThrow2 thus ?case by simp (blast intro:eval_evals.BinOpThrow2)
 next
   case Var thus ?case by(simp add:eval_evals.intros)
 next
   case (LAss E e h\<^sub>0 l\<^sub>0 v h l V T v' l')
   have IH: "\<And>W. fv e \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0|`W)\<rangle> \<Rightarrow> \<langle>Val v,(h,l|`W)\<rangle>"
     and env:"E V = \<lfloor>T\<rfloor>" and casts:"P \<turnstile> T casts v to v'"
     and [simp]: "l' = l(V \<mapsto> v')" by fact+
   have "fv (V:=e) \<subseteq> W" by fact
   hence fv: "fv e \<subseteq> W" and VinW: "V \<in> W" by auto
   from eval_evals.LAss[OF IH[OF fv] _ casts] env VinW
   show ?case by fastforce
 next
   case LAssThrow thus ?case by(fastforce intro: eval_evals.LAssThrow)
 next
   case FAcc thus ?case by simp (blast intro: eval_evals.FAcc)
 next
   case FAccNull thus ?case by(fastforce intro: eval_evals.FAccNull)
 next
   case FAccThrow thus ?case by(fastforce intro: eval_evals.FAccThrow)
 next
   case (FAss E e\<^sub>1 h l a Cs' h' l' e\<^sub>2 v h\<^sub>2 l\<^sub>2 D S F T Cs v' Ds fs fs' S' h\<^sub>2' W)
   have IH1: "\<And>W. fv e\<^sub>1 \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,(h, l|`W)\<rangle> \<Rightarrow> \<langle>ref (a, Cs'),(h', l'|`W)\<rangle>"
     and IH2: "\<And>W. fv e\<^sub>2 \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,(h', l'|`W)\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2, l\<^sub>2|`W)\<rangle>"
     and fv:"fv (e\<^sub>1\<bullet>F{Cs} := e\<^sub>2) \<subseteq> W"
     and h:"h\<^sub>2 a = Some(D,S)" and Ds:"Ds = Cs' @\<^sub>p Cs"
     and S:"(Ds,fs) \<in> S" and fs':"fs' = fs(F \<mapsto> v')"
     and S':"S' = S - {(Ds, fs)} \<union> {(Ds, fs')}" 
     and h':"h\<^sub>2' = h\<^sub>2(a \<mapsto> (D, S'))" 
     and field:"P \<turnstile> last Cs' has least F:T via Cs"
     and casts:"P \<turnstile> T casts v to v'" by fact+
   from fv have fv1:"fv e\<^sub>1 \<subseteq> W" and fv2:"fv e\<^sub>2 \<subseteq> W" by auto
   from eval_evals.FAss[OF IH1[OF fv1] IH2[OF fv2] _ field casts] h Ds S fs' S' h'
   show ?case by simp
 next
   case FAssNull thus ?case by simp (blast intro: eval_evals.FAssNull)
 next
   case FAssThrow1 thus ?case by simp (blast intro: eval_evals.FAssThrow1)
 next
   case FAssThrow2 thus ?case by simp (blast intro: eval_evals.FAssThrow2)
 next
   case CallObjThrow thus ?case by simp (blast intro: eval_evals.intros)
 next
   case CallNull thus ?case by simp (blast intro: eval_evals.CallNull)
 next
   case CallParamsThrow thus ?case
     by simp (blast intro: eval_evals.CallParamsThrow)
 next
   case (Call E e h\<^sub>0 l\<^sub>0 a Cs h\<^sub>1 l\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C S M Ts' T' pns'
              body' Ds Ts T pns body Cs' vs' l\<^sub>2' new_body e' h\<^sub>3 l\<^sub>3 W)
   have IHe: "\<And>W. fv e \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0|`W)\<rangle> \<Rightarrow> \<langle>ref(a,Cs),(h\<^sub>1,l\<^sub>1|`W)\<rangle>"
     and IHps: "\<And>W. fvs ps \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>ps,(h\<^sub>1,l\<^sub>1|`W)\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2|`W)\<rangle>"
     and IHbd: "\<And>W. fv new_body \<subseteq> W \<Longrightarrow> P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
                                     \<langle>new_body,(h\<^sub>2,l\<^sub>2'|`W)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3|`W)\<rangle>"
     and h\<^sub>2a: "h\<^sub>2 a = Some (C,S)"
     and "method": "P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
     and select:"P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
     and same_len: "size vs = size pns"
     and casts:"P \<turnstile> Ts Casts vs to vs'"
     and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref(a,Cs'), pns [\<mapsto>] vs']"
     and body_case: "new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body)" by fact+
   have "fv (e\<bullet>M(ps)) \<subseteq> W" by fact
   hence fve: "fv e \<subseteq> W" and fvps: "fvs(ps) \<subseteq> W" by auto
   have wfmethod: "size Ts = size pns \<and> this \<notin> set pns" and
        fvbd: "fv body \<subseteq> {this} \<union> set pns"
     using select wf by(fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
   from fvbd body_case have fvbd':"fv new_body \<subseteq> {this} \<union> set pns"
     by(cases T') auto
   from l\<^sub>2' have "l\<^sub>2' |` ({this} \<union> set pns) = [this \<mapsto> Ref (a, Cs'), pns [\<mapsto>] vs']"
     by (auto intro!:ext simp:restrict_map_def fun_upd_def)
   with eval_evals.Call[OF IHe[OF fve] IHps[OF fvps] _ "method" select same_len
                           casts _ body_case IHbd[OF fvbd']] h\<^sub>2a
   show ?case by simp
 next
   case (StaticCall E e h\<^sub>0 l\<^sub>0 a Cs h\<^sub>1 l\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C Cs'' M Ts T pns body
                    Cs' Ds vs' l\<^sub>2' e' h\<^sub>3 l\<^sub>3 W)
   have IHe: "\<And>W. fv e \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>e,(h\<^sub>0,l\<^sub>0|`W)\<rangle> \<Rightarrow> \<langle>ref(a,Cs),(h\<^sub>1,l\<^sub>1|`W)\<rangle>"
     and IHps: "\<And>W. fvs ps \<subseteq> W \<Longrightarrow> P,E \<turnstile> \<langle>ps,(h\<^sub>1,l\<^sub>1|`W)\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2|`W)\<rangle>"
     and IHbd: "\<And>W. fv body \<subseteq> W \<Longrightarrow> P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> 
                                     \<langle>body,(h\<^sub>2,l\<^sub>2'|`W)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3|`W)\<rangle>"
     and path_unique: "P \<turnstile> Path last Cs to C unique"
     and path_via: "P \<turnstile> Path last Cs to C via Cs''"
     and least: "P \<turnstile> C has least M = (Ts, T, pns, body) via Cs'"
     and Ds: "Ds = (Cs @\<^sub>p Cs'') @\<^sub>p Cs'"
     and same_len: "size vs = size pns"
     and casts:"P \<turnstile> Ts Casts vs to vs'"
     and l\<^sub>2': "l\<^sub>2' = [this \<mapsto> Ref(a,Ds), pns [\<mapsto>] vs']" by fact+
   have "fv (e\<bullet>(C::)M(ps)) \<subseteq> W" by fact
   hence fve: "fv e \<subseteq> W" and fvps: "fvs(ps) \<subseteq> W" by auto
   have wfmethod: "size Ts = size pns \<and> this \<notin> set pns" and
        fvbd: "fv body \<subseteq> {this} \<union> set pns"
     using least wf by(fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
   from fvbd have fvbd':"fv body \<subseteq> {this} \<union> set pns"
     by auto
   from l\<^sub>2' have "l\<^sub>2' |` ({this} \<union> set pns) = [this \<mapsto> Ref(a,Ds), pns [\<mapsto>] vs']"
     by (auto intro!:ext simp:restrict_map_def fun_upd_def)
   with eval_evals.StaticCall[OF IHe[OF fve] IHps[OF fvps] path_unique path_via
                                 least Ds same_len casts _ IHbd[OF fvbd']]
   show ?case by simp
 next
   case SeqThrow thus ?case by simp (blast intro: eval_evals.SeqThrow)
 next
   case CondT thus ?case by simp (blast intro: eval_evals.CondT)
 next
   case CondF thus ?case by simp (blast intro: eval_evals.CondF)
 next
   case CondThrow thus ?case by simp (blast intro: eval_evals.CondThrow)
 next
   case WhileF thus ?case by simp (blast intro: eval_evals.WhileF)
 next
   case WhileT thus ?case by simp (blast intro: eval_evals.WhileT)
 next
   case WhileCondThrow thus ?case by simp (blast intro: eval_evals.WhileCondThrow)
 next
   case WhileBodyThrow thus ?case by simp (blast intro: eval_evals.WhileBodyThrow)
 next
   case Throw thus ?case by simp (blast intro: eval_evals.Throw)
 next
   case ThrowNull thus ?case by simp (blast intro: eval_evals.ThrowNull)
 next
   case ThrowThrow thus ?case by simp (blast intro: eval_evals.ThrowThrow)
 next
   case Nil thus ?case by (simp add: eval_evals.Nil)
 next
   case Cons thus ?case by simp (blast intro: eval_evals.Cons)
 next
   case ConsThrow thus ?case by simp (blast intro: eval_evals.ConsThrow)
 qed
 
 
 
 lemma eval_notfree_unchanged:
 assumes wf:"wwf_prog P"
 shows "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> (\<And>V. V \<notin> fv e \<Longrightarrow> l' V = l V)"
 and "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<Rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> (\<And>V. V \<notin> fvs es \<Longrightarrow> l' V = l V)"
 
 proof(induct rule:eval_evals_inducts)
   case LAss thus ?case by(simp add:fun_upd_apply)
 next
   case Block thus ?case
     by (simp only:fun_upd_apply split:if_splits) fastforce
 qed simp_all
 
 
 
 lemma eval_closed_lcl_unchanged:
   assumes wf:"wwf_prog P"
   and eval:"P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<Rightarrow> \<langle>e',(h',l')\<rangle>"
   and fv:"fv e = {}"
   shows "l' = l"
 
 proof -
   from wf eval have "\<And>V. V \<notin> fv e \<Longrightarrow> l' V = l V" by (rule eval_notfree_unchanged)
   with fv have "\<And>V. l' V = l V" by simp
   thus ?thesis by(simp add:fun_eq_iff)
 qed
 
 
 
 (* Hiermit kann man die ganze pair-Splitterei in den automatischen Taktiken
 abschalten. Wieder anschalten siehe nach dem Beweis. *)
 
 declare split_paired_All [simp del] split_paired_Ex [simp del]
 
 declaration \<open>K (Simplifier.map_ss (fn ss => ss delloop "split_all_tac"))\<close>
 setup \<open>map_theory_claset (fn ctxt => ctxt delSWrapper "split_all_tac")\<close>
 
 
 lemma list_eval_Throw: 
 assumes eval_e: "P,E \<turnstile> \<langle>throw x,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 shows "P,E \<turnstile> \<langle>map Val vs @ throw x # es',s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ e' # es',s'\<rangle>"
 
 proof -
   from eval_e 
   obtain a where e': "e' = Throw a"
     by (cases) (auto dest!: eval_final)
   {
     fix es
     have "\<And>vs. es = map Val vs @ throw x # es' 
            \<Longrightarrow> P,E \<turnstile> \<langle>es,s\<rangle>[\<Rightarrow>]\<langle>map Val vs @ e' # es',s'\<rangle>"
     proof (induct es type: list)
       case Nil thus ?case by simp
     next
       case (Cons e es vs)
       have e_es: "e # es = map Val vs @ throw x # es'" by fact
       show "P,E \<turnstile> \<langle>e # es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ e' # es',s'\<rangle>"
       proof (cases vs)
         case Nil
         with e_es obtain "e=throw x" "es=es'" by simp
         moreover from eval_e e'
         have "P,E \<turnstile> \<langle>throw x # es,s\<rangle> [\<Rightarrow>] \<langle>Throw a # es,s'\<rangle>"
           by (iprover intro: ConsThrow)
         ultimately show ?thesis using Nil e' by simp
       next
         case (Cons v vs')
         have vs: "vs = v # vs'" by fact
         with e_es obtain 
           e: "e=Val v" and es:"es= map Val vs' @ throw x # es'"
           by simp
         from e 
         have "P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>Val v,s\<rangle>"
           by (iprover intro: eval_evals.Val)
         moreover from es 
         have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs' @ e' # es',s'\<rangle>"
           by (rule Cons.hyps)
         ultimately show 
           "P,E \<turnstile> \<langle>e#es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ e' # es',s'\<rangle>"
           using vs by (auto intro: eval_evals.Cons)
       qed
     qed
   }
   thus ?thesis
     by simp
 qed
 
 
 
 
 text \<open>The key lemma:\<close>
 
 lemma
 assumes wf: "wwf_prog P"
 shows extend_1_eval:
   "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e'',s''\<rangle> \<Longrightarrow>  (\<And>s' e'. P,E \<turnstile> \<langle>e'',s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>)"
 and extend_1_evals:
   "P,E \<turnstile> \<langle>es,t\<rangle> [\<rightarrow>] \<langle>es'',t''\<rangle> \<Longrightarrow> (\<And>t' es'. P,E \<turnstile> \<langle>es'',t''\<rangle> [\<Rightarrow>] \<langle>es',t'\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>es,t\<rangle> [\<Rightarrow>] \<langle>es',t'\<rangle>)"
 
 proof (induct rule: red_reds.inducts)
  case RedNew thus ?case by (iprover elim: eval_cases intro: eval_evals.intros)
 next
   case RedNewFail thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case (StaticCastRed E e s e'' s'' C s' e') thus ?case
     by -(erule eval_cases,auto intro:eval_evals.intros,
          subgoal_tac "P,E \<turnstile> \<langle>e'',s''\<rangle> \<Rightarrow> \<langle>ref(a,Cs@[C]@Cs'),s'\<rangle>",
          rule_tac Cs'="Cs'" in StaticDownCast,auto)
 next
   case RedStaticCastNull thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedStaticUpCast thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedStaticDownCast thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedStaticCastFail thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedStaticUpDynCast thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedStaticDownDynCast thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case (DynCastRed E e s e'' s'' C s' e')
   have eval:"P,E \<turnstile> \<langle>Cast C e'',s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and IH:"\<And>ex sx. P,E \<turnstile> \<langle>e'',s''\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle>" by fact+
   moreover 
   { fix Cs Cs' a
     assume "P,E \<turnstile> \<langle>e'',s''\<rangle> \<Rightarrow> \<langle>ref (a, Cs @ C # Cs'),s'\<rangle>"
     from IH[OF this] have "P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>ref (a, Cs@[C]@Cs'),s'\<rangle>" by simp
     hence "P,E \<turnstile> \<langle>Cast C e,s\<rangle> \<Rightarrow> \<langle>ref (a, Cs@[C]),s'\<rangle>" by(rule StaticDownDynCast) }
   ultimately show ?case by -(erule eval_cases,auto intro: eval_evals.intros)
 next
   case RedDynCastNull thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
 next
   case (RedDynCast s a D S C Cs' E Cs s' e')
   thus ?case by (cases s)(auto elim!:eval_cases intro:eval_evals.intros)
 next
   case (RedDynCastFail s a D S C Cs E s'' e'')
   thus ?case by (cases s)(auto elim!: eval_cases intro: eval_evals.intros)
 next
   case BinOpRed1 thus ?case by -(erule eval_cases,auto intro: eval_evals.intros)
 next
   case BinOpRed2 
   thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros eval_finalId)
 next
   case RedBinOp thus ?case by (iprover elim:eval_cases intro:eval_evals.intros)
 next
   case (RedVar s V v E s' e')
   thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
 next
   case LAssRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
 next
   case RedLAss
   thus ?case by (fastforce elim:eval_cases intro:eval_evals.intros)
 next
   case FAccRed thus ?case by -(erule eval_cases,auto intro:eval_evals.intros)
 next
   case (RedFAcc s a D S Ds Cs' Cs fs F v E s' e')
   thus ?case by (cases s)(fastforce elim:eval_cases intro:eval_evals.intros)
 next
   case RedFAccNull thus ?case by (fastforce elim!:eval_cases intro:eval_evals.intros)
 next
   case (FAssRed1 E e\<^sub>1 s e\<^sub>1' s'' F Cs e\<^sub>2 s' e')
   have eval:"P,E \<turnstile> \<langle>e\<^sub>1'\<bullet>F{Cs} := e\<^sub>2,s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and IH:"\<And>ex sx. P,E \<turnstile> \<langle>e\<^sub>1',s''\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle>" by fact+
   { fix Cs' D S T a fs h\<^sub>2 l\<^sub>2 s\<^sub>1 v v'
     assume ref:"P,E \<turnstile> \<langle>e\<^sub>1',s''\<rangle> \<Rightarrow> \<langle>ref (a, Cs'),s\<^sub>1\<rangle>" 
       and rest:"P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,(h\<^sub>2, l\<^sub>2)\<rangle>" "h\<^sub>2 a = \<lfloor>(D, S)\<rfloor>" 
       "P \<turnstile> last Cs' has least F:T via Cs" "P \<turnstile> T casts v to v'"
       "(Cs' @\<^sub>p Cs, fs) \<in> S"
     from IH[OF ref] have "P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>ref (a, Cs'),s\<^sub>1\<rangle>" .
     with rest have "P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow>
           \<langle>Val v',(h\<^sub>2(a \<mapsto> (D,insert (Cs'@\<^sub>pCs,fs(F \<mapsto> v'))(S - {(Cs'@\<^sub>pCs,fs)}))),l\<^sub>2)\<rangle>"
       by-(rule FAss,simp_all) }
   moreover
   { fix s\<^sub>1 v 
     assume null:"P,E \<turnstile> \<langle>e\<^sub>1',s''\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>" 
       and rest:"P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v,s'\<rangle>"
     from IH[OF null] have "P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>" .
     with rest have "P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s'\<rangle>"
       by-(rule FAssNull,simp_all) }
   moreover
   { fix e' assume throw:"P,E \<turnstile> \<langle>e\<^sub>1',s''\<rangle> \<Rightarrow> \<langle>throw e',s'\<rangle>"
     from IH[OF throw] have "P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>throw e',s'\<rangle>" .
     hence "P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw e',s'\<rangle>"
       by-(rule eval_evals.FAssThrow1,simp_all) }
   moreover
   { fix e' s\<^sub>1 v
     assume val:"P,E \<turnstile> \<langle>e\<^sub>1',s''\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>"
       and rest:"P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw e',s'\<rangle>"
     from IH[OF val] have "P,E \<turnstile> \<langle>e\<^sub>1,s\<rangle> \<Rightarrow> \<langle>Val v,s\<^sub>1\<rangle>" .
     with rest have "P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw e',s'\<rangle>"
       by-(rule eval_evals.FAssThrow2,simp_all) }
   ultimately show ?case using eval
     by -(erule eval_cases,auto)
 next
   case (FAssRed2 E e\<^sub>2 s e\<^sub>2' s'' v F Cs s' e')
   have eval:"P,E \<turnstile> \<langle>Val v\<bullet>F{Cs} := e\<^sub>2',s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and IH:"\<And>ex sx. P,E \<turnstile> \<langle>e\<^sub>2',s''\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle>" by fact+
   { fix Cs' D S T a fs h\<^sub>2 l\<^sub>2 s\<^sub>1 v' v''
     assume val1:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>ref (a,Cs'),s\<^sub>1\<rangle>"
       and val2:"P,E \<turnstile> \<langle>e\<^sub>2',s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v',(h\<^sub>2, l\<^sub>2)\<rangle>"
       and rest:"h\<^sub>2 a = \<lfloor>(D, S)\<rfloor>" "P \<turnstile> last Cs' has least F:T via Cs"
                "P \<turnstile> T casts v' to v''" "(Cs'@\<^sub>pCs,fs) \<in> S"
     from val1 have s'':"s\<^sub>1 = s''" by -(erule eval_cases)
     with val1 have "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>ref (a,Cs'),s\<rangle>"
       by(fastforce elim:eval_cases intro:eval_finalId)
     also from IH[OF val2[simplified s'']] have "P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val v',(h\<^sub>2, l\<^sub>2)\<rangle>" .
     ultimately have "P,E \<turnstile> \<langle>Val v\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow>
            \<langle>Val v'',(h\<^sub>2(a\<mapsto>(D,insert(Cs'@\<^sub>pCs,fs(F \<mapsto> v''))(S - {(Cs'@\<^sub>pCs,fs)}))),l\<^sub>2)\<rangle>"
       using rest by -(rule FAss,simp_all) }
   moreover
   { fix s\<^sub>1 v'
     assume val1:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>"
       and val2:"P,E \<turnstile> \<langle>e\<^sub>2',s\<^sub>1\<rangle> \<Rightarrow> \<langle>Val v',s'\<rangle>"
     from val1 have s'':"s\<^sub>1 = s''" by -(erule eval_cases)
     with val1 have "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
       by(fastforce elim:eval_cases intro:eval_finalId)
     also from IH[OF val2[simplified s'']] have "P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>Val v',s'\<rangle>" .
     ultimately have "P,E \<turnstile> \<langle>Val v\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>THROW NullPointer,s'\<rangle>"
       by -(rule FAssNull,simp_all) }
   moreover
   { fix r assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>"
     hence s'':"s'' = s'" by -(erule eval_cases,simp)
     with val have "P,E \<turnstile> \<langle>Val v\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>" 
       by -(rule eval_evals.FAssThrow1,erule eval_cases,simp) }
   moreover
   { fix r s\<^sub>1 v'
     assume val1:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>Val v',s\<^sub>1\<rangle>"
       and val2:"P,E \<turnstile> \<langle>e\<^sub>2',s\<^sub>1\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>"
     from val1 have s'':"s\<^sub>1 = s''" by -(erule eval_cases)
     with val1 have "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>Val v',s\<rangle>"
       by(fastforce elim:eval_cases intro:eval_finalId)
     also from IH[OF val2[simplified s'']] have "P,E \<turnstile> \<langle>e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>" .
     ultimately have "P,E \<turnstile> \<langle>Val v\<bullet>F{Cs} := e\<^sub>2,s\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>" 
       by -(rule eval_evals.FAssThrow2,simp_all) }
   ultimately show ?case using eval
     by -(erule eval_cases,auto)
 next
   case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l s' e')
   have val:"P,E \<turnstile> \<langle>Val v',(h(a \<mapsto> (D,insert (Ds,fs(F \<mapsto> v'))(S - {(Ds,fs)}))),l)\<rangle> \<Rightarrow> 
                   \<langle>e',s'\<rangle>"
     and rest:"h a = \<lfloor>(D, S)\<rfloor>" "P \<turnstile> last Cs' has least F:T via Cs"
              "P \<turnstile> T casts v to v'" "Ds = Cs' @\<^sub>p Cs" "(Ds, fs) \<in> S" by fact+
   from val have "s' = (h(a \<mapsto> (D,insert (Ds,fs(F \<mapsto> v')) (S - {(Ds,fs)}))),l)"
     and "e' = Val v'" by -(erule eval_cases,simp_all)+
   with rest show ?case apply simp
     by(rule FAss,simp_all)(rule eval_finalId,simp)+
 next
   case RedFAssNull
   thus ?case by (fastforce elim!: eval_cases intro: eval_evals.intros)
 next
   case (CallObj E e s e' s' Copt M es s'' e'')
   thus ?case
     apply -
     apply(cases Copt,simp)
     by(erule eval_cases,auto intro:eval_evals.intros)+
 next
   case (CallParams E es s es' s'' v Copt M s' e')
   have call:"P,E \<turnstile> \<langle>Call (Val v) Copt M es',s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and IH:"\<And>esx sx. P,E \<turnstile> \<langle>es',s''\<rangle> [\<Rightarrow>] \<langle>esx,sx\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>esx,sx\<rangle>" by fact+
   show ?case
     proof(cases Copt)
     case None with call have eval:"P,E \<turnstile> \<langle>Val v\<bullet>M(es'),s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by simp
     from eval show ?thesis
     proof(rule eval_cases)
       fix r assume "P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>" "e' = throw r"
       with None show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by(fastforce elim:eval_cases)
     next
       fix es'' r sx v' vs
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>Val v',sx\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',sx\<rangle> [\<Rightarrow>] \<langle>map Val vs @ throw r # es'',s'\<rangle>"
         and e':"e' = throw r"
       have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>Val v,s\<rangle>" by(rule Val)
       from val have eq:"v' = v \<and> s'' = sx" by -(erule eval_cases,simp)
       with IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ throw r # es'',s'\<rangle>"
         by simp
       with eq CallParamsThrow[OF val'] e' None
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by fastforce
     next
       fix C Cs Cs' Ds S T T' Ts Ts' a body body' h\<^sub>2 h\<^sub>3 l\<^sub>2 l\<^sub>3 pns pns' s\<^sub>1 vs vs'
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<^sub>1\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
         and hp:"h\<^sub>2 a = Some(C, S)"
         and "method":"P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
         and select:"P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
         and length:"length vs = length pns"
         and casts:"P \<turnstile> Ts Casts vs to vs'"
         and body:"P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
     \<langle>case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body,(h\<^sub>2,[this \<mapsto> Ref(a,Cs'),pns [\<mapsto>] vs'])\<rangle>
         \<Rightarrow> \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>"
         and s':"s' = (h\<^sub>3, l\<^sub>2)"
       from val have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<rangle>"
         and eq:"s'' = s\<^sub>1 \<and> v = Ref(a,Cs)"
         by(auto elim:eval_cases intro:Val)
       from body obtain new_body 
         where body_case:"new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body)"
         and body':"P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> 
         \<langle>new_body,(h\<^sub>2,[this \<mapsto> Ref(a,Cs'),pns [\<mapsto>] vs'])\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle>"
         by simp
       from eq IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>" by simp
       with eq Call[OF val' _ _ "method" select length casts _ body_case] 
            hp body' s' None
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fastforce
     next
       fix s\<^sub>1 vs
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,s'\<rangle>"
         and e':"e' = THROW NullPointer"
       from val have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and eq:"s'' = s\<^sub>1 \<and> v = Null"
         by(auto elim:eval_cases intro:Val)
       from eq IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,s'\<rangle>" by simp
       with eq CallNull[OF val'] e' None
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fastforce
     qed
   next
     case (Some C) with call have eval:"P,E \<turnstile> \<langle>Val v\<bullet>(C::)M(es'),s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
       by simp
     from eval show ?thesis
     proof(rule eval_cases)
       fix r assume "P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>throw r,s'\<rangle>" "e' = throw r"
       with Some show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by(fastforce elim:eval_cases)
     next
       fix es'' r sx v' vs
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>Val v',sx\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',sx\<rangle> [\<Rightarrow>] \<langle>map Val vs @ throw r # es'',s'\<rangle>"
         and e':"e' = throw r"
       have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>Val v,s\<rangle>" by(rule Val)
       from val have eq:"v' = v \<and> s'' = sx" by -(erule eval_cases,simp)
       with IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ throw r # es'',s'\<rangle>"
         by simp
       with eq CallParamsThrow[OF val'] e' Some
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by fastforce
     next
       fix Cs Cs' Cs'' T Ts a body h\<^sub>2 h\<^sub>3 l\<^sub>2 l\<^sub>3 pns s\<^sub>1 vs vs'
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>ref (a,Cs),s\<^sub>1\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
         and path_unique:"P \<turnstile> Path last Cs to C unique"
         and path_via:"P \<turnstile> Path last Cs to C via Cs''"
         and least:"P \<turnstile> C has least M = (Ts, T, pns, body) via Cs'"
         and length:"length vs = length pns"
         and casts:"P \<turnstile> Ts Casts vs to vs'"
         and body:"P,E(this \<mapsto> Class (last ((Cs @\<^sub>p Cs'') @\<^sub>p Cs')), pns [\<mapsto>] Ts) \<turnstile> 
            \<langle>body,(h\<^sub>2,[this \<mapsto> Ref(a,(Cs@\<^sub>pCs'')@\<^sub>pCs'),pns [\<mapsto>] vs'])\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle>"
         and s':"s' = (h\<^sub>3,l\<^sub>2)"
       from val have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<rangle>"
         and eq:"s'' = s\<^sub>1 \<and> v = Ref(a,Cs)"
         by(auto elim:eval_cases intro:Val)
       from eq IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>" by simp
       with eq StaticCall[OF val' _ path_unique path_via least _ _ casts _ body] 
            length s' Some
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fastforce
     next
       fix s\<^sub>1 vs
       assume val:"P,E \<turnstile> \<langle>Val v,s''\<rangle> \<Rightarrow> \<langle>null,s\<^sub>1\<rangle>"
         and evals:"P,E \<turnstile> \<langle>es',s\<^sub>1\<rangle> [\<Rightarrow>] \<langle>map Val vs,s'\<rangle>"
         and e':"e' = THROW NullPointer"
       from val have val':"P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>null,s\<rangle>"
         and eq:"s'' = s\<^sub>1 \<and> v = Null"
         by(auto elim:eval_cases intro:Val)
       from eq IH evals have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,s'\<rangle>" by simp
       with eq CallNull[OF val'] e' Some
       show "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
         by fastforce
     qed
   qed
 next
   case (RedCall s a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs' vs
                 bs new_body E s' e')
   obtain h l where "s' = (h,l)" by(cases s') auto
   have "P,E \<turnstile> \<langle>ref(a,Cs),s\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<rangle>" by (rule eval_evals.intros)
   moreover
   have finals: "finals(map Val vs)" by simp
   obtain h\<^sub>2 l\<^sub>2 where s: "s = (h\<^sub>2,l\<^sub>2)" by (cases s)
   with finals have "P,E \<turnstile> \<langle>map Val vs,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
     by (iprover intro: eval_finalsId)
   moreover from s have h\<^sub>2a:"h\<^sub>2 a = Some (C,S)" using RedCall by simp
   moreover have "method": "P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds" by fact
   moreover have select:"P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'" by fact
   moreover have blocks:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)" by fact
   moreover have body_case:"new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>bs | _ \<Rightarrow> bs)" by fact
   moreover have same_len\<^sub>1: "length Ts = length pns"
    and this_distinct: "this \<notin> set pns" and fv: "fv body \<subseteq> {this} \<union> set pns"
     using select wf by (fastforce dest!:select_method_wf_mdecl simp:wf_mdecl_def)+
   have same_len: "length vs = length pns" by fact
   moreover
   obtain h\<^sub>3 l\<^sub>3 where s': "s' = (h\<^sub>3,l\<^sub>3)" by (cases s')
   have eval_blocks:"P,E \<turnstile> \<langle>new_body,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fact
   hence id: "l\<^sub>3 = l\<^sub>2" using fv s s' same_len\<^sub>1 same_len wf blocks body_case
     by(cases T')(auto elim!: eval_closed_lcl_unchanged)
   from same_len\<^sub>1 have same_len':"length(this#pns) = length(Class (last Cs')#Ts)" 
     by simp
   from same_len\<^sub>1 same_len
   have same_len\<^sub>2:"length(this#pns) = length(Ref(a,Cs')#vs)" by simp
   from eval_blocks
   have eval_blocks':"P,E \<turnstile> \<langle>new_body,(h\<^sub>2,l\<^sub>2)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle>" using s s' by simp
   have casts_unique:"\<And>vs'. P \<turnstile> Class (last Cs')#Ts Casts Ref(a,Cs')#vs to vs'
                             \<Longrightarrow> vs' = Ref(a,Cs')#tl vs'"
     using wf
     by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
                                       simp:path_via_def appendPath_def)
   have "\<exists>l'' vs' new_body'. P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
               \<langle>new_body',(h\<^sub>2,l\<^sub>2(this # pns[\<mapsto>]Ref(a,Cs')#vs'))\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l'')\<rangle> \<and> 
      P \<turnstile> Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs' \<and>
      length vs' = length vs \<and> fv new_body' \<subseteq> {this} \<union> set pns \<and>
      new_body' = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body  | _  \<Rightarrow> body)"
   proof(cases "\<forall>C. T' \<noteq> Class C")
     case True
     with same_len' same_len\<^sub>2 eval_blocks' casts_unique body_case blocks
     obtain l'' vs'
       where body:"P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
                     \<langle>body,(h\<^sub>2,l\<^sub>2(this # pns[\<mapsto>]Ref(a,Cs')#vs'))\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l'')\<rangle>"
       and casts:"P \<turnstile> Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
       and lengthvs':"length vs' = length vs"
       by -(drule_tac vs="Ref(a,Cs')#vs" in blocksEval,assumption,cases T',
            auto simp:length_Suc_conv,blast)
     with fv True show ?thesis by(cases T') auto
   next
     case False
     then obtain D where T':"T' = Class D" by auto
     with same_len' same_len\<^sub>2 eval_blocks' casts_unique body_case blocks
     obtain l'' vs'
       where body:"P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
                     \<langle>\<lparr>D\<rparr>body,(h\<^sub>2,l\<^sub>2(this # pns[\<mapsto>]Ref(a,Cs')#vs'))\<rangle> \<Rightarrow> 
                     \<langle>e',(h\<^sub>3, l'')\<rangle>"
       and casts:"P \<turnstile> Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
       and lengthvs':"length vs' = length vs"
       by - (drule_tac vs="Ref(a,Cs')#vs" in CastblocksEval,
             assumption,simp,clarsimp simp:length_Suc_conv,auto)
     from fv have "fv (\<lparr>D\<rparr>body) \<subseteq> {this} \<union> set pns"
       by simp
     with body casts lengthvs' T' show ?thesis by auto
   qed
   then obtain l'' vs' new_body'
     where body:"P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
                \<langle>new_body',(h\<^sub>2,l\<^sub>2(this # pns[\<mapsto>]Ref(a,Cs')#vs'))\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l'')\<rangle>"
     and casts:"P \<turnstile> Class(last Cs')#Ts Casts Ref(a,Cs')#vs to Ref(a,Cs')#vs'"
     and lengthvs':"length vs' = length vs"
     and body_case':"new_body' = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body  | _ \<Rightarrow> body)"
     and fv':"fv new_body' \<subseteq> {this} \<union> set pns"
     by auto
   from same_len\<^sub>2 lengthvs'
   have same_len\<^sub>3:"length (this # pns) = length (Ref (a, Cs') # vs')" by simp
   from restrict_map_upds[OF same_len\<^sub>3,of "set(this#pns)" "l\<^sub>2"]
   have "l\<^sub>2(this # pns[\<mapsto>]Ref(a,Cs')#vs')|`(set(this#pns)) = 
           [this # pns[\<mapsto>]Ref(a,Cs')#vs']" by simp
   with eval_restrict_lcl[OF wf body fv'] this_distinct same_len\<^sub>1 same_len
   have "P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
    \<langle>new_body',(h\<^sub>2,[this # pns[\<mapsto>]Ref(a,Cs')#vs'])\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l''|`(set(this#pns)))\<rangle>"
     by simp
   with casts obtain l\<^sub>2' l\<^sub>3' vs' where
         "P \<turnstile> Ts Casts vs to vs'"
     and "P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> 
                                       \<langle>new_body',(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3')\<rangle>"
     and "l\<^sub>2' = [this\<mapsto>Ref(a,Cs'),pns[\<mapsto>]vs']"
     by(auto elim:Casts_to.cases)
   ultimately have "P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>M(map Val vs),s\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>2)\<rangle>"
     using body_case'
     by -(rule Call,simp_all)
   with s' id show ?case by simp
 next
   case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a s s' e')
   have "P,E \<turnstile> \<langle>ref(a,Cs),s\<rangle> \<Rightarrow> \<langle>ref(a,Cs),s\<rangle>" by (rule eval_evals.intros)
   moreover
   have finals: "finals(map Val vs)" by simp
   obtain h\<^sub>2 l\<^sub>2 where s: "s = (h\<^sub>2,l\<^sub>2)" by (cases s)
   with finals have "P,E \<turnstile> \<langle>map Val vs,s\<rangle> [\<Rightarrow>] \<langle>map Val vs,(h\<^sub>2,l\<^sub>2)\<rangle>"
     by (iprover intro: eval_finalsId)
   moreover have path_unique:"P \<turnstile> Path last Cs to C unique" by fact
   moreover have path_via:"P \<turnstile> Path last Cs to C via Cs''" by fact
   moreover have least:"P \<turnstile> C has least M = (Ts, T, pns, body) via Cs'" by fact
   moreover have same_len\<^sub>1: "length Ts = length pns"
    and this_distinct: "this \<notin> set pns" and fv: "fv body \<subseteq> {this} \<union> set pns"
     using least wf by (fastforce dest!:has_least_wf_mdecl simp:wf_mdecl_def)+
   moreover have same_len:"length vs = length pns" by fact
   moreover have Ds:"Ds = (Cs @\<^sub>p Cs'') @\<^sub>p Cs'" by fact
   moreover
   obtain h\<^sub>3 l\<^sub>3 where s': "s' = (h\<^sub>3,l\<^sub>3)" by (cases s')
   have eval_blocks:"P,E \<turnstile> \<langle>blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),s\<rangle>
                        \<Rightarrow> \<langle>e',s'\<rangle>" by fact
   hence id: "l\<^sub>3 = l\<^sub>2" using fv s s' same_len\<^sub>1 same_len wf
     by(auto elim!: eval_closed_lcl_unchanged)
   from same_len\<^sub>1 have same_len':"length(this#pns) = length(Class (last Ds)#Ts)"
     by simp
   from same_len\<^sub>1 same_len
   have same_len\<^sub>2:"length(this#pns) = length(Ref(a,Ds)#vs)" by simp
   from eval_blocks
   have eval_blocks':"P,E \<turnstile> \<langle>blocks(this#pns,Class(last Ds)#Ts,Ref(a,Ds)#vs,body),
                                (h\<^sub>2,l\<^sub>2)\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle>" using s s' by simp
   have casts_unique:"\<And>vs'. P \<turnstile> Class (last Ds)#Ts Casts Ref(a,Ds)#vs to vs'
                             \<Longrightarrow> vs' = Ref(a,Ds)#tl vs'"
     using wf
     by -(erule Casts_to.cases,auto elim!:casts_to.cases dest!:mdc_eq_last
                                       simp:path_via_def appendPath_def)
   from same_len' same_len\<^sub>2 eval_blocks' casts_unique
   obtain l'' vs' where body:"P,E(this\<mapsto>Class(last Ds), pns[\<mapsto>]Ts) \<turnstile> 
                \<langle>body,(h\<^sub>2,l\<^sub>2(this # pns[\<mapsto>]Ref(a,Ds)#vs'))\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l'')\<rangle>"
     and casts:"P \<turnstile> Class(last Ds)#Ts Casts Ref(a,Ds)#vs to Ref(a,Ds)#vs'"
     and lengthvs':"length vs' = length vs"
     by -(drule_tac vs="Ref(a,Ds)#vs" in blocksEval,auto simp:length_Suc_conv,blast)
   from same_len\<^sub>2 lengthvs'
   have same_len\<^sub>3:"length (this # pns) = length (Ref(a,Ds) # vs')" by simp
   from restrict_map_upds[OF same_len\<^sub>3,of "set(this#pns)" "l\<^sub>2"]
   have "l\<^sub>2(this # pns[\<mapsto>]Ref(a,Ds)#vs')|`(set(this#pns)) = 
           [this # pns[\<mapsto>]Ref(a,Ds)#vs']" by simp
   with eval_restrict_lcl[OF wf body fv] this_distinct same_len\<^sub>1 same_len
   have "P,E(this\<mapsto>Class(last Ds), pns[\<mapsto>]Ts) \<turnstile> 
    \<langle>body,(h\<^sub>2,[this#pns [\<mapsto>] Ref(a,Ds)#vs'])\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3, l''|`(set(this#pns)))\<rangle>"
     by simp
   with casts obtain l\<^sub>2' l\<^sub>3' vs' where
         "P \<turnstile> Ts Casts vs to vs'"
     and "P,E(this \<mapsto> Class(last Ds),pns [\<mapsto>] Ts) \<turnstile> \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>3')\<rangle>"
     and "l\<^sub>2' = [this \<mapsto> Ref(a,Ds),pns [\<mapsto>] vs']"
     by(auto elim:Casts_to.cases)
   ultimately have "P,E \<turnstile> \<langle>(ref(a,Cs))\<bullet>(C::)M(map Val vs),s\<rangle> \<Rightarrow> \<langle>e',(h\<^sub>3,l\<^sub>2)\<rangle>"
     by -(rule StaticCall,simp_all)
   with s' id show ?case by simp
 next
   case RedCallNull
   thus ?case
     by (fastforce elim: eval_cases intro: eval_evals.intros eval_finalsId)
 next
   case BlockRedNone
   thus ?case
     by (fastforce elim!: eval_cases intro: eval_evals.intros 
                  simp add: fun_upd_same fun_upd_idem)
 next
   case (BlockRedSome E V T e h l e'' h' l' v s' e')
   have eval:"P,E \<turnstile> \<langle>{V:T:=Val v; e''},(h', l'(V := l V))\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<rightarrow> \<langle>e'',(h', l')\<rangle>"
     and notassigned:"\<not> assigned V e" and l':"l' V = Some v"
     and IH:"\<And>ex sx. P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h', l')\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle> \<Longrightarrow>
                      P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle>" by fact+
   from l' have l'upd:"l'(V \<mapsto> v) = l'" by (rule map_upd_triv)
   from wf red l' have casts:"P \<turnstile> T casts v to v"
     apply -
     apply(erule_tac V="V" in None_lcl_casts_values)
     by(simp add:fun_upd_same)+
   from eval obtain h'' l''
   where "P,E(V \<mapsto> T) \<turnstile> \<langle>V:=Val v;; e'',(h',l'(V:=None))\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle> \<and> 
     s' = (h'',l''(V:=l V))"
     by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
   moreover
   { fix T' h\<^sub>0 l\<^sub>0 v' v''
     assume eval':"P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h\<^sub>0,l\<^sub>0(V \<mapsto> v''))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>"
       and val:"P,E(V \<mapsto> T) \<turnstile> \<langle>Val v,(h', l'(V := None))\<rangle> \<Rightarrow> \<langle>Val v',(h\<^sub>0,l\<^sub>0)\<rangle>"
       and env:"(E(V \<mapsto> T)) V = Some T'" and casts':"P \<turnstile> T' casts v' to v''"
     from env have TeqT':"T = T'" by (simp add:fun_upd_same)
     from val have eq:"v = v' \<and> h' = h\<^sub>0 \<and> l'(V := None) = l\<^sub>0"
       by -(erule eval_cases,simp)
     with casts casts' wf TeqT' have "v = v''"
       by clarsimp(rule casts_casts_eq)
     with eq eval'
     have "P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h', l'(V \<mapsto> v))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>"
       by clarsimp }
   ultimately have "P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h',l'(V \<mapsto> v))\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle>" 
     and s':"s' = (h'',l''(V:=l V))"
     apply auto
     apply(erule eval_cases)
      apply(erule eval_cases) apply auto
     apply(erule eval_cases) apply auto
     apply(erule eval_cases) apply auto
     done
   with l'upd have eval'':"P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h',l')\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle>"
     by simp
   from IH[OF eval''] have "P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>" .
   with s' show ?case by(fastforce intro:Block)
 next
   case (InitBlockRed E V T e h l v' e'' h' l' v'' v s' e')
   have eval:" P,E \<turnstile> \<langle>{V:T:=Val v''; e''},(h', l'(V := l V))\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     and red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V \<mapsto> v'))\<rangle> \<rightarrow> \<langle>e'',(h', l')\<rangle>"
     and casts:"P \<turnstile> T casts v to v'" and l':"l' V = Some v''"
     and IH:"\<And>ex sx. P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h', l')\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle> \<Longrightarrow>
                      P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V \<mapsto> v'))\<rangle> \<Rightarrow> \<langle>ex,sx\<rangle>" by fact+
   from l' have l'upd:"l'(V \<mapsto> v'') = l'" by (rule map_upd_triv)
   from wf casts have "P \<turnstile> T casts v' to v'" by(rule casts_casts)
   with wf red l' have casts':"P \<turnstile> T casts v'' to v''"
     apply -
     apply(erule_tac V="V" in Some_lcl_casts_values)
     by(simp add:fun_upd_same)+
   from eval obtain h'' l''
   where "P,E(V \<mapsto> T) \<turnstile> \<langle>V:=Val v'';; e'',(h',l'(V:=None))\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle> \<and> 
     s' = (h'',l''(V:=l V))"
     by (fastforce elim:eval_cases simp:fun_upd_same fun_upd_idem)
   moreover
   { fix T' v'''
     assume eval':"P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h',l'(V \<mapsto> v'''))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>"
       and env:"(E(V \<mapsto> T)) V = Some T'" and casts'':"P \<turnstile> T' casts v'' to v'''"
     from env have "T = T'" by (simp add:fun_upd_same)
     with casts' casts'' wf have "v'' = v'''" by simp(rule casts_casts_eq)
     with eval' have "P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h', l'(V \<mapsto> v''))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>" by simp }
   ultimately have "P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h',l'(V \<mapsto> v''))\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle>"
     and s':"s' = (h'',l''(V:=l V))"
     by(auto elim!:eval_cases)
  with l'upd have eval'':"P,E(V \<mapsto> T) \<turnstile> \<langle>e'',(h',l')\<rangle> \<Rightarrow> \<langle>e',(h'',l'')\<rangle>"
     by simp
   from IH[OF eval'']
   have evale:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V \<mapsto> v'))\<rangle> \<Rightarrow> \<langle>e',(h'', l'')\<rangle>" .
   from casts
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>V:=Val v,(h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Val v',(h,l(V \<mapsto> v'))\<rangle>"
     by -(rule_tac l="l(V:=None)" in LAss,
          auto intro:eval_evals.intros simp:fun_upd_same)
   with evale s' show ?case by(fastforce intro:Block Seq)
 next
   case (RedBlock E V T v s s' e')
   have "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fact
   then obtain s': "s'=s" and e': "e'=Val v"
     by cases simp
   obtain h l where s: "s=(h,l)" by (cases s)
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>Val v,(h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Val v,(h,l(V:=None))\<rangle>" 
     by (rule eval_evals.intros)
   hence "P,E \<turnstile> \<langle>{V:T;Val v},(h,l)\<rangle> \<Rightarrow> \<langle>Val v,(h,(l(V:=None))(V:=l V))\<rangle>"
     by (rule eval_evals.Block)
   thus "P,E \<turnstile> \<langle>{V:T; Val v},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     using s s' e'
     by simp
 next
   case (RedInitBlock T v v' E V u s s' e')
   have "P,E \<turnstile> \<langle>Val u,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" and casts:"P \<turnstile> T casts v to v'" by fact+
   then obtain s': "s' = s" and e': "e'=Val u" by cases simp
   obtain h l where s: "s=(h,l)" by (cases s)
   have val:"P,E(V \<mapsto> T) \<turnstile> \<langle>Val v,(h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Val v,(h,l(V:=None))\<rangle>"
     by (rule eval_evals.intros)
   with casts
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>V:=Val v,(h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Val v',(h,l(V \<mapsto> v'))\<rangle>"
     by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
   hence "P,E \<turnstile> \<langle>{V:T :=Val v; Val u},(h,l)\<rangle> \<Rightarrow> \<langle>Val u,(h, (l(V\<mapsto>v'))(V:=l V))\<rangle>"
     by (fastforce intro!: eval_evals.intros)
   thus ?case using s s' e' by simp
 next
   case SeqRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedSeq thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case CondRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedCondT thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedCondF thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedWhile
   thus ?case by (auto simp add: unfold_while intro:eval_evals.intros elim:eval_cases)
 next
   case ThrowRed thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case RedThrowNull
   thus ?case by -(auto elim!:eval_cases intro!:eval_evals.ThrowNull eval_finalId)
 next
   case ListRed1 thus ?case by (fastforce elim: evals_cases intro: eval_evals.intros)
 next
   case ListRed2
   thus ?case by (fastforce elim!: evals_cases eval_cases 
                           intro: eval_evals.intros eval_finalId)
 next
   case StaticCastThrow
   thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case DynCastThrow
   thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case BinOpThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case BinOpThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case LAssThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case FAccThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case FAssThrow1 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case FAssThrow2 thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case CallThrowObj thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case (CallThrowParams es vs r es' E v Copt M s s' e')
   have "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow> \<langle>Val v,s\<rangle>" by (rule eval_evals.intros)
   moreover
   have es: "es = map Val vs @ Throw r # es'" by fact
   have eval_e: "P,E \<turnstile> \<langle>Throw r,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fact
   then obtain s': "s' = s" and e': "e' = Throw r"
     by cases (auto elim!:eval_cases)
   with list_eval_Throw [OF eval_e] es
   have "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>map Val vs @ Throw r # es',s'\<rangle>" by simp
   ultimately have "P,E \<turnstile> \<langle>Call (Val v) Copt M es,s\<rangle> \<Rightarrow> \<langle>Throw r,s'\<rangle>"
     by (rule eval_evals.CallParamsThrow)
   thus ?case using e' by simp
 next
   case (BlockThrow E V T r s s' e')
   have "P,E \<turnstile> \<langle>Throw r, s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" by fact
   then obtain s': "s' = s" and e': "e' = Throw r"
     by cases (auto elim!:eval_cases)
   obtain h l where s: "s=(h,l)" by (cases s)
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>Throw r, (h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Throw r, (h,l(V:=None))\<rangle>"
     by (simp add:eval_evals.intros eval_finalId)
   hence "P,E \<turnstile> \<langle>{V:T;Throw r},(h,l)\<rangle> \<Rightarrow> \<langle>Throw r, (h,(l(V:=None))(V:=l V))\<rangle>"
     by (rule eval_evals.Block)
   thus "P,E \<turnstile> \<langle>{V:T; Throw r},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" using s s' e' by simp
 next
   case (InitBlockThrow T v v' E V r s s' e')
   have "P,E \<turnstile> \<langle>Throw r,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" and casts:"P \<turnstile> T casts v to v'" by fact+
   then obtain s': "s' = s" and e': "e' = Throw r"
     by cases (auto elim!:eval_cases)
   obtain h l where s: "s = (h,l)" by (cases s)
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>Val v,(h,l(V:=None))\<rangle> \<Rightarrow> \<langle>Val v,(h,l(V:=None))\<rangle>"
     by (rule eval_evals.intros)
   with casts
   have "P,E(V \<mapsto> T) \<turnstile> \<langle>V:=Val v,(h,l(V := None))\<rangle> \<Rightarrow> \<langle>Val v',(h,l(V \<mapsto> v'))\<rangle>"
     by -(rule_tac l="l(V:=None)" in LAss,auto simp:fun_upd_same)
   hence "P,E \<turnstile> \<langle>{V:T := Val v; Throw r},(h,l)\<rangle> \<Rightarrow> \<langle>Throw r, (h, (l(V\<mapsto>v'))(V:=l V))\<rangle>"
     by(fastforce intro:eval_evals.intros)
   thus "P,E \<turnstile> \<langle>{V:T := Val v; Throw r},s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>" using s s' e' by simp
 next
   case SeqThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case CondThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 next
   case ThrowThrow thus ?case by (fastforce elim: eval_cases intro: eval_evals.intros)
 qed
 
 
 (* ... und wieder anschalten: *)
 declare split_paired_All [simp] split_paired_Ex [simp]
 setup \<open>map_theory_claset (fn ctxt => ctxt addSbefore ("split_all_tac", split_all_tac))\<close>
 setup \<open>map_theory_simpset (fn ctxt => ctxt addloop ("split_all_tac", split_all_tac))\<close>
 
 
 text \<open>Its extension to \<open>\<rightarrow>*\<close>:\<close> 
 
 lemma extend_eval:
 assumes wf: "wwf_prog P"
 and reds: "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e'',s''\<rangle>" and eval_rest:  "P,E \<turnstile> \<langle>e'',s''\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 shows "P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 
 using reds eval_rest 
 apply (induct rule: converse_rtrancl_induct2)
 apply simp
 apply simp
 apply (rule extend_1_eval)
 apply (rule wf)
 apply assumption+
 done
 
 
 
 lemma extend_evals:
 assumes wf: "wwf_prog P"
 and reds: "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es'',s''\<rangle>" and eval_rest:  "P,E \<turnstile> \<langle>es'',s''\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>"
 shows "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>"
 
 using reds eval_rest 
 apply (induct rule: converse_rtrancl_induct2)
 apply simp
 apply simp
 apply (rule extend_1_evals)
 apply (rule wf)
 apply assumption+
 done
 
 
 text \<open>Finally, small step semantics can be simulated by big step semantics:
 \<close>
 
 theorem
 assumes wf: "wwf_prog P"
 shows small_by_big: "\<lbrakk>P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>; final e'\<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
 and "\<lbrakk>P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>; finals es'\<rbrakk> \<Longrightarrow> P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>"
 
 proof -
   note wf 
   moreover assume "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
   moreover assume "final e'"
   then have "P,E \<turnstile> \<langle>e',s'\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>"
     by (rule eval_finalId)
   ultimately show "P,E \<turnstile> \<langle>e,s\<rangle>\<Rightarrow>\<langle>e',s'\<rangle>"
     by (rule extend_eval)
 next
   note wf 
   moreover assume "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
   moreover assume "finals es'"
   then have "P,E \<turnstile> \<langle>es',s'\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>"
     by (rule eval_finalsId)
   ultimately show "P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>"
     by (rule extend_evals)
 qed
 
 
 subsection \<open>Equivalence\<close>
 
 text\<open>And now, the crowning achievement:\<close>
 
 corollary big_iff_small:
   "wwf_prog P \<Longrightarrow>
   P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>  =  (P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle> \<and> final e')"
 by(blast dest: big_by_small eval_final small_by_big)
 
 
 end
diff --git a/thys/CoreC++/Exceptions.thy b/thys/CoreC++/Exceptions.thy
--- a/thys/CoreC++/Exceptions.thy
+++ b/thys/CoreC++/Exceptions.thy
@@ -1,101 +1,101 @@
 (*  Title:       CoreC++
     Author:      Gerwin Klein, Martin Strecker, Daniel Wasserrab
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 *)
 
 section \<open>Exceptions\<close>
 
 theory Exceptions imports Objects begin
 
 subsection \<open>Exceptions\<close>
 
 
 definition NullPointer :: cname where 
   "NullPointer \<equiv> ''NullPointer''"
 
 definition ClassCast :: cname where
   "ClassCast \<equiv> ''ClassCast''"
 
 definition OutOfMemory :: cname where
   "OutOfMemory \<equiv> ''OutOfMemory''"
 
 definition sys_xcpts :: "cname set" where
   "sys_xcpts  \<equiv>  {NullPointer, ClassCast, OutOfMemory}"
 
 definition addr_of_sys_xcpt :: "cname \<Rightarrow> addr" where
   "addr_of_sys_xcpt s \<equiv> if s = NullPointer then 0 else
                         if s = ClassCast then 1 else
                         if s = OutOfMemory then 2 else undefined"
 
 definition start_heap :: "prog \<Rightarrow> heap" where
-  "start_heap P \<equiv> Map.empty (addr_of_sys_xcpt NullPointer \<mapsto> blank P NullPointer)
-                        (addr_of_sys_xcpt ClassCast \<mapsto> blank P ClassCast)
-                        (addr_of_sys_xcpt OutOfMemory \<mapsto> blank P OutOfMemory)"
+  "start_heap P \<equiv> Map.empty (addr_of_sys_xcpt NullPointer \<mapsto> blank P NullPointer,
+                        addr_of_sys_xcpt ClassCast \<mapsto> blank P ClassCast,
+                        addr_of_sys_xcpt OutOfMemory \<mapsto> blank P OutOfMemory)"
 
 definition preallocated :: "heap \<Rightarrow> bool" where
   "preallocated h \<equiv> \<forall>C \<in> sys_xcpts. \<exists>S. h (addr_of_sys_xcpt C) = Some (C,S)"
 
 
 subsection "System exceptions"
 
 lemma [simp]: 
 "NullPointer \<in> sys_xcpts \<and> OutOfMemory \<in> sys_xcpts \<and> ClassCast \<in> sys_xcpts"
 by(simp add: sys_xcpts_def)
 
 
 lemma sys_xcpts_cases [consumes 1, cases set]:
   "\<lbrakk> C \<in> sys_xcpts; P NullPointer; P OutOfMemory; P ClassCast\<rbrakk> \<Longrightarrow> P C"
 by (auto simp add: sys_xcpts_def)
 
 
 subsection "@{term preallocated}"
 
 lemma preallocated_dom [simp]: 
   "\<lbrakk> preallocated h; C \<in> sys_xcpts \<rbrakk> \<Longrightarrow> addr_of_sys_xcpt C \<in> dom h"
 by (fastforce simp:preallocated_def dom_def)
 
 
 lemma preallocatedD:
   "\<lbrakk> preallocated h; C \<in> sys_xcpts \<rbrakk> \<Longrightarrow> \<exists>S. h (addr_of_sys_xcpt C) = Some (C,S)"
 by(auto simp add: preallocated_def sys_xcpts_def)
 
 
 lemma preallocatedE [elim?]:
   "\<lbrakk> preallocated h;  C \<in> sys_xcpts; \<And>S. h (addr_of_sys_xcpt C) = Some(C,S) \<Longrightarrow> P h C\<rbrakk>
   \<Longrightarrow> P h C"
 by (fast dest: preallocatedD)
 
 
 lemma cname_of_xcp [simp]:
   "\<lbrakk> preallocated h; C \<in> sys_xcpts \<rbrakk> \<Longrightarrow> cname_of h (addr_of_sys_xcpt C) = C"
 by (auto elim: preallocatedE)
 
 
 lemma preallocated_start:
   "preallocated (start_heap P)"
 by (auto simp add: start_heap_def blank_def sys_xcpts_def fun_upd_apply
                      addr_of_sys_xcpt_def preallocated_def)
 
 
 
 subsection "@{term start_heap}"
 
 lemma start_Subobj:
 "\<lbrakk>start_heap P a = Some(C, S); (Cs,fs) \<in> S\<rbrakk> \<Longrightarrow> Subobjs P C Cs"
 by (fastforce elim:init_obj.cases simp:start_heap_def blank_def 
                                     fun_upd_apply split:if_split_asm)
 
 lemma start_SuboSet:
 "\<lbrakk>start_heap P a = Some(C, S); Subobjs P C Cs\<rbrakk> \<Longrightarrow> \<exists>fs. (Cs,fs) \<in> S"
 by (fastforce intro:init_obj.intros simp:start_heap_def blank_def
                 split:if_split_asm)
 
 lemma start_init_obj: "start_heap P a = Some(C,S) \<Longrightarrow> S = Collect (init_obj P C)"
 by (auto simp:start_heap_def blank_def split:if_split_asm)
 
 lemma start_subobj:
   "\<lbrakk>start_heap P a = Some(C, S); \<exists>fs. (Cs, fs) \<in> S\<rbrakk> \<Longrightarrow> Subobjs P C Cs"
 by (fastforce elim:init_obj.cases simp:start_heap_def blank_def
                   split:if_split_asm)
 
 end
diff --git a/thys/CoreC++/Execute.thy b/thys/CoreC++/Execute.thy
--- a/thys/CoreC++/Execute.thy
+++ b/thys/CoreC++/Execute.thy
@@ -1,1377 +1,1377 @@
 (*  Title:       CoreC++
     Author:      Daniel Wasserrab, Stefan Berghofer
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 *)
 
 section \<open>Code generation for Semantics and Type System\<close>
 
 theory Execute
 imports BigStep WellType
   "HOL-Library.AList_Mapping"
   "HOL-Library.Code_Target_Numeral"
 begin
 
 subsection\<open>General redefinitions\<close>
 
 inductive app :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool"
 where
   "app [] ys ys"
 | "app xs ys zs \<Longrightarrow> app (x # xs) ys (x # zs)"
 
 theorem app_eq1: "\<And>ys zs. zs = xs @ ys \<Longrightarrow> app xs ys zs"
   apply (induct xs)
    apply simp
    apply (rule app.intros)
   apply simp
   apply (iprover intro: app.intros)
   done
 
 theorem app_eq2: "app xs ys zs \<Longrightarrow> zs = xs @ ys"
   by (erule app.induct) simp_all
 
 theorem app_eq: "app xs ys zs = (zs = xs @ ys)"
   apply (rule iffI)
    apply (erule app_eq2)
   apply (erule app_eq1)
   done
 
 code_pred
   (modes:
     i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool,
     o \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, o \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool as reverse_app)
   app
 .
 
 declare rtranclp_rtrancl_eq[code del]
 
 lemmas [code_pred_intro] = rtranclp.rtrancl_refl converse_rtranclp_into_rtranclp
 
 code_pred 
   (modes: 
    (i => o => bool) => i => i => bool,
    (i => o => bool) => i => o => bool)
   rtranclp
 by(erule converse_rtranclpE) blast+
 
 definition Set_project :: "('a \<times> 'b) set => 'a => 'b set"
 where "Set_project A a = {b. (a, b) \<in> A}"
 
 lemma Set_project_set [code]:
   "Set_project (set xs) a = set (List.map_filter (\<lambda>(a', b). if a = a' then Some b else None) xs)"
 by(auto simp add: Set_project_def map_filter_def intro: rev_image_eqI split: if_split_asm)
 
 
 text\<open>Redefine map Val vs\<close>
 
 inductive map_val :: "expr list \<Rightarrow> val list \<Rightarrow> bool"
 where
   Nil: "map_val [] []"
 | Cons: "map_val xs ys \<Longrightarrow> map_val (Val y # xs) (y # ys)"
 
 code_pred 
   (modes: i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> o \<Rightarrow> bool)
   map_val
 .
 
 inductive map_val2 :: "expr list \<Rightarrow> val list \<Rightarrow> expr list \<Rightarrow> bool"
 where
   Nil: "map_val2 [] [] []"
 | Cons: "map_val2 xs ys zs \<Longrightarrow> map_val2 (Val y # xs) (y # ys) zs"
 | Throw: "map_val2 (throw e # xs) [] (throw e # xs)"
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool)
   map_val2
 .
 
 theorem map_val_conv: "(xs = map Val ys) = map_val xs ys"
 (*<*)
 proof -
   have "\<And>ys. xs = map Val ys \<Longrightarrow> map_val xs ys"
     apply (induct xs type:list)
      apply (case_tac ys)
       apply simp
       apply (rule map_val.Nil)
      apply simp
     apply (case_tac ys)
      apply simp
     apply simp
 
     apply (rule map_val.Cons)
     apply simp
     done
   moreover have "map_val xs ys \<Longrightarrow> xs = map Val ys"
     by (erule map_val.induct) simp+
   ultimately show ?thesis ..
 qed
 (*>*)
 
 theorem map_val2_conv:
  "(xs = map Val ys @ throw e # zs) = map_val2 xs ys (throw e # zs)"
 (*<*)
 proof -
   have "\<And>ys. xs = map Val ys @ throw e # zs \<Longrightarrow> map_val2 xs ys (throw e # zs)"
     apply (induct xs type:list)
      apply (case_tac ys)
       apply simp
      apply simp
     apply simp
     apply (case_tac ys)
      apply simp
      apply (rule map_val2.Throw)
     apply simp
     apply (rule map_val2.Cons)
     apply simp
     done
   moreover have "map_val2 xs ys (throw e # zs) \<Longrightarrow> xs = map Val ys @ throw e # zs"
     by (erule map_val2.induct) simp+
   ultimately show ?thesis ..
 qed
 (*>*)
 
 
 subsection\<open>Code generation\<close>
 
 lemma subclsRp_code [code_pred_intro]:
   "\<lbrakk> class P C = \<lfloor>(Bs, rest)\<rfloor>; Predicate_Compile.contains (set Bs) (Repeats D) \<rbrakk> \<Longrightarrow> subclsRp P C D"
 by(auto intro: subclsRp.intros simp add: contains_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   subclsRp
 by(erule subclsRp.cases)(fastforce simp add: Predicate_Compile.contains_def)
 
 lemma subclsR_code [code_pred_inline]:
   "P \<turnstile> C \<prec>\<^sub>R D \<longleftrightarrow> subclsRp P C D"
 by(simp add: subclsR_def)
 
 lemma subclsSp_code [code_pred_intro]:
   "\<lbrakk> class P C = \<lfloor>(Bs, rest)\<rfloor>; Predicate_Compile.contains (set Bs) (Shares D) \<rbrakk> \<Longrightarrow> subclsSp P C D"
 by(auto intro: subclsSp.intros simp add: Predicate_Compile.contains_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   subclsSp
 by(erule subclsSp.cases)(fastforce simp add: Predicate_Compile.contains_def)
 
 declare SubobjsR_Base [code_pred_intro]
 lemma SubobjsR_Rep_code [code_pred_intro]:
   "\<lbrakk>subclsRp P C D; Subobjs\<^sub>R P D Cs\<rbrakk> \<Longrightarrow> Subobjs\<^sub>R P C (C # Cs)"
 by(simp add: SubobjsR_Rep subclsR_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   Subobjs\<^sub>R
 by(erule Subobjs\<^sub>R.cases)(auto simp add: subclsR_code)
 
 lemma subcls1p_code [code_pred_intro]:
   "\<lbrakk>class P C = Some (Bs,rest); Predicate_Compile.contains (baseClasses Bs) D \<rbrakk> \<Longrightarrow> subcls1p P C D"
 by(auto intro: subcls1p.intros simp add: Predicate_Compile.contains_def)
 
 code_pred (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   subcls1p
 by(fastforce elim!: subcls1p.cases simp add: Predicate_Compile.contains_def) 
 
 declare Subobjs_Rep [code_pred_intro]
 lemma Subobjs_Sh_code [code_pred_intro]:
   "\<lbrakk> (subcls1p P)^** C C'; subclsSp P C' D; Subobjs\<^sub>R P D Cs\<rbrakk>
   \<Longrightarrow> Subobjs P C Cs"
 by(rule Subobjs_Sh)(simp_all add: rtrancl_def subcls1_def subclsS_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   Subobjs
 by(erule Subobjs.cases)(auto simp add: rtrancl_def subcls1_def subclsS_def)
 
 definition widen_unique :: "prog \<Rightarrow> cname \<Rightarrow> cname \<Rightarrow> path \<Rightarrow> bool"
 where "widen_unique P C D Cs \<longleftrightarrow> (\<forall>Cs'. Subobjs P C Cs' \<longrightarrow> last Cs' = D \<longrightarrow> Cs = Cs')"
 
 code_pred [inductify, skip_proof] widen_unique .
 
 lemma widen_subcls':
   "\<lbrakk>Subobjs P C Cs'; last Cs' = D; widen_unique P C D Cs' \<rbrakk>
 \<Longrightarrow> P \<turnstile> Class C \<le> Class D"
 by(rule widen_subcls,auto simp:path_unique_def widen_unique_def)
 
 declare 
   widen_refl [code_pred_intro]
   widen_subcls' [code_pred_intro widen_subcls]
   widen_null [code_pred_intro]
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   widen
 by(erule widen.cases)(auto simp add: path_unique_def widen_unique_def)
 
 code_pred 
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool)
   leq_path1p 
 .
 
 lemma leq_path_unfold: "P,C \<turnstile> Cs \<sqsubseteq> Ds \<longleftrightarrow> (leq_path1p P C)^** Cs Ds"
 by(simp add: leq_path1_def rtrancl_def)
 
 code_pred
    (modes: i => i => i => o => bool, i => i => i => i =>  bool)
    [inductify,skip_proof] 
    path_via 
 .
 
 
 lemma path_unique_eq [code_pred_def]: "P \<turnstile> Path C to D unique \<longleftrightarrow>
   (\<exists>Cs. Subobjs P C Cs \<and> last Cs = D \<and> (\<forall>Cs'. Subobjs P C Cs' \<longrightarrow> last Cs' = D \<longrightarrow> Cs = Cs'))"
 by(auto simp add: path_unique_def)
 
 code_pred
    (modes: i => i => o => bool, i => i => i => bool) 
    [inductify, skip_proof]
    path_unique .
 
 text \<open>Redefine MethodDefs and FieldDecls\<close>
 
 (* FIXME: These predicates should be defined inductively in the first place! *)
 
 definition MethodDefs' :: "prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> path \<Rightarrow> method \<Rightarrow> bool" where
   "MethodDefs' P C M Cs mthd \<equiv> (Cs, mthd) \<in> MethodDefs P C M"
 
 lemma [code_pred_intro]:
   "Subobjs P C Cs \<Longrightarrow> class P (last Cs) = \<lfloor>(Bs,fs,ms)\<rfloor> \<Longrightarrow> map_of ms M =  \<lfloor>mthd\<rfloor> \<Longrightarrow>
    MethodDefs' P C M Cs mthd"
  by (simp add: MethodDefs_def MethodDefs'_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   MethodDefs'
 by(fastforce simp add: MethodDefs_def MethodDefs'_def)
 
 
 definition FieldDecls' :: "prog \<Rightarrow> cname \<Rightarrow> vname \<Rightarrow> path \<Rightarrow> ty \<Rightarrow> bool" where
   "FieldDecls' P C F Cs T \<equiv> (Cs, T) \<in> FieldDecls P C F"
 
 lemma [code_pred_intro]:
   "Subobjs P C Cs \<Longrightarrow> class P (last Cs) = \<lfloor>(Bs,fs,ms)\<rfloor> \<Longrightarrow> map_of fs F =  \<lfloor>T\<rfloor> \<Longrightarrow>
    FieldDecls' P C F Cs T"
 by (simp add: FieldDecls_def FieldDecls'_def)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   FieldDecls'
 by(fastforce simp add: FieldDecls_def FieldDecls'_def)
 
 
 
 definition MinimalMethodDefs' :: "prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> path \<Rightarrow> method \<Rightarrow> bool" where
   "MinimalMethodDefs' P C M Cs mthd \<equiv> (Cs, mthd) \<in> MinimalMethodDefs P C M"
 
 definition MinimalMethodDefs_unique :: "prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> path \<Rightarrow> bool"
 where
   "MinimalMethodDefs_unique P C M Cs \<longleftrightarrow> 
   (\<forall>Cs' mthd. MethodDefs' P C M Cs' mthd \<longrightarrow> (leq_path1p P C)^** Cs' Cs \<longrightarrow> Cs' = Cs)"
 
 code_pred [inductify, skip_proof] MinimalMethodDefs_unique .
 
 lemma [code_pred_intro]:
   "MethodDefs' P C M Cs mthd \<Longrightarrow> MinimalMethodDefs_unique P C M Cs \<Longrightarrow>
    MinimalMethodDefs' P C M Cs mthd"
 by (fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool)
   MinimalMethodDefs' 
 by(fastforce simp add:MinimalMethodDefs_def MinimalMethodDefs'_def MethodDefs'_def MinimalMethodDefs_unique_def leq_path_unfold)
 
 
 
 definition LeastMethodDef_unique :: "prog \<Rightarrow> cname \<Rightarrow> mname \<Rightarrow> path \<Rightarrow> bool"
 where
   "LeastMethodDef_unique P C M Cs \<longleftrightarrow>
   (\<forall>Cs' mthd'. MethodDefs' P C M Cs' mthd' \<longrightarrow> (leq_path1p P C)^** Cs Cs')"
 
 code_pred [inductify, skip_proof] LeastMethodDef_unique .
 
 lemma LeastMethodDef_unfold:
   "P \<turnstile> C has least M = mthd via Cs \<longleftrightarrow>
    MethodDefs' P C M Cs mthd \<and> LeastMethodDef_unique P C M Cs"
 by(fastforce simp add: LeastMethodDef_def MethodDefs'_def leq_path_unfold LeastMethodDef_unique_def)
 
 lemma LeastMethodDef_intro [code_pred_intro]:
   "\<lbrakk> MethodDefs' P C M Cs mthd; LeastMethodDef_unique P C M Cs \<rbrakk>
   \<Longrightarrow> P \<turnstile> C has least M = mthd via Cs"
 by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)
 
 code_pred (modes: i => i => i => o => o => bool)
   LeastMethodDef
 by(simp add: LeastMethodDef_unfold LeastMethodDef_unique_def)
 
 
 definition OverriderMethodDefs' :: "prog \<Rightarrow> subobj \<Rightarrow> mname \<Rightarrow> path \<Rightarrow> method \<Rightarrow> bool" where
   "OverriderMethodDefs' P R M Cs mthd \<equiv> (Cs, mthd) \<in> OverriderMethodDefs P R M"
 
 lemma Overrider1 [code_pred_intro]:
   "P \<turnstile> (ldc R) has least M = mthd' via Cs' \<Longrightarrow> 
    MinimalMethodDefs' P (mdc R) M Cs mthd \<Longrightarrow>
    last (snd R) = hd Cs' \<Longrightarrow> (leq_path1p P (mdc R))^** Cs (snd R @ tl Cs') \<Longrightarrow>
    OverriderMethodDefs' P R M Cs mthd"
 apply(simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold)
 apply(rule_tac x="Cs'" in exI)
 apply clarsimp
 apply(cases mthd')
 apply blast
 done
 
 lemma Overrider2 [code_pred_intro]:
   "P \<turnstile> (ldc R) has least M = mthd' via Cs' \<Longrightarrow> 
    MinimalMethodDefs' P (mdc R) M Cs mthd \<Longrightarrow>
    last (snd R) \<noteq> hd Cs' \<Longrightarrow> (leq_path1p P (mdc R))^** Cs Cs' \<Longrightarrow>
    OverriderMethodDefs' P R M Cs mthd"
 by(auto simp add:OverriderMethodDefs_def OverriderMethodDefs'_def MinimalMethodDefs'_def appendPath_def leq_path_unfold simp del: split_paired_Ex)
 
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   OverriderMethodDefs'
 apply(clarsimp simp add: OverriderMethodDefs'_def MinimalMethodDefs'_def MethodDefs'_def OverriderMethodDefs_def appendPath_def leq_path_unfold)
 apply(case_tac "last xb = hd Cs'")
  apply(simp)
 
 apply(thin_tac "PROP _")
 apply(simp add: leq_path1_def)
 done
 
 
 definition WTDynCast_ex :: "prog \<Rightarrow> cname \<Rightarrow> cname \<Rightarrow> bool"
 where "WTDynCast_ex P D C \<longleftrightarrow> (\<exists>Cs. P \<turnstile> Path D to C via Cs)"
 
 code_pred [inductify, skip_proof] WTDynCast_ex .
 
 lemma WTDynCast_new:
   "\<lbrakk>P,E \<turnstile> e :: Class D; is_class P C;
     P \<turnstile> Path D to C unique \<or> \<not> WTDynCast_ex P D C\<rbrakk> 
   \<Longrightarrow> P,E \<turnstile> Cast C e :: Class C"
 by(rule WTDynCast)(auto simp add: WTDynCast_ex_def)
 
 definition WTStaticCast_sub :: "prog \<Rightarrow> cname \<Rightarrow> cname \<Rightarrow> bool"
 where "WTStaticCast_sub P C D \<longleftrightarrow> 
   P \<turnstile> Path D to C unique \<or> 
   ((subcls1p P)^** C D \<and> (\<forall>Cs. P \<turnstile> Path C to D via Cs \<longrightarrow> Subobjs\<^sub>R P C Cs))"
 
 code_pred [inductify, skip_proof] WTStaticCast_sub .
 
 lemma WTStaticCast_new:
   "\<lbrakk>P,E \<turnstile> e :: Class D; is_class P C; WTStaticCast_sub P C D \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<lparr>C\<rparr>e :: Class C"
 by (rule WTStaticCast)(auto simp add: WTStaticCast_sub_def subcls1_def rtrancl_def)
 
 lemma WTBinOp1: "\<lbrakk> P,E \<turnstile> e\<^sub>1 :: T;  P,E \<turnstile> e\<^sub>2 :: T\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> e\<^sub>1 \<guillemotleft>Eq\<guillemotright> e\<^sub>2 :: Boolean"
   apply (rule WTBinOp)
   apply assumption+
   apply simp
   done
 
 lemma WTBinOp2: "\<lbrakk> P,E \<turnstile> e\<^sub>1 :: Integer;  P,E \<turnstile> e\<^sub>2 :: Integer \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> e\<^sub>1 \<guillemotleft>Add\<guillemotright> e\<^sub>2 :: Integer"
   apply (rule WTBinOp)
   apply assumption+
   apply simp
   done
 
 
 lemma LeastFieldDecl_unfold [code_pred_def]: 
   "P \<turnstile> C has least F:T via Cs \<longleftrightarrow>
    FieldDecls' P C F Cs T \<and> (\<forall>Cs' T'. FieldDecls' P C F Cs' T' \<longrightarrow> (leq_path1p P C)^** Cs Cs')"
 by(auto simp add: LeastFieldDecl_def FieldDecls'_def leq_path_unfold)
 
 code_pred [inductify, skip_proof] LeastFieldDecl .
 
 
 lemmas [code_pred_intro] = WT_WTs.WTNew
 declare
   WTDynCast_new[code_pred_intro WTDynCast_new]
   WTStaticCast_new[code_pred_intro WTStaticCast_new]
 lemmas [code_pred_intro] = WT_WTs.WTVal WT_WTs.WTVar 
 declare
   WTBinOp1[code_pred_intro WTBinOp1]
   WTBinOp2 [code_pred_intro WTBinOp2]
 lemmas [code_pred_intro] =
   WT_WTs.WTLAss WT_WTs.WTFAcc WT_WTs.WTFAss WT_WTs.WTCall WTStaticCall
   WT_WTs.WTBlock WT_WTs.WTSeq WT_WTs.WTCond WT_WTs.WTWhile WT_WTs.WTThrow
 lemmas [code_pred_intro] = WT_WTs.WTNil WT_WTs.WTCons
 
 code_pred
   (modes: WT: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool
    and WTs: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool)
   WT
 proof -
   case WT
   from WT.prems show thesis
   proof(cases (no_simp) rule: WT.cases)
     case WTDynCast thus thesis
       by(rule WT.WTDynCast_new[OF refl, unfolded WTDynCast_ex_def, simplified])
   next
     case WTStaticCast thus ?thesis
       unfolding subcls1_def rtrancl_def mem_Collect_eq prod.case
       by(rule WT.WTStaticCast_new[OF refl, unfolded WTStaticCast_sub_def])
   next
     case WTBinOp thus ?thesis
       by(split bop.split_asm)(simp_all, (erule (4) WT.WTBinOp1[OF refl] WT.WTBinOp2[OF refl])+)
   qed(assumption|erule (2) WT.that[OF refl])+
 next
   case WTs
   from WTs.prems show thesis
     by(cases (no_simp) rule: WTs.cases)(assumption|erule (2) WTs.that[OF refl])+
 qed
 
 lemma casts_to_code [code_pred_intro]:
   "(case T of Class C \<Rightarrow> False | _ \<Rightarrow> True) \<Longrightarrow> P \<turnstile> T casts v to v"
   "P \<turnstile> Class C casts Null to Null"
   "\<lbrakk>Subobjs P (last Cs) Cs'; last Cs' = C;
     last Cs = hd Cs'; Cs @ tl Cs' = Ds\<rbrakk> 
   \<Longrightarrow> P \<turnstile> Class C casts Ref(a,Cs) to Ref(a,Ds)"
   "\<lbrakk>Subobjs P (last Cs) Cs'; last Cs' = C; last Cs \<noteq> hd Cs'\<rbrakk>
   \<Longrightarrow> P \<turnstile> Class C casts Ref(a,Cs) to Ref(a,Cs')"
 by(auto intro: casts_to.intros simp add: path_via_def appendPath_def)
 
 code_pred (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   casts_to
 apply(erule casts_to.cases)
   apply(fastforce split: ty.splits)
  apply simp
 apply(fastforce simp add: appendPath_def path_via_def split: if_split_asm)
 done
 
 code_pred 
   (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   Casts_to
 .
 
 
 lemma card_eq_1_iff_ex1: "x \<in> A \<Longrightarrow> card A = 1 \<longleftrightarrow> A = {x}"
 apply(rule iffI)
  apply(rule equalityI)
   apply(rule subsetI)
   apply(subgoal_tac "card {x, xa} \<le> card A")
    apply(auto intro: ccontr)[1]
   apply(rule card_mono)
    apply simp_all
 apply(metis Suc_n_not_n card.infinite)
 done
 
 lemma FinalOverriderMethodDef_unfold [code_pred_def]:
   "P \<turnstile> R has overrider M = mthd via Cs \<longleftrightarrow>
    OverriderMethodDefs' P R M Cs mthd \<and> 
    (\<forall>Cs' mthd'. OverriderMethodDefs' P R M Cs' mthd' \<longrightarrow> Cs = Cs' \<and> mthd = mthd')"
 by(auto simp add: FinalOverriderMethodDef_def OverriderMethodDefs'_def card_eq_1_iff_ex1 simp del: One_nat_def)
 
 code_pred
   (modes: i => i => i => o => o => bool)
   [inductify, skip_proof]
   FinalOverriderMethodDef
 .
 
 code_pred
   (modes: i => i => i => i => o => o => bool, i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
   [inductify]
   SelectMethodDef 
 .
 
 text \<open>Isomorphic subo with mapping instead of a map\<close>
 
 type_synonym subo' = "(path \<times> (vname, val) mapping)"
 type_synonym obj'  = "cname \<times> subo' set"
 
 lift_definition init_class_fieldmap' :: "prog \<Rightarrow> cname \<Rightarrow> (vname, val) mapping" is "init_class_fieldmap" .
 
 lemma init_class_fieldmap'_code [code]:
   "init_class_fieldmap' P C =
      Mapping (map (\<lambda>(F,T).(F,default_val T)) (fst(snd(the(class P C)))) )"
 by transfer(simp add: init_class_fieldmap_def)
 
 lift_definition init_obj' :: "prog \<Rightarrow> cname \<Rightarrow> subo' \<Rightarrow> bool" is init_obj .
 
 lemma init_obj'_intros [code_pred_intro]: 
   "Subobjs P C Cs \<Longrightarrow> init_obj' P C (Cs, init_class_fieldmap' P (last Cs))"
 by(transfer)(rule init_obj.intros)
 
 code_pred
   (modes: i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> bool as init_obj_pred)
   init_obj'
 by transfer(erule init_obj.cases, blast)
 
 
 lemma init_obj_pred_conv: "set_of_pred (init_obj_pred P C) = Collect (init_obj' P C)"
 by(auto elim: init_obj_predE intro: init_obj_predI)
 
 lift_definition blank' :: "prog \<Rightarrow> cname \<Rightarrow> obj'" is "blank" .
 
 lemma blank'_code [code]:
   "blank' P C = (C, set_of_pred (init_obj_pred P C))"
 unfolding init_obj_pred_conv by transfer(simp add: blank_def)
 
 type_synonym heap'  = "addr \<rightharpoonup> obj'"
 
 abbreviation
   cname_of' :: "heap' \<Rightarrow> addr \<Rightarrow> cname" where
   "\<And>hp. cname_of' hp a == fst (the (hp a))"
 
 lift_definition new_Addr' :: "heap' \<Rightarrow> addr option" is "new_Addr" .
 
 lift_definition start_heap' :: "prog \<Rightarrow> heap'" is "start_heap" .
 
 lemma start_heap'_code [code]:
-  "start_heap' P = Map.empty (addr_of_sys_xcpt NullPointer \<mapsto> blank' P NullPointer)
-                        (addr_of_sys_xcpt ClassCast \<mapsto> blank' P ClassCast)
-                        (addr_of_sys_xcpt OutOfMemory \<mapsto> blank' P OutOfMemory)"
+  "start_heap' P = Map.empty (addr_of_sys_xcpt NullPointer \<mapsto> blank' P NullPointer,
+                        addr_of_sys_xcpt ClassCast \<mapsto> blank' P ClassCast,
+                        addr_of_sys_xcpt OutOfMemory \<mapsto> blank' P OutOfMemory)"
 by transfer(simp add: start_heap_def)
 
 type_synonym
   state'  = "heap' \<times> locals"
 
 lift_definition hp' :: "state' \<Rightarrow> heap'" is hp .
 
 lemma hp'_code [code]: "hp' = fst"
 by transfer simp
 
 lift_definition lcl' :: "state' \<Rightarrow> locals" is lcl .
 
 lemma lcl_code [code]: "lcl' = snd"
 by transfer simp
 
 
 lift_definition eval' :: "prog \<Rightarrow> env \<Rightarrow> expr \<Rightarrow> state' \<Rightarrow> expr \<Rightarrow> state' \<Rightarrow> bool"
           ("_,_ \<turnstile> ((1\<langle>_,/_\<rangle>) \<Rightarrow>''/ (1\<langle>_,/_\<rangle>))" [51,0,0,0,0] 81)
   is eval .
 lift_definition evals' :: "prog \<Rightarrow> env \<Rightarrow> expr list \<Rightarrow> state' \<Rightarrow> expr list \<Rightarrow> state' \<Rightarrow> bool"
            ("_,_ \<turnstile> ((1\<langle>_,/_\<rangle>) [\<Rightarrow>'']/ (1\<langle>_,/_\<rangle>))" [51,0,0,0,0] 81)
   is evals .
 
 lemma New':
   "\<lbrakk> new_Addr' h = Some a; h' = h(a\<mapsto>(blank' P C)) \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>new C,(h,l)\<rangle> \<Rightarrow>' \<langle>ref (a,[C]),(h',l)\<rangle>"
 by transfer(unfold blank_def, rule New)
 
 lemma NewFail':
   "new_Addr' h = None \<Longrightarrow>
   P,E \<turnstile> \<langle>new C, (h,l)\<rangle> \<Rightarrow>' \<langle>THROW OutOfMemory,(h,l)\<rangle>"
 by transfer(rule NewFail)
 
 lemma StaticUpCast':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs),s\<^sub>1\<rangle>; P \<turnstile> Path last Cs to C via Cs'; Ds = Cs@\<^sub>pCs' \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Ds),s\<^sub>1\<rangle>"
 by transfer(rule StaticUpCast)
 
 lemma StaticDownCast'_new:  (* requires reverse append *)
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Ds),s\<^sub>1\<rangle>; app Cs [C] Ds'; app Ds' Cs' Ds\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref(a,Cs@[C]),s\<^sub>1\<rangle>"
 apply transfer
 apply (rule StaticDownCast)
 apply (simp add: app_eq)
 done
 
 lemma StaticCastNull':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle>"
 by transfer(rule StaticCastNull)
 
 lemma StaticCastFail'_new: (* manual unfolding of subcls *)
 "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle>\<Rightarrow>' \<langle>ref (a,Cs),s\<^sub>1\<rangle>;  \<not> (subcls1p P)^** (last Cs) C; C \<notin> set Cs\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>THROW ClassCast,s\<^sub>1\<rangle>"
 apply transfer
 by (fastforce intro:StaticCastFail simp add: rtrancl_def subcls1_def)
 
 lemma StaticCastThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>\<lparr>C\<rparr>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule StaticCastThrow)
 
 lemma StaticUpDynCast':
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref(a,Cs),s\<^sub>1\<rangle>; P \<turnstile> Path last Cs to C unique;
     P \<turnstile> Path last Cs to C via Cs'; Ds = Cs@\<^sub>pCs' \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref(a,Ds),s\<^sub>1\<rangle>"
 by transfer(rule StaticUpDynCast)
 
 lemma StaticDownDynCast'_new: (* requires reverse append *)
   "\<lbrakk>P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Ds),s\<^sub>1\<rangle>; app Cs [C] Ds'; app Ds' Cs' Ds\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref(a,Cs@[C]),s\<^sub>1\<rangle>"
 apply transfer
 apply (rule StaticDownDynCast)
 apply (simp add: app_eq)
 done
 
 lemma DynCast':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs),(h,l)\<rangle>; h a = Some(D,S);
     P \<turnstile> Path D to C via Cs'; P \<turnstile> Path D to C unique \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs'),(h,l)\<rangle>"
 by transfer(rule DynCast)
 
 lemma DynCastNull':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle>"
 by transfer(rule DynCastNull)
 
 lemma DynCastFail':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle>\<Rightarrow>' \<langle>ref (a,Cs),(h,l)\<rangle>; h a = Some(D,S); \<not> P \<turnstile> Path D to C unique;
     \<not> P \<turnstile> Path last Cs to C unique; C \<notin> set Cs \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,(h,l)\<rangle>"
 by transfer(rule DynCastFail)
 
 lemma DynCastThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>Cast C e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule DynCastThrow)
 
 lemma Val':
   "P,E \<turnstile> \<langle>Val v,s\<rangle> \<Rightarrow>' \<langle>Val v,s\<rangle>"
 by transfer(rule Val)
 
 lemma BinOp':
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>2,s\<^sub>2\<rangle>; 
     binop(bop,v\<^sub>1,v\<^sub>2) = Some v \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle>\<Rightarrow>'\<langle>Val v,s\<^sub>2\<rangle>"
 by transfer(rule BinOp)
 
 lemma BinOpThrow1':
   "P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2, s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>1\<rangle>"
 by transfer(rule BinOpThrow1)
 
 lemma BinOpThrow2':
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>2\<rangle>"
 by transfer(rule BinOpThrow2)
 
 lemma Var':
   "l V = Some v \<Longrightarrow>
   P,E \<turnstile> \<langle>Var V,(h,l)\<rangle> \<Rightarrow>' \<langle>Val v,(h,l)\<rangle>"
 by transfer(rule Var)
 
 lemma LAss':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v,(h,l)\<rangle>; E V = Some T;
      P \<turnstile> T casts v to v'; l' = l(V\<mapsto>v') \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>V:=e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v',(h,l')\<rangle>"
 by (transfer) (erule (3) LAss)
 
 lemma LAssThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>V:=e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule LAssThrow)
 
 lemma FAcc'_new: (* iteration over set *)
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs'),(h,l)\<rangle>; h a = Some(D,S);
      Ds = Cs'@\<^sub>pCs; Predicate_Compile.contains (Set_project S Ds) fs; Mapping.lookup fs F = Some v \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v,(h,l)\<rangle>"
 unfolding Set_project_def mem_Collect_eq Predicate_Compile.contains_def
 by transfer(rule FAcc)
 
 lemma FAccNull':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow>' \<langle>THROW NullPointer,s\<^sub>1\<rangle>" 
 by transfer(rule FAccNull)
 
 lemma FAccThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<bullet>F{Cs},s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule FAccThrow)
 
 lemma FAss'_new: (* iteration over set *)
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs'),s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v,(h\<^sub>2,l\<^sub>2)\<rangle>;
      h\<^sub>2 a = Some(D,S); P \<turnstile> (last Cs') has least F:T via Cs; P \<turnstile> T casts v to v';
      Ds = Cs'@\<^sub>pCs;  Predicate_Compile.contains (Set_project S Ds) fs; fs' = Mapping.update F v' fs;
      S' = S - {(Ds,fs)} \<union> {(Ds,fs')}; h\<^sub>2' = h\<^sub>2(a\<mapsto>(D,S'))\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v',(h\<^sub>2',l\<^sub>2)\<rangle>"
 unfolding Predicate_Compile.contains_def Set_project_def mem_Collect_eq
 by transfer(rule FAss)
 
 lemma FAssNull':
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle>;  P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v,s\<^sub>2\<rangle> \<rbrakk> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>THROW NullPointer,s\<^sub>2\<rangle>" 
 by transfer(rule FAssNull)
 
 lemma FAssThrow1':
   "P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule FAssThrow1)
 
 lemma FAssThrow2':
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1\<bullet>F{Cs}:=e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle>"
 by transfer(rule FAssThrow2)
 
 lemma CallObjThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule CallObjThrow)
 
 lemma CallParamsThrow'_new: (* requires inverse map Val and append *)
   "\<lbrakk> P,E \<turnstile> \<langle>e,s0\<rangle> \<Rightarrow>' \<langle>Val v,s1\<rangle>; P,E \<turnstile> \<langle>es,s1\<rangle> [\<Rightarrow>'] \<langle>evs,s2\<rangle>;
      map_val2 evs vs (throw ex # es') \<rbrakk>
    \<Longrightarrow> P,E \<turnstile> \<langle>Call e Copt M es,s0\<rangle> \<Rightarrow>' \<langle>throw ex,s2\<rangle>"
 apply transfer
 apply(rule eval_evals.CallParamsThrow, assumption+)
 apply(simp add: map_val2_conv[symmetric])
 done
 
 lemma Call'_new: (* requires inverse map Val *)
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs),s\<^sub>1\<rangle>;  P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>evs,(h\<^sub>2,l\<^sub>2)\<rangle>;
      map_val evs vs;
      h\<^sub>2 a = Some(C,S);  P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds;
      P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'; length vs = length pns; 
      P \<turnstile> Ts Casts vs to vs'; l\<^sub>2' = [this\<mapsto>Ref (a,Cs'), pns[\<mapsto>]vs'];
      new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body   | _  \<Rightarrow> body);  
      P,E(this\<mapsto>Class(last Cs'), pns[\<mapsto>]Ts) \<turnstile> \<langle>new_body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>M(ps),s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3,l\<^sub>2)\<rangle>"
 apply transfer
 apply(rule Call)
 apply assumption+
 apply(simp add: map_val_conv[symmetric])
 apply assumption+
 done
 
 lemma StaticCall'_new: (* requires inverse map Val *)
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a,Cs),s\<^sub>1\<rangle>;  P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>evs,(h\<^sub>2,l\<^sub>2)\<rangle>;
      map_val evs vs;
      P \<turnstile> Path (last Cs) to C unique; P \<turnstile> Path (last Cs) to C via Cs'';
      P \<turnstile> C has least M = (Ts,T,pns,body) via Cs'; Ds = (Cs@\<^sub>pCs'')@\<^sub>pCs';
      length vs = length pns; P \<turnstile> Ts Casts vs to vs'; 
      l\<^sub>2' = [this\<mapsto>Ref (a,Ds), pns[\<mapsto>]vs'];
      P,E(this\<mapsto>Class(last Ds), pns[\<mapsto>]Ts) \<turnstile> \<langle>body,(h\<^sub>2,l\<^sub>2')\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3,l\<^sub>3)\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<bullet>(C::)M(ps),s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3,l\<^sub>2)\<rangle>"
 apply transfer
 apply(rule StaticCall)
 apply(assumption)+
 apply(simp add: map_val_conv[symmetric])
 apply assumption+
 done
 
 lemma CallNull'_new: (* requires inverse map Val *)
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle>;  P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>evs,s\<^sub>2\<rangle>; map_val evs vs \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>Call e Copt M es,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>THROW NullPointer,s\<^sub>2\<rangle>"
 apply transfer
 apply(rule CallNull, assumption+)
 apply(simp add: map_val_conv[symmetric])
 done
 
 lemma Block':
   "\<lbrakk>P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0,l\<^sub>0(V:=None))\<rangle> \<Rightarrow>' \<langle>e\<^sub>1,(h\<^sub>1,l\<^sub>1)\<rangle> \<rbrakk> \<Longrightarrow>
   P,E \<turnstile> \<langle>{V:T; e\<^sub>0},(h\<^sub>0,l\<^sub>0)\<rangle> \<Rightarrow>' \<langle>e\<^sub>1,(h\<^sub>1,l\<^sub>1(V:=l\<^sub>0 V))\<rangle>"
 by transfer(rule Block)
 
 lemma Seq':
   "\<lbrakk> P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e\<^sub>2,s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>0;;e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e\<^sub>2,s\<^sub>2\<rangle>"
 by transfer(rule Seq)
 
 lemma SeqThrow':
   "P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e\<^sub>0;;e\<^sub>1,s\<^sub>0\<rangle>\<Rightarrow>'\<langle>throw e,s\<^sub>1\<rangle>"
 by transfer(rule SeqThrow)
 
 lemma CondT':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle>"
 by transfer(rule CondT)
 
 lemma CondF':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>false,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle>"
 by transfer(rule CondF)
 
 lemma CondThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>if (e) e\<^sub>1 else e\<^sub>2, s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule CondThrow)
 
 lemma WhileF':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>false,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>unit,s\<^sub>1\<rangle>"
 by transfer(rule WhileF)
 
 lemma WhileT':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>2\<rangle>; 
      P,E \<turnstile> \<langle>while (e) c,s\<^sub>2\<rangle> \<Rightarrow>' \<langle>e\<^sub>3,s\<^sub>3\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>e\<^sub>3,s\<^sub>3\<rangle>"
 by transfer(rule WhileT)
 
 lemma WhileCondThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle> throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule WhileCondThrow)
 
 lemma WhileBodyThrow':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle>\<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>while (e) c,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle>"
 by transfer(rule WhileBodyThrow)
 
 lemma Throw':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref r,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Throw r,s\<^sub>1\<rangle>"
 by transfer(rule eval_evals.Throw)
 
 lemma ThrowNull':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>THROW NullPointer,s\<^sub>1\<rangle>"
 by transfer(rule ThrowNull)
 
 lemma ThrowThrow':
   "P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>throw e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle>"
 by transfer(rule ThrowThrow)
 
 lemma Nil':
   "P,E \<turnstile> \<langle>[],s\<rangle> [\<Rightarrow>'] \<langle>[],s\<rangle>"
 by transfer(rule eval_evals.Nil)
 
 lemma Cons':
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v,s\<^sub>1\<rangle>; P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>es',s\<^sub>2\<rangle> \<rbrakk>
   \<Longrightarrow> P,E \<turnstile> \<langle>e#es,s\<^sub>0\<rangle> [\<Rightarrow>'] \<langle>Val v # es',s\<^sub>2\<rangle>"
 by transfer(rule eval_evals.Cons)
 
 lemma ConsThrow':
   "P,E \<turnstile> \<langle>e, s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e', s\<^sub>1\<rangle> \<Longrightarrow>
   P,E \<turnstile> \<langle>e#es, s\<^sub>0\<rangle> [\<Rightarrow>'] \<langle>throw e' # es, s\<^sub>1\<rangle>"
 by transfer(rule ConsThrow)
 
 text \<open>Axiomatic heap address model refinement\<close>
 
 partial_function (option) lowest :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat option"
 where
   [code]: "lowest P n = (if P n then Some n else lowest P (Suc n))"
 
 axiomatization
 where
   new_Addr'_code [code]: "new_Addr' h = lowest (Option.is_none \<circ> h) 0"
     \<comment> \<open>admissible: a tightening of the specification of @{const new_Addr'}\<close>
 
 lemma eval'_cases
   [consumes 1,
    case_names New NewFail StaticUpCast StaticDownCast StaticCastNull StaticCastFail
     StaticCastThrow StaticUpDynCast StaticDownDynCast DynCast DynCastNull DynCastFail
     DynCastThrow Val BinOp BinOpThrow1 BinOpThrow2 Var LAss LAssThrow FAcc FAccNull FAccThrow
     FAss FAssNull FAssThrow1 FAssThrow2 CallObjThrow CallParamsThrow Call StaticCall CallNull
     Block Seq SeqThrow CondT CondF CondThrow WhileF WhileT WhileCondThrow WhileBodyThrow
     Throw ThrowNull ThrowThrow]:
   assumes "P,x \<turnstile> \<langle>y,z\<rangle> \<Rightarrow>' \<langle>u,v\<rangle>"
   and "\<And>h a h' C E l. x = E \<Longrightarrow> y = new C \<Longrightarrow> z = (h, l) \<Longrightarrow> u = ref (a, [C]) \<Longrightarrow>
     v = (h', l) \<Longrightarrow> new_Addr' h = \<lfloor>a\<rfloor> \<Longrightarrow> h' = h(a \<mapsto> blank' P C) \<Longrightarrow> thesis"
   and "\<And>h E C l. x = E \<Longrightarrow> y = new C \<Longrightarrow> z = (h, l) \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt OutOfMemory, [OutOfMemory]) \<Longrightarrow>
     v = (h, l) \<Longrightarrow> new_Addr' h = None \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs s\<^sub>1 C Cs' Ds. x = E \<Longrightarrow> y = \<lparr>C\<rparr>e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = ref (a, Ds) \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),s\<^sub>1\<rangle> \<Longrightarrow>
     P \<turnstile> Path last Cs to C via Cs'  \<Longrightarrow> Ds = Cs @\<^sub>p Cs' \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs C Cs' s\<^sub>1. x = E \<Longrightarrow> y = \<lparr>C\<rparr>e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = ref (a, Cs @ [C]) \<Longrightarrow>
     v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs @ [C] @ Cs'),s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 C. x = E \<Longrightarrow> y = \<lparr>C\<rparr>e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = null \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
    P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs s\<^sub>1 C. x = E \<Longrightarrow> y = \<lparr>C\<rparr>e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt ClassCast, [ClassCast]) \<Longrightarrow>  v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),s\<^sub>1\<rangle> \<Longrightarrow> (last Cs, C) \<notin> (subcls1 P)\<^sup>* \<Longrightarrow> C \<notin> set Cs \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 C. x = E \<Longrightarrow> y = \<lparr>C\<rparr>e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs s\<^sub>1 C Cs' Ds. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = ref (a, Ds) \<Longrightarrow>
     v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),s\<^sub>1\<rangle> \<Longrightarrow> P \<turnstile> Path last Cs to C unique \<Longrightarrow>
     P \<turnstile> Path last Cs to C via Cs'  \<Longrightarrow> Ds = Cs @\<^sub>p Cs' \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs C Cs' s\<^sub>1. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = ref (a, Cs @ [C]) \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs @ [C] @ Cs'),s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs h l D S C Cs'. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = ref (a, Cs') \<Longrightarrow> v = (h, l) \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),(h, l)\<rangle> \<Longrightarrow>
     h a = \<lfloor>(D, S)\<rfloor> \<Longrightarrow> P \<turnstile> Path D to C via Cs'  \<Longrightarrow> P \<turnstile> Path D to C unique \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 C. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = null \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> 
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> thesis" 
   and "\<And>E e s\<^sub>0 a Cs h l D S C. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = null \<Longrightarrow>
     v = (h, l) \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),(h, l)\<rangle> \<Longrightarrow> h a = \<lfloor>(D, S)\<rfloor> \<Longrightarrow>
     \<not> P \<turnstile> Path D to C unique \<Longrightarrow> \<not> P \<turnstile> Path last Cs to C unique \<Longrightarrow> C \<notin> set Cs \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 C. x = E \<Longrightarrow> y = Cast C e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1
     \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E va s. x = E \<Longrightarrow> y = Val va \<Longrightarrow> z = s \<Longrightarrow> u = Val va \<Longrightarrow> v = s \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 v\<^sub>1 s\<^sub>1 e\<^sub>2 v\<^sub>2 s\<^sub>2 bop va. x = E \<Longrightarrow> y = e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Val va \<Longrightarrow> v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>1\<rangle> \<Longrightarrow>
     P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>2,s\<^sub>2\<rangle> \<Longrightarrow> binop (bop, v\<^sub>1, v\<^sub>2) = \<lfloor>va\<rfloor> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 e s\<^sub>1 bop e\<^sub>2. x = E \<Longrightarrow> y = e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e \<Longrightarrow> v = s\<^sub>1  \<Longrightarrow>
     P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 v\<^sub>1 s\<^sub>1 e\<^sub>2 e s\<^sub>2 bop. x = E \<Longrightarrow> y = e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>l V va E h. x = E \<Longrightarrow> y = Var V \<Longrightarrow> z = (h, l) \<Longrightarrow> u = Val va \<Longrightarrow> v = (h, l) \<Longrightarrow>
     l V = \<lfloor>va\<rfloor> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 va h l V T v' l'. x = E \<Longrightarrow> y = V:=e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = Val v' \<Longrightarrow>
     v = (h, l') \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val va,(h, l)\<rangle> \<Longrightarrow>
     E V = \<lfloor>T\<rfloor> \<Longrightarrow> P \<turnstile> T casts va to v'  \<Longrightarrow> l' = l(V \<mapsto> v') \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 V. x = E \<Longrightarrow> y = V:=e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs' h l D S Ds Cs fs F va. x = E \<Longrightarrow> y = e\<bullet>F{Cs} \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Val va \<Longrightarrow> v = (h, l) \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs'),(h, l)\<rangle> \<Longrightarrow>
     h a = \<lfloor>(D, S)\<rfloor> \<Longrightarrow> Ds = Cs' @\<^sub>p Cs \<Longrightarrow> (Ds, fs) \<in> S \<Longrightarrow> Mapping.lookup fs F = \<lfloor>va\<rfloor> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 F Cs. x = E \<Longrightarrow> y = e\<bullet>F{Cs} \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) \<Longrightarrow>
     v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 F Cs. x = E \<Longrightarrow> y = e\<bullet>F{Cs} \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 a Cs' s\<^sub>1 e\<^sub>2 va h\<^sub>2 l\<^sub>2 D S F T Cs v' Ds fs fs' S' h\<^sub>2'.
     x = E \<Longrightarrow> y = e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = Val v' \<Longrightarrow> v = (h\<^sub>2', l\<^sub>2) \<Longrightarrow>
     P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs'),s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val va,(h\<^sub>2, l\<^sub>2)\<rangle> \<Longrightarrow>
     h\<^sub>2 a = \<lfloor>(D, S)\<rfloor> \<Longrightarrow> P \<turnstile> last Cs' has least F:T via Cs \<Longrightarrow>
     P \<turnstile> T casts va to v'  \<Longrightarrow> Ds = Cs' @\<^sub>p Cs \<Longrightarrow> (Ds, fs) \<in> S \<Longrightarrow> fs' = Mapping.update F v' fs \<Longrightarrow>
     S' = S - {(Ds, fs)} \<union> {(Ds, fs')} \<Longrightarrow> h\<^sub>2' = h\<^sub>2(a \<mapsto> (D, S')) \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 s\<^sub>1 e\<^sub>2 va s\<^sub>2 F Cs. x = E \<Longrightarrow> y = e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val va,s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 e' s\<^sub>1 F Cs e\<^sub>2. x = E \<Longrightarrow> y = e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>1 s\<^sub>0 va s\<^sub>1 e\<^sub>2 e' s\<^sub>2 F Cs. x = E \<Longrightarrow> y = e\<^sub>1\<bullet>F{Cs} := e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = throw e' \<Longrightarrow> v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val va,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle> \<Longrightarrow> 
     thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 Copt M es. x = E \<Longrightarrow> y = Call e Copt M es \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 va s\<^sub>1 es vs ex es' s\<^sub>2 Copt M. x = E \<Longrightarrow> y = Call e Copt M es \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = throw ex \<Longrightarrow> v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val va,s\<^sub>1\<rangle> \<Longrightarrow>
     P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>map Val vs @ throw ex # es',s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 a Cs s\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C S M Ts' T' pns' body' Ds Ts T pns body Cs' vs' l\<^sub>2' new_body e'
     h\<^sub>3 l\<^sub>3. x = E \<Longrightarrow> y = Call e None M ps \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = e' \<Longrightarrow> v = (h\<^sub>3, l\<^sub>2) \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>map Val vs,(h\<^sub>2, l\<^sub>2)\<rangle> \<Longrightarrow>
     h\<^sub>2 a = \<lfloor>(C, S)\<rfloor> \<Longrightarrow> P \<turnstile> last Cs has least M = (Ts', T', pns', body') via Ds \<Longrightarrow>
     P \<turnstile> (C,Cs @\<^sub>p Ds) selects M = (Ts, T, pns, body) via Cs' \<Longrightarrow> length vs = length pns \<Longrightarrow>
     P \<turnstile> Ts Casts vs to vs'  \<Longrightarrow> l\<^sub>2' = [this \<mapsto> Ref (a, Cs'), pns [\<mapsto>] vs'] \<Longrightarrow>
     new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>body | _ \<Rightarrow> body) \<Longrightarrow>
     P,E(this \<mapsto> Class (last Cs'), pns [\<mapsto>] Ts) \<turnstile> \<langle>new_body,(h\<^sub>2, l\<^sub>2')\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle> \<Longrightarrow>
     thesis"
   and "\<And>E e s\<^sub>0 a Cs s\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 C Cs'' M Ts T pns body Cs' Ds vs' l\<^sub>2' e' h\<^sub>3 l\<^sub>3.
     x = E \<Longrightarrow> y = Call e \<lfloor>C\<rfloor> M ps \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = e' \<Longrightarrow> v = (h\<^sub>3, l\<^sub>2) \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref (a, Cs),s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>ps,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>map Val vs,(h\<^sub>2, l\<^sub>2)\<rangle> \<Longrightarrow>
     P \<turnstile> Path last Cs to C unique \<Longrightarrow> P \<turnstile> Path last Cs to C via Cs''  \<Longrightarrow>
     P \<turnstile> C has least M = (Ts, T, pns, body) via Cs' \<Longrightarrow> Ds = (Cs @\<^sub>p Cs'') @\<^sub>p Cs' \<Longrightarrow>
     length vs = length pns \<Longrightarrow> P \<turnstile> Ts Casts vs to vs'  \<Longrightarrow>
     l\<^sub>2' = [this \<mapsto> Ref (a, Ds), pns [\<mapsto>] vs'] \<Longrightarrow>
     P,E(this \<mapsto> Class (last Ds), pns [\<mapsto>] Ts) \<turnstile> \<langle>body,(h\<^sub>2, l\<^sub>2')\<rangle> \<Rightarrow>' \<langle>e',(h\<^sub>3, l\<^sub>3)\<rangle> \<Longrightarrow>
     thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 es vs s\<^sub>2 Copt M. x = E \<Longrightarrow> y = Call e Copt M es \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>es,s\<^sub>1\<rangle> [\<Rightarrow>'] \<langle>map Val vs,s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E V T e\<^sub>0 h\<^sub>0 l\<^sub>0 e\<^sub>1 h\<^sub>1 l\<^sub>1.
     x = E \<Longrightarrow> y = {V:T; e\<^sub>0} \<Longrightarrow> z = (h\<^sub>0, l\<^sub>0) \<Longrightarrow> u = e\<^sub>1 \<Longrightarrow>
     v = (h\<^sub>1, l\<^sub>1(V := l\<^sub>0 V)) \<Longrightarrow> P,E(V \<mapsto> T) \<turnstile> \<langle>e\<^sub>0,(h\<^sub>0, l\<^sub>0(V := None))\<rangle> \<Rightarrow>' \<langle>e\<^sub>1,(h\<^sub>1, l\<^sub>1)\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>0 s\<^sub>0 va s\<^sub>1 e\<^sub>1 e\<^sub>2 s\<^sub>2. x = E \<Longrightarrow> y = e\<^sub>0;; e\<^sub>1 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = e\<^sub>2 \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>Val va,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e\<^sub>2,s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e\<^sub>0 s\<^sub>0 e s\<^sub>1 e\<^sub>1. x = E \<Longrightarrow> y = e\<^sub>0;; e\<^sub>1 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e\<^sub>0,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 e\<^sub>1 e' s\<^sub>2 e\<^sub>2. x = E \<Longrightarrow> y = if (e) e\<^sub>1 else e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = e' \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>1,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 e\<^sub>2 e' s\<^sub>2 e\<^sub>1. x = E \<Longrightarrow> y = if (e) e\<^sub>1 else e\<^sub>2 \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = e' \<Longrightarrow> v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>false,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>e\<^sub>2,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>e',s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 e\<^sub>1 e\<^sub>2. x = E \<Longrightarrow> y = if (e) e\<^sub>1 else e\<^sub>2 \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 c. x = E \<Longrightarrow> y = while (e) c \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = unit \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow>
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>false,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 c v\<^sub>1 s\<^sub>2 e\<^sub>3 s\<^sub>3. x = E \<Longrightarrow> y = while (e) c \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = e\<^sub>3 \<Longrightarrow>
     v = s\<^sub>3 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>Val v\<^sub>1,s\<^sub>2\<rangle> \<Longrightarrow>
     P,E \<turnstile> \<langle>while (e) c,s\<^sub>2\<rangle> \<Rightarrow>' \<langle>e\<^sub>3,s\<^sub>3\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1 c. x = E \<Longrightarrow> y = while (e) c \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> 
     P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1 c e' s\<^sub>2. x = E \<Longrightarrow> y = while (e) c \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow>
     v = s\<^sub>2 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>true,s\<^sub>1\<rangle> \<Longrightarrow> P,E \<turnstile> \<langle>c,s\<^sub>1\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>2\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 r s\<^sub>1. x = E \<Longrightarrow> y = throw e \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = Throw r \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>ref r,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 s\<^sub>1. x = E \<Longrightarrow> y = throw e \<Longrightarrow> z = s\<^sub>0 \<Longrightarrow>
     u = Throw (addr_of_sys_xcpt NullPointer, [NullPointer]) \<Longrightarrow>
     v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>null,s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   and "\<And>E e s\<^sub>0 e' s\<^sub>1. x = E \<Longrightarrow> y = throw e \<Longrightarrow>
     z = s\<^sub>0 \<Longrightarrow> u = throw e' \<Longrightarrow> v = s\<^sub>1 \<Longrightarrow> P,E \<turnstile> \<langle>e,s\<^sub>0\<rangle> \<Rightarrow>' \<langle>throw e',s\<^sub>1\<rangle> \<Longrightarrow> thesis"
   shows thesis
 using assms
 by(transfer)(erule eval.cases, unfold blank_def, assumption+)
 
 lemmas [code_pred_intro] = New' NewFail' StaticUpCast'
 declare StaticDownCast'_new[code_pred_intro StaticDownCast']
 lemmas [code_pred_intro] = StaticCastNull'
 declare StaticCastFail'_new[code_pred_intro StaticCastFail']
 lemmas [code_pred_intro] = StaticCastThrow' StaticUpDynCast'
 declare
   StaticDownDynCast'_new[code_pred_intro StaticDownDynCast']
   DynCast'[code_pred_intro DynCast']
 lemmas [code_pred_intro] = DynCastNull'
 declare DynCastFail'[code_pred_intro DynCastFail']
 lemmas [code_pred_intro] = DynCastThrow' Val' BinOp' BinOpThrow1'
 declare BinOpThrow2'[code_pred_intro BinOpThrow2']
 lemmas [code_pred_intro] = Var' LAss' LAssThrow'
 declare FAcc'_new[code_pred_intro FAcc']
 lemmas [code_pred_intro] = FAccNull' FAccThrow'
 declare FAss'_new[code_pred_intro FAss']
 lemmas [code_pred_intro] = FAssNull' FAssThrow1'
 declare FAssThrow2'[code_pred_intro FAssThrow2']
 lemmas [code_pred_intro] = CallObjThrow'
 declare
   CallParamsThrow'_new[code_pred_intro CallParamsThrow']
   Call'_new[code_pred_intro Call']
   StaticCall'_new[code_pred_intro StaticCall']
   CallNull'_new[code_pred_intro CallNull']
 lemmas [code_pred_intro] = Block' Seq'
 declare SeqThrow'[code_pred_intro SeqThrow']
 lemmas [code_pred_intro] = CondT'
 declare 
   CondF'[code_pred_intro CondF']
   CondThrow'[code_pred_intro CondThrow']
 lemmas [code_pred_intro] = WhileF' WhileT'
 declare
   WhileCondThrow'[code_pred_intro WhileCondThrow']
   WhileBodyThrow'[code_pred_intro WhileBodyThrow']
 lemmas [code_pred_intro] = Throw'
 declare ThrowNull'[code_pred_intro ThrowNull']
 lemmas [code_pred_intro] = ThrowThrow'
 lemmas [code_pred_intro] = Nil' Cons' ConsThrow'
 
 code_pred 
   (modes: eval': i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool as big_step
    and evals': i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> o \<Rightarrow> o \<Rightarrow> bool as big_steps)
   eval'
 proof -
   case eval'
   from eval'.prems show thesis
   proof(cases (no_simp) rule: eval'_cases)
     case (StaticDownCast E C e s\<^sub>0 a Cs Cs' s\<^sub>1)
     moreover
     have "app a [Cs] (a @ [Cs])" "app (a @ [Cs]) Cs' (a @ [Cs] @ Cs')"
       by(simp_all add: app_eq)
     ultimately show ?thesis by(rule eval'.StaticDownCast'[OF refl])
   next
     case StaticCastFail thus ?thesis
       unfolding rtrancl_def subcls1_def mem_Collect_eq prod.case
       by(rule eval'.StaticCastFail'[OF refl])
   next
     case (StaticDownDynCast E e s\<^sub>0 a Cs C Cs' s\<^sub>1)
     moreover have "app Cs [C] (Cs @ [C])" "app (Cs @ [C]) Cs' (Cs @ [C] @ Cs')"
       by(simp_all add: app_eq)
     ultimately show thesis by(rule eval'.StaticDownDynCast'[OF refl])
   next
     case DynCast thus ?thesis by(rule eval'.DynCast'[OF refl])
   next
     case DynCastFail thus ?thesis by(rule eval'.DynCastFail'[OF refl])
   next
     case BinOpThrow2 thus ?thesis by(rule eval'.BinOpThrow2'[OF refl])
   next
     case FAcc thus ?thesis
       by(rule eval'.FAcc'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
   next
     case FAss thus ?thesis
       by(rule eval'.FAss'[OF refl, unfolded Predicate_Compile.contains_def Set_project_def mem_Collect_eq])
   next
     case FAssThrow2 thus ?thesis by(rule eval'.FAssThrow2'[OF refl])
   next
     case (CallParamsThrow E e s\<^sub>0 v s\<^sub>1 es vs ex es' s\<^sub>2 Copt M)
     moreover have "map_val2 (map Val vs @ throw ex # es') vs (throw ex # es')"
       by(simp add: map_val2_conv[symmetric])
     ultimately show ?thesis by(rule eval'.CallParamsThrow'[OF refl])
   next
     case (Call E e s\<^sub>0 a Cs s\<^sub>1 ps vs)
     moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
     ultimately show ?thesis by-(rule eval'.Call'[OF refl])
   next
     case (StaticCall E e s\<^sub>0 a Cs s\<^sub>1 ps vs)
     moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
     ultimately show ?thesis by-(rule eval'.StaticCall'[OF refl])
   next
     case (CallNull E e s\<^sub>0 s\<^sub>1 es vs)
     moreover have "map_val (map Val vs) vs" by(simp add: map_val_conv[symmetric])
     ultimately show ?thesis by-(rule eval'.CallNull'[OF refl])
   next
     case SeqThrow thus ?thesis by(rule eval'.SeqThrow'[OF refl])
   next
     case CondF thus ?thesis by(rule eval'.CondF'[OF refl])
   next
     case CondThrow thus ?thesis by(rule eval'.CondThrow'[OF refl])
   next
     case WhileCondThrow thus ?thesis by(rule eval'.WhileCondThrow'[OF refl])
   next
     case WhileBodyThrow thus ?thesis by(rule eval'.WhileBodyThrow'[OF refl])
   next
     case ThrowNull thus ?thesis by(rule eval'.ThrowNull'[OF refl])
   qed(assumption|erule (4) eval'.that[OF refl])+
 next
   case evals'
   from evals'.prems evals'.that[OF refl]
   show thesis by transfer(erule evals.cases)
 qed
 
 subsection \<open>Examples\<close>
 
 declare [[values_timeout = 180]]
 
 values [expected "{Val (Intg 5)}"]
   "{fst (e', s') | e' s'. 
     [],Map.empty \<turnstile> \<langle>{''V'':Integer; ''V'' :=  Val(Intg 5);; Var ''V''},(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 11)}"]
   "{fst (e', s') | e' s'. 
     [],Map.empty \<turnstile> \<langle>(Val(Intg 5)) \<guillemotleft>Add\<guillemotright> (Val(Intg 6)),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 83)}"]
   "{fst (e', s') | e' s'. 
     [],[''V''\<mapsto>Integer] \<turnstile> \<langle>(Var ''V'') \<guillemotleft>Add\<guillemotright> (Val(Intg 6)),
                                        (Map.empty,[''V''\<mapsto>Intg 77])\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Some (Intg 6)}"]
   "{lcl' (snd (e', s')) ''V''  | e' s'. 
     [],[''V''\<mapsto>Integer] \<turnstile> \<langle>''V'' := Val(Intg 6),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Some (Intg 12)}"]
   "{lcl' (snd (e', s')) ''mult''  | e' s'. 
     [],[''V''\<mapsto>Integer,''a''\<mapsto>Integer,''b''\<mapsto>Integer,''mult''\<mapsto>Integer]
     \<turnstile> \<langle>(''a'' := Val(Intg 3));;(''b'' := Val(Intg 4));;(''mult'' := Val(Intg 0));;
        (''V'' := Val(Intg 1));;
        while (Var ''V'' \<guillemotleft>Eq\<guillemotright> Val(Intg 1))((''mult'' := Var ''mult'' \<guillemotleft>Add\<guillemotright> Var ''b'');;
          (''a'' := Var ''a'' \<guillemotleft>Add\<guillemotright> Val(Intg (- 1)));;
          (''V'' := (if(Var ''a'' \<guillemotleft>Eq\<guillemotright> Val(Intg 0)) Val(Intg 0) else Val(Intg 1)))),
        (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 30)}"]
   "{fst (e', s') | e' s'. 
     [],[''a''\<mapsto>Integer, ''b''\<mapsto>Integer, ''c''\<mapsto> Integer, ''cond''\<mapsto>Boolean]
     \<turnstile> \<langle>''a'' := Val(Intg 17);; ''b'' := Val(Intg 13);; 
        ''c'' := Val(Intg 42);; ''cond'' := true;; 
        if (Var ''cond'') (Var ''a'' \<guillemotleft>Add\<guillemotright> Var ''b'') else (Var ''a'' \<guillemotleft>Add\<guillemotright> Var ''c''),
        (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 
 text \<open>progOverrider examples\<close>
 
 definition
   classBottom :: "cdecl" where
   "classBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],
                    [(''x'',Integer)],[])" 
 
 definition
   classLeft :: "cdecl" where
   "classLeft = (''Left'', [Repeats ''Top''],[],[(''f'', [Class ''Top'', Integer],Integer, [''V'',''W''],Var this \<bullet> ''x'' {[''Left'',''Top'']} \<guillemotleft>Add\<guillemotright> Val (Intg 5))])"
 
 definition
   classRight :: "cdecl" where
   "classRight = (''Right'', [Shares ''Right2''],[],
     [(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this \<bullet> ''x'' {[''Right2'',''Top'']} \<guillemotleft>Add\<guillemotright> Val (Intg 7)),(''g'',[],Class ''Left'',[],new ''Left'')])"
 
 definition
   classRight2 :: "cdecl" where
   "classRight2 = (''Right2'', [Repeats ''Top''],[],
     [(''f'', [Class ''Top'', Integer], Integer,[''V'',''W''],Var this \<bullet> ''x'' {[''Right2'',''Top'']} \<guillemotleft>Add\<guillemotright> Val (Intg 9)),(''g'',[],Class ''Top'',[],new ''Top'')])"
 
 definition
   classTop :: "cdecl" where
   "classTop = (''Top'', [], [(''x'',Integer)],[])"
 
 definition
   progOverrider :: "cdecl list" where
   "progOverrider = [classBottom, classLeft, classRight, classRight2, classTop]"
 
 values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"] \<comment> \<open>dynCastSide\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right''] \<turnstile>
     \<langle>''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Ref(0,[''Right'']))}"] \<comment> \<open>dynCastViaSh\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right2''] \<turnstile> 
     \<langle>''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 42)}"] \<comment> \<open>block\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Integer] 
     \<turnstile> \<langle>''V'' := Val(Intg 42) ;; {''V'':Class ''Left''; ''V'' := new ''Bottom''} ;; Var ''V'',
       (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 8)}"] \<comment> \<open>staticCall\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right'',''W''\<mapsto>Class ''Bottom''] 
     \<turnstile> \<langle>''V'' := new ''Bottom'' ;; ''W'' := new ''Bottom'' ;; 
        ((Cast ''Left'' (Var ''W''))\<bullet>''x''{[''Left'',''Top'']} := Val(Intg 3));;
        (Var ''W''\<bullet>(''Left''::)''f''([Var ''V'',Val(Intg 2)])),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val (Intg 12)}"] \<comment> \<open>call\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right2'',''W''\<mapsto>Class ''Left''] 
     \<turnstile> \<langle>''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;; 
        (Var ''V''\<bullet>''f''([Var ''W'',Val(Intg 42)])) \<guillemotleft>Add\<guillemotright> (Var ''W''\<bullet>''f''([Var ''V'',Val(Intg 13)])),
        (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Intg 13)}"] \<comment> \<open>callOverrider\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right2'',''W''\<mapsto>Class ''Left''] 
     \<turnstile> \<langle>''V'' := new ''Bottom'';; (Var ''V'' \<bullet> ''x'' {[''Right2'',''Top'']} := Val(Intg 6));; 
        ''W'' := new ''Left'' ;; Var ''V''\<bullet>''f''([Var ''W'',Val(Intg 42)]),
        (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Ref(1,[''Left'',''Top'']))}"] \<comment> \<open>callClass\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right2''] 
     \<turnstile> \<langle>''V'' := new ''Right'' ;; Var ''V''\<bullet>''g''([]),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Intg 42)}"] \<comment> \<open>fieldAss\<close>
   "{fst (e', s') | e' s'. 
     progOverrider,[''V''\<mapsto>Class ''Right2''] 
     \<turnstile> \<langle>''V'' := new ''Right'' ;; 
        (Var ''V''\<bullet>''x''{[''Right2'',''Top'']} := (Val(Intg 42))) ;; 
        (Var ''V''\<bullet>''x''{[''Right2'',''Top'']}),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 
 text \<open>typing rules\<close>
 
 values [expected "{Class ''Bottom''}"] \<comment> \<open>typeNew\<close>
   "{T. progOverrider,Map.empty \<turnstile> new ''Bottom'' :: T}"
 
 values [expected "{Class ''Left''}"] \<comment> \<open>typeDynCast\<close>
   "{T. progOverrider,Map.empty \<turnstile> Cast ''Left'' (new ''Bottom'') :: T}"
 
 values [expected "{Class ''Left''}"] \<comment> \<open>typeStaticCast\<close>
   "{T. progOverrider,Map.empty \<turnstile> \<lparr>''Left''\<rparr> (new ''Bottom'') :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeVal\<close>
   "{T. [],Map.empty \<turnstile> Val(Intg 17) :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeVar\<close>
   "{T. [],[''V'' \<mapsto> Integer] \<turnstile> Var ''V'' :: T}"
 
 values [expected "{Boolean}"] \<comment> \<open>typeBinOp\<close>
   "{T. [],Map.empty \<turnstile> (Val(Intg 5)) \<guillemotleft>Eq\<guillemotright> (Val(Intg 6)) :: T}"
 
 values [expected "{Class ''Top''}"] \<comment> \<open>typeLAss\<close>
   "{T. progOverrider,[''V'' \<mapsto> Class ''Top''] \<turnstile> ''V'' := (new ''Left'') :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeFAcc\<close>
   "{T. progOverrider,Map.empty \<turnstile> (new ''Right'')\<bullet>''x''{[''Right2'',''Top'']} :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeFAss\<close>
   "{T. progOverrider,Map.empty \<turnstile> (new ''Right'')\<bullet>''x''{[''Right2'',''Top'']} :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeStaticCall\<close>
   "{T. progOverrider,[''V''\<mapsto>Class ''Left''] 
        \<turnstile> ''V'' := new ''Left'' ;; Var ''V''\<bullet>(''Left''::)''f''([new ''Top'', Val(Intg 13)]) :: T}"
 
 values [expected "{Class ''Top''}"] \<comment> \<open>typeCall\<close>
   "{T. progOverrider,[''V''\<mapsto>Class ''Right2''] 
        \<turnstile> ''V'' := new ''Right'' ;; Var ''V''\<bullet>''g''([]) :: T}"
 
 values [expected "{Class ''Top''}"] \<comment> \<open>typeBlock\<close>
   "{T. progOverrider,Map.empty \<turnstile> {''V'':Class ''Top''; ''V'' := new ''Left''} :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeCond\<close>
   "{T. [],Map.empty \<turnstile> if (true) Val(Intg 6) else Val(Intg 9) :: T}"
 
 values [expected "{Void}"] \<comment> \<open>typeWhile\<close>
   "{T. [],Map.empty \<turnstile> while (false) Val(Intg 17) :: T}"
 
 values [expected "{Void}"] \<comment> \<open>typeThrow\<close>
   "{T. progOverrider,Map.empty \<turnstile> throw (new ''Bottom'') :: T}"
 
 values [expected "{Integer}"] \<comment> \<open>typeBig\<close>
   "{T. progOverrider,[''V''\<mapsto>Class ''Right2'',''W''\<mapsto>Class ''Left''] 
        \<turnstile> ''V'' := new ''Right'' ;; ''W'' := new ''Left'' ;; 
          (Var ''V''\<bullet>''f''([Var ''W'', Val(Intg 7)])) \<guillemotleft>Add\<guillemotright> (Var ''W''\<bullet>''f''([Var ''V'', Val(Intg 13)])) 
        :: T}"
 
 
 text \<open>progDiamond examples\<close>
 
 definition
   classDiamondBottom :: "cdecl" where
   "classDiamondBottom = (''Bottom'', [Repeats ''Left'', Repeats ''Right''],[(''x'',Integer)],
     [(''g'', [],Integer, [],Var this \<bullet> ''x'' {[''Bottom'']} \<guillemotleft>Add\<guillemotright> Val (Intg 5))])" 
 
 definition
   classDiamondLeft :: "cdecl" where
   "classDiamondLeft = (''Left'', [Repeats ''TopRep'',Shares ''TopSh''],[],[])"
 
 definition
   classDiamondRight :: "cdecl" where
   "classDiamondRight = (''Right'', [Repeats ''TopRep'',Shares ''TopSh''],[],
     [(''f'', [Integer], Boolean,[''i''], Var ''i'' \<guillemotleft>Eq\<guillemotright> Val (Intg 7))])"
 
 definition
   classDiamondTopRep :: "cdecl" where
   "classDiamondTopRep = (''TopRep'', [], [(''x'',Integer)],
     [(''g'', [],Integer, [], Var this \<bullet> ''x'' {[''TopRep'']} \<guillemotleft>Add\<guillemotright> Val (Intg 10))])"
 
 definition
   classDiamondTopSh :: "cdecl" where
   "classDiamondTopSh = (''TopSh'', [], [], 
     [(''f'', [Integer], Boolean,[''i''], Var ''i'' \<guillemotleft>Eq\<guillemotright> Val (Intg 3))])"
 
 definition
   progDiamond :: "cdecl list" where
   "progDiamond = [classDiamondBottom, classDiamondLeft, classDiamondRight, classDiamondTopRep, classDiamondTopSh]"
 
 values [expected "{Val(Ref(0,[''Bottom'',''Left'']))}"] \<comment> \<open>cast1\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''Left''] \<turnstile> \<langle>''V'' := new ''Bottom'',
                                                       (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Ref(0,[''TopSh'']))}"] \<comment> \<open>cast2\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''TopSh''] \<turnstile> \<langle>''V'' := new ''Bottom'',
                                                       (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{}"] \<comment> \<open>typeCast3 not typeable\<close>
   "{T. progDiamond,[''V''\<mapsto>Class ''TopRep''] \<turnstile> ''V'' := new ''Bottom'' :: T}"
 
 values [expected "{
    Val(Ref(0,[''Bottom'', ''Left'', ''TopRep''])), 
    Val(Ref(0,[''Bottom'', ''Right'', ''TopRep'']))
   }"] \<comment> \<open>cast3\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''TopRep''] \<turnstile> \<langle>''V'' := new ''Bottom'', 
                                                       (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 values [expected "{Val(Intg 17)}"] \<comment> \<open>fieldAss\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''Bottom''] 
     \<turnstile> \<langle>''V'' := new ''Bottom'' ;; 
        ((Var ''V'')\<bullet>''x''{[''Bottom'']} := (Val(Intg 17))) ;; 
        ((Var ''V'')\<bullet>''x''{[''Bottom'']}),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 values [expected "{Val Null}"] \<comment> \<open>dynCastNull\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,Map.empty \<turnstile> \<langle>Cast ''Right'' null,(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 values [expected "{Val (Ref(0, [''Right'']))}"] \<comment> \<open>dynCastViaSh\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''TopSh''] 
     \<turnstile> \<langle>''V'' := new ''Right'' ;; Cast ''Right'' (Var ''V''),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 values [expected "{Val Null}"] \<comment> \<open>dynCastFail\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''TopRep''] 
     \<turnstile> \<langle>''V'' := new ''Right'' ;; Cast ''Bottom'' (Var ''V''),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 values [expected "{Val (Ref(0, [''Bottom'', ''Left'']))}"] \<comment> \<open>dynCastSide\<close>
   "{fst (e', s') | e' s'. 
     progDiamond,[''V''\<mapsto>Class ''Right'']
     \<turnstile> \<langle>''V'' := new ''Bottom'' ;; Cast ''Left'' (Var ''V''),(Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e',s'\<rangle>}"
 
 text \<open>failing g++ example\<close>
 
 definition
   classD :: "cdecl" where
   "classD = (''D'', [Shares ''A'', Shares ''B'', Repeats ''C''],[],[])"
 
 definition
   classC :: "cdecl" where
   "classC = (''C'', [Shares ''A'', Shares ''B''],[],
               [(''f'',[],Integer,[],Val(Intg 42))])"
 
 definition
   classB :: "cdecl" where
   "classB = (''B'', [],[],
               [(''f'',[],Integer,[],Val(Intg 17))])"
 
 definition
   classA :: "cdecl" where
   "classA = (''A'', [],[],
               [(''f'',[],Integer,[],Val(Intg 13))])"
 
 definition
   ProgFailing :: "cdecl list" where
   "ProgFailing = [classA,classB,classC,classD]"
 
 values [expected "{Val (Intg 42)}"] \<comment> \<open>callFailGplusplus\<close>
   "{fst (e', s') | e' s'. 
     ProgFailing,Map.empty 
     \<turnstile> \<langle>{''V'':Class ''D''; ''V'' := new ''D'';; Var ''V''\<bullet>''f''([])},
        (Map.empty,Map.empty)\<rangle> \<Rightarrow>' \<langle>e', s'\<rangle>}"
 
 end
 
diff --git a/thys/CoreC++/TypeSafe.thy b/thys/CoreC++/TypeSafe.thy
--- a/thys/CoreC++/TypeSafe.thy
+++ b/thys/CoreC++/TypeSafe.thy
@@ -1,1691 +1,1689 @@
 (*  Title:       CoreC++
     Author:      Daniel Wasserrab
     Maintainer:  Daniel Wasserrab <wasserra at fmi.uni-passau.de>
 
     Based on the Jinja theory J/TypeSafe.thy by Tobias Nipkow 
 *)
 
 section \<open>Type Safety Proof\<close>
 
 theory TypeSafe
 imports HeapExtension CWellForm
 begin
 
 
 subsection\<open>Basic preservation lemmas\<close>
 
 lemma assumes wf:"wwf_prog P" and casts:"P \<turnstile> T casts v to v'"
   and typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T'" and leq:"P \<turnstile> T' \<le> T"
   shows casts_conf:"P,h \<turnstile> v' :\<le> T"
 
 proof -
   { fix a' C Cs S'
     assume leq:"P \<turnstile> Class (last Cs) \<le> T" and subo:"Subobjs P C Cs"
       and casts':"P \<turnstile> T casts Ref (a',Cs) to v'" and h:"h a' = Some(C,S')"
     from subo wf have "is_class P (last Cs)" by(fastforce intro:Subobj_last_isClass)
     with leq wf obtain C' where T:"T = Class C'"
       and path_unique:"P \<turnstile> Path (last Cs) to C' unique"
       by(auto dest:Class_widen)
     from path_unique obtain Cs' where path_via:"P \<turnstile> Path (last Cs) to C' via Cs'"
       by(auto simp:path_via_def path_unique_def)
     with T path_unique casts' have v':"v' = Ref (a',Cs@\<^sub>pCs')"
       by -(erule casts_to.cases,auto simp:path_unique_def path_via_def)
     from subo path_via wf have "Subobjs P C (Cs@\<^sub>pCs')"
       and "last (Cs@\<^sub>pCs') = C'"
       apply(auto intro:Subobjs_appendPath simp:path_via_def)
       apply(drule_tac Cs="Cs'" in Subobjs_nonempty)
       by(rule sym[OF appendPath_last])
     with T h v' have ?thesis by auto }
   with casts typeof wf typeof leq show ?thesis
     by(cases v,auto elim:casts_to.cases split:if_split_asm)
 qed
 
 
 
 theorem assumes wf:"wwf_prog P"
 shows red_preserves_hconf:
   "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> (\<And>T. \<lbrakk> P,E,h \<turnstile> e : T; P \<turnstile> h \<surd> \<rbrakk> \<Longrightarrow> P \<turnstile> h' \<surd>)"
 and reds_preserves_hconf:
   "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> (\<And>Ts. \<lbrakk> P,E,h \<turnstile> es [:] Ts; P \<turnstile> h \<surd> \<rbrakk> \<Longrightarrow> P \<turnstile> h' \<surd>)"
 
 proof (induct rule:red_reds_inducts)
   case (RedNew h a h' C E l)
   have new: "new_Addr h = Some a" and h':"h' = h(a \<mapsto> (C, Collect (init_obj P C)))"
     and hconf:"P \<turnstile> h \<surd>" and wt_New:"P,E,h \<turnstile> new C : T" by fact+
   from new have None: "h a = None" by(rule new_Addr_SomeD)
   with wf have oconf:"P,h \<turnstile> (C, Collect (init_obj P C)) \<surd>"
     apply (auto simp:oconf_def)
     apply (rule_tac x="init_class_fieldmap P (last Cs)" in exI)
     by (fastforce intro:init_obj.intros fconf_init_fields 
                  elim: init_obj.cases dest!:Subobj_last_isClass simp:is_class_def)+
   thus ?case using h' None by(fast intro: hconf_new[OF hconf])
 next
   case (RedFAss h a D S Cs' F T Cs v v' Ds fs' E l T')
   let ?fs' = "fs'(F \<mapsto> v')"
   let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs')})"
   have ha:"h a = Some(D,S)" and hconf:"P \<turnstile> h \<surd>"
     and field:"P \<turnstile> last Cs' has least F:T via Cs"
     and casts:"P \<turnstile> T casts v to v'"
     and Ds:"Ds = Cs' @\<^sub>p Cs" and S:"(Ds,fs') \<in> S"
     and wte:"P,E,h \<turnstile> ref(a,Cs')\<bullet>F{Cs} := Val v : T'" by fact+
   from wte have "P \<turnstile> last Cs' has least F:T' via Cs" by (auto split:if_split_asm)
   with field have eq:"T = T'" by (rule sees_field_fun)
   with casts wte wf have conf:"P,h \<turnstile> v' :\<le> T'"
     by(auto intro:casts_conf)
   from hconf ha have oconf:"P,h \<turnstile> (D,S) \<surd>" by (fastforce simp:hconf_def)
   with S have suboD:"Subobjs P D Ds" by (fastforce simp:oconf_def)
   from field obtain Bs fs ms
     where subo:"Subobjs P (last Cs') Cs"
     and "class": "class P (last Cs) = Some(Bs,fs,ms)"
     and map:"map_of fs F = Some T"
     by (auto simp:LeastFieldDecl_def FieldDecls_def)
   from Ds subo have last:"last Cs = last Ds"
     by(fastforce dest:Subobjs_nonempty intro:appendPath_last simp:appendPath_last)
   with "class" have classDs:"class P (last Ds) = Some(Bs,fs,ms)" by simp
   with S suboD oconf have "P,h \<turnstile> fs' (:\<le>) map_of fs"
     apply (auto simp:oconf_def)
     apply (erule allE)
     apply (erule_tac x="Ds" in allE)
     apply (erule_tac x="fs'" in allE)
     apply clarsimp
     done
   with map conf eq have fconf:"P,h \<turnstile> fs'(F \<mapsto> v') (:\<le>) map_of fs"
     by (simp add:fconf_def)
   from oconf have "\<forall>Cs fs'. (Cs,fs') \<in> S \<longrightarrow> Subobjs P D Cs \<and> 
                     (\<exists>fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) \<and> 
                                 P,h \<turnstile> fs' (:\<le>) map_of fs)"
     by(simp add:oconf_def)
   with suboD classDs fconf 
   have oconf':"\<forall>Cs fs'. (Cs,fs') \<in> ?S' \<longrightarrow> Subobjs P D Cs \<and> 
                     (\<exists>fs Bs ms. class P (last Cs) = Some (Bs,fs,ms) \<and> 
                                 P,h \<turnstile> fs' (:\<le>) map_of fs)"
     by auto
   from oconf have all:"\<forall>Cs. Subobjs P D Cs \<longrightarrow> (\<exists>!fs'. (Cs,fs') \<in> S)"
     by(simp add:oconf_def)
   with S have "\<forall>Cs. Subobjs P D Cs \<longrightarrow> (\<exists>!fs'. (Cs,fs') \<in> ?S')" by blast
   with oconf' have oconf':"P,h \<turnstile> (D,?S') \<surd>"
     by (simp add:oconf_def)
   with hconf ha show ?case by (rule hconf_upd_obj)
 next
   case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
 next
   case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
 next
   case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
 qed auto
 
 
 
 
 theorem assumes wf:"wwf_prog P"
 shows red_preserves_lconf:
   "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow>
   (\<And>T. \<lbrakk> P,E,h \<turnstile> e:T; P,h \<turnstile> l (:\<le>)\<^sub>w E; P \<turnstile> E \<surd> \<rbrakk> \<Longrightarrow> P,h' \<turnstile> l' (:\<le>)\<^sub>w E)"
 and reds_preserves_lconf:
   "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow>
   (\<And>Ts. \<lbrakk> P,E,h \<turnstile> es[:]Ts; P,h \<turnstile> l (:\<le>)\<^sub>w E; P \<turnstile> E \<surd> \<rbrakk> \<Longrightarrow> P,h' \<turnstile> l' (:\<le>)\<^sub>w E)"
 
 proof(induct rule:red_reds_inducts)
   case RedNew thus ?case
     by(fast intro:lconf_hext red_hext_incr[OF red_reds.RedNew])
 next
   case (RedLAss E V T v v' h l T')
   have casts:"P \<turnstile> T casts v to v'" and env:"E V = Some T"
     and wt:"P,E,h \<turnstile> V:=Val v : T'" and lconf:"P,h \<turnstile> l (:\<le>)\<^sub>w E" by fact+
   from wt env have eq:"T = T'" by auto
   with casts wt wf have conf:"P,h \<turnstile> v' :\<le> T'"
     by(auto intro:casts_conf)
   with lconf env eq show ?case
     by (simp del:fun_upd_apply)(erule lconf_upd,simp_all)
 next
   case RedFAss thus ?case
     by(auto intro:lconf_hext red_hext_incr[OF red_reds.RedFAss] 
          simp del:fun_upd_apply)
 next
   case (BlockRedNone E V T e h l e' h' l' T')
   have red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH: "\<And>T''. \<lbrakk> P,E(V \<mapsto> T),h \<turnstile> e : T''; P,h \<turnstile> l(V:=None) (:\<le>)\<^sub>w E(V \<mapsto> T);
                       envconf P (E(V \<mapsto> T)) \<rbrakk>
                    \<Longrightarrow> P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)"
     and lconf: "P,h \<turnstile> l (:\<le>)\<^sub>w E" and wte: "P,E,h \<turnstile> {V:T; e} : T'"
     and envconf:"envconf P E" by fact+
   from lconf_hext[OF lconf red_hext_incr[OF red]]
   have lconf':"P,h' \<turnstile> l (:\<le>)\<^sub>w E" .
   from wte have wte':"P,E(V\<mapsto>T),h \<turnstile> e : T'" and type:"is_type P T"
     by (auto elim:WTrt.cases)
   from envconf type have envconf':"envconf P (E(V \<mapsto> T))"
     by(auto simp:envconf_def)
   from lconf have "P,h \<turnstile> (l(V := None)) (:\<le>)\<^sub>w E(V\<mapsto>T)"
     by (simp add:lconf_def fun_upd_apply)
   from IH[OF wte' this envconf'] have "P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V\<mapsto>T)" .
   with lconf' show ?case
     by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
 next
   case (BlockRedSome E V T e h l e' h' l' v T')
   have red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH: "\<And>T''. \<lbrakk> P,E(V \<mapsto> T),h \<turnstile> e : T''; P,h \<turnstile> l(V:=None) (:\<le>)\<^sub>w E(V \<mapsto> T);
                       envconf P (E(V \<mapsto> T)) \<rbrakk>
                    \<Longrightarrow> P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)"
     and lconf: "P,h \<turnstile> l (:\<le>)\<^sub>w E" and wte: "P,E,h \<turnstile> {V:T; e} : T'"
     and envconf:"envconf P E" by fact+
   from lconf_hext[OF lconf red_hext_incr[OF red]]
   have lconf':"P,h' \<turnstile> l (:\<le>)\<^sub>w E" .
   from wte have wte':"P,E(V\<mapsto>T),h \<turnstile> e : T'" and type:"is_type P T"
     by (auto elim:WTrt.cases)
   from envconf type have envconf':"envconf P (E(V \<mapsto> T))"
     by(auto simp:envconf_def)
   from lconf have "P,h \<turnstile> (l(V := None)) (:\<le>)\<^sub>w E(V\<mapsto>T)"
     by (simp add:lconf_def fun_upd_apply)
   from IH[OF wte' this envconf'] have "P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V\<mapsto>T)" .
   with lconf' show ?case
     by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
 next
   case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
   have red: "P,E(V \<mapsto> T) \<turnstile> \<langle>e, (h, l(V\<mapsto>v'))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
      and IH: "\<And>T''. \<lbrakk> P,E(V \<mapsto> T),h \<turnstile> e : T''; P,h \<turnstile> l(V \<mapsto> v') (:\<le>)\<^sub>w E(V \<mapsto> T); 
                        envconf P (E(V \<mapsto> T)) \<rbrakk>
                    \<Longrightarrow> P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)"
     and lconf:"P,h \<turnstile> l (:\<le>)\<^sub>w E" and l':"l' V = Some v''"
     and wte:"P,E,h \<turnstile> {V:T; V:=Val v;; e} : T'"
     and casts:"P \<turnstile> T casts v to v'" and envconf:"envconf P E" by fact+
   from lconf_hext[OF lconf red_hext_incr[OF red]]
   have lconf':"P,h' \<turnstile> l (:\<le>)\<^sub>w E" .
   from wte obtain T'' where wte':"P,E(V\<mapsto>T),h \<turnstile> e : T'"
     and wt:"P,E(V \<mapsto> T),h \<turnstile> V:=Val v : T''"
     and type:"is_type P T"
     by (auto elim:WTrt.cases)
   from envconf type have envconf':"envconf P (E(V \<mapsto> T))"
     by(auto simp:envconf_def)
   from wt have "T'' = T" by auto
   with wf casts wt have "P,h \<turnstile> v' :\<le> T"
     by(auto intro:casts_conf)
   with lconf have "P,h \<turnstile> l(V \<mapsto> v') (:\<le>)\<^sub>w E(V\<mapsto>T)"
     by -(rule lconf_upd2)
   from IH[OF wte' this envconf'] have "P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)" .
   with lconf' show ?case
     by (fastforce simp:lconf_def fun_upd_apply split:if_split_asm)
 next
   case (CallObj E e h l e' h' l' Copt M es) thus ?case by (cases Copt) auto
 next
   case (CallParams E es h l es' h' l' v Copt M) thus ?case by (cases Copt) auto
 next
   case (RedCallNull E Copt M vs h l) thus ?case by (cases Copt) auto
 qed auto
 
 
 
 
 text\<open>Preservation of definite assignment more complex and requires a
 few lemmas first.\<close>
 
 lemma [iff]: "\<And>A. \<lbrakk> length Vs = length Ts; length vs = length Ts\<rbrakk> \<Longrightarrow>
  \<D> (blocks (Vs,Ts,vs,e)) A = \<D> e (A \<squnion> \<lfloor>set Vs\<rfloor>)"
 
 apply(induct Vs Ts vs e rule:blocks_old_induct)
 apply(simp_all add:hyperset_defs)
 done
 
 
 lemma red_lA_incr: "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> \<lfloor>dom l\<rfloor> \<squnion> \<A> e \<sqsubseteq>  \<lfloor>dom l'\<rfloor> \<squnion> \<A> e'"
   and reds_lA_incr: "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> \<lfloor>dom l\<rfloor> \<squnion> \<A>s es \<sqsubseteq>  \<lfloor>dom l'\<rfloor> \<squnion> \<A>s es'"
   apply (induct rule:red_reds_inducts)
   apply (simp_all del: fun_upd_apply add: hyperset_defs)
   apply blast
   apply blast
   apply blast
   apply blast
   apply blast
   apply blast
   apply blast
   apply auto
   done
 
 
 
 text\<open>Now preservation of definite assignment.\<close>
 
 lemma assumes wf: "wf_C_prog P"
 shows red_preserves_defass:
   "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow> \<D> e \<lfloor>dom l\<rfloor> \<Longrightarrow> \<D> e' \<lfloor>dom l'\<rfloor>"
 and "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow> \<D>s es \<lfloor>dom l\<rfloor> \<Longrightarrow> \<D>s es' \<lfloor>dom l'\<rfloor>"
 
 proof (induct rule:red_reds_inducts)
   case BinOpRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
 next
   case FAssRed1 thus ?case by (auto elim!: D_mono[OF red_lA_incr])
 next
   case CallObj thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
 next
   case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
                 vs bs new_body E)
   thus ?case
     apply (auto dest!:select_method_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
     apply(cases T') apply auto
     by(rule_tac A="\<lfloor>insert this (set pns)\<rfloor>" in D_mono,clarsimp simp:hyperset_defs,
           assumption)+
 next
   case RedStaticCall thus ?case
     apply (auto dest!:has_least_wf_mdecl[OF wf] simp:wf_mdecl_def elim!:D_mono')
     by(auto simp:hyperset_defs)
 next
   case InitBlockRed thus ?case
     by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
 next
   case BlockRedNone thus ?case
     by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
 next
   case BlockRedSome thus ?case
     by(auto simp:hyperset_defs elim!:D_mono' simp del:fun_upd_apply)
 next
   case SeqRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
 next
   case CondRed thus ?case by (auto elim!: D_mono[OF red_lA_incr])
 next
   case RedWhile thus ?case by(auto simp:hyperset_defs elim!:D_mono')
 next
   case ListRed1 thus ?case by (auto elim!: Ds_mono[OF red_lA_incr])
 qed (auto simp:hyperset_defs)
 
 
 
 
 text\<open>Combining conformance of heap and local variables:\<close>
 
 definition sconf :: "prog \<Rightarrow> env \<Rightarrow> state \<Rightarrow> bool"  ("_,_ \<turnstile> _ \<surd>"   [51,51,51]50) where
   "P,E \<turnstile> s \<surd>  \<equiv>  let (h,l) = s in P \<turnstile> h \<surd> \<and> P,h \<turnstile> l (:\<le>)\<^sub>w E \<and> P \<turnstile> E \<surd>"
 
 lemma red_preserves_sconf:
   "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e',s'\<rangle>; P,E,hp s \<turnstile> e : T; P,E \<turnstile> s \<surd>; wwf_prog P\<rbrakk> 
 \<Longrightarrow> P,E \<turnstile> s' \<surd>"
 
 by(fastforce intro:red_preserves_hconf red_preserves_lconf
             simp add:sconf_def)
 
 
 lemma reds_preserves_sconf:
   "\<lbrakk> P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>; P,E,hp s \<turnstile> es [:] Ts; P,E \<turnstile> s \<surd>; wwf_prog P\<rbrakk> 
 \<Longrightarrow> P,E \<turnstile> s' \<surd>"
 
 by(fastforce intro:reds_preserves_hconf reds_preserves_lconf
             simp add:sconf_def)
 
 
 
 
 
 subsection "Subject reduction"
 
 lemma wt_blocks:
  "\<And>E. \<lbrakk> length Vs = length Ts; length vs = length Ts;
          \<forall>T' \<in> set Ts. is_type P T'\<rbrakk> \<Longrightarrow>
        (P,E,h \<turnstile> blocks(Vs,Ts,vs,e) : T) =
   (P,E(Vs[\<mapsto>]Ts),h \<turnstile> e:T \<and> 
   (\<exists>Ts'. map (P \<turnstile> typeof\<^bsub>h\<^esub>) vs = map Some Ts' \<and> P \<turnstile> Ts' [\<le>] Ts))"
 
 proof(induct Vs Ts vs e rule:blocks_old_induct)
   case (5 V Vs T' Ts v vs e)
   have length:"length (V#Vs) = length (T'#Ts)" "length (v#vs) = length (T'#Ts)"
     and type:"\<forall>S \<in> set (T'#Ts). is_type P S"
     and IH:"\<And>E. \<lbrakk>length Vs = length Ts; length vs = length Ts;
                   \<forall>S \<in> set Ts. is_type P S\<rbrakk>
      \<Longrightarrow> (P,E,h \<turnstile> blocks (Vs, Ts, vs, e) : T) =
          (P,E(Vs [\<mapsto>] Ts),h \<turnstile> e : T \<and>
             (\<exists>Ts'. map P \<turnstile> typeof\<^bsub>h\<^esub> vs = map Some Ts' \<and> P \<turnstile> Ts' [\<le>] Ts))" by fact+
   from type have typeT':"is_type P T'" and type':"\<forall>S \<in> set Ts. is_type P S"
     by simp_all
   from length have "length Vs = length Ts" "length vs = length Ts"
     by simp_all
   from IH[OF this type'] have eq:"(P,E(V \<mapsto> T'),h \<turnstile> blocks (Vs,Ts,vs,e) : T) =
-  (P,E(V \<mapsto> T')(Vs [\<mapsto>] Ts),h \<turnstile> e : T \<and>
+  (P,E(V \<mapsto> T', Vs [\<mapsto>] Ts),h \<turnstile> e : T \<and>
    (\<exists>Ts'. map P \<turnstile> typeof\<^bsub>h\<^esub> vs = map Some Ts' \<and> P \<turnstile> Ts' [\<le>] Ts))" .
   show ?case
   proof(rule iffI)
     assume "P,E,h \<turnstile> blocks (V#Vs,T'#Ts,v#vs,e) : T"
     then have wt:"P,E(V \<mapsto> T'),h \<turnstile> V:=Val v : T'"
       and blocks:"P,E(V \<mapsto> T'),h \<turnstile> blocks (Vs,Ts,vs,e) : T" by auto
-    from blocks eq obtain Ts' where wte:"P,E(V \<mapsto> T')(Vs [\<mapsto>] Ts),h \<turnstile> e : T"
+    from blocks eq obtain Ts' where wte:"P,E(V \<mapsto> T', Vs [\<mapsto>] Ts),h \<turnstile> e : T"
       and typeof:"map P \<turnstile> typeof\<^bsub>h\<^esub> vs = map Some Ts'" and subs:"P \<turnstile> Ts' [\<le>] Ts"
       by auto
     from wt obtain T'' where "P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T''" and "P \<turnstile> T'' \<le> T'"
       by auto
     with wte typeof subs
     show "P,E(V # Vs [\<mapsto>] T' # Ts),h \<turnstile> e : T \<and>
           (\<exists>Ts'. map P \<turnstile> typeof\<^bsub>h\<^esub> (v # vs) = map Some Ts' \<and> P \<turnstile> Ts' [\<le>] (T' # Ts))"
       by auto
   next
     assume "P,E(V # Vs [\<mapsto>] T' # Ts),h \<turnstile> e : T \<and>
       (\<exists>Ts'. map P \<turnstile> typeof\<^bsub>h\<^esub> (v # vs) = map Some Ts' \<and> P \<turnstile> Ts' [\<le>] (T' # Ts))"
     then obtain Ts' where wte:"P,E(V # Vs [\<mapsto>] T' # Ts),h \<turnstile> e : T"
       and typeof:"map P \<turnstile> typeof\<^bsub>h\<^esub> (v # vs) = map Some Ts'"
       and subs:"P \<turnstile> Ts' [\<le>] (T'#Ts)" by auto
     from subs obtain U Us where Ts':"Ts' = U#Us" by(cases Ts') auto
     with wte typeof subs eq have blocks:"P,E(V \<mapsto> T'),h \<turnstile> blocks (Vs,Ts,vs,e) : T"
       by auto
     from Ts' typeof subs have "P \<turnstile> typeof\<^bsub>h\<^esub> v = Some U"
       and "P \<turnstile> U \<le> T'" by (auto simp:fun_of_def)
     hence wtval:"P,E(V \<mapsto> T'),h \<turnstile> V:=Val v : T'" by auto
     with blocks typeT' show "P,E,h \<turnstile> blocks (V#Vs,T'#Ts,v#vs,e) : T" by auto
   qed
 qed auto
 
 
 
 
 theorem assumes wf: "wf_C_prog P"
 shows subject_reduction2: "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle> \<Longrightarrow>
   (\<And>T. \<lbrakk> P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T \<rbrakk> \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T)"
 and subjects_reduction2: "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle> \<Longrightarrow>
   (\<And>Ts.\<lbrakk> P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> es [:] Ts \<rbrakk> \<Longrightarrow> types_conf P E h' es' Ts)"
 
 proof (induct rule:red_reds_inducts)
   case (RedNew h a h' C E l)
   have new:"new_Addr h = Some a" and h':"h' = h(a \<mapsto> (C, Collect (init_obj P C)))" 
     and wt:"P,E,h \<turnstile> new C : T" by fact+
   from wt have eq:"T = Class C" and "class": "is_class P C" by auto
   from "class" have subo:"Subobjs P C [C]" by(rule Subobjs_Base)
   from h' have "h' a = Some(C, Collect (init_obj P C))" by(simp add:map_upd_Some_unfold)
   with subo have "P,E,h' \<turnstile> ref(a,[C]) : Class C" by auto
   with eq show ?case by auto
 next
   case (RedNewFail h E C l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P OutOfMemory" 
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt OutOfMemory,[OutOfMemory])) = Some(Class OutOfMemory)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW OutOfMemory : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (StaticCastRed E e h l e' h' l' C)
   have wt:"P,E,h \<turnstile> \<lparr>C\<rparr>e : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" by fact+
   from wt obtain T' where wte:"P,E,h \<turnstile> e : T'" and isref:"is_refT T'" 
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from isref have "P,E,h' \<turnstile> \<lparr>C\<rparr>e' : Class C"
   proof(rule refTE)
     assume "T' = NT"
     with IH[OF sconf wte] isref "class" show ?thesis by auto
   next
     fix D assume "T' = Class D"
     with IH[OF sconf wte] isref "class" show ?thesis by auto
   qed
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case RedStaticCastNull
   thus ?case by (auto elim:WTrt.cases)
 next
   case (RedStaticUpCast Cs C Cs' Ds E a h l)
   have wt:"P,E,h \<turnstile> \<lparr>C\<rparr>ref (a,Cs) : T"
     and path_via:"P \<turnstile> Path last Cs to C via Cs'"
     and Ds:"Ds = Cs @\<^sub>p Cs'" by fact+
   from wt have typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> (Ref(a,Cs)) = Some(Class(last Cs))"
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
     by (auto dest:typeof_Class_Subo split:if_split_asm)
   from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
     by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
             simp:path_via_def)
   with h have "P,E,h \<turnstile> ref (a,Ds) : Class C" by auto
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (RedStaticDownCast E C a Cs Cs' h l)
   have "P,E,h \<turnstile> \<lparr>C\<rparr>ref (a,Cs@[C]@Cs') : T" by fact
   hence typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from typeof obtain D S where h:"h a = Some(D,S)" 
     and subo:"Subobjs P D (Cs@[C]@Cs')"
     by (auto dest:typeof_Class_Subo split:if_split_asm)
   from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
   with h have "P,E,h \<turnstile> ref (a,Cs@[C]) : Class C" by auto
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (RedStaticCastFail C Cs E a h l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P ClassCast" 
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt ClassCast,[ClassCast])) = Some(Class ClassCast)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW ClassCast : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (DynCastRed E e h l e' h' l' C)
   have wt:"P,E,h \<turnstile> Cast C e : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt obtain T' where wte:"P,E,h \<turnstile> e : T'" and isref:"is_refT T'" 
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from isref have "P,E,h' \<turnstile> Cast C e' : Class C"
   proof(rule refTE)
     assume "T' = NT"
     with IH[OF sconf wte] isref "class" show ?thesis by auto
   next
     fix D assume "T' = Class D"
     with IH[OF sconf wte] isref "class" show ?thesis by auto
   qed
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case RedDynCastNull
   thus ?case by (auto elim:WTrt.cases)
 next
   case (RedDynCast h l a D S C Cs' E Cs)
   have wt:"P,E,h \<turnstile> Cast C (ref (a,Cs)) : T"
     and path_via:"P \<turnstile> Path D to C via Cs'"
     and hp:"hp (h,l) a = Some(D,S)" by fact+
   from wt have typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> (Ref(a,Cs)) = Some(Class(last Cs))"
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from typeof hp have subo:"Subobjs P D Cs"
     by (auto dest:typeof_Class_Subo split:if_split_asm)
   from path_via subo have "Subobjs P D Cs'" 
     and last:"last Cs' = C" by (auto simp:path_via_def)
   with hp have "P,E,h \<turnstile> ref (a,Cs') : Class C" by auto
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (RedStaticUpDynCast Cs C Cs' Ds E a h l)
   have wt:"P,E,h \<turnstile> Cast C (ref (a,Cs)) : T"
     and path_via:"P \<turnstile> Path last Cs to C via Cs'"
     and Ds:"Ds = Cs @\<^sub>p Cs'" by fact+
   from wt have typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> (Ref(a,Cs)) = Some(Class(last Cs))"
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from typeof obtain D S where h:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
     by (auto dest:typeof_Class_Subo split:if_split_asm)
   from path_via subo wf Ds have "Subobjs P D Ds" and last:"last Ds = C"
     by(auto intro!:Subobjs_appendPath appendPath_last[THEN sym] Subobjs_nonempty
             simp:path_via_def)
   with h have "P,E,h \<turnstile> ref (a,Ds) : Class C" by auto
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (RedStaticDownDynCast E C a Cs Cs' h l)
   have "P,E,h \<turnstile> Cast C (ref (a,Cs@[C]@Cs')) : T" by fact
   hence typeof:"P \<turnstile> typeof\<^bsub>h\<^esub> (Ref(a,Cs@[C]@Cs')) = Some(Class(last(Cs@[C]@Cs')))"
     and "class": "is_class P C" and T:"T = Class C"
     by auto
   from typeof obtain D S where h:"h a = Some(D,S)" 
     and subo:"Subobjs P D (Cs@[C]@Cs')"
     by (auto dest:typeof_Class_Subo split:if_split_asm)
   from subo have "Subobjs P D (Cs@[C])" by(fastforce intro:appendSubobj)
   with h have "P,E,h \<turnstile> ref (a,Cs@[C]) : Class C" by auto
   with T show ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case RedDynCastFail thus ?case by fastforce
 next
   case (BinOpRed1 E e h l e' h' l' bop e\<^sub>2)
   have red:"P,E \<turnstile> \<langle>e,(h, l)\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and wt:"P,E,h \<turnstile> e \<guillemotleft>bop\<guillemotright> e\<^sub>2 : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt obtain T\<^sub>1 T\<^sub>2 where wte:"P,E,h \<turnstile> e : T\<^sub>1" and wte2:"P,E,h \<turnstile> e\<^sub>2 : T\<^sub>2"
     and binop:"case bop of Eq \<Rightarrow> T = Boolean
                         | Add \<Rightarrow> T\<^sub>1 = Integer \<and> T\<^sub>2 = Integer \<and> T = Integer"
     by auto
   from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' \<turnstile> e\<^sub>2 : T\<^sub>2" .
   have "P,E,h' \<turnstile> e' \<guillemotleft>bop\<guillemotright> e\<^sub>2 : T"
   proof (cases bop)
     assume Eq:"bop = Eq"
     from IH[OF sconf wte] obtain T' where "P,E,h' \<turnstile> e' : T'"
       by (cases "T\<^sub>1") auto
     with wte2' binop Eq show ?thesis by(cases bop) auto
   next
     assume Add:"bop = Add"
     with binop have Intg:"T\<^sub>1 = Integer" by simp
     with IH[OF sconf wte] have "P,E,h' \<turnstile> e' : Integer" by simp
     with wte2' binop Add show ?thesis by(cases bop) auto
   qed
   with binop show ?case by(cases bop) simp_all
 next
   case (BinOpRed2 E e h l e' h' l' v\<^sub>1 bop)
   have red:"P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
     and wt:"P,E,h \<turnstile> Val v\<^sub>1 \<guillemotleft>bop\<guillemotright> e : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt obtain T\<^sub>1 T\<^sub>2 where wtval:"P,E,h \<turnstile> Val v\<^sub>1 : T\<^sub>1" and wte:"P,E,h \<turnstile> e : T\<^sub>2"
     and binop:"case bop of Eq \<Rightarrow> T = Boolean
                         | Add \<Rightarrow> T\<^sub>1 = Integer \<and> T\<^sub>2 = Integer \<and> T = Integer"
     by auto
   from WTrt_hext_mono[OF wtval red_hext_incr[OF red]]
   have wtval':"P,E,h' \<turnstile> Val v\<^sub>1 : T\<^sub>1" .
   have "P,E,h' \<turnstile> Val v\<^sub>1 \<guillemotleft>bop\<guillemotright> e' : T"
   proof (cases bop)
     assume Eq:"bop = Eq"
     from IH[OF sconf wte] obtain T' where "P,E,h' \<turnstile> e' : T'"
       by (cases "T\<^sub>2") auto
     with wtval' binop Eq show ?thesis by(cases bop) auto
   next
     assume Add:"bop = Add"
     with binop have Intg:"T\<^sub>2 = Integer" by simp
     with IH[OF sconf wte] have "P,E,h' \<turnstile> e' : Integer" by simp
     with wtval' binop Add show ?thesis by(cases bop) auto
   qed
   with binop show ?case by(cases bop) simp_all
 next
   case (RedBinOp bop v\<^sub>1 v\<^sub>2 v E a b) thus ?case
   proof (cases bop)
     case Eq thus ?thesis using RedBinOp by auto
   next
     case Add thus ?thesis using RedBinOp by auto
   qed
 next
   case (RedVar h l V v E)
   have l:"lcl (h, l) V = Some v" and sconf:"P,E \<turnstile> (h, l) \<surd>"
     and wt:"P,E,h \<turnstile> Var V : T" by fact+
   hence conf:"P,h \<turnstile> v :\<le> T" by(force simp:sconf_def lconf_def)
   show ?case
   proof(cases "\<forall>C. T \<noteq> Class C")
     case True 
     with conf have "P \<turnstile> typeof\<^bsub>h\<^esub> v = Some T" by(cases T) auto
     hence "P,E,h \<turnstile> Val v : T" by auto
     thus ?thesis by(rule wt_same_type_typeconf)
   next
     case False
     then obtain C where T:"T = Class C" by auto
     with conf have "P \<turnstile> typeof\<^bsub>h\<^esub> v = Some(Class C) \<or> P \<turnstile> typeof\<^bsub>h\<^esub> v = Some NT"
       by simp
     with T show ?thesis by simp
   qed
 next
   case (LAssRed E e h l e' h' l' V)
   have wt:"P,E,h \<turnstile> V:=e : T" and sconf:"P,E \<turnstile> (h, l) \<surd>"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h, l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'" by fact+
   from wt obtain T' where wte:"P,E,h \<turnstile> e : T'" and env:"E V = Some T" 
     and sub:"P \<turnstile> T' \<le> T" by auto
   from sconf env have "is_type P T" by(auto simp:sconf_def envconf_def)
   from sub this wf show ?case
   proof(rule subE)
     assume eq:"T' = T" and notclass:"\<forall>C. T' \<noteq> Class C"
     with IH[OF sconf wte] have "P,E,h' \<turnstile> e' : T" by(cases T) auto
     with eq env have "P,E,h' \<turnstile> V:=e' : T" by auto
     with eq show ?thesis by(cases T) auto
   next
     fix C D
     assume T':"T' = Class C" and T:"T = Class D" 
       and path_unique:"P \<turnstile> Path C to D unique"
     with IH[OF sconf wte] have "P,E,h' \<turnstile> e' : Class C \<or> P,E,h' \<turnstile> e' : NT"
       by simp
     hence "P,E,h' \<turnstile> V:=e' : T"
     proof(rule disjE)
       assume "P,E,h' \<turnstile> e' : Class C"
       with env T' sub show ?thesis by (fastforce intro:WTrtLAss)
     next
       assume "P,E,h' \<turnstile> e' : NT"
       with env T show ?thesis by (fastforce intro:WTrtLAss)
     qed
     with T show ?thesis by(cases T) auto
   next
     fix C
     assume T':"T' = NT" and T:"T = Class C"
     with IH[OF sconf wte] have "P,E,h' \<turnstile> e' : NT" by simp
     with env T show ?thesis by (fastforce intro:WTrtLAss)
   qed
 next
   case (RedLAss E V T v v' h l T')
   have env:"E V = Some T" and casts:"P \<turnstile> T casts v to v'"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> V:=Val v : T'" by fact+
   show ?case
   proof(cases "\<forall>C. T \<noteq> Class C")
     case True
     with casts wt env show ?thesis
       by(cases T',auto elim!:casts_to.cases)
   next
     case False
     then obtain C where "T = Class C" by auto
     with casts wt env wf show ?thesis
       by(auto elim!:casts_to.cases,
          auto intro!:sym[OF appendPath_last] Subobjs_nonempty split:if_split_asm 
               simp:path_via_def,drule_tac Cs="Cs" in Subobjs_appendPath,auto)
   qed
 next
   case (FAccRed E e h l e' h' l' F Cs)
   have red:"P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
     and wt:"P,E,h \<turnstile> e\<bullet>F{Cs} : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt have "P,E,h' \<turnstile> e'\<bullet>F{Cs} : T"
   proof(rule WTrt_elim_cases)
     fix C assume wte: "P,E,h \<turnstile> e : Class C"
       and field:"P \<turnstile> C has least F:T via Cs"
       and notemptyCs:"Cs \<noteq> []"
     from field have "class": "is_class P C"
       by (fastforce intro:Subobjs_isClass simp add:LeastFieldDecl_def FieldDecls_def)
     from IH[OF sconf wte] have "P,E,h' \<turnstile> e' : NT \<or> P,E,h' \<turnstile> e' : Class C" by auto
     thus ?thesis
     proof(rule disjE)
       assume "P,E,h' \<turnstile> e' : NT"
       thus ?thesis by (fastforce intro!:WTrtFAccNT)
     next
       assume wte':"P,E,h' \<turnstile> e' : Class C"
       from wte' notemptyCs field show ?thesis by(rule WTrtFAcc)
     qed
   next
     assume wte: "P,E,h \<turnstile> e : NT"
     from IH[OF sconf wte] have "P,E,h' \<turnstile> e' : NT" by auto
     thus ?thesis by (rule WTrtFAccNT)
   qed
   thus ?case by(rule wt_same_type_typeconf)
 next
   case (RedFAcc h l a D S Ds Cs' Cs fs' F v E)
   have h:"hp (h,l) a = Some(D,S)" 
     and Ds:"Ds = Cs'@\<^sub>pCs" and S:"(Ds,fs') \<in> S"
     and fs':"fs' F = Some v" and sconf:"P,E \<turnstile> (h,l) \<surd>"
     and wte:"P,E,h \<turnstile> ref (a,Cs')\<bullet>F{Cs} : T" by fact+
   from wte have field:"P \<turnstile> last Cs' has least F:T via Cs"
     and notemptyCs:"Cs \<noteq> []"
     by (auto split:if_split_asm)
   from h S sconf obtain Bs fs ms where classDs:"class P (last Ds) = Some (Bs,fs,ms)"
     and fconf:"P,h \<turnstile> fs' (:\<le>) map_of fs"
     by (simp add:sconf_def hconf_def oconf_def) blast
   from field Ds have "last Cs = last Ds"
     by (fastforce intro!:appendPath_last Subobjs_nonempty 
                    simp:LeastFieldDecl_def FieldDecls_def)
   with field classDs have map:"map_of fs F =  Some T"
     by (simp add:LeastFieldDecl_def FieldDecls_def)
   with fconf fs' have conf:"P,h \<turnstile> v :\<le> T"
     by (simp add:fconf_def,erule_tac x="F" in allE,fastforce)
   thus ?case by (cases T) auto
 next
   case (RedFAccNull E F Cs h l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P NullPointer" 
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
 next
   case (FAssRed1 E e h l e' h' l' F Cs e\<^sub>2)
   have red:"P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
     and wt:"P,E,h \<turnstile> e\<bullet>F{Cs} := e\<^sub>2 : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt have "P,E,h' \<turnstile> e'\<bullet>F{Cs} := e\<^sub>2 : T"
   proof (rule WTrt_elim_cases)
     fix C T' assume wte: "P,E,h \<turnstile> e : Class C"
       and field:"P \<turnstile> C has least F:T via Cs"
       and notemptyCs:"Cs \<noteq> []"
       and wte2:"P,E,h \<turnstile> e\<^sub>2 : T'" and sub:"P \<turnstile> T' \<le> T"
     have wte2': "P,E,h' \<turnstile> e\<^sub>2 : T'"
       by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
     from IH[OF sconf wte] have "P,E,h' \<turnstile> e' : Class C \<or> P,E,h' \<turnstile> e' : NT"
       by simp
     thus ?thesis
     proof(rule disjE)
       assume wte':"P,E,h' \<turnstile> e' : Class C"
       from wte' notemptyCs field wte2' sub show ?thesis by (rule WTrtFAss)
     next
       assume wte':"P,E,h' \<turnstile> e' : NT"
       from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
     qed
   next
     fix T' assume wte:"P,E,h \<turnstile> e : NT"
       and wte2:"P,E,h \<turnstile> e\<^sub>2 : T'" and sub:"P \<turnstile> T' \<le> T"
     have wte2': "P,E,h' \<turnstile> e\<^sub>2 : T'"
       by(rule WTrt_hext_mono[OF wte2 red_hext_incr[OF red]])
     from IH[OF sconf wte] have wte':"P,E,h' \<turnstile> e' : NT" by simp
     from wte' wte2' sub show ?thesis by (rule WTrtFAssNT)
   qed
   thus ?case by(rule wt_same_type_typeconf)
 next
   case (FAssRed2 E e h l e' h' l' v F Cs)
   have red:"P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
     and wt:"P,E,h \<turnstile> Val v\<bullet>F{Cs} := e : T"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> 
             \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt have "P,E,h' \<turnstile> Val v\<bullet>F{Cs}:=e' : T"
   proof (rule WTrt_elim_cases)
     fix C T' assume wtval:"P,E,h \<turnstile> Val v : Class C"
       and field:"P \<turnstile> C has least F:T via Cs"
       and notemptyCs:"Cs \<noteq> []"
       and wte:"P,E,h \<turnstile> e : T'"
       and sub:"P \<turnstile> T' \<le> T"
     have wtval':"P,E,h' \<turnstile> Val v : Class C"
       by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
     from field wf have type:"is_type P T" by(rule least_field_is_type)
     from sub type wf show ?thesis
     proof(rule subE)
       assume "T' = T" and notclass:"\<forall>C. T' \<noteq> Class C"
       from IH[OF sconf wte] notclass have wte':"P,E,h' \<turnstile> e' : T'" 
         by(cases T') auto
       from wtval' notemptyCs field wte' sub show ?thesis
         by(rule WTrtFAss)
     next
       fix C' D assume T':"T' = Class C'" and T:"T = Class D" 
         and path_unique:"P \<turnstile> Path C' to D unique"
       from IH[OF sconf wte] T' have "P,E,h' \<turnstile> e' : Class C' \<or> P,E,h' \<turnstile> e' : NT"
         by simp
       thus ?thesis
       proof(rule disjE)
         assume wte':"P,E,h' \<turnstile> e' : Class C'"
         from wtval' notemptyCs field wte' sub T' show ?thesis 
           by (fastforce intro: WTrtFAss)
       next
         assume wte':"P,E,h' \<turnstile> e' : NT"
         from wtval' notemptyCs field wte' sub T show ?thesis
           by (fastforce intro: WTrtFAss)
       qed
     next
       fix C' assume T':"T' = NT" and T:"T = Class C'"
       from IH[OF sconf wte] T' have wte':"P,E,h' \<turnstile> e' : NT" by simp
       from wtval' notemptyCs field wte' sub T show ?thesis
         by (fastforce intro: WTrtFAss)
     qed
   next
     fix T' assume wtval:"P,E,h \<turnstile> Val v : NT"
       and wte:"P,E,h \<turnstile> e : T'"
       and sub:"P \<turnstile> T' \<le> T"
     have wtval':"P,E,h' \<turnstile> Val v : NT"
       by(rule WTrt_hext_mono[OF wtval red_hext_incr[OF red]])
     from IH[OF sconf wte] sub obtain T'' where wte':"P,E,h' \<turnstile> e' : T''"
       and sub':"P \<turnstile> T'' \<le> T" by (cases T',auto,cases T,auto)
     from wtval' wte' sub' show ?thesis
       by(rule WTrtFAssNT)
   qed
   thus ?case by(rule wt_same_type_typeconf)
 next
   case (RedFAss h a D S Cs' F T Cs v v' Ds fs E l T')
   let ?fs' = "fs(F \<mapsto> v')"
   let ?S' = "insert (Ds, ?fs') (S - {(Ds, fs)})"
   let ?h' = "h(a \<mapsto> (D,?S'))"
   have h:"h a = Some(D,S)" and casts:"P \<turnstile> T casts v to v'"
     and field:"P \<turnstile> last Cs' has least F:T via Cs"
     and wt:"P,E,h \<turnstile> ref (a,Cs')\<bullet>F{Cs} := Val v : T'" by fact+
   from wt wf have type:"is_type P T'" 
     by (auto dest:least_field_is_type split:if_split_asm)
   from wt field obtain T'' where wtval:"P,E,h \<turnstile> Val v : T''" and eq:"T = T'" 
     and leq:"P \<turnstile> T'' \<le> T'"
     by (auto dest:sees_field_fun split:if_split_asm)
   from casts eq wtval show ?case
   proof(induct rule:casts_to.induct)
     case (casts_prim T\<^sub>0 w)
     have "T\<^sub>0 = T'" and "\<forall>C. T\<^sub>0 \<noteq> Class C" and wtval':"P,E,h \<turnstile> Val w : T''" by fact+
     with leq have "T' = T''" by(cases T',auto)
     with wtval' have "P,E,h \<turnstile> Val w : T'" by simp
     with h have "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> w))(S-{(Ds,fs)})))) \<turnstile> Val w : T'"
       by(cases w,auto split:if_split_asm)
     thus "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> w))(S-{(Ds,fs)})))) \<turnstile> (Val w) :\<^bsub>NT\<^esub> T'"
       by(rule wt_same_type_typeconf)
   next
     case (casts_null C'')
     have T':"Class C'' = T'" by fact
     have "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> Null))(S-{(Ds,fs)})))) \<turnstile> null : NT"
       by simp
     with sym[OF T']
     show "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> Null))(S-{(Ds,fs)})))) \<turnstile> null :\<^bsub>NT\<^esub> T'"
       by simp
   next
     case (casts_ref Xs C'' Xs' Ds'' a')
     have "Class C'' = T'" and "Ds'' = Xs @\<^sub>p Xs'"
       and "P \<turnstile> Path last Xs to C'' via Xs'"
       and "P,E,h \<turnstile> ref (a', Xs) : T''" by fact+
     with wf have "P,E,h \<turnstile> ref (a',Ds'') : T'"
       by (auto intro!:appendPath_last[THEN sym] Subobjs_nonempty
         split:if_split_asm simp:path_via_def,
         drule_tac Cs="Xs" in Subobjs_appendPath,auto)
     with h have "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> Ref(a',Ds'')))(S-{(Ds,fs)})))) \<turnstile> 
       ref (a',Ds'') : T'"
       by auto
     thus "P,E,(h(a\<mapsto>(D,insert(Ds,fs(F \<mapsto> Ref(a',Ds'')))(S-{(Ds,fs)})))) \<turnstile> 
       ref (a',Ds'') :\<^bsub>NT\<^esub> T'"
       by(rule wt_same_type_typeconf)
   qed
 next
   case (RedFAssNull E F Cs v h l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P NullPointer"
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
 next
   case (CallObj E e h l e' h' l' Copt M es)
   have red: "P,E \<turnstile> \<langle>e,(h,l)\<rangle> \<rightarrow> \<langle>e',(h',l')\<rangle>"
    and IH: "\<And>T'. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk>
                  \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
    and sconf: "P,E \<turnstile> (h,l) \<surd>" and wt: "P,E,h \<turnstile> Call e Copt M es : T" by fact+
   from wt have "P,E,h' \<turnstile> Call e' Copt M es : T"
   proof(cases Copt)
     case None
     with wt have "P,E,h \<turnstile> e\<bullet>M(es) : T" by simp
     hence "P,E,h' \<turnstile> e'\<bullet>M(es) : T"
     proof(rule WTrt_elim_cases)
       fix C Cs Ts Ts' m
       assume wte:"P,E,h \<turnstile> e : Class C"
         and "method":"P \<turnstile> C has least M = (Ts, T, m) via Cs"
         and wtes:"P,E,h \<turnstile> es [:] Ts'" and subs: "P \<turnstile> Ts' [\<le>] Ts"
       from IH[OF sconf wte] have "P,E,h' \<turnstile> e' : NT \<or> P,E,h' \<turnstile> e' : Class C" by auto
       thus ?thesis
       proof(rule disjE)
         assume wte':"P,E,h' \<turnstile> e' : NT"
         have "P,E,h' \<turnstile> es [:] Ts'"
           by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
         with wte' show ?thesis by(rule WTrtCallNT)
       next
         assume wte':"P,E,h' \<turnstile> e' : Class C"
         have wtes':"P,E,h' \<turnstile> es [:] Ts'"
           by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
         from wte' "method" wtes' subs show ?thesis by(rule WTrtCall)
       qed
     next
       fix Ts 
       assume wte:"P,E,h \<turnstile> e : NT" and wtes:"P,E,h \<turnstile> es [:] Ts"
       from IH[OF sconf wte] have wte':"P,E,h' \<turnstile> e' : NT" by simp
       have "P,E,h' \<turnstile> es [:] Ts"
         by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
       with wte' show ?thesis by(rule WTrtCallNT)
     qed
     with None show ?thesis by simp
   next
     case (Some C)
     with wt have "P,E,h \<turnstile> e\<bullet>(C::)M(es) : T" by simp
     hence "P,E,h' \<turnstile> e'\<bullet>(C::)M(es) : T"
     proof(rule WTrt_elim_cases)
       fix C' Cs Ts Ts' m
       assume wte:"P,E,h \<turnstile> e : Class C'" and path_unique:"P \<turnstile> Path C' to C unique"
         and "method":"P \<turnstile> C has least M = (Ts, T, m) via Cs"
         and wtes:"P,E,h \<turnstile> es [:] Ts'" and subs: "P \<turnstile> Ts' [\<le>] Ts"
       from IH[OF sconf wte] have "P,E,h' \<turnstile> e' : NT \<or> P,E,h' \<turnstile> e' : Class C'" by auto
       thus ?thesis
       proof(rule disjE)
         assume wte':"P,E,h' \<turnstile> e' : NT"
         have "P,E,h' \<turnstile> es [:] Ts'"
           by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
         with wte' show ?thesis by(rule WTrtCallNT)
       next
         assume wte':"P,E,h' \<turnstile> e' : Class C'"
         have wtes':"P,E,h' \<turnstile> es [:] Ts'"
           by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
         from wte' path_unique "method" wtes' subs show ?thesis by(rule WTrtStaticCall)
       qed
     next
       fix Ts 
       assume wte:"P,E,h \<turnstile> e : NT" and wtes:"P,E,h \<turnstile> es [:] Ts"
       from IH[OF sconf wte] have wte':"P,E,h' \<turnstile> e' : NT" by simp
       have "P,E,h' \<turnstile> es [:] Ts"
         by(rule WTrts_hext_mono[OF wtes red_hext_incr[OF red]])
       with wte' show ?thesis by(rule WTrtCallNT)
     qed
     with Some show ?thesis by simp
   qed
   thus ?case by (rule wt_same_type_typeconf)
 next
   case (CallParams E es h l es' h' l' v Copt M)
   have reds: "P,E \<turnstile> \<langle>es,(h,l)\<rangle> [\<rightarrow>] \<langle>es',(h',l')\<rangle>"
    and IH: "\<And>Ts. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> es [:] Ts\<rbrakk>
                  \<Longrightarrow> types_conf P E h' es' Ts"
    and sconf: "P,E \<turnstile> (h,l) \<surd>" and wt: "P,E,h \<turnstile> Call (Val v) Copt M es : T" by fact+
   from wt have "P,E,h' \<turnstile> Call (Val v) Copt M es' : T"
   proof(cases Copt)
     case None
     with wt have "P,E,h \<turnstile> (Val v)\<bullet>M(es) : T" by simp
     hence "P,E,h' \<turnstile> Val v\<bullet>M(es') : T"
     proof (rule WTrt_elim_cases)
       fix C Cs Ts Ts' m
       assume wte: "P,E,h \<turnstile> Val v : Class C"
         and "method":"P \<turnstile> C has least M = (Ts,T,m) via Cs"
         and wtes: "P,E,h \<turnstile> es [:] Ts'" and subs:"P \<turnstile> Ts' [\<le>] Ts"
       from wtes have "length es = length Ts'" by(rule WTrts_same_length)
       with reds have "length es' = length Ts'"
         by -(drule reds_length,simp)
       with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' \<turnstile> es' [:] Ts''"
         and subs':"P \<turnstile> Ts'' [\<le>] Ts" by(auto dest:types_conf_smaller_types)
       have wte':"P,E,h' \<turnstile> Val v : Class C"
         by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
       from wte' "method" wtes' subs' show ?thesis
         by(rule WTrtCall)
     next
       fix Ts
       assume wte:"P,E,h \<turnstile> Val v : NT" 
         and wtes:"P,E,h \<turnstile> es [:] Ts"
       from wtes have "length es = length Ts" by(rule WTrts_same_length)
       with reds have "length es' = length Ts"
         by -(drule reds_length,simp)
       with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' \<turnstile> es' [:] Ts'"
         and "P \<turnstile> Ts' [\<le>] Ts" by(auto dest:types_conf_smaller_types)
       have wte':"P,E,h' \<turnstile> Val v : NT"
         by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
       from wte' wtes' show ?thesis by(rule WTrtCallNT)
     qed
     with None show ?thesis by simp
   next
     case (Some C)
     with wt have "P,E,h \<turnstile> (Val v)\<bullet>(C::)M(es) : T" by simp
     hence "P,E,h' \<turnstile> (Val v)\<bullet>(C::)M(es') : T"
     proof(rule WTrt_elim_cases)
       fix C' Cs Ts Ts' m
       assume wte:"P,E,h \<turnstile> Val v : Class C'" and path_unique:"P \<turnstile> Path C' to C unique"
         and "method":"P \<turnstile> C has least M = (Ts,T,m) via Cs"
         and wtes:"P,E,h \<turnstile> es [:] Ts'" and subs: "P \<turnstile> Ts' [\<le>] Ts"
       from wtes have "length es = length Ts'" by(rule WTrts_same_length)
       with reds have "length es' = length Ts'"
         by -(drule reds_length,simp)
       with IH[OF sconf wtes] subs obtain Ts'' where wtes':"P,E,h' \<turnstile> es' [:] Ts''"
         and subs':"P \<turnstile> Ts'' [\<le>] Ts" by(auto dest:types_conf_smaller_types)
       have wte':"P,E,h' \<turnstile> Val v : Class C'"
         by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
       from wte' path_unique "method" wtes' subs' show ?thesis
         by(rule WTrtStaticCall)
     next
       fix Ts
       assume wte:"P,E,h \<turnstile> Val v : NT" 
         and wtes:"P,E,h \<turnstile> es [:] Ts"
       from wtes have "length es = length Ts" by(rule WTrts_same_length)
       with reds have "length es' = length Ts"
         by -(drule reds_length,simp)
       with IH[OF sconf wtes] obtain Ts' where wtes':"P,E,h' \<turnstile> es' [:] Ts'"
         and "P \<turnstile> Ts' [\<le>] Ts" by(auto dest:types_conf_smaller_types)
       have wte':"P,E,h' \<turnstile> Val v : NT"
         by(rule WTrt_hext_mono[OF wte reds_hext_incr[OF reds]])
       from wte' wtes' show ?thesis by(rule WTrtCallNT)
     qed
     with Some show ?thesis by simp
   qed
   thus ?case by (rule wt_same_type_typeconf)
 next
   case (RedCall h l a C S Cs M Ts' T' pns' body' Ds Ts T pns body Cs'
                 vs bs new_body E T'')
   have hp:"hp (h,l) a = Some(C,S)"
     and "method":"P \<turnstile> last Cs has least M = (Ts',T',pns',body') via Ds"
     and select:"P \<turnstile> (C,Cs@\<^sub>pDs) selects M = (Ts,T,pns,body) via Cs'"
     and length1:"length vs = length pns" and length2:"length Ts = length pns"
     and bs:"bs = blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body)"
     and body_case:"new_body = (case T' of Class D \<Rightarrow> \<lparr>D\<rparr>bs | _ \<Rightarrow> bs)"
     and wt:"P,E,h \<turnstile> ref (a,Cs)\<bullet>M(map Val vs) : T''" by fact+
   from wt hp "method" wf obtain Ts''
     where wtref:"P,E,h \<turnstile> ref (a,Cs) : Class (last Cs)" and eq:"T'' = T'"
     and wtes:"P,E,h \<turnstile> map Val vs [:] Ts''" and subs: "P \<turnstile> Ts'' [\<le>] Ts'"
     by(auto dest:wf_sees_method_fun split:if_split_asm)
   from select wf have "is_class P (last Cs')"
     by(induct rule:SelectMethodDef.induct,
        auto intro:Subobj_last_isClass simp:FinalOverriderMethodDef_def 
       OverriderMethodDefs_def MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
   with select_method_wf_mdecl[OF wf select]
   have length_pns:"length (this#pns) = length (Class(last Cs')#Ts)" 
     and notNT:"T \<noteq> NT" and type:"\<forall>T\<in>set (Class(last Cs')#Ts). is_type P T"
     and wtabody:"P,[this\<mapsto>Class(last Cs'),pns[\<mapsto>]Ts] \<turnstile> body :: T"
     by(auto simp:wf_mdecl_def)
   from wtes hp select
   have map:"map (P \<turnstile> typeof\<^bsub>h\<^esub>) (Ref(a,Cs')#vs) = map Some (Class(last Cs')#Ts'')"
     by(auto elim:SelectMethodDef.cases split:if_split_asm 
             simp:FinalOverriderMethodDef_def OverriderMethodDefs_def 
                  MinimalMethodDefs_def LeastMethodDef_def MethodDefs_def)
   from wtref hp have "P \<turnstile> Path C to (last Cs) via Cs"
     by (auto simp:path_via_def split:if_split_asm)
   with select "method" wf have "Ts' = Ts \<and> P \<turnstile> T \<le> T'"
     by -(rule select_least_methods_subtypes,simp_all)
   hence eqs:"Ts' = Ts" and sub:"P \<turnstile> T \<le> T'" by auto
   from wf wtabody have "P,Map.empty(this\<mapsto>Class(last Cs'),pns[\<mapsto>]Ts),h \<turnstile> body : T"
     by -(rule WT_implies_WTrt,simp_all)
   hence wtbody:"P,E(this#pns [\<mapsto>] Class (last Cs')#Ts),h \<turnstile> body : T"
     by(rule WTrt_env_mono) simp
   from wtes have "length vs = length Ts''"
     by (fastforce dest:WTrts_same_length)
   with eqs subs
   have length_vs:"length (Ref(a,Cs')#vs) = length (Class(last Cs')#Ts)"
     by (simp add:list_all2_iff)
   from subs eqs have "P \<turnstile> (Class(last Cs')#Ts'') [\<le>] (Class(last Cs')#Ts)"
     by (simp add:fun_of_def)
   with wt_blocks[OF length_pns length_vs type] wtbody map eq
   have blocks:"P,E,h \<turnstile> blocks(this#pns,Class(last Cs')#Ts,Ref(a,Cs')#vs,body) : T"
     by auto
   have "P,E,h \<turnstile> new_body : T'"
   proof(cases "\<forall>C. T' \<noteq> Class C")
     case True
     with sub notNT have "T = T'" by (cases T') auto
     with blocks True body_case bs show ?thesis by(cases T') auto
   next
     case False
     then obtain D where T':"T' = Class D" by auto
     with "method" sub wf have "class": "is_class P D"
       by (auto elim!:widen.cases dest:least_method_is_type 
                intro:Subobj_last_isClass simp:path_unique_def)
     with blocks T' body_case bs "class" sub show ?thesis
       by(cases T',auto,cases T,auto)
   qed
   with eq show ?case by(fastforce intro:wt_same_type_typeconf)
 next
   case (RedStaticCall Cs C Cs'' M Ts T pns body Cs' Ds vs E a h l T')
   have "method":"P \<turnstile> C has least M = (Ts, T, pns, body) via Cs'"
     and length1:"length vs = length pns"
     and length2:"length Ts = length pns"
     and path_unique:"P \<turnstile> Path last Cs to C unique"
     and path_via:"P \<turnstile> Path last Cs to C via Cs''"
     and Ds:"Ds = (Cs @\<^sub>p Cs'') @\<^sub>p Cs'"
     and wt:"P,E,h \<turnstile> ref (a,Cs)\<bullet>(C::)M(map Val vs) : T'" by fact+
   from wt "method" wf obtain Ts'
     where wtref:"P,E,h \<turnstile> ref (a,Cs) : Class (last Cs)"
     and wtes:"P,E,h \<turnstile> map Val vs [:] Ts'" and subs:"P \<turnstile> Ts' [\<le>] Ts"
     and TeqT':"T = T'"
     by(auto dest:wf_sees_method_fun split:if_split_asm)
   from wtref obtain D S where hp:"h a = Some(D,S)" and subo:"Subobjs P D Cs"
     by (auto split:if_split_asm)
   from length1 length2
   have length_vs: "length (Ref(a,Ds)#vs) = length (Class (last Ds)#Ts)" by simp
   from length2 have length_pns:"length (this#pns) = length (Class (last Ds)#Ts)"
     by simp
   from "method" have "Cs' \<noteq> []" 
     by (fastforce intro!:Subobjs_nonempty simp add:LeastMethodDef_def MethodDefs_def)
   with Ds have last:"last Cs' = last Ds"
     by (fastforce dest:appendPath_last)
   with "method" have "is_class P (last Ds)"
     by(auto simp:LeastMethodDef_def MethodDefs_def is_class_def)
   with last has_least_wf_mdecl[OF wf "method"]
   have wtabody: "P,[this#pns [\<mapsto>] Class (last Ds)#Ts] \<turnstile> body :: T"
     and type:"\<forall>T\<in>set (Class(last Ds)#Ts). is_type P T"
     by(auto simp:wf_mdecl_def)
   from path_via have suboCs'':"Subobjs P (last Cs) Cs''" 
     and lastCs'':"last Cs'' = C" 
     by (auto simp add:path_via_def)
   with subo wf have subo':"Subobjs P D (Cs@\<^sub>pCs'')"
      by(fastforce intro: Subobjs_appendPath)
    from lastCs'' suboCs'' have lastC:"C = last(Cs@\<^sub>pCs'')"
      by (fastforce dest:Subobjs_nonempty intro:appendPath_last)
   from "method" have "Subobjs P C Cs'"
     by (auto simp:LeastMethodDef_def MethodDefs_def)
   with subo' wf lastC have "Subobjs P D ((Cs @\<^sub>p Cs'') @\<^sub>p Cs')"
     by (fastforce intro:Subobjs_appendPath)
   with Ds have suboDs:"Subobjs P D Ds" by simp
   from wtabody have "P,Map.empty(this#pns [\<mapsto>] Class (last Ds)#Ts),h \<turnstile> body : T"
     by(rule WT_implies_WTrt)
   hence "P,E(this#pns [\<mapsto>] Class (last Ds)#Ts),h \<turnstile> body : T"
     by(rule WTrt_env_mono) simp
   hence "P,E,h \<turnstile> blocks(this#pns, Class (last Ds)#Ts, Ref(a,Ds)#vs, body) : T"
     using wtes subs wt_blocks[OF length_pns length_vs type] hp suboDs
     by(auto simp add:rel_list_all2_Cons2)
   with TeqT' show ?case by(fastforce intro:wt_same_type_typeconf)
 next
   case (RedCallNull E Copt M vs h l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P NullPointer" 
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (BlockRedNone E V T e h l e' h' l' T')
   have IH:"\<And>T'. \<lbrakk>P,E(V \<mapsto> T) \<turnstile> (h, l(V := None)) \<surd>; P,E(V \<mapsto> T),h \<turnstile> e : T'\<rbrakk>
                  \<Longrightarrow> P,E(V \<mapsto> T),h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> {V:T; e} : T'" by fact+
   from wt have type:"is_type P T" and wte:"P,E(V\<mapsto>T),h \<turnstile> e : T'" by auto
   from sconf type have "P,E(V \<mapsto> T) \<turnstile> (h, l(V := None)) \<surd>"
     by (auto simp:sconf_def lconf_def envconf_def)
   from IH[OF this wte] type show ?case by (cases T') auto
 next
   case (BlockRedSome E V T e h l e' h' l' v T')
   have red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V := None))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH:"\<And>T'. \<lbrakk>P,E(V \<mapsto> T) \<turnstile> (h, l(V := None)) \<surd>; P,E(V \<mapsto> T),h \<turnstile> e : T'\<rbrakk>
                   \<Longrightarrow> P,E(V \<mapsto> T),h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and Some:"l' V = Some v"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> {V:T; e} : T'" by fact+
   from wt have wte:"P,E(V\<mapsto>T),h \<turnstile> e : T'"  and type:"is_type P T" by auto
   with sconf wf red type have "P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)"
     by -(auto simp:sconf_def,rule red_preserves_lconf,
          auto intro:wf_prog_wwf_prog simp:envconf_def lconf_def)
   hence conf:"P,h' \<turnstile> v :\<le> T" using Some 
     by(auto simp:lconf_def,erule_tac x="V" in allE,clarsimp)
   have wtval:"P,E(V \<mapsto> T),h' \<turnstile> V:=Val v : T"
   proof(cases T)
     case Void with conf show ?thesis by auto
   next
     case Boolean with conf show ?thesis by auto
   next
     case Integer with conf show ?thesis by auto
   next
     case NT with conf show ?thesis by auto
   next
     case (Class C)
     with conf have "P,E(V \<mapsto> T),h' \<turnstile> Val v : T \<or> P,E(V \<mapsto> T),h' \<turnstile> Val v : NT"
       by auto
     with Class show ?thesis by auto
   qed
   from sconf type have "P,E(V \<mapsto> T) \<turnstile> (h, l(V := None)) \<surd>"
     by (auto simp:sconf_def lconf_def envconf_def)
   from IH[OF this wte] wtval type show ?case by(cases T') auto
 next
   case (InitBlockRed E V T e h l v' e' h' l' v'' v T')
   have red:"P,E(V \<mapsto> T) \<turnstile> \<langle>e,(h, l(V \<mapsto> v'))\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH:"\<And>T'. \<lbrakk>P,E(V \<mapsto> T) \<turnstile> (h, l(V \<mapsto> v')) \<surd>; P,E(V \<mapsto> T),h \<turnstile> e : T'\<rbrakk>
               \<Longrightarrow> P,E(V \<mapsto> T),h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and Some:"l' V = Some v''" and casts:"P \<turnstile> T casts v to v'"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> {V:T := Val v; e} : T'" by fact+
   from wt have wte:"P,E(V \<mapsto> T),h \<turnstile> e : T'" and wtval:"P,E(V \<mapsto> T),h \<turnstile> V:=Val v : T"
     and type:"is_type P T"
     by auto
   from wf casts wtval have "P,h \<turnstile> v' :\<le> T"
     by(fastforce intro!:casts_conf wf_prog_wwf_prog)
   with sconf have lconf:"P,h \<turnstile> l(V \<mapsto> v') (:\<le>)\<^sub>w E(V \<mapsto> T)"
     by (fastforce intro!:lconf_upd2 simp:sconf_def)
   from sconf type have "envconf P (E(V \<mapsto> T))" by(simp add:sconf_def envconf_def)
   from red_preserves_lconf[OF wf_prog_wwf_prog[OF wf] red wte lconf this]
   have "P,h' \<turnstile> l' (:\<le>)\<^sub>w E(V \<mapsto> T)" .
   with Some have "P,h' \<turnstile> v'' :\<le> T"
     by(simp add:lconf_def,erule_tac x="V" in allE,auto)
   hence wtval':"P,E(V \<mapsto> T),h' \<turnstile> V:=Val v'' : T"
     by(cases T) auto
   from lconf sconf type have "P,E(V \<mapsto> T) \<turnstile> (h, l(V \<mapsto> v')) \<surd>"
     by(auto simp:sconf_def envconf_def)
   from IH[OF this wte] wtval' type show ?case by(cases T') auto
 next
   case RedBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case RedInitBlock thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (SeqRed E e h l e' h' l' e\<^sub>2 T)
   have red:"P,E \<turnstile> \<langle>e,(h, l)\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH:"\<And>T'. \<lbrakk>P,E \<turnstile> (h, l) \<surd>; P,E,h \<turnstile> e : T'\<rbrakk> \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T'"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> e;; e\<^sub>2 : T" by fact+
   from wt obtain T' where wte:"P,E,h \<turnstile> e : T'" and wte2:"P,E,h \<turnstile> e\<^sub>2 : T" by auto
   from WTrt_hext_mono[OF wte2 red_hext_incr[OF red]] have wte2':"P,E,h' \<turnstile> e\<^sub>2 : T" .
   from IH[OF sconf wte] obtain T'' where "P,E,h' \<turnstile> e' : T''" by(cases T') auto
   with wte2' have "P,E,h' \<turnstile> e';; e\<^sub>2 : T" by auto
   thus ?case by(rule wt_same_type_typeconf)
 next
   case RedSeq thus ?case by (fastforce intro:wt_same_type_typeconf)
 next
   case (CondRed E e h l e' h' l' e\<^sub>1 e\<^sub>2)
   have red:"P,E \<turnstile> \<langle>e,(h, l)\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH: "\<And>T. \<lbrakk>P,E \<turnstile> (h,l) \<surd>; P,E,h \<turnstile> e : T\<rbrakk>
                      \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T"
     and wt:"P,E,h \<turnstile> if (e) e\<^sub>1 else e\<^sub>2 : T"
     and sconf:"P,E \<turnstile> (h,l) \<surd>" by fact+
   from wt have wte:"P,E,h \<turnstile> e : Boolean"
       and wte1:"P,E,h \<turnstile> e\<^sub>1 : T" and wte2:"P,E,h \<turnstile> e\<^sub>2 : T" by auto
   from IH[OF sconf wte] have wte':"P,E,h' \<turnstile> e' : Boolean" by auto
   from wte' WTrt_hext_mono[OF wte1 red_hext_incr[OF red]]
     WTrt_hext_mono[OF wte2 red_hext_incr[OF red]]
   have "P,E,h' \<turnstile> if (e') e\<^sub>1 else e\<^sub>2 : T"
     by (rule WTrtCond)
   thus ?case by(rule wt_same_type_typeconf)
 next
   case RedCondT thus ?case by (fastforce intro: wt_same_type_typeconf)
 next
   case RedCondF thus ?case by (fastforce intro: wt_same_type_typeconf)
 next
   case RedWhile thus ?case by (fastforce intro: wt_same_type_typeconf)
 next
   case (ThrowRed E e h l e' h' l' T)
   have IH:"\<And>T. \<lbrakk>P,E \<turnstile> (h, l) \<surd>; P,E,h \<turnstile> e : T\<rbrakk> \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> throw e : T" by fact+
   from wt obtain T' where wte:"P,E,h \<turnstile> e : T'" and ref:"is_refT T'"
     by auto
   from ref have "P,E,h' \<turnstile> throw e' : T"
   proof(rule refTE)
     assume T':"T' = NT"
     with wte have "P,E,h \<turnstile> e : NT" by simp
     from IH[OF sconf this] ref T' show ?thesis by auto
     
   next
     fix C assume T':"T' = Class C"
     with wte have "P,E,h \<turnstile> e : Class C" by simp
     from IH[OF sconf this] have "P,E,h' \<turnstile> e' : Class C \<or> P,E,h' \<turnstile> e' : NT"
       by simp
     thus ?thesis
     proof(rule disjE)
       assume wte':"P,E,h' \<turnstile> e' : Class C"
       have "is_refT (Class C)" by simp
       with wte' show ?thesis by auto
     next
       assume wte':"P,E,h' \<turnstile> e' : NT"
       have "is_refT NT" by simp
       with wte' show ?thesis by auto
     qed
   qed
   thus ?case by (rule wt_same_type_typeconf)
 next
   case (RedThrowNull E h l)
   have sconf:"P,E \<turnstile> (h, l) \<surd>" by fact
   from wf have "is_class P NullPointer"
     by (fastforce intro:is_class_xcpt wf_prog_wwf_prog)
   hence "preallocated h \<Longrightarrow> P \<turnstile> typeof\<^bsub>h\<^esub> (Ref (addr_of_sys_xcpt NullPointer,[NullPointer])) = Some(Class NullPointer)"
     by (auto elim: preallocatedE dest!:preallocatedD Subobjs_Base)
   with sconf have "P,E,h \<turnstile> THROW NullPointer : T" by(auto simp:sconf_def hconf_def)
   thus ?case by (fastforce intro:wt_same_type_typeconf wf_prog_wwf_prog)
 next
   case (ListRed1 E e h l e' h' l' es Ts)
   have red:"P,E \<turnstile> \<langle>e,(h, l)\<rangle> \<rightarrow> \<langle>e',(h', l')\<rangle>"
     and IH:"\<And>T. \<lbrakk>P,E \<turnstile> (h, l) \<surd>; P,E,h \<turnstile> e : T\<rbrakk> \<Longrightarrow> P,E,h' \<turnstile> e' :\<^bsub>NT\<^esub> T"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> e # es [:] Ts" by fact+
   from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
   with wt have wte:"P,E,h \<turnstile> e : U" and wtes:"P,E,h \<turnstile> es [:] Us" by simp_all
   from WTrts_hext_mono[OF wtes red_hext_incr[OF red]] 
   have wtes':"P,E,h' \<turnstile> es [:] Us" .
   hence "length es = length Us" by (rule WTrts_same_length)
   with wtes' have "types_conf P E h' es Us"
     by (fastforce intro:wts_same_types_typesconf)
   with IH[OF sconf wte] Ts show ?case by simp
 next
   case (ListRed2 E es h l es' h' l' v Ts)
   have reds:"P,E \<turnstile> \<langle>es,(h, l)\<rangle> [\<rightarrow>] \<langle>es',(h', l')\<rangle>"
     and IH:"\<And>Ts. \<lbrakk>P,E \<turnstile> (h, l) \<surd>; P,E,h \<turnstile> es [:] Ts\<rbrakk> \<Longrightarrow> types_conf P E h' es' Ts"
     and sconf:"P,E \<turnstile> (h, l) \<surd>" and wt:"P,E,h \<turnstile> Val v#es [:] Ts" by fact+
   from wt obtain U Us where Ts:"Ts = U#Us" by(cases Ts) auto
   with wt have wtval:"P,E,h \<turnstile> Val v : U" and wtes:"P,E,h \<turnstile> es [:] Us" by simp_all
   from WTrt_hext_mono[OF wtval reds_hext_incr[OF reds]]
   have "P,E,h' \<turnstile> Val v : U" .
   hence "P,E,h' \<turnstile> (Val v) :\<^bsub>NT\<^esub> U" by(rule wt_same_type_typeconf)
   with IH[OF sconf wtes] Ts show ?case by simp
 next
   case (CallThrowObj E h l Copt M es h' l')
   thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
 next
   case (CallThrowParams es vs h l es' E v Copt M h' l')
   thus ?case by(cases Copt)(auto intro:wt_same_type_typeconf)
 qed (fastforce intro:wt_same_type_typeconf)+
 
 
 
 corollary subject_reduction:
   "\<lbrakk> wf_C_prog P; P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e',s'\<rangle>; P,E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e:T \<rbrakk>
   \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
 by(cases s, cases s', fastforce dest:subject_reduction2)
 
 corollary subjects_reduction:
   "\<lbrakk> wf_C_prog P; P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>] \<langle>es',s'\<rangle>; P,E \<turnstile> s \<surd>; P,E,hp s \<turnstile> es[:]Ts \<rbrakk>
   \<Longrightarrow> types_conf P E (hp s') es' Ts"
 by(cases s, cases s', fastforce dest:subjects_reduction2)
 
 
 subsection \<open>Lifting to \<open>\<rightarrow>*\<close>\<close>
 
 text\<open>Now all these preservation lemmas are first lifted to the transitive
 closure \dots\<close>
 
 lemma step_preserves_sconf:
 assumes wf: "wf_C_prog P" and step: "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
 shows "\<And>T. \<lbrakk> P,E,hp s \<turnstile> e : T; P,E \<turnstile> s \<surd> \<rbrakk> \<Longrightarrow> P,E \<turnstile> s' \<surd>"
 
 using step
 proof (induct rule:converse_rtrancl_induct2)
   case refl show ?case by fact 
 next
   case step
   thus ?case using wf
     apply simp
     apply (frule subject_reduction[OF wf])
       apply (rule step.prems)
       apply (rule step.prems)
       apply (cases T)
       apply (auto dest:red_preserves_sconf intro:wf_prog_wwf_prog)
       done
 qed
 
 lemma steps_preserves_sconf:
 assumes wf: "wf_C_prog P" and step: "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
 shows "\<And>Ts. \<lbrakk> P,E,hp s \<turnstile> es [:] Ts; P,E \<turnstile> s \<surd> \<rbrakk> \<Longrightarrow> P,E \<turnstile> s' \<surd>"
 
 using step
 proof (induct rule:converse_rtrancl_induct2)
   case refl show ?case by fact
 next
   case (step es s es'' s'' Ts)
   have Reds:"((es, s), es'', s'') \<in> Reds P E"
     and reds:"P,E \<turnstile> \<langle>es'',s''\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
     and wtes:"P,E,hp s \<turnstile> es [:] Ts"
     and sconf:"P,E \<turnstile> s \<surd>"
     and IH:"\<And>Ts. \<lbrakk>P,E,hp s'' \<turnstile> es'' [:] Ts; P,E \<turnstile> s'' \<surd>\<rbrakk> \<Longrightarrow> P,E \<turnstile> s' \<surd>" by fact+
   from Reds have reds1:"P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>] \<langle>es'',s''\<rangle>" by simp
   from subjects_reduction[OF wf this sconf wtes] 
   have type:"types_conf P E (hp s'') es'' Ts" .
   from reds1 wtes sconf wf have sconf':"P,E \<turnstile> s'' \<surd>" 
     by(fastforce intro:wf_prog_wwf_prog reds_preserves_sconf)
   from type have "\<exists>Ts'. P,E,hp s'' \<turnstile> es'' [:] Ts'"
   proof (induct Ts arbitrary: es'')
     fix esi
     assume "types_conf P E (hp s'') esi []"
     thus "\<exists>Ts'. P,E,hp s'' \<turnstile> esi [:] Ts'"
     proof(induct esi)
       case Nil thus "\<exists>Ts'. P,E,hp s'' \<turnstile> [] [:] Ts'" by simp
     next
       fix ex esx
       assume "types_conf P E (hp s'') (ex#esx) []"
       thus "\<exists>Ts'. P,E,hp s'' \<turnstile> ex#esx [:] Ts'" by simp
     qed
   next
     fix T' Ts' esi
     assume type':"types_conf P E (hp s'') esi (T'#Ts')"
       and IH:"\<And>es''. types_conf P E (hp s'') es'' Ts' \<Longrightarrow>
                       \<exists>Ts''. P,E,hp s'' \<turnstile> es'' [:] Ts''"
     from type' show "\<exists>Ts'. P,E,hp s'' \<turnstile> esi [:] Ts'"
     proof(induct esi)
       case Nil thus "\<exists>Ts'. P,E,hp s'' \<turnstile> [] [:] Ts'" by simp
     next
       fix ex esx
       assume "types_conf P E (hp s'') (ex#esx) (T'#Ts')"
       hence type':"P,E,hp s'' \<turnstile> ex :\<^bsub>NT\<^esub> T'" 
         and types':"types_conf P E (hp s'') esx Ts'" by simp_all
       from type' obtain Tx where type'':"P,E,hp s'' \<turnstile> ex : Tx"
         by(cases T') auto
       from IH[OF types'] obtain Tsx where "P,E,hp s'' \<turnstile> esx [:] Tsx" by auto
       with type'' show "\<exists>Ts'. P,E,hp s'' \<turnstile> ex#esx [:] Ts'" by auto
     qed
   qed
   then obtain Ts' where "P,E,hp s'' \<turnstile> es'' [:] Ts'" by blast
   from IH[OF this sconf'] show ?case .
 qed
 
 
 lemma step_preserves_defass:
 assumes wf: "wf_C_prog P" and step: "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
 shows "\<D> e \<lfloor>dom(lcl s)\<rfloor> \<Longrightarrow> \<D> e' \<lfloor>dom(lcl s')\<rfloor>"
 
 using step
 proof (induct rule:converse_rtrancl_induct2)
   case refl thus ?case .
 next
   case (step e s e' s') thus ?case
     by(cases s,cases s')(auto dest:red_preserves_defass[OF wf])
 qed
 
 
 
 lemma step_preserves_type:
 assumes wf: "wf_C_prog P" and step: "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
 shows "\<And>T. \<lbrakk> P,E \<turnstile> s \<surd>; P,E,hp s \<turnstile> e:T \<rbrakk>
     \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
 
 using step
 proof (induct rule:converse_rtrancl_induct2)
   case refl thus ?case by -(rule wt_same_type_typeconf)
 next
   case (step e s e'' s'' T) thus ?case using wf
     apply simp
     apply (frule subject_reduction[OF wf])
     apply (auto dest!:red_preserves_sconf intro:wf_prog_wwf_prog)
     apply(cases T)
     apply fastforce+
     done
 qed
 
 
 text\<open>predicate to show the same lemma for lists\<close>
 
 fun
   conformable :: "ty list \<Rightarrow> ty list \<Rightarrow> bool"
 where
   "conformable [] [] \<longleftrightarrow> True"
   | "conformable (T''#Ts'') (T'#Ts') \<longleftrightarrow> (T'' = T'
      \<or> (\<exists>C. T'' = NT \<and> T' = Class C)) \<and> conformable Ts'' Ts'"
   | "conformable _ _ \<longleftrightarrow> False"
 
 lemma types_conf_conf_types_conf:
   "\<lbrakk>types_conf P E h es Ts; conformable Ts Ts'\<rbrakk> \<Longrightarrow> types_conf P E h es Ts'"
 proof (induct Ts arbitrary: Ts' es)
   case Nil thus ?case by (cases Ts') (auto split: if_split_asm)
 next
   case (Cons T'' Ts'')
   have type:"types_conf P E h es (T''#Ts'')"
     and conf:"conformable (T''#Ts'') Ts'"
     and IH:"\<And>Ts' es. \<lbrakk>types_conf P E h es Ts''; conformable Ts'' Ts'\<rbrakk>
                    \<Longrightarrow> types_conf P E h es Ts'" by fact+
   from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
   with type have type':"P,E,h \<turnstile> e' :\<^bsub>NT\<^esub> T''"
     and types': "types_conf P E h es' Ts''"
     by simp_all
   from conf obtain U Us where Ts': "Ts' = U#Us" by (cases Ts') auto
   with conf have disj:"T'' = U \<or> (\<exists>C. T'' = NT \<and> U = Class C)"
     and conf':"conformable Ts'' Us"
     by simp_all
   from type' disj have "P,E,h \<turnstile> e' :\<^bsub>NT\<^esub> U" by auto
   with IH[OF types' conf'] Ts' es show ?case by simp
 qed
 
 
 lemma types_conf_Wtrt_conf:
   "types_conf P E h es Ts \<Longrightarrow> \<exists>Ts'. P,E,h \<turnstile> es [:] Ts' \<and> conformable Ts' Ts"
 proof (induct Ts arbitrary: es)
   case Nil thus ?case by (cases es) (auto split:if_split_asm)
 next
   case (Cons T'' Ts'')
   have type:"types_conf P E h es (T''#Ts'')"
     and IH:"\<And>es. types_conf P E h es Ts'' \<Longrightarrow>
                   \<exists>Ts'. P,E,h \<turnstile> es [:] Ts' \<and> conformable Ts' Ts''" by fact+
   from type obtain e' es' where es:"es = e'#es'" by (cases es) auto
   with type have type':"P,E,h \<turnstile> e' :\<^bsub>NT\<^esub> T''"
     and types': "types_conf P E h es' Ts''"
     by simp_all
   from type' obtain T' where "P,E,h \<turnstile> e' : T'" and 
     "T' = T'' \<or> (\<exists>C. T' = NT \<and> T'' = Class C)" by(cases T'') auto
   with IH[OF types'] es show ?case 
     by(auto,rule_tac x="T''#Ts'" in exI,simp,rule_tac x="NT#Ts'" in exI,simp)
 qed
 
 
 
 lemma steps_preserves_types:
 assumes wf: "wf_C_prog P" and steps: "P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
 shows "\<And>Ts. \<lbrakk> P,E \<turnstile> s \<surd>; P,E,hp s \<turnstile> es [:] Ts\<rbrakk>
   \<Longrightarrow> types_conf P E (hp s') es' Ts"
   
 using steps
 proof (induct rule:converse_rtrancl_induct2)
   case refl thus ?case by -(rule wts_same_types_typesconf)
 next
   case (step es s es'' s'' Ts)
   have Reds:"((es, s), es'', s'') \<in> Reds P E"
     and steps:"P,E \<turnstile> \<langle>es'',s''\<rangle> [\<rightarrow>]* \<langle>es',s'\<rangle>"
     and sconf:"P,E \<turnstile> s \<surd>" and wtes:"P,E,hp s \<turnstile> es [:] Ts"
     and IH:"\<And>Ts. \<lbrakk>P,E \<turnstile> s'' \<surd>; P,E,hp s'' \<turnstile> es'' [:] Ts \<rbrakk> 
                \<Longrightarrow> types_conf P E (hp s') es' Ts" by fact+
   from Reds have step:"P,E \<turnstile> \<langle>es,s\<rangle> [\<rightarrow>] \<langle>es'',s''\<rangle>" by simp
   with wtes sconf wf have sconf':"P,E \<turnstile> s'' \<surd>"
     by(auto intro:reds_preserves_sconf wf_prog_wwf_prog)
   from wtes have "length es = length Ts" by(fastforce dest:WTrts_same_length)
   from step sconf wtes
   have type': "types_conf P E (hp s'') es'' Ts"
     by (rule subjects_reduction[OF wf])
   then obtain Ts' where wtes'':"P,E,hp s'' \<turnstile> es'' [:] Ts'" 
     and conf:"conformable Ts' Ts" by (auto dest:types_conf_Wtrt_conf)
   from IH[OF sconf' wtes''] have "types_conf P E (hp s') es' Ts'" .
   with conf show ?case by(fastforce intro:types_conf_conf_types_conf)
 qed
   
 
 subsection \<open>Lifting to \<open>\<Rightarrow>\<close>\<close>
 
 text\<open>\dots and now to the big step semantics, just for fun.\<close>
 
 lemma eval_preserves_sconf:
   "\<lbrakk> wf_C_prog P; P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>; P,E \<turnstile> e::T; P,E \<turnstile> s \<surd> \<rbrakk> \<Longrightarrow> P,E \<turnstile> s' \<surd>"
 
 by(blast intro:step_preserves_sconf big_by_small WT_implies_WTrt wf_prog_wwf_prog)
 
 lemma evals_preserves_sconf:
   "\<lbrakk> wf_C_prog P; P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>; P,E \<turnstile> es [::] Ts; P,E \<turnstile> s \<surd> \<rbrakk> 
   \<Longrightarrow> P,E \<turnstile> s' \<surd>"
   by(blast intro:steps_preserves_sconf bigs_by_smalls WTs_implies_WTrts 
                  wf_prog_wwf_prog)
 
 
 
 lemma eval_preserves_type: assumes wf: "wf_C_prog P"
 shows "\<lbrakk> P,E \<turnstile> \<langle>e,s\<rangle> \<Rightarrow> \<langle>e',s'\<rangle>; P,E \<turnstile> s \<surd>; P,E \<turnstile> e::T \<rbrakk>
    \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
 
   using wf
   by (auto dest!:big_by_small[OF wf_prog_wwf_prog[OF wf]] WT_implies_WTrt 
            intro:wf_prog_wwf_prog
            dest!:step_preserves_type[OF wf])
 
 
 lemma evals_preserves_types: assumes wf: "wf_C_prog P"
 shows "\<lbrakk> P,E \<turnstile> \<langle>es,s\<rangle> [\<Rightarrow>] \<langle>es',s'\<rangle>; P,E \<turnstile> s \<surd>; P,E \<turnstile> es [::] Ts \<rbrakk>
   \<Longrightarrow> types_conf P E (hp s') es' Ts"
 using wf
   by (auto dest!:bigs_by_smalls[OF wf_prog_wwf_prog[OF wf]] WTs_implies_WTrts
            intro:wf_prog_wwf_prog
            dest!:steps_preserves_types[OF wf])
 
 
 subsection \<open>The final polish\<close>
 
 text\<open>The above preservation lemmas are now combined and packed nicely.\<close>
 
 definition wf_config :: "prog \<Rightarrow> env \<Rightarrow> state \<Rightarrow> expr \<Rightarrow> ty \<Rightarrow> bool" ("_,_,_ \<turnstile> _ : _ \<surd>"   [51,0,0,0,0]50) where
   "P,E,s \<turnstile> e:T \<surd>  \<equiv>  P,E \<turnstile> s \<surd> \<and> P,E,hp s \<turnstile> e : T"
 
 theorem Subject_reduction: assumes wf: "wf_C_prog P"
 shows "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e',s'\<rangle> \<Longrightarrow> P,E,s \<turnstile> e : T \<surd>
        \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
 
   using wf
   by (force elim!:red_preserves_sconf intro:wf_prog_wwf_prog 
             dest:subject_reduction[OF wf] simp:wf_config_def)
 
 
 
 theorem Subject_reductions:
 assumes wf: "wf_C_prog P" and reds: "P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
 shows "\<And>T. P,E,s \<turnstile> e : T \<surd> \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
 
 using reds
 proof (induct rule:converse_rtrancl_induct2)
   case refl thus ?case
     by (fastforce intro:wt_same_type_typeconf simp:wf_config_def)
 next
   case (step e s e'' s'' T)
   have Red:"((e, s), e'', s'') \<in> Red P E"
     and IH:"\<And>T. P,E,s'' \<turnstile> e'' : T \<surd> \<Longrightarrow> P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
     and wte:"P,E,s \<turnstile> e : T \<surd>" by fact+
   from Red have red:"P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e'',s''\<rangle>" by simp
   from red_preserves_sconf[OF red] wte wf have sconf:"P,E \<turnstile> s'' \<surd>"
     by(fastforce dest:wf_prog_wwf_prog simp:wf_config_def)
   from wf red wte have type_conf:"P,E,(hp s'') \<turnstile> e'' :\<^bsub>NT\<^esub> T"
     by(rule Subject_reduction)
   show ?case
   proof(cases T)
     case Void
     with type_conf have "P,E,hp s'' \<turnstile> e'' : T" by simp
     with sconf have "P,E,s'' \<turnstile> e'' : T \<surd>" by(simp add:wf_config_def)
     from IH[OF this] show ?thesis .
   next
     case Boolean
     with type_conf have "P,E,hp s'' \<turnstile> e'' : T" by simp
     with sconf have "P,E,s'' \<turnstile> e'' : T \<surd>" by(simp add:wf_config_def)
     from IH[OF this] show ?thesis .
   next
     case Integer
     with type_conf have "P,E,hp s'' \<turnstile> e'' : T" by simp
     with sconf have "P,E,s'' \<turnstile> e'' : T \<surd>" by(simp add:wf_config_def)
     from IH[OF this] show ?thesis .
   next
     case NT
     with type_conf have "P,E,hp s'' \<turnstile> e'' : T" by simp
     with sconf have "P,E,s'' \<turnstile> e'' : T \<surd>" by(simp add:wf_config_def)
     from IH[OF this] show ?thesis .
   next
     case (Class C)
     with type_conf have "P,E,hp s'' \<turnstile> e'' : T \<or> P,E,hp s'' \<turnstile> e'' : NT" by simp
     thus ?thesis
     proof(rule disjE)
       assume "P,E,hp s'' \<turnstile> e'' : T"
       with sconf have "P,E,s'' \<turnstile> e'' : T \<surd>" by(simp add:wf_config_def)
       from IH[OF this] show ?thesis .
     next
       assume "P,E,hp s'' \<turnstile> e'' : NT"
       with sconf have "P,E,s'' \<turnstile> e'' : NT \<surd>" by(simp add:wf_config_def)
       from IH[OF this] have "P,E,hp s' \<turnstile> e' : NT" by simp
       with Class show ?thesis by simp
     qed
   qed
 qed
 
 
 
 corollary Progress: assumes wf: "wf_C_prog P"
 shows "\<lbrakk> P,E,s  \<turnstile> e : T \<surd>; \<D> e \<lfloor>dom(lcl s)\<rfloor>; \<not> final e \<rbrakk> \<Longrightarrow> \<exists>e' s'. P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow> \<langle>e',s'\<rangle>"
 
 using progress[OF wf_prog_wwf_prog[OF wf]]
 by(auto simp:wf_config_def sconf_def)
 
 
 corollary TypeSafety:
 fixes s s' :: state
 assumes wf:"wf_C_prog P" and sconf:"P,E \<turnstile> s \<surd>" and wte:"P,E \<turnstile> e :: T"
   and D:"\<D> e \<lfloor>dom(lcl s)\<rfloor>" and step:"P,E \<turnstile> \<langle>e,s\<rangle> \<rightarrow>* \<langle>e',s'\<rangle>"
   and nored:"\<not>(\<exists>e'' s''. P,E \<turnstile> \<langle>e',s'\<rangle> \<rightarrow> \<langle>e'',s''\<rangle>)"
 shows "(\<exists>v. e' = Val v \<and> P,hp s' \<turnstile> v :\<le> T) \<or>
       (\<exists>r. e' = Throw r \<and> the_addr (Ref r) \<in> dom(hp s'))"
 proof -
   from sconf wte wf have wf_config:"P,E,s \<turnstile> e : T \<surd>"
     by(fastforce intro:WT_implies_WTrt simp:wf_config_def)
   with wf step have type_conf:"P,E,(hp s') \<turnstile> e' :\<^bsub>NT\<^esub> T"
     by(rule Subject_reductions)
   from step_preserves_sconf[OF wf step wte[THEN WT_implies_WTrt] sconf] wf
   have sconf':"P,E \<turnstile> s' \<surd>" by simp
   from wf step D have D':"\<D> e' \<lfloor>dom(lcl s')\<rfloor>" by(rule step_preserves_defass)
   show ?thesis
   proof(cases T)
     case Void 
     with type_conf have wte':"P,E,hp s' \<turnstile> e' : T" by simp
     with sconf' have wf_config':"P,E,s' \<turnstile> e' : T \<surd>" by(simp add:wf_config_def)
     { assume "\<not> final e'"
       from Progress[OF wf wf_config' D' this] nored have False
         by simp }
     hence "final e'" by fast
     with wte' show ?thesis by(auto simp:final_def)
   next
     case Boolean
     with type_conf have wte':"P,E,hp s' \<turnstile> e' : T" by simp
     with sconf' have wf_config':"P,E,s' \<turnstile> e' : T \<surd>" by(simp add:wf_config_def)
     { assume "\<not> final e'"
       from Progress[OF wf wf_config' D' this] nored have False
         by simp }
     hence "final e'" by fast
     with wte' show ?thesis by(auto simp:final_def)
   next
     case Integer
     with type_conf have wte':"P,E,hp s' \<turnstile> e' : T" by simp
     with sconf' have wf_config':"P,E,s' \<turnstile> e' : T \<surd>" by(simp add:wf_config_def)
     { assume "\<not> final e'"
       from Progress[OF wf wf_config' D' this] nored have False
         by simp }
     hence "final e'" by fast
     with wte' show ?thesis by(auto simp:final_def)
   next
     case NT
     with type_conf have wte':"P,E,hp s' \<turnstile> e' : T" by simp
     with sconf' have wf_config':"P,E,s' \<turnstile> e' : T \<surd>" by(simp add:wf_config_def)
     { assume "\<not> final e'"
       from Progress[OF wf wf_config' D' this] nored have False
         by simp }
     hence "final e'" by fast
     with wte' show ?thesis by(auto simp:final_def)
   next
     case (Class C)
     with type_conf have wte':"P,E,hp s' \<turnstile> e' : T \<or> P,E,hp s' \<turnstile> e' : NT" by simp
     thus ?thesis
     proof(rule disjE)
       assume wte':"P,E,hp s' \<turnstile> e' : T"
       with sconf' have wf_config':"P,E,s' \<turnstile> e' : T \<surd>" by(simp add:wf_config_def)
       { assume "\<not> final e'"
         from Progress[OF wf wf_config' D' this] nored have False
           by simp }
       hence "final e'" by fast
       with wte' show ?thesis by(auto simp:final_def)
     next
       assume wte':"P,E,hp s' \<turnstile> e' : NT"
       with sconf' have wf_config':"P,E,s' \<turnstile> e' : NT \<surd>" by(simp add:wf_config_def)
       { assume "\<not> final e'"
         from Progress[OF wf wf_config' D' this] nored have False
           by simp }
       hence "final e'" by fast
       with wte' Class show ?thesis by(auto simp:final_def)
     qed
   qed
 qed
 
-
-
 end
diff --git a/thys/Featherweight_OCL/examples/Employee_Model/Analysis/Analysis_UML.thy b/thys/Featherweight_OCL/examples/Employee_Model/Analysis/Analysis_UML.thy
--- a/thys/Featherweight_OCL/examples/Employee_Model/Analysis/Analysis_UML.thy
+++ b/thys/Featherweight_OCL/examples/Employee_Model/Analysis/Analysis_UML.thy
@@ -1,1384 +1,1384 @@
 (*****************************************************************************
  * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
  *                       for the OMG Standard.
  *                       http://www.brucker.ch/projects/hol-testgen/
  *
  * Analysis_UML.thy --- OCL Contracts and an Example.
  * This file is part of HOL-TestGen.
  *
  * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
  *               2013-2015 IRT SystemX, France
  *
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions are
  * met:
  *
  *     * Redistributions of source code must retain the above copyright
  *       notice, this list of conditions and the following disclaimer.
  *
  *     * Redistributions in binary form must reproduce the above
  *       copyright notice, this list of conditions and the following
  *       disclaimer in the documentation and/or other materials provided
  *       with the distribution.
  *
  *     * Neither the name of the copyright holders nor the names of its
  *       contributors may be used to endorse or promote products derived
  *       from this software without specific prior written permission.
  *
  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
 chapter\<open>Example: The Employee Analysis Model\<close> (* UML part *)
 
 theory
   Analysis_UML
 imports
   "../../../UML_Main"
 begin
 
 text \<open>\label{ex:employee-analysis:uml}\<close>
 
 section\<open>Introduction\<close>
 text\<open>
   For certain concepts like classes and class-types, only a generic
   definition for its resulting semantics can be given. Generic means,
   there is a function outside HOL that ``compiles'' a concrete,
   closed-world class diagram into a ``theory'' of this data model,
   consisting of a bunch of definitions for classes, accessors, method,
   casts, and tests for actual types, as well as proofs for the
   fundamental properties of these operations in this concrete data
   model.\<close>
 
 text\<open>Such generic function or ``compiler'' can be implemented in
   Isabelle on the ML level.  This has been done, for a semantics
   following the open-world assumption, for UML 2.0
   in~\<^cite>\<open>"brucker.ea:extensible:2008-b" and "brucker:interactive:2007"\<close>. In
   this paper, we follow another approach for UML 2.4: we define the
   concepts of the compilation informally, and present a concrete
   example which is verified in Isabelle/HOL.\<close>
 
 subsection\<open>Outlining the Example\<close>
 
 text\<open>We are presenting here an ``analysis-model'' of the (slightly
 modified) example Figure 7.3, page 20 of
 the OCL standard~\<^cite>\<open>"omg:ocl:2012"\<close>.
 Here, analysis model means that associations
 were really represented as relation on objects on the state---as is
 intended by the standard---rather by pointers between objects as is
 done in our ``design model'' 
 \isatagafp
 (see \autoref{ex:employee-design:uml}).
 \endisatagafp
 \isatagannexa
 (see \url{http://isa-afp.org/entries/Featherweight_OCL.shtml}).
 \endisatagannexa
 To be precise, this theory contains the formalization of the data-part
 covered by the UML class model (see \autoref{fig:person-ana}):\<close>
 
 text\<open>
 \begin{figure}
   \centering\scalebox{.3}{\includegraphics{figures/person.png}}%
   \caption{A simple UML class model drawn from Figure 7.3,
   page 20 of~\<^cite>\<open>"omg:ocl:2012"\<close>. \label{fig:person-ana}}
 \end{figure}
 \<close>
 
 text\<open>This means that the association (attached to the association class
 \inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
 by the attribute  \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
 captured by the subsequent theory).
 \<close>
 
 section\<open>Example Data-Universe and its Infrastructure\<close>
 text\<open>Ideally, the following is generated automatically from a UML class model.\<close>
 
 text\<open>Our data universe  consists in the concrete class diagram just of node's,
 and implicitly of the class object. Each class implies the existence of a class
 type defined for the corresponding object representations as follows:\<close>
 
 datatype type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid          (* the oid to the person itself *)
                             "int option" (* the attribute "salary" or null *)
 
 
 datatype type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid          (* the oid to the oclany itself *)
                             "(int option) option"
                                          (* the extensions to "person"; used to denote
                                             objects of actual type "person" casted to "oclany";
                                             in case of existence of several subclasses
                                             of oclany, sums of extensions have to be provided. *)
 
 text\<open>Now, we construct a concrete ``universe of OclAny types'' by injection into a
 sum type containing the class types. This type of OclAny will be used as instance
 for all respective type-variables.\<close>
 
 datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y
 
 text\<open>Having fixed the object universe, we can introduce type synonyms that exactly correspond
 to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
 one-to-one correspondance of OCL-types to types of the meta-language HOL.\<close>
 type_synonym Boolean     = " \<AA> Boolean"
 type_synonym Integer     = " \<AA> Integer"
 type_synonym Void        = " \<AA> Void"
 type_synonym OclAny      = "(\<AA>, type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option option) val"
 type_synonym Person      = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) val"
 type_synonym Set_Integer = "(\<AA>, int option option) Set"
 type_synonym Set_Person  = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) Set"
 
 text\<open>Just a little check:\<close>
 typ "Boolean"
 
 text\<open>To reuse key-elements of the library like referential equality, we have
 to show that the object universe belongs to the type class ``oclany,'' \ie,
  each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.\<close>
 instantiation type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object
 begin
    definition oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def: "oid_of x = (case x of mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ \<Rightarrow> oid)"
    instance ..
 end
 
 instantiation type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object
 begin
    definition oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def: "oid_of x = (case x of mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid _ \<Rightarrow> oid)"
    instance ..
 end
 
 instantiation \<AA> :: object
 begin
    definition oid_of_\<AA>_def: "oid_of x = (case x of
                                              in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person \<Rightarrow> oid_of person
                                            | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oclany \<Rightarrow> oid_of oclany)"
    instance ..
 end
 
 
 
 
 section\<open>Instantiation of the Generic Strict Equality\<close>
 text\<open>We instantiate the referential equality
 on \<open>Person\<close> and \<open>OclAny\<close>\<close>
 
 overloading StrictRefEq \<equiv> "StrictRefEq :: [Person,Person] \<Rightarrow> Boolean"
 begin
   definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n   : "(x::Person) \<doteq> y  \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y"
 end
 
 overloading StrictRefEq \<equiv> "StrictRefEq :: [OclAny,OclAny] \<Rightarrow> Boolean"
 begin
   definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y   : "(x::OclAny) \<doteq> y  \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y"
 end
 
 lemmas cps23 = 
     cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[of "x::Person" "y::Person" "\<tau>",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     cp_intro(9)         [of "P::Person \<Rightarrow>Person""Q::Person \<Rightarrow>Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric] ]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def      [of "x::Person" "y::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_defargs  [of _ "x::Person" "y::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict1
                         [of "x::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict2
                         [of "x::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
   for x y \<tau> P Q
 text\<open>For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
    a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
    \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
 \<close>
 text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have
 two operations to declare and to provide two overloading definitions for the two static types.
 \<close>
 
 
 section\<open>OclAsType\<close>
 subsection\<open>Definition\<close>
 
 consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> OclAny" ("(_) .oclAsType'(OclAny')")
 consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Person" ("(_) .oclAsType'(Person')")
 
 definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda>u. \<lfloor>case u of in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y a \<Rightarrow> a
                                              | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a) \<Rightarrow> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>\<rfloor>)"
 
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some: "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x \<noteq> None"
 by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
 
 overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> OclAny"
 begin
   definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclAsType(OclAny) \<equiv> X"
 end
 
 overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> OclAny"
 begin
   definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclAsType(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a \<rfloor>\<rfloor> \<Rightarrow>  \<lfloor>\<lfloor>  (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>) \<rfloor>\<rfloor>)"
 end
 
 definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = 
                    (\<lambda>u. case u of in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n p \<Rightarrow> \<lfloor>p\<rfloor>
                             | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>) \<Rightarrow> \<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a\<rfloor>
                             | _ \<Rightarrow> None)"
 
 overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Person"
 begin
   definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclAsType(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow>  invalid \<tau>   \<comment> \<open>down-cast exception\<close>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor> \<rfloor>\<rfloor> \<Rightarrow>  \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a\<rfloor>\<rfloor>)"
 end
 
 overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Person"
 begin
   definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclAsType(Person) \<equiv> X "  (* to avoid identity for null ? *)
 end
 
 text_raw\<open>\isatagafp\<close>
 
 lemmas [simp] =
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 
 text_raw\<open>\endisatagafp\<close>
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
       by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
       by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
       by(rule ext, simp add: bot_option_def invalid_def  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
       by(rule ext, simp add: null_fun_def null_option_def bot_option_def  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid"  by(simp)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)
 
 section\<open>OclIsTypeOf\<close>
 
 subsection\<open>Definition\<close>
 
 consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(OclAny')")
 consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(Person')")
 
 overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclIsTypeOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>  \<comment> \<open>invalid ??\<close>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)"
 end
 
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny':
          "(X::OclAny) .oclIsTypeOf(OclAny) = 
                     (\<lambda> \<tau>. if \<tau> \<Turnstile> \<upsilon> X then (case X \<tau> of
                                               \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>  \<comment> \<open>invalid ??\<close>
                                            | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>
                                            | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)
                                            else invalid \<tau>)"
        apply(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
        by(case_tac "\<tau> \<Turnstile> \<upsilon> X", auto simp: foundation18' bot_option_def)
 
 interpretation OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : 
        profile_mono_schemeV 
        "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::OclAny \<Rightarrow> Boolean" 
        "\<lambda> X. (case X of
                     \<lfloor>None\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor>  \<comment> \<open>invalid ??\<close>
                   | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid None \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor>
                   | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>)"                     
       apply(unfold_locales, simp add: atomize_eq, rule ext)
       by(auto simp:  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny' OclValid_def true_def false_def 
               split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split)
 
 overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclIsTypeOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>    \<comment> \<open>invalid ??\<close>
                             | \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)  \<comment> \<open>must have actual type \<open>Person\<close> otherwise\<close>"
 end
 
 overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclIsTypeOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclIsTypeOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)" (* for (* \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Node otherwise  *)
 end
 text_raw\<open>\isatagafp\<close>
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 text_raw\<open>\endisatagafp\<close>
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp]:
      "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp]:
      "(null::OclAny) .oclIsTypeOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp]:
      "(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp]:
      "(null::Person) .oclIsTypeOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]:
      "(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]:
      "(null::OclAny) .oclIsTypeOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]:
      "(invalid::Person) .oclIsTypeOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]:
      "(null::Person) .oclIsTypeOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 subsection\<open>Up Down Casting\<close>
 
 lemma actualType_larger_staticType:
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows          "\<tau> \<Turnstile> (X::Person) .oclIsTypeOf(OclAny) \<triangleq> false"
 using isdef
 by(auto simp : null_option_def bot_option_def
                OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16)
 
 lemma down_cast_type:
 assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid"
 using isOclAny non_null
 apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                   OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
            split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny  OclValid_def false_def true_def)
 
 lemma down_cast_type':
 assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> not (\<upsilon> (X .oclAsType(Person)))"
 by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])
 
 lemma up_down_cast :
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows "\<tau> \<Turnstile> ((X::Person) .oclAsType(OclAny) .oclAsType(Person) \<triangleq> X)"
 using isdef
 by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
                OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
         split: option.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 
 
 lemma up_down_cast_Person_OclAny_Person [simp]:
 shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
  apply(rule ext, rename_tac \<tau>)
  apply(rule foundation22[THEN iffD1])
  apply(case_tac "\<tau> \<Turnstile> (\<delta> X)", simp add: up_down_cast)
  apply(simp add: defined_split, elim disjE)
  apply(erule StrongEq_L_subst2_rev, simp, simp)+
 done
 
 lemma up_down_cast_Person_OclAny_Person':
 assumes "\<tau> \<Turnstile> \<upsilon> X"
 shows   "\<tau> \<Turnstile> (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)"
  apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 by(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym, simp add: assms)
 
 lemma up_down_cast_Person_OclAny_Person'': 
 assumes "\<tau> \<Turnstile> \<upsilon> (X :: Person)"
 shows   "\<tau> \<Turnstile> (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)"
  apply(simp add: OclValid_def)
  apply(subst cp_OclImplies)
  apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym[OF assms, simplified OclValid_def])
  apply(subst cp_OclImplies[symmetric])
 by simp
 
 
 section\<open>OclIsKindOf\<close>
 subsection\<open>Definition\<close>
 
 consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(OclAny')")
 consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(Person')")
 
 overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclIsKindOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclIsKindOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _\<Rightarrow> true \<tau>)"
 (* for (* \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n e oid _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) :  must have actual type Person otherwise  *)
 end
 
 overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclIsKindOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclIsKindOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)"
 end
 text_raw\<open>\isatagafp\<close>
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 text_raw\<open>\endisatagafp\<close>
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
 by(rule ext, simp add: invalid_def bot_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
 by(rule ext, simp add: bot_option_def invalid_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 subsection\<open>Up Down Casting\<close>
 
 lemma actualKind_larger_staticKind:
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows          "\<tau> \<Turnstile>  ((X::Person) .oclIsKindOf(OclAny) \<triangleq> true)"
 using isdef
 by(auto simp : bot_option_def
                OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16)
 
 lemma down_cast_kind:
 assumes isOclAny: "\<not> (\<tau> \<Turnstile> ((X::OclAny).oclIsKindOf(Person)))"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> ((X .oclAsType(Person)) \<triangleq> invalid)"
 using isOclAny non_null
 apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                   OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
            split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny  OclValid_def false_def true_def)
 
 section\<open>OclAllInstances\<close>
 
 text\<open>To denote OCL-types occurring in OCL expressions syntactically---as, for example,  as
 ``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
 functions into the object universes; we show that this is sufficient ``characterization.''\<close>
 
 definition "Person \<equiv> OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>"
 definition "OclAny \<equiv> OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>"
 lemmas [simp] = Person_def OclAny_def
 
 lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAllInstances_generic pre_post OclAny =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (pre_post \<tau>)) \<rfloor>\<rfloor>)"
 proof -
  let ?S1 = "\<lambda>\<tau>. OclAny ` ran (heap (pre_post \<tau>))"
  let ?S2 = "\<lambda>\<tau>. ?S1 \<tau> - {None}"
  have B : "\<And>\<tau>. ?S2 \<tau> \<subseteq> ?S1 \<tau>" by auto
  have C : "\<And>\<tau>. ?S1 \<tau> \<subseteq> ?S2 \<tau>" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some)
 
  show ?thesis by(insert equalityI[OF B C], simp)
 qed
 
 lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances() =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (snd \<tau>)) \<rfloor>\<rfloor>)"
 unfolding OclAllInstances_at_post_def
 by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec)
 
 lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances@pre() =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (fst \<tau>)) \<rfloor>\<rfloor>) "
 unfolding OclAllInstances_at_pre_def
 by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec)
 
 subsection\<open>OclIsTypeOf\<close>
 
 lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 assumes [simp]: "\<And>x. pre_post (x, x) = x"
 shows "\<exists>\<tau>. (\<tau> \<Turnstile>     ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
  apply(rule_tac x = \<tau>\<^sub>0 in exI, simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: assms UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 
 lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 "\<exists>\<tau>. (\<tau> \<Turnstile>     (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp)
 
 lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 "\<exists>\<tau>. (\<tau> \<Turnstile>     (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp)
 
 lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 assumes [simp]: "\<And>x. pre_post (x, x) = x"
 shows "\<exists>\<tau>. (\<tau> \<Turnstile> not ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 proof - fix oid a let ?t0 = "\<lparr>heap = Map.empty(oid \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>)),
                               assocs = Map.empty\<rparr>" show ?thesis
  apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
  by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclNot_def OclAny_def)
 qed
 
 lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 "\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp)
 
 lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 "\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp)
 
 lemma Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemma Person_allInstances_at_post_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 lemma Person_allInstances_at_pre_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 subsection\<open>OclIsKindOf\<close>
 lemma OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 
 lemma OclAny_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma OclAny_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 
 lemma Person_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemma Person_allInstances_at_post_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 section\<open>The Accessors (any, boss, salary)\<close>
 text\<open>\label{sec:eam-accessors}\<close>
 text\<open>Should be generated entirely from a class-diagram.\<close>
 
 
 subsection\<open>Definition (of the association Employee-Boss)\<close>
 
 text\<open>We start with a oid for the association; this oid can be used
 in presence of association classes to represent the association inside an object,
 pretty much similar to the \inlineisar+Design_UML+, where we stored
 an \verb+oid+ inside the class as ``pointer.''\<close>
 
 definition oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> ::"oid" where "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> = 10"
 
 text\<open>From there on, we can already define an empty state which must contain
 for $\mathit{oid}_{Person}\mathcal{BOSS}$ the empty relation (encoded as association list, since there are
 associations with a Sequence-like structure).\<close>
 
 
 definition eval_extract :: "('\<AA>,('a::object) option option) val
                             \<Rightarrow> (oid \<Rightarrow> ('\<AA>,'c::null) val)
                             \<Rightarrow> ('\<AA>,'c::null) val"
 where "eval_extract X f = (\<lambda> \<tau>. case X \<tau> of
                                     \<bottom> \<Rightarrow> invalid \<tau>   \<comment> \<open>exception propagation\<close>
                                | \<lfloor>  \<bottom> \<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>dereferencing null pointer\<close>
                                | \<lfloor>\<lfloor> obj \<rfloor>\<rfloor> \<Rightarrow> f (oid_of obj) \<tau>)"
 
 definition "choose\<^sub>2_1 = fst"
 definition "choose\<^sub>2_2 = snd"
 
 definition "List_flatten = (\<lambda>l. (foldl ((\<lambda>acc. (\<lambda>l. (foldl ((\<lambda>acc. (\<lambda>l. (Cons (l) (acc))))) (acc) ((rev (l))))))) (Nil) ((rev (l)))))"
 definition "deref_assocs\<^sub>2" :: "('\<AA> state \<times> '\<AA> state \<Rightarrow> '\<AA> state)
                               \<Rightarrow> (oid list list \<Rightarrow> oid list \<times> oid list)
                               \<Rightarrow> oid
                               \<Rightarrow> (oid list \<Rightarrow> ('\<AA>,'f)val)
                               \<Rightarrow> oid
                               \<Rightarrow> ('\<AA>, 'f::null)val"
 where      "deref_assocs\<^sub>2 pre_post to_from assoc_oid f oid =
                  (\<lambda>\<tau>. case (assocs (pre_post \<tau>)) assoc_oid of
                       \<lfloor> S \<rfloor> \<Rightarrow> f (List_flatten (map (choose\<^sub>2_2 \<circ> to_from)
                                      (filter (\<lambda> p. List.member (choose\<^sub>2_1 (to_from p)) oid) S)))
                                  \<tau>
                      | _    \<Rightarrow> invalid \<tau>)"
 
 
 text\<open>The \<open>pre_post\<close>-parameter is configured with \<open>fst\<close> or
 \<open>snd\<close>, the \<open>to_from\<close>-parameter either with the identity @{term id} or
 the following combinator \<open>switch\<close>:\<close>
 definition "switch\<^sub>2_1 = (\<lambda>[x,y]\<Rightarrow> (x,y))"
 definition "switch\<^sub>2_2 = (\<lambda>[x,y]\<Rightarrow> (y,x))"
 definition "switch\<^sub>3_1 = (\<lambda>[x,y,z]\<Rightarrow> (x,y))"
 definition "switch\<^sub>3_2 = (\<lambda>[x,y,z]\<Rightarrow> (x,z))"
 definition "switch\<^sub>3_3 = (\<lambda>[x,y,z]\<Rightarrow> (y,x))"
 definition "switch\<^sub>3_4 = (\<lambda>[x,y,z]\<Rightarrow> (y,z))"
 definition "switch\<^sub>3_5 = (\<lambda>[x,y,z]\<Rightarrow> (z,x))"
 definition "switch\<^sub>3_6 = (\<lambda>[x,y,z]\<Rightarrow> (z,y))"
 
 definition deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state)
                              \<Rightarrow> (type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<Rightarrow> (\<AA>, 'c::null)val)
                              \<Rightarrow> oid
                              \<Rightarrow> (\<AA>, 'c::null)val"
 where "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of
                                               \<lfloor> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj \<rfloor> \<Rightarrow> f obj \<tau>
                                             | _              \<Rightarrow> invalid \<tau>)"
 
 
 
 definition deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state)
                              \<Rightarrow> (type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<Rightarrow> (\<AA>, 'c::null)val)
                              \<Rightarrow> oid
                              \<Rightarrow> (\<AA>, 'c::null)val"
 where "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of
                        \<lfloor> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj \<rfloor> \<Rightarrow> f obj \<tau>
                      | _       \<Rightarrow> invalid \<tau>)"
 
 text\<open>pointer undefined in state or not referencing a type conform object representation\<close>
 
 
 definition "select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> f = (\<lambda> X. case X of
                      (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<bottom>) \<Rightarrow> null
                    | (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<lfloor>any\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) any)"
 
 
 definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f = select_object mtSet UML_Set.OclIncluding UML_Set.OclANY (f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>))"
 
 
 definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> f = (\<lambda> X. case X of
                      (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<bottom>) \<Rightarrow> null
                    | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<lfloor>salary\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) salary)"
 
 
 definition "deref_assocs\<^sub>2\<B>\<O>\<S>\<S> fst_snd f = (\<lambda> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ \<Rightarrow>
               deref_assocs\<^sub>2 fst_snd switch\<^sub>2_1 oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f oid)"
 
 definition "in_pre_state = fst"
 definition "in_post_state = snd"
 
 definition "reconst_basetype = (\<lambda> convert x. convert x)"
 
 definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> :: "OclAny \<Rightarrow> _"  ("(1(_).any)" 50)
   where "(X).any = eval_extract X
                      (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_post_state
                        (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>
                          reconst_basetype))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> :: "Person \<Rightarrow> Person"  ("(1(_).boss)" 50)
   where "(X).boss = eval_extract X
                       (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state
                         (deref_assocs\<^sub>2\<B>\<O>\<S>\<S> in_post_state
                           (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>
                             (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state))))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> :: "Person \<Rightarrow> Integer"  ("(1(_).salary)" 50)
   where "(X).salary = eval_extract X
                         (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state
                           (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>
                             reconst_basetype))"
 
 definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre :: "OclAny \<Rightarrow> _"  ("(1(_).any@pre)" 50)
   where "(X).any@pre = eval_extract X
                          (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_pre_state
                            (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>
                              reconst_basetype))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre:: "Person \<Rightarrow> Person"  ("(1(_).boss@pre)" 50)
   where "(X).boss@pre = eval_extract X
                           (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state
                             (deref_assocs\<^sub>2\<B>\<O>\<S>\<S> in_pre_state
                               (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>
                                 (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state))))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre:: "Person \<Rightarrow> Integer"  ("(1(_).salary@pre)" 50)
   where "(X).salary@pre = eval_extract X
                             (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state
                               (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>
                                 reconst_basetype))"
 
 lemmas dot_accessor =
   dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_def
   dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_def
 
 subsection\<open>Context Passing\<close>
 
 lemmas [simp] = eval_extract_def
 
 lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>: "((X).any) \<tau> = ((\<lambda>_. X \<tau>).any) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>: "((X).boss) \<tau> = ((\<lambda>_. X \<tau>).boss) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>: "((X).salary) \<tau> = ((\<lambda>_. X \<tau>).salary) \<tau>" by (simp add: dot_accessor)
 
 lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre: "((X).any@pre) \<tau> = ((\<lambda>_. X \<tau>).any@pre) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre: "((X).boss@pre) \<tau> = ((\<lambda>_. X \<tau>).boss@pre) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre: "((X).salary@pre) \<tau> = ((\<lambda>_. X \<tau>).salary@pre) \<tau>" by (simp add: dot_accessor)
 
 lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_I [simp, intro!]=
        cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_nullstrict [simp]: "(null).any = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_strict [simp] : "(invalid).any = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_strict [simp] : "(invalid).any@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_nullstrict [simp]: "(null).boss = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_strict [simp] : "(invalid).boss = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_nullstrict [simp]: "(null).salary = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_strict [simp] : "(invalid).salary = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 subsection\<open>Representation in States\<close>
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono:"\<tau> \<Turnstile> \<delta>(X .boss) \<Longrightarrow> \<tau> \<Turnstile> \<delta>(X)"
   apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16')
   apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16')
 by(simp add: defined_split)
 
 lemma repr_boss:  
 assumes A : "\<tau> \<Turnstile> \<delta>(x .boss)"
 shows      "is_represented_in_state in_post_state (x .boss) Person \<tau>"
          apply(insert A[simplified foundation16]
                       A[THEN dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono, simplified foundation16])
          unfolding is_represented_in_state_def
                    dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def eval_extract_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def in_post_state_def
          oops
 
 lemma repr_bossX : 
 assumes A: "\<tau> \<Turnstile> \<delta>(x .boss)"
 shows "\<tau> \<Turnstile> ((Person .allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x .boss))"
 oops
 
 section\<open>A Little Infra-structure on Example States\<close>
 
 text\<open>
 The example we are defining in this section comes from the figure~\ref{fig:eam1_system-states}.
 \begin{figure}
 \includegraphics[width=\textwidth]{figures/pre-post.pdf}
 \caption{(a) pre-state $\sigma_1$ and
   (b) post-state $\sigma_1'$.}
 \label{fig:eam1_system-states}
 \end{figure}
 \<close>
 
 text_raw\<open>\isatagafp\<close>
 
 definition OclInt1000 ("\<one>\<zero>\<zero>\<zero>") where "OclInt1000 = (\<lambda> _ . \<lfloor>\<lfloor>1000\<rfloor>\<rfloor>)"
 definition OclInt1200 ("\<one>\<two>\<zero>\<zero>") where "OclInt1200 = (\<lambda> _ . \<lfloor>\<lfloor>1200\<rfloor>\<rfloor>)"
 definition OclInt1300 ("\<one>\<three>\<zero>\<zero>") where "OclInt1300 = (\<lambda> _ . \<lfloor>\<lfloor>1300\<rfloor>\<rfloor>)"
 definition OclInt1800 ("\<one>\<eight>\<zero>\<zero>") where "OclInt1800 = (\<lambda> _ . \<lfloor>\<lfloor>1800\<rfloor>\<rfloor>)"
 definition OclInt2600 ("\<two>\<six>\<zero>\<zero>") where "OclInt2600 = (\<lambda> _ . \<lfloor>\<lfloor>2600\<rfloor>\<rfloor>)"
 definition OclInt2900 ("\<two>\<nine>\<zero>\<zero>") where "OclInt2900 = (\<lambda> _ . \<lfloor>\<lfloor>2900\<rfloor>\<rfloor>)"
 definition OclInt3200 ("\<three>\<two>\<zero>\<zero>") where "OclInt3200 = (\<lambda> _ . \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>)"
 definition OclInt3500 ("\<three>\<five>\<zero>\<zero>") where "OclInt3500 = (\<lambda> _ . \<lfloor>\<lfloor>3500\<rfloor>\<rfloor>)"
 
 definition "oid0 \<equiv> 0"
 definition "oid1 \<equiv> 1"
 definition "oid2 \<equiv> 2"
 definition "oid3 \<equiv> 3"
 definition "oid4 \<equiv> 4"
 definition "oid5 \<equiv> 5"
 definition "oid6 \<equiv> 6"
 definition "oid7 \<equiv> 7"
 definition "oid8 \<equiv> 8"
 
 definition "person1 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1300\<rfloor>"
 definition "person2 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1800\<rfloor>"
 definition "person3 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid2 None"
 definition "person4 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2900\<rfloor>"
 definition "person5 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid4 \<lfloor>3500\<rfloor>"
 definition "person6 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2500\<rfloor>"
 definition "person7 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid6 \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>"
 definition "person8 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid7 None"
 definition "person9 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid8 \<lfloor>0\<rfloor>"
 
 text_raw\<open>\endisatagafp\<close>
 
 definition
-      "\<sigma>\<^sub>1  \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor>))
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor>))
+      "\<sigma>\<^sub>1  \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor>),
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor>),
                            \<^cancel>\<open>oid2\<close>
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor>))
-                           (oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5)
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor>))
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor>),
+                           oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5,
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor>),
                            \<^cancel>\<open>oid6\<close>
                            \<^cancel>\<open>oid7\<close>
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
+                           oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
                assocs = Map.empty(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> \<mapsto> [[[oid0],[oid1]],[[oid3],[oid4]],[[oid5],[oid3]]]) \<rparr>"
 
 definition
-      "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2)
-                           (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3)
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4)
+      "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1,
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2,
+                           oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3,
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4,
                            \<^cancel>\<open>oid4\<close>
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6)
-                           (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7)
-                           (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8)
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6,
+                           oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7,
+                           oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8,
+                           oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
                assocs = Map.empty(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> \<mapsto> [[[oid0],[oid1]],[[oid1],[oid1]],[[oid5],[oid6]],[[oid6],[oid6]]]) \<rparr>"
 
 definition "\<sigma>\<^sub>0 \<equiv> \<lparr> heap = Map.empty, assocs = Map.empty \<rparr>"
 
 
 lemma basic_\<tau>_wff: "WFF(\<sigma>\<^sub>1,\<sigma>\<^sub>1')"
 by(auto simp: WFF_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
               oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
               oid_of_\<AA>_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def
               person1_def person2_def person3_def person4_def
               person5_def person6_def person7_def person8_def person9_def)
 
 lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1) = {oid0,oid1\<^cancel>\<open>,oid2\<close>,oid3,oid4,oid5\<^cancel>\<open>,oid6,oid7\<close>,oid8}"
 by(auto simp: \<sigma>\<^sub>1_def)
 
 lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1') = {oid0,oid1,oid2,oid3\<^cancel>\<open>,oid4\<close>,oid5,oid6,oid7,oid8}"
 by(auto simp: \<sigma>\<^sub>1'_def)
 
 text_raw\<open>\isatagafp\<close>
 
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person1 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person2 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person3 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person4 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person5 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person6 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person7 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person8 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person9 \<rfloor>\<rfloor>"
 
 lemma [code_unfold]: "((x::Person) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 lemma [code_unfold]: "((x::OclAny) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemmas [simp,code_unfold] =
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 
  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 
  OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 text_raw\<open>\endisatagafp\<close>
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary    <> \<one>\<zero>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary    \<doteq> \<one>\<three>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre     \<doteq> \<one>\<zero>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre     <> \<one>\<three>\<zero>\<zero>)"
 (*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss   <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .salary   \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary  \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre  \<doteq> \<one>\<two>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre  <> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre  \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre .boss@pre))"
 *)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def
              \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def person1_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>    ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def)
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>  not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>  not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"
 
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary       \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary@pre   \<doteq> \<one>\<two>\<zero>\<zero>)"
 (*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss      \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .salary@pre      \<doteq> \<one>\<two>\<zero>\<zero>)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .boss@pre      \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  <> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .boss))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .salary@pre))"
 *)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def person2_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary       \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary@pre))"
 (*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss       \<doteq> null)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss@pre))"
 *)lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclIsNew())"
 by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def person3_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 
 (*Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre   \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary@pre   \<doteq> \<three>\<five>\<zero>\<zero>)"
 *)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def person4_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary@pre   \<doteq> \<three>\<five>\<zero>\<zero>)"
 (*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss))"
 *)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclIsDeleted())"
 by(simp add: OclNot_def OclValid_def OclIsDeleted_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def person5_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary)   \<doteq> \<three>\<two>\<zero>\<zero> )"*)
 (*Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary@pre))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre   \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary   \<doteq> \<two>\<nine>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary@pre   \<doteq> \<two>\<six>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .boss@pre  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)"
 *)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def person6_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)   \<doteq>  (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss)))" *)
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss)   \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)) )" *)
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss .salary)   \<doteq> \<three>\<two>\<zero>\<zero> )" *)
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     \<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person))"
 (*Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.    (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss@pre))"
 *)
 lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .oclAsType(OclAny)
                                                                    .oclAsType(Person))
                                       \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)))"
 by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclValid_def valid_def person7_def)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>       (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclIsNew())"
 by(simp add: OclValid_def OclIsNew_def  \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def person7_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
              oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(Person)))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>   not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>   not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(OclAny))"
 
 lemma \<sigma>_modifiedonly: "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny)
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close>
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close>
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close>
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close>
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}->oclIsModifiedOnly())"
  apply(simp add: OclIsModifiedOnly_def OclValid_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                  person1_def person2_def person3_def person4_def
                  person5_def person6_def person7_def person8_def person9_def
                  image_def)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
  apply(simp add: oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def, clarsimp)
  apply(simp add: \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
 done
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>))  \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)"
 by(simp add: OclSelf_at_pre_def \<sigma>\<^sub>1_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @post (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>))  \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)"
 by(simp add: OclSelf_at_post_def \<sigma>\<^sub>1'_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)) \<triangleq>
                    ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @post (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)))"
 proof -
 
  have including4 : "\<And>a b c d \<tau>.
         Set{\<lambda>\<tau>. \<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>"
   apply(subst abs_rep_simp'[symmetric], simp)
   apply(simp add: OclIncluding_rep_set mtSet_rep_set)
   by(rule arg_cong[of _ _ "\<lambda>x. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(\<lfloor>\<lfloor> x \<rfloor>\<rfloor>))"], auto)
 
  have excluding1: "\<And>S a b c d e \<tau>.
                    (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>)->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. \<lfloor>\<lfloor>e\<rfloor>\<rfloor>) \<tau> =
                    Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} - {\<lfloor>\<lfloor>e\<rfloor>\<rfloor>} \<rfloor>\<rfloor>"
   apply(simp add: UML_Set.OclExcluding_def)
   apply(simp add: defined_def OclValid_def false_def true_def
                   bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)
   apply(rule conjI)
    apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def)+
   apply(rule conjI)
    apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def null_option_def)+
   apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def, simp)
  done
 
  show ?thesis
   apply(rule framing[where X = "Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny)
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close>
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close>
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close>
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close>
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}"])
    apply(cut_tac \<sigma>_modifiedonly)
    apply(simp only: OclValid_def
                     X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                     X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                     person1_def person2_def person3_def person4_def
                     person5_def person6_def person7_def person8_def person9_def
                     OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
    apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
      subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)
 
   apply(simp only: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                    X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                    person1_def person2_def person3_def person4_def
                    person5_def person6_def person7_def person8_def person9_def)
   apply(simp add: OclIncluding_rep_set mtSet_rep_set
                   oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
   apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def OclNot_def OclValid_def
                   null_option_def bot_option_def)
  done
 qed
 
 lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = \<lparr> heap = Map.empty
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9)
-                           (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8)
-                           (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7)
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6)
+                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9,
+                           oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8,
+                           oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7,
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6,
                            \<^cancel>\<open>oid4\<close>
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4)
-                           (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3)
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2)
-                           (oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4,
+                           oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3,
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2,
+                           oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
                        , assocs = assocs \<sigma>\<^sub>1' \<rparr>"
 proof -
  note P = fun_upd_twist
  show ?thesis
   apply(simp add: \<sigma>\<^sub>1'_def
                   oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
   apply(subst (1) P, simp)
   apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  by(simp)
 qed
 
 declare const_ss [simp]
 
 lemma "\<And>\<sigma>\<^sub>1.
  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Person .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6,
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)\<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 })"
  apply(subst perm_\<sigma>\<^sub>1')
  apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                   person7_def)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
   apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
    apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
     apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
      apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
        apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def
                                                                              person8_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp)
        apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
         apply(rule state_update_vs_allInstances_at_post_empty)
 by(simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "\<And>\<sigma>\<^sub>1.
  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (OclAny .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny),
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                                            \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny),
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny) })"
  apply(subst perm_\<sigma>\<^sub>1')
  apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                   person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
          apply(rule state_update_vs_allInstances_at_post_empty)
 by(simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
 
 end
diff --git a/thys/Featherweight_OCL/examples/Employee_Model/Design/Design_UML.thy b/thys/Featherweight_OCL/examples/Employee_Model/Design/Design_UML.thy
--- a/thys/Featherweight_OCL/examples/Employee_Model/Design/Design_UML.thy
+++ b/thys/Featherweight_OCL/examples/Employee_Model/Design/Design_UML.thy
@@ -1,1337 +1,1337 @@
 (*****************************************************************************
  * Featherweight-OCL --- A Formal Semantics for UML-OCL Version OCL 2.5
  *                       for the OMG Standard.
  *                       http://www.brucker.ch/projects/hol-testgen/
  *
  * Design_UML.thy --- OCL Contracts and an Example.
  * This file is part of HOL-TestGen.
  *
  * Copyright (c) 2012-2015 Université Paris-Saclay, Univ. Paris-Sud, France
  *               2013-2015 IRT SystemX, France
  *
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions are
  * met:
  *
  *     * Redistributions of source code must retain the above copyright
  *       notice, this list of conditions and the following disclaimer.
  *
  *     * Redistributions in binary form must reproduce the above
  *       copyright notice, this list of conditions and the following
  *       disclaimer in the documentation and/or other materials provided
  *       with the distribution.
  *
  *     * Neither the name of the copyright holders nor the names of its
  *       contributors may be used to endorse or promote products derived
  *       from this software without specific prior written permission.
  *
  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
 chapter\<open>Example: The Employee Design Model\<close> (* UML part *)
 
 theory
   Design_UML
 imports
   "../../../UML_Main"
 begin
 
 text \<open>\label{ex:employee-design:uml}\<close>
 
 section\<open>Introduction\<close>
 text\<open>
   For certain concepts like classes and class-types, only a generic
   definition for its resulting semantics can be given. Generic means,
   there is a function outside HOL that ``compiles'' a concrete,
   closed-world class diagram into a ``theory'' of this data model,
   consisting of a bunch of definitions for classes, accessors, method,
   casts, and tests for actual types, as well as proofs for the
   fundamental properties of these operations in this concrete data
   model.\<close>
 
 text\<open>Such generic function or ``compiler'' can be implemented in
   Isabelle on the ML level.  This has been done, for a semantics
   following the open-world assumption, for UML 2.0
   in~\<^cite>\<open>"brucker.ea:extensible:2008-b" and "brucker:interactive:2007"\<close>. In
   this paper, we follow another approach for UML 2.4: we define the
   concepts of the compilation informally, and present a concrete
   example which is verified in Isabelle/HOL.\<close>
 
 subsection\<open>Outlining the Example\<close>
 
 text\<open>We are presenting here a ``design-model'' of the (slightly
 modified) example Figure 7.3, page 20 of
 the OCL standard~\<^cite>\<open>"omg:ocl:2012"\<close>. To be precise, this theory contains the formalization of
 the data-part covered by the UML class model (see \autoref{fig:person}):\<close>
 
 text\<open>
 \begin{figure}
   \centering\scalebox{.3}{\includegraphics{figures/person.png}}%
   \caption{A simple UML class model drawn from Figure 7.3,
   page 20 of~\<^cite>\<open>"omg:ocl:2012"\<close>. \label{fig:person}}
 \end{figure}
 \<close>
 
 text\<open>This means that the association (attached to the association class
 \inlineocl{EmployeeRanking}) with the association ends \inlineocl+boss+ and \inlineocl+employees+ is implemented
 by the attribute  \inlineocl+boss+ and the operation \inlineocl+employees+ (to be discussed in the OCL part
 captured by the subsequent theory).
 \<close>
 
 section\<open>Example Data-Universe and its Infrastructure\<close>
 text\<open>Ideally, the following is generated automatically from a UML class model.\<close>
 
 text\<open>Our data universe  consists in the concrete class diagram just of node's,
 and implicitly of the class object. Each class implies the existence of a class
 type defined for the corresponding object representations as follows:\<close>
 
 datatype type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid          (* the oid to the person itself *)
                             "int option" (* the attribute "salary" or null *)
                             "oid option" (* the attribute "boss" or null *)
 
 
 datatype type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid          (* the oid to the oclany itself *)
                             "(int option \<times> oid option) option"
                                          (* the extensions to "person"; used to denote
                                             objects of actual type "person" casted to "oclany";
                                             in case of existence of several subclasses
                                             of oclany, sums of extensions have to be provided. *)
 
 text\<open>Now, we construct a concrete ``universe of OclAny types'' by injection into a
 sum type containing the class types. This type of OclAny will be used as instance
 for all respective type-variables.\<close>
 
 datatype \<AA> = in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y
 
 text\<open>Having fixed the object universe, we can introduce type synonyms that exactly correspond
 to OCL types. Again, we exploit that our representation of OCL is a ``shallow embedding'' with a
 one-to-one correspondance of OCL-types to types of the meta-language HOL.\<close>
 type_synonym Boolean     = " \<AA> Boolean"
 type_synonym Integer     = " \<AA> Integer"
 type_synonym Void        = " \<AA> Void"
 type_synonym OclAny      = "(\<AA>, type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y option option) val"
 type_synonym Person      = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) val"
 type_synonym Set_Integer = "(\<AA>, int option option) Set"
 type_synonym Set_Person  = "(\<AA>, type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n option option) Set"
 
 text\<open>Just a little check:\<close>
 typ "Boolean"
 
 text\<open>To reuse key-elements of the library like referential equality, we have
 to show that the object universe belongs to the type class ``oclany,'' \ie,
  each class type has to provide a function @{term oid_of} yielding the object id (oid) of the object.\<close>
 instantiation type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: object
 begin
    definition oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def: "oid_of x = (case x of mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid _ _ \<Rightarrow> oid)"
    instance ..
 end
 
 instantiation type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: object
 begin
    definition oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def: "oid_of x = (case x of mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid _ \<Rightarrow> oid)"
    instance ..
 end
 
 instantiation \<AA> :: object
 begin
    definition oid_of_\<AA>_def: "oid_of x = (case x of
                                              in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person \<Rightarrow> oid_of person
                                            | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oclany \<Rightarrow> oid_of oclany)"
    instance ..
 end
 
 
 
 
 section\<open>Instantiation of the Generic Strict Equality\<close>
 text\<open>We instantiate the referential equality
 on \<open>Person\<close> and \<open>OclAny\<close>\<close>
 
 overloading StrictRefEq \<equiv> "StrictRefEq :: [Person,Person] \<Rightarrow> Boolean"
 begin
   definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n   : "(x::Person) \<doteq> y  \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y"
 end
 
 overloading StrictRefEq \<equiv> "StrictRefEq :: [OclAny,OclAny] \<Rightarrow> Boolean"
 begin
   definition StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y   : "(x::OclAny) \<doteq> y  \<equiv> StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y"
 end
 
 lemmas cps23 = 
     cp_StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t[of "x::Person" "y::Person" "\<tau>",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     cp_intro(9)         [of "P::Person \<Rightarrow>Person""Q::Person \<Rightarrow>Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric] ]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def      [of "x::Person" "y::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_defargs  [of _ "x::Person" "y::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict1
                         [of "x::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
     StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_strict2
                         [of "x::Person",
                          simplified StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n[symmetric]]
   for x y \<tau> P Q
 text\<open>For each Class \emph{C}, we will have a casting operation \inlineocl{.oclAsType($C$)},
    a test on the actual type \inlineocl{.oclIsTypeOf($C$)} as well as its relaxed form
    \inlineocl{.oclIsKindOf($C$)} (corresponding exactly to Java's \verb+instanceof+-operator.
 \<close>
 text\<open>Thus, since we have two class-types in our concrete class hierarchy, we have
 two operations to declare and to provide two overloading definitions for the two static types.
 \<close>
 
 
 section\<open>OclAsType\<close>
 subsection\<open>Definition\<close>
 
 consts OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> OclAny" ("(_) .oclAsType'(OclAny')")
 consts OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Person" ("(_) .oclAsType'(Person')")
 
 definition "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> = (\<lambda>u. \<lfloor>case u of in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y a \<Rightarrow> a
                                             | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b) \<Rightarrow> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>\<rfloor>)"
 
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some: "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x \<noteq> None"
 by(simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
 
 overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> OclAny"
 begin
   definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclAsType(OclAny) \<equiv> X"
 end
 
 overloading OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> OclAny"
 begin
   definition OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclAsType(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b \<rfloor>\<rfloor> \<Rightarrow>  \<lfloor>\<lfloor>  (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>) \<rfloor>\<rfloor>)"
 end
 
 definition "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> = 
                    (\<lambda>u. case u of in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n p \<Rightarrow> \<lfloor>p\<rfloor>
                             | in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor>) \<Rightarrow> \<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b\<rfloor>
                             | _ \<Rightarrow> None)"
 
 overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Person"
 begin
   definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclAsType(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> null \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow>  invalid \<tau>   \<comment> \<open>down-cast exception\<close>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>(a,b)\<rfloor> \<rfloor>\<rfloor> \<Rightarrow>  \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid a b \<rfloor>\<rfloor>)"
 end
 
 overloading OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Person"
 begin
   definition OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclAsType(Person) \<equiv> X "  (* to avoid identity for null ? *)
 end
 text_raw\<open>\isatagafp\<close>
 
 lemmas [simp] =
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::Person) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::OclAny) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(OclAny))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::Person)::OclAny) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X. (P (X::OclAny)::Person) .oclAsType(Person))"
 by(rule cpI1, simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 
 text_raw\<open>\endisatagafp\<close>
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict : "(invalid::OclAny) .oclAsType(OclAny) = invalid" by(simp)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_nullstrict : "(null::OclAny) .oclAsType(OclAny) = null" by(simp)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict[simp] : "(invalid::Person) .oclAsType(OclAny) = invalid"
       by(rule ext, simp add: bot_option_def invalid_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_nullstrict[simp] : "(null::Person) .oclAsType(OclAny) = null"
       by(rule ext, simp add: null_fun_def null_option_def bot_option_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict[simp] : "(invalid::OclAny) .oclAsType(Person) = invalid"
       by(rule ext, simp add: bot_option_def invalid_def  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_nullstrict[simp] : "(null::OclAny) .oclAsType(Person) = null"
       by(rule ext, simp add: null_fun_def null_option_def bot_option_def  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict : "(invalid::Person) .oclAsType(Person) = invalid"  by(simp)
 lemma OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_nullstrict : "(null::Person) .oclAsType(Person) = null" by(simp)
 
 section\<open>OclIsTypeOf\<close>
 
 subsection\<open>Definition\<close>
 
 consts OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(OclAny')")
 consts OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsTypeOf'(Person')")
 
 overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclIsTypeOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>  \<comment> \<open>invalid ??\<close>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)"
 end
 
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny':
          "(X::OclAny) .oclIsTypeOf(OclAny) = 
                     (\<lambda> \<tau>. if \<tau> \<Turnstile> \<upsilon> X then (case X \<tau> of
                                               \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>  \<comment> \<open>invalid ??\<close>
                                            | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>
                                            | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)
                                            else invalid \<tau>)"
        apply(rule ext, simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
        by(case_tac "\<tau> \<Turnstile> \<upsilon> X", auto simp: foundation18' bot_option_def)
 
 interpretation OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny : 
        profile_mono_schemeV 
        "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y::OclAny \<Rightarrow> Boolean" 
        "\<lambda> X. (case X of
                     \<lfloor>None\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor>  \<comment> \<open>invalid ??\<close>
                   | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid None \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>True\<rfloor>\<rfloor>
                   | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> \<lfloor>\<lfloor>False\<rfloor>\<rfloor>)"                     
       apply(unfold_locales, simp add: atomize_eq, rule ext)
       by(auto simp:  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny' OclValid_def true_def false_def 
               split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split)
 
 overloading OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclIsTypeOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>    \<comment> \<open>invalid ??\<close>
                             | \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> false \<tau>)  \<comment> \<open>must have actual type \<open>Person\<close> otherwise\<close>"
 end
 
 overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclIsTypeOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclIsTypeOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)" (* for (* \<lfloor>\<lfloor> _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) : must have actual type Node otherwise  *)
 end
 text_raw\<open>\isatagafp\<close>
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsTypeOf(Person))"
 by(rule cpI1, simp_all add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 text_raw\<open>\endisatagafp\<close>
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp]:
      "(invalid::OclAny) .oclIsTypeOf(OclAny) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp]:
      "(null::OclAny) .oclIsTypeOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp]:
      "(invalid::Person) .oclIsTypeOf(OclAny) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp]:
      "(null::Person) .oclIsTypeOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]:
      "(invalid::OclAny) .oclIsTypeOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]:
      "(null::OclAny) .oclIsTypeOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]:
      "(invalid::Person) .oclIsTypeOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]:
      "(null::Person) .oclIsTypeOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 subsection\<open>Up Down Casting\<close>
 
 lemma actualType_larger_staticType:
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows          "\<tau> \<Turnstile> (X::Person) .oclIsTypeOf(OclAny) \<triangleq> false"
 using isdef
 by(auto simp : null_option_def bot_option_def
                OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16)
 
 lemma down_cast_type:
 assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> (X .oclAsType(Person)) \<triangleq> invalid"
 using isOclAny non_null
 apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                   OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
            split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny  OclValid_def false_def true_def)
 
 lemma down_cast_type':
 assumes isOclAny: "\<tau> \<Turnstile> (X::OclAny) .oclIsTypeOf(OclAny)"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> not (\<upsilon> (X .oclAsType(Person)))"
 by(rule foundation15[THEN iffD1], simp add: down_cast_type[OF assms])
 
 lemma up_down_cast :
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows "\<tau> \<Turnstile> ((X::Person) .oclAsType(OclAny) .oclAsType(Person) \<triangleq> X)"
 using isdef
 by(auto simp : null_fun_def null_option_def bot_option_def null_def invalid_def
                OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
         split: option.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 
 
 lemma up_down_cast_Person_OclAny_Person [simp]:
 shows "((X::Person) .oclAsType(OclAny) .oclAsType(Person) = X)"
  apply(rule ext, rename_tac \<tau>)
  apply(rule foundation22[THEN iffD1])
  apply(case_tac "\<tau> \<Turnstile> (\<delta> X)", simp add: up_down_cast)
  apply(simp add: defined_split, elim disjE)
  apply(erule StrongEq_L_subst2_rev, simp, simp)+
 done
 
 lemma up_down_cast_Person_OclAny_Person':
 assumes "\<tau> \<Turnstile> \<upsilon> X"
 shows   "\<tau> \<Turnstile> (((X :: Person) .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)"
  apply(simp only: up_down_cast_Person_OclAny_Person StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 by(rule StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym, simp add: assms)
 
 lemma up_down_cast_Person_OclAny_Person'': 
 assumes "\<tau> \<Turnstile> \<upsilon> (X :: Person)"
 shows   "\<tau> \<Turnstile> (X .oclIsTypeOf(Person) implies (X .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X)"
  apply(simp add: OclValid_def)
  apply(subst cp_OclImplies)
  apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_sym[OF assms, simplified OclValid_def])
  apply(subst cp_OclImplies[symmetric])
 by simp
 
 
 section\<open>OclIsKindOf\<close>
 subsection\<open>Definition\<close>
 
 consts OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(OclAny')")
 consts OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "'\<alpha> \<Rightarrow> Boolean" ("(_).oclIsKindOf'(Person')")
 
 overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny:
         "(X::OclAny) .oclIsKindOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<equiv> "OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: Person \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person:
         "(X::Person) .oclIsKindOf(OclAny) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _\<Rightarrow> true \<tau>)"
 (* for (* \<lfloor>\<lfloor>mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n e oid _ \<rfloor>\<rfloor> \<Rightarrow> true \<tau> *) :  must have actual type Person otherwise  *)
 end
 
 overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: OclAny \<Rightarrow> Boolean"
 begin
   definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny:
         "(X::OclAny) .oclIsKindOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom>   \<Rightarrow> invalid \<tau>
                             | \<lfloor>\<bottom>\<rfloor> \<Rightarrow> true \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<bottom> \<rfloor>\<rfloor> \<Rightarrow> false \<tau>
                             | \<lfloor>\<lfloor>mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>_\<rfloor> \<rfloor>\<rfloor> \<Rightarrow> true \<tau>)"
 end
 
 overloading OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<equiv> "OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: Person \<Rightarrow> Boolean"
 begin
  definition OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person:
         "(X::Person) .oclIsKindOf(Person) \<equiv>
                    (\<lambda>\<tau>. case X \<tau> of
                               \<bottom> \<Rightarrow> invalid \<tau>
                             | _ \<Rightarrow> true \<tau>)"
 end
 text_raw\<open>\isatagafp\<close>
 subsection\<open>Context Passing\<close>
 
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::Person).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::OclAny).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(OclAny))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::Person)::OclAny).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person: "cp P \<Longrightarrow> cp(\<lambda>X.(P(X::OclAny)::Person).oclIsKindOf(Person))"
 by(rule cpI1, simp_all add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemmas [simp] =
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_Person
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_OclAny
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_Person
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_OclAny
 
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_OclAny
  cp_OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_Person
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_OclAny
  cp_OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_Person
 text_raw\<open>\endisatagafp\<close>
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict1[simp] : "(invalid::OclAny) .oclIsKindOf(OclAny) = invalid"
 by(rule ext, simp add: invalid_def bot_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny_strict2[simp] : "(null::OclAny) .oclIsKindOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict1[simp] : "(invalid::Person) .oclIsKindOf(OclAny) = invalid"
 by(rule ext, simp add: bot_option_def invalid_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person_strict2[simp] : "(null::Person) .oclIsKindOf(OclAny) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def
                        OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict1[simp]: "(invalid::OclAny) .oclIsKindOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny_strict2[simp]: "(null::OclAny) .oclIsKindOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict1[simp]: "(invalid::Person) .oclIsKindOf(Person) = invalid"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 lemma OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person_strict2[simp]: "(null::Person) .oclIsKindOf(Person) = true"
 by(rule ext, simp add: null_fun_def null_option_def bot_option_def null_def invalid_def
                        OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 subsection\<open>Up Down Casting\<close>
 
 lemma actualKind_larger_staticKind:
 assumes isdef: "\<tau> \<Turnstile> (\<delta> X)"
 shows          "\<tau> \<Turnstile>  ((X::Person) .oclIsKindOf(OclAny) \<triangleq> true)"
 using isdef
 by(auto simp : bot_option_def
                OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person foundation22 foundation16)
 
 lemma down_cast_kind:
 assumes isOclAny: "\<not> (\<tau> \<Turnstile> ((X::OclAny).oclIsKindOf(Person)))"
 and     non_null: "\<tau> \<Turnstile> (\<delta> X)"
 shows             "\<tau> \<Turnstile> ((X .oclAsType(Person)) \<triangleq> invalid)"
 using isOclAny non_null
 apply(auto simp : bot_fun_def null_fun_def null_option_def bot_option_def null_def invalid_def
                   OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny foundation22 foundation16
            split: option.split type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y.split type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split)
 by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny  OclValid_def false_def true_def)
 
 section\<open>OclAllInstances\<close>
 
 text\<open>To denote OCL-types occurring in OCL expressions syntactically---as, for example,  as
 ``argument'' of \inlineisar{oclAllInstances()}---we use the inverses of the injection
 functions into the object universes; we show that this is sufficient ``characterization.''\<close>
 
 definition "Person \<equiv> OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>"
 definition "OclAny \<equiv> OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>"
 lemmas [simp] = Person_def OclAny_def
 
 lemma OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAllInstances_generic pre_post OclAny =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (pre_post \<tau>)) \<rfloor>\<rfloor>)"
 proof -
  let ?S1 = "\<lambda>\<tau>. OclAny ` ran (heap (pre_post \<tau>))"
  let ?S2 = "\<lambda>\<tau>. ?S1 \<tau> - {None}"
  have B : "\<And>\<tau>. ?S2 \<tau> \<subseteq> ?S1 \<tau>" by auto
  have C : "\<And>\<tau>. ?S1 \<tau> \<subseteq> ?S2 \<tau>" by(auto simp: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_some)
 
  show ?thesis by(insert equalityI[OF B C], simp)
 qed
 
 lemma OclAllInstances_at_post\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances() =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (snd \<tau>)) \<rfloor>\<rfloor>)"
 unfolding OclAllInstances_at_post_def
 by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec)
 
 lemma OclAllInstances_at_pre\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec: "OclAny .allInstances@pre() =
              (\<lambda>\<tau>.  Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e  \<lfloor>\<lfloor> Some ` OclAny ` ran (heap (fst \<tau>)) \<rfloor>\<rfloor>) "
 unfolding OclAllInstances_at_pre_def
 by(rule OclAllInstances_generic\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_exec)
 
 subsection\<open>OclIsTypeOf\<close>
 
 lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 assumes [simp]: "\<And>x. pre_post (x, x) = x"
 shows "\<exists>\<tau>. (\<tau> \<Turnstile>     ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
  apply(rule_tac x = \<tau>\<^sub>0 in exI, simp add: \<tau>\<^sub>0_def OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: assms UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 
 lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 "\<exists>\<tau>. (\<tau> \<Turnstile>     (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp)
 
 lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1:
 "\<exists>\<tau>. (\<tau> \<Turnstile>     (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y1, simp)
 
 lemma OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 assumes [simp]: "\<And>x. pre_post (x, x) = x"
 shows "\<exists>\<tau>. (\<tau> \<Turnstile> not ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 proof - fix oid a let ?t0 = "\<lparr>heap = Map.empty(oid \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid \<lfloor>a\<rfloor>)),
                               assocs = Map.empty\<rparr>" show ?thesis
  apply(rule_tac x = "(?t0, ?t0)" in exI, simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
  by(simp add: OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny OclNot_def OclAny_def)
 qed
 
 lemma OclAny_allInstances_at_post_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 "\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp)
 
 lemma OclAny_allInstances_at_pre_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2:
 "\<exists>\<tau>. (\<tau> \<Turnstile> not (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(OclAny))))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y2, simp)
 
 lemma Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemma Person_allInstances_at_post_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 lemma Person_allInstances_at_pre_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsTypeOf(Person)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 subsection\<open>OclIsKindOf\<close>
 lemma OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post OclAny)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny)
 
 lemma OclAny_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (OclAny .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_post_def
 by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma OclAny_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (OclAny .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_pre_def
 by(rule OclAny_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
 
 lemma Person_allInstances_at_post_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(OclAny)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemma Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> ((OclAllInstances_generic pre_post Person)->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
  apply(simp add: OclValid_def del: OclAllInstances_generic_def)
  apply(simp only: UML_Set.OclForall_def refl if_True
                   OclAllInstances_generic_defined[simplified OclValid_def])
  apply(simp only: OclAllInstances_generic_def)
  apply(subst (1 2 3) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def)
 by(simp add: OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person)
 
 lemma Person_allInstances_at_post_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
 unfolding OclAllInstances_at_post_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 lemma Person_allInstances_at_pre_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n:
 "\<tau> \<Turnstile> (Person .allInstances@pre()->forAll\<^sub>S\<^sub>e\<^sub>t(X|X .oclIsKindOf(Person)))"
 unfolding OclAllInstances_at_pre_def
 by(rule Person_allInstances_generic_oclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 
 section\<open>The Accessors (any, boss, salary)\<close>
 text\<open>\label{sec:edm-accessors}\<close>
 text\<open>Should be generated entirely from a class-diagram.\<close>
 
 
 subsection\<open>Definition\<close>
 
 definition eval_extract :: "('\<AA>,('a::object) option option) val
                             \<Rightarrow> (oid \<Rightarrow> ('\<AA>,'c::null) val)
                             \<Rightarrow> ('\<AA>,'c::null) val"
 where "eval_extract X f = (\<lambda> \<tau>. case X \<tau> of
                                     \<bottom> \<Rightarrow> invalid \<tau>   \<comment> \<open>exception propagation\<close>
                                | \<lfloor>  \<bottom> \<rfloor> \<Rightarrow> invalid \<tau> \<comment> \<open>dereferencing null pointer\<close>
                                | \<lfloor>\<lfloor> obj \<rfloor>\<rfloor> \<Rightarrow> f (oid_of obj) \<tau>)"
 
 
 definition deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state)
                              \<Rightarrow> (type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n \<Rightarrow> (\<AA>, 'c::null)val)
                              \<Rightarrow> oid
                              \<Rightarrow> (\<AA>, 'c::null)val"
 where "deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of
                                               \<lfloor> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n obj \<rfloor> \<Rightarrow> f obj \<tau>
                                             | _              \<Rightarrow> invalid \<tau>)"
 
 
 
 definition deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y :: "(\<AA> state \<times> \<AA> state \<Rightarrow> \<AA> state)
                              \<Rightarrow> (type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y \<Rightarrow> (\<AA>, 'c::null)val)
                              \<Rightarrow> oid
                              \<Rightarrow> (\<AA>, 'c::null)val"
 where "deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y fst_snd f oid = (\<lambda>\<tau>. case (heap (fst_snd \<tau>)) oid of
                        \<lfloor> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y obj \<rfloor> \<Rightarrow> f obj \<tau>
                      | _       \<Rightarrow> invalid \<tau>)"
 
 text\<open>pointer undefined in state or not referencing a type conform object representation\<close>
 
 
 definition "select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> f = (\<lambda> X. case X of
                      (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<bottom>) \<Rightarrow> null
                    | (mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y _ \<lfloor>any\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) any)"
 
 
 definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> f = (\<lambda> X. case X of
                      (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ _ \<bottom>) \<Rightarrow> null  \<comment> \<open>object contains null pointer\<close>
                    | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ _ \<lfloor>boss\<rfloor>) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) boss)"
 
 
 definition "select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> f = (\<lambda> X. case X of
                      (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<bottom> _) \<Rightarrow> null
                    | (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n _ \<lfloor>salary\<rfloor> _) \<Rightarrow> f (\<lambda>x _. \<lfloor>\<lfloor>x\<rfloor>\<rfloor>) salary)"
 
 
 definition "in_pre_state = fst"
 definition "in_post_state = snd"
 
 definition "reconst_basetype = (\<lambda> convert x. convert x)"
 
 definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y> :: "OclAny \<Rightarrow> _"  ("(1(_).any)" 50)
   where "(X).any = eval_extract X
                      (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_post_state
                        (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>
                          reconst_basetype))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S> :: "Person \<Rightarrow> Person"  ("(1(_).boss)" 50)
   where "(X).boss = eval_extract X
                       (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state
                         (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>
                           (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state)))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y> :: "Person \<Rightarrow> Integer"  ("(1(_).salary)" 50)
   where "(X).salary = eval_extract X
                         (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_post_state
                           (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>
                             reconst_basetype))"
 
 definition dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre :: "OclAny \<Rightarrow> _"  ("(1(_).any@pre)" 50)
   where "(X).any@pre = eval_extract X
                          (deref_oid\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y in_pre_state
                            (select\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>
                              reconst_basetype))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre:: "Person \<Rightarrow> Person"  ("(1(_).boss@pre)" 50)
   where "(X).boss@pre = eval_extract X
                           (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state
                             (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>
                               (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state)))"
 
 definition dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre:: "Person \<Rightarrow> Integer"  ("(1(_).salary@pre)" 50)
   where "(X).salary@pre = eval_extract X
                             (deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n in_pre_state
                               (select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>
                                 reconst_basetype))"
 
 lemmas dot_accessor =
   dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_def
   dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_def
   dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_def
 
 subsection\<open>Context Passing\<close>
 
 lemmas [simp] = eval_extract_def
 
 lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>: "((X).any) \<tau> = ((\<lambda>_. X \<tau>).any) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>: "((X).boss) \<tau> = ((\<lambda>_. X \<tau>).boss) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>: "((X).salary) \<tau> = ((\<lambda>_. X \<tau>).salary) \<tau>" by (simp add: dot_accessor)
 
 lemma cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre: "((X).any@pre) \<tau> = ((\<lambda>_. X \<tau>).any@pre) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre: "((X).boss@pre) \<tau> = ((\<lambda>_. X \<tau>).boss@pre) \<tau>" by (simp add: dot_accessor)
 lemma cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre: "((X).salary@pre) \<tau> = ((\<lambda>_. X \<tau>).salary@pre) \<tau>" by (simp add: dot_accessor)
 
 lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_I [simp, intro!]=
        cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 lemmas cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_I [simp, intro!]=
        cp_dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre[THEN allI[THEN allI],
                           of "\<lambda> X _. X" "\<lambda> _ \<tau>. \<tau>", THEN cpI1]
 
 subsection\<open>Execution with Invalid or Null as Argument\<close>
 
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_nullstrict [simp]: "(null).any = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_nullstrict [simp] : "(null).any@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_strict [simp] : "(invalid).any = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y\<A>\<N>\<Y>_at_pre_strict [simp] : "(invalid).any@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_nullstrict [simp]: "(null).boss = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_nullstrict [simp] : "(null).boss@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_strict [simp] : "(invalid).boss = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_at_pre_strict [simp] : "(invalid).boss@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_nullstrict [simp]: "(null).salary = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_nullstrict [simp] : "(null).salary@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_strict [simp] : "(invalid).salary = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<S>\<A>\<L>\<A>\<R>\<Y>_at_pre_strict [simp] : "(invalid).salary@pre = invalid"
 by(rule ext, simp add: dot_accessor null_fun_def null_option_def bot_option_def null_def invalid_def)
 
 subsection\<open>Representation in States\<close>
 
 lemma dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono:"\<tau> \<Turnstile> \<delta>(X .boss) \<Longrightarrow> \<tau> \<Turnstile> \<delta>(X)"
   apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> invalid)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "invalid"], simp add: foundation16')
   apply(case_tac "\<tau> \<Turnstile> (X \<triangleq> null)", insert StrongEq_L_subst2[where P = "(\<lambda>x. (\<delta> (x .boss)))" and \<tau> = "\<tau>" and x = "X" and y = "null"], simp add: foundation16')
 by(simp add: defined_split)
 
 lemma repr_boss:  
 assumes A : "\<tau> \<Turnstile> \<delta>(x .boss)"
 shows      "is_represented_in_state in_post_state (x .boss) Person \<tau>"
          apply(insert A[simplified foundation16]
                       A[THEN dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def_mono, simplified foundation16])
          unfolding is_represented_in_state_def
                    dot\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def eval_extract_def select\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<B>\<O>\<S>\<S>_def in_post_state_def
          by(auto simp: deref_oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def bot_fun_def bot_option_def null_option_def null_fun_def invalid_def
                        OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def image_def ran_def
                  split: type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n.split option.split \<AA>.split)
 
 lemma repr_bossX : 
 assumes A: "\<tau> \<Turnstile> \<delta>(x .boss)"
 shows "\<tau> \<Turnstile> ((Person .allInstances()) ->includes\<^sub>S\<^sub>e\<^sub>t(x .boss))"
 proof -
   have B : "\<And>S f. (x .boss) \<tau> \<in> (Some ` f ` S) \<Longrightarrow>
                   (x .boss) \<tau> \<in> (Some ` (f ` S - {None}))"
             apply(auto simp: image_def ran_def, metis)
   by(insert A[simplified foundation16], simp add: null_option_def bot_option_def)
   show ?thesis
          apply(insert repr_boss[OF A] OclAllInstances_at_post_defined[where H = Person and \<tau> = \<tau>])
          unfolding is_represented_in_state_def OclValid_def
                    OclAllInstances_at_post_def OclAllInstances_generic_def OclIncludes_def
                    in_post_state_def
          apply(simp add: A[THEN foundation20, simplified OclValid_def])
          apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp, metis bot_option_def option.distinct(1))
   by(simp add: image_comp B true_def)
 qed
 
 section\<open>A Little Infra-structure on Example States\<close>
 
 text\<open>
 The example we are defining in this section comes from the figure~\ref{fig:edm1_system-states}.
 \begin{figure}
 \includegraphics[width=\textwidth]{figures/pre-post.pdf}
 \caption{(a) pre-state $\sigma_1$ and
   (b) post-state $\sigma_1'$.}
 \label{fig:edm1_system-states}
 \end{figure}
 \<close>
 
 text_raw\<open>\isatagafp\<close>
 
 definition OclInt1000 ("\<one>\<zero>\<zero>\<zero>") where "OclInt1000 = (\<lambda> _ . \<lfloor>\<lfloor>1000\<rfloor>\<rfloor>)"
 definition OclInt1200 ("\<one>\<two>\<zero>\<zero>") where "OclInt1200 = (\<lambda> _ . \<lfloor>\<lfloor>1200\<rfloor>\<rfloor>)"
 definition OclInt1300 ("\<one>\<three>\<zero>\<zero>") where "OclInt1300 = (\<lambda> _ . \<lfloor>\<lfloor>1300\<rfloor>\<rfloor>)"
 definition OclInt1800 ("\<one>\<eight>\<zero>\<zero>") where "OclInt1800 = (\<lambda> _ . \<lfloor>\<lfloor>1800\<rfloor>\<rfloor>)"
 definition OclInt2600 ("\<two>\<six>\<zero>\<zero>") where "OclInt2600 = (\<lambda> _ . \<lfloor>\<lfloor>2600\<rfloor>\<rfloor>)"
 definition OclInt2900 ("\<two>\<nine>\<zero>\<zero>") where "OclInt2900 = (\<lambda> _ . \<lfloor>\<lfloor>2900\<rfloor>\<rfloor>)"
 definition OclInt3200 ("\<three>\<two>\<zero>\<zero>") where "OclInt3200 = (\<lambda> _ . \<lfloor>\<lfloor>3200\<rfloor>\<rfloor>)"
 definition OclInt3500 ("\<three>\<five>\<zero>\<zero>") where "OclInt3500 = (\<lambda> _ . \<lfloor>\<lfloor>3500\<rfloor>\<rfloor>)"
 
 definition "oid0 \<equiv> 0"
 definition "oid1 \<equiv> 1"
 definition "oid2 \<equiv> 2"
 definition "oid3 \<equiv> 3"
 definition "oid4 \<equiv> 4"
 definition "oid5 \<equiv> 5"
 definition "oid6 \<equiv> 6"
 definition "oid7 \<equiv> 7"
 definition "oid8 \<equiv> 8"
 
 definition "person1 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1300\<rfloor> \<lfloor>oid1\<rfloor>"
 definition "person2 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1800\<rfloor> \<lfloor>oid1\<rfloor>"
 definition "person3 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid2 None None"
 definition "person4 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2900\<rfloor> None"
 definition "person5 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid4 \<lfloor>3500\<rfloor> None"
 definition "person6 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2500\<rfloor> \<lfloor>oid6\<rfloor>"
 definition "person7 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid6 \<lfloor>(\<lfloor>3200\<rfloor>, \<lfloor>oid6\<rfloor>)\<rfloor>"
 definition "person8 \<equiv> mk\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y oid7 None"
 definition "person9 \<equiv> mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid8 \<lfloor>0\<rfloor> None"
 
 definition
-      "\<sigma>\<^sub>1  \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor> \<lfloor>oid1\<rfloor>))
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor>  None))
+      "\<sigma>\<^sub>1  \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid0 \<lfloor>1000\<rfloor> \<lfloor>oid1\<rfloor>),
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid1 \<lfloor>1200\<rfloor>  None),
                            \<^cancel>\<open>oid2\<close>
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor> \<lfloor>oid4\<rfloor>))
-                           (oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5)
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor> \<lfloor>oid3\<rfloor>))
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid3 \<lfloor>2600\<rfloor> \<lfloor>oid4\<rfloor>),
+                           oid4 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person5,
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n oid5 \<lfloor>2300\<rfloor> \<lfloor>oid3\<rfloor>),
                            \<^cancel>\<open>oid6\<close>
                            \<^cancel>\<open>oid7\<close>
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
+                           oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
                assocs = Map.empty \<rparr>"
 
 definition
-      "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2)
-                           (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3)
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4)
+      "\<sigma>\<^sub>1' \<equiv> \<lparr> heap = Map.empty(oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1,
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2,
+                           oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3,
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4,
                            \<^cancel>\<open>oid4\<close>
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6)
-                           (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7)
-                           (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8)
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6,
+                           oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7,
+                           oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8,
+                           oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9),
                assocs = Map.empty \<rparr>"
 
 definition "\<sigma>\<^sub>0 \<equiv> \<lparr> heap = Map.empty, assocs = Map.empty \<rparr>"
 
 
 lemma basic_\<tau>_wff: "WFF(\<sigma>\<^sub>1,\<sigma>\<^sub>1')"
 by(auto simp: WFF_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
               oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
               oid_of_\<AA>_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def
               person1_def person2_def person3_def person4_def
               person5_def person6_def person7_def person8_def person9_def)
 
 lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1) = {oid0,oid1\<^cancel>\<open>,oid2\<close>,oid3,oid4,oid5\<^cancel>\<open>,oid6,oid7\<close>,oid8}"
 by(auto simp: \<sigma>\<^sub>1_def)
 
 lemma [simp,code_unfold]: "dom (heap \<sigma>\<^sub>1') = {oid0,oid1,oid2,oid3\<^cancel>\<open>,oid4\<close>,oid5,oid6,oid7,oid8}"
 by(auto simp: \<sigma>\<^sub>1'_def)
 
 text_raw\<open>\isatagafp\<close>
 
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person1 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person2 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person3 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person4 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person5 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person6 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person7 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 :: OclAny \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person8 \<rfloor>\<rfloor>"
 definition "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 :: Person \<equiv> \<lambda> _ .\<lfloor>\<lfloor> person9 \<rfloor>\<rfloor>"
 
 lemma [code_unfold]: "((x::Person) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)
 lemma [code_unfold]: "((x::OclAny) \<doteq> y) = StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t x y" by(simp only: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y)
 
 lemmas [simp,code_unfold] =
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 
  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclIsTypeOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclIsTypeOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 
  OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_OclAny
  OclIsKindOf\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person
  OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_OclAny
  OclIsKindOf\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_Person
 text_raw\<open>\endisatagafp\<close>
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary    <> \<one>\<zero>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary    \<doteq> \<one>\<three>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre     \<doteq> \<one>\<zero>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .salary@pre     <> \<one>\<three>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss   <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .salary   \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss .boss  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary  \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre  \<doteq> \<one>\<two>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .salary@pre  <> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre  \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .boss@pre .boss@pre .boss@pre))"
 
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def
              \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def person1_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>    ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclAsType(Person)) \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1)"
 by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def)
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>  not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsTypeOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclIsKindOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>  not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny) .oclIsTypeOf(OclAny))"
 
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary       \<doteq> \<one>\<eight>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .salary@pre   \<doteq> \<one>\<two>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss      \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .salary@pre      \<doteq> \<one>\<two>\<zero>\<zero>)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss .boss@pre      \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre  <> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .boss))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .boss@pre .salary@pre))"
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def person2_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary       \<doteq> null)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .salary@pre))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss       \<doteq> null)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .boss@pre))"
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclIsNew())"
 by(simp add: OclValid_def OclIsNew_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def person3_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre   \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .boss@pre .salary@pre   \<doteq> \<three>\<five>\<zero>\<zero>)"
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def person4_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .salary@pre   \<doteq> \<three>\<five>\<zero>\<zero>)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .boss))"
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclIsDeleted())"
 by(simp add: OclNot_def OclValid_def OclIsDeleted_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def person5_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary)   \<doteq> \<three>\<two>\<zero>\<zero> )"*)
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e     .   (s\<^sub>p\<^sub>r\<^sub>e,\<sigma>\<^sub>1') \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss .salary@pre))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre   \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4)"
 Assert "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary   \<doteq> \<two>\<nine>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .salary@pre   \<doteq> \<two>\<six>\<zero>\<zero>)"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss@pre .boss@pre  \<doteq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5)"
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclIsMaintained())"
 by(simp add: OclValid_def OclIsMaintained_def \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def person6_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def
              oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def)
 
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)   \<doteq>  (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .boss)))" *)
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss)   \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)) )" *)
 (* (* access to an oclany object not yet supported *) Assert "  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss .salary)   \<doteq> \<three>\<two>\<zero>\<zero> )" *)
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     \<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person))"
 Assert "\<And>    s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.    (\<sigma>\<^sub>1,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .boss@pre))"
 lemma "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>     ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person) .oclAsType(OclAny)
                                                                    .oclAsType(Person))
                                       \<doteq> (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)))"
 by(rule up_down_cast_Person_OclAny_Person', simp add: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def OclValid_def valid_def person7_def)
 lemma "               (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile>       (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclIsNew())"
 by(simp add: OclValid_def OclIsNew_def  \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def person7_def
              oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid8_def
              oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def)
 
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8  <> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7)"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile> not(\<upsilon>(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(Person)))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(OclAny))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>   not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsTypeOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>   not(X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(Person))"
 Assert "\<And>s\<^sub>p\<^sub>r\<^sub>e s\<^sub>p\<^sub>o\<^sub>s\<^sub>t.   (s\<^sub>p\<^sub>r\<^sub>e,s\<^sub>p\<^sub>o\<^sub>s\<^sub>t) \<Turnstile>      (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclIsKindOf(OclAny))"
 
 lemma \<sigma>_modifiedonly: "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny)
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close>
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close>
                       , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny)
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close>
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close>
                       \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}->oclIsModifiedOnly())"
  apply(simp add: OclIsModifiedOnly_def OclValid_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                  X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                  person1_def person2_def person3_def person4_def
                  person5_def person6_def person7_def person8_def person9_def
                  image_def)
  apply(simp add: OclIncluding_rep_set mtSet_rep_set null_option_def bot_option_def)
  apply(simp add: oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def, clarsimp)
  apply(simp add: \<sigma>\<^sub>1_def \<sigma>\<^sub>1'_def
                  oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
 done
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>))  \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)"
 by(simp add: OclSelf_at_pre_def \<sigma>\<^sub>1_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 @post (\<lambda>x. \<lfloor>OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA> x\<rfloor>))  \<triangleq> X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9)"
 by(simp add: OclSelf_at_post_def \<sigma>\<^sub>1'_def oid_of_option_def oid_of_type\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_def
              X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def person9_def oid8_def OclValid_def StrongEq_def OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "(\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @pre (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)) \<triangleq>
                    ((X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)) @post (\<lambda>x. \<lfloor>OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA> x\<rfloor>)))"
 proof -
 
  have including4 : "\<And>a b c d \<tau>.
         Set{\<lambda>\<tau>. \<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lambda>\<tau>. \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<tau> = Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>"
   apply(subst abs_rep_simp'[symmetric], simp)
   apply(simp add: OclIncluding_rep_set mtSet_rep_set)
   by(rule arg_cong[of _ _ "\<lambda>x. (Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e(\<lfloor>\<lfloor> x \<rfloor>\<rfloor>))"], auto)
 
  have excluding1: "\<And>S a b c d e \<tau>.
                    (\<lambda>_. Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} \<rfloor>\<rfloor>)->excluding\<^sub>S\<^sub>e\<^sub>t(\<lambda>\<tau>. \<lfloor>\<lfloor>e\<rfloor>\<rfloor>) \<tau> =
                    Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e \<lfloor>\<lfloor> {\<lfloor>\<lfloor>a\<rfloor>\<rfloor>, \<lfloor>\<lfloor>b\<rfloor>\<rfloor>, \<lfloor>\<lfloor>c\<rfloor>\<rfloor>, \<lfloor>\<lfloor>d\<rfloor>\<rfloor>} - {\<lfloor>\<lfloor>e\<rfloor>\<rfloor>} \<rfloor>\<rfloor>"
   apply(simp add: UML_Set.OclExcluding_def)
   apply(simp add: defined_def OclValid_def false_def true_def
                   bot_fun_def bot_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def null_fun_def null_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_def)
   apply(rule conjI)
    apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def)+
   apply(rule conjI)
    apply(rule impI, subst (asm) Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inject) apply( simp add: bot_option_def null_option_def)+
   apply(subst Abs_Set\<^sub>b\<^sub>a\<^sub>s\<^sub>e_inverse, simp add: bot_option_def, simp)
  done
 
  show ?thesis
   apply(rule framing[where X = "Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny)
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny)\<close>
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5 .oclAsType(OclAny)\<close>
                        , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny)
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(OclAny)\<close>
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8 .oclAsType(OclAny)\<close>
                        \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny)\<close>}"])
    apply(cut_tac \<sigma>_modifiedonly)
    apply(simp only: OclValid_def
                     X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                     X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                     person1_def person2_def person3_def person4_def
                     person5_def person6_def person7_def person8_def person9_def
                     OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_Person)
    apply(subst cp_OclIsModifiedOnly, subst UML_Set.OclExcluding.cp0,
      subst (asm) cp_OclIsModifiedOnly, simp add: including4 excluding1)
 
   apply(simp only: X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                    X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                    person1_def person2_def person3_def person4_def
                    person5_def person6_def person7_def person8_def person9_def)
   apply(simp add: OclIncluding_rep_set mtSet_rep_set
                   oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
   apply(simp add: StrictRefEq\<^sub>O\<^sub>b\<^sub>j\<^sub>e\<^sub>c\<^sub>t_def oid_of_option_def oid_of_type\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_def OclNot_def OclValid_def
                   null_option_def bot_option_def)
  done
 qed
 
 lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = \<lparr> heap = Map.empty
-                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9)
-                           (oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8)
-                           (oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7)
-                           (oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6)
+                           (oid8 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person9,
+                           oid7 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person8,
+                           oid6 \<mapsto> in\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y person7,
+                           oid5 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person6,
                            \<^cancel>\<open>oid4\<close>
-                           (oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4)
-                           (oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3)
-                           (oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2)
-                           (oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
+                           oid3 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person4,
+                           oid2 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person3,
+                           oid1 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person2,
+                           oid0 \<mapsto> in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n person1)
                        , assocs = assocs \<sigma>\<^sub>1' \<rparr>"
 proof -
  note P = fun_upd_twist
  show ?thesis
   apply(simp add: \<sigma>\<^sub>1'_def
                   oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def)
   apply(subst (1) P, simp)
   apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
   apply(subst (7) P, simp) apply(subst (6) P, simp) apply(subst (5) P, simp) apply(subst (4) P, simp) apply(subst (3) P, simp) apply(subst (2) P, simp) apply(subst (1) P, simp)
  by(simp)
 qed
 
 declare const_ss [simp]
 
 lemma "\<And>\<sigma>\<^sub>1.
  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (Person .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4\<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6,
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7 .oclAsType(Person)\<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 })"
  apply(subst perm_\<sigma>\<^sub>1')
  apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                   person7_def)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
   apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
    apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
     apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
      apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
       apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
        apply(subst state_update_vs_allInstances_at_post_ntc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def
                                                                              person8_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp)
        apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)
         apply(rule state_update_vs_allInstances_at_post_empty)
 by(simp_all add: OclAsType\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<AA>_def)
 
 lemma "\<And>\<sigma>\<^sub>1.
  (\<sigma>\<^sub>1,\<sigma>\<^sub>1') \<Turnstile> (OclAny .allInstances() \<doteq> Set{ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 .oclAsType(OclAny),
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 .oclAsType(OclAny), X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4 .oclAsType(OclAny)
                                            \<^cancel>\<open>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5\<close>, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6 .oclAsType(OclAny),
                                            X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9 .oclAsType(OclAny) })"
  apply(subst perm_\<sigma>\<^sub>1')
  apply(simp only: oid0_def oid1_def oid2_def oid3_def oid4_def oid5_def oid6_def oid7_def oid8_def
                   X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n4_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n5_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n6_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n7_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n8_def X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n9_def
                   person1_def person2_def person3_def person4_def person5_def person6_def person9_def)
  apply(subst state_update_vs_allInstances_at_post_tc, simp, simp add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def, simp, rule const_StrictRefEq\<^sub>S\<^sub>e\<^sub>t_including, simp, simp, simp, rule OclIncluding_cong, simp, simp)+
          apply(rule state_update_vs_allInstances_at_post_empty)
 by(simp_all add: OclAsType\<^sub>O\<^sub>c\<^sub>l\<^sub>A\<^sub>n\<^sub>y_\<AA>_def)
 
 end
diff --git a/thys/Hoare_Time/Big_StepT_Partial.thy b/thys/Hoare_Time/Big_StepT_Partial.thy
--- a/thys/Hoare_Time/Big_StepT_Partial.thy
+++ b/thys/Hoare_Time/Big_StepT_Partial.thy
@@ -1,500 +1,500 @@
 subsection "Big step Semantics on partial states"
 
 theory Big_StepT_Partial
 imports Partial_Evaluation Big_StepT "SepLogAdd/Sep_Algebra_Add"  
     "HOL-Eisbach.Eisbach"
 begin
 
 
 type_synonym lvname = string 
 type_synonym pstate_t = "partstate * nat"
 type_synonym assnp = "partstate \<Rightarrow> bool"
 type_synonym assn2 = "pstate_t \<Rightarrow> bool" 
 
 subsubsection \<open>helper functions\<close>
      
 paragraph \<open>restrict\<close>
     
 definition restrict where "restrict S s = (%x. if x:S then Some (s x) else None)"
    
 lemma restrictI: "\<forall>x\<in>S. s1 x = s2 x \<Longrightarrow> restrict S s1 = restrict S s2"
   unfolding restrict_def by fastforce
     
 lemma restrictE: "restrict S s1 = restrict S s2 \<Longrightarrow> s1 = s2 on S"
   unfolding restrict_def by (meson option.inject)   
         
 lemma dom_restrict[simp]: "dom (restrict S s) = S"
   unfolding restrict_def
   using domIff by fastforce
        
 lemma restrict_less_part: "restrict S t \<preceq> part t"      
   unfolding restrict_def map_le_substate_conv[symmetric] map_le_def part_def apply auto 
   by (metis option.simps(3))
    
 paragraph \<open>Heap helper functions\<close> 
         
 fun lmaps_to_expr :: "aexp \<Rightarrow> val \<Rightarrow> assn2" where
   "lmaps_to_expr a v = (%(s,c). dom s = vars a \<and> paval a s = v \<and> c = 0)"
   
 fun lmaps_to_expr_x :: "vname \<Rightarrow> aexp \<Rightarrow> val \<Rightarrow> assn2" where
   "lmaps_to_expr_x x a v = (%(s,c). dom s = vars a \<union> {x} \<and> paval a s = v \<and> c = 0)"
       
 lemma subState: "x \<preceq> y \<Longrightarrow> v \<in> dom x \<Longrightarrow> x v = y v" unfolding map_le_substate_conv[symmetric] map_le_def  
   by blast 
        
 lemma  fixes ps:: partstate
     and s::state
   assumes "vars a \<subseteq> dom ps" "ps \<preceq> part s"
   shows emb_update: "emb [x \<mapsto> paval a ps] s = (emb ps s) (x := aval a (emb ps s))"
     using assms
       unfolding emb_def apply auto apply (rule ext)
       apply(case_tac "v=x")
         apply(simp add: paval_aval)
       apply(simp) unfolding part_def apply(case_tac "v \<in> dom ps")
       using subState apply fastforce
       by (simp add: domIff)       
   
 lemma paval_aval2: "vars a \<subseteq> dom ps \<Longrightarrow> ps \<preceq> part s \<Longrightarrow> paval a ps = aval a s"
   apply(induct a) using subState unfolding part_def apply auto  
   by fastforce  
     
 lemma  fixes ps:: partstate
     and s::state
   assumes "vars a \<subseteq> dom ps" "ps \<preceq> part s"
   shows emb_update2: "emb (ps(x \<mapsto> paval a ps)) s = (emb ps s)(x := aval a (emb ps s))"
     using assms
       unfolding emb_def apply auto apply (rule ext)
       apply(case_tac "v=x")
         apply(simp add: paval_aval)
       by (simp)             
      
     
 subsubsection "Big step Semantics on partial states"
 
 inductive
   big_step_t_part :: "com \<times> partstate \<Rightarrow> nat \<Rightarrow> partstate \<Rightarrow> bool"  ("_ \<Rightarrow>\<^sub>A _ \<Down> _" 55)
 where
 Skip: "(SKIP,s) \<Rightarrow>\<^sub>A Suc 0 \<Down> s" |
 Assign: "\<lbrakk> vars a \<union> {x} \<subseteq> dom ps; paval a ps = v ; ps' = ps(x \<mapsto> v) \<rbrakk> \<Longrightarrow> (x ::= a,ps) \<Rightarrow>\<^sub>A Suc 0 \<Down> ps'" |
 
 Seq: "\<lbrakk> (c1,s1) \<Rightarrow>\<^sub>A x \<Down> s2;  (c2,s2) \<Rightarrow>\<^sub>A y \<Down> s3 ; z=x+y \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^sub>A z \<Down> s3" |
 
 IfTrue: "\<lbrakk> vars b \<subseteq> dom ps ; dom ps' = dom ps ; pbval b ps;  (c1,ps) \<Rightarrow>\<^sub>A x \<Down> ps'; y=x+1 \<rbrakk> \<Longrightarrow> (IF b THEN c1 ELSE c2, ps) \<Rightarrow>\<^sub>A y \<Down> ps'" |
 IfFalse: "\<lbrakk> vars b \<subseteq> dom ps ; dom ps' = dom ps ; \<not> pbval b ps;  (c2,ps) \<Rightarrow>\<^sub>A x \<Down> ps'; y=x+1  \<rbrakk> \<Longrightarrow> (IF b THEN c1 ELSE c2, ps) \<Rightarrow>\<^sub>A y \<Down> ps'" |
 WhileFalse: "\<lbrakk> vars b \<subseteq> dom s; \<not> pbval b s \<rbrakk> \<Longrightarrow> (WHILE b DO c,s) \<Rightarrow>\<^sub>A Suc 0 \<Down> s" |
 WhileTrue: "\<lbrakk> pbval b s1; vars b \<subseteq> dom s1;  (c,s1) \<Rightarrow>\<^sub>A x \<Down> s2;  (WHILE b DO c, s2) \<Rightarrow>\<^sub>A y \<Down> s3; 1+x+y=z  \<rbrakk> 
           \<Longrightarrow> (WHILE b DO c, s1) \<Rightarrow>\<^sub>A z \<Down> s3"
 
 
 declare big_step_t_part.intros [intro]
 
     
 inductive_cases Skip_tE3[elim!]: "(SKIP,s) \<Rightarrow>\<^sub>A x \<Down> t"
 thm Skip_tE3 
 inductive_cases Assign_tE3[elim!]: "(x ::= a,s) \<Rightarrow>\<^sub>A p \<Down> t"
 thm Assign_tE3
 inductive_cases Seq_tE3[elim!]: "(c1;;c2,s1) \<Rightarrow>\<^sub>A p \<Down> s3"
 thm Seq_tE3
 inductive_cases If_tE3[elim!]: "(IF b THEN c1 ELSE c2,s) \<Rightarrow>\<^sub>A x \<Down> t"
 thm If_tE3
 inductive_cases While_tE3[elim]: "(WHILE b DO c,s) \<Rightarrow>\<^sub>A x \<Down> t"
 thm While_tE3
 
   
 lemmas big_step_t_part_induct = big_step_t_part.induct[split_format(complete)]
   
   
 lemma big_step_t3_post_dom_conv: "(c,ps) \<Rightarrow>\<^sub>A t \<Down> ps' \<Longrightarrow> dom ps' = dom ps"
 apply(induct rule: big_step_t_part_induct) apply (auto simp: sep_disj_fun_def plus_fun_def)
   apply metis   done
       
 lemma add_update_distrib: "ps1 x1 = Some y \<Longrightarrow> ps1 ## ps2 \<Longrightarrow> vars x2 \<subseteq> dom ps1 \<Longrightarrow> ps1(x1 \<mapsto> paval x2 ps1) + ps2  = (ps1 + ps2)(x1 \<mapsto> paval x2 ps1)"
   apply (rule ext)
   apply (auto simp: sep_disj_fun_def plus_fun_def)
   by (metis disjoint_iff_not_equal domI domain_conv)   
   
 lemma paval_extend:  "ps1 ## ps2 \<Longrightarrow> vars a \<subseteq> dom ps1 \<Longrightarrow> paval a (ps1 + ps2) = paval a ps1" 
 apply(induct a) apply (auto simp: sep_disj_fun_def domain_conv)
   by (metis domI map_add_comm map_add_dom_app_simps(1) option.sel plus_fun_conv) 
     
 lemma pbval_extend: "ps1 ## ps2 \<Longrightarrow> vars b \<subseteq> dom ps1 \<Longrightarrow> pbval b (ps1 + ps2) = pbval b ps1" 
 apply(induct b)  by (auto simp: paval_extend) 
      
     
 lemma Framer: "(C, ps1) \<Rightarrow>\<^sub>A m \<Down> ps1' \<Longrightarrow> ps1 ## ps2 \<Longrightarrow> (C, ps1 + ps2) \<Rightarrow>\<^sub>A m \<Down>  ps1'+ps2"
 proof (induct rule: big_step_t_part_induct)  
   case (Skip s)
   then show ?case by (auto simp: big_step_t_part.Skip)  
 next
   case (Assign a x ps v ps')
   show ?case apply(rule big_step_t_part.Assign)  
     using Assign 
      apply (auto simp: plus_fun_def)  
     apply(rule ext)
     apply(case_tac "xa=x") 
     subgoal apply auto subgoal using paval_extend[unfolded plus_fun_def] by auto
        unfolding sep_disj_fun_def
        by (metis disjoint_iff_not_equal domI domain_conv) 
    subgoal by auto   
      done
 next
   case (IfTrue b ps ps' c1 x y c2)
   then show ?case apply (auto ) apply(subst big_step_t_part.IfTrue)
          apply (auto simp: pbval_extend) 
       subgoal      by (auto simp: plus_fun_def)
       subgoal      by (auto simp: plus_fun_def)
       subgoal      by (auto simp: plus_fun_def) 
           done
 next
   case (IfFalse b ps ps' c2 x y c1)
   then show ?case apply (auto ) apply(subst big_step_t_part.IfFalse)
          apply (auto simp: pbval_extend) 
       subgoal      by (auto simp: plus_fun_def)
       subgoal      by (auto simp: plus_fun_def)
       subgoal      by (auto simp: plus_fun_def) 
           done
 next
   case (WhileFalse b s c)
   then show ?case apply(subst big_step_t_part.WhileFalse)
       subgoal      by (auto simp: plus_fun_def)
       subgoal      by (auto simp: pbval_extend)
           by auto
 next
   case (WhileTrue b s1 c x s2 y s3 z)
   from big_step_t3_post_dom_conv[OF WhileTrue(3)]  have "dom s2 = dom s1" by auto
   with WhileTrue(8) have "s2 ## ps2" unfolding sep_disj_fun_def domain_conv by auto
   with WhileTrue show ?case apply auto apply(subst big_step_t_part.WhileTrue)
       subgoal      by (auto simp: pbval_extend)
       subgoal      by (auto simp: plus_fun_def)
              apply (auto) done
 next
   case (Seq c1 s1 x s2 c2 y s3 z)
   from big_step_t3_post_dom_conv[OF Seq(1)]  have "dom s2 = dom s1" by auto
   with Seq(6) have "s2 ## ps2" unfolding sep_disj_fun_def domain_conv by auto
   with Seq show ?case apply (subst big_step_t_part.Seq)
       by auto
 qed
    
    
 lemma Framer2: "(C, ps1) \<Rightarrow>\<^sub>A m \<Down> ps1' \<Longrightarrow> ps1 ## ps2 \<Longrightarrow> ps = ps1 + ps2 \<Longrightarrow> ps' = ps1'+ps2 \<Longrightarrow> (C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' "
   using Framer by auto
   
 (* connection to bigstep2 *)
    
 subsubsection \<open>Relation to BigStep Semantic on full states\<close> 
     
 lemma paval_aval_part: "paval a (part s) = aval a s"
   apply(induct a) by (auto simp: part_def) 
 lemma pbval_bval_part: "pbval b (part s) = bval b s"
   apply(induct b) by (auto simp: paval_aval_part) 
  
     
-lemma part_paval_aval: "part (s(x := aval a s)) = part s(x \<mapsto> paval a (part s))"
+lemma part_paval_aval: "part (s(x := aval a s)) = (part s)(x \<mapsto> paval a (part s))"
   apply(rule ext)
   apply(case_tac "xa=x")  
     unfolding part_def apply auto by (metis (full_types) domIff map_le_def map_le_substate_conv option.distinct(1) part_def paval_aval2 subsetI) 
        
       
 lemma full_to_part: "(C, s) \<Rightarrow> m \<Down> s' \<Longrightarrow>  (C, part s) \<Rightarrow>\<^sub>A m \<Down> part s' " 
 apply(induct rule: big_step_t_induct)
   using Skip apply simp 
        apply (subst Assign)
           using part_paval_aval apply(simp_all add: )
     apply(rule Seq) apply auto
     apply(rule IfTrue) apply (auto simp: pbval_bval_part)
     apply(rule IfFalse) apply (auto simp: pbval_bval_part)
     apply(rule WhileFalse) apply (auto simp: pbval_bval_part)
   apply(rule WhileTrue) apply (auto simp: pbval_bval_part)
   done        
   
 lemma part_to_full': "(C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' \<Longrightarrow> (C, emb ps s) \<Rightarrow> m \<Down> emb ps' s" 
 proof (induct rule: big_step_t_part_induct) 
   case (Assign a x ps v ps')
   have z: "paval a ps = aval a (emb ps s)"
     apply(rule paval_aval_vars) using Assign(1) by auto
   have g :"emb ps' s = (emb ps s)(x:=aval a (emb ps s) )"
     apply(simp only: Assign z[symmetric])
       unfolding emb_def by auto      
   show ?case apply(simp only: g) by(rule big_step_t.Assign)
 qed (auto simp: pbval_bval_vars[symmetric])
   
   
 lemma part_to_full: "(C, part s) \<Rightarrow>\<^sub>A m \<Down> part s' \<Longrightarrow> (C, s) \<Rightarrow> m \<Down> s'"
 proof -
   assume "(C, part s) \<Rightarrow>\<^sub>A m \<Down> part s'"
   then have "(C, emb (part s) s) \<Rightarrow> m \<Down> emb (part s') s" by (rule part_to_full')
   then show "(C, s) \<Rightarrow> m \<Down> s'" by auto
 qed
   
   
 lemma part_full_equiv: "(C, s) \<Rightarrow> m \<Down> s' \<longleftrightarrow> (C, part s) \<Rightarrow>\<^sub>A m \<Down> part s'"
 using part_to_full full_to_part by metis    
     
 subsubsection \<open>more properties\<close>
     
 lemma big_step_t3_gt0: "(C, ps) \<Rightarrow>\<^sub>A x \<Down> ps' \<Longrightarrow> x > 0"
 apply(induct rule: big_step_t_part_induct) apply auto done
         
 lemma big_step_t3_same: "(C, ps) \<Rightarrow>\<^sub>A m \<Down> ps' ==>  ps = ps' on UNIV - lvars C"
 apply(induct rule: big_step_t_part_induct) by (auto simp: sep_disj_fun_def plus_fun_def) 
     
 lemma avalDirekt3_correct: " (x ::= N v, ps) \<Rightarrow>\<^sub>A m \<Down> ps' \<Longrightarrow> paval' a ps = Some v \<Longrightarrow>  (x ::= a, ps) \<Rightarrow>\<^sub>A m \<Down> ps'" 
 apply(auto) apply(subst Assign) by (auto simp: paval_paval' paval'dom) 
     
 
 
   
 subsection \<open>Partial State\<close>    
   
  
   
 (* partialstate and nat is a separation algebra ! *)  
 lemma
   fixes h :: "(vname \<Rightarrow> val option) * nat"
   shows "(P ** Q ** H) h = (Q ** H ** P) h"
   by (simp add: sep_conj_ac)
         
 lemma separate_othogonal_commuted': assumes
     "\<And>ps n. P (ps,n) \<Longrightarrow> ps = 0"
     "\<And>ps n. Q (ps,n) \<Longrightarrow> n = 0"
   shows "(P ** Q) s \<longleftrightarrow> P (0,snd s) \<and> Q (fst s,0)"
   using assms unfolding sep_conj_def by force  
    
  
 lemma separate_othogonal_commuted: assumes
     "\<And>ps n. P (ps,n) \<Longrightarrow> ps = 0"
     "\<And>ps n. Q (ps,n) \<Longrightarrow> n = 0"
   shows "(P ** Q) (ps,n) \<longleftrightarrow> P (0,n) \<and> Q (ps,0)"
   using assms unfolding sep_conj_def by force  
    
     
 lemma separate_othogonal: assumes
     "\<And>ps n. P (ps,n) \<Longrightarrow> n = 0"
     "\<And>ps n. Q (ps,n) \<Longrightarrow> ps = 0"
   shows "(P ** Q) (ps,n) \<longleftrightarrow> P (ps,0) \<and> Q (0,n)"
   using assms unfolding sep_conj_def by force 
     
 lemma assumes "  ((\<lambda>(s, n). P (s, n) \<and> vars b \<subseteq> dom s) \<and>* (\<lambda>(s, c). s = 0 \<and> c = Suc 0)) (ps, n)"
 shows "\<exists> n'. P (ps, n') \<and> vars b \<subseteq> dom ps \<and> n = Suc n'"
 proof -
   from assms obtain x y where " x ## y" and "(ps, n) = x + y" 
       and 2: "(case x of (s, n) \<Rightarrow> P (s, n) \<and> vars b \<subseteq>  dom s)"
       and "(case y of (s, c) \<Rightarrow> s = 0 \<and> c = Suc 0)" 
     unfolding sep_conj_def by blast
   then have "y = (0, Suc 0)" and f: "fst x = ps" and n: "n = snd x + Suc 0" by auto
     
   with 2 have "P (ps, snd x) \<and> vars b \<subseteq> dom ps \<and> n = Suc (snd x)"
     by auto 
   then show ?thesis by simp
 qed 
        
     
     
     
 subsection \<open>Dollar and Pointsto\<close>    
     
 definition dollar :: "nat \<Rightarrow> assn2" ("$") where
   "dollar q = (%(s,c). s = 0 \<and> c=q)"
   
   
 lemma sep_reorder_dollar_aux:  
     "NO_MATCH ($X) A \<Longrightarrow> ($B ** A) = (A ** $B)"   
     "($X ** $Y) = $(X+Y)"
    apply (auto simp: sep_simplify)
     unfolding dollar_def sep_conj_def sep_disj_prod_def sep_disj_nat_def by auto
      
 lemmas sep_reorder_dollar = sep_conj_assoc sep_reorder_dollar_aux
 
 lemma stardiff: assumes "(P \<and>* $m) (ps, n)"
   shows  P: "P (ps, n - m)" and "m\<le>n" using assms unfolding sep_conj_def dollar_def by auto     
 
 lemma [simp]: "(Q ** $0) = Q" unfolding dollar_def sep_conj_def sep_disj_prod_def sep_disj_nat_def  
   by auto 
   
 definition embP :: "(partstate \<Rightarrow> bool) \<Rightarrow> partstate \<times> nat \<Rightarrow> bool" where "embP P = (%(s,n). P s \<and> n = 0)"
   
     
 lemma orthogonal_split: assumes "(embP Q \<and>* $ n) = (embP P \<and>* $ m)"   
   shows "(Q = P \<and> n = m) \<or> Q = (\<lambda>s. False) \<and> P = (\<lambda>s. False)"
   using assms unfolding embP_def dollar_def apply (auto intro!: ext)
     unfolding sep_conj_def apply auto unfolding  sep_disj_prod_def  plus_prod_def  
     apply (metis fst_conv snd_conv)+ done
       
 (* how to set up case rules *)      
       
 lemma F: assumes "(embP Q \<and>* $ n) = (embP P \<and>* $ m)"   
   obtains (blub) "Q = P" and "n = m" |
           (da)  "Q = (\<lambda>s. False)" and "P = (\<lambda>s. False)" 
   using assms orthogonal_split by auto
     
 lemma T: assumes "(embP Q \<and>* $ n) = (embP P \<and>* $ m)"   
   obtains (blub) x::nat where "Q = P" and "n = m" and "x=x" |
           (da)  "Q = (\<lambda>s. False)" and "P = (\<lambda>s. False)"
           using assms orthogonal_split by auto
   
   
 definition pointsto :: "vname \<Rightarrow> val \<Rightarrow> assn2"  ("_ \<hookrightarrow> _" [56,51] 56) where
   "v \<hookrightarrow> n = (%(s,c). s = [v \<mapsto> n] \<and> c=0)"
   
 (* If you don't mind syntax ambiguity: *)
 notation pred_ex (binder "\<exists>" 10)
   
 definition maps_to_ex :: "vname \<Rightarrow> assn2" ("_ \<hookrightarrow> -" [56] 56)
   where "x \<hookrightarrow> - \<equiv> \<exists>y. x \<hookrightarrow> y"
         
 fun lmaps_to_ex :: "vname set \<Rightarrow> assn2" where
   "lmaps_to_ex xs = (%(s,c). dom s = xs \<and> c = 0)"
    
   
 lemma "(x \<hookrightarrow> -) (s,n) \<Longrightarrow> x \<in> dom s"
   unfolding maps_to_ex_def pointsto_def by auto 
       
 fun lmaps_to_axpr :: "bexp \<Rightarrow> bool \<Rightarrow> assnp" where
   "lmaps_to_axpr b bv = (%ps. vars b \<subseteq> dom ps \<and> pbval b ps = bv )"
  
 definition lmaps_to_axpr' :: "bexp \<Rightarrow> bool \<Rightarrow> assnp" where
   "lmaps_to_axpr' b bv = lmaps_to_axpr b bv"
   
    
     
     
 subsection \<open>Frame Inference\<close>
       
 definition Frame where "Frame P Q F \<equiv>    \<forall>s. (P imp (Q ** F)) s" 
 definition Frame' where "Frame' P P' Q F \<equiv> \<forall>s. (( P' ** P) imp (Q ** F)) s"  
 
 definition cnv where "cnv x y == x = y"
   
 lemma cnv_I: "cnv x x"
   unfolding cnv_def by simp
   
 lemma Frame'_conv: "Frame P Q F = Frame' (P ** \<box>) \<box> (Q ** \<box>) F" 
   unfolding Frame_def Frame'_def apply auto done     
     
 lemma Frame'I: "Frame' (P ** \<box>) \<box> (Q ** \<box>) F \<Longrightarrow> cnv F F' \<Longrightarrow> Frame P Q F'" 
   unfolding Frame_def Frame'_def cnv_def apply auto done
     
 lemma FrameD: assumes "Frame P Q F" " P s "
   shows "(F ** Q) s"
   using assms unfolding Frame_def by (auto simp: sep_conj_commute)    
     
 lemma Frame'_match: "Frame' (P ** P') \<box> Q F \<Longrightarrow> Frame' (x \<hookrightarrow> v ** P) P' (x \<hookrightarrow> v ** Q) F" 
   unfolding Frame_def Frame'_def apply (auto simp: sep_conj_ac)
   by (metis (no_types, opaque_lifting) prod.collapse sep.mult_assoc sep_conj_impl1)   
     
 lemma R: assumes "\<And>s. (A imp B) s" shows "((A ** $n) imp (B ** $n)) s"    
 proof (safe)
   assume "(A \<and>* $ n) s"
   then obtain h1 h2 where A: "A h1"  and n: "$n h2" and disj: "h1 ## h2" "s = h1+h2" unfolding sep_conj_def by blast
   from assms A have B: "B h1" by auto    
   show "(B ** $n) s" using B n disj unfolding sep_conj_def by blast
 qed 
   
 lemma Frame'_matchdollar:  assumes "Frame' (P ** P' ** $(n-m)) \<box> Q F" and nm: "n\<ge>m"
   shows "Frame' ($n ** P) P' ($m ** Q) F" 
  using assms(1) unfolding Frame_def Frame'_def apply (auto simp: sep_conj_ac)  
 proof (goal_cases)
   case (1 a b) 
   have g: "((P \<and>* P' \<and>* $ n) imp (F \<and>* Q \<and>* $ m)) (a, b)
         \<longleftrightarrow> (((P \<and>* P' \<and>* $(n-m)) ** $m) imp ((F \<and>* Q) \<and>* $ m)) (a, b)" 
     by(simp add: nm sep_reorder_dollar)
   have "((P \<and>* P' \<and>* $ n) imp (F \<and>* Q \<and>* $ m)) (a, b)"     
     apply(subst g)
       apply(rule R) using 1(1) by auto
   then have "(P \<and>* P' \<and>* $ n) (a, b) \<longrightarrow> (F \<and>* Q \<and>* $ m) (a, b)"
     by blast  
   then show ?case using 1(2) by auto
 qed
                                                             
 lemma Frame'_nomatch: " Frame' P (p ** P') (x \<hookrightarrow> v ** Q) F\<Longrightarrow> Frame' (p ** P) P' (x \<hookrightarrow> v ** Q) F" 
   unfolding  Frame'_def by (auto simp: sep_conj_ac)   
     
 lemma Frame'_nomatchempty: " Frame' P P' (x \<hookrightarrow> v ** Q) F\<Longrightarrow> Frame' (\<box> ** P) P' (x \<hookrightarrow> v ** Q) F" 
   unfolding  Frame'_def by (auto simp: sep_conj_ac) 
         
 (* this will only be reached after a Frame'_match move, where P' is \<box> *)    
 lemma Frame'_end: " Frame' P \<box> \<box> P"
   unfolding  Frame'_def by (auto simp: sep_conj_ac)   
         
 schematic_goal "Frame (x \<hookrightarrow> v1 \<and>* y \<hookrightarrow> v2)  (x \<hookrightarrow> ?v) ?F"
   apply(rule Frame'I) apply(simp only: sep_conj_assoc)
   apply(rule Frame'_match)
   apply(rule Frame'_end) apply(simp only: sep_conj_ac sep_conj_empty' sep_conj_empty) apply(rule cnv_I) done
     
 schematic_goal "Frame (x \<hookrightarrow> v1 \<and>* y \<hookrightarrow> v2)  (y \<hookrightarrow> ?v) ?F"
   apply(rule Frame'I) apply(simp only: sep_conj_assoc)
    apply(rule Frame'_end Frame'_match Frame'_nomatchempty Frame'_nomatch; (simp only: sep_conj_assoc)?)+
     apply(simp only: sep_conj_ac sep_conj_empty' sep_conj_empty) apply(rule cnv_I) 
    done
         
 method frame_inference_init = (rule Frame'I, (simp only: sep_conj_assoc)?)
 
 method frame_inference_solve = (rule Frame'_matchdollar Frame'_end Frame'_match Frame'_nomatchempty Frame'_nomatch; (simp only: sep_conj_assoc)?)+
   
 method frame_inference_cleanup = ( (simp only: sep_conj_ac sep_conj_empty' sep_conj_empty)?; rule cnv_I)
   
   
 method frame_inference = (frame_inference_init, (frame_inference_solve; fail), (frame_inference_cleanup; fail))
 method frame_inference_debug = (frame_inference_init, frame_inference_solve)
   
 subsubsection \<open>tests\<close>  
       
 schematic_goal "Frame (x \<hookrightarrow> v1 \<and>* y \<hookrightarrow> v2)  (y \<hookrightarrow> ?v) ?F"
   by frame_inference
     
 schematic_goal "Frame (x \<hookrightarrow> v1 ** P ** \<box> ** y \<hookrightarrow> v2 \<and>* z \<hookrightarrow> v2 ** Q)  (z \<hookrightarrow> ?v ** y \<hookrightarrow> ?v2) ?F"
   by frame_inference
           
 (* with dollar *)
 
 schematic_goal " 1 \<le> v \<Longrightarrow> Frame ($ (2 * v) \<and>* ''x'' \<hookrightarrow> int v) ($ 1 \<and>* ''x'' \<hookrightarrow> ?d) ?F" 
   apply(rule Frame'I) apply(simp only: sep_conj_assoc) 
    apply(rule  Frame'_matchdollar Frame'_end Frame'_match Frame'_nomatchempty Frame'_nomatch; (simp only: sep_conj_assoc)?)+
   apply (simp only: sep_conj_ac sep_conj_empty' sep_conj_empty)?
   apply (rule cnv_I) done 
     
     
 schematic_goal " 0 < v \<Longrightarrow> Frame ($ (2 * v) \<and>* ''x'' \<hookrightarrow> int v) ($ 1 \<and>* ''x'' \<hookrightarrow> ?d) ?F"    
     apply frame_inference done
             
 subsection \<open>Expression evaluation\<close>
       
 definition symeval where "symeval P e v \<equiv> (\<forall>s n. P (s,n) \<longrightarrow> paval' e s = Some v)"    
 definition symevalb where "symevalb P e v \<equiv> (\<forall>s n. P (s,n) \<longrightarrow> pbval' e s = Some v)"      
       
 lemma symeval_c: "symeval P (N v) v"
   unfolding symeval_def apply auto done
       
     
 lemma symeval_v: assumes "Frame P (x \<hookrightarrow> v) F"
   shows "symeval P (V x) v"
   unfolding symeval_def apply auto
   apply (drule FrameD[OF assms])  unfolding sep_conj_def pointsto_def  
   apply (auto simp: plus_fun_conv) done
     
 lemma symeval_plus: assumes "symeval P e1 v1" "symeval P e2 v2"
   shows "symeval P (Plus e1 e2) (v1+v2)"
   using assms unfolding symeval_def by auto 
     
     
 lemma symevalb_c: "symevalb P (Bc v) v"
   unfolding symevalb_def apply auto done
           
 lemma symevalb_and: assumes "symevalb P e1 v1" "symevalb P e2 v2"
   shows "symevalb P (And e1 e2) (v1 \<and> v2)"
   using assms unfolding symevalb_def  by auto
     
 lemma symevalb_not:  assumes "symevalb P e v"
   shows "symevalb P (Not e) (\<not> v)"
   using assms unfolding symevalb_def  by auto
     
 lemma symevalb_less: assumes "symeval P e1 v1" "symeval P e2 v2"
   shows "symevalb P (Less e1 e2) (v1 < v2)"
   using assms unfolding symevalb_def symeval_def by auto
   
 lemmas symeval = symeval_c symeval_v symeval_plus symevalb_c symevalb_and symevalb_not symevalb_less
    
 schematic_goal "symevalb ( (x \<hookrightarrow> v1) ** (y \<hookrightarrow> v2) ) (Less (Plus (V x) (V y)) (N 5)) ?g"
   apply(rule symeval | frame_inference)+ done
     
 end
\ No newline at end of file
diff --git a/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated.thy b/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated.thy
--- a/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated.thy
+++ b/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated.thy
@@ -1,107 +1,108 @@
 theory Design_generated imports "../Toy_Library"   "../Toy_Library_Static"   "../embedding/Generator_dynamic_sequential" begin
 
 (* 1 ************************************ 0 + 1 *)
 text \<open>
   For certain concepts like classes and class-types, only a generic
   definition for its resulting semantics can be given. Generic means,
   there is a function outside HOL that ``compiles'' a concrete,
   closed-world class diagram into a ``theory'' of this data model,
   consisting of a bunch of definitions for classes, accessors, method,
   casts, and tests for actual types, as well as proofs for the
   fundamental properties of these operations in this concrete data
   model. \<close>
 
 (* 2 ************************************ 1 + 1 *)
 text \<open>
    Our data universe  consists in the concrete class diagram just of node's,
 and implicitly of the class object. Each class implies the existence of a class
 type defined for the corresponding object representations as follows: \<close>
 
 (* 3 ************************************ 2 + 10 *)
 datatype ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m "oid" "oid list option" "int option" "bool option" "nat option" "unit option"
 datatype ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m" "int option"
 datatype ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "oid" "oid list option" "int option" "bool option" "nat option" "unit option"
 datatype ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
 datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "unit option"
 datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" "bool option"
 datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid"
 datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "nat option" "unit option"
 datatype ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "oid"
 datatype ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y"
 
 (* 4 ************************************ 12 + 1 *)
 text \<open>
    Now, we construct a concrete ``universe of ToyAny types'' by injection into a
 sum type containing the class types. This type of ToyAny will be used as instance
 for all respective type-variables. \<close>
 
 (* 5 ************************************ 13 + 1 *)
 datatype \<AA> = in\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | in\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y"
                         | in\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y"
 
 (* 6 ************************************ 14 + 1 *)
 text \<open>
    Having fixed the object universe, we can introduce type synonyms that exactly correspond
 to Toy types. Again, we exploit that our representation of Toy is a ``shallow embedding'' with a
 one-to-one correspondance of Toy-types to types of the meta-language HOL. \<close>
 
 (* 7 ************************************ 15 + 5 *)
 type_synonym Atom = "\<langle>\<langle>ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Molecule = "\<langle>\<langle>ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym ToyAny = "\<langle>\<langle>ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 
 (* 8 ************************************ 20 + 3 *)
 definition "oid\<^sub>A\<^sub>t\<^sub>o\<^sub>m_0___boss = 0"
 definition "oid\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_0___boss = 0"
 definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0"
 
 (* 9 ************************************ 23 + 2 *)
 definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))"
 definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))"
 
 (* 10 ************************************ 25 + 3 *)
 definition "oid1 = 1"
 definition "oid2 = 2"
 definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((drop ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None
     | l \<Rightarrow> (Some (l)))::oid list option))"
 
 (* 11 ************************************ 28 + 0 *)
 
 (* 12 ************************************ 28 + 2 *)
 definition "oid3 = 3"
 definition "inst_assoc3 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((drop ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None
     | l \<Rightarrow> (Some (l)))::oid list option))"
 
 (* 13 ************************************ 30 + 0 *)
 
 (* 14 ************************************ 30 + 4 *)
 generation_syntax [ shallow (generation_semantics [ design ]) ]
 setup \<open>(Generation_mode.update_compiler_config ((K (let open META in Compiler_env_config_ext (true, NONE, Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 4)), I ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 0)), Gen_only_design, SOME (ToyClass ((META.SS_base (META.ST "ToyAny")), nil, uncurry cons (ToyClass ((META.SS_base (META.ST "Galaxy")), uncurry cons (I ((META.SS_base (META.ST "wormhole")), ToyTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "is_sound")), ToyTy_base_void), nil)), uncurry cons (ToyClass ((META.SS_base (META.ST "Person")), uncurry cons (I ((META.SS_base (META.ST "boss")), ToyTy_object (ToyTyObj (ToyTyCore (Toy_ty_class_ext ((META.SS_base (META.ST "oid")), (Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 2), Toy_ty_class_node_ext ((Code_Numeral.natural_of_integer 0), Toy_multiplicity_ext (uncurry cons (I (Mult_star, NONE), nil), NONE, uncurry cons (Set, nil), ()), (META.SS_base (META.ST "Person")), ()), Toy_ty_class_node_ext ((Code_Numeral.natural_of_integer 1), Toy_multiplicity_ext (uncurry cons (I (Mult_nat ((Code_Numeral.natural_of_integer 0)), SOME (Mult_nat ((Code_Numeral.natural_of_integer 1)))), nil), SOME ((META.SS_base (META.ST "boss"))), uncurry cons (Set, nil), ()), (META.SS_base (META.ST "Person")), ()), ())), nil))), uncurry cons (I ((META.SS_base (META.ST "salary")), ToyTy_base_integer), uncurry cons (I ((META.SS_base (META.ST "is_meta_thinking")), ToyTy_base_boolean), nil))), uncurry cons (ToyClass ((META.SS_base (META.ST "Molecule")), nil, uncurry cons (ToyClass ((META.SS_base (META.ST "Atom")), uncurry cons (I ((META.SS_base (META.ST "size")), ToyTy_base_integer), nil), nil), nil)), nil)), nil)), nil))), uncurry cons (META_instance (ToyInstance (uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1")))))), nil)), ()), nil))), uncurry cons (META_instance (ToyInstance (uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), uncurry cons (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1800")))))), nil)), ()), nil)))), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "salary")), ToyTy_base_integer), uncurry cons (I ((META.SS_base (META.ST "boss")), ToyTy_object (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), nil))), uncurry cons (I ((META.SS_base (META.ST "is_meta_thinking")), ToyTy_base_boolean), nil))), nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Galaxy"))), nil), uncurry cons (I ((META.SS_base (META.ST "wormhole")), ToyTy_base_unlimitednatural), uncurry cons (I ((META.SS_base (META.ST "is_sound")), ToyTy_base_void), nil)), nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Molecule"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Person"))), nil), nil)), nil, nil, false, ())), uncurry cons (META_class_raw (Floor1, Toy_class_raw_ext (ToyTyObj (ToyTyCore_pre ((META.SS_base (META.ST "Atom"))), uncurry cons (uncurry cons (ToyTyCore_pre ((META.SS_base (META.ST "Molecule"))), nil), nil)), uncurry cons (I ((META.SS_base (META.ST "size")), ToyTy_base_integer), nil), nil, false, ())), nil)))))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 3)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1800")))))), nil)), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 2)))), uncurry cons (I ((META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"), I (Toy_instance_single_ext (SOME ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1"))), SOME ((META.SS_base (META.ST "Person"))), ToyAttrNoCast (uncurry cons (I (NONE, I ((META.SS_base (META.ST "salary")), ShallB_term (ToyDefInteger ((META.SS_base (META.ST "1300")))))), uncurry cons (I (NONE, I ((META.SS_base (META.ST "boss")), ShallB_str ((META.SS_base (META.ST "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"))))), nil))), ()), Oids ((Code_Numeral.natural_of_integer 0), (Code_Numeral.natural_of_integer 1), (Code_Numeral.natural_of_integer 1)))), nil))), nil, false, false, I (nil, nil), nil, I (NONE, false), ()) end))))\<close>
 Instance \<sigma>\<^sub>1_object0 :: Person = [ "salary" = 1000, "boss" = self 1 ]
      and \<sigma>\<^sub>1_object1 :: Person = [ "salary" = 1200 ]
      and \<sigma>\<^sub>1_object2 :: Person = [ "salary" = 2600, "boss" = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 ]
      and \<sigma>\<^sub>1_object4 :: Person = [ "salary" = 2300, "boss" = self 2 ]
+(* Fails because of modified map update syntax priorities
 State[shallow] \<sigma>\<^sub>1 = [ \<sigma>\<^sub>1_object0, \<sigma>\<^sub>1_object1, \<sigma>\<^sub>1_object2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, \<sigma>\<^sub>1_object4, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ]
 
 (* 15 ************************************ 34 + 1 *)
 State[shallow] \<sigma>\<^sub>1' = [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2, X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 ]
 
 (* 16 ************************************ 35 + 1 *)
 PrePost[shallow] \<sigma>\<^sub>1 \<sigma>\<^sub>1'
-
+*)
 end
diff --git a/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated_generated.thy b/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated_generated.thy
--- a/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated_generated.thy
+++ b/thys/Isabelle_Meta_Model/toy_example/document_generated/Design_generated_generated.thy
@@ -1,225 +1,225 @@
 theory Design_generated_generated imports "../Toy_Library"   "../Toy_Library_Static" begin
 
 (* 1 ************************************ 0 + 1 *)
 text \<open>
   For certain concepts like classes and class-types, only a generic
   definition for its resulting semantics can be given. Generic means,
   there is a function outside HOL that ``compiles'' a concrete,
   closed-world class diagram into a ``theory'' of this data model,
   consisting of a bunch of definitions for classes, accessors, method,
   casts, and tests for actual types, as well as proofs for the
   fundamental properties of these operations in this concrete data
   model. \<close>
 
 (* 2 ************************************ 1 + 1 *)
 text \<open>
    Our data universe  consists in the concrete class diagram just of node's,
 and implicitly of the class object. Each class implies the existence of a class
 type defined for the corresponding object representations as follows: \<close>
 
 (* 3 ************************************ 2 + 10 *)
 datatype ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m "oid" "oid list option" "int option" "bool option" "nat option" "unit option"
 datatype ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m = mk\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<E>\<X>\<T>\<^sub>A\<^sub>t\<^sub>o\<^sub>m" "int option"
 datatype ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "oid" "oid list option" "int option" "bool option" "nat option" "unit option"
 datatype ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e = mk\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<E>\<X>\<T>\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
 datatype ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "oid" "nat option" "unit option"
 datatype ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n = mk\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<E>\<X>\<T>\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "oid list option" "int option" "bool option"
 datatype ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "oid"
 datatype ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y = mk\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<E>\<X>\<T>\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y" "nat option" "unit option"
 datatype ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y_\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | mk\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "oid"
 datatype ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y = mk\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<E>\<X>\<T>\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y"
 
 (* 4 ************************************ 12 + 1 *)
 text \<open>
    Now, we construct a concrete ``universe of ToyAny types'' by injection into a
 sum type containing the class types. This type of ToyAny will be used as instance
 for all respective type-variables. \<close>
 
 (* 5 ************************************ 13 + 1 *)
 datatype \<AA> = in\<^sub>A\<^sub>t\<^sub>o\<^sub>m "ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m"
                         | in\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e "ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e"
                         | in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
                         | in\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y "ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y"
                         | in\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y "ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y"
 
 (* 6 ************************************ 14 + 1 *)
 text \<open>
    Having fixed the object universe, we can introduce type synonyms that exactly correspond
 to Toy types. Again, we exploit that our representation of Toy is a ``shallow embedding'' with a
 one-to-one correspondance of Toy-types to types of the meta-language HOL. \<close>
 
 (* 7 ************************************ 15 + 5 *)
 type_synonym Atom = "\<langle>\<langle>ty\<^sub>A\<^sub>t\<^sub>o\<^sub>m\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Molecule = "\<langle>\<langle>ty\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Person = "\<langle>\<langle>ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym Galaxy = "\<langle>\<langle>ty\<^sub>G\<^sub>a\<^sub>l\<^sub>a\<^sub>x\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 type_synonym ToyAny = "\<langle>\<langle>ty\<^sub>T\<^sub>o\<^sub>y\<^sub>A\<^sub>n\<^sub>y\<rangle>\<^sub>\<bottom>\<rangle>\<^sub>\<bottom>"
 
 (* 8 ************************************ 20 + 3 *)
 definition "oid\<^sub>A\<^sub>t\<^sub>o\<^sub>m_0___boss = 0"
 definition "oid\<^sub>M\<^sub>o\<^sub>l\<^sub>e\<^sub>c\<^sub>u\<^sub>l\<^sub>e_0___boss = 0"
 definition "oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss = 0"
 
 (* 9 ************************************ 23 + 2 *)
 definition "switch\<^sub>2_01 = (\<lambda> [x0 , x1] \<Rightarrow> (x0 , x1))"
 definition "switch\<^sub>2_10 = (\<lambda> [x0 , x1] \<Rightarrow> (x1 , x0))"
 
 (* 10 ************************************ 25 + 3 *)
 definition "oid1 = 1"
 definition "oid2 = 2"
 definition "inst_assoc1 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((drop ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None
     | l \<Rightarrow> (Some (l)))::oid list option))"
 
 (* 11 ************************************ 28 + 0 *)
 
 (* 12 ************************************ 28 + 2 *)
 definition "oid3 = 3"
 definition "inst_assoc3 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((drop ((((map_of_list ([]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None
     | l \<Rightarrow> (Some (l)))::oid list option))"
 
 (* 13 ************************************ 30 + 0 *)
 
 (* 14 ************************************ 30 + 5 *)
 definition "oid4 = 4"
 definition "oid5 = 5"
 definition "oid6 = 6"
 definition "oid7 = 7"
 definition "inst_assoc4 = (\<lambda>oid_class to_from oid. ((case (deref_assocs_list ((to_from::oid list list \<Rightarrow> oid list \<times> oid list)) ((oid::oid)) ((drop ((((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid7] , [oid6]] , [[oid6] , [oid1]] , [[oid4] , [oid5]]])))]))) ((oid_class::oid))))))) of Nil \<Rightarrow> None
     | l \<Rightarrow> (Some (l)))::oid list option))"
 
 (* 15 ************************************ 35 + 0 *)
 
 (* 16 ************************************ 35 + 1 *)
 locale state_\<sigma>\<^sub>1 =
 fixes "oid4" :: "nat"
 fixes "oid5" :: "nat"
 fixes "oid6" :: "nat"
 fixes "oid1" :: "nat"
 fixes "oid7" :: "nat"
 fixes "oid2" :: "nat"
 assumes distinct_oid: "(distinct ([oid4 , oid5 , oid6 , oid1 , oid7 , oid2]))"
 fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 begin
-definition "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid4] , [oid2]] , [[oid6] , [oid4]] , [[oid1] , [oid6]] , [[oid7] , [oid3]]])))]))))"
+definition "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid4] , [oid2]] , [[oid6] , [oid4]] , [[oid1] , [oid6]] , [[oid7] , [oid3]]])))]))))"
 
-lemma perm_\<sigma>\<^sub>1 : "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1))))"
+lemma perm_\<sigma>\<^sub>1 : "\<sigma>\<^sub>1 = (state.make ((Map.empty (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid7 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid6 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid5 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid4 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1))))"
   apply(simp add: \<sigma>\<^sub>1_def)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (5) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (4) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (3) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
 by(simp)
 end
 
 (* 17 ************************************ 36 + 1 *)
 locale state_\<sigma>\<^sub>1' =
 fixes "oid1" :: "nat"
 fixes "oid2" :: "nat"
 fixes "oid3" :: "nat"
 assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3]))"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 begin
-definition "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))))"
+definition "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((map_of_list ([(oid\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n_0___boss , (List.map ((\<lambda>(x , y). [x , y]) o switch\<^sub>2_01) ([[[oid1] , [oid2]]])))]))))"
 
-lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))) (oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1'))))"
+lemma perm_\<sigma>\<^sub>1' : "\<sigma>\<^sub>1' = (state.make ((Map.empty (oid3 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid2 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n)), oid1 \<mapsto> (in\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n))))) ((assocs (\<sigma>\<^sub>1'))))"
   apply(simp add: \<sigma>\<^sub>1'_def)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (2) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
   apply(subst (1) fun_upd_twist, metis distinct_oid distinct_length_2_or_more)
 by(simp)
 end
 
 (* 18 ************************************ 37 + 1 *)
 locale pre_post_\<sigma>\<^sub>1_\<sigma>\<^sub>1' =
 fixes "oid1" :: "nat"
 fixes "oid2" :: "nat"
 fixes "oid3" :: "nat"
 fixes "oid4" :: "nat"
 fixes "oid5" :: "nat"
 fixes "oid6" :: "nat"
 fixes "oid7" :: "nat"
 assumes distinct_oid: "(distinct ([oid1 , oid2 , oid3 , oid4 , oid5 , oid6 , oid7]))"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3" :: "\<cdot>Person"
 assumes X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3_def: "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 = (\<lambda>_. \<lfloor>\<lfloor>X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object0" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object0_def: "\<sigma>\<^sub>1_object0 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object1" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object1_def: "\<sigma>\<^sub>1_object1 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object2" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object2_def: "\<sigma>\<^sub>1_object2 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 fixes "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" :: "ty\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n"
 fixes "\<sigma>\<^sub>1_object4" :: "\<cdot>Person"
 assumes \<sigma>\<^sub>1_object4_def: "\<sigma>\<^sub>1_object4 = (\<lambda>_. \<lfloor>\<lfloor>\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n\<rfloor>\<rfloor>)"
 
 assumes \<sigma>\<^sub>1: "(state_\<sigma>\<^sub>1 (oid4) (oid5) (oid6) (oid1) (oid7) (oid2) (\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object0) (\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object1) (\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (\<sigma>\<^sub>1_object4) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2))"
 
 assumes \<sigma>\<^sub>1': "(state_\<sigma>\<^sub>1' (oid1) (oid2) (oid3) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n) (X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3))"
 begin
 interpretation state_\<sigma>\<^sub>1: state_\<sigma>\<^sub>1 "oid4" "oid5" "oid6" "oid1" "oid7" "oid2" "\<sigma>\<^sub>1_object0\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object0" "\<sigma>\<^sub>1_object1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object1" "\<sigma>\<^sub>1_object2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "\<sigma>\<^sub>1_object4\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "\<sigma>\<^sub>1_object4" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2"
 by(rule \<sigma>\<^sub>1)
 
 interpretation state_\<sigma>\<^sub>1': state_\<sigma>\<^sub>1' "oid1" "oid2" "oid3" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n" "X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3"
 by(rule \<sigma>\<^sub>1')
 
 definition "heap_\<sigma>\<^sub>1 = (heap (state_\<sigma>\<^sub>1.\<sigma>\<^sub>1))"
 
 definition "heap_\<sigma>\<^sub>1' = (heap (state_\<sigma>\<^sub>1'.\<sigma>\<^sub>1'))"
 end
 
 end
diff --git a/thys/Isabelle_Meta_Model/toy_example/generator/Design_shallow.thy b/thys/Isabelle_Meta_Model/toy_example/generator/Design_shallow.thy
--- a/thys/Isabelle_Meta_Model/toy_example/generator/Design_shallow.thy
+++ b/thys/Isabelle_Meta_Model/toy_example/generator/Design_shallow.thy
@@ -1,136 +1,137 @@
 (******************************************************************************
  * HOL-TOY
  *
  * Copyright (c) 2011-2018 Université Paris-Saclay, Univ. Paris-Sud, France
  *               2013-2017 IRT SystemX, France
  *               2011-2015 Achim D. Brucker, Germany
  *               2016-2018 The University of Sheffield, UK
  *               2016-2017 Nanyang Technological University, Singapore
  *               2017-2018 Virginia Tech, USA
  *
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
  * modification, are permitted provided that the following conditions are
  * met:
  *
  *     * Redistributions of source code must retain the above copyright
  *       notice, this list of conditions and the following disclaimer.
  *
  *     * Redistributions in binary form must reproduce the above
  *       copyright notice, this list of conditions and the following
  *       disclaimer in the documentation and/or other materials provided
  *       with the distribution.
  *
  *     * Neither the name of the copyright holders nor the names of its
  *       contributors may be used to endorse or promote products derived
  *       from this software without specific prior written permission.
  *
  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  ******************************************************************************)
 
 section\<open>Example: A Class Model Interactively Executed\<close>
 subsection\<open>Introduction\<close>
 
 theory
   Design_shallow
 imports
   "../Toy_Library"
   "../Toy_Library_Static"
   "../embedding/Generator_dynamic_sequential"
   "../../Antiquote_Setup"
 begin
 
 text\<open>
 In this example, we configure our package to execute tactic SML code
 (corresponding to some generated \verb|.thy| file, @{file \<open>Design_deep.thy\<close>}
 details how to obtain such generated \verb|.thy| file).
 Since SML code are already compiled (or reflected) and bound with the native Isabelle API in
 @{theory Isabelle_Meta_Model.Generator_dynamic_sequential}, nothing is generated in this theory.
 The system only parses arguments given to meta-commands and immediately calls the corresponding
 compiled functions.
 
 The execution time is comparatively similar as if tactics were written by hand,
 except that the generated SML code potentially inherits all optimizations performed
 by the raw code generation of Isabelle (if any).
 \<close>
 
 generation_syntax [ shallow (generation_semantics [ design ])
                             (*SORRY*) (*no_dirty*)
                   (*, syntax_print*) ]
 text\<open>
 The configuration in @{keyword "shallow"} mode is straightforward:
 in this mode @{command generation_syntax} basically terminates in $O(1)$.
 \<close>
 
 subsection\<open>Designing Class Models (I): Basics\<close>
 
 Class Atom < Molecule
   Attributes size : Integer
 End
 
        End End End
 
 Class Molecule < Person
 
 Class Galaxy
   Attributes wormhole : UnlimitedNatural
              is_sound : Void
 End!
 
 Class Person < Galaxy
   Attributes salary : Integer
              boss : Person
              is_meta_thinking: Boolean
 
 Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1 :: Person = [ salary = 1300 , boss = X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ]
      and X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 :: Person = [ salary = 1800 ]
 
 Instance X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 :: Person = [ salary = 1 ]
 
 (* Class Big_Bang < Atom (* This will force the creation of a new universe. *) *)
 
 subsection\<open>Designing Class Models (II): Jumping to Another Semantic Floor\<close>
 
+(* Fails because of modified map update syntax priorities
 State \<sigma>\<^sub>1 =
   [ ([ salary = 1000 , boss = self 1 ] :: Person)
   , ([ salary = 1200 ] :: Person)
   (* *)
   , ([ salary = 2600 , boss = self 3 ] :: Person)
   , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1
   , ([ salary = 2300 , boss = self 2 ] :: Person)
   (* *)
   (* *)
   , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2 ]
 
 State \<sigma>\<^sub>1' =
   [ X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n1
   , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n2
   , X\<^sub>P\<^sub>e\<^sub>r\<^sub>s\<^sub>o\<^sub>n3 ]
 
 PrePost \<sigma>\<^sub>1 \<sigma>\<^sub>1'
-
+*)
 (* PrePost \<sigma>\<^sub>1 [ ([ salary = 1000 , boss = self 1 ] :: Person) ] *)
 
 subsection\<open>Designing Class Models (III): Interaction with (Pure) Term\<close>
 
 text\<open>
 Here in @{keyword "shallow"} mode, the following expression is directly rejected: \\
 \verb|Context Person :: content ()| \\
 \verb|  Post "><"|
 \<close>
 
 Context[shallow] Person :: content ()
   Post : "a + b = c"
 
 end
diff --git a/thys/LightweightJava/Lightweight_Java_Definition.thy b/thys/LightweightJava/Lightweight_Java_Definition.thy
--- a/thys/LightweightJava/Lightweight_Java_Definition.thy
+++ b/thys/LightweightJava/Lightweight_Java_Definition.thy
@@ -1,674 +1,674 @@
 (*  Title:       Lightweight Java, the definition
     Authors:     Rok Strnisa <rok@strnisa.com>, 2006
                  Matthew Parkinson <matt@matthewp.com>, 2006
     Maintainer:
     Note:        This file should _not_ be modified directly. Please see the
                  accompanying README file.
 *)
 
 (* generated by Ott 0.20.3 from: lj_common.ott lj_base.ott lj.ott *)
 theory Lightweight_Java_Definition
 imports Main "HOL-Library.Multiset"
 begin
 
 (** warning: the backend selected ignores the file structure informations *)
 (** syntax *)
 type_synonym "j" = "nat"
 type_synonym "f" = "string"
 type_synonym "meth" = "string"
 type_synonym "var" = "string"
 type_synonym "dcl" = "string"
 type_synonym "oid" = "nat"
 datatype "fqn" =
    fqn_def "dcl"
 
 datatype "cl" =
    cl_object
  | cl_fqn "fqn"
 
 datatype "x" =
    x_var "var"
  | x_this
 
 datatype "vd" =
    vd_def "cl" "var"
 
 type_synonym "X" = "x list"
 datatype "ctx" =
    ctx_def
 
 type_synonym "vds" = "vd list"
 datatype "s" =
    s_block "s list"
  | s_ass "var" "x"
  | s_read "var" "x" "f"
  | s_write "x" "f" "x"
  | s_if "x" "x" "s" "s"
  | s_new "var" "ctx" "cl"
  | s_call "var" "x" "meth" "X"
 
 datatype "meth_sig" =
    meth_sig_def "cl" "meth" "vds"
 
 datatype "meth_body" =
    meth_body_def "s list" "x"
 
 datatype "fd" =
    fd_def "cl" "f"
 
 datatype "meth_def" =
    meth_def_def "meth_sig" "meth_body"
 
 type_synonym "fds" = "fd list"
 type_synonym "meth_defs" = "meth_def list"
 datatype "cld" =
    cld_def "dcl" "cl" "fds" "meth_defs"
 
 type_synonym "ctxcld" = "(ctx \<times> cld)"
 datatype "ty" =
    ty_top
  | ty_def "ctx" "dcl"
 
 datatype "v" =
    v_null
  | v_oid "oid"
 
 type_synonym "clds" = "cld list"
 type_synonym "ctxclds" = "ctxcld list"
 type_synonym "fs" = "f list"
 type_synonym "ty_opt" = "ty option"
 type_synonym "tys" = "ty list"
 type_synonym "L" = "x \<rightharpoonup> v"
 type_synonym "H" = "oid \<rightharpoonup> (ty \<times> (f \<rightharpoonup> v))"
 datatype "Exception" =
    ex_npe
 
 type_synonym "P" = "clds"
 type_synonym "ctxcld_opt" = "ctxcld option"
 type_synonym "nn" = "nat"
 type_synonym "ctxclds_opt" = "ctxclds option"
 type_synonym "fs_opt" = "fs option"
 type_synonym "meths" = "meth list"
 datatype "ty_opt_bot" =
    ty_opt_bot_opt "ty_opt"
  | ty_opt_bot_bot
 
 type_synonym "meth_def_opt" = "meth_def option"
 type_synonym "ctxmeth_def_opt" = "(ctx \<times> meth_def) option"
 datatype "mty" =
    mty_def "tys" "ty"
 
 type_synonym "\<Gamma>" = "x \<rightharpoonup> ty"
 type_synonym "v_opt" = "v option"
 datatype "config" =
    config_normal "P" "L" "H" "s list"
  | config_ex "P" "L" "H" "Exception"
 
 type_synonym "T" = "x \<rightharpoonup> x"
 
 
 (** library functions *)
 lemma [mono]:"
          (!! x. f x --> g x) ==> list_all (%b. b) (map f foo_list)-->
                     list_all (%b. b) (map g foo_list) "
    apply(induct_tac foo_list, auto) done
 
 lemma [mono]: "case_prod f p = f (fst p) (snd p)" by (simp add: split_def)
 
 (** definitions *)
 (*defns class_name_def *)
 inductive class_name :: "cld \<Rightarrow> dcl \<Rightarrow> bool"
 where
 (* defn class_name *)
 
 class_nameI: "class_name ((cld_def dcl cl fds meth_defs)) (dcl)"
 
 (*defns superclass_name_def *)
 inductive superclass_name :: "cld \<Rightarrow> cl \<Rightarrow> bool"
 where
 (* defn superclass_name *)
 
 superclass_nameI: "superclass_name ((cld_def dcl cl fds meth_defs)) (cl)"
 
 (*defns class_fields_def *)
 inductive class_fields :: "cld \<Rightarrow> fds \<Rightarrow> bool"
 where
 (* defn class_fields *)
 
 class_fieldsI: "class_fields ((cld_def dcl cl fds meth_defs)) (fds)"
 
 (*defns class_methods_def *)
 inductive class_methods :: "cld \<Rightarrow> meth_defs \<Rightarrow> bool"
 where
 (* defn class_methods *)
 
 class_methodsI: "class_methods ((cld_def dcl cl fds meth_defs)) (meth_defs)"
 
 (*defns method_name_def *)
 inductive method_name :: "meth_def \<Rightarrow> meth \<Rightarrow> bool"
 where
 (* defn method_name *)
 
 method_nameI: "method_name ((meth_def_def (meth_sig_def cl meth vds) meth_body)) (meth)"
 
 (*defns distinct_names_def *)
 inductive distinct_names :: "P \<Rightarrow> bool"
 where
 (* defn distinct_names *)
 
 dn_defI: "\<lbrakk> P  =    ((List.map (%((cld_XXX::cld),(dcl_XXX::dcl)).cld_XXX) cld_dcl_list))    ;
  list_all (\<lambda>f. f)  ((List.map (%((cld_XXX::cld),(dcl_XXX::dcl)).class_name (cld_XXX) (dcl_XXX)) cld_dcl_list))  ;
  distinct ( ((List.map (%((cld_XXX::cld),(dcl_XXX::dcl)).dcl_XXX) cld_dcl_list)) ) \<rbrakk> \<Longrightarrow>
 distinct_names (P)"
 
 (*defns find_cld_def *)
 inductive find_cld :: "P \<Rightarrow> ctx \<Rightarrow> fqn \<Rightarrow> ctxcld_opt \<Rightarrow> bool"
 where
 (* defn find_cld *)
 
 fc_emptyI: "find_cld (  []  ) (ctx) (fqn) ( None )"
 
 | fc_cons_trueI: "\<lbrakk> P  =    ([(cld)] @ cld_list)    ;
  cld  =  (cld_def dcl cl fds meth_defs) \<rbrakk> \<Longrightarrow>
 find_cld (P) (ctx) ((fqn_def dcl)) ( (Some (  ( ctx , cld )  )) )"
 
 | fc_cons_falseI: "\<lbrakk> cld  =  (cld_def dcl' cl fds meth_defs)  ;
  (cl_fqn (fqn_def dcl))  \<noteq>  (cl_fqn (fqn_def dcl'))  ;
 find_cld (  (cld_list)  ) (ctx) ((fqn_def dcl)) (ctxcld_opt)\<rbrakk> \<Longrightarrow>
 find_cld (  ([(cld)] @ cld_list)  ) (ctx) ((fqn_def dcl)) (ctxcld_opt)"
 
 (*defns find_type_def *)
 inductive find_type :: "P \<Rightarrow> ctx \<Rightarrow> cl \<Rightarrow> ty_opt \<Rightarrow> bool"
 where
 (* defn find_type *)
 
 ft_objI: "find_type (P) (ctx) (cl_object) ( (Some ( ty_top )) )"
 
 | ft_nullI: "\<lbrakk>find_cld (P) (ctx) (fqn) ( None )\<rbrakk> \<Longrightarrow>
 find_type (P) (ctx) ((cl_fqn fqn)) ( None )"
 
 | ft_dclI: "\<lbrakk>find_cld (P) (ctx) ((fqn_def dcl)) ( (Some (  ( ctx' , cld )  )) )\<rbrakk> \<Longrightarrow>
 find_type (P) (ctx) ((cl_fqn (fqn_def dcl))) ( (Some ( (ty_def ctx' dcl) )) )"
 
 (*defns path_length_def *)
 inductive path_length :: "P \<Rightarrow> ctx \<Rightarrow> cl \<Rightarrow> nn \<Rightarrow> bool"
 where
 (* defn path_length *)
 
 pl_objI: "path_length (P) (ctx) (cl_object) ( 0 )"
 
 | pl_fqnI: "\<lbrakk>find_cld (P) (ctx) (fqn) ( (Some (  ( ctx' , cld )  )) ) ;
 superclass_name (cld) (cl) ;
 path_length (P) (ctx') (cl) (nn)\<rbrakk> \<Longrightarrow>
 path_length (P) (ctx) ((cl_fqn fqn)) ( ( nn +  1  ) )"
 
 (*defns acyclic_clds_def *)
 inductive acyclic_clds :: "P \<Rightarrow> bool"
 where
 (* defn acyclic_clds *)
 
 ac_defI: "\<lbrakk> \<forall>  ctx   fqn .   (    (  (\<exists>  ctx'   cld  .  find_cld (P) (ctx) (fqn) ( (Some (  ( ctx' , cld )  )) ) )  )   \<longrightarrow>     (\<exists>  nn  .  path_length (P) (ctx) ((cl_fqn fqn)) (nn) )      )  \<rbrakk> \<Longrightarrow>
 acyclic_clds (P)"
 
 (*defns find_path_rec_def *)
 inductive find_path_rec :: "P \<Rightarrow> ctx \<Rightarrow> cl \<Rightarrow> ctxclds \<Rightarrow> ctxclds_opt \<Rightarrow> bool"
 where
 (* defn find_path_rec *)
 
 fpr_objI: "find_path_rec (P) (ctx) (cl_object) (ctxclds) ( Some ( ctxclds ) )"
 
 | fpr_nullI: "\<lbrakk>  (  \<not> ( acyclic_clds (P) )  )   \<or>  find_cld (P) (ctx) (fqn) ( None ) \<rbrakk> \<Longrightarrow>
 find_path_rec (P) (ctx) ((cl_fqn fqn)) (ctxclds) ( None )"
 
 | fpr_fqnI: "\<lbrakk> acyclic_clds (P)  \<and>  find_cld (P) (ctx) (fqn) ( (Some (  ( ctx' , cld )  )) )  ;
 superclass_name (cld) (cl) ;
 find_path_rec (P) (ctx') (cl) ( ctxclds @[   ( ctx' , cld )   ] ) (ctxclds_opt)\<rbrakk> \<Longrightarrow>
 find_path_rec (P) (ctx) ((cl_fqn fqn)) (ctxclds) (ctxclds_opt)"
 
 (*defns find_path_def *)
 inductive find_path :: "P \<Rightarrow> ctx \<Rightarrow> cl \<Rightarrow> ctxclds_opt \<Rightarrow> bool"
 where
 (* defn find_path *)
 
 fp_defI: "\<lbrakk>find_path_rec (P) (ctx) (cl) ( [] ) (ctxclds_opt)\<rbrakk> \<Longrightarrow>
 find_path (P) (ctx) (cl) (ctxclds_opt)"
 
 (*defns find_path_ty_def *)
 inductive find_path_ty :: "P \<Rightarrow> ty \<Rightarrow> ctxclds_opt \<Rightarrow> bool"
 where
 (* defn find_path_ty *)
 
 fpty_objI: "find_path_ty (P) (ty_top) ( Some (  []  ) )"
 
 | fpty_dclI: "\<lbrakk>find_path (P) (ctx) ((cl_fqn (fqn_def dcl))) (ctxclds_opt)\<rbrakk> \<Longrightarrow>
 find_path_ty (P) ((ty_def ctx dcl)) (ctxclds_opt)"
 
 (*defns fields_in_path_def *)
 inductive fields_in_path :: "ctxclds \<Rightarrow> fs \<Rightarrow> bool"
 where
 (* defn fields_in_path *)
 
 fip_emptyI: "fields_in_path ( [] ) ( [] )"
 
 | fip_consI: "\<lbrakk>class_fields (cld) ( ((List.map (%((cl_XXX::cl),(f_XXX::f)).(fd_def cl_XXX f_XXX)) cl_f_list)) ) ;
 fields_in_path ( (ctxcld_list) ) (fs) ;
  fs'  =   (  ((List.map (%((cl_XXX::cl),(f_XXX::f)).f_XXX) cl_f_list))  @ fs )  \<rbrakk> \<Longrightarrow>
 fields_in_path ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (fs')"
 
 (*defns fields_def *)
 inductive fields :: "P \<Rightarrow> ty \<Rightarrow> fs_opt \<Rightarrow> bool"
 where
 (* defn fields *)
 
 fields_noneI: "\<lbrakk>find_path_ty (P) (ty) ( None )\<rbrakk> \<Longrightarrow>
 fields (P) (ty) ( None )"
 
 | fields_someI: "\<lbrakk>find_path_ty (P) (ty) ( Some ( ctxclds ) ) ;
 fields_in_path (ctxclds) (fs)\<rbrakk> \<Longrightarrow>
 fields (P) (ty) ( Some ( fs ) )"
 
 (*defns methods_in_path_def *)
 inductive methods_in_path :: "clds \<Rightarrow> meths \<Rightarrow> bool"
 where
 (* defn methods_in_path *)
 
 mip_emptyI: "methods_in_path ( [] ) ( [] )"
 
 | mip_consI: "\<lbrakk>class_methods (cld) ( ((List.map (%((meth_def_XXX::meth_def),(cl_XXX::cl),(meth_XXX::meth),(vds_XXX::vds),(meth_body_XXX::meth_body)).meth_def_XXX) meth_def_cl_meth_vds_meth_body_list)) ) ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_def_XXX::meth_def),(cl_XXX::cl),(meth_XXX::meth),(vds_XXX::vds),(meth_body_XXX::meth_body)). meth_def_XXX  =  (meth_def_def (meth_sig_def cl_XXX meth_XXX vds_XXX) meth_body_XXX) ) meth_def_cl_meth_vds_meth_body_list))  ;
 methods_in_path ( (cld_list) ) (meths') ;
  meths  =   (  ((List.map (%((meth_def_XXX::meth_def),(cl_XXX::cl),(meth_XXX::meth),(vds_XXX::vds),(meth_body_XXX::meth_body)).meth_XXX) meth_def_cl_meth_vds_meth_body_list))  @ meths' )  \<rbrakk> \<Longrightarrow>
 methods_in_path ( ([(cld)] @ cld_list) ) (meths)"
 
 (*defns methods_def *)
 inductive methods :: "P \<Rightarrow> ty \<Rightarrow> meths \<Rightarrow> bool"
 where
 (* defn methods *)
 
 methods_methodsI: "\<lbrakk>find_path_ty (P) (ty) ( Some (  ((List.map (%((ctx_XXX::ctx),(cld_XXX::cld)). ( ctx_XXX , cld_XXX ) ) ctx_cld_list))  ) ) ;
 methods_in_path ( ((List.map (%((ctx_XXX::ctx),(cld_XXX::cld)).cld_XXX) ctx_cld_list)) ) (meths)\<rbrakk> \<Longrightarrow>
 methods (P) (ty) (meths)"
 
 (*defns ftype_in_fds_def *)
 inductive ftype_in_fds :: "P \<Rightarrow> ctx \<Rightarrow> fds \<Rightarrow> f \<Rightarrow> ty_opt_bot \<Rightarrow> bool"
 where
 (* defn ftype_in_fds *)
 
 ftif_emptyI: "ftype_in_fds (P) (ctx) ( [] ) (f) ((ty_opt_bot_opt  None ))"
 
 | ftif_cons_botI: "\<lbrakk>find_type (P) (ctx) (cl) ( None )\<rbrakk> \<Longrightarrow>
 ftype_in_fds (P) (ctx) ( ([((fd_def cl f))] @ fd_list) ) (f) (ty_opt_bot_bot)"
 
 | ftif_cons_trueI: "\<lbrakk>find_type (P) (ctx) (cl) ( (Some ( ty )) )\<rbrakk> \<Longrightarrow>
 ftype_in_fds (P) (ctx) ( ([((fd_def cl f))] @ fd_list) ) (f) ((ty_opt_bot_opt  (Some ( ty )) ))"
 
 | ftif_cons_falseI: "\<lbrakk> f  \<noteq>  f'  ;
 ftype_in_fds (P) (ctx) ( (fd_list) ) (f') (ty_opt_bot)\<rbrakk> \<Longrightarrow>
 ftype_in_fds (P) (ctx) ( ([((fd_def cl f))] @ fd_list) ) (f') (ty_opt_bot)"
 
 (*defns ftype_in_path_def *)
 inductive ftype_in_path :: "P \<Rightarrow> ctxclds \<Rightarrow> f \<Rightarrow> ty_opt \<Rightarrow> bool"
 where
 (* defn ftype_in_path *)
 
 ftip_emptyI: "ftype_in_path (P) ( [] ) (f) ( None )"
 
 | ftip_cons_botI: "\<lbrakk>class_fields (cld) (fds) ;
 ftype_in_fds (P) (ctx) (fds) (f) (ty_opt_bot_bot)\<rbrakk> \<Longrightarrow>
 ftype_in_path (P) ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (f) ( None )"
 
 | ftip_cons_trueI: "\<lbrakk>class_fields (cld) (fds) ;
 ftype_in_fds (P) (ctx) (fds) (f) ((ty_opt_bot_opt  (Some ( ty )) ))\<rbrakk> \<Longrightarrow>
 ftype_in_path (P) ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (f) ( (Some ( ty )) )"
 
 | ftip_cons_falseI: "\<lbrakk>class_fields (cld) (fds) ;
 ftype_in_fds (P) (ctx) (fds) (f) ((ty_opt_bot_opt  None )) ;
 ftype_in_path (P) ( (ctxcld_list) ) (f) (ty_opt)\<rbrakk> \<Longrightarrow>
 ftype_in_path (P) ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (f) (ty_opt)"
 
 (*defns ftype_def *)
 inductive ftype :: "P \<Rightarrow> ty \<Rightarrow> f \<Rightarrow> ty \<Rightarrow> bool"
 where
 (* defn ftype *)
 
 ftypeI: "\<lbrakk>find_path_ty (P) (ty) ( Some ( ctxclds ) ) ;
 ftype_in_path (P) (ctxclds) (f) ( (Some ( ty' )) )\<rbrakk> \<Longrightarrow>
 ftype (P) (ty) (f) (ty')"
 
 (*defns find_meth_def_in_list_def *)
 inductive find_meth_def_in_list :: "meth_defs \<Rightarrow> meth \<Rightarrow> meth_def_opt \<Rightarrow> bool"
 where
 (* defn find_meth_def_in_list *)
 
 fmdil_emptyI: "find_meth_def_in_list ( [] ) (meth) ( None )"
 
 | fmdil_cons_trueI: "\<lbrakk> meth_def  =  (meth_def_def (meth_sig_def cl meth vds) meth_body) \<rbrakk> \<Longrightarrow>
 find_meth_def_in_list ( ([(meth_def)] @ meth_def_list) ) (meth) ( Some ( meth_def ) )"
 
 | fmdil_cons_falseI: "\<lbrakk> meth_def  =  (meth_def_def (meth_sig_def cl meth' vds) meth_body)  ;
  meth  \<noteq>  meth'  ;
 find_meth_def_in_list ( (meth_def_list) ) (meth) (meth_def_opt)\<rbrakk> \<Longrightarrow>
 find_meth_def_in_list ( ([(meth_def)] @ meth_def_list) ) (meth) (meth_def_opt)"
 
 (*defns find_meth_def_in_path_def *)
 inductive find_meth_def_in_path :: "ctxclds \<Rightarrow> meth \<Rightarrow> ctxmeth_def_opt \<Rightarrow> bool"
 where
 (* defn find_meth_def_in_path *)
 
 fmdip_emptyI: "find_meth_def_in_path ( [] ) (meth) ( (None::ctxmeth_def_opt) )"
 
 | fmdip_cons_trueI: "\<lbrakk>class_methods (cld) (meth_defs) ;
 find_meth_def_in_list (meth_defs) (meth) ( Some ( meth_def ) )\<rbrakk> \<Longrightarrow>
 find_meth_def_in_path ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (meth) ( (Some ( ctx , meth_def )::ctxmeth_def_opt) )"
 
 | fmdip_cons_falseI: "\<lbrakk>class_methods (cld) (meth_defs) ;
 find_meth_def_in_list (meth_defs) (meth) ( None ) ;
 find_meth_def_in_path ( (ctxcld_list) ) (meth) (ctxmeth_def_opt)\<rbrakk> \<Longrightarrow>
 find_meth_def_in_path ( ([( ( ctx , cld ) )] @ ctxcld_list) ) (meth) (ctxmeth_def_opt)"
 
 (*defns find_meth_def_def *)
 inductive find_meth_def :: "P \<Rightarrow> ty \<Rightarrow> meth \<Rightarrow> ctxmeth_def_opt \<Rightarrow> bool"
 where
 (* defn find_meth_def *)
 
 fmd_nullI: "\<lbrakk>find_path_ty (P) (ty) ( None )\<rbrakk> \<Longrightarrow>
 find_meth_def (P) (ty) (meth) ( (None::ctxmeth_def_opt) )"
 
 | fmd_optI: "\<lbrakk>find_path_ty (P) (ty) ( Some ( ctxclds ) ) ;
 find_meth_def_in_path (ctxclds) (meth) (ctxmeth_def_opt)\<rbrakk> \<Longrightarrow>
 find_meth_def (P) (ty) (meth) (ctxmeth_def_opt)"
 
 (*defns mtype_def *)
 inductive mtype :: "P \<Rightarrow> ty \<Rightarrow> meth \<Rightarrow> mty \<Rightarrow> bool"
 where
 (* defn mtype *)
 
 mtypeI: "\<lbrakk>find_meth_def (P) (ty) (meth) ( (Some ( ctx , meth_def )::ctxmeth_def_opt) ) ;
  meth_def  =  (meth_def_def (meth_sig_def cl meth  ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).(vd_def cl_XXX var_XXX)) cl_var_ty_list)) ) meth_body)  ;
 find_type (P) (ctx) (cl) ( (Some ( ty' )) ) ;
  list_all (\<lambda>f. f)  ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).find_type (P) (ctx) (cl_XXX) ( (Some ( ty_XXX )) )) cl_var_ty_list))  ;
  mty  =  (mty_def  ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).ty_XXX) cl_var_ty_list))  ty') \<rbrakk> \<Longrightarrow>
 mtype (P) (ty) (meth) (mty)"
 
 (*defns sty_one_def *)
 inductive sty_one :: "P \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"
 where
 (* defn one *)
 
 sty_objI: "\<lbrakk>find_path_ty (P) (ty) ( Some ( ctxclds ) )\<rbrakk> \<Longrightarrow>
 sty_one (P) (ty) (ty_top)"
 
 | sty_dclI: "\<lbrakk>find_path_ty (P) (ty) ( Some (  ((List.map (%((ctx_XXX::ctx),(cld_XXX::cld),(dcl_XXX::dcl)). ( ctx_XXX , cld_XXX ) ) ctx_cld_dcl_list))  ) ) ;
  list_all (\<lambda>f. f)  ((List.map (%((ctx_XXX::ctx),(cld_XXX::cld),(dcl_XXX::dcl)).class_name (cld_XXX) (dcl_XXX)) ctx_cld_dcl_list))  ;
  ( ctx' , dcl' ) \<in> set  ((List.map (%((ctx_XXX::ctx),(cld_XXX::cld),(dcl_XXX::dcl)).(ctx_XXX,dcl_XXX)) ctx_cld_dcl_list)) \<rbrakk> \<Longrightarrow>
 sty_one (P) (ty) ((ty_def ctx' dcl'))"
 
 (*defns sty_many_def *)
 inductive sty_many :: "P \<Rightarrow> tys \<Rightarrow> tys \<Rightarrow> bool"
 where
 (* defn many *)
 
 sty_manyI: "\<lbrakk> tys  =   ((List.map (%((ty_XXX::ty),(ty_'::ty)).ty_XXX) ty_ty'_list))   ;
  tys'  =   ((List.map (%((ty_XXX::ty),(ty_'::ty)).ty_') ty_ty'_list))   ;
  list_all (\<lambda>f. f)  ((List.map (%((ty_XXX::ty),(ty_'::ty)).sty_one (P) (ty_XXX) (ty_')) ty_ty'_list)) \<rbrakk> \<Longrightarrow>
 sty_many (P) (tys) (tys')"
 
 (*defns sty_option_def *)
 inductive sty_option :: "P \<Rightarrow> ty_opt \<Rightarrow> ty_opt \<Rightarrow> bool"
 where
 (* defn option *)
 
 sty_optionI: "\<lbrakk> ty_opt  =   (Some ( ty ))   ;
  ty_opt'  =   (Some ( ty' ))   ;
 sty_one (P) (ty) (ty')\<rbrakk> \<Longrightarrow>
 sty_option (P) (ty_opt) (ty_opt')"
 
 (*defns well_formedness *)
 inductive wf_object :: "P \<Rightarrow> H \<Rightarrow> v_opt \<Rightarrow> ty_opt \<Rightarrow> bool"
  and wf_varstate :: "P \<Rightarrow> \<Gamma> \<Rightarrow> H \<Rightarrow> L \<Rightarrow> bool"
  and wf_heap :: "P \<Rightarrow> H \<Rightarrow> bool"
  and wf_config :: "\<Gamma> \<Rightarrow> config \<Rightarrow> bool"
  and wf_stmt :: "P \<Rightarrow> \<Gamma> \<Rightarrow> s \<Rightarrow> bool"
  and wf_meth :: "P \<Rightarrow> ty \<Rightarrow> meth_def \<Rightarrow> bool"
  and wf_class_common :: "P \<Rightarrow> ctx \<Rightarrow> dcl \<Rightarrow> cl \<Rightarrow> fds \<Rightarrow> meth_defs \<Rightarrow> bool"
  and wf_class :: "P \<Rightarrow> cld \<Rightarrow> bool"
  and wf_program :: "P \<Rightarrow> bool"
 where
 (* defn object *)
 
 wf_nullI: "\<lbrakk> ty_opt  =   (Some ( ty ))  \<rbrakk> \<Longrightarrow>
 wf_object (P) (H) ( Some  v_null ) (ty_opt)"
 
 | wf_objectI: "\<lbrakk>sty_option (P) ( (case  H   oid  of
                      None \<Rightarrow> None
                    | Some tyfs \<Rightarrow> Some (fst tyfs)) ) (ty_opt)\<rbrakk> \<Longrightarrow>
 wf_object (P) (H) ( Some  (v_oid oid) ) (ty_opt)"
 
 | (* defn varstate *)
 
 wf_varstateI: "\<lbrakk> finite (dom ( L ))  ;
  \<forall>  x  \<in> dom  \<Gamma> .  wf_object (P) (H) ( L   x ) ( \<Gamma>   x ) \<rbrakk> \<Longrightarrow>
 wf_varstate (P) (\<Gamma>) (H) (L)"
 
 | (* defn heap *)
 
 wf_heapI: "\<lbrakk> finite (dom ( H ))  ;
  \<forall>  oid  \<in> dom  H .   (   \<exists>  ty  .     (case  H   oid  of
                      None \<Rightarrow> None
                    | Some tyfs \<Rightarrow> Some (fst tyfs))   =   (Some ( ty ))    \<and>   (\<exists>  fs  .   fields (P) (ty) ( Some ( fs ) )  \<and>     (\<forall>  f  \<in> set  fs .   \<exists>  ty'  .   (   ftype (P) (ty) (f) (ty')  \<and>   wf_object (P) (H) ( (case  H   oid  of
                      None \<Rightarrow> None
                    | Some tyfs \<Rightarrow> (snd tyfs)  f ) ) ( (Some ( ty' )) )    )   )     )     )  \<rbrakk> \<Longrightarrow>
 wf_heap (P) (H)"
 
 | (* defn config *)
 
 wf_all_exI: "\<lbrakk>wf_program (P) ;
 wf_heap (P) (H) ;
 wf_varstate (P) (\<Gamma>) (H) (L)\<rbrakk> \<Longrightarrow>
 wf_config (\<Gamma>) ((config_ex P L H Exception))"
 
 | wf_allI: "\<lbrakk>wf_program (P) ;
 wf_heap (P) (H) ;
 wf_varstate (P) (\<Gamma>) (H) (L) ;
  list_all (\<lambda>f. f)  ((List.map (%(s_XXX::s).wf_stmt (P) (\<Gamma>) (s_XXX)) s_list)) \<rbrakk> \<Longrightarrow>
 wf_config (\<Gamma>) ((config_normal P L H (s_list)))"
 
 | (* defn stmt *)
 
 wf_blockI: "\<lbrakk> list_all (\<lambda>f. f)  ((List.map (%(s_XXX::s).wf_stmt (P) (\<Gamma>) (s_XXX)) s_list)) \<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_block (s_list)))"
 
 | wf_var_assignI: "\<lbrakk>sty_option (P) ( \<Gamma>   x ) ( \<Gamma>   (x_var var) )\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_ass var x))"
 
 | wf_field_readI: "\<lbrakk>  \<Gamma>   x   =   (Some ( ty ))   ;
 ftype (P) (ty) (f) (ty') ;
 sty_option (P) ( (Some ( ty' )) ) ( \<Gamma>   (x_var var) )\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_read var x f))"
 
 | wf_field_writeI: "\<lbrakk>  \<Gamma>   x   =   (Some ( ty ))   ;
 ftype (P) (ty) (f) (ty') ;
 sty_option (P) ( \<Gamma>   y ) ( (Some ( ty' )) )\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_write x f y))"
 
 | wf_ifI: "\<lbrakk> sty_option (P) ( \<Gamma>   x ) ( \<Gamma>   y )  \<or>  sty_option (P) ( \<Gamma>   y ) ( \<Gamma>   x )  ;
 wf_stmt (P) (\<Gamma>) (s1) ;
 wf_stmt (P) (\<Gamma>) (s2)\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_if x y s1 s2))"
 
 | wf_newI: "\<lbrakk>find_type (P) (ctx) (cl) ( (Some ( ty )) ) ;
 sty_option (P) ( (Some ( ty )) ) ( \<Gamma>   (x_var var) )\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_new var ctx cl))"
 
 | wf_mcallI: "\<lbrakk> Y  =   ((List.map (%((y_XXX::x),(ty_XXX::ty)).y_XXX) y_ty_list))   ;
   \<Gamma>   x   =   (Some ( ty ))   ;
 mtype (P) (ty) (meth) ((mty_def  ((List.map (%((y_XXX::x),(ty_XXX::ty)).ty_XXX) y_ty_list))  ty')) ;
  list_all (\<lambda>f. f)  ((List.map (%((y_XXX::x),(ty_XXX::ty)).sty_option (P) ( \<Gamma>   y_XXX ) ( (Some ( ty_XXX )) )) y_ty_list))  ;
 sty_option (P) ( (Some ( ty' )) ) ( \<Gamma>   (x_var var) )\<rbrakk> \<Longrightarrow>
 wf_stmt (P) (\<Gamma>) ((s_call var x meth Y))"
 
 | (* defn meth *)
 
 wf_methodI: "\<lbrakk> distinct ( ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).var_XXX) cl_var_ty_list)) )  ;
  list_all (\<lambda>f. f)  ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).find_type (P) (ctx) (cl_XXX) ( (Some ( ty_XXX )) )) cl_var_ty_list))  ;
  \<Gamma>  =   (  (map_of ( ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).((x_var var_XXX),ty_XXX)) cl_var_ty_list)) ))   ( x_this   \<mapsto>   (ty_def ctx dcl) ))   ;
  list_all (\<lambda>f. f)  ((List.map (%(s_XXX::s).wf_stmt (P) (\<Gamma>) (s_XXX)) s_list))  ;
 find_type (P) (ctx) (cl) ( (Some ( ty )) ) ;
 sty_option (P) ( \<Gamma>   y ) ( (Some ( ty )) )\<rbrakk> \<Longrightarrow>
 wf_meth (P) ((ty_def ctx dcl)) ((meth_def_def (meth_sig_def cl meth  ((List.map (%((cl_XXX::cl),(var_XXX::var),(ty_XXX::ty)).(vd_def cl_XXX var_XXX)) cl_var_ty_list)) ) (meth_body_def (s_list) y)))"
 
 | (* defn class_common *)
 
 wf_class_commonI: "\<lbrakk>find_type (P) (ctx) (cl) ( (Some ( ty )) ) ;
  (ty_def ctx dcl)  \<noteq>  ty  ;
  distinct ( ((List.map (%((cl_XXX::cl),(f_XXX::f),(ty_XXX::ty)).f_XXX) cl_f_ty_list)) )  ;
 fields (P) (ty) ( Some ( fs ) ) ;
  (set   ((List.map (%((cl_XXX::cl),(f_XXX::f),(ty_XXX::ty)).f_XXX) cl_f_ty_list))  ) \<inter> (set  fs ) = {}  ;
  list_all (\<lambda>f. f)  ((List.map (%((cl_XXX::cl),(f_XXX::f),(ty_XXX::ty)).find_type (P) (ctx) (cl_XXX) ( (Some ( ty_XXX )) )) cl_f_ty_list))  ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_def_XXX::meth_def),(meth_XXX::meth)).wf_meth (P) ((ty_def ctx dcl)) (meth_def_XXX)) meth_def_meth_list))  ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_def_XXX::meth_def),(meth_XXX::meth)).method_name (meth_def_XXX) (meth_XXX)) meth_def_meth_list))  ;
  distinct ( ((List.map (%((meth_def_XXX::meth_def),(meth_XXX::meth)).meth_XXX) meth_def_meth_list)) )  ;
 methods (P) (ty) ( ((List.map (%((meth_'::meth),(mty_XXX::mty),(mty_'::mty)).meth_') meth'_mty_mty'_list)) ) ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_'::meth),(mty_XXX::mty),(mty_'::mty)).mtype (P) ((ty_def ctx dcl)) (meth_') (mty_XXX)) meth'_mty_mty'_list))  ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_'::meth),(mty_XXX::mty),(mty_'::mty)).mtype (P) (ty) (meth_') (mty_')) meth'_mty_mty'_list))  ;
  list_all (\<lambda>f. f)  ((List.map (%((meth_'::meth),(mty_XXX::mty),(mty_'::mty)).  meth_'  \<in> set   ((List.map (%((meth_def_XXX::meth_def),(meth_XXX::meth)).meth_XXX) meth_def_meth_list))    \<longrightarrow>   mty_XXX  =  mty_'  ) meth'_mty_mty'_list)) \<rbrakk> \<Longrightarrow>
 wf_class_common (P) (ctx) (dcl) (cl) ( ((List.map (%((cl_XXX::cl),(f_XXX::f),(ty_XXX::ty)).(fd_def cl_XXX f_XXX)) cl_f_ty_list)) ) ( ((List.map (%((meth_def_XXX::meth_def),(meth_XXX::meth)).meth_def_XXX) meth_def_meth_list)) )"
 
 | (* defn class *)
 
 wf_classI: "\<lbrakk> (cld_def dcl cl fds meth_defs)  \<in> set  P  ;
 wf_class_common (P) (ctx_def) (dcl) (cl) (fds) (meth_defs)\<rbrakk> \<Longrightarrow>
 wf_class (P) ((cld_def dcl cl fds meth_defs))"
 
 | (* defn program *)
 
 wf_programI: "\<lbrakk> P  =    (cld_list)    ;
 distinct_names (P) ;
  list_all (\<lambda>f. f)  ((List.map (%(cld_XXX::cld).wf_class (P) (cld_XXX)) cld_list))  ;
 acyclic_clds (P)\<rbrakk> \<Longrightarrow>
 wf_program (P)"
 
 (*defns var_trans *)
 inductive tr_s :: "T \<Rightarrow> s \<Rightarrow> s \<Rightarrow> bool"
 where
 (* defn tr_s *)
 
 tr_s_blockI: "\<lbrakk> list_all (\<lambda>f. f)  ((List.map (%((s_XXX::s),(s_'::s)).tr_s (T) (s_XXX) (s_')) s_s'_list)) \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_block ((List.map (%((s_XXX::s),(s_'::s)).s_XXX) s_s'_list)))) ((s_block ((List.map (%((s_XXX::s),(s_'::s)).s_') s_s'_list))))"
 
 | tr_s_var_assignI: "\<lbrakk> (case  T  (x_var  var ) of
                     None \<Rightarrow>  var  | Some x' \<Rightarrow>
                  (case x' of x_this \<Rightarrow>  var
                            | x_var var' \<Rightarrow> var')) =  var'  ;
  (case  T   x  of None \<Rightarrow>  x
                                     | Some x' \<Rightarrow> x') =  x' \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_ass var x)) ((s_ass var' x'))"
 
 | tr_s_field_readI: "\<lbrakk> (case  T  (x_var  var ) of
                     None \<Rightarrow>  var  | Some x' \<Rightarrow>
                  (case x' of x_this \<Rightarrow>  var
                            | x_var var' \<Rightarrow> var')) =  var'  ;
  (case  T   x  of None \<Rightarrow>  x
                                     | Some x' \<Rightarrow> x') =  x' \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_read var x f)) ((s_read var' x' f))"
 
 | tr_s_field_writeI: "\<lbrakk> (case  T   x  of None \<Rightarrow>  x
                                     | Some x' \<Rightarrow> x') =  x'  ;
  (case  T   y  of None \<Rightarrow>  y
                                     | Some x' \<Rightarrow> x') =  y' \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_write x f y)) ((s_write x' f y'))"
 
 | tr_s_ifI: "\<lbrakk> (case  T   x  of None \<Rightarrow>  x
                                     | Some x' \<Rightarrow> x') =  x'  ;
  (case  T   y  of None \<Rightarrow>  y
                                     | Some x' \<Rightarrow> x') =  y'  ;
 tr_s (T) (s1) (s1') ;
 tr_s (T) (s2) (s2')\<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_if x y s1 s2)) ((s_if x' y' s1' s2'))"
 
 | tr_s_newI: "\<lbrakk> (case  T  (x_var  var ) of
                     None \<Rightarrow>  var  | Some x' \<Rightarrow>
                  (case x' of x_this \<Rightarrow>  var
                            | x_var var' \<Rightarrow> var')) =  var' \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_new var ctx cl)) ((s_new var' ctx cl))"
 
 | tr_s_mcallI: "\<lbrakk> (case  T  (x_var  var ) of
                     None \<Rightarrow>  var  | Some x' \<Rightarrow>
                  (case x' of x_this \<Rightarrow>  var
                            | x_var var' \<Rightarrow> var')) =  var'  ;
  (case  T   x  of None \<Rightarrow>  x
                                     | Some x' \<Rightarrow> x') =  x'  ;
  list_all (\<lambda>f. f)  ((List.map (%((y_XXX::x),(y_'::x)). (case  T   y_XXX  of None \<Rightarrow>  y_XXX
                                     | Some x' \<Rightarrow> x') =  y_' ) y_y'_list)) \<rbrakk> \<Longrightarrow>
 tr_s (T) ((s_call var x meth  ((List.map (%((y_XXX::x),(y_'::x)).y_XXX) y_y'_list)) )) ((s_call var' x' meth  ((List.map (%((y_XXX::x),(y_'::x)).y_') y_y'_list)) ))"
 
 (*defns reduction *)
 inductive r_stmt :: "config \<Rightarrow> config \<Rightarrow> bool"
 where
 (* defn stmt *)
 
 r_blockI: "r_stmt ((config_normal P L H ([((s_block (s_list)))] @ s'_list))) ((config_normal P L H (s_list @ s'_list)))"
 
 | r_var_assignI: "\<lbrakk>  L   x   = Some  v \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_ass var x))] @ s_list))) ((config_normal P  ( L  ( (x_var var)   \<mapsto>   v ))  H (s_list)))"
 
 | r_field_read_npeI: "\<lbrakk>  L   x   = Some  v_null \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_read var x f))] @ s_list))) ((config_ex P L H ex_npe))"
 
 | r_field_readI: "\<lbrakk>  L   x   = Some  (v_oid oid)  ;
   (case  H   oid  of
                      None \<Rightarrow> None
                    | Some tyfs \<Rightarrow> (snd tyfs)  f )   = Some  v \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_read var x f))] @ s_list))) ((config_normal P  ( L  ( (x_var var)   \<mapsto>   v ))  H (s_list)))"
 
 | r_field_write_npeI: "\<lbrakk>  L   x   = Some  v_null \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_write x f y))] @ s_list))) ((config_ex P L H ex_npe))"
 
 | r_field_writeI: "\<lbrakk>  L   x   = Some  (v_oid oid)  ;
   L   y   = Some  v \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_write x f y))] @ s_list))) ((config_normal P L  (case  H   oid  of
                 None \<Rightarrow> arbitrary
               | Some tyfs \<Rightarrow>
                    (( H  ( oid   \<mapsto>
-                       (fst tyfs, snd tyfs ( f   \<mapsto>   v ))))::H))  (s_list)))"
+                       (fst tyfs, (snd tyfs) ( f   \<mapsto>   v ))))::H))  (s_list)))"
 
 | r_if_trueI: "\<lbrakk>  L   x   = Some  v  ;
   L   y   = Some  w  ;
  v  =  w \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_if x y s1 s2))] @ s'_list))) ((config_normal P L H ([(s1)] @ s'_list)))"
 
 | r_if_falseI: "\<lbrakk>  L   x   = Some  v  ;
   L   y   = Some  w  ;
  v  \<noteq>  w \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_if x y s1 s2))] @ s'_list))) ((config_normal P L H ([(s2)] @ s'_list)))"
 
 | r_newI: "\<lbrakk>find_type (P) (ctx) (cl) ( (Some ( ty )) ) ;
 fields (P) (ty) ( Some (  (f_list)  ) ) ;
  oid  \<notin> dom  H  ;
  H'  =   (( H  ( oid   \<mapsto>  ( ty ,
                           map_of  ((List.map (%(f_XXX::f).(f_XXX,v_null)) f_list))  )))::H)  \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_new var ctx cl))] @ s_list))) ((config_normal P  ( L  ( (x_var var)   \<mapsto>   (v_oid oid) ))  H' (s_list)))"
 
 | r_mcall_npeI: "\<lbrakk>  L   x   = Some  v_null \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_call var x meth  (y_list) ))] @ s_list))) ((config_ex P L H ex_npe))"
 
 | r_mcallI: "\<lbrakk>  L   x   = Some  (v_oid oid)  ;
   (case  H   oid  of
                      None \<Rightarrow> None
                    | Some tyfs \<Rightarrow> Some (fst tyfs))   =   (Some ( ty ))   ;
 find_meth_def (P) (ty) (meth) ( (Some ( ctx , (meth_def_def (meth_sig_def cl meth  ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).(vd_def cl_XXX var_XXX)) y_cl_var_var'_v_list)) ) (meth_body_def ((List.map (%((s_''::s),(s_'::s)).s_') s''_s'_list)) y)) )::ctxmeth_def_opt) ) ;
  (set  ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).(x_var var_')) y_cl_var_var'_v_list)) ) Int (dom  L ) = {}  ;
  distinct ( ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).var_') y_cl_var_var'_v_list)) )  ;
  x'  \<notin> dom  L  ;
  x'  \<notin> set  ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).(x_var var_')) y_cl_var_var'_v_list))  ;
  list_all (\<lambda>f. f)  ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).  L   y_XXX   = Some  v_XXX ) y_cl_var_var'_v_list))  ;
  L'  =   (  ( L  ++ (map_of ( ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).((x_var var_'),v_XXX)) y_cl_var_var'_v_list)) )))   ( x'   \<mapsto>   (v_oid oid) ))   ;
  T  =   (  (map_of ( ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).((x_var var_XXX),(x_var var_'))) y_cl_var_var'_v_list)) ))   ( x_this   \<mapsto>   x' ))   ;
  list_all (\<lambda>f. f)  ((List.map (%((s_''::s),(s_'::s)).tr_s (T) (s_') (s_'')) s''_s'_list))  ;
  (case  T   y  of None \<Rightarrow>  y
                                     | Some x' \<Rightarrow> x') =  y' \<rbrakk> \<Longrightarrow>
 r_stmt ((config_normal P L H ([((s_call var x meth  ((List.map (%((y_XXX::x),(cl_XXX::cl),(var_XXX::var),(var_'::var),(v_XXX::v)).y_XXX) y_cl_var_var'_v_list)) ))] @ s_list))) ((config_normal P L' H ((List.map (%((s_''::s),(s_'::s)).s_'') s''_s'_list) @ [((s_ass var y'))] @ s_list)))"
 
 
 
 end
diff --git a/thys/LightweightJava/Lightweight_Java_Proof.thy b/thys/LightweightJava/Lightweight_Java_Proof.thy
--- a/thys/LightweightJava/Lightweight_Java_Proof.thy
+++ b/thys/LightweightJava/Lightweight_Java_Proof.thy
@@ -1,1819 +1,1819 @@
 (*  Title:       Lightweight Java, the proof
     Authors:     Rok Strnisa <rok@strnisa.com>, 2006
                  Matthew Parkinson <matt@matthewp.com>, 2006
     Maintainer:  
 *)
 
 theory Lightweight_Java_Proof
 imports Lightweight_Java_Equivalence "HOL-Library.Infinite_Set"
 begin
 
 lemmas wf_intros = wf_object_wf_varstate_wf_heap_wf_config_wf_stmt_wf_meth_wf_class_common_wf_class_wf_program.intros [simplified]
 lemmas wf_induct = wf_object_wf_varstate_wf_heap_wf_config_wf_stmt_wf_meth_wf_class_common_wf_class_wf_program.induct [simplified]
 lemmas wf_config_normalI = wf_object_wf_varstate_wf_heap_wf_config_wf_stmt_wf_meth_wf_class_common_wf_class_wf_program.wf_allI [simplified]
 lemmas wf_objectE   = wf_object.cases[simplified]
 lemmas wf_varstateE = wf_varstate.cases[simplified]
 lemmas wf_heapE     = wf_heap.cases[simplified]
 lemmas wf_configE   = wf_config.cases[simplified]
 lemmas wf_stmtE     = wf_stmt.cases[simplified]
 lemmas wf_methE     = wf_meth.cases[simplified]
 lemmas wf_class_cE  = wf_class_common.cases[simplified]
 lemmas wf_classE    = wf_class.cases[simplified]
 lemmas wf_programE  = wf_program.cases[simplified]
 
 lemma wf_subvarstateI:
   "\<lbrakk>wf_varstate P \<Gamma> H L; \<Gamma> x' = Some ty;
     wf_object P H (Some v) (Some ty)\<rbrakk>
         \<Longrightarrow> wf_varstate P \<Gamma> H (L (x' \<mapsto> v))"
 apply(erule wf_varstateE) apply(rule wf_varstateI) apply(simp) apply(clarsimp)
 done
 
 lemma finite_super_varstate:
   "finite (dom ((L ++ map_of (map (\<lambda>(y, cl, var, var', y). (x_var var', y)) y_cl_var_var'_v_list))(x' \<mapsto> v_oid oid))) = finite (dom L)"
 apply(induct y_cl_var_var'_v_list)
  apply(clarsimp) apply(simp add: dom_def)
  apply(subgoal_tac "{a. a \<noteq> x' \<longrightarrow> (\<exists>y. L a = Some y)} = {a. a = x' \<or> (\<exists>y. L a = Some y)}")
  apply(simp add: Collect_disj_eq) apply(force)
 apply(clarsimp simp add: map_add_def dom_def split: if_split_asm)
 apply(subgoal_tac "{aa. aa \<noteq> x_var a \<longrightarrow> aa \<noteq> x' \<longrightarrow> (\<exists>y. case_option (L aa) Some (map_of (map (\<lambda>(y, cl, var, var', y). (x_var var', y)) y_cl_var_var'_v_list) aa) = Some y)} =
                    {aa. aa = x_var a \<or> (aa = x' \<or> (\<exists>y. case_option (L aa) Some (map_of (map (\<lambda>(y, cl, var, var', y). (x_var var', y)) y_cl_var_var'_v_list) aa) = Some y))}")
 apply(simp add: Collect_disj_eq) apply(force)
 done
 
 lemma fst_map_elem:
   "(y_k, ty_k, var_k, var'_k, v_k) \<in> set y_ty_var_var'_v_list \<Longrightarrow>
       x_var var'_k \<in> fst ` (\<lambda>(y, ty, var, var', v). (x_var var', ty)) ` set y_ty_var_var'_v_list"
 by (force)
 
 lemma map_add_x_var[THEN mp]:
   "var' \<in> set (map (\<lambda>(y, cl, var, var', v). var) y_cl_var_var'_v_list) \<longrightarrow>
    x_var var' \<in> set (map (\<lambda>(y, cl, var, var', v). x_var var) y_cl_var_var'_v_list)"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma map_of_map_and_x[simp]:
   "\<lbrakk>\<Gamma> x = Some ty_x; L x' = None; \<forall>x\<in>set y_cl_var_var'_v_list. (\<lambda>(y, cl, var, var', v). L (x_var var') = None) x;
     \<forall>x\<in>Map.dom \<Gamma>. wf_object Pa H (L x) (\<Gamma> x)\<rbrakk> \<Longrightarrow>
       (if x = x' then Some ty
        else (\<Gamma> ++ map_of (map (\<lambda>((y, cl, var, var', v), y', ty). (x_var var', ty)) (zip y_cl_var_var'_v_list y_ty_list))) x) =
           Some ty_x"
 apply(subgoal_tac "x \<noteq> x'") apply(subgoal_tac "\<forall>(y, cl, var, var', v) \<in> set y_cl_var_var'_v_list. x_var var' \<noteq> x")
   apply(case_tac "map_of (map (\<lambda>((y, cl, var, var', v), y', ty). (x_var var', ty)) (zip y_cl_var_var'_v_list y_ty_list)) x")
    apply(clarsimp simp add: map_add_def)
   apply(clarsimp) apply(drule map_of_SomeD) apply(clarsimp) apply(rename_tac y cl var var' v y' ty)
   apply(drule_tac x = "(y, cl, var, var', v)" in bspec) apply(force simp add: set_zip)
   apply(drule_tac x = "x_var var'" in bspec, simp add: domI) apply(erule wf_objectE, simp+)
  apply(force elim: wf_objectE)+
 done
 
 lemma wf_stmt_in_G':
    "(L x' = None \<and> (\<forall>x\<in>set y_cl_var_var'_v_list. (\<lambda>(y, cl, var, var', v). L (x_var var') = None) x)
     \<and> (\<forall>x\<in>dom \<Gamma>. wf_object P H (L x) (\<Gamma> x)) \<and> wf_stmt P \<Gamma> s \<longrightarrow>
        wf_stmt P ((\<Gamma> ++ map_of (map (\<lambda>((y, cl, var, var', v), y', y). (x_var var', y)) (zip y_cl_var_var'_v_list y_ty_list)))(x' \<mapsto> ty)) s) \<and>
     (L x' = None \<and> (\<forall>x\<in>set y_cl_var_var'_v_list. (\<lambda>(y, cl, var, var', v). L (x_var var') = None) x)
     \<and> (\<forall>x\<in>dom \<Gamma>. wf_object P H (L x) (\<Gamma> x)) \<and> (\<forall>s\<in>set ss. wf_stmt P \<Gamma> s) \<longrightarrow>
        (\<forall>s\<in>set ss. wf_stmt P ((\<Gamma> ++ map_of (map (\<lambda>((y, cl, var, var', v), y', y). (x_var var', y)) (zip y_cl_var_var'_v_list y_ty_list)))(x' \<mapsto> ty)) s))"
 apply(rule tr_s_f_tr_ss_f.induct)
 
 apply(clarsimp, erule wf_stmtE, simp_all, simp add: wf_blockI)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(erule sty_option.cases, force intro: wf_var_assignI sty_optionI)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(erule sty_option.cases, force intro: wf_field_readI sty_optionI)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(erule sty_option.cases, force intro: wf_field_writeI sty_optionI)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(clarsimp)
 apply(rule wf_ifI)
   apply(erule disjE)
    apply(rule disjI1, erule sty_option.cases, force intro: sty_optionI)
   apply(rule disjI2, erule sty_option.cases, force intro: sty_optionI)
  apply(assumption+)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(erule sty_option.cases, force intro: wf_newI sty_optionI)
 
 apply(clarify, erule wf_stmtE, simp_all)
 apply(rule wf_mcallI, simp, simp, simp)
  apply(clarsimp split del: if_split) apply(rename_tac y_k ty_k)
  apply(drule_tac x = "(y_k, ty_k)" in bspec, simp, clarify)
  apply(erule_tac ?a3.0 = "Some ty_k" in sty_option.cases)
  apply(force intro: sty_optionI)
 apply(clarify)
 apply(erule sty_option.cases)
 apply(rule sty_optionI, simp+)
 
 done
 
 lemma map_three_in_four:
   "var_k \<in> set (map (\<lambda>(y, cl, var, u). var) y_cl_var_var'_v_list)
    \<longrightarrow> (\<exists>y cl u. (y, cl, var_k, u) \<in> set y_cl_var_var'_v_list)"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma map_var:
   "\<lbrakk>(cl_k, var_k, ty_k) \<in> set cl_var_ty_list;
     map (\<lambda>(y, cl, var, u). var) y_cl_var_var'_v_list = map (\<lambda>(cl, var, ty). var) cl_var_ty_list\<rbrakk>
       \<Longrightarrow> \<exists>y_k cl'_k u_k. (y_k, cl'_k, var_k, u_k) \<in> set y_cl_var_var'_v_list"
 apply(subgoal_tac "var_k \<in> set (map (\<lambda>(y, cl, var, u). var) y_cl_var_var'_v_list)")
 by (force simp add: map_three_in_four)+
 
 lemma length_one_in_two:
   "length y_ty_list = length (map fst y_ty_list)"
 by (induct y_ty_list, auto)
 
 lemma length_two_in_two:
   "length y_ty_list = length (map snd y_ty_list)"
 by (induct y_ty_list, auto)
 
 lemma length_two_in_three:
   "length cl_var_ty_list = length (map (\<lambda>(cl, var, ty). var) cl_var_ty_list)"
 by (induct cl_var_ty_list, auto)
 
 lemma length_three_in_three:
   "length cl_var_ty_list = length (map (\<lambda>(cl, var, ty). ty) cl_var_ty_list)"
 by (induct cl_var_ty_list, auto)
 
 lemma length_three_in_four:
   "length y_cl_var_var'_v_list = length (map (\<lambda>(y, cl, var, u). var) y_cl_var_var'_v_list)"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma length_one_in_five:
   "length y_cl_var_var'_v_list = length (map (\<lambda>(y, cl, var, var', v). y) y_cl_var_var'_v_list)"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma length_three_in_five:
   "length y_cl_var_var'_v_list = length (map (\<lambda>(y, cl, var, var', v). var) y_cl_var_var'_v_list)"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma map_length_list:
   "length (map (\<lambda>((y, y'), yy, ty). (y', ty)) list) = length list"
 by (induct list, auto)
 
 lemma map_length_y:
   "map (\<lambda>(y, cl, var, var', v). y) y_cl_var_var'_v_list = map fst y_ty_list \<Longrightarrow>
    length y_cl_var_var'_v_list = length y_ty_list"
 by (simp only: length_one_in_five length_one_in_two)
 
 lemma map_length_y':
   "map fst y_y'_list = map fst y_ty_list \<Longrightarrow> length y_y'_list = length y_ty_list"
 by (simp only: length_one_in_two length_two_in_two)
 
 lemma map_length_var:
   "map (\<lambda>(y, cl, var, var', v). var) y_cl_var_var'_v_list = map (\<lambda>(cl, var, ty). var) cl_var_ty_list \<Longrightarrow>
    length y_cl_var_var'_v_list = length cl_var_ty_list"
 by (simp only: length_three_in_five length_two_in_three)
 
 lemma map_length_ty:
   "map (\<lambda>(cl, var, ty). ty) cl_var_ty_list = map snd y_ty_list \<Longrightarrow>
    length cl_var_ty_list = length y_ty_list"
 by (simp only: length_three_in_three length_two_in_two)
 
 lemma map_length_var_ty:
   "\<lbrakk>map (\<lambda>(y, cl, var, u). var) y_cl_var_var'_v_list = map (\<lambda>(cl, var, ty). var) cl_var_ty_list;
     map (\<lambda>(cl, var, ty). ty) cl_var_ty_list = map snd y_ty_list\<rbrakk> \<Longrightarrow>
    length y_cl_var_var'_v_list = length y_ty_list"
 apply(rule_tac s = "length cl_var_ty_list" in trans)
 apply (simp only: length_three_in_four length_two_in_three)
 apply(simp only: length_three_in_three length_two_in_two)
 done
 
 lemma fun_eq_fst:
   "(fst \<circ> (\<lambda>((y, cl, var, var', v), y', y). (x_var var', y))) = (\<lambda>((y, cl, var, var', v), y', y). (x_var var'))"
 by (simp add: fun_eq_iff)
 
 lemma fst_zip_eq:
   "length y_cl_var_var'_v_list = length y_ty_list \<Longrightarrow>
    (map fst (map (\<lambda>((y, cl, var, var', v), y', y). (x_var var', y)) (zip y_cl_var_var'_v_list y_ty_list))) =
    (map (\<lambda>(y, cl, var, var', v). x_var var') y_cl_var_var'_v_list)"
 apply(simp)
 apply(simp add: fun_eq_fst)
 apply(rule nth_equalityI)
  apply(force)
 apply(clarsimp)
 apply(frule nth_mem)
 apply(subgoal_tac "\<exists>x. (y_cl_var_var'_v_list ! i) = x")
 apply(force)
 apply(rule_tac x = "y_cl_var_var'_v_list ! i" in exI)
 apply(simp)
 done
 
 lemma distinct_x_var:
   "distinct (map (\<lambda>(y, cl, var, var', v). x_var var) y_cl_var_var'_v_list) =
    distinct (map (\<lambda>(y, cl, var, var', v). var) y_cl_var_var'_v_list)"
 apply (induct y_cl_var_var'_v_list)
 by (force simp add: contrapos_np)+
 
 lemma distinct_x_var':
   "distinct (map (\<lambda>(y, cl, var, var', v). x_var var') y_cl_var_var'_v_list) =
    distinct (map (\<lambda>(y, cl, var, var', v). var') y_cl_var_var'_v_list)"
 apply(induct y_cl_var_var'_v_list)
 by (force simp add: contrapos_np)+
 
 lemma map_fst_two:
   "map fst (map (\<lambda>(y, cl, var, var', v). (x_var var, x_var var')) y_cl_var_var'_v_list) =
    map (\<lambda>(y, cl, var, var', v). x_var var) y_cl_var_var'_v_list"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma map_fst_two':
   "map fst (map (\<lambda>(y, cl, var, var', y). (x_var var', y)) y_cl_var_var'_v_list) =
    map (\<lambda>(y, cl, var, var', y). x_var var') y_cl_var_var'_v_list"
 by (induct y_cl_var_var'_v_list, auto)
 
 lemma map_fst_var':
   "distinct (map fst (map (\<lambda>(y, cl, var, var', y). (x_v