(*  Title:      HOL/Bali/Evaln.thy
    Author:     David von Oheimb and Norbert Schirmer
*)
subsection {* Operational evaluation (big-step) semantics of Java expressions and
          statements
*}

theory Evaln imports TypeSafe begin

text {*
Variant of @{term eval} relation with counter for bounded recursive depth.
In principal @{term evaln} could replace @{term eval}.

Validity of the axiomatic semantics builds on @{term evaln}.
For recursive method calls the axiomatic semantics rule assumes the method ok
to derive a proof for the body. To prove the method rule sound we need to
perform induction on the recursion depth.
For the completeness proof of the axiomatic semantics the notion of the most
general formula is used. The most general formula right now builds on the
ordinary evaluation relation @{term eval}.
So sometimes we have to switch between @{term evaln} and @{term eval} and vice
versa. To make
this switch easy @{term evaln} also does all the technical accessibility tests
@{term check_field_access} and @{term check_method_access} like @{term eval}.
If it would omit them @{term evaln} and @{term eval} would only be equivalent
for welltyped, and definitely assigned terms.
*}

inductive
  evaln :: "[prog, state, term, nat, vals, state] \<Rightarrow> bool"
    ("_\<turnstile>_ \<midarrow>_\<succ>\<midarrow>_\<rightarrow> '(_, _')" [61,61,80,61,0,0] 60)
  and evarn :: "[prog, state, var, vvar, nat, state] \<Rightarrow> bool"
    ("_\<turnstile>_ \<midarrow>_=\<succ>_\<midarrow>_\<rightarrow> _" [61,61,90,61,61,61] 60)
  and eval_n:: "[prog, state, expr, val, nat, state] \<Rightarrow> bool"
    ("_\<turnstile>_ \<midarrow>_-\<succ>_\<midarrow>_\<rightarrow> _" [61,61,80,61,61,61] 60)
  and evalsn :: "[prog, state, expr list, val  list, nat, state] \<Rightarrow> bool"
    ("_\<turnstile>_ \<midarrow>_\<doteq>\<succ>_\<midarrow>_\<rightarrow> _" [61,61,61,61,61,61] 60)
  and execn     :: "[prog, state, stmt, nat, state] \<Rightarrow> bool"
    ("_\<turnstile>_ \<midarrow>_\<midarrow>_\<rightarrow> _"     [61,61,65,   61,61] 60)
  for G :: prog
where

  "G\<turnstile>s \<midarrow>c     \<midarrow>n\<rightarrow>    s' \<equiv> G\<turnstile>s \<midarrow>In1r  c\<succ>\<midarrow>n\<rightarrow> (\<diamondsuit>    ,  s')"
| "G\<turnstile>s \<midarrow>e-\<succ>v  \<midarrow>n\<rightarrow>    s' \<equiv> G\<turnstile>s \<midarrow>In1l e\<succ>\<midarrow>n\<rightarrow> (In1 v ,  s')"
| "G\<turnstile>s \<midarrow>e=\<succ>vf \<midarrow>n\<rightarrow>    s' \<equiv> G\<turnstile>s \<midarrow>In2  e\<succ>\<midarrow>n\<rightarrow> (In2 vf,  s')"
| "G\<turnstile>s \<midarrow>e\<doteq>\<succ>v  \<midarrow>n\<rightarrow>    s' \<equiv> G\<turnstile>s \<midarrow>In3  e\<succ>\<midarrow>n\<rightarrow> (In3 v ,  s')"

--{* propagation of abrupt completion *}

| Abrupt:   "G\<turnstile>(Some xc,s) \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (undefined3 t,(Some xc,s))"

--{* evaluation of variables *}

| LVar: "G\<turnstile>Norm s \<midarrow>LVar vn=\<succ>lvar vn s\<midarrow>n\<rightarrow> Norm s"

| FVar: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s2;
          (v,s2') = fvar statDeclC stat fn a s2;
          s3 = check_field_access G accC statDeclC fn stat a s2'\<rbrakk> \<Longrightarrow>
          G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>v\<midarrow>n\<rightarrow> s3"

| AVar: "\<lbrakk>G\<turnstile> Norm s0 \<midarrow>e1-\<succ>a\<midarrow>n\<rightarrow> s1 ; G\<turnstile>s1 \<midarrow>e2-\<succ>i\<midarrow>n\<rightarrow> s2;
          (v,s2') = avar G i a s2\<rbrakk> \<Longrightarrow>
                      G\<turnstile>Norm s0 \<midarrow>e1.[e2]=\<succ>v\<midarrow>n\<rightarrow> s2'"

--{* evaluation of expressions *}

| NewC: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1 \<midarrow>halloc (CInst C)\<succ>a\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                                  G\<turnstile>Norm s0 \<midarrow>NewC C-\<succ>Addr a\<midarrow>n\<rightarrow> s2"

| NewA: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>init_comp_ty T\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>e-\<succ>i'\<midarrow>n\<rightarrow> s2;
          G\<turnstile>abupd (check_neg i') s2 \<midarrow>halloc (Arr T (the_Intg i'))\<succ>a\<rightarrow> s3\<rbrakk> \<Longrightarrow>
                                G\<turnstile>Norm s0 \<midarrow>New T[e]-\<succ>Addr a\<midarrow>n\<rightarrow> s3"

| Cast: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1;
          s2 = abupd (raise_if (\<not>G,snd s1\<turnstile>v fits T) ClassCast) s1\<rbrakk> \<Longrightarrow>
                                G\<turnstile>Norm s0 \<midarrow>Cast T e-\<succ>v\<midarrow>n\<rightarrow> s2"

| Inst: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1;
          b = (v\<noteq>Null \<and> G,store s1\<turnstile>v fits RefT T)\<rbrakk> \<Longrightarrow>
                              G\<turnstile>Norm s0 \<midarrow>e InstOf T-\<succ>Bool b\<midarrow>n\<rightarrow> s1"

| Lit:                     "G\<turnstile>Norm s \<midarrow>Lit v-\<succ>v\<midarrow>n\<rightarrow> Norm s"

| UnOp: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1\<rbrakk>
         \<Longrightarrow> G\<turnstile>Norm s0 \<midarrow>UnOp unop e-\<succ>(eval_unop unop v)\<midarrow>n\<rightarrow> s1"

| BinOp: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e1-\<succ>v1\<midarrow>n\<rightarrow> s1;
           G\<turnstile>s1 \<midarrow>(if need_second_arg binop v1 then (In1l e2) else (In1r Skip))
            \<succ>\<midarrow>n\<rightarrow> (In1 v2,s2)\<rbrakk>
         \<Longrightarrow> G\<turnstile>Norm s0 \<midarrow>BinOp binop e1 e2-\<succ>(eval_binop binop v1 v2)\<midarrow>n\<rightarrow> s2"

| Super:                   "G\<turnstile>Norm s \<midarrow>Super-\<succ>val_this s\<midarrow>n\<rightarrow> Norm s"

| Acc:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>va=\<succ>(v,f)\<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
                                  G\<turnstile>Norm s0 \<midarrow>Acc va-\<succ>v\<midarrow>n\<rightarrow> s1"

| Ass:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>va=\<succ>(w,f)\<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1 \<midarrow>e-\<succ>v     \<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                                   G\<turnstile>Norm s0 \<midarrow>va:=e-\<succ>v\<midarrow>n\<rightarrow> assign f v s2"

| Cond: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                            G\<turnstile>Norm s0 \<midarrow>e0 ? e1 : e2-\<succ>v\<midarrow>n\<rightarrow> s2"

| Call:
  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s2;
    D = invocation_declclass G mode (store s2) a' statT \<lparr>name=mn,parTs=pTs\<rparr>;
    s3=init_lvars G D \<lparr>name=mn,parTs=pTs\<rparr> mode a' vs s2;
    s3' = check_method_access G accC statT mode \<lparr>name=mn,parTs=pTs\<rparr> a' s3;
    G\<turnstile>s3'\<midarrow>Methd D \<lparr>name=mn,parTs=pTs\<rparr>-\<succ>v\<midarrow>n\<rightarrow> s4
   \<rbrakk>
   \<Longrightarrow>
    G\<turnstile>Norm s0 \<midarrow>{accC,statT,mode}e\<cdot>mn({pTs}args)-\<succ>v\<midarrow>n\<rightarrow> (restore_lvars s2 s4)"

| Methd:"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
                                G\<turnstile>Norm s0 \<midarrow>Methd D sig-\<succ>v\<midarrow>Suc n\<rightarrow> s1"

| Body: "\<lbrakk>G\<turnstile>Norm s0\<midarrow>Init D\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>c\<midarrow>n\<rightarrow> s2;
          s3 = (if (\<exists> l. abrupt s2 = Some (Jump (Break l)) \<or>
                         abrupt s2 = Some (Jump (Cont l)))
                  then abupd (\<lambda> x. Some (Error CrossMethodJump)) s2
                  else s2)\<rbrakk>\<Longrightarrow>
         G\<turnstile>Norm s0 \<midarrow>Body D c
          -\<succ>the (locals (store s2) Result)\<midarrow>n\<rightarrow>abupd (absorb Ret) s3"

--{* evaluation of expression lists *}

| Nil:
                                "G\<turnstile>Norm s0 \<midarrow>[]\<doteq>\<succ>[]\<midarrow>n\<rightarrow> Norm s0"

| Cons: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e -\<succ> v \<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1 \<midarrow>es\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                             G\<turnstile>Norm s0 \<midarrow>e#es\<doteq>\<succ>v#vs\<midarrow>n\<rightarrow> s2"

--{* execution of statements *}

| Skip:                             "G\<turnstile>Norm s \<midarrow>Skip\<midarrow>n\<rightarrow> Norm s"

| Expr: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
                                  G\<turnstile>Norm s0 \<midarrow>Expr e\<midarrow>n\<rightarrow> s1"

| Lab:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c \<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
                             G\<turnstile>Norm s0 \<midarrow>l\<bullet> c\<midarrow>n\<rightarrow> abupd (absorb l) s1"

| Comp: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c1 \<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1 \<midarrow>c2 \<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                                 G\<turnstile>Norm s0 \<midarrow>c1;; c2\<midarrow>n\<rightarrow> s2"

| If:   "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n\<rightarrow> s1;
          G\<turnstile>     s1\<midarrow>(if the_Bool b then c1 else c2)\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
                       G\<turnstile>Norm s0 \<midarrow>If(e) c1 Else c2 \<midarrow>n\<rightarrow> s2"

| Loop: "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n\<rightarrow> s1;
          if the_Bool b
             then (G\<turnstile>s1 \<midarrow>c\<midarrow>n\<rightarrow> s2 \<and>
                   G\<turnstile>(abupd (absorb (Cont l)) s2) \<midarrow>l\<bullet> While(e) c\<midarrow>n\<rightarrow> s3)
             else s3 = s1\<rbrakk> \<Longrightarrow>
                              G\<turnstile>Norm s0 \<midarrow>l\<bullet> While(e) c\<midarrow>n\<rightarrow> s3"

| Jmp: "G\<turnstile>Norm s \<midarrow>Jmp j\<midarrow>n\<rightarrow> (Some (Jump j), s)"

| Throw:"\<lbrakk>G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<midarrow>n\<rightarrow> s1\<rbrakk> \<Longrightarrow>
                                 G\<turnstile>Norm s0 \<midarrow>Throw e\<midarrow>n\<rightarrow> abupd (throw a') s1"

| Try:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2;
          if G,s2\<turnstile>catch tn then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>n\<rightarrow> s3 else s3 = s2\<rbrakk>
          \<Longrightarrow>
                  G\<turnstile>Norm s0 \<midarrow>Try c1 Catch(tn vn) c2\<midarrow>n\<rightarrow> s3"

| Fin:  "\<lbrakk>G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n\<rightarrow> (x1,s1);
          G\<turnstile>Norm s1 \<midarrow>c2\<midarrow>n\<rightarrow> s2;
          s3=(if (\<exists> err. x1=Some (Error err))
              then (x1,s1)
              else abupd (abrupt_if (x1\<noteq>None) x1) s2)\<rbrakk> \<Longrightarrow>
              G\<turnstile>Norm s0 \<midarrow>c1 Finally c2\<midarrow>n\<rightarrow> s3"

| Init: "\<lbrakk>the (class G C) = c;
          if inited C (globs s0) then s3 = Norm s0
          else (G\<turnstile>Norm (init_class_obj G C s0)
                  \<midarrow>(if C = Object then Skip else Init (super c))\<midarrow>n\<rightarrow> s1 \<and>
                G\<turnstile>set_lvars empty s1 \<midarrow>init c\<midarrow>n\<rightarrow> s2 \<and>
                s3 = restore_lvars s1 s2)\<rbrakk>
          \<Longrightarrow>
                 G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s3"
monos
  if_bool_eq_conj

declare split_if     [split del] split_if_asm     [split del]
        option.split [split del] option.split_asm [split del]
        not_None_eq [simp del]
        split_paired_All [simp del] split_paired_Ex [simp del]
setup {* map_theory_simpset (fn ctxt => ctxt delloop "split_all_tac") *}

inductive_cases evaln_cases: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v, s')"

inductive_cases evaln_elim_cases:
        "G\<turnstile>(Some xc, s) \<midarrow>t                        \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1r Skip                      \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (Jmp j)                   \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> c)                    \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In3  ([])                      \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In3  (e#es)                    \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Lit w)                   \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (UnOp unop e)             \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (BinOp binop e1 e2)       \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In2  (LVar vn)                 \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Cast T e)                \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (e InstOf T)              \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Super)                   \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Acc va)                  \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (Expr e)                  \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (c1;; c2)                 \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Methd C sig)             \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Body D c)                \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (e0 ? e1 : e2)            \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (If(e) c1 Else c2)        \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (l\<bullet> While(e) c)           \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (c1 Finally c2)           \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (Throw e)                 \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (NewC C)                  \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (New T[e])                \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l (Ass va e)                \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (Try c1 Catch(tn vn) c2)  \<succ>\<midarrow>n\<rightarrow> (x, s')"
        "G\<turnstile>Norm s \<midarrow>In2  ({accC,statDeclC,stat}e..fn) \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In2  (e1.[e2])                 \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1l ({accC,statT,mode}e\<cdot>mn({pT}p)) \<succ>\<midarrow>n\<rightarrow> (v, s')"
        "G\<turnstile>Norm s \<midarrow>In1r (Init C)                  \<succ>\<midarrow>n\<rightarrow> (x, s')"

declare split_if     [split] split_if_asm     [split]
        option.split [split] option.split_asm [split]
        not_None_eq [simp]
        split_paired_All [simp] split_paired_Ex [simp]
declaration {* K (Simplifier.map_ss (fn ss => ss addloop ("split_all_tac", split_all_tac))) *}

lemma evaln_Inj_elim: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (w,s') \<Longrightarrow> case t of In1 ec \<Rightarrow>
  (case ec of Inl e \<Rightarrow> (\<exists>v. w = In1 v) | Inr c \<Rightarrow> w = \<diamondsuit>)
  | In2 e \<Rightarrow> (\<exists>v. w = In2 v) | In3 e \<Rightarrow> (\<exists>v. w = In3 v)"
apply (erule evaln_cases , auto)
apply (induct_tac "t")
apply   (rename_tac a, induct_tac "a")
apply auto
done

text {* The following simplification procedures set up the proper injections of
 terms and their corresponding values in the evaluation relation:
 E.g. an expression
 (injection @{term In1l} into terms) always evaluates to ordinary values
 (injection @{term In1} into generalised values @{term vals}).
*}

lemma evaln_expr_eq: "G\<turnstile>s \<midarrow>In1l t\<succ>\<midarrow>n\<rightarrow> (w, s') = (\<exists>v. w=In1 v \<and> G\<turnstile>s \<midarrow>t-\<succ>v \<midarrow>n\<rightarrow> s')"
  by (auto, frule evaln_Inj_elim, auto)

lemma evaln_var_eq: "G\<turnstile>s \<midarrow>In2 t\<succ>\<midarrow>n\<rightarrow> (w, s') = (\<exists>vf. w=In2 vf \<and> G\<turnstile>s \<midarrow>t=\<succ>vf\<midarrow>n\<rightarrow> s')"
  by (auto, frule evaln_Inj_elim, auto)

lemma evaln_exprs_eq: "G\<turnstile>s \<midarrow>In3 t\<succ>\<midarrow>n\<rightarrow> (w, s') = (\<exists>vs. w=In3 vs \<and> G\<turnstile>s \<midarrow>t\<doteq>\<succ>vs\<midarrow>n\<rightarrow> s')"
  by (auto, frule evaln_Inj_elim, auto)

lemma evaln_stmt_eq: "G\<turnstile>s \<midarrow>In1r t\<succ>\<midarrow>n\<rightarrow> (w, s') = (w=\<diamondsuit> \<and> G\<turnstile>s \<midarrow>t \<midarrow>n\<rightarrow> s')"
  by (auto, frule evaln_Inj_elim, auto, frule evaln_Inj_elim, auto)

simproc_setup evaln_expr ("G\<turnstile>s \<midarrow>In1l t\<succ>\<midarrow>n\<rightarrow> (w, s')") = {*
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      (_ $ _ $ _ $ _ $ _ $ (Const _ $ _) $ _) => NONE
    | _ => SOME (mk_meta_eq @{thm evaln_expr_eq})) *}

simproc_setup evaln_var ("G\<turnstile>s \<midarrow>In2 t\<succ>\<midarrow>n\<rightarrow> (w, s')") = {*
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      (_ $ _ $ _ $ _ $ _ $ (Const _ $ _) $ _) => NONE
    | _ => SOME (mk_meta_eq @{thm evaln_var_eq})) *}

simproc_setup evaln_exprs ("G\<turnstile>s \<midarrow>In3 t\<succ>\<midarrow>n\<rightarrow> (w, s')") = {*
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      (_ $ _ $ _ $ _ $ _ $ (Const _ $ _) $ _) => NONE
    | _ => SOME (mk_meta_eq @{thm evaln_exprs_eq})) *}

simproc_setup evaln_stmt ("G\<turnstile>s \<midarrow>In1r t\<succ>\<midarrow>n\<rightarrow> (w, s')") = {*
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      (_ $ _ $ _ $ _ $ _ $ (Const _ $ _) $ _) => NONE
    | _ => SOME (mk_meta_eq @{thm evaln_stmt_eq})) *}

ML {* ML_Thms.bind_thms ("evaln_AbruptIs", sum3_instantiate @{context} @{thm evaln.Abrupt}) *}
declare evaln_AbruptIs [intro!]

lemma evaln_Callee: "G\<turnstile>Norm s\<midarrow>In1l (Callee l e)\<succ>\<midarrow>n\<rightarrow> (v,s') = False"
proof -
  { fix s t v s'
    assume eval: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s')" and
         normal: "normal s" and
         callee: "t=In1l (Callee l e)"
    then have "False" by induct auto
  }
  then show ?thesis
    by (cases s') fastforce
qed

lemma evaln_InsInitE: "G\<turnstile>Norm s\<midarrow>In1l (InsInitE c e)\<succ>\<midarrow>n\<rightarrow> (v,s') = False"
proof -
  { fix s t v s'
    assume eval: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s')" and
         normal: "normal s" and
         callee: "t=In1l (InsInitE c e)"
    then have "False" by induct auto
  }
  then show ?thesis
    by (cases s') fastforce
qed

lemma evaln_InsInitV: "G\<turnstile>Norm s\<midarrow>In2 (InsInitV c w)\<succ>\<midarrow>n\<rightarrow> (v,s') = False"
proof -
  { fix s t v s'
    assume eval: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s')" and
         normal: "normal s" and
         callee: "t=In2 (InsInitV c w)"
    then have "False" by induct auto
  }
  then show ?thesis
    by (cases s') fastforce
qed

lemma evaln_FinA: "G\<turnstile>Norm s\<midarrow>In1r (FinA a c)\<succ>\<midarrow>n\<rightarrow> (v,s') = False"
proof -
  { fix s t v s'
    assume eval: "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s')" and
         normal: "normal s" and
         callee: "t=In1r (FinA a c)"
    then have "False" by induct auto
  }
  then show ?thesis
    by (cases s') fastforce
qed

lemma evaln_abrupt_lemma: "G\<turnstile>s \<midarrow>e\<succ>\<midarrow>n\<rightarrow> (v,s') \<Longrightarrow>
 fst s = Some xc \<longrightarrow> s' = s \<and> v = undefined3 e"
apply (erule evaln_cases , auto)
done

lemma evaln_abrupt:
 "\<And>s'. G\<turnstile>(Some xc,s) \<midarrow>e\<succ>\<midarrow>n\<rightarrow> (w,s') = (s' = (Some xc,s) \<and>
  w=undefined3 e \<and> G\<turnstile>(Some xc,s) \<midarrow>e\<succ>\<midarrow>n\<rightarrow> (undefined3 e,(Some xc,s)))"
apply auto
apply (frule evaln_abrupt_lemma, auto)+
done

simproc_setup evaln_abrupt ("G\<turnstile>(Some xc,s) \<midarrow>e\<succ>\<midarrow>n\<rightarrow> (w,s')") = {*
  fn _ => fn _ => fn ct =>
    (case Thm.term_of ct of
      (_ $ _ $ _ $ _ $ _ $ _ $ (Const (@{const_name Pair}, _) $ (Const (@{const_name Some},_) $ _)$ _))
        => NONE
    | _ => SOME (mk_meta_eq @{thm evaln_abrupt}))
*}

lemma evaln_LitI: "G\<turnstile>s \<midarrow>Lit v-\<succ>(if normal s then v else undefined)\<midarrow>n\<rightarrow> s"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.Lit)

lemma CondI:
 "\<And>s1. \<lbrakk>G\<turnstile>s \<midarrow>e-\<succ>b\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
  G\<turnstile>s \<midarrow>e ? e1 : e2-\<succ>(if normal s1 then v else undefined)\<midarrow>n\<rightarrow> s2"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.Cond)

lemma evaln_SkipI [intro!]: "G\<turnstile>s \<midarrow>Skip\<midarrow>n\<rightarrow> s"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.Skip)

lemma evaln_ExprI: "G\<turnstile>s \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s' \<Longrightarrow> G\<turnstile>s \<midarrow>Expr e\<midarrow>n\<rightarrow> s'"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.Expr)

lemma evaln_CompI: "\<lbrakk>G\<turnstile>s \<midarrow>c1\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>c2\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow> G\<turnstile>s \<midarrow>c1;; c2\<midarrow>n\<rightarrow> s2"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.Comp)

lemma evaln_IfI:
 "\<lbrakk>G\<turnstile>s \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1; G\<turnstile>s1 \<midarrow>(if the_Bool v then c1 else c2)\<midarrow>n\<rightarrow> s2\<rbrakk> \<Longrightarrow>
  G\<turnstile>s \<midarrow>If(e) c1 Else c2\<midarrow>n\<rightarrow> s2"
apply (case_tac "s", case_tac "a = None")
by (auto intro!: evaln.If)

lemma evaln_SkipD [dest!]: "G\<turnstile>s \<midarrow>Skip\<midarrow>n\<rightarrow> s' \<Longrightarrow> s' = s"
by (erule evaln_cases, auto)

lemma evaln_Skip_eq [simp]: "G\<turnstile>s \<midarrow>Skip\<midarrow>n\<rightarrow> s' = (s = s')"
apply auto
done

subsubsection {* evaln implies eval *}

lemma evaln_eval:
  assumes evaln: "G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)"
  shows "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)"
using evaln
proof (induct)
  case (Loop s0 e b n s1 c s2 l s3)
  note `G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<rightarrow> s1`
  moreover
  have "if the_Bool b
        then (G\<turnstile>s1 \<midarrow>c\<rightarrow> s2) \<and>
             G\<turnstile>abupd (absorb (Cont l)) s2 \<midarrow>l\<bullet> While(e) c\<rightarrow> s3
        else s3 = s1"
    using Loop.hyps by simp
  ultimately show ?case by (rule eval.Loop)
next
  case (Try s0 c1 n s1 s2 C vn c2 s3)
  note `G\<turnstile>Norm s0 \<midarrow>c1\<rightarrow> s1`
  moreover
  note `G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2`
  moreover
  have "if G,s2\<turnstile>catch C then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<rightarrow> s3 else s3 = s2"
    using Try.hyps by simp
  ultimately show ?case by (rule eval.Try)
next
  case (Init C c s0 s3 n s1 s2)
  note `the (class G C) = c`
  moreover
  have "if inited C (globs s0)
           then s3 = Norm s0
           else G\<turnstile>Norm ((init_class_obj G C) s0)
                  \<midarrow>(if C = Object then Skip else Init (super c))\<rightarrow> s1 \<and>
                G\<turnstile>(set_lvars empty) s1 \<midarrow>init c\<rightarrow> s2 \<and>
                s3 = (set_lvars (locals (store s1))) s2"
    using Init.hyps by simp
  ultimately show ?case by (rule eval.Init)
qed (rule eval.intros,(assumption+ | assumption?))+

lemma Suc_le_D_lemma: "\<lbrakk>Suc n <= m'; (\<And>m. n <= m \<Longrightarrow> P (Suc m)) \<rbrakk> \<Longrightarrow> P m'"
apply (frule Suc_le_D)
apply fast
done

lemma evaln_nonstrict [rule_format (no_asm), elim]:
  "G\<turnstile>s \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (w, s') \<Longrightarrow> \<forall>m. n\<le>m \<longrightarrow> G\<turnstile>s \<midarrow>t\<succ>\<midarrow>m\<rightarrow> (w, s')"
apply (erule evaln.induct)
apply (tactic {* ALLGOALS (EVERY'[strip_tac, TRY o etac @{thm Suc_le_D_lemma},
  REPEAT o smp_tac @{context} 1,
  resolve_tac @{thms evaln.intros} THEN_ALL_NEW TRY o atac]) *})
(* 3 subgoals *)
apply (auto split del: split_if)
done

lemmas evaln_nonstrict_Suc = evaln_nonstrict [OF _ le_refl [THEN le_SucI]]

lemma evaln_max2: "\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> (w1, s1'); G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> (w2, s2')\<rbrakk> \<Longrightarrow>
             G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max n1 n2\<rightarrow> (w1, s1') \<and> G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max n1 n2\<rightarrow> (w2, s2')"
by (fast intro: max.cobounded1 max.cobounded2)

corollary evaln_max2E [consumes 2]:
  "\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> (w1, s1'); G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> (w2, s2');
    \<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max n1 n2\<rightarrow> (w1, s1');G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max n1 n2\<rightarrow> (w2, s2') \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
by (drule (1) evaln_max2) simp

lemma evaln_max3:
"\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> (w1, s1'); G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> (w2, s2'); G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>n3\<rightarrow> (w3, s3')\<rbrakk> \<Longrightarrow>
 G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w1, s1') \<and>
 G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w2, s2') \<and>
 G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w3, s3')"
apply (drule (1) evaln_max2, erule thin_rl)
apply (fast intro!: max.cobounded1 max.cobounded2)
done

corollary evaln_max3E:
"\<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>n1\<rightarrow> (w1, s1'); G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>n2\<rightarrow> (w2, s2'); G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>n3\<rightarrow> (w3, s3');
   \<lbrakk>G\<turnstile>s1 \<midarrow>t1\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w1, s1');
    G\<turnstile>s2 \<midarrow>t2\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w2, s2');
    G\<turnstile>s3 \<midarrow>t3\<succ>\<midarrow>max (max n1 n2) n3\<rightarrow> (w3, s3')
   \<rbrakk> \<Longrightarrow> P
  \<rbrakk> \<Longrightarrow> P"
by (drule (2) evaln_max3) simp

lemma le_max3I1: "(n2::nat) \<le> max n1 (max n2 n3)"
proof -
  have "n2 \<le> max n2 n3"
    by (rule max.cobounded1)
  also
  have "max n2 n3 \<le> max n1 (max n2 n3)"
    by (rule max.cobounded2)
  finally
  show ?thesis .
qed

lemma le_max3I2: "(n3::nat) \<le> max n1 (max n2 n3)"
proof -
  have "n3 \<le> max n2 n3"
    by (rule max.cobounded2)
  also
  have "max n2 n3 \<le> max n1 (max n2 n3)"
    by (rule max.cobounded2)
  finally
  show ?thesis .
qed

declare [[simproc del: wt_expr wt_var wt_exprs wt_stmt]]

subsubsection {* eval implies evaln *}
lemma eval_evaln:
  assumes eval: "G\<turnstile>s0 \<midarrow>t\<succ>\<rightarrow> (v,s1)"
  shows  "\<exists>n. G\<turnstile>s0 \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (v,s1)"
using eval
proof (induct)
  case (Abrupt xc s t)
  obtain n where
    "G\<turnstile>(Some xc, s) \<midarrow>t\<succ>\<midarrow>n\<rightarrow> (undefined3 t, (Some xc, s))"
    by (iprover intro: evaln.Abrupt)
  then show ?case ..
next
  case Skip
  show ?case by (blast intro: evaln.Skip)
next
  case (Expr s0 e v s1)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
    by (iprover)
  then have "G\<turnstile>Norm s0 \<midarrow>Expr e\<midarrow>n\<rightarrow> s1"
    by (rule evaln.Expr)
  then show ?case ..
next
  case (Lab s0 c s1 l)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>c\<midarrow>n\<rightarrow> s1"
    by (iprover)
  then have "G\<turnstile>Norm s0 \<midarrow>l\<bullet> c\<midarrow>n\<rightarrow> abupd (absorb l) s1"
    by (rule evaln.Lab)
  then show ?case ..
next
  case (Comp s0 c1 s1 c2 s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>c2\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  then have "G\<turnstile>Norm s0 \<midarrow>c1;; c2\<midarrow>max n1 n2\<rightarrow> s2"
    by (blast intro: evaln.Comp dest: evaln_max2 )
  then show ?case ..
next
  case (If s0 e b s1 c1 c2 s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>(if the_Bool b then c1 else c2)\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  then have "G\<turnstile>Norm s0 \<midarrow>If(e) c1 Else c2\<midarrow>max n1 n2\<rightarrow> s2"
    by (blast intro: evaln.If dest: evaln_max2)
  then show ?case ..
next
  case (Loop s0 e b s1 c s2 l s3)
  from Loop.hyps obtain n1 where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>b\<midarrow>n1\<rightarrow> s1"
    by (iprover)
  moreover from Loop.hyps obtain n2 where
    "if the_Bool b
        then (G\<turnstile>s1 \<midarrow>c\<midarrow>n2\<rightarrow> s2 \<and>
              G\<turnstile>(abupd (absorb (Cont l)) s2)\<midarrow>l\<bullet> While(e) c\<midarrow>n2\<rightarrow> s3)
        else s3 = s1"
    by simp (iprover intro: evaln_nonstrict max.cobounded1 max.cobounded2)
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>l\<bullet> While(e) c\<midarrow>max n1 n2\<rightarrow> s3"
    apply -
    apply (rule evaln.Loop)
    apply   (iprover intro: evaln_nonstrict intro: max.cobounded1)
    apply   (auto intro: evaln_nonstrict intro: max.cobounded2)
    done
  then show ?case ..
next
  case (Jmp s j)
  fix n have "G\<turnstile>Norm s \<midarrow>Jmp j\<midarrow>n\<rightarrow> (Some (Jump j), s)"
    by (rule evaln.Jmp)
  then show ?case ..
next
  case (Throw s0 e a s1)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a\<midarrow>n\<rightarrow> s1"
    by (iprover)
  then have "G\<turnstile>Norm s0 \<midarrow>Throw e\<midarrow>n\<rightarrow> abupd (throw a) s1"
    by (rule evaln.Throw)
  then show ?case ..
next
  case (Try s0 c1 s1 s2 catchC vn c2 s3)
  from Try.hyps obtain n1 where
    "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> s1"
    by (iprover)
  moreover
  note sxalloc = `G\<turnstile>s1 \<midarrow>sxalloc\<rightarrow> s2`
  moreover
  from Try.hyps obtain n2 where
    "if G,s2\<turnstile>catch catchC then G\<turnstile>new_xcpt_var vn s2 \<midarrow>c2\<midarrow>n2\<rightarrow> s3 else s3 = s2"
    by fastforce
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>Try c1 Catch(catchC vn) c2\<midarrow>max n1 n2\<rightarrow> s3"
    by (auto intro!: evaln.Try max.cobounded1 max.cobounded2)
  then show ?case ..
next
  case (Fin s0 c1 x1 s1 c2 s2 s3)
  from Fin obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>c1\<midarrow>n1\<rightarrow> (x1, s1)"
    "G\<turnstile>Norm s1 \<midarrow>c2\<midarrow>n2\<rightarrow> s2"
    by iprover
  moreover
  note s3 = `s3 = (if \<exists>err. x1 = Some (Error err)
                   then (x1, s1)
                   else abupd (abrupt_if (x1 \<noteq> None) x1) s2)`
  ultimately
  have
    "G\<turnstile>Norm s0 \<midarrow>c1 Finally c2\<midarrow>max n1 n2\<rightarrow> s3"
    by (blast intro: evaln.Fin dest: evaln_max2)
  then show ?case ..
next
  case (Init C c s0 s3 s1 s2)
  note cls = `the (class G C) = c`
  moreover from Init.hyps obtain n where
      "if inited C (globs s0) then s3 = Norm s0
       else (G\<turnstile>Norm (init_class_obj G C s0)
              \<midarrow>(if C = Object then Skip else Init (super c))\<midarrow>n\<rightarrow> s1 \<and>
                   G\<turnstile>set_lvars empty s1 \<midarrow>init c\<midarrow>n\<rightarrow> s2 \<and>
                   s3 = restore_lvars s1 s2)"
    by (auto intro: evaln_nonstrict max.cobounded1 max.cobounded2)
  ultimately have "G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s3"
    by (rule evaln.Init)
  then show ?case ..
next
  case (NewC s0 C s1 a s2)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>Init C\<midarrow>n\<rightarrow> s1"
    by (iprover)
  with NewC
  have "G\<turnstile>Norm s0 \<midarrow>NewC C-\<succ>Addr a\<midarrow>n\<rightarrow> s2"
    by (iprover intro: evaln.NewC)
  then show ?case ..
next
  case (NewA s0 T s1 e i s2 a s3)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>init_comp_ty T\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>e-\<succ>i\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  moreover
  note `G\<turnstile>abupd (check_neg i) s2 \<midarrow>halloc Arr T (the_Intg i)\<succ>a\<rightarrow> s3`
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>New T[e]-\<succ>Addr a\<midarrow>max n1 n2\<rightarrow> s3"
    by (blast intro: evaln.NewA dest: evaln_max2)
  then show ?case ..
next
  case (Cast s0 e v s1 s2 castT)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
    by (iprover)
  moreover
  note `s2 = abupd (raise_if (\<not> G,snd s1\<turnstile>v fits castT) ClassCast) s1`
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>Cast castT e-\<succ>v\<midarrow>n\<rightarrow> s2"
    by (rule evaln.Cast)
  then show ?case ..
next
  case (Inst s0 e v s1 b T)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
    by (iprover)
  moreover
  note `b = (v \<noteq> Null \<and> G,snd s1\<turnstile>v fits RefT T)`
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>e InstOf T-\<succ>Bool b\<midarrow>n\<rightarrow> s1"
    by (rule evaln.Inst)
  then show ?case ..
next
  case (Lit s v)
  fix n have "G\<turnstile>Norm s \<midarrow>Lit v-\<succ>v\<midarrow>n\<rightarrow> Norm s"
    by (rule evaln.Lit)
  then show ?case ..
next
  case (UnOp s0 e v s1 unop)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n\<rightarrow> s1"
    by (iprover)
  hence "G\<turnstile>Norm s0 \<midarrow>UnOp unop e-\<succ>eval_unop unop v\<midarrow>n\<rightarrow> s1"
    by (rule evaln.UnOp)
  then show ?case ..
next
  case (BinOp s0 e1 v1 s1 binop e2 v2 s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e1-\<succ>v1\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>(if need_second_arg binop v1 then In1l e2
               else In1r Skip)\<succ>\<midarrow>n2\<rightarrow> (In1 v2, s2)"
    by (iprover)
  hence "G\<turnstile>Norm s0 \<midarrow>BinOp binop e1 e2-\<succ>(eval_binop binop v1 v2)\<midarrow>max n1 n2
          \<rightarrow> s2"
    by (blast intro!: evaln.BinOp dest: evaln_max2)
  then show ?case ..
next
  case (Super s )
  fix n have "G\<turnstile>Norm s \<midarrow>Super-\<succ>val_this s\<midarrow>n\<rightarrow> Norm s"
    by (rule evaln.Super)
  then show ?case ..
next
  case (Acc s0 va v f s1)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>va=\<succ>(v, f)\<midarrow>n\<rightarrow> s1"
    by (iprover)
  then
  have "G\<turnstile>Norm s0 \<midarrow>Acc va-\<succ>v\<midarrow>n\<rightarrow> s1"
    by (rule evaln.Acc)
  then show ?case ..
next
  case (Ass s0 var w f s1 e v s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>var=\<succ>(w, f)\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>e-\<succ>v\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  then
  have "G\<turnstile>Norm s0 \<midarrow>var:=e-\<succ>v\<midarrow>max n1 n2\<rightarrow> assign f v s2"
    by (blast intro: evaln.Ass dest: evaln_max2)
  then show ?case ..
next
  case (Cond s0 e0 b s1 e1 e2 v s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e0-\<succ>b\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>(if the_Bool b then e1 else e2)-\<succ>v\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  then
  have "G\<turnstile>Norm s0 \<midarrow>e0 ? e1 : e2-\<succ>v\<midarrow>max n1 n2\<rightarrow> s2"
    by (blast intro: evaln.Cond dest: evaln_max2)
  then show ?case ..
next
  case (Call s0 e a' s1 args vs s2 invDeclC mode statT mn pTs' s3 s3' accC' v s4)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>a'\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>args\<doteq>\<succ>vs\<midarrow>n2\<rightarrow> s2"
    by iprover
  moreover
  note `invDeclC = invocation_declclass G mode (store s2) a' statT
                       \<lparr>name=mn,parTs=pTs'\<rparr>`
  moreover
  note `s3 = init_lvars G invDeclC \<lparr>name=mn,parTs=pTs'\<rparr> mode a' vs s2`
  moreover
  note `s3'=check_method_access G accC' statT mode \<lparr>name=mn,parTs=pTs'\<rparr> a' s3`
  moreover
  from Call.hyps
  obtain m where
    "G\<turnstile>s3' \<midarrow>Methd invDeclC \<lparr>name=mn, parTs=pTs'\<rparr>-\<succ>v\<midarrow>m\<rightarrow> s4"
    by iprover
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>{accC',statT,mode}e\<cdot>mn( {pTs'}args)-\<succ>v\<midarrow>max n1 (max n2 m)\<rightarrow>
            (set_lvars (locals (store s2))) s4"
    by (auto intro!: evaln.Call max.cobounded1 le_max3I1 le_max3I2)
  thus ?case ..
next
  case (Methd s0 D sig v s1)
  then obtain n where
    "G\<turnstile>Norm s0 \<midarrow>body G D sig-\<succ>v\<midarrow>n\<rightarrow> s1"
    by iprover
  then have "G\<turnstile>Norm s0 \<midarrow>Methd D sig-\<succ>v\<midarrow>Suc n\<rightarrow> s1"
    by (rule evaln.Methd)
  then show ?case ..
next
  case (Body s0 D s1 c s2 s3)
  from Body.hyps obtain n1 n2 where
    evaln_init: "G\<turnstile>Norm s0 \<midarrow>Init D\<midarrow>n1\<rightarrow> s1" and
    evaln_c: "G\<turnstile>s1 \<midarrow>c\<midarrow>n2\<rightarrow> s2"
    by (iprover)
  moreover
  note `s3 = (if \<exists>l. fst s2 = Some (Jump (Break l)) \<or>
                     fst s2 = Some (Jump (Cont l))
              then abupd (\<lambda>x. Some (Error CrossMethodJump)) s2
              else s2)`
  ultimately
  have
     "G\<turnstile>Norm s0 \<midarrow>Body D c-\<succ>the (locals (store s2) Result)\<midarrow>max n1 n2
       \<rightarrow> abupd (absorb Ret) s3"
    by (iprover intro: evaln.Body dest: evaln_max2)
  then show ?case ..
next
  case (LVar s vn )
  obtain n where
    "G\<turnstile>Norm s \<midarrow>LVar vn=\<succ>lvar vn s\<midarrow>n\<rightarrow> Norm s"
    by (iprover intro: evaln.LVar)
  then show ?case ..
next
  case (FVar s0 statDeclC s1 e a s2 v s2' stat fn s3 accC)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>Init statDeclC\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>e-\<succ>a\<midarrow>n2\<rightarrow> s2"
    by iprover
  moreover
  note `s3 = check_field_access G accC statDeclC fn stat a s2'`
    and `(v, s2') = fvar statDeclC stat fn a s2`
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>{accC,statDeclC,stat}e..fn=\<succ>v\<midarrow>max n1 n2\<rightarrow> s3"
    by (iprover intro: evaln.FVar dest: evaln_max2)
  then show ?case ..
next
  case (AVar s0 e1 a s1 e2 i s2 v s2')
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e1-\<succ>a\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>e2-\<succ>i\<midarrow>n2\<rightarrow> s2"
    by iprover
  moreover
  note `(v, s2') = avar G i a s2`
  ultimately
  have "G\<turnstile>Norm s0 \<midarrow>e1.[e2]=\<succ>v\<midarrow>max n1 n2\<rightarrow> s2'"
    by (blast intro!: evaln.AVar dest: evaln_max2)
  then show ?case ..
next
  case (Nil s0)
  show ?case by (iprover intro: evaln.Nil)
next
  case (Cons s0 e v s1 es vs s2)
  then obtain n1 n2 where
    "G\<turnstile>Norm s0 \<midarrow>e-\<succ>v\<midarrow>n1\<rightarrow> s1"
    "G\<turnstile>s1 \<midarrow>es\<doteq>\<succ>vs\<midarrow>n2\<rightarrow> s2"
    by iprover
  then
  have "G\<turnstile>Norm s0 \<midarrow>e # es\<doteq>\<succ>v # vs\<midarrow>max n1 n2\<rightarrow> s2"
    by (blast intro!: evaln.Cons dest: evaln_max2)
  then show ?case ..
qed

end


(* @LICENSE(NICTA_CORE) *)

(*  Author:     Rafal Kolanski, NICTA & UNSW

    Generic heap definitions and manipulations instantiated to a machine.
*)

theory Heaps
imports MemTypes WordTypes
begin

section \<open>Memory Views\<close>

text \<open>
  Apart from the heap, representing the physical machine memory, we recognise
  the virtual address map (mapping each virtual address to a physical one) and
  the virtual address space (mapping each virtual address to a byte).

  You can obtain a virtual map from lifting the page table from the heap, and
  an address space from combining a vmap and heap.

  All maps are partial. On the physical side, this denotes memory that has been
  allocated. On the virtual side, memory that has been mapped. Allocated memory
  may be unmapped, mapped memory may be unallocated.

  The heap is partial, defined on areas used by the program.

  A value space is a partial map from any kind of address to bytes.
\<close>
type_synonym vmap = "vaddr \<rightharpoonup> paddr"
type_synonym heap = "paddr \<rightharpoonup> byte"
type_synonym addr_space = "vaddr \<rightharpoonup> byte"

translations
  (type) "vmap" <=(type) "vaddr \<rightharpoonup> paddr"
  (type) "heap" <=(type) "paddr \<rightharpoonup> byte"
  (type) "addr_space" <=(type) "vaddr \<rightharpoonup> byte"

type_synonym ('a,'p) value_space = "('a,'p) addr_t \<rightharpoonup> byte"

section \<open>Object Loading\<close>

text \<open>Obtaining a list of values (i.e. bytes) from a map with an addr_t domain.\<close>

primrec
  load_list_basic :: "(('a::semiring_1,'p) addr_t \<rightharpoonup> 'val) \<Rightarrow> nat
                      \<Rightarrow> ('a,'p) addr_t \<Rightarrow> 'val option list"
where
  "load_list_basic h 0 p = []" |
  "load_list_basic h (Suc n) p = h p # load_list_basic h n (p r+ 1)"

definition
  deoption_list :: "'a option list \<rightharpoonup> 'a list" where
  "deoption_list xs \<equiv> if None \<in> set xs then None else Some (map the xs)"

definition
  "load_list h n p \<equiv> deoption_list (load_list_basic h n p)"

lemma length_load_list_basic [simp]:
  "length (load_list_basic h sz p) = sz"
  by (induct sz arbitrary: p, auto)

section \<open>Loading Objects from the Heap/Address Space\<close>

text \<open>Retrieving a stored value on the heap or addr\_space\<close>
(* FIXME: ugly return-type overloading, improve? *)

definition
  load_value :: "('a::semiring_1,'p) value_space \<Rightarrow> ('a,'p) addr_t
                  \<rightharpoonup> ('t::mem_type)" where
  "load_value h p \<equiv> (case load_list h (size_of TYPE('t)) p
                       of None \<Rightarrow> None
                        | Some bs \<Rightarrow> Some (from_bytes bs))"

(* update form Hira: changed Option.map to map_option *)
lemma load_value_def2:
  "((load_value h p)::'t option) \<equiv> map_option from_bytes (load_list h (size_of TYPE('t::mem_type)) p)"
  by (auto intro!: eq_reflection simp: load_value_def split: option.splits)

definition
  load_machine_word :: "('a::semiring_1,'p) value_space \<Rightarrow> ('a,'p) addr_t
                        \<rightharpoonup> machine_word" where
  "load_machine_word \<equiv> load_value"

subsection \<open>Loading Objects After Unrelated Heap Updates\<close>

lemma load_list_basic_update_eq:
  assumes p: "p \<notin> set (addr_seq start sz)"
  shows "load_list_basic (h(p \<mapsto> v)) sz start = load_list_basic h sz start"
  using p proof (induct sz arbitrary: start)
  case 0 thus ?case by simp
next
  case (Suc sz start)
  hence IH: "p \<notin> set (addr_seq (start r+ 1) sz)
             \<Longrightarrow> load_list_basic (h(p \<mapsto> v)) sz (start r+ 1) =
                 load_list_basic h sz (start r+ 1)"
    and ps: "p \<notin> set (addr_seq start (Suc sz))" by - assumption
  (*WTF:blast or simp don't work here? why?*)

  from ps have "p \<notin> set (addr_seq (start r+ 1) sz)" by auto

  hence "load_list_basic (h(p \<mapsto> v)) sz (start r+ 1) =
           load_list_basic h sz (start r+ 1)" using IH by simp

  moreover

  have "(\<lambda>a. if a = p then Some v else h a) = h(p \<mapsto> v)"
    by (rule ext, auto)

  moreover

  have "p \<noteq> start" using ps
    proof -
      assume "start = p"
      hence "p \<in> set (addr_seq start (Suc sz))" by simp
    qed (auto)

  ultimately show ?case by (clarsimp)
qed

lemma load_list_update_eq:
  "\<lbrakk> p \<notin> set (addr_seq start sz) \<rbrakk>
   \<Longrightarrow> load_list (h(p \<mapsto> v)) sz start = load_list h sz start"
  unfolding load_list_def deoption_list_def
  by (simp add: load_list_basic_update_eq)

lemma load_value_update_eq:
  "\<lbrakk> p \<notin> set (addr_seq start (size_of TYPE('a::mem_type))) \<rbrakk>
   \<Longrightarrow> load_value (h(p \<mapsto> v)) start = ((load_value h start)::'a option)"
  unfolding load_machine_word_def load_value_def Let_def
  by (simp add: load_list_update_eq)

lemma load_list_basic_nth [simp]:
  fixes p :: "('a::len word,'b) addr_t"
  shows "i < sz \<Longrightarrow> load_list_basic h sz p ! i = h (p r+ (of_nat i))"
proof (induct sz arbitrary: p i)
  case 0 thus ?case by simp
next
  case (Suc sz)
  thus ?case
  by (clarsimp simp: nth_Cons')
     (cases i, auto simp add: addr_add_def add_ac split: nat.split)
qed

end


theory Read_Write_Tag_Ref

imports  Address_Translate_Tag_Ref

begin

lemma  mmu_write_rel:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s')\<rbrakk>   \<Longrightarrow>  s' = s \<lparr> non_det_tlb := non_det_tlb s' , MEM:= MEM s' , exception:= exception s' \<rparr>"
  apply (clarsimp simp:  mmu_write_size_non_det_tlb_state_ext_def Let_def, cases "mmu_translate va s", clarsimp split: if_split_asm)
   apply (drule write_mem_rel, cases "mmu_translate va s" , clarsimp)
   apply (drule mmu_rel, cases s, cases s', case_tac b, clarsimp)
  apply (clarsimp simp: mmu_translate_non_det_tlb_state_ext_def Let_def split: lookup_type.splits)
  by (clarsimp simp: Let_def raise'exception_def split:if_split_asm)+

lemma mmu_write_tlb_disj:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s') \<rbrakk> \<Longrightarrow>
     non_det_tlb s' = non_det_tlb s - tlb_evict (typ_non_det_tlb s) \<or>
           non_det_tlb s' = non_det_tlb s - tlb_evict (typ_non_det_tlb s) \<union> {the (pt_walk (non_det_asid s) (MEM s) (TTBR0 s) va)}"
  apply (clarsimp simp:  mmu_write_size_non_det_tlb_state_ext_def mmu_translate_non_det_tlb_state_ext_def split_def Let_def write_mem_eq_TLB raise'exception_def
                  split: lookup_type.splits split: if_split_asm)
    apply (drule write_mem_eq_TLB state.defs)
    apply (cases s , cases s' ; clarsimp)
   apply (drule write_mem_eq_TLB state.defs)
  by(cases s , cases s' ; clarsimp)

lemma  mmu_write_det_rel:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s')\<rbrakk>   \<Longrightarrow>  s' = s \<lparr> det_tlb := det_tlb s' , MEM:= MEM s' , exception:= exception s' \<rparr>"
  apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def Let_def, cases "mmu_translate va s", clarsimp split: if_split_asm)
   apply (drule write_mem_rel, cases "mmu_translate va s" , clarsimp)
   apply (drule mmu_det_rel, cases s, cases s', case_tac b, clarsimp)
  apply (clarsimp simp: mmu_translate_det_tlb_state_ext_def Let_def split: lookup_type.splits)
  by (clarsimp simp: Let_def raise'exception_def split:if_split_asm)+

lemma mmu_write_tlb_disj_det:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s') \<rbrakk> \<Longrightarrow>
     det_tlb s' = det_tlb s  \<or>  det_tlb s' = det_tlb s  \<union> {the (pt_walk (det_asid s)  (MEM s) (TTBR0 s) va)}"
  apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def mmu_translate_det_tlb_state_ext_def split_def Let_def write_mem_eq_TLB raise'exception_def
                  split: lookup_type.splits split: if_split_asm)
    apply (drule write_mem_eq_TLB state.defs)
    apply (cases s , cases s' ; clarsimp)
   apply (drule write_mem_eq_TLB state.defs)
  by(cases s , cases s' ; clarsimp)

(**************************************************************)

lemma mmu_write_tlb_subset_non_det_det:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t); consistent (typ_det_tlb t) va;
       mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow> non_det_tlb s' \<subseteq> det_tlb t'"
  apply (frule tlb_rel_detD)
  apply (subgoal_tac "lookup'' (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) (non_det_asid s) va \<le> lookup'' (det_tlb t) (det_asid t) va")
   prefer 2
   apply (simp add:  sup.absorb1 asid_tlb_mono tlb_rel_det_def)
   apply (meson Diff_subset order_trans asid_tlb_mono)
  apply (frule mmu_write_tlb_disj)
  apply (frule mmu_write_tlb_disj_det)
  apply (erule disjE)
   apply (clarsimp simp: )
   apply blast
  apply (erule disjE)
   apply clarsimp
   apply (rule conjI)
    prefer 2
    apply blast
   apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def , cases "mmu_translate va t" , clarsimp split: if_split_asm)
    apply (clarsimp simp:  mmu_translate_det_tlb_state_ext_def)
    apply (case_tac "lookup'' (det_tlb t) (det_asid t) va"; clarsimp simp: Let_def consistent0_def)
     apply (clarsimp simp: raise'exception_def  split: if_split_asm)
     apply (clarsimp simp: write'mem1_def split: if_split_asm)
         apply (cases t, cases t', clarsimp simp: state.defs) apply force
        apply (cases t, cases t', clarsimp simp: state.defs) apply force
       apply (cases t, cases t', clarsimp simp: state.defs) apply force
      apply (cases t, cases t', clarsimp simp: state.defs) apply force
     apply (clarsimp simp: raise'exception_def  split: if_split_asm)
     apply (cases t, cases t', clarsimp simp: state.defs) apply force
  using lookup_in_asid_tlb apply blast
   apply (clarsimp simp:  mmu_translate_det_tlb_state_ext_def)
   apply (case_tac "lookup'' (det_tlb t) (det_asid t) va")
     apply (subgoal_tac "lookup'' (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) (det_asid t) va = Miss")
      prefer 2
      apply force
     apply (clarsimp simp:  mmu_write_size_non_det_tlb_state_ext_def)
     apply (case_tac "mmu_translate va s", clarsimp)
     apply (clarsimp simp: mmu_translate_non_det_tlb_state_ext_def)
     apply (clarsimp simp: Let_def split: if_split_asm)
       apply (case_tac "exception s = NoException")
        apply (clarsimp simp: raise'exception_def  split: if_split_asm)
       apply (thin_tac "raise'exception (PAGE_FAULT ''more info'') t = (a, t')")
       apply (clarsimp simp: raise'exception_def  split: if_split_asm)
      apply (thin_tac "raise'exception (PAGE_FAULT ''more info'') t = (a, t')")
      apply (clarsimp simp: raise'exception_def  split: if_split_asm)
       apply force
      apply force
     apply force
    apply (clarsimp simp: consistent0_def)
   apply (simp only: consistent0_def)
   apply (metis lookup_in_asid_tlb lookup_type.simps(5))
  apply clarsimp
  by blast

lemma write_mem_non_det_det_MEM:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s');  tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t) ; consistent (typ_det_tlb t) va;
                   mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow> MEM s' = MEM t'"
  apply (frule tlb_rel_detD)
  apply (clarsimp simp:  mmu_write_size_non_det_tlb_state_ext_def , cases "mmu_translate va s" , clarsimp)
  apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def , cases "mmu_translate va t" , clarsimp)
  apply (clarsimp split: if_split_asm)
     apply (case_tac "write'mem1 (val, aa, sz) ba" , clarsimp)
     apply (subgoal_tac "MEM b = MEM ba \<and> aa = a")
  using write_same_mem apply blast
     apply (rule conjI)
      apply (clarsimp simp:  mmu_eq_asid_root_mem mmu_det_eq_asid_root_mem)
     apply (frule_tac s= "(typ_non_det_tlb s)" and va= "va" in tlb_rel_det_consistent, clarsimp)
     apply (subgoal_tac "non_det_tlb s - tlb_evict (typ_non_det_tlb s) \<subseteq> non_det_tlb s")
      prefer 2
      apply blast
     apply (subgoal_tac "lookup'' (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) (non_det_asid s) va \<le> lookup'' (det_tlb t) (det_asid t) va")
      prefer 2
      apply (simp add:  sup.absorb1 asid_tlb_mono tlb_rel_det_def)
     apply (clarsimp simp:  mmu_translate_non_det_tlb_state_ext_def  mmu_translate_det_tlb_state_ext_def split_def Let_def)
     apply (cases "lookup'' (det_tlb t) (det_asid t) va"; clarsimp)
       apply (clarsimp simp: tlb_rel_det_def Let_def raise'exception_def  state.defs split: if_split_asm)
      apply (clarsimp simp: consistent0_def)
     apply (subgoal_tac "x3 = the (pt_walk (non_det_asid s) (MEM s) (TTBR0 s) va)")
      prefer 2
      apply (clarsimp simp: consistent0_def)
     apply (cases "lookup'' (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) (non_det_asid s) va"; clarsimp)
     apply (clarsimp simp: Let_def)
     apply (cases "\<not>is_fault (pt_walk () (MEM s) (TTBR0 s) va)")
      apply (clarsimp simp: tlb_rel_det_def typ_det_tlb_def typ_non_det_tlb_def state.defs lookup_in_asid_tlb raise'exception_def split: if_split_asm)
     apply (clarsimp simp: tlb_rel_det_def typ_det_tlb_def typ_non_det_tlb_def state.defs lookup_in_asid_tlb raise'exception_def split: if_split_asm)
  using mmu_translate_non_det_det_excp mmu_translate_non_det_det_pa apply fastforce
  using mmu_translate_non_det_det_excp mmu_translate_non_det_det_pa apply fastforce
  by (simp add: mmu_det_eq_asid_root_mem mmu_eq_asid_root_mem)

lemma mmu_write_size_det_non_det_state_trun:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_det(typ_non_det_tlb s) (typ_det_tlb t)  ; consistent (typ_det_tlb t) va;
     mmu_write_size (val,va, sz) t = ((), t')\<rbrakk> \<Longrightarrow> state.truncate t' = state.truncate s' \<and> det_asid t' = non_det_asid s'"
  apply (frule (3)  write_mem_non_det_det_MEM)
  apply (frule tlb_rel_detD, clarsimp)
  apply (frule mmu_write_rel)
  apply (rotate_tac)
  apply (frule mmu_write_det_rel)
  apply (clarsimp simp: tlb_rel_det_def)
  apply (subgoal_tac "exception s' = exception t'")
   apply (cases s, cases t, cases s' , cases t')
   apply (clarsimp simp: state.defs det_tlb_state.defs)
  apply (clarsimp simp: mmu_write_size_non_det_tlb_state_ext_def mmu_write_size_det_tlb_state_ext_def Let_def)
  apply (case_tac "mmu_translate va t" , case_tac "write'mem1 (val, a, sz) b" , clarsimp)
  apply (case_tac "mmu_translate va s" , clarsimp)
  apply (subgoal_tac "exception b = exception bb \<and> a = aa")
   apply (clarsimp split: if_split_asm)
   apply (subgoal_tac "MEM b = MEM bb ")
    apply (frule_tac s="bb" and s'="s'" and t = b and t' = t' in write_same_mem_excep ; clarsimp)
   apply (frule_tac s="s" and s'="bb" and t = t and t' = b and p' = aa in mmu_translate_non_det_det_mem_excp ; clarsimp simp: consistent0_def tlb_rel_det_def)
  apply (rule conjI)
   apply (frule_tac t= t and pa' = a and t' = b in mmu_translate_non_det_det_pa)
      apply (clarsimp simp: tlb_rel_det_def)
     apply (clarsimp simp: consistent0_def)
    apply (clarsimp simp: tlb_rel_det_def)
   apply (frule_tac s = "s" and s' = "bb" and t = "t" and t' = "b" in   mmu_translate_non_det_det_excp ; clarsimp simp: tlb_rel_det_def)
  apply (subgoal_tac "non_det_tlb s - tlb_evict (typ_non_det_tlb s) \<subseteq> non_det_tlb s")
   prefer 2
   apply blast
  apply (subgoal_tac "lookup'' (non_det_tlb s - tlb_evict (typ_non_det_tlb s))  (non_det_asid s) va \<le> lookup'' (det_tlb t) (det_asid t) va")
   prefer 2
   apply (simp add: sup.absorb1 asid_tlb_mono tlb_rel_det_def)
  apply (clarsimp simp: mmu_translate_non_det_tlb_state_ext_def mmu_translate_det_tlb_state_ext_def split_def Let_def)
  apply (cases "lookup'' (det_tlb t) (det_asid t) va")
    apply clarsimp
    prefer 2
    apply (clarsimp simp: consistent0_def)
   apply (clarsimp simp: tlb_rel_det_def Let_def)
   apply (cases "(is_fault (pt_walk (non_det_asid s)  (MEM s) (TTBR0 s) va))")
    apply (clarsimp simp: raise'exception_def  state.defs split: if_split_asm)
   apply (clarsimp simp: lookup_def entry_set_def  split: if_split_asm)
  apply clarsimp
  apply (subgoal_tac "x3 = the (pt_walk (non_det_asid s) (MEM s) (TTBR0 s) va)")
   prefer 2
   apply (clarsimp simp: consistent0_def)
  apply (cases "lookup''  (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) (non_det_asid s)  va"; clarsimp)
  by (clarsimp simp: Let_def consistent0_def)

lemma mmu_write_non_det_det_refine:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)  ; consistent (typ_det_tlb t) va;
        mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow>  tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t') "
  apply (clarsimp simp: tlb_rel_det_def)
  apply (rule conjI)
   prefer 2
   apply (frule_tac s = s and s' = s' and t = t and t' = t' in mmu_write_tlb_subset_non_det_det; clarsimp simp: tlb_rel_det_def)
   apply (frule_tac s = s and s' = s' and t = t and t' = t' in mmu_write_size_det_non_det_state_trun; clarsimp simp: tlb_rel_det_def)+
  done

lemma mmu_write_saturated_state:
  "\<lbrakk>mmu_write_size (val,va,sz) s = ((), t)  \<rbrakk>  \<Longrightarrow> saturated (typ_sat_tlb t)"
  apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def Let_def)
  apply (case_tac "mmu_translate va s" , clarsimp)
  apply (clarsimp split: if_split_asm)
   apply (case_tac "write'mem1 (val, a, sz) b" , clarsimp)
   apply (subgoal_tac "sat_asid s = sat_asid ba \<and>  TTBR0 s = TTBR0 ba ")
    apply (clarsimp simp: saturated_def)
   apply (subgoal_tac " sat_asid s = sat_asid b \<and> TTBR0 s = TTBR0 b")
    apply clarsimp
    apply (clarsimp simp:  write'mem1_def Let_def)
    apply (clarsimp split: if_split_asm)
    apply (clarsimp simp:  raise'exception_def)
   apply (clarsimp simp: mmu_translate_sat_tlb_state_ext_def Let_def raise'exception_def split:lookup_type.splits if_split_asm)
  using mmu_translate_saturated_state surjective_pairing by blast

lemma mmu_wrtie_sat_rel:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s')\<rbrakk>   \<Longrightarrow>
      s' = s \<lparr> sat_tlb := sat_tlb s' , MEM:= MEM s' , exception:= exception s' \<rparr>"
  apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def Let_def)
  apply (cases "mmu_translate va s" , clarsimp)
  apply (clarsimp split: if_split_asm)
   apply (case_tac " write'mem1 (val, a, sz) b", clarsimp)
   apply (drule write_mem_rel)
   apply (drule mmu_sat_rel)
   apply (cases s, cases s', case_tac a, case_tac b, case_tac ba)
   apply clarsimp
  apply (clarsimp simp: mmu_translate_sat_tlb_state_ext_def Let_def split: lookup_type.splits)
   apply (clarsimp simp: raise'exception_def  split:if_split_asm)
  by (clarsimp simp: raise'exception_def split:if_split_asm)

lemma wrtie_mem_sat_tlbs:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s') \<rbrakk> \<Longrightarrow>
     sat_tlb s' = sat_tlb s \<union> the `{e\<in>pt_walk (sat_asid s)   (MEM s) (TTBR0 s) ` UNIV. \<not> is_fault e} \<or>
     sat_tlb s' = sat_tlb s \<union> the `{e\<in>pt_walk (sat_asid s)   (MEM s) (TTBR0 s) ` UNIV. \<not> is_fault e} \<union> the `{e\<in>pt_walk (sat_asid s)   (MEM s') (TTBR0 s') ` UNIV. \<not> is_fault e}"
  apply (cases "exception (snd (mmu_translate va s)) \<noteq> NoException")
   apply (rule disjI1)
   apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def Let_def)
   apply (case_tac "mmu_translate va s" , clarsimp)
   apply (clarsimp simp: mmu_translate_sat_tlb_union)
  apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def Let_def)
  apply (case_tac "mmu_translate va s " , clarsimp)
  apply (case_tac "write'mem1 (val, a, sz) b" , clarsimp)
  apply (subgoal_tac "sat_tlb ba = sat_tlb b")
   apply (subgoal_tac "sat_tlb b  = sat_tlb s \<union> the `{e\<in>pt_walk (sat_asid s)   (MEM s) (TTBR0 s) ` UNIV. \<not> is_fault e}")
    apply (subgoal_tac "  TTBR0 ba = TTBR0 s")
     apply clarsimp
    apply (subgoal_tac "  TTBR0 b = TTBR0 s")
     apply (simp add: write_mem1_eq_ASID_TTBR0)
  apply (simp add: mmu_sat_eq_asid_root_mem)
   apply (clarsimp simp: mmu_translate_sat_tlb_union)
  apply (drule write_mem_eq_TLB)
  apply (case_tac ba , case_tac b ; clarsimp)
  done

lemma mmu_write_tlb_subset:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t) ; consistent (typ_sat_tlb t) va ;
        mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow>
          det_tlb s' \<subseteq> sat_tlb t'"
  apply (frule tlb_rel_satD)
  apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def , cases "mmu_translate va s" , clarsimp)
  apply (clarsimp simp:  mmu_write_size_sat_tlb_state_ext_def , cases "mmu_translate va t" , clarsimp)
  apply (frule_tac t' = ba and s' = b and t = t and s = s and pa' = aa in mmu_translate_det_sat_subset_rel; simp?)
  apply (subgoal_tac "det_tlb b = det_tlb s'", clarsimp split: if_split_asm)
    apply (case_tac "write'mem1 (val, aa, sz) ba", clarsimp simp:)
    apply (subgoal_tac "state.more bb = state.more ba")
     apply force
    apply (drule write_mem_eq_TLB)
    apply (drule write_mem_eq_TLB)
    apply (clarsimp simp: typ_sat_tlb_def) apply force
   apply (case_tac "write'mem1 (val, aa, sz) ba", simp)
   apply (subgoal_tac "state.more ba = state.more b")
    apply force
   apply (drule write_mem_eq_TLB)
    apply (clarsimp simp: typ_sat_tlb_def)
   apply (clarsimp simp: typ_sat_tlb_def) apply force
  apply (clarsimp split: if_split_asm)
   apply (drule write_mem_eq_TLB)
   apply (cases s' , case_tac b, clarsimp simp:)
  apply (drule write_mem_eq_TLB)
  by (cases s' , case_tac b, clarsimp simp:)

lemma mmu_write_det_sat_mem:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s');  tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t) ; consistent (typ_sat_tlb t) va;
                   mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow> MEM s' = MEM t'"
  apply (frule tlb_rel_satD)
  apply (clarsimp simp:  mmu_write_size_det_tlb_state_ext_def , cases "mmu_translate va s" , clarsimp)
  apply (clarsimp simp:  mmu_write_size_sat_tlb_state_ext_def , cases "mmu_translate va t" , clarsimp)
  apply (subgoal_tac "MEM ba = MEM b \<and>  exception ba = exception b")
   prefer 2
   apply (frule_tac t = t and t' = ba in mmu_translate_non_det_sat_mem_excp; simp?)
  apply (subgoal_tac "a = aa")
   prefer 2
   apply (frule  mmu_translate_non_det_sat_pa; simp)
  apply simp
  apply (clarsimp split: if_split_asm)
  apply (case_tac "write'mem1 (val, aa, sz) ba", simp)
  apply (frule_tac t = ba and t' = bb in  write_same_mem, simp, simp)
  by (case_tac bb, cases t', simp)

lemma mmu_write_size_det_sat_state_trunc:
  "\<lbrakk>mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)  ; consistent (typ_sat_tlb t) va;
     mmu_write_size (val,va, sz) t = ((), t')\<rbrakk> \<Longrightarrow> state.truncate t' = state.truncate s' \<and> det_asid s' = sat_asid t'"
  apply (frule (3)  mmu_write_det_sat_mem)
  apply (frule tlb_rel_satD, clarsimp)
  apply (frule mmu_write_det_rel)
  apply (rotate_tac)
  apply (frule mmu_wrtie_sat_rel)
  apply (clarsimp simp: tlb_rel_sat_def)
  apply (subgoal_tac "exception s' = exception t'")
   apply (cases s, cases t, cases s' , cases t')
   apply (clarsimp simp: state.defs)
  apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def mmu_write_size_det_tlb_state_ext_def Let_def)
  apply (case_tac "mmu_translate va t" , case_tac "write'mem1 (val, a, sz) b" , clarsimp)
  apply (case_tac "mmu_translate va s" , clarsimp?)
  apply (subgoal_tac "exception b = exception bb \<and> a = aa")
   apply (clarsimp split: if_split_asm)
   apply (subgoal_tac "MEM b = MEM bb ")
    apply (frule_tac s="bb" and s'="s'" and t = b and t' = ba in write_same_mem_excep ; clarsimp?)
   apply (frule_tac s="s" and s'="bb" and t = t and t' = b and p' = aa in mmu_translate_non_det_sat_mem_excp ; clarsimp simp: consistent0_def tlb_rel_sat_def)
  apply (rule conjI)
   apply (frule_tac s = "s" and s' = "bb" and t = "t" and t' = "b" in   mmu_translate_non_det_sat_excp ; clarsimp simp: tlb_rel_sat_def)
  by (frule_tac t= t and pa' = a and t' = b in mmu_translate_non_det_sat_pa ; clarsimp simp: tlb_rel_sat_def) +

lemma mmu_write_det_sat_refine:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s'); tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)  ; consistent (typ_sat_tlb t) va;
        mmu_write_size (val,va, sz) t = ((), t') \<rbrakk> \<Longrightarrow>  tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t') "
  apply (clarsimp simp: tlb_rel_sat_def)
  apply (clarsimp simp: mmu_write_saturated_state )
  apply (rule conjI)
   prefer 2
   apply (frule_tac s="s" and s'="s'" and t="t" and t'="t'" in mmu_write_tlb_subset; clarsimp simp: tlb_rel_sat_def)
  by (frule_tac s="s" and s'="s'" and t="t" and t'="t'" in mmu_write_size_det_sat_state_trunc; clarsimp simp: tlb_rel_sat_def)+

(*

lemma mmu_write_incon_set_rel:
  "\<lbrakk> saturated (typ_sat_tlb s) ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb t);  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb t);
      sat_asid s = sat_asid r; TTBR0 s = TTBR0 r\<rbrakk> \<Longrightarrow>
     inconsistent_vaddrs (typ_sat_tlb (r\<lparr>sat_tlb := sat_tlb s \<union> the ` {e \<in> range (pt_walk (sat_asid r) (MEM q) (TTBR0 r)). \<not> is_fault e}\<rparr>))
           \<subseteq> iset(set_tlb t) \<union> incon_comp  (sat_asid r) (sat_asid r) (MEM s) (MEM q) (TTBR0 r) (TTBR0 r)"
  apply (clarsimp)
  apply (clarsimp simp: inconsistent_vaddrs_def incon_comp_def ptable_comp_def  incoherrent_vaddrs_def)
  apply (erule disjE)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE)   apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply clarsimp
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (erule disjE)
   apply (erule disjE)
    apply (drule union_asid_tlb_incon_cases)
    apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
     apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
      apply blast
     apply (clarsimp simp:)
    apply (erule disjE)   apply blast
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon) apply blast
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
    apply clarsimp
    apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
     apply blast
    apply (clarsimp simp:)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
    apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
     apply blast
    apply (clarsimp simp:)
   apply (erule disjE)   apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply clarsimp
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (erule disjE)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (drule union_asid_tlb_incon_cases)
  apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
  apply (erule disjE, clarsimp)
   apply (subgoal_tac "the (pt_walk (sat_asid r) (MEM q) (TTBR0 r) xc) = the (pt_walk (sat_asid r) (MEM q) (TTBR0 r) x)")
    apply clarsimp
  using saturatd_lookup_hit_no_fault apply fastforce
   apply (frule asid_tlb_lookup_range_fault_pt_walk)
   apply (drule_tac x = x in bspec)
  using lookup_asid_tlb_hit_entry_range apply blast
   apply clarsimp
  apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
  apply (erule disjE, clarsimp simp:)
   apply blast
  apply (clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon) by blast
  *)

(*
lemma  mmu_write_asid_ptcomp_rel:
  "\<lbrakk>saturated (typ_sat_tlb s) ;   sat_asid t = set_asid r; set_asid r = sat_asid s; MEM t = MEM r; TTBR0 t = TTBR0 s ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb q) ;  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> iset(set_tlb q)\<rbrakk> \<Longrightarrow>
      incoherrent_vaddrs  (typ_sat_tlb (t\<lparr>sat_tlb := sat_tlb s \<union> the ` {e \<in> range (pt_walk (sat_asid t) (MEM r) (TTBR0 t)). \<not> is_fault e}\<rparr>)) \<subseteq> iset (set_tlb q) \<union>
                                            incon_comp  (sat_asid t) (sat_asid t) (MEM s) (MEM r) (TTBR0 t) (TTBR0 t)"
  apply rule
  apply (clarsimp simp: incoherrent_vaddrs_def  inconsistent_vaddrs_def )
  apply (drule lookup_asid_tlb_hit_union_cases')
  apply (erule disjE)
   apply (clarsimp simp: incon_comp_def ptable_comp_def Let_def)
   apply blast
  by  (clarsimp simp: asid_tlb_lookup_miss_is_fault_intro)
*)

lemma mmu_write_incon_set_rel:
  "\<lbrakk> saturated (typ_sat_tlb s) ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb t);  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb t);
      sat_asid s = sat_asid r; TTBR0 s = TTBR0 r\<rbrakk> \<Longrightarrow>
     inconsistent_vaddrs (typ_sat_tlb (r\<lparr>sat_tlb := sat_tlb s \<union> the ` {e \<in> range (pt_walk (sat_asid r) (MEM q) (TTBR0 r)). \<not> is_fault e}\<rparr>))
           \<subseteq> iset(set_tlb t) \<union> incon_comp  (sat_asid r) (sat_asid r) (MEM s) (MEM q) (TTBR0 r) (TTBR0 r)"
  apply (clarsimp)
  apply (clarsimp simp: inconsistent_vaddrs_def incon_comp_def ptable_comp_def  incoherrent_vaddrs_def)
  apply (erule disjE)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE)   apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply clarsimp
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (erule disjE)
   apply (erule disjE)
    apply (drule union_asid_tlb_incon_cases)
    apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
     apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
      apply blast
     apply (clarsimp simp:)
    apply (erule disjE)   apply blast
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon) apply blast
    apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
    apply clarsimp
    apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
     apply blast
    apply (clarsimp simp:)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
    apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
     apply blast
    apply (clarsimp simp:)
   apply (erule disjE)   apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon) apply blast
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply clarsimp
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (erule disjE)
   apply (drule union_asid_tlb_incon_cases)
   apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
   apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
   apply (subgoal_tac "is_fault (pt_walk (sat_asid r) (MEM s) (TTBR0 r) x)")
    apply blast
   apply (clarsimp simp:)
  apply (drule union_asid_tlb_incon_cases)
  apply (erule disjE, clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon)
  apply (erule disjE, clarsimp)
   apply (subgoal_tac "the (pt_walk (sat_asid r) (MEM q) (TTBR0 r) xc) = the (pt_walk (sat_asid r) (MEM q) (TTBR0 r) x)")
    apply clarsimp
  using saturatd_lookup_hit_no_fault apply fastforce
   apply (frule asid_tlb_lookup_range_fault_pt_walk)
   apply (drule_tac x = x in bspec)
  using lookup_asid_tlb_hit_entry_range apply blast
   apply clarsimp
  apply (erule disjE, clarsimp simp: asid_tlb_lookup_range_pt_walk_not_incon)
  apply (erule disjE, clarsimp simp:)
   apply blast
  apply (clarsimp simp: saturated_def asid_tlb_lookup_range_pt_walk_not_incon) by blast

lemma  mmu_write_asid_ptcomp_rel:
  "\<lbrakk>saturated (typ_sat_tlb s) ;   sat_asid t = set_asid r; set_asid r = sat_asid s; MEM t = MEM r; TTBR0 t = TTBR0 s ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> iset (set_tlb q) ;  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> iset(set_tlb q)\<rbrakk> \<Longrightarrow>
      incoherrent_vaddrs  (typ_sat_tlb (t\<lparr>sat_tlb := sat_tlb s \<union> the ` {e \<in> range (pt_walk (sat_asid t) (MEM r) (TTBR0 t)). \<not> is_fault e}\<rparr>)) \<subseteq> iset (set_tlb q) \<union>
                                            incon_comp  (sat_asid t) (sat_asid t) (MEM s) (MEM r) (TTBR0 t) (TTBR0 t)"
  apply rule
  apply (clarsimp simp: incoherrent_vaddrs_def  inconsistent_vaddrs_def )
  apply (drule lookup_asid_tlb_hit_union_cases')
  apply (erule disjE)
   apply (clarsimp simp: incon_comp_def ptable_comp_def Let_def)
   apply blast
  by  (clarsimp simp: asid_tlb_lookup_miss_is_fault_intro)

lemma mmu_write_sat_incon_refine:
  "\<lbrakk> mmu_write_size (val,va, sz) s = ((), s');  mmu_write_size (val,va, sz) t = ((), t'); va \<notin> iset(set_tlb t);
            tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)  \<rbrakk> \<Longrightarrow>
                                  tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t')"
  apply (frule_tac s = s in tlb_rel_abs_consistent' ; clarsimp )
  apply (frule tlb_rel_absD' , clarsimp)
  apply (clarsimp simp: mmu_write_size_sat_tlb_state_ext_def  mmu_write_size_set_tlb_state_ext_def)
  apply (cases "mmu_translate va s", cases "mmu_translate va t" , clarsimp)
  apply (frule_tac t=t and pa'= aa and t' = ba in mmu_translate_sat_incon_refine; clarsimp)
  apply (clarsimp simp: tlb_rel_abs_def)
  apply (subgoal_tac "exception b = exception ba")
   prefer 2 apply (case_tac b , case_tac ba , clarsimp simp: state.defs)
  apply (clarsimp split: if_split_asm)
  apply (case_tac "write'mem1 (val, aa, sz) b " , case_tac "write'mem1 (val, aa, sz) ba" , clarsimp simp: Let_def)
  apply (subgoal_tac "state.truncate bb = state.truncate bc")
   prefer 2
   apply (meson write_mem_state_trun_equal)
  apply (rule conjI , clarsimp simp: state.defs)
  apply (subgoal_tac "MEM bb = MEM bc  \<and> MEM s = MEM b" , simp)
   apply (subgoal_tac "sat_asid s =  sat_asid b \<and> TTBR0 s = TTBR0 b" , simp)
    apply (subgoal_tac "saturated (typ_sat_tlb b)")
     prefer 2 apply blast
    prefer 2 apply (drule mmu_sat_eq_asid_root_mem) apply simp
   prefer 2
   apply (rule conjI)
    apply (clarsimp simp: state.defs)
   apply (drule mmu_sat_eq_asid_root_mem) apply simp
  apply (subgoal_tac "set_asid t = set_asid bc \<and> sat_asid b = sat_asid bb \<and> TTBR0 b = TTBR0 bb")
   prefer 2
   apply (rule conjI)
    apply (subgoal_tac "set_asid t = set_asid ba \<and> set_asid ba = set_asid bc")
     apply presburger
    apply (rule conjI, drule mmu_incon_eq_asid_root_mem')
     apply presburger
    apply (clarsimp simp: write'mem1_def raise'exception_def split: if_split_asm)
   apply (clarsimp simp: write'mem1_def raise'exception_def split: if_split_asm)
  apply (simp only: incon_addrs_def)
  apply simp
  apply (rule conjI)
   apply (clarsimp simp: saturated_def)
  apply (rule conjI)
   apply (drule_tac s = b and t = ba and q = bc and r = bb in mmu_write_incon_set_rel; clarsimp simp:)
  apply (rule conjI)
   apply (frule_tac t = bb and r = bc and q = ba and s = b in  mmu_write_asid_ptcomp_rel ; clarsimp simp:)
  apply (rule conjI)
   apply (simp only: global_entries_union)
   apply clarsimp
   apply blast
  apply (clarsimp simp: )
  apply (subgoal_tac "sat_tlb b \<union> the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e} =
                       sat_tlb b \<union> non_global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e}) \<union>
                                    global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})")
   prefer 2
   apply (metis (no_types) sup_assoc tlb_global_non_global_union)
  apply clarsimp
  apply (thin_tac "sat_tlb b \<union> the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e} =
                       sat_tlb b \<union> non_global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e}) \<union>
                                    global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})")
  apply (subgoal_tac "lookup'' (non_global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})) a v = Miss")
   prefer 2
   apply (clarsimp simp: asid_unequal_lookup_pt_walk_miss)
  apply (drule_tac t = "sat_tlb b" and t''' = "global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})"
      and t'' = "global_entries (sat_tlb b \<union> non_global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e}) \<union>
       global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e}))" in  lookup_union_minus_equal)
  apply clarsimp
  apply (subgoal_tac " global_entries (sat_tlb b \<union> non_global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e}) \<union>
                     global_entries (the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})) =
                          global_entries (sat_tlb b \<union> the ` {e \<in> range (pt_walk (set_asid bc) (MEM bc) (TTBR0 bb)). \<not> is_fault e})")
   prefer 2
   apply (clarsimp simp: global_entries_def non_global_entries_def) apply blast
  apply (clarsimp)
  apply (subgoal_tac "sat_tlb b = sat_tlb s  \<and> set_tlb ba = set_tlb t")
   prefer 2
   apply (clarsimp simp: mmu_translate_saturated_tlb_unchange mmu_translate_incon_unchange)
  apply clarsimp
  apply (clarsimp simp: global_entries_union)
  apply (clarsimp simp: Un_Diff)
  apply (simp only: set_double_minus [symmetric])
  apply clarsimp
  apply (drule_tac x = a in spec, clarsimp, drule_tac x = v in spec)
  apply (clarsimp simp: lookup_minus_smaller_order)
  done

(* refinement for read theroems *)

lemma  mem_read1_consistent_tlb_rel_non_det_det:
  " \<lbrakk>mem_read1 (a, sz) s = (val, s');   mem_read1 (a, sz) t = (val', t');
               consistent0 (lookup'' (det_tlb t) (det_asid t)) (pt_walk (det_asid t)  (MEM t) (TTBR0 t))   va; tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)\<rbrakk>
              \<Longrightarrow> consistent0 (lookup'' (det_tlb t')  (det_asid t')) (pt_walk (det_asid t') (MEM t') (TTBR0 t')) va \<and> tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t')"
   apply (rule conjI)
   apply (subgoal_tac "MEM t = MEM t' \<and>   TTBR0 t = TTBR0 t' \<and> det_asid t = det_asid t' \<and> det_tlb t = det_tlb t'")
    apply (clarsimp simp: consistent0_def)
   prefer 2
   apply (subgoal_tac " exception s' =  exception t'")
    apply (drule mem1_read_exception)
    apply (drule mem1_read_exception)
    apply (clarsimp simp: tlb_rel_det_def)
    apply (clarsimp simp: saturated_def  state.truncate_def)
    apply (cases s', cases t')
    apply clarsimp
   apply (subgoal_tac "MEM s = MEM t \<and> exception s = exception t")
    apply (thin_tac "tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)")
    apply (clarsimp simp: mem_read1_def)
    apply (clarsimp split: if_split_asm)
        apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
       apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
      apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
     subgoal
     by (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
    apply (clarsimp simp: raise'exception_def split: option.splits if_split_asm)
   apply (clarsimp simp: tlb_rel_det_def state.defs)
  apply (drule mem1_read_exception)
  apply (drule mem1_read_exception)
  apply (cases t, cases t' , clarsimp)
   done

lemma  mem_read1_consistent_tlb_rel_det_sat:
  " \<lbrakk>mem_read1 (a, sz) s = (val, s');   mem_read1 (a, sz) t = (val', t');
                consistent0 (lookup'' (sat_tlb t) (sat_asid t)) (pt_walk (sat_asid t) (MEM t) (TTBR0 t)) va; tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)\<rbrakk>
              \<Longrightarrow>  consistent0 (lookup'' (sat_tlb t') (sat_asid t')) (pt_walk (sat_asid t') (MEM t') (TTBR0 t')) va \<and> tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t')"
   apply (rule conjI)
   apply (subgoal_tac "MEM t = MEM t' \<and>   TTBR0 t = TTBR0 t' \<and> sat_asid t = sat_asid t' \<and> sat_tlb t = sat_tlb t'")
    apply (clarsimp simp: consistent0_def)
   prefer 2
   apply (subgoal_tac " exception s' =  exception t'")
    apply (drule mem1_read_exception)
    apply (drule mem1_read_exception)
    apply (clarsimp simp: tlb_rel_sat_def)
    apply (clarsimp simp: saturated_def  state.truncate_def)
    apply (cases s', cases t')
    apply clarsimp
   apply (subgoal_tac "MEM s = MEM t \<and> exception s = exception t")
    apply (thin_tac "tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)")
    apply (clarsimp simp: mem_read1_def)
    apply (clarsimp split: if_split_asm)
        apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
       apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
      apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
     subgoal
     by (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
    apply (clarsimp simp: raise'exception_def split: option.splits if_split_asm)
   apply (clarsimp simp: tlb_rel_sat_def state.defs)
  apply (drule mem1_read_exception)
  apply (drule mem1_read_exception)
  apply (cases t, cases t' , clarsimp)
   done

lemma mmu_read_non_det_det_rel_cons:
  "\<lbrakk> mmu_read_size (va, sz) s = (val, s'); tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t);
         consistent (typ_det_tlb t) va; mmu_read_size (va, sz) t = (val', t') \<rbrakk> \<Longrightarrow>
                     consistent (typ_det_tlb t') va \<and>  tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t') "
  apply (clarsimp simp: mmu_read_size_det_tlb_state_ext_def   mmu_read_size_non_det_tlb_state_ext_def Let_def)
  apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
  apply (drule_tac t = t in mmu_translate_non_det_det_refine ; clarsimp simp: Let_def mem_read1_consistent_tlb_rel_non_det_det)
  done

lemma mmu_read_det_sat_rel_cons:
  "\<lbrakk> mmu_read_size (va, sz) s = (val, s'); tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t);
         consistent (typ_sat_tlb t) va; mmu_read_size (va, sz) t = (val', t') \<rbrakk> \<Longrightarrow>
                     consistent (typ_sat_tlb t') va \<and>  tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t') "
  apply (clarsimp simp: mmu_read_size_sat_tlb_state_ext_def   mmu_read_size_det_tlb_state_ext_def Let_def)
  apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
  apply (drule_tac t = t in mmu_translate_det_sat_refine ; clarsimp simp: Let_def mem_read1_consistent_tlb_rel_det_sat)
  done

lemma same_mem_read_equal:
  "\<lbrakk>MEM s = MEM t; mem_read1 (pa, sz) s = (val, s'); mem_read1 (pa, sz) t = (val', t')  \<rbrakk> \<Longrightarrow> val = val'"
  apply (clarsimp simp: mem_read1_def)
  apply (clarsimp split: if_split_asm)
      apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
     apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
    apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
  subgoal
    by (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
  apply (clarsimp simp: raise'exception_def split: option.splits if_split_asm)
    done

lemma mmu_read_non_det_det_refine:
  "\<lbrakk>mmu_read_size (va, sz) s = (val, s');  mmu_read_size (va, sz) t = (val', t');
              tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t); consistent (typ_det_tlb t) va\<rbrakk> \<Longrightarrow>
                     val = val' \<and> tlb_rel_det (typ_non_det_tlb s') (typ_det_tlb t') \<and> consistent (typ_det_tlb t') va  "
  apply (rule conjI)
   apply (clarsimp simp: mmu_read_size_det_tlb_state_ext_def   mmu_read_size_non_det_tlb_state_ext_def Let_def)
   apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
   apply (rename_tac pa s'' pa' t'')
   apply (subgoal_tac "pa = pa'", clarsimp)
    apply (subgoal_tac "MEM s'' = MEM t''")
     apply (clarsimp simp: same_mem_read_equal)
  using mmu_det_eq_asid_root_mem mmu_eq_asid_root_mem tlb_rel_detD apply fastforce
  using det_tlb_more mmu_translate_non_det_det_pa apply fastforce
  by (frule_tac t = t and t' =t' in  mmu_read_non_det_det_rel_cons; simp?)

lemma mmu_read_non_det_sat_refine:
  "\<lbrakk>mmu_read_size (va, sz) s = (val, s');  mmu_read_size (va, sz) t = (val', t');
              tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t); consistent (typ_sat_tlb t) va\<rbrakk> \<Longrightarrow>
                     val = val' \<and> tlb_rel_sat (typ_det_tlb s') (typ_sat_tlb t') \<and> consistent (typ_sat_tlb t') va  "
  apply (rule conjI)
   apply (clarsimp simp: mmu_read_size_det_tlb_state_ext_def   mmu_read_size_sat_tlb_state_ext_def Let_def)
   apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
   apply (rename_tac pa s'' pa' t'')
   apply (subgoal_tac "pa = pa'", clarsimp)
    apply (subgoal_tac "MEM s'' = MEM t''")
     apply (clarsimp simp: same_mem_read_equal)
  using mmu_det_eq_asid_root_mem mmu_sat_eq_asid_root_mem tlb_rel_satD apply fastforce
  apply (simp add: mmu_translate_non_det_sat_pa)
  apply (frule_tac t = t and t' =t' in  mmu_read_det_sat_rel_cons; simp?)
  done

lemma mmu_read_sat_const_inter [simp]:
  "saturated (typ_sat_tlb s) \<Longrightarrow> sat_tlb (snd (mmu_read_size v s)) = sat_tlb s "
   by (clarsimp simp: mmu_read_size_sat_tlb_state_ext_def split_def Let_def
                      mem_read1_def raise'exception_def  split: if_split_asm)

lemma  mem_read1_consistent_tlb_rel_incon:
  "\<lbrakk>mem_read1 (a, sz) s = (val, s'); mem_read1 (a, sz) t = (val', t');
             va \<notin> iset (set_tlb t); tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)\<rbrakk>
              \<Longrightarrow>  va \<notin> iset(set_tlb t') \<and>  tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t')"
  apply (rule conjI)
   apply (subgoal_tac "set_tlb t = set_tlb t'")
    apply clarsimp
   apply (drule mem1_read_exception)
   apply (drule mem1_read_exception)
   apply (cases t, cases t')
   apply clarsimp
  apply (subgoal_tac "exception s' =  exception t'")
   apply (drule mem1_read_exception)
   apply (drule mem1_read_exception)
   apply (clarsimp simp: tlb_rel_abs_def)
   apply (rule conjI)
    apply (clarsimp simp: state.defs)
    apply (cases s', cases t')
    apply clarsimp
   apply (rule conjI)
    apply (clarsimp simp: state.defs)
    apply (cases s', cases t')
    apply clarsimp
   apply (rule conjI)
    apply (clarsimp simp:  saturated_def)
  apply (rule conjI)
    apply (clarsimp simp: incon_addrs_def inconsistent_vaddrs_def incoherrent_vaddrs_def)
    apply (cases s', cases t')
    apply clarsimp
   apply (rule conjI)
    apply (cases t, cases t')
    apply (clarsimp)
   apply clarsimp
   apply (subgoal_tac "set_tlb t' = set_tlb t")
    apply clarsimp
   apply (cases t, cases t')
   apply clarsimp
  apply (subgoal_tac "MEM s = MEM t \<and> exception s = exception t")
   apply (thin_tac " va \<notin> iset(set_tlb t)")
   apply (thin_tac " tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)")
   apply (clarsimp simp: mem_read1_def)
   apply (clarsimp split: if_split_asm)
       apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
      apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
     apply (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
    subgoal
    by (clarsimp simp: mem1_def raise'exception_def split: option.splits if_split_asm)
   apply (clarsimp simp: raise'exception_def split: option.splits if_split_asm)
  apply (clarsimp simp: tlb_rel_abs_def state.defs)
  done

lemma mmu_read_sat_incon_rel_con:
  "\<lbrakk> mmu_read_size (va, sz) s = (val, s'); tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t);
         va \<notin> iset (set_tlb t); mmu_read_size (va, sz) t = (val', t') \<rbrakk> \<Longrightarrow>
                     va \<notin> iset(set_tlb t') \<and>  tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t') "
  apply (clarsimp simp: mmu_read_size_sat_tlb_state_ext_def  mmu_read_size_set_tlb_state_ext_def Let_def)
  apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
  apply (drule_tac t = t and pa' = aa  and t' = ba in mmu_translate_sat_incon_refine ; clarsimp simp: Let_def mem_read1_consistent_tlb_rel_incon)
  done

lemma mmu_read_sat_incon_refine:
  "\<lbrakk> mmu_read_size (va, sz) s = (val, s'); mmu_read_size (va, sz) t = (val', t');
        tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t); va \<notin> iset (set_tlb t)  \<rbrakk> \<Longrightarrow>
                    val = val' \<and> tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t') \<and> va \<notin> iset(set_tlb t')"
  apply (rule conjI)
   apply (clarsimp simp: mmu_read_size_sat_tlb_state_ext_def  mmu_read_size_set_tlb_state_ext_def Let_def)
   apply (cases "mmu_translate va s", cases "mmu_translate va t", clarsimp)
   apply (rename_tac pa s'' pa' t'')
   apply (subgoal_tac "pa = pa'", clarsimp)
    apply (subgoal_tac "MEM s'' = MEM t''")
     apply (clarsimp simp: same_mem_read_equal)
    using mmu_translate_sat_incon_mem_excp apply force
   using mmu_translate_sat_incon_refine apply force
   by (frule_tac t = t and t' = t' in  mmu_read_sat_incon_rel_con; simp)

end


(*  Title:      HOL/Auth/n_german_lemma_inv__52_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__52_on_rules imports n_german_lemma_on_inv__52
begin
section{*All lemmas on causal relation between inv__52*}
lemma lemma_inv__52_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__52  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqEIVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqES  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqESVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReq N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvEVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvSVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__52) done
    }

    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__52) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end