theory Read_Write_Ref

imports  Address_Translate_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 ()  (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 ()  (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)) va \<le> lookup' (det_tlb t) va")
   prefer 2
   apply (simp add:  sup.absorb1 tlb_mono tlb_rel_det_def)
   apply (meson Diff_subset order_trans 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) 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_tlb apply blast
   apply (clarsimp simp:  mmu_translate_det_tlb_state_ext_def)
   apply (case_tac "lookup' (det_tlb t) va")
     apply (subgoal_tac "lookup' (non_det_tlb s - tlb_evict (typ_non_det_tlb s)) 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 UnE inf_sup_ord(4) lookup_in_tlb lookup_type.inject lookup_type.simps(5) subset_eq)
  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)) va \<le> lookup' (det_tlb t) va")
      prefer 2
      apply (simp add:  sup.absorb1 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)  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 () (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))  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_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_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'"
  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))   va \<le> lookup' (det_tlb t) va")
   prefer 2
   apply (simp add: sup.absorb1 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) 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 ()   (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 ()  (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))   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 "  TTBR0 s = TTBR0 ba ")
    apply (clarsimp simp: saturated_def)
   apply (subgoal_tac " 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 ()   (MEM s) (TTBR0 s) ` UNIV. \<not> is_fault e} \<or>
     sat_tlb s' = sat_tlb s \<union> the `{e\<in>pt_walk ()   (MEM s) (TTBR0 s) ` UNIV. \<not> is_fault e} \<union> the `{e\<in>pt_walk ()   (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 ()   (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'"
  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)
  apply (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)
  done

(* refinement between saturated and second abstracted model *)

(*lemma pt_walk_new_equal_pt_walk:
  "pt_walk_pair a m rt v = pt_walk_pair a' m' rt' v \<Longrightarrow> pt_walk () a m rt v = pt_walk () a' m' rt' v"
  by (cases "pt_walk_pair a m rt v"; cases "pt_walk_pair a' m' rt' v";
               clarsimp simp: pt_walk_new_fault_pt_walk_fault' pt_walk_new_par_fault_pt_walk_fault'
                              pt_walk_new_no_fault_pt_walk)
*)

lemma  not_elem_rewrite':
  "bb
                \<notin>
                   {va. \<not> is_fault (pt_walk ()   (MEM b) (TTBR0 b) va) \<and> \<not> is_fault (pt_walk ()   (MEM bc) (TTBR0 b) va) \<and> pt_walk ()   (MEM b) (TTBR0 b) va \<noteq> pt_walk ()   (MEM bc) (TTBR0 b) va \<or>
                        \<not> is_fault (pt_walk ()   (MEM b) (TTBR0 b) va) \<and> is_fault (pt_walk ()   (MEM bc) (TTBR0 b) va)} \<Longrightarrow>
   (is_fault (pt_walk ()   (MEM b) (TTBR0 b) bb) \<or> is_fault (pt_walk ()   (MEM bc) (TTBR0 b) bb) \<or> pt_walk ()   (MEM b) (TTBR0 b) bb = pt_walk ()   (MEM bc) (TTBR0 b) bb) \<and>
            (is_fault (pt_walk ()   (MEM b) (TTBR0 b) bb) \<or> \<not> is_fault (pt_walk ()   (MEM bc) (TTBR0 b) bb))  "
  by force

lemma mmu_write_incon_set_rel:
  "\<lbrakk> saturated (typ_sat_tlb s) ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> set_tlb t  ;  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> set_tlb t  ;   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 ()  (MEM q) (TTBR0 r)). \<not> is_fault e}\<rparr>))
           \<subseteq> set_tlb t \<union> incon_comp  (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 (erule disjE)
    apply (drule union_incon_cases)
    apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
    apply (erule disjE, blast)
    apply (erule disjE, blast)
    apply (erule disjE, blast)
    apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
    apply blast
   apply (drule union_incon_cases)
   apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
   apply (erule disjE, blast)
   apply (erule disjE, blast)
   apply (erule disjE, blast)
   apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
   apply blast
  apply (erule disjE)
   apply (erule disjE)
    apply (drule union_incon_cases)
    apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
    apply (erule disjE, blast)
    apply (erule disjE, blast)
    apply (erule disjE, blast)
    apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
    apply blast
   apply (drule union_incon_cases)
   apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
   apply (erule disjE, blast)
   apply (erule disjE, blast)
   apply (erule disjE, blast)
   apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
   apply blast
  apply (drule union_incon_cases)
  apply (erule disjE, clarsimp simp: lookup_range_pt_walk_not_incon)
  apply (erule disjE, blast)
  apply (erule disjE, clarsimp)
   apply (subgoal_tac "the (pt_walk () (MEM q) (TTBR0 r) xc) = the (pt_walk () (MEM q) (TTBR0 r) x)")
    apply clarsimp
  using saturatd_lookup_hit_no_fault apply fastforce
   apply (frule lookup_range_fault_pt_walk)
   apply (drule_tac x = x in bspec)
  using lookup_hit_entry_range_asid_tags apply blast
   apply clarsimp
  using  lookup_range_pt_walk_not_incon by blast

lemma  mmu_write_asid_ptcomp_rel:
  "\<lbrakk>saturated (typ_sat_tlb s) ;   MEM t = MEM r; TTBR0 t = TTBR0 s ;
       inconsistent_vaddrs (typ_sat_tlb s) \<subseteq> set_tlb q ;  incoherrent_vaddrs (typ_sat_tlb s) \<subseteq> set_tlb q\<rbrakk> \<Longrightarrow>
      incoherrent_vaddrs  (typ_sat_tlb (t\<lparr>sat_tlb := sat_tlb s \<union> the ` {e \<in> range (pt_walk ()   (MEM r) (TTBR0 t)). \<not> is_fault e}\<rparr>)) \<subseteq> set_tlb q \<union>
                                            incon_comp  (MEM s) (MEM r) (TTBR0 t) (TTBR0 t)"
  apply rule
  apply (clarsimp simp: incoherrent_vaddrs_def  inconsistent_vaddrs_def )
   apply (drule lookup_hit_union_cases')
   apply (erule disjE)
    apply (clarsimp simp: incon_comp_def ptable_comp_def Let_def)
    apply (subgoal_tac "is_fault (pt_walk ()  (MEM s) (TTBR0 s) x)")
    apply blast
  apply blast
   by  (clarsimp simp: 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> 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
   using write_mem_state_trun_equal apply blast
  apply (rule conjI , clarsimp simp: state.defs)
  apply (subgoal_tac "MEM bb = MEM bc  \<and> MEM s = MEM b" , simp)
   apply (subgoal_tac "  TTBR0 s = TTBR0 b" , simp)
    apply (subgoal_tac "saturated (typ_sat_tlb b)")
     prefer 2 apply blast
    prefer 2 using mmu_sat_eq_asid_root_mem apply blast
   prefer 2
   apply (rule conjI)
    apply (clarsimp simp: state.defs)
    using mmu_sat_eq_asid_root_mem
   apply blast
  apply (subgoal_tac "TTBR0 b = TTBR0 bb")
   apply (simp only: incon_addrs_def)
   apply simp
   apply (rule conjI)
    apply (drule_tac s = b and t = ba and q = bc and r = bb in mmu_write_incon_set_rel; clarsimp)
   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 (clarsimp simp: saturated_def)
    by (simp add: write_mem1_eq_ASID_TTBR0)

(* 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)) (pt_walk () (MEM t) (TTBR0 t)) va; tlb_rel_det (typ_non_det_tlb s) (typ_det_tlb t)\<rbrakk>
              \<Longrightarrow> consistent0 (lookup' (det_tlb t')) (pt_walk () (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_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)) (pt_walk () (MEM t) (TTBR0 t)) va; tlb_rel_sat (typ_det_tlb s) (typ_sat_tlb t)\<rbrakk>
              \<Longrightarrow>  consistent0 (lookup' (sat_tlb t')) (pt_walk () (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_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
  apply (metis (mono_tags, lifting) case_prodD det_tlb_more mmu_translate_non_det_det_refine tlb_rel_det_def typ_det_prim_parameter)
  apply (frule_tac t = t and t' =t' in  mmu_read_non_det_det_rel_cons; simp?)
  done

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> set_tlb t; tlb_rel_abs (typ_sat_tlb s) (typ_set_tlb t)\<rbrakk>
              \<Longrightarrow>  va \<notin> 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: incon_addrs_def inconsistent_vaddrs_def incoherrent_vaddrs_def)
    apply (cases s', cases t')
    apply clarsimp
    apply (clarsimp simp:  saturated_def)
   apply (subgoal_tac "MEM s = MEM t \<and> exception s = exception t")
    apply (thin_tac " va \<notin> 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> set_tlb t; mmu_read_size (va, sz) t = (val', t') \<rbrakk> \<Longrightarrow>
                     va \<notin> 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> set_tlb t  \<rbrakk> \<Longrightarrow>
                    val = val' \<and> tlb_rel_abs (typ_sat_tlb s') (typ_set_tlb t') \<and> va \<notin> 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/UNITY/Comp/AllocImpl.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1998  University of Cambridge
*)

section\<open>Implementation of a multiple-client allocator from a single-client allocator\<close>

theory AllocImpl imports AllocBase "../Follows" "../PPROD" begin

(** State definitions.  OUTPUT variables are locals **)

(*Type variable 'b is the type of items being merged*)
record 'b merge =
  In   :: "nat => 'b list"  (*merge's INPUT histories: streams to merge*)
  Out  :: "'b list"         (*merge's OUTPUT history: merged items*)
  iOut :: "nat list"        (*merge's OUTPUT history: origins of merged items*)

record ('a,'b) merge_d =
  "'b merge" +
  dummy :: 'a       (*dummy field for new variables*)

definition non_dummy :: "('a,'b) merge_d => 'b merge" where
    "non_dummy s = (|In = In s, Out = Out s, iOut = iOut s|)"

record 'b distr =
  In  :: "'b list"          (*items to distribute*)
  iIn :: "nat list"         (*destinations of items to distribute*)
  Out :: "nat => 'b list"   (*distributed items*)

record ('a,'b) distr_d =
  "'b distr" +
  dummy :: 'a       (*dummy field for new variables*)

record allocState =
  giv :: "nat list"   (*OUTPUT history: source of tokens*)
  ask :: "nat list"   (*INPUT: tokens requested from allocator*)
  rel :: "nat list"   (*INPUT: tokens released to allocator*)

record 'a allocState_d =
  allocState +
  dummy    :: 'a                (*dummy field for new variables*)

record 'a systemState =
  allocState +
  mergeRel :: "nat merge"
  mergeAsk :: "nat merge"
  distr    :: "nat distr"
  dummy    :: 'a                  (*dummy field for new variables*)

(** Merge specification (the number of inputs is Nclients) ***)

definition
  (*spec (10)*)
  merge_increasing :: "('a,'b) merge_d program set"
  where "merge_increasing =
         UNIV guarantees (Increasing merge.Out) Int (Increasing merge.iOut)"

definition
  (*spec (11)*)
  merge_eqOut :: "('a,'b) merge_d program set"
  where "merge_eqOut =
         UNIV guarantees
         Always {s. length (merge.Out s) = length (merge.iOut s)}"

definition
  (*spec (12)*)
  merge_bounded :: "('a,'b) merge_d program set"
  where "merge_bounded =
         UNIV guarantees
         Always {s. \<forall>elt \<in> set (merge.iOut s). elt < Nclients}"

definition
  (*spec (13)*)
  merge_follows :: "('a,'b) merge_d program set"
  where "merge_follows =
         (\<Inter>i \<in> lessThan Nclients. Increasing (sub i o merge.In))
         guarantees
         (\<Inter>i \<in> lessThan Nclients.
          (%s. nths (merge.Out s)
                       {k. k < size(merge.iOut s) & merge.iOut s! k = i})
          Fols (sub i o merge.In))"

definition
  (*spec: preserves part*)
  merge_preserves :: "('a,'b) merge_d program set"
  where "merge_preserves = preserves merge.In Int preserves merge_d.dummy"

definition
  (*environmental constraints*)
  merge_allowed_acts :: "('a,'b) merge_d program set"
  where "merge_allowed_acts =
       {F. AllowedActs F =
            insert Id (\<Union> (Acts ` preserves (funPair merge.Out iOut)))}"

definition
  merge_spec :: "('a,'b) merge_d program set"
  where "merge_spec = merge_increasing Int merge_eqOut Int merge_bounded Int
                   merge_follows Int merge_allowed_acts Int merge_preserves"

(** Distributor specification (the number of outputs is Nclients) ***)

definition
  (*spec (14)*)
  distr_follows :: "('a,'b) distr_d program set"
  where "distr_follows =
         Increasing distr.In Int Increasing distr.iIn Int
         Always {s. \<forall>elt \<in> set (distr.iIn s). elt < Nclients}
         guarantees
         (\<Inter>i \<in> lessThan Nclients.
          (sub i o distr.Out) Fols
          (%s. nths (distr.In s)
                       {k. k < size(distr.iIn s) & distr.iIn s ! k = i}))"

definition
  distr_allowed_acts :: "('a,'b) distr_d program set"
  where "distr_allowed_acts =
       {D. AllowedActs D = insert Id (\<Union>(Acts ` (preserves distr.Out)))}"

definition
  distr_spec :: "('a,'b) distr_d program set"
  where "distr_spec = distr_follows Int distr_allowed_acts"

(** Single-client allocator specification (required) ***)

definition
  (*spec (18)*)
  alloc_increasing :: "'a allocState_d program set"
  where "alloc_increasing = UNIV  guarantees  Increasing giv"

definition
  (*spec (19)*)
  alloc_safety :: "'a allocState_d program set"
  where "alloc_safety =
         Increasing rel
         guarantees  Always {s. tokens (giv s) \<le> NbT + tokens (rel s)}"

definition
  (*spec (20)*)
  alloc_progress :: "'a allocState_d program set"
  where "alloc_progress =
         Increasing ask Int Increasing rel Int
         Always {s. \<forall>elt \<in> set (ask s). elt \<le> NbT}
         Int
         (\<Inter>h. {s. h \<le> giv s & h pfixGe (ask s)}
                 LeadsTo
                 {s. tokens h \<le> tokens (rel s)})
         guarantees  (\<Inter>h. {s. h \<le> ask s} LeadsTo {s. h pfixLe giv s})"

definition
  (*spec: preserves part*)
  alloc_preserves :: "'a allocState_d program set"
  where "alloc_preserves = preserves rel Int
                        preserves ask Int
                        preserves allocState_d.dummy"

definition
  (*environmental constraints*)
  alloc_allowed_acts :: "'a allocState_d program set"
  where "alloc_allowed_acts =
       {F. AllowedActs F = insert Id (\<Union>(Acts ` (preserves giv)))}"

definition
  alloc_spec :: "'a allocState_d program set"
  where "alloc_spec = alloc_increasing Int alloc_safety Int alloc_progress Int
                   alloc_allowed_acts Int alloc_preserves"

locale Merge =
  fixes M :: "('a,'b::order) merge_d program"
  assumes
    Merge_spec:  "M  \<in> merge_spec"

locale Distrib =
  fixes D :: "('a,'b::order) distr_d program"
  assumes
    Distrib_spec:  "D \<in> distr_spec"

(****
#  {** Network specification ***}

#    {*spec (9.1)*}
#    network_ask :: "'a systemState program set
#       "network_ask == \<Inter>i \<in> lessThan Nclients.
#                           Increasing (ask o sub i o client)
#                           guarantees[ask]
#                           (ask  Fols (ask o sub i o client))"

#    {*spec (9.2)*}
#    network_giv :: "'a systemState program set
#       "network_giv == \<Inter>i \<in> lessThan Nclients.
#                           Increasing giv
#                           guarantees[giv o sub i o client]
#                           ((giv o sub i o client) Fols giv)"

#    {*spec (9.3)*}
#    network_rel :: "'a systemState program set
#       "network_rel == \<Inter>i \<in> lessThan Nclients.
#                           Increasing (rel o sub i o client)
#                           guarantees[rel]
#                           (rel  Fols (rel o sub i o client))"

#    {*spec: preserves part*}
#       network_preserves :: "'a systemState program set
#       "network_preserves == preserves giv  Int
#                             (\<Inter>i \<in> lessThan Nclients.
#                              preserves (funPair rel ask o sub i o client))"

#    network_spec :: "'a systemState program set
#       "network_spec == network_ask Int network_giv Int
#                        network_rel Int network_preserves"

#  {** State mappings **}
#    sysOfAlloc :: "((nat => merge) * 'a) allocState_d => 'a systemState"
#       "sysOfAlloc == %s. let (cl,xtr) = allocState_d.dummy s
#                          in (| giv = giv s,
#                                ask = ask s,
#                                rel = rel s,
#                                client   = cl,
#                                dummy    = xtr|)"

#    sysOfClient :: "(nat => merge) * 'a allocState_d => 'a systemState"
#       "sysOfClient == %(cl,al). (| giv = giv al,
#                                    ask = ask al,
#                                    rel = rel al,
#                                    client   = cl,
#                                    systemState.dummy = allocState_d.dummy al|)"
****)

declare subset_preserves_o [THEN subsetD, intro]
declare funPair_o_distrib [simp]
declare Always_INT_distrib [simp]
declare o_apply [simp del]

subsection\<open>Theorems for Merge\<close>

context Merge
begin

lemma Merge_Allowed:
     "Allowed M = (preserves merge.Out) Int (preserves merge.iOut)"
apply (cut_tac Merge_spec)
apply (auto simp add: merge_spec_def merge_allowed_acts_def Allowed_def
                      safety_prop_Acts_iff)
done

lemma M_ok_iff [iff]:
     "M ok G = (G \<in> preserves merge.Out & G \<in> preserves merge.iOut &
                     M \<in> Allowed G)"
by (auto simp add: Merge_Allowed ok_iff_Allowed)

lemma Merge_Always_Out_eq_iOut:
     "[| G \<in> preserves merge.Out; G \<in> preserves merge.iOut; M \<in> Allowed G |]
      ==> M \<squnion> G \<in> Always {s. length (merge.Out s) = length (merge.iOut s)}"
apply (cut_tac Merge_spec)
apply (force dest: guaranteesD simp add: merge_spec_def merge_eqOut_def)
done

lemma Merge_Bounded:
     "[| G \<in> preserves merge.iOut; G \<in> preserves merge.Out; M \<in> Allowed G |]
      ==> M \<squnion> G \<in> Always {s. \<forall>elt \<in> set (merge.iOut s). elt < Nclients}"
apply (cut_tac Merge_spec)
apply (force dest: guaranteesD simp add: merge_spec_def merge_bounded_def)
done

lemma Merge_Bag_Follows_lemma:
     "[| G \<in> preserves merge.iOut; G \<in> preserves merge.Out; M \<in> Allowed G |]
  ==> M \<squnion> G \<in> Always
          {s. (\<Sum>i \<in> lessThan Nclients. bag_of (nths (merge.Out s)
                                  {k. k < length (iOut s) & iOut s ! k = i})) =
              (bag_of o merge.Out) s}"
apply (rule Always_Compl_Un_eq [THEN iffD1])
apply (blast intro: Always_Int_I [OF Merge_Always_Out_eq_iOut Merge_Bounded])
apply (rule UNIV_AlwaysI, clarify)
apply (subst bag_of_nths_UN_disjoint [symmetric])
  apply (simp)
 apply blast
apply (simp add: set_conv_nth)
apply (subgoal_tac
       "(\<Union>i \<in> lessThan Nclients. {k. k < length (iOut x) & iOut x ! k = i}) =
       lessThan (length (iOut x))")
 apply (simp (no_asm_simp) add: o_def)
apply blast
done

lemma Merge_Bag_Follows:
     "M \<in> (\<Inter>i \<in> lessThan Nclients. Increasing (sub i o merge.In))
          guarantees
             (bag_of o merge.Out) Fols
             (%s. \<Sum>i \<in> lessThan Nclients. (bag_of o sub i o merge.In) s)"
apply (rule Merge_Bag_Follows_lemma [THEN Always_Follows1, THEN guaranteesI], auto)
apply (rule Follows_sum)
apply (cut_tac Merge_spec)
apply (auto simp add: merge_spec_def merge_follows_def o_def)
apply (drule guaranteesD)
  prefer 3
  apply (best intro: mono_bag_of [THEN mono_Follows_apply, THEN subsetD], auto)
done

end

subsection\<open>Theorems for Distributor\<close>

context Distrib
begin

lemma Distr_Increasing_Out:
     "D \<in> Increasing distr.In Int Increasing distr.iIn Int
          Always {s. \<forall>elt \<in> set (distr.iIn s). elt < Nclients}
          guarantees
          (\<Inter>i \<in> lessThan Nclients. Increasing (sub i o distr.Out))"
apply (cut_tac Distrib_spec)
apply (simp add: distr_spec_def distr_follows_def)
apply clarify
apply (blast intro: guaranteesI Follows_Increasing1 dest: guaranteesD)
done

lemma Distr_Bag_Follows_lemma:
     "[| G \<in> preserves distr.Out;
         D \<squnion> G \<in> Always {s. \<forall>elt \<in> set (distr.iIn s). elt < Nclients} |]
  ==> D \<squnion> G \<in> Always
          {s. (\<Sum>i \<in> lessThan Nclients. bag_of (nths (distr.In s)
                                  {k. k < length (iIn s) & iIn s ! k = i})) =
              bag_of (nths (distr.In s) (lessThan (length (iIn s))))}"
apply (erule Always_Compl_Un_eq [THEN iffD1])
apply (rule UNIV_AlwaysI, clarify)
apply (subst bag_of_nths_UN_disjoint [symmetric])
  apply (simp (no_asm))
 apply blast
apply (simp add: set_conv_nth)
apply (subgoal_tac
       "(\<Union>i \<in> lessThan Nclients. {k. k < length (iIn x) & iIn x ! k = i}) =
        lessThan (length (iIn x))")
 apply (simp (no_asm_simp))
apply blast
done

lemma D_ok_iff [iff]:
     "D ok G = (G \<in> preserves distr.Out & D \<in> Allowed G)"
apply (cut_tac Distrib_spec)
apply (auto simp add: distr_spec_def distr_allowed_acts_def Allowed_def
                      safety_prop_Acts_iff ok_iff_Allowed)
done

lemma Distr_Bag_Follows:
 "D \<in> Increasing distr.In Int Increasing distr.iIn Int
      Always {s. \<forall>elt \<in> set (distr.iIn s). elt < Nclients}
      guarantees
       (\<Inter>i \<in> lessThan Nclients.
        (%s. \<Sum>i \<in> lessThan Nclients. (bag_of o sub i o distr.Out) s)
        Fols
        (%s. bag_of (nths (distr.In s) (lessThan (length(distr.iIn s))))))"
apply (rule guaranteesI, clarify)
apply (rule Distr_Bag_Follows_lemma [THEN Always_Follows2], auto)
apply (rule Follows_sum)
apply (cut_tac Distrib_spec)
apply (auto simp add: distr_spec_def distr_follows_def o_def)
apply (drule guaranteesD)
  prefer 3
  apply (best intro: mono_bag_of [THEN mono_Follows_apply, THEN subsetD], auto)
done

end

subsection\<open>Theorems for Allocator\<close>

lemma alloc_refinement_lemma:
     "!!f::nat=>nat. (\<Inter>i \<in> lessThan n. {s. f i \<le> g i s})
      \<subseteq> {s. (\<Sum>x \<in> lessThan n. f x) \<le> (\<Sum>x \<in> lessThan n. g x s)}"
apply (induct_tac "n")
apply (auto simp add: lessThan_Suc)
done

lemma alloc_refinement:
"(\<Inter>i \<in> lessThan Nclients. Increasing (sub i o allocAsk) Int
                           Increasing (sub i o allocRel))
  Int
  Always {s. \<forall>i. i<Nclients -->
              (\<forall>elt \<in> set ((sub i o allocAsk) s). elt \<le> NbT)}
  Int
  (\<Inter>i \<in> lessThan Nclients.
   \<Inter>h. {s. h \<le> (sub i o allocGiv)s & h pfixGe (sub i o allocAsk)s}
        LeadsTo {s. tokens h \<le> (tokens o sub i o allocRel)s})
  \<subseteq>
 (\<Inter>i \<in> lessThan Nclients. Increasing (sub i o allocAsk) Int
                           Increasing (sub i o allocRel))
  Int
  Always {s. \<forall>i. i<Nclients -->
              (\<forall>elt \<in> set ((sub i o allocAsk) s). elt \<le> NbT)}
  Int
  (\<Inter>hf. (\<Inter>i \<in> lessThan Nclients.
         {s. hf i \<le> (sub i o allocGiv)s & hf i pfixGe (sub i o allocAsk)s})
  LeadsTo {s. (\<Sum>i \<in> lessThan Nclients. tokens (hf i)) \<le>
              (\<Sum>i \<in> lessThan Nclients. (tokens o sub i o allocRel)s)})"
apply (auto simp add: ball_conj_distrib)
apply (rename_tac F hf)
apply (rule LeadsTo_weaken_R [OF Finite_stable_completion alloc_refinement_lemma], blast, blast)
apply (subgoal_tac "F \<in> Increasing (tokens o (sub i o allocRel))")
 apply (simp add: Increasing_def o_assoc)
apply (blast intro: mono_tokens [THEN mono_Increasing_o, THEN subsetD])
done

end


theory Memory_Nodes
  imports
    "../AutoCorres/Impl"
    "../lib/ExtraLemmas"
begin

context sable_isa
begin

abbreviation node_size
  where "node_size s n \<equiv> size_C (h_val (hrs_mem (t_hrs_' s)) n)"
abbreviation node_size_masked
  where "node_size_masked s n \<equiv> (node_size s n) && scast (~~ MEM_NODE_OCCUPIED_FLAG)"

abbreviation node_next
  where "node_next s n \<equiv> next_C (h_val (hrs_mem (t_hrs_' s)) n)"
abbreviation node_is_occupied
  where "node_is_occupied s n \<equiv> (mem_node_C.size_C (h_val (hrs_mem (t_hrs_' s)) n)) && scast  MEM_NODE_OCCUPIED_FLAG"

abbreviation node_val
  where "node_val s n \<equiv> (h_val (hrs_mem (t_hrs_' s)) n)"

abbreviation update_node :: " globals \<Rightarrow> mem_node_C ptr \<Rightarrow> mem_node_C \<Rightarrow> globals"
  where "update_node s n new_val \<equiv>
  (t_hrs_'_update (hrs_mem_update (heap_update n new_val)) s)"
value t_hrs_'_update

abbreviation hrs_the_same_at
  where "hrs_the_same_at s s' p \<equiv>
  fst (t_hrs_' s) p = fst (t_hrs_' s') p \<and> snd (t_hrs_' s) p = snd (t_hrs_' s') p"

lemma t_hrs_'_t_hrs_'_update_simp:
  "t_hrs_' (t_hrs_'_update m (s::globals)) = m (t_hrs_' s)" by simp

lemma updated_node_val:
  "h_val (hrs_mem (t_hrs_' (update_node s n new_val))) n = new_val"
  by (simp add: h_val_heap_update hrs_mem_update)

lemma updated_node_size:
  "node_size (update_node s n (mem_node_C nodeSize next)) n = nodeSize"
  using sable_isa.updated_node_val by auto

lemma updated_node_next:
  "node_next (update_node s n (mem_node_C nodeSize next)) n = next"
  using sable_isa.updated_node_val by auto

lemma hrs_the_same_nodes_the_same:
  "\<forall>p \<in> ptr_span (node::mem_node_C ptr). hrs_the_same_at s s' p \<Longrightarrow>
    node_val s node = node_val s' node"
  unfolding h_val_def hrs_mem_def
  apply (subgoal_tac " heap_list (fst (t_hrs_' s)) (size_of TYPE(mem_node_C)) (ptr_val node) =
     heap_list (fst (t_hrs_' s')) (size_of TYPE(mem_node_C)) (ptr_val node)")
   apply auto
  apply (rule heap_list_h_eq2)
  by simp

lemma MEM_NODE_OCCUPIED_FLAG_not_zero:
  "MEM_NODE_OCCUPIED_FLAG \<noteq> (0:: 32 signed word)" unfolding MEM_NODE_OCCUPIED_FLAG_def by auto

lemma one_mask_neg_MNOF_not_zero[simp]:
  "(1::32 signed word) && ~~ MEM_NODE_OCCUPIED_FLAG = (0::32 signed word) \<Longrightarrow> False"
     unfolding MEM_NODE_OCCUPIED_FLAG_def by unat_arith

lemma OCC_FLAG_helper1: "(x::32 word) && (scast MEM_NODE_OCCUPIED_FLAG) = 0 \<Longrightarrow>
    y \<le> x \<Longrightarrow>
    y && (scast MEM_NODE_OCCUPIED_FLAG) = 0"
  apply(subgoal_tac "scast MEM_NODE_OCCUPIED_FLAG = ~~ ((mask 31)::32 word)")
   apply(subgoal_tac "y && mask 31 = y ")
    apply (frule mask_eq_x_eq_0[THEN iffD1])
    apply simp
   apply (subgoal_tac "x \<le> mask 31")
    apply (metis (no_types, hide_lams) and_mask_eq_iff_le_mask less_le_trans not_less)
   apply (metis add.left_neutral word_and_le1 word_bool_alg.double_compl word_plus_and_or_coroll2)
  unfolding MEM_NODE_OCCUPIED_FLAG_def mask_def
  by simp

abbreviation
  array_span :: "'a::mem_type ptr \<Rightarrow> nat \<Rightarrow> addr set" where
  "array_span p arr_size \<equiv> {ptr_val p ..+ arr_size * size_of TYPE('a)}"

end
end