(*  Title:      HOL/Auth/n_g2kAbsAfter_lemma_inv__41_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_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__41_on_rules imports n_g2kAbsAfter_lemma_on_inv__41
begin
section{*All lemmas on causal relation between inv__41*}
lemma lemma_inv__41_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__41  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__41) done
    }

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

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__41) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__41) done
    }

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

end


(*  Title:      HOL/Auth/n_g2kAbsAfter_lemma_inv__45_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_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__45_on_rules imports n_g2kAbsAfter_lemma_on_inv__45
begin
section{*All lemmas on causal relation between inv__45*}
lemma lemma_inv__45_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__45  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__45) done
    }

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

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__45) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__45) done
    }

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

end


(*
 * Copyright 2016, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory OstoreInvS
imports
  "../impl/BilbyFs_Shallow_Desugar_Tuples"
  "../impl/BilbyFs_ShallowConsts_Desugar_Tuples"
  "../spec/OstoreS"
  "../spec/SerialS"
  "../spec/UbiS"
  "../adt/BufferT"
  "../adt/RbtT"
  "~~/src/HOL/Library/Sublist"
begin

definition
  \<alpha>_index :: "IndexState\<^sub>T \<Rightarrow> (ObjId \<rightharpoonup> ObjAddr\<^sub>T)"
where
 "\<alpha>_index index_st \<equiv> \<alpha>rbt (addrs\<^sub>f index_st)"

consts \<alpha>_fsm_gim :: "(ObjId,  GimNode\<^sub>T) Rbt \<Rightarrow> (ObjId \<rightharpoonup> GimNode\<^sub>T)"

definition
  nopad :: "U8 list \<Rightarrow> U8 list"
where
 "nopad xs \<equiv>
    dropWhile (op = bilbyFsPadByte) xs"

lemma pTrans_termination[simp]:
 "is_valid_ObjHeader obj (d # data) \<Longrightarrow>
    Suc (length data) - unat (Obj.len\<^sub>f obj) < Suc (length data)"
 "is_valid_ObjHeader obj data \<Longrightarrow>
    (length data) - unat (Obj.len\<^sub>f obj) < (length data)"
  unfolding bilbyFsObjHeaderSize_def
  by (drule is_valid_ObjHeader_len_facts,
         clarsimp simp add: bilbyFsObjHeaderSize_def, unat_arith)+

type_synonym Trans = "Obj\<^sub>T list"
fun
  pTrans :: "U8 list \<Rightarrow> (U8 list \<times> Trans)"
where
 "pTrans [] = ([],[])"
|pTrans_Cons: "pTrans data =
    (let obj = pObj data 0
    (* We stop at the first obviously invalid object. *)
     in if \<not>is_valid_ObjHeader obj data then
       (drop (max (unat bilbyFsObjHeaderSize) (unat (Obj.len\<^sub>f obj))) data, [])
     else if Obj.trans\<^sub>f obj = bilbyFsTransIn then
       (\<lambda>(d,os). (d, (obj#os))) (pTrans (drop (unat (Obj.len\<^sub>f obj)) data))
     else
       (drop (unat (Obj.len\<^sub>f obj)) data, [obj])
)"

lemma drop_0_eq[simp]:
  "\<exists>n. xs = drop n xs"
 by (rule_tac x=0 in exI, simp)

lemma pTrans_data_is_substring:
  "(\<exists>n. fst (pTrans data) = drop n data)"
  by (induct data rule: pTrans.induct) (fastforce simp: Let_def prod.case_eq_if)+

lemma pTrans_length_helper:
assumes len: "is_valid_ObjHeader (pObj (d # data) 0) (d # data)"
shows
  "length (fst (pTrans (drop (unat (Obj.len\<^sub>f (pObj (d # data) 0))) (d # data)))) < length (d # data)"
  using pTrans_data_is_substring apply clarsimp
  apply (drule_tac x="(drop (unat (Obj.len\<^sub>f (pObj (d # data) 0))) (d # data))" in meta_spec)
  using is_valid_ObjHeader_len[OF len]  apply (clarsimp simp: bilbyFsObjHeaderSize_def)
  apply unat_arith
 done

text {*
The termination proof above does not look at the shape of the returned
values of pTrans, it only shows that the size of the input
data list decreases.
To prove termination of \<alpha>_updates_fun we need to know that the returned data
list is smaller than the one received as argument.
I could not figure a way to reuse the termination proof above to show
that \<alpha>_updates_fun terminates. I wouldn't be surprise to see that there's
a simpler way to achieve my goal. If you find one, please educate me.
*}
lemma pTrans_termination_argument:
 "(nd#nds, o'#os) = pTrans (d#data) \<Longrightarrow> length (nd#nds) < length (d#data)"
  apply (clarsimp simp del: list.size split:split_if_asm
         simp : bilbyFsObjHeaderSize_def Let_def prod.case_eq_if)
  apply (fastforce dest: pTrans_length_helper simp: prod.case_eq_if)
 done

definition
  is_valid_addr :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> ObjAddr\<^sub>T \<Rightarrow> bool"
where
 "is_valid_addr mount_st ostore_st addr \<equiv>
    ebnum\<^sub>f addr < nb_eb\<^sub>f (super\<^sub>f mount_st) \<and>
    bilbyFsFirstLogEbNum \<le> ebnum\<^sub>f addr \<and>
    bilbyFsMinObjSize \<le> ObjAddr.len\<^sub>f addr \<and>
    offs\<^sub>f addr < offs\<^sub>f addr + ObjAddr.len\<^sub>f addr \<and>
    offs\<^sub>f addr + ObjAddr.len\<^sub>f addr \<le> eb_size\<^sub>f (super\<^sub>f mount_st) \<and>
    (ebnum\<^sub>f addr = wbuf_eb\<^sub>f ostore_st \<longrightarrow>
        (offs\<^sub>f addr + ObjAddr.len\<^sub>f addr \<le> used\<^sub>f ostore_st))"

text {* It turns out that transactions can be separated by few bilbyFsPadByte bytes.
This happens when there isn't enough room for a padding object to fill up a
hardware page. Thus there cannot be such padding area at an offset corresponding
to the beginning of a page.
*}
function
  list_trans :: "U8 list \<Rightarrow> (U8 list \<times> Trans list)"
where
"list_trans data =
    (case pTrans data of
      (_, []) \<Rightarrow> (data, []) (* We return the beginning of an invalid transaction as it's obviously non-empty *)
    | ([],objs) \<Rightarrow> ([], [objs])
    | (newdata, objs) \<Rightarrow>
      (*let objs = if length objs = 1 \<and>
                    otype\<^sub>f (objs!0) = bilbyFsObjTypePad then [] else objs
       in*) (\<lambda>(d,txs). (d,objs#txs)) (list_trans (nopad newdata)))"
  by pat_completeness auto
  termination
  apply (relation "measure length")
  apply (clarsimp simp del: pTrans.simps split:prod.splits)
  apply (case_tac "data")
   apply clarsimp
  apply (fastforce dest:pTrans_termination_argument
          simp: nopad_def dropWhile_eq_drop)
 done

definition
  list_trans_no_pad :: "U8 list \<Rightarrow> (U8 list \<times> Trans list)"
where
  "list_trans_no_pad data \<equiv>
    (case list_trans data of
     (rem, txs) \<Rightarrow>
     (rem, filter (\<lambda>tx. \<not> (length tx = 1 \<and> otype\<^sub>f (tx!0) = bilbyFsObjTypePad)) txs))"

lemma list_trans_no_pad_Cons[simp]:
 "list_trans_no_pad (x#xs) =
 (fst (list_trans (x # xs)),
  [tx\<leftarrow>snd (list_trans (x # xs)).  \<not> (length tx = 1 \<and> otype\<^sub>f (tx!0) = bilbyFsObjTypePad)])"
  by (simp add: list_trans_no_pad_def prod.case_eq_if del: list_trans.simps)

lemma list_trans_no_pad_Nil[simp]:
 "list_trans_no_pad [] = ([], [])"
  by (simp add: list_trans_no_pad_def)

type_synonym EbLog = "Trans list"

definition
 list_eb_log :: "ubi_leb list \<Rightarrow> EbLog list"
where
 "list_eb_log wubi \<equiv>
   map (snd o list_trans_no_pad) (drop (unat bilbyFsFirstLogEbNum) wubi)"

definition
  prune_ostore :: "Obj\<^sub>T \<Rightarrow> ostore_map \<Rightarrow> ostore_map"
where
 "prune_ostore del omap \<equiv>
  (\<lambda>oid. case omap oid of
         option.Some obj \<Rightarrow>
           if obj_is_deleted_by obj del then
             option.None
           else
             option.Some obj
        | option.None \<Rightarrow> option.None)"

definition
  trans_order :: "Obj\<^sub>T list \<Rightarrow> U64"
where
 "trans_order objs \<equiv> Obj.sqnum\<^sub>f ((sort_key Obj.sqnum\<^sub>f objs)!0)"

definition
  abstract_mount_\<alpha>_ostore :: "ubi_leb list \<Rightarrow> ostore_map"
where
 "abstract_mount_\<alpha>_ostore wubi \<equiv>
  let alltrans = (concat $ list_eb_log wubi);
      alltrans' = sort_key trans_order alltrans
  in fold id (map ostore_update alltrans') Map.empty"

text {* @{term mount_\<alpha>_ostore} returns the logical representation of the object
store curently stored (synchronised) on medium. *}
definition
  mount_\<alpha>_ostore :: "ubi_leb list \<Rightarrow> ostore_map"
where
 "mount_\<alpha>_ostore wubi \<equiv>
   let lel = list_eb_log wubi ;
       delobjs = concat $ concat $ map (map (filter obj_is_del)) lel;
       delfree_lel = map (map (filter (Not o obj_is_del))) lel;
       ostore_map = fold id (map (\<lambda>ltx. fold id (map ostore_update ltx)) delfree_lel) Map.empty
  in fold prune_ostore delobjs ostore_map"

definition
  ostore_get_obj :: "OstoreState\<^sub>T \<Rightarrow> ObjAddr\<^sub>T \<Rightarrow> Obj\<^sub>T"
where
 "ostore_get_obj ostore_st addr \<equiv>
  let buf = (if ebnum\<^sub>f addr = wbuf_eb\<^sub>f ostore_st then
               (\<alpha>wa $ data\<^sub>f $ wbuf\<^sub>f ostore_st)
             else
               \<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st)!(unat $ ebnum\<^sub>f addr))
  in pObj (take (unat (ObjAddr.offs\<^sub>f addr) + unat (ObjAddr.len\<^sub>f addr)) buf) (offs\<^sub>f addr)"

definition
 \<alpha>_ostore_medium :: "OstoreState\<^sub>T \<Rightarrow> ostore_map"
where
 "\<alpha>_ostore_medium ostore_st \<equiv> abstract_mount_\<alpha>_ostore (\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st))"

text {* \<alpha>_updates: returns updates not synchronised to medium yet *}
definition
  \<alpha>_updates :: "OstoreState\<^sub>T \<Rightarrow> (ostore_map \<Rightarrow> ostore_map) list"
where
 "\<alpha>_updates ostore_st \<equiv>
  (map ostore_update $ snd $ list_trans_no_pad
    (buf_slice (wbuf\<^sub>f ostore_st) (sync_offs\<^sub>f ostore_st) (used\<^sub>f ostore_st)))"

text {* \<alpha>_ostore_uptodate: returns the logical view of the object store when all
 updates are applied.
*}

definition
  \<alpha>_ostore_uptodate ::  "OstoreState\<^sub>T \<Rightarrow> ostore_map"
where
 "\<alpha>_ostore_uptodate ostore_st \<equiv>
    fold id (\<alpha>_updates ostore_st) (\<alpha>_ostore_medium ostore_st)"

definition
  \<alpha>_ostore_runtime :: "OstoreState\<^sub>T \<Rightarrow> ostore_map"
where
 "\<alpha>_ostore_runtime ostore_st oid \<equiv>
  (case (\<alpha>_index $ index_st\<^sub>f ostore_st) oid of
   option.None \<Rightarrow> option.None
   | option.Some addr \<Rightarrow>
       option.Some $ ostore_get_obj ostore_st addr)"

definition
 is_valid_ObjIn :: "Obj\<^sub>T \<Rightarrow> U8 list \<Rightarrow> bool"
where
 "is_valid_ObjIn obj buf \<equiv>
   is_valid_ObjHeader obj buf \<and> Obj.trans\<^sub>f (pObj buf 0) = bilbyFsTransIn"

definition
 is_valid_ObjCommit :: "Obj\<^sub>T \<Rightarrow> U8 list \<Rightarrow> bool"
where
 "is_valid_ObjCommit obj buf \<equiv>
   is_valid_ObjHeader obj buf \<and> Obj.trans\<^sub>f (pObj buf 0) = bilbyFsTransCommit"

lemma bilbyFsTrans_diff[simp]:
  "bilbyFsTransIn \<noteq> bilbyFsTransCommit"
  "bilbyFsTransCommit \<noteq> bilbyFsTransIn"
   unfolding bilbyFsTransIn_def bilbyFsTransCommit_def
   by simp+

lemmas is_valid_ObjTrans = is_valid_ObjIn_def is_valid_ObjCommit_def

lemma drop_n_ge_0:
  "0<n \<Longrightarrow> drop n (v # va) = drop (n - 1) va"
 by (case_tac n, simp+)

lemma is_valid_ObjHeader_drop_non_zero:
 "is_valid_ObjHeader (pObj (v # va) 0) (v # va) \<Longrightarrow>
  drop (unat (Obj.len\<^sub>f (pObj (v # va) 0))) (v # va) = drop (unat (Obj.len\<^sub>f (pObj (v # va) 0)) - 1) (va)
 "
  apply (frule is_valid_ObjHeader_len_facts)
  apply (clarsimp simp:  bilbyFsObjHeaderSize_def unat_arith_simps)
  apply (simp add: drop_n_ge_0)
 done

fun
  valid_trans :: "U8 list \<Rightarrow> bool"
where
"valid_trans [] = False"
|valid_trans_Cons: "valid_trans buf =
   (if is_valid_ObjIn (pObj buf 0) buf then
     valid_trans (drop (unat $ Obj.len\<^sub>f $ pObj buf 0) buf)
   else is_valid_ObjCommit (pObj buf 0) buf)"

declare valid_trans.simps[simp del]

lemma valid_trans_simps[simp]:
  "valid_trans [] = False"
  "is_valid_ObjIn (pObj xs 0) xs \<Longrightarrow>
    valid_trans xs = valid_trans (drop (unat $ Obj.len\<^sub>f $ pObj xs 0) xs)"
  "is_valid_ObjCommit (pObj xs 0) xs \<Longrightarrow>
    valid_trans xs = True"
    apply (simp add: valid_trans.simps)
   apply (case_tac xs, (clarsimp simp: is_valid_ObjHeader_len_facts valid_trans.simps is_valid_ObjTrans is_valid_ObjHeader_def bilbyFsObjHeaderSize_def )+)
  apply (case_tac xs, simp)
   apply (frule is_len_and_type_ok_hdr_szD)
   apply (simp add: bilbyFsObjHeaderSize_def, unat_arith)
  apply (simp add: valid_trans.simps is_valid_ObjTrans is_valid_ObjHeader_def)
 done

lemma is_valid_Obj_diff:
  "is_valid_ObjCommit (pObj buf n) buf \<longrightarrow> \<not>is_valid_ObjIn (pObj buf n) buf"
  "is_valid_ObjIn (pObj buf n) buf \<longrightarrow> \<not>is_valid_ObjCommit (pObj buf n) buf"
  by (simp add: is_valid_ObjTrans)+

lemma Nil_not_valid_Obj[simp]:
  "is_valid_ObjHeader (pObj [] n) [] = False"
  "is_valid_ObjIn (pObj [] n) [] = False"
  "is_valid_ObjCommit (pObj [] n) [] = False"
  by (clarsimp simp add: is_valid_ObjTrans,
      frule is_valid_ObjHeader_len_facts,
      simp add: bilbyFsObjHeaderSize_def)+

fun
 trans_len :: "U8 list \<Rightarrow> nat"
where
trans_len_Nil: "trans_len [] = max (unat bilbyFsObjHeaderSize) (unat $ Obj.len\<^sub>f $ pObj [] 0)"
|trans_len_Cons: "trans_len buf =
   (if \<not>is_valid_ObjHeader (pObj buf 0) buf then
        max (unat bilbyFsObjHeaderSize) (unat $ Obj.len\<^sub>f $ pObj buf 0)
    else if is_valid_ObjIn (pObj buf 0) buf then
     (unat $ Obj.len\<^sub>f $ pObj buf 0) + trans_len (drop (unat $ Obj.len\<^sub>f $ pObj buf 0) buf)
    else
     unat $ Obj.len\<^sub>f $ pObj buf 0)"

declare trans_len.simps [simp del]
lemma trans_len_simps[simp]:
  "trans_len [] = max (unat bilbyFsObjHeaderSize) (unat $ Obj.len\<^sub>f $ pObj [] 0)"
  "is_valid_ObjIn (pObj xs 0) xs \<Longrightarrow>
    trans_len xs = (unat $ Obj.len\<^sub>f $ pObj xs 0) + trans_len (drop (unat $ Obj.len\<^sub>f $ pObj xs 0) xs)"
  "is_valid_ObjCommit (pObj xs 0) xs \<Longrightarrow>
    trans_len xs = unat (Obj.len\<^sub>f $ pObj xs 0)"
  apply (case_tac xs, (clarsimp simp: is_valid_ObjTrans is_valid_ObjHeader_def bilbyFsObjHeaderSize_def trans_len.simps)+)
  apply (case_tac xs, (clarsimp simp: is_valid_ObjTrans is_valid_ObjHeader_def bilbyFsObjHeaderSize_def trans_len.simps)+)
  apply (case_tac xs, (clarsimp simp: is_valid_ObjTrans, frule is_len_and_type_ok_hdr_szD, simp add: bilbyFsObjHeaderSize_def, unat_arith))
  apply (clarsimp simp: is_valid_ObjTrans, frule is_len_and_type_ok_hdr_szD,
         clarsimp simp add: bilbyFsObjHeaderSize_def trans_len.simps is_valid_ObjTrans, unat_arith)
 done

lemma trans_len_min_header[simp]:
  "unat bilbyFsObjHeaderSize - 1 < trans_len xs"
  apply (rule_tac x=xs in trans_len.cases)
   apply (fastforce simp: bilbyFsObjHeaderSize_def)
  apply (simp only: trans_len_Cons)
  apply (case_tac "is_valid_ObjIn (pObj (v # va) 0) (v # va)")
   apply (clarsimp simp: is_valid_Obj_diff is_valid_ObjTrans)
   apply (drule is_valid_ObjHeader_len, simp add: bilbyFsObjHeaderSize_def, unat_arith)
  apply (clarsimp simp: is_valid_ObjTrans)
  apply (auto dest!:  is_valid_ObjHeader_len[simplified bilbyFsObjHeaderSize_def], (simp add: bilbyFsObjHeaderSize_def | unat_arith)+)
 done

lemma hdr_sz_le_trans_len:
  "unat bilbyFsObjHeaderSize \<le> trans_len xs"
 using trans_len_min_header[where xs=xs] by simp

lemma trans_len_non_zero:
 "0 < trans_len xs"
 using trans_len_min_header
 by (drule_tac x=xs in meta_spec) fastforce

lemma take_non0:
 "xs \<noteq> [] \<Longrightarrow> 0 < n \<Longrightarrow>
   take n xs = hd xs#(take (n- 1) (tl xs))"
by (case_tac n, auto simp: take_Suc)

lemma prefixeq_length_le_Cons:
 "prefixeq xs (y#ys) \<Longrightarrow> length xs \<le> Suc (length ys)"
by (drule  prefixeq_length_le) simp

function
  valid_list_trans :: "U8 list \<Rightarrow> bool"
where
"valid_list_trans [] = False"
|"valid_list_trans (b#buf) =
   (valid_trans (b#buf) \<and>
    (if nopad (drop (trans_len (b#buf)) (b#buf)) = [] then True
     else valid_list_trans (nopad (drop (trans_len (b#buf)) (b#buf)))))"

by pat_completeness simp+
termination
  apply (relation "measure (Suc o length)")
   apply simp
  apply (simp add: dropWhile_eq_drop nopad_def)
  apply (cut_tac xs="b # buf" in trans_len_non_zero)
  apply unat_arith
 done

definition
  valid_list_trans_no_pad :: "U8 list \<Rightarrow> bool"
where
  "valid_list_trans_no_pad buf \<equiv>
    valid_list_trans buf \<and> snd (list_trans_no_pad buf) \<noteq> []"

lemma valid_list_trans_to_valid_trans:
 "valid_list_trans buf \<Longrightarrow> valid_trans buf"
by (erule valid_list_trans.elims, simp)

text {* \<alpha>_summary_updates: returns all the updates included in the summary.
This includes the updates already synchronised to medium i.e. wbuf[0:used] and
updates only applied in memory i.e. wbuf[used:sync_offs]. (Where wbuf[x:y] is the
slice of the WordArray U8 maching the medium contents for the erase-block in
question.)
*}
definition
  \<alpha>_summary_updates :: "OstoreState\<^sub>T \<Rightarrow> (ostore_map \<Rightarrow> ostore_map) list"
where
 "\<alpha>_summary_updates ostore_st \<equiv>
   let offs = unat $ (used\<^sub>f ostore_st);
       buf = take offs (\<alpha>wa $ data\<^sub>f $ wbuf\<^sub>f ostore_st)
    in (map ostore_update $ snd $ list_trans_no_pad buf)"

text {* inv_\<alpha>_step_updates: asserts inv is true no matter how many updates we apply. *}
definition
  inv_\<alpha>_step_updates :: "OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_\<alpha>_step_updates ostore_st \<equiv>
   (let updates = \<alpha>_updates ostore_st
    in \<forall>n\<le>length updates.
     inv_\<alpha>_ostore (apply_n_updates n (\<alpha>_ostore_medium ostore_st) updates))"

definition
  sum_from_wbuf :: "Buffer\<^sub>T \<Rightarrow> Obj\<^sub>T"
where
 "sum_from_wbuf buf \<equiv>
   let  data = \<alpha>wa $ data\<^sub>f buf ;
        offs = ple32 data (buf_length buf - 4)
   in pObj data offs"

text {*
 summary_map: builds a ostore_map from a summary.
 The resulting map should be the same as applying all updates returned by \<alpha>_summary_updates to an empty
 map. (see inv_sum_consistent)
*}

definition
 summary_map :: "ObjSummary\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> ostore_map"
where
 "summary_map summary ostore_st \<equiv>
  let nb_entry = unat $ nb_sum_entry\<^sub>f summary;
      entries = take nb_entry $ \<alpha>wa $ entries\<^sub>f summary;
      nodel = filter (Not o obj_sum_entry_is_del) entries;
      maps = map (\<lambda>entry. Map.empty(ObjSumEntry.id\<^sub>f entry \<mapsto> pObj (\<alpha>wa $ data\<^sub>f $ wbuf\<^sub>f ostore_st) (obj_sum_entry_offs entry))) nodel;
      omap = fold op ++ maps Map.empty;
      dels = filter (obj_sum_entry_is_del) entries
  in fold (\<lambda>entry gos.
    (\<lambda>oid. if oid_is_deleted_by oid (ObjSumEntry.id\<^sub>f entry) then
              option.None
           else gos oid)) dels omap"

definition
  inv_sum_consistent :: "Obj\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_sum_consistent sumobj ostore_st \<equiv>
   True
   (* ignore summary consistency for now:
   otype\<^sub>f sumobj = bilbyFsObjTypeSum \<and>
   let sum = obj_osummary sumobj
   in summary_map sum ostore_st = fold id (\<alpha>_summary_updates ostore_st) Map.empty*)"

definition
  room_for_summary :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "room_for_summary mount_st ostore_st \<equiv>
   (\<not>no_summary\<^sub>f mount_st \<and> used\<^sub>f ostore_st \<noteq> (eb_size\<^sub>f $ super\<^sub>f mount_st)) \<longrightarrow>
     (unat (eb_size\<^sub>f $ super\<^sub>f mount_st) - unat (used\<^sub>f ostore_st) \<le> unat (serialise_size_summary_Obj (summary\<^sub>f ostore_st)))
    "

text {*
Unless "used" equals "eb_size", there must be enough room for the summary
to be serialised. If "used" is equal to "eb_size", the summary's been
serialised already and can be read from the buffer.

nb_sum_entry constrain says that the maximum number of objects in
an erase-block has to be less than the number of min-size object that fit
in that buffer (this is an over-approximation because at least one of these
objects must be a summary).
*}
definition
  inv_ostore_summary :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_ostore_summary mount_st ostore_st \<equiv>
 True
 (* No summary invariant for now.
   let eb_size = eb_size\<^sub>f (super\<^sub>f mount_st)
   in nb_sum_entry\<^sub>f (summary\<^sub>f ostore_st) < (eb_size div bilbyFsMinObjSize) \<and>
   room_for_summary mount_st ostore_st \<and>
   (if used\<^sub>f ostore_st = eb_size then
    inv_sum_consistent (sum_from_wbuf (wbuf\<^sub>f ostore_st)) ostore_st
   else
     used\<^sub>f ostore_st < used\<^sub>f ostore_st + os_sum_sz ostore_st \<and>
     used\<^sub>f ostore_st + os_sum_sz ostore_st \<le> eb_size \<and>
     inv_sum_consistent ((sum_obj\<^sub>f ostore_st)\<lparr> ounion\<^sub>f:= TObjSummary (summary\<^sub>f ostore_st) \<rparr>) ostore_st)
     *)
  "

text {*
 inv_ostore_obj_meta: is the invariant of object meta data in
 relation to the object store state.
*}
definition
  inv_mem_ostore_obj :: "OstoreState\<^sub>T \<Rightarrow> Obj\<^sub>T \<Rightarrow> bool"
where
 "inv_mem_ostore_obj ostore_st obj \<equiv>
  Obj.sqnum\<^sub>f obj < OstoreState.next_sqnum\<^sub>f ostore_st \<and>
  ucast (otype\<^sub>f obj) = bilbyFsObjInode \<longrightarrow>
    (inum_from_obj_id $ get_obj_oid obj) < OstoreState.next_inum\<^sub>f ostore_st"

text {* @{term pollute_buf} ensures that the buffer does not contain a valid transaction
at offset @{term offs}. It does not matter what the value is as long as it's not
a valid transaction or padding, mount will stop at this offset.
Note that we could allow invalid to be prefixed by padding bytes but it's this is Ok for now.
We don't use pollute_buf at the moment because we do not care about crash-tolerance.
*}
definition
 pollute_buf :: "nat \<Rightarrow> U8 list \<Rightarrow> U8 list"
where
 "pollute_buf offs xs = xs[offs:=0xff]"

text {* list_eb_log_wbuf: returns the logical view of the log on-flash with the current
state of the buffer wbuf instead of the content of the corresponding erase-block.
*}
definition
 list_eb_log_wbuf :: "OstoreState\<^sub>T \<Rightarrow> EbLog list"
where
 "list_eb_log_wbuf ostore_st \<equiv>
  let eblogs = list_eb_log (\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st));
      wbuflog = snd (list_trans_no_pad ((* pollute_buf *)buf_slice (wbuf\<^sub>f ostore_st) 0 (used\<^sub>f ostore_st)))
  in eblogs[unat (wbuf_eb\<^sub>f ostore_st) - unat bilbyFsFirstLogEbNum:=wbuflog]"

text {* Attempt at on-flash invariant.

It's composed of 3 level of invariant, the top-level being the on that talks
about the entire log and relation between objects: inv_flash
The next level talks about individual erase-blocks: inv_eb_log
Erase-blocks log are made of multiple transactions: inv_trans
Transactions are made of objects: inv_obj

*}

definition
  ostore_log_objects :: "EbLog list \<Rightarrow> Obj\<^sub>T list"
where
 "ostore_log_objects \<equiv> concat o concat "

definition
 inv_trans :: "Obj\<^sub>T list \<Rightarrow> bool"
where
 "inv_trans olist \<equiv> (\<forall>obj\<in>set olist. \<not>obj_is_del obj \<longrightarrow> inv_read_obj obj)"

definition
  inv_eb_log :: "EbLog \<Rightarrow> Obj\<^sub>T set \<Rightarrow> bool"
where
 "inv_eb_log tlist allobjs \<equiv>
     (let sumtrans = tlist!(length tlist - 1);
         sumobj = hd sumtrans ;
         sum = obj_osummary sumobj
     in length sumtrans = 1 \<and> otype\<^sub>f sumobj = bilbyFsObjTypeSum \<and>
        (\<forall>entry\<in>(set $ \<alpha>wa $ ObjSummary.entries\<^sub>f sum).
          let objs = set $ concat $ tlist
          in \<exists>obj. Obj.offs\<^sub>f obj = obj_sum_entry_offs entry \<and>
          get_obj_oid obj = ObjSumEntry.id\<^sub>f entry \<and>
          (obj_sum_entry_is_del entry \<longrightarrow>
            (otype\<^sub>f obj = bilbyFsObjTypeDel \<and>
             card {x. x \<in> allobjs \<and>
                      oid_is_deleted_by (get_obj_oid x) (ObjSumEntry.id\<^sub>f entry) \<and>
                      Obj.sqnum\<^sub>f obj < ObjSumEntry.sqnum\<^sub>f entry
                  } = unat (ObjSumEntry.count\<^sub>f entry))) \<and>
          Obj.len\<^sub>f obj = ObjSumEntry.len\<^sub>f entry) \<and>
          (\<forall>trans \<in> set(butlast tlist). inv_trans trans))"

definition
  obj_is_alive :: "Obj\<^sub>T \<Rightarrow> Obj\<^sub>T set \<Rightarrow> bool"
where
 "obj_is_alive obj all \<equiv>
  (\<forall>delobj \<in>{x. x\<in> all \<and> obj_is_del x}. \<not>obj_is_deleted_by obj delobj)"

definition
  inv_flash :: "EbLog list \<Rightarrow> bool"
where
 "inv_flash flash \<equiv> True
(*
  let all = ostore_log_objects flash in
  (* The root inode exists, we don't really need to know that for the object store *)
  (* (\<exists>obj\<in>set all. get_obj_oid obj = obj_id_inode_mk bilbyFsRootIno \<and> obj_is_alive obj (set all)) \<and> *)
  (* all sqnums are uniq *)
  (card (Obj.sqnum\<^sub>f ` set all) = length (map Obj.sqnum\<^sub>f all)) \<and>
  (\<forall>eblog\<in>set flash. inv_eb_log eblog (set all)) \<and>
  (* There is maximum 1 erase-block with garbage, (stripping out unmapped erase-blocks) *)
  length ((filter (op \<noteq> []) $ map (fst o the) $ filter (op \<noteq> option.None) flash)) \<le> 1
  (*rel dentarr inode and inode data blocks? no cyclic dependencies in graph? *)
  *)"

definition
 is_obj_addr_consistent :: "Obj\<^sub>T \<Rightarrow> ObjAddr\<^sub>T \<Rightarrow> bool"
where
 "is_obj_addr_consistent obj addr \<equiv>
  Obj.sqnum\<^sub>f obj = ObjAddr.sqnum\<^sub>f addr \<and>
  Obj.offs\<^sub>f obj = ObjAddr.offs\<^sub>f addr \<and>
  Obj.len\<^sub>f obj = ObjAddr.len\<^sub>f addr"

definition
 inv_ostore_index :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_ostore_index mount_st ostore_st \<equiv>
  (\<forall>oid\<in>dom(\<alpha>_index $ index_st\<^sub>f ostore_st).
    let addr = the $ (\<alpha>_index $ index_st\<^sub>f ostore_st) oid;
        obj = ostore_get_obj ostore_st addr
     in is_valid_addr mount_st ostore_st addr \<and>
        is_obj_addr_consistent obj addr \<and>
        get_obj_oid obj = oid)"

definition
  inv_ostore_index_gim_disjoint :: "OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_ostore_index_gim_disjoint ostore_st \<equiv>
   dom (\<alpha>_index $ index_st\<^sub>f ostore_st) \<inter> dom (\<alpha>_fsm_gim $ gim\<^sub>f $ fsm_st\<^sub>f ostore_st) = {}"

definition
 inv_fsm_st :: "MountState\<^sub>T \<Rightarrow> FsmState\<^sub>T \<Rightarrow> bool"
where
 "inv_fsm_st mount_st fsm_st \<equiv>
 length (\<alpha>wa $ dirty_space\<^sub>f $ fsm_st) = unat (nb_eb\<^sub>f $ super\<^sub>f mount_st) \<and>
 length (\<alpha>wa $ used_eb\<^sub>f $ fsm_st) = unat (nb_eb\<^sub>f $ super\<^sub>f mount_st)"

definition
 inv_ostore_fsm :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_ostore_fsm mount_st ostore_st \<equiv>
 (\<alpha>wa $ used_eb\<^sub>f $ fsm_st\<^sub>f ostore_st) ! unat (wbuf_eb\<^sub>f ostore_st) \<noteq> 0 \<and>
(* Count on each gimnode is equal to the number of objects with the same oid
   in the log *)
  (\<forall>oid \<in> dom(\<alpha>_fsm_gim $ gim\<^sub>f $ fsm_st\<^sub>f ostore_st).
   let gimnode = the $ (\<alpha>_fsm_gim $ gim\<^sub>f $ fsm_st\<^sub>f ostore_st) oid
   in unat (GimNode.count\<^sub>f gimnode) =
     card {x. x \<in> (set $ ostore_log_objects $ list_eb_log_wbuf ostore_st)  \<and>
              oid_is_deleted_by (get_obj_oid x) oid}) \<and>

(* All Ubi erase-block with data are marked as used in the FSM used_eb\<^sub>f bit map *)
  (\<forall>ebnum\<in> {bilbyFsFirstLogEbNum..<nb_eb\<^sub>f (super\<^sub>f mount_st)}.
     (unat ebnum \<noteq> unat (wbuf_eb\<^sub>f ostore_st) \<longrightarrow>
     ((\<alpha>wubi $ OstoreState.ubi_vol\<^sub>f ostore_st)  ! (unat ebnum) = [] \<longleftrightarrow>
     ((\<alpha>wa $ used_eb\<^sub>f $ fsm_st\<^sub>f ostore_st) ! (unat ebnum) \<noteq> 0))))

(* Dirty space book-keeping (commented out for now) *)
  (* let ebnum = wbuf_eb\<^sub>f ostore_st in
  ((\<alpha>wa $ used_eb\<^sub>f $ fsm_st\<^sub>f ostore_st) ! (unat ebnum) \<noteq> 0)  \<longrightarrow>
   (let eb_log = list_eb_log_wbuf ostore_st ! (unat ebnum);
       eb_size =  unat (eb_size\<^sub>f (super\<^sub>f mount_st));
       nondirt = listsum (map (unat o Obj.len\<^sub>f) (concat eb_log)) ;
       nonused = (if ebnum = wbuf_eb\<^sub>f ostore_st then eb_size - unat (used\<^sub>f ostore_st) else 0) in
  (unat ((\<alpha>wa $ dirty_space\<^sub>f $ fsm_st\<^sub>f ostore_st) ! unat ebnum) = eb_size - nondirt - nonused))*)
"

definition
 inv_bufs :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_bufs mount_st ostore_st \<equiv>
   inv_ubi_vol mount_st (OstoreState.ubi_vol\<^sub>f ostore_st) \<and>
   (\<forall>ebnum\<in>{unat bilbyFsFirstLogEbNum.. length ((\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st)))}.
    unat (wbuf_eb\<^sub>f ostore_st) \<noteq> ebnum \<longrightarrow>
    length ((\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st))!ebnum) = unat (eb_size\<^sub>f (super\<^sub>f mount_st) )) \<and>
  (let synced = buf_take (wbuf\<^sub>f ostore_st) (sync_offs\<^sub>f ostore_st);
       sync_to_used = buf_slice (wbuf\<^sub>f ostore_st) (sync_offs\<^sub>f ostore_st) (used\<^sub>f ostore_st) in
   \<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st) ! unat (wbuf_eb\<^sub>f ostore_st) = synced \<and>
   (sync_offs\<^sub>f ostore_st < used\<^sub>f ostore_st \<longrightarrow> valid_list_trans_no_pad sync_to_used) \<and>
   (used\<^sub>f ostore_st > 0 \<longrightarrow> valid_list_trans_no_pad synced) \<and>
   sort_key trans_order (snd (list_trans_no_pad sync_to_used)) =
     snd (list_trans_no_pad sync_to_used))
(*
  (let nb_eb = nb_eb\<^sub>f (super\<^sub>f mount_st) in
   (\<forall>ebnum\<in>{bilbyFsFirstLogEbNum..nb_eb}.
      (case ubi_to_buf (OstoreState.ubi_vol\<^sub>f ostore_st) ebnum of
         option.None \<Rightarrow> True |
         option.Some buf \<Rightarrow> valid_list_trans buf)))
*)"

definition
  inv_log :: "Trans list list \<Rightarrow> Trans list \<Rightarrow> bool"
where
 "inv_log eb_log wbuf_log \<equiv>
  (\<forall>x\<in>set (concat eb_log).
   \<forall>y\<in>set (wbuf_log). trans_order x < trans_order y) \<and>
   inj_on trans_order (set $ concat $ eb_log @ [wbuf_log])"

definition
  inv_opad :: "Obj\<^sub>T \<Rightarrow> bool"
where
 "inv_opad opad \<equiv>
   magic\<^sub>f opad = bilbyFsMagic \<and>
   otype\<^sub>f opad = bilbyFsObjTypePad \<and>
   trans\<^sub>f opad = bilbyFsTransCommit \<and>
   bilbyFsObjHeaderSize \<le> Obj.len\<^sub>f opad \<and>
   ounion\<^sub>f (opad) = ObjUnion\<^sub>1\<^sub>1\<^sub>1\<^sub>1\<^sub>1\<^sub>1\<^sub>1.TObjPad () \<and>
   Obj.offs\<^sub>f opad = 0"

text {*
From inv_ostore, we know that  used\<^sub>f ostore_st \<le> eb_size,
see lemma inv_ostore_used below.
*}
definition
  inv_ostore :: "MountState\<^sub>T \<Rightarrow> OstoreState\<^sub>T \<Rightarrow> bool"
where
 "inv_ostore mount_st ostore_st \<equiv>
  sync_offs\<^sub>f ostore_st \<le> used\<^sub>f ostore_st \<and>
  io_size\<^sub>f (super\<^sub>f mount_st) udvd sync_offs\<^sub>f ostore_st \<and>
  used\<^sub>f ostore_st \<le> eb_size\<^sub>f (super\<^sub>f mount_st) \<and>
  used\<^sub>f ostore_st < used\<^sub>f ostore_st + io_size\<^sub>f (super\<^sub>f mount_st) \<and>
  buf_length (rbuf\<^sub>f ostore_st) = eb_size\<^sub>f (super\<^sub>f mount_st) \<and>
  buf_length (wbuf\<^sub>f ostore_st) = eb_size\<^sub>f (super\<^sub>f mount_st) \<and>
  buf_bound (wbuf\<^sub>f ostore_st) = eb_size\<^sub>f (super\<^sub>f mount_st) \<and>
  wbuf_eb\<^sub>f ostore_st \<ge> bilbyFsFirstLogEbNum \<and>
  wbuf_eb\<^sub>f ostore_st < nb_eb\<^sub>f (super\<^sub>f mount_st) \<and>
  inv_opad (opad\<^sub>f ostore_st) \<and>
  \<alpha>_ostore_runtime ostore_st = \<alpha>_ostore_uptodate ostore_st \<and>
  inv_ostore_summary mount_st ostore_st \<and>
  inv_ostore_index mount_st ostore_st \<and>
  inv_ostore_index_gim_disjoint ostore_st \<and>
  inv_bufs mount_st ostore_st \<and>
  inv_fsm_st mount_st (fsm_st\<^sub>f ostore_st) \<and>
  inv_ostore_fsm mount_st ostore_st \<and>
  inv_flash (list_eb_log_wbuf ostore_st) \<and>
  inv_log (list_eb_log (\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st)))
    (snd $ list_trans_no_pad (buf_slice (wbuf\<^sub>f ostore_st) (sync_offs\<^sub>f ostore_st) (used\<^sub>f ostore_st)))"

lemmas inv_ostore_simps =
  inv_ostore_def
  inv_ostore_summary_def
  inv_ostore_index_def
  inv_ostore_index_gim_disjoint_def
  inv_bufs_def
  inv_ostore_fsm_def
  inv_flash_def
  inv_eb_log_def

lemma inv_summaryD: "inv_ostore mount_st ostore_st \<Longrightarrow> inv_ostore_summary mount_st ostore_st"
by (simp add: inv_ostore_def)

lemma inv_ostore_wbuf_lengthD: "inv_ostore mount_st ostore_st \<Longrightarrow> buf_length (wbuf\<^sub>f ostore_st) = eb_size\<^sub>f (super\<^sub>f mount_st)"
by (simp add: inv_ostore_def)

lemma inv_ostore_wbuf_boundD: "inv_ostore mount_st ostore_st \<Longrightarrow> buf_bound (wbuf\<^sub>f ostore_st) = eb_size\<^sub>f (super\<^sub>f mount_st)"
by (simp add: inv_ostore_def)

lemma inv_ostore_usedD:
  "inv_ostore mount_st ostore_st \<Longrightarrow>
  used\<^sub>f ostore_st \<le> eb_size\<^sub>f (super\<^sub>f mount_st)"
by (clarsimp simp:inv_ostore_def)

lemma inv_ostore_used_len_wbufD:
  "inv_ostore mount_st ostore_st \<Longrightarrow> inv_mount_st mount_st \<Longrightarrow> unat (used\<^sub>f ostore_st) \<le> length (\<alpha>wa $ data\<^sub>f $ wbuf\<^sub>f ostore_st)"
  apply (frule inv_ostore_wbuf_lengthD[THEN sym])
  apply (frule inv_ostore_usedD)
  apply (clarsimp simp: word_unat.Rep_inject[symmetric] word_le_nat_alt buf_simps inv_mount_st_def Let_def wordarray_length_ret)
 done

lemma inv_ostore_sync_offsD:
  "inv_ostore mount_st ostore_st \<Longrightarrow>  sync_offs\<^sub>f ostore_st \<le>  used\<^sub>f ostore_st"
by (clarsimp simp:inv_ostore_def)

lemma inv_ostore_fsmD:
  "inv_ostore mount_st ostore_st \<Longrightarrow> inv_ostore_fsm mount_st ostore_st"
by (clarsimp simp:inv_ostore_def)

lemma used_eq_sync_offs_means_no_update:
 "sync_offs\<^sub>f ostore_st = used\<^sub>f ostore_st \<Longrightarrow>
  \<alpha>_updates ostore_st = []"
 unfolding \<alpha>_updates_def by (simp add:  buf_simps)

lemma inv_bufsD[simplified inv_bufs_def Let_def]:
 "inv_ostore mount_st ostore_st \<Longrightarrow> inv_bufs mount_st ostore_st"
  by (simp add: inv_ostore_def)

lemma length_ubi_buf_eq_sync_offsD:
  "inv_ostore mount_st ostore_st \<Longrightarrow>
   inv_mount_st mount_st \<Longrightarrow>
  length (\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st) ! unat (wbuf_eb\<^sub>f ostore_st)) =
    unat (sync_offs\<^sub>f ostore_st)"
   apply (frule inv_bufsD)
   apply (subgoal_tac "unat (sync_offs\<^sub>f ostore_st) \<le> unat (buf_length (wbuf\<^sub>f ostore_st))")
   using wordarray_length_ret[where arr="data\<^sub>f (wbuf\<^sub>f ostore_st)"]
   apply (clarsimp simp:  inv_bufs_def buf_simps min_absorb1 Let_def)
   apply unat_arith
 apply (frule inv_ostore_usedD)
 apply (clarsimp simp: inv_ostore_def buf_simps inv_mount_st_def Let_def, unat_arith+)
done

lemma inv_ubi_volD:
 "inv_ostore mount_st ostore_st \<Longrightarrow> inv_ubi_vol mount_st (OstoreState.ubi_vol\<^sub>f ostore_st)"
 by (drule inv_bufsD, clarsimp simp: inv_bufs_def)

lemma inv_ostore_indexD:
 "inv_ostore mount_st ostore_st \<Longrightarrow> inv_ostore_index mount_st ostore_st"
 by (clarsimp simp: inv_ostore_def)

lemma inv_ostore_eb_size_wbuf_eqD:
  "inv_ostore mount_st ostore_st  \<Longrightarrow>
   unat (eb_size\<^sub>f (super\<^sub>f mount_st)) = length (\<alpha>wa (data\<^sub>f (wbuf\<^sub>f ostore_st)))"
using wordarray_length_ret[where arr="(data\<^sub>f (wbuf\<^sub>f ostore_st))"]
by (clarsimp simp: inv_ostore_def Let_def buf_simps wordarray_length_ret)

lemma inv_ostore_eb_size_rbuf_eqD:
  "inv_ostore mount_st ostore_st  \<Longrightarrow>
   unat (eb_size\<^sub>f (super\<^sub>f mount_st)) = length (\<alpha>wa (data\<^sub>f (rbuf\<^sub>f ostore_st)))"
using wordarray_length_ret[where arr="(data\<^sub>f (rbuf\<^sub>f ostore_st))"]
by (clarsimp simp: inv_ostore_def Let_def buf_simps wordarray_length_ret)

lemma inv_ostore_buf_boundD:
  "inv_ostore mount_st ostore_st \<Longrightarrow>
   unat (buf_bound (wbuf\<^sub>f ostore_st)) \<le> length (\<alpha>wa (data\<^sub>f (wbuf\<^sub>f ostore_st)))"
using wordarray_length_ret[where arr="(data\<^sub>f (wbuf\<^sub>f ostore_st))",symmetric]
by (clarsimp simp: inv_ostore_def buf_simps)

lemma inv_ostore_buf_bound_eqD:
  "inv_ostore mount_st ostore_st \<Longrightarrow>
   unat (buf_bound (wbuf\<^sub>f ostore_st)) = length (\<alpha>wa (data\<^sub>f (wbuf\<^sub>f ostore_st)))"
using wordarray_length_ret[where arr="(data\<^sub>f (wbuf\<^sub>f ostore_st))",symmetric]
by (clarsimp simp: inv_ostore_def buf_simps)

lemma inv_mount_st_no_summaryD:
  "inv_mount_st mount_st \<Longrightarrow> \<not> no_summary\<^sub>f mount_st"
 by (simp add: inv_mount_st_def Let_def)

lemma inv_logD[simplified inv_log_def]:
  "inv_ostore mount_st ostore_st \<Longrightarrow>
   inv_log (list_eb_log (\<alpha>wubi (OstoreState.ubi_vol\<^sub>f ostore_st))) (snd $ list_trans_no_pad (buf_slice (wbuf\<^sub>f ostore_st) (sync_offs\<^sub>f ostore_st) (used\<^sub>f ostore_st)))"
 by (clarsimp simp add: inv_ostore_def Let_def)

lemma inv_ostore_used_no_overflowD:
 "inv_ostore mount_st ostore_st \<Longrightarrow> used\<^sub>f ostore_st < used\<^sub>f ostore_st + io_size\<^sub>f (super\<^sub>f mount_st)"
 by (clarsimp simp: inv_ostore_def)

lemma used_neq_sync_offs_means_updates_not_Nil:
assumes inv_ostore: "inv_ostore mount_st ostore_st"
shows
 "sync_offs\<^sub>f ostore_st \<noteq> used\<^sub>f ostore_st \<Longrightarrow>
  \<alpha>_updates ostore_st \<noteq> []"
 unfolding \<alpha>_updates_def
using inv_bufsD[OF inv_ostore]  inv_ostore_sync_offsD[OF inv_ostore]
 by (fastforce simp add: valid_list_trans_no_pad_def)

lemma inv_mount_st_eb_size_boundD:
  "inv_mount_st mount_st \<Longrightarrow> eb_size\<^sub>f (super\<^sub>f mount_st) \<le> bilbyFsMaxEbSize"
 by (simp add: inv_mount_st_def Let_def)

lemma inv_fsm_stD[simplified inv_fsm_st_def]:
 "inv_ostore mount_st ostore_st \<Longrightarrow> inv_fsm_st mount_st (fsm_st\<^sub>f ostore_st)"
 by (clarsimp simp: inv_ostore_def)

lemma inv_ostore_wbuf_eb_rangeD:
 "inv_ostore mount_st ostore_st \<Longrightarrow>   wbuf_eb\<^sub>f ostore_st \<ge> bilbyFsFirstLogEbNum \<and>
  wbuf_eb\<^sub>f ostore_st < nb_eb\<^sub>f (super\<^sub>f mount_st)"
 by (clarsimp simp: inv_ostore_def)

lemma inv_opadD[simplified inv_opad_def]:
 "inv_ostore mount_st ostore_st \<Longrightarrow> inv_opad (opad\<^sub>f ostore_st)"
 by (simp add: inv_ostore_def)

definition
 valid_pad_obj :: "Obj\<^sub>T \<Rightarrow> bool"
where
 "valid_pad_obj obj \<equiv> otype\<^sub>f obj = bilbyFsObjTypePad \<and> is_valid_Obj obj \<and> Obj.offs\<^sub>f obj = 0"

lemma is_valid_ObjCommit_trans_len:
 "valid_pad_obj obj \<Longrightarrow> is_valid_ObjCommit obj (sObj obj) \<Longrightarrow> unat (Obj.len\<^sub>f obj) = length (sObj obj) \<Longrightarrow>  trans_len (sObj obj) = length (sObj obj)"
  apply (clarsimp simp add: is_valid_ObjTrans)
  apply (frule is_valid_ObjHeader_len_facts, clarsimp)
  apply (case_tac "sObj obj")
   apply (simp add: bilbyFsObjHeaderSize_def is_valid_ObjHeader_def)
  apply (simp add: trans_len_Cons)
  apply (rename_tac x xs)
  apply (clarsimp simp add: valid_pad_obj_def is_valid_ObjHeader_def)
  apply (drule_tac t="x#xs" in sym, simp add: Obj_inverse[where xs=Nil, simplified] is_valid_ObjTrans)
 done

lemma is_valid_ObjHeader_length_sObj:
 "valid_pad_obj obj \<Longrightarrow> is_valid_ObjHeader obj (sObj obj)  \<Longrightarrow> length (sObj obj) = unat (Obj.len\<^sub>f obj)"
  by (frule is_valid_ObjHeader_len_facts)
     (clarsimp simp: is_valid_ObjHeader_def length_sObj valid_pad_obj_def)

lemma inv_ostore_valid_pad_objD:
 "inv_ostore mount_st ostore_st \<Longrightarrow> valid_pad_obj (opad\<^sub>f ostore_st)"
 by (drule inv_opadD)  (clarsimp simp: inv_ostore_def valid_pad_obj_def is_valid_Obj_def)

end


(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(GD_GPL)
 *)

(*
Refinement for interrupt controller operations
*)

theory Interrupt_AI
imports "./$L4V_ARCH/ArchIpc_AI"
begin

context begin interpretation Arch .
requalify_consts
  maxIRQ
end

definition
  interrupt_derived :: "cap \<Rightarrow> cap \<Rightarrow> bool"
where
 "interrupt_derived cap cap' \<equiv> \<not> is_untyped_cap cap \<longrightarrow> cap_master_cap cap = cap_master_cap cap'
                                    \<and> (cap_badge cap', cap_badge cap) \<in> capBadge_ordering False"

primrec
  irq_handler_inv_valid :: "irq_handler_invocation \<Rightarrow> 'z::state_ext state \<Rightarrow> bool"
where
  "irq_handler_inv_valid (ACKIrq irq) = (\<lambda>s. interrupt_states s irq \<noteq> IRQInactive)"
| "irq_handler_inv_valid (Invocations_A.ClearIRQHandler irq) = \<top>"
| "irq_handler_inv_valid (Invocations_A.SetIRQHandler irq cap cte_ptr)
     = (\<lambda>s. ex_cte_cap_wp_to (is_cnode_cap) cte_ptr s
            \<and> (\<exists>ptr'. cte_wp_at (op = (cap.IRQHandlerCap irq)) ptr' s)
            \<and> cte_wp_at (interrupt_derived cap) cte_ptr s
            \<and> s \<turnstile> cap \<and> is_ntfn_cap cap)"

consts
  arch_irq_control_inv_valid :: "arch_irq_control_invocation \<Rightarrow> ('a :: state_ext) state \<Rightarrow> bool"

primrec
  irq_control_inv_valid :: "irq_control_invocation \<Rightarrow> 'a::state_ext state \<Rightarrow> bool"
where
  "irq_control_inv_valid (Invocations_A.ArchIRQControl ivk) = (arch_irq_control_inv_valid ivk)"
| "irq_control_inv_valid (Invocations_A.IRQControl irq ptr ptr') =
       (cte_wp_at (op = cap.NullCap) ptr and
        cte_wp_at (op = cap.IRQControlCap) ptr'
        and ex_cte_cap_wp_to is_cnode_cap ptr and real_cte_at ptr
        and K (irq \<le> maxIRQ))"

locale Interrupt_AI =
  fixes state_ext_type1 :: "('a :: state_ext) itself"
  assumes decode_irq_control_invocation_inv[wp]:
    "\<And>(P  :: 'a state \<Rightarrow> bool) args slot label caps.
      \<lbrace>P\<rbrace> decode_irq_control_invocation label args slot caps \<lbrace>\<lambda>rv. P\<rbrace>"
  assumes decode_irq_control_valid[wp]:
    "\<And>slot caps label args.
    \<lbrace>\<lambda>s :: 'a state. invs s \<and> (\<forall>cap \<in> set caps. s \<turnstile> cap)
          \<and> (\<forall>cap \<in> set caps. is_cnode_cap cap \<longrightarrow>
                  (\<forall>r \<in> cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s))
          \<and> cte_wp_at (op = cap.IRQControlCap) slot s\<rbrace>
      decode_irq_control_invocation label args slot caps
    \<lbrace>irq_control_inv_valid\<rbrace>,-"
  assumes get_irq_slot_different:
    "\<And> irq ptr.
    \<lbrace>\<lambda>s :: 'a state. valid_global_refs s \<and> ex_cte_cap_wp_to is_cnode_cap ptr s\<rbrace>
       get_irq_slot irq
    \<lbrace>\<lambda>rv s. rv \<noteq> ptr\<rbrace>"
  assumes is_derived_use_interrupt:
    "\<And> cap cap' m p.
    (is_ntfn_cap cap \<and> interrupt_derived cap cap') \<longrightarrow> (is_derived m p cap cap')"
  assumes maskInterrupt_invs:
    "\<And>b irq.
    \<lbrace>invs and (\<lambda>s :: 'a state. \<not>b \<longrightarrow> interrupt_states s irq \<noteq> IRQInactive)\<rbrace>
      do_machine_op (maskInterrupt b irq)
    \<lbrace>\<lambda>rv. invs\<rbrace>"
  assumes no_cap_to_obj_with_diff_IRQHandler[simp]:
    "\<And> irq S. (no_cap_to_obj_with_diff_ref (IRQHandlerCap irq) S :: 'a state \<Rightarrow> bool)= \<top>"
  assumes set_irq_state_valid_cap[wp]:
    "\<And> cap irq.
    \<lbrace>valid_cap cap :: 'a state \<Rightarrow> bool\<rbrace>
      set_irq_state IRQSignal irq
    \<lbrace>\<lambda>rv. valid_cap cap\<rbrace>"
  assumes set_irq_state_valid_global_refs[wp]:
    "\<And> a b.
    \<lbrace>valid_global_refs :: 'a state \<Rightarrow> bool\<rbrace>
      set_irq_state a b
    \<lbrace>\<lambda>_. valid_global_refs\<rbrace>"
  assumes invoke_irq_handler_invs':
    "\<And> (ex_inv :: 'a state \<Rightarrow> bool) i.
     \<lbrakk> \<And>f. \<lbrace>invs and ex_inv\<rbrace> do_machine_op f \<lbrace>\<lambda>rv::unit. ex_inv\<rbrace>;
       \<And>cap src dest.
       \<lbrace>ex_inv and invs and K (src \<noteq> dest)\<rbrace>
         cap_insert cap src dest
       \<lbrace>\<lambda>_.ex_inv\<rbrace>;
       \<And>cap. \<lbrace>ex_inv and invs\<rbrace> cap_delete_one cap \<lbrace>\<lambda>_.ex_inv\<rbrace>
     \<rbrakk> \<Longrightarrow>
     \<lbrace>invs and ex_inv and irq_handler_inv_valid i\<rbrace> invoke_irq_handler i \<lbrace>\<lambda>rv s. invs s \<and> ex_inv s\<rbrace>"
  assumes invoke_irq_control_invs[wp]:
    "\<And> i. \<lbrace>invs and irq_control_inv_valid i\<rbrace> invoke_irq_control i \<lbrace>\<lambda>rv. invs :: 'a state \<Rightarrow> bool\<rbrace>"
  assumes resetTimer_invs[wp]:
    "\<lbrace>invs :: 'a state \<Rightarrow> bool\<rbrace> do_machine_op resetTimer \<lbrace>\<lambda>_. invs\<rbrace>"
  assumes empty_fail_ackInterrupt[simp, intro!]:
    "\<And> irq. empty_fail (ackInterrupt irq)"
  assumes empty_fail_maskInterrupt[simp, intro!]:
    "\<And> f irq. empty_fail (maskInterrupt f irq)"
  assumes handle_interrupt_invs [wp]:
    "\<And> irq. \<lbrace>invs :: 'a state \<Rightarrow> bool\<rbrace> handle_interrupt irq \<lbrace>\<lambda>_. invs\<rbrace>"
  assumes sts_arch_irq_control_inv_valid [wp]:
    "\<And>i t st.
      \<lbrace>arch_irq_control_inv_valid i :: 'a state \<Rightarrow> bool\<rbrace>
        set_thread_state t st
      \<lbrace>\<lambda>rv. arch_irq_control_inv_valid i\<rbrace>"

crunch inv[wp]: decode_irq_handler_invocation "P"
  (simp: crunch_simps)

lemma valid_irq_handlersD:
  "\<lbrakk>cte_wp_at (op = (IRQHandlerCap irq)) (a, b) s; valid_irq_handlers s\<rbrakk>  \<Longrightarrow>
  interrupt_states s irq = IRQSignal"
  apply(auto simp: valid_irq_handlers_def cte_wp_at_caps_of_state irq_issued_def cap_irqs_def cap_irq_opt_def split: cap.splits)
  done

lemma decode_irq_handler_valid[wp]:
  "\<lbrace>\<lambda>s. invs s \<and> (\<forall>cap \<in> set caps. s \<turnstile> fst cap) \<and> (\<exists>ptr'. cte_wp_at (op = (cap.IRQHandlerCap irq)) ptr' s)
        \<and> (\<forall>cap \<in> set caps. \<forall>r \<in> cte_refs (fst cap) (interrupt_irq_node s). ex_cte_cap_to r s)
        \<and> (\<forall>cap \<in> set caps. ex_cte_cap_wp_to is_cnode_cap (snd cap) s)
        \<and> (\<forall>cap \<in> set caps. cte_wp_at (interrupt_derived (fst cap)) (snd cap) s)\<rbrace>
     decode_irq_handler_invocation label irq caps
   \<lbrace>irq_handler_inv_valid\<rbrace>,-"
  apply (simp add: decode_irq_handler_invocation_def Let_def split_def
                  split del: if_split cong: if_cong)
  apply (rule hoare_pre, wp)
  apply (clarsimp simp: neq_Nil_conv)
  apply (fastforce dest: valid_irq_handlersD simp: invs_def valid_state_def)
  done

crunch inv[wp]: is_irq_active "P"

lemma unat_mask_32_16_is_mod:
  "unat ((a::word32) && mask 16) = (unat a) mod (2^16)"
  by (simp add:word_mod_2p_is_mask[symmetric] unat_word_ariths)

lemma mod_le:
  "\<lbrakk>b < c;b dvd c\<rbrakk>  \<Longrightarrow> (a mod b \<le> a mod (c::nat))"
  apply (subst mod_mod_cancel[symmetric],simp)
  by simp

lemma is_up_8_32: "is_up (ucast :: word8 \<Rightarrow> word32)"
  by (simp add: is_up_def source_size_def target_size_def word_size)

crunch mdb_inv[wp]: cancel_all_ipc "\<lambda>s. P (cdt s)"
  (wp: fast_finalise_lift crunch_wps)

crunch mdb_inv[wp]: cancel_all_signals "\<lambda>s. P (cdt s)"
  (wp: fast_finalise_lift crunch_wps)

crunch mdb_inv[wp]: fast_finalise "\<lambda>s. P (cdt s)"
  (wp: fast_finalise_lift crunch_wps)

crunch mdb_inv[wp]: set_cap "\<lambda>s. P (cdt s)"
  (wp: crunch_wps simp: crunch_simps)

lemma cap_delete_one_still_derived:
  "\<lbrace>\<lambda>s. cte_wp_at (is_derived (cdt s) p' cap) p' s \<and> p \<noteq> p' \<and> valid_mdb s\<rbrace>
     cap_delete_one p
   \<lbrace>\<lambda>rv s. cte_wp_at (is_derived (cdt s) p' cap) p' s\<rbrace>"
  apply (simp add: cap_delete_one_def empty_slot_def unless_def
                   cte_wp_at_caps_of_state set_cdt_def)
  apply (wp hoare_vcg_ex_lift)
  apply (simp split del:if_split)
  apply (wp hoare_vcg_ex_lift get_cap_wp hoare_vcg_all_lift
            hoare_vcg_disj_lift
               | simp only: cte_wp_at_caps_of_state imp_conv_disj
                            cdt_update.caps_of_state_update
                            revokable_update.caps_of_state_update
               | simp)+
     apply (simp add: is_final_cap_def | wp)+
   apply (rule get_cap_wp)
  apply (clarsimp simp: cte_wp_at_caps_of_state if_apply_def2
             split del: if_split)
  apply (rule_tac x=capa in exI)
  apply (clarsimp simp only: is_derived_def simp_thms
                      split: if_split_asm)
   apply clarsimp
   apply (subst mdb_empty_abs.descendants[unfolded fun_upd_def])
    apply (rule mdb_empty_abs.intro)
    apply (rule vmdb_abs.intro)
    apply simp
   apply simp
  apply auto
  done

lemma cap_delete_one_cte_cap_to[wp]:
  "\<lbrace>ex_cte_cap_wp_to P ptr\<rbrace> cap_delete_one ptr' \<lbrace>\<lambda>rv. ex_cte_cap_wp_to P ptr\<rbrace>"
  apply (simp add: ex_cte_cap_wp_to_def)
  apply (wp hoare_vcg_ex_lift
            hoare_use_eq_irq_node [OF cap_delete_one_irq_node
                                      cap_delete_one_cte_wp_at_preserved])
  apply (clarsimp simp: can_fast_finalise_def split: cap.split_asm)+
  done

lemma get_irq_slot_ex_cte:
  "\<lbrace>\<lambda>s. \<exists>ptr. cte_wp_at (op = (cap.IRQHandlerCap irq)) ptr s \<and> P (cap.IRQHandlerCap irq)\<rbrace>
      get_irq_slot irq
   \<lbrace>ex_cte_cap_wp_to P\<rbrace>"
  apply (simp add: get_irq_slot_def)
  apply wp
  apply (simp add: ex_cte_cap_wp_to_def)
  apply (elim conjE exEI cte_wp_at_weakenE)
  apply clarsimp
  done

crunch pspace_aligned[wp]: set_irq_state "pspace_aligned"

crunch pspace_distinct[wp]: set_irq_state "pspace_distinct"

lemma valid_mdb_interrupts[simp]:
  "valid_mdb (interrupt_states_update f s) = valid_mdb s"
  by (simp add: valid_mdb_def mdb_cte_at_def)

crunch valid_mdb[wp]: set_irq_state "valid_mdb"

crunch mdb_cte_wp_at[wp]: set_irq_state "\<lambda>s. cte_wp_at (P (cdt s)) p s"
crunch real_cte_at[wp]: set_irq_state "real_cte_at p"

lemmas set_irq_state_cte_cap_to[wp]
    = ex_cte_cap_to_pres [OF set_irq_state_mdb_cte_wp_at set_irq_state_irq_node]

lemma set_irq_state_issued[wp]:
  "\<lbrace>\<top>\<rbrace> set_irq_state irq_state.IRQSignal irq \<lbrace>\<lambda>rv. irq_issued irq\<rbrace>"
  apply (simp add: set_irq_state_def irq_issued_def)
  apply wp
  apply clarsimp
  done

lemma IRQHandler_valid:
  "(s \<turnstile> cap.IRQHandlerCap irq) = (irq \<le> maxIRQ)"
  by (simp add: valid_cap_def cap_aligned_def word_bits_conv)

lemmas (in Interrupt_AI)
  invoke_irq_handler_invs[wp] = invoke_irq_handler_invs'[where ex_inv=\<top>
                                                             , simplified hoare_post_taut
                                                             , OF TrueI TrueI TrueI
                                                             , simplified
                                                        ]

crunch interrupt_states[wp]: update_waiting_ntfn, cancel_signal, blocked_cancel_ipc "\<lambda>s. P (interrupt_states s)" (wp: mapM_x_wp_inv)

lemma cancel_ipc_noreply_interrupt_states:
  "\<lbrace>\<lambda>s. st_tcb_at (\<lambda>st. st \<noteq> BlockedOnReply) t s \<and> P (interrupt_states s) \<rbrace> cancel_ipc t \<lbrace> \<lambda>_ s. P (interrupt_states s) \<rbrace>"
  apply (simp add: cancel_ipc_def)
  apply wpsimp
     apply (rule hoare_pre_cont)
    apply (wp)
   apply (wp gts_wp)+
  apply (auto simp: pred_tcb_at_def obj_at_def)
  done

lemma send_signal_interrupt_states[wp_unsafe]:
  "\<lbrace>\<lambda>s. P (interrupt_states s) \<and> valid_objs s\<rbrace> send_signal a b \<lbrace>\<lambda>_ s. P (interrupt_states s)\<rbrace>"
  apply (simp add: send_signal_def)
  apply (rule hoare_seq_ext [OF _ get_ntfn_sp])
  apply (rule hoare_pre)
  apply (wp cancel_ipc_noreply_interrupt_states gts_wp hoare_vcg_all_lift thread_get_wp | wpc | simp)+
  apply (clarsimp)
  apply (erule (1) obj_at_valid_objsE)
  apply (clarsimp simp: valid_obj_def valid_ntfn_def obj_at_def is_tcb_def)
  apply (case_tac ko, simp_all)
  apply (auto simp: pred_tcb_at_def obj_at_def receive_blocked_def)
  done

end


(*  Title:      HOL/Auth/n_g2kAbsAfter_lemma_inv__36_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_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__36_on_rules imports n_g2kAbsAfter_lemma_on_inv__36
begin
section{*All lemmas on causal relation between inv__36*}
lemma lemma_inv__36_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__36  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__36) done
    }

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

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__36) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__36) done
    }

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

end


(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory ArchUntyped_AI
imports Untyped_AI
begin

context Arch begin global_naming ARM_HYP

named_theorems Untyped_AI_assms

lemma of_bl_nat_to_cref[Untyped_AI_assms]:
    "\<lbrakk> x < 2 ^ bits; bits < word_bits \<rbrakk>
      \<Longrightarrow> (of_bl (nat_to_cref bits x) :: machine_word) = of_nat x"
  apply (clarsimp intro!: less_mask_eq
                  simp: nat_to_cref_def of_drop_to_bl
                        word_size word_less_nat_alt word_bits_def)
  by (metis add_lessD1 le_unat_uoi nat_le_iff_add nat_le_linear)

lemma cnode_cap_ex_cte[Untyped_AI_assms]:
  "\<lbrakk> is_cnode_cap cap; cte_wp_at (\<lambda>c. \<exists>m. cap = mask_cap m c) p s;
     (s::'state_ext::state_ext state) \<turnstile> cap; valid_objs s; pspace_aligned s \<rbrakk> \<Longrightarrow>
    ex_cte_cap_wp_to is_cnode_cap (obj_ref_of cap, nat_to_cref (bits_of cap) x) s"
  apply (simp only: ex_cte_cap_wp_to_def)
  apply (rule exI, erule cte_wp_at_weakenE)
  apply (clarsimp simp: is_cap_simps bits_of_def)
  apply (case_tac c, simp_all add: mask_cap_def cap_rights_update_def split:bool.splits)
  apply (clarsimp simp: nat_to_cref_def word_bits_def)
  apply (erule(2) valid_CNodeCapE)
  apply (simp add: word_bits_def cte_level_bits_def)
  done

lemma inj_on_nat_to_cref[Untyped_AI_assms]:
  "bits < word_bits \<Longrightarrow> inj_on (nat_to_cref bits) {..< 2 ^ bits}"
  apply (rule inj_onI)
  apply (drule arg_cong[where f="\<lambda>x. replicate (word_bits - bits) False @ x"])
  apply (subst(asm) word_bl.Abs_inject[where 'a=32, symmetric])
    apply (simp add: nat_to_cref_def word_bits_def)
   apply (simp add: nat_to_cref_def word_bits_def)
  apply (simp add: of_bl_rep_False of_bl_nat_to_cref)
  apply (erule word_unat.Abs_eqD)
   apply (simp only: unats_def mem_simps)
   apply (erule order_less_le_trans)
   apply (rule power_increasing, simp_all add: word_bits_def)
  apply (simp only: unats_def mem_simps)
  apply (erule order_less_le_trans)
  apply (rule power_increasing, simp+)
  done

lemma data_to_obj_type_sp[Untyped_AI_assms]:
  "\<lbrace>P\<rbrace> data_to_obj_type x \<lbrace>\<lambda>ts (s::'state_ext::state_ext state). ts \<noteq> ArchObject ASIDPoolObj \<and> P s\<rbrace>, -"
  unfolding data_to_obj_type_def
  apply (rule hoare_pre)
   apply (wp|wpc)+
  apply clarsimp
  apply (simp add: arch_data_to_obj_type_def split: if_split_asm)
  done

lemma dui_inv_wf[wp, Untyped_AI_assms]:
  "\<lbrace>invs and cte_wp_at ((=) (cap.UntypedCap dev w sz idx)) slot
     and (\<lambda>(s::'state_ext::state_ext state). \<forall>cap \<in> set cs. is_cnode_cap cap
                      \<longrightarrow> (\<forall>r\<in>cte_refs cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s))
    and (\<lambda>s. \<forall>x \<in> set cs. s \<turnstile> x)\<rbrace>
     decode_untyped_invocation label args slot (cap.UntypedCap dev w sz idx) cs
   \<lbrace>valid_untyped_inv\<rbrace>,-"
proof -
  have inj: "\<And>node_cap s. \<lbrakk>is_cnode_cap node_cap;
    unat (args ! 5) \<le> 2 ^ bits_of node_cap - unat (args ! 4);valid_cap node_cap s\<rbrakk> \<Longrightarrow>
    inj_on (Pair (obj_ref_of node_cap) \<circ> nat_to_cref (bits_of node_cap))
                      {unat (args ! 4)..<unat (args ! 4) + unat (args ! 5)}"
    apply (simp add: comp_def)
    apply (rule inj_on_split)
    apply (rule subset_inj_on [OF inj_on_nat_to_cref])
     apply (clarsimp simp: is_cap_simps bits_of_def valid_cap_def word_bits_def cap_aligned_def)
    apply clarsimp
    apply (rule less_le_trans)
     apply assumption
    apply (simp add: le_diff_conv2)
    done
  have nasty_strengthen:
    "\<And>S a f s. (\<forall>x\<in>S. cte_wp_at ((=) cap.NullCap) (a, f x) s)
    \<Longrightarrow> cte_wp_at (\<lambda>c. c \<noteq> cap.NullCap) slot s
    \<longrightarrow> slot \<notin> (Pair a \<circ> f) ` S"
    by (auto simp: cte_wp_at_caps_of_state)
  show ?thesis
    apply (simp add: decode_untyped_invocation_def unlessE_def[symmetric]
                     unlessE_whenE
             split del: if_split)
    apply (rule validE_R_sp[OF whenE_throwError_sp]
                validE_R_sp[OF data_to_obj_type_sp]
                validE_R_sp[OF dui_sp_helper] validE_R_sp[OF map_ensure_empty])+
     apply clarsimp
    apply (rule hoare_pre)
     apply (wp whenE_throwError_wp[THEN validE_validE_R] check_children_wp map_ensure_empty_wp)
    apply (clarsimp simp: distinct_map cases_imp_eq)
    apply (subgoal_tac "s \<turnstile> node_cap")
     prefer 2
     apply (erule disjE)
      apply (drule bspec [where x = "cs ! 0"],clarsimp)+
      apply fastforce
     apply clarsimp
     apply (clarsimp simp: cte_wp_at_caps_of_state)
     apply (drule(1) caps_of_state_valid[rotated])+
     apply simp
    apply (subgoal_tac "\<forall>r\<in>cte_refs node_cap (interrupt_irq_node s). ex_cte_cap_wp_to is_cnode_cap r s")
     apply (clarsimp simp: cte_wp_at_caps_of_state)
     apply (frule(1) caps_of_state_valid[rotated])
     apply (clarsimp simp: not_less)
     apply (frule(2) inj)
     apply (clarsimp simp: comp_def)
     apply (frule(1) caps_of_state_valid)
     apply (simp add: nasty_strengthen[unfolded o_def] cte_wp_at_caps_of_state)
     apply (intro conjI)
      apply (intro impI)
      apply (frule range_cover_stuff[where w=w and rv = 0 and sz = sz], simp_all)[1]
        apply (clarsimp simp: valid_cap_simps cap_aligned_def)+
      apply (frule alignUp_idem[OF is_aligned_weaken,where a = w])
        apply (erule range_cover.sz)
       apply (simp add: range_cover_def)
      apply (clarsimp simp: get_free_ref_def empty_descendants_range_in)
      apply (rule conjI[rotated], blast, clarsimp)
      apply (drule_tac x = "(obj_ref_of node_cap,nat_to_cref (bits_of node_cap) slota)" in bspec)
       apply (clarsimp simp: is_cap_simps nat_to_cref_def word_bits_def
                             bits_of_def valid_cap_simps cap_aligned_def)+
     apply (simp add: free_index_of_def)
     apply (frule(1) range_cover_stuff[where sz = sz])
        apply (clarsimp dest!: valid_cap_aligned simp:cap_aligned_def word_bits_def)+
      apply simp+
     apply (clarsimp simp: get_free_ref_def)
    apply (erule disjE)
     apply (drule_tac x= "cs!0" in bspec)
    subgoal by clarsimp
    subgoal by simp
    apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def)
    apply (rule_tac x=aa in exI,rule exI,rule exI)
    apply (rule conjI, assumption)
    apply simp
   done
qed

lemma asid_bits_ge_0:
  "(0::word32) < 2 ^ asid_bits" by (simp add: asid_bits_def)

lemma retype_ret_valid_caps_captable[Untyped_AI_assms]:
  "\<lbrakk>pspace_no_overlap_range_cover ptr sz (s::'state_ext::state_ext state) \<and> 0 < us
   \<and> range_cover ptr sz (obj_bits_api CapTableObject us) n \<and> ptr \<noteq> 0
       \<rbrakk>
         \<Longrightarrow> \<forall>y\<in>{0..<n}. s
                \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object CapTableObject dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api CapTableObject us)) [0..<n])
                           (kheap s)\<rparr> \<turnstile> CNodeCap (ptr_add ptr (y * 2 ^ obj_bits_api CapTableObject us)) us []"
by ((clarsimp simp:valid_cap_def default_object_def cap_aligned_def
        cte_level_bits_def slot_bits_def is_obj_defs well_formed_cnode_n_def empty_cnode_def
        dom_def arch_default_cap_def ptr_add_def | rule conjI | intro conjI obj_at_foldr_intro imageI
      | rule is_aligned_add_multI[OF _ le_refl],
        (simp add:range_cover_def word_bits_def obj_bits_api_def slot_bits_def)+)+)[1]

lemma retype_ret_valid_caps_aobj[Untyped_AI_assms]:
  "\<And>ptr sz (s::'state_ext::state_ext state) x6 us n.
  \<lbrakk>pspace_no_overlap_range_cover ptr sz s \<and> x6 \<noteq> ASIDPoolObj \<and>
  range_cover ptr sz (obj_bits_api (ArchObject x6) us) n \<and> ptr \<noteq> 0\<rbrakk>
            \<Longrightarrow> \<forall>y\<in>{0..<n}. s
                   \<lparr>kheap := foldr (\<lambda>p kh. kh(p \<mapsto> default_object (ArchObject x6) dev us)) (map (\<lambda>p. ptr_add ptr (p * 2 ^ obj_bits_api (ArchObject x6) us)) [0..<n])
                              (kheap s)\<rparr> \<turnstile> ArchObjectCap (ARM_A.arch_default_cap x6 (ptr_add ptr (y * 2 ^ obj_bits_api (ArchObject x6) us)) us dev)"
  apply (rename_tac aobject_type us n)
  apply (case_tac aobject_type)
by (clarsimp simp:valid_cap_def default_object_def cap_aligned_def
        cte_level_bits_def slot_bits_def is_obj_defs well_formed_cnode_n_def empty_cnode_def
        dom_def arch_default_cap_def ptr_add_def | intro conjI obj_at_foldr_intro
        imageI valid_vm_rights_def
      | rule is_aligned_add_multI[OF _ le_refl]
      | fastforce simp:range_cover_def obj_bits_api_def
        default_arch_object_def valid_vm_rights_def  word_bits_def a_type_def)+

lemma copy_global_mappings_hoare_lift:(*FIXME: arch_split  \<rightarrow> these do not seem to be used globally *)
  assumes wp: "\<And>ptr val. \<lbrace>Q\<rbrace> store_pde ptr val \<lbrace>\<lambda>rv. Q\<rbrace>"
  shows       "\<lbrace>Q\<rbrace> copy_global_mappings pd \<lbrace>\<lambda>rv. Q\<rbrace>"
  apply (simp add: copy_global_mappings_def)
  done

lemma init_arch_objects_hoare_lift:
  assumes wp: "\<And>oper. \<lbrace>(P::'state_ext::state_ext state\<Rightarrow>bool)\<rbrace> do_machine_op oper \<lbrace>\<lambda>rv :: unit. Q\<rbrace>"
              "\<And>ptr val. \<lbrace>P\<rbrace> store_pde ptr val \<lbrace>\<lambda>rv. P\<rbrace>"
  shows       "\<lbrace>P and Q\<rbrace> init_arch_objects tp ptr sz us adds \<lbrace>\<lambda>rv. Q\<rbrace>"
proof -
  have pres: "\<And>oper. \<lbrace>P and Q\<rbrace> do_machine_op oper \<lbrace>\<lambda>rv :: unit. Q\<rbrace>"
             "\<lbrace>P and Q\<rbrace> return () \<lbrace>\<lambda>rv. Q\<rbrace>"
    by (wp wp | simp)+
  show ?thesis
    apply (simp add: init_arch_objects_def
                  pres reserve_region_def
           split: Structures_A.apiobject_type.split
                  aobject_type.split)
    apply clarsimp
    apply (rule hoare_pre)
     apply (wp mapM_x_wp' copy_global_mappings_hoare_lift wp)
    apply simp
    done
qed

lemma cap_refs_in_kernel_windowD2:
  "\<lbrakk> cte_wp_at P p (s::'state_ext::state_ext state); cap_refs_in_kernel_window s \<rbrakk>
       \<Longrightarrow> \<exists>cap. P cap \<and> region_in_kernel_window (cap_range cap) s"
  apply (clarsimp simp: cte_wp_at_caps_of_state region_in_kernel_window_def)
  apply (drule(1) cap_refs_in_kernel_windowD)
  apply fastforce
  done

lemma init_arch_objects_descendants_range[wp,Untyped_AI_assms]:
  "\<lbrace>\<lambda>(s::'state_ext::state_ext state). descendants_range x cref s \<rbrace> init_arch_objects ty ptr n us y
          \<lbrace>\<lambda>rv s. descendants_range x cref s\<rbrace>"
  apply (simp add:descendants_range_def)
  apply (rule hoare_pre)
   apply (wp retype_region_mdb init_arch_objects_hoare_lift)
    apply (wps do_machine_op_mdb)
    apply (wp hoare_vcg_ball_lift)
   apply (rule hoare_pre)
    apply (wps store_pde_mdb_inv)
    apply wp
   apply simp
  apply fastforce
  done

lemma init_arch_objects_caps_overlap_reserved[wp,Untyped_AI_assms]:
  "\<lbrace>\<lambda>(s::'state_ext::state_ext state). caps_overlap_reserved S s\<rbrace>
   init_arch_objects ty ptr n us y
   \<lbrace>\<lambda>rv s. caps_overlap_reserved S s\<rbrace>"
  apply (simp add:caps_overlap_reserved_def)
  apply (rule hoare_pre)
   apply (wp retype_region_mdb init_arch_objects_hoare_lift)
  apply fastforce
  done

lemma set_untyped_cap_invs_simple[Untyped_AI_assms]:
  "\<lbrace>\<lambda>s. descendants_range_in {ptr .. ptr+2^sz - 1} cref s \<and> pspace_no_overlap_range_cover ptr sz s \<and> invs s
  \<and> cte_wp_at (\<lambda>c. is_untyped_cap c \<and> cap_bits c = sz \<and> obj_ref_of c = ptr \<and> cap_is_device c = dev) cref s \<and> idx \<le> 2^ sz\<rbrace>
  set_cap (cap.UntypedCap dev ptr sz idx) cref
 \<lbrace>\<lambda>rv s. invs s\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp: cte_wp_at_caps_of_state invs_def valid_state_def)
  apply (rule hoare_pre)
  apply (wp set_free_index_valid_pspace_simple set_cap_valid_mdb_simple
    set_cap_idle update_cap_ifunsafe)
  apply (simp add:valid_irq_node_def)
  apply wps
  apply (wp hoare_vcg_all_lift set_cap_irq_handlers set_cap_valid_arch_caps
    set_cap_irq_handlers cap_table_at_lift_valid set_cap_typ_at
    set_untyped_cap_refs_respects_device_simple)
  apply (clarsimp simp:cte_wp_at_caps_of_state is_cap_simps)
  apply (intro conjI, clarsimp)
        apply (rule ext, clarsimp simp:is_cap_simps)
       apply (clarsimp split:cap.splits simp:is_cap_simps appropriate_cte_cap_def)
      apply (drule(1) if_unsafe_then_capD[OF caps_of_state_cteD])
       apply clarsimp
      apply (clarsimp simp:is_cap_simps ex_cte_cap_wp_to_def appropriate_cte_cap_def cte_wp_at_caps_of_state)
     apply (clarsimp dest!:valid_global_refsD2 simp:cap_range_def)
    apply (simp add:valid_irq_node_def)
   apply (clarsimp simp:valid_irq_node_def)
  apply (clarsimp simp:no_cap_to_obj_with_diff_ref_def cte_wp_at_caps_of_state vs_cap_ref_def)
  apply (case_tac cap)
   apply (simp_all add:vs_cap_ref_def table_cap_ref_def)
  apply (rename_tac arch_cap)
  apply (case_tac arch_cap)
   apply simp_all
  apply (clarsimp simp:cap_refs_in_kernel_window_def
              valid_refs_def simp del:split_paired_All)
  apply (drule_tac x = cref in spec)
  apply (clarsimp simp:cte_wp_at_caps_of_state)
  apply fastforce
  done

lemma pbfs_atleast_pageBits':
  "pageBits \<le> pageBitsForSize sz"by (cases sz, simp_all add: pageBits_def)

lemma pbfs_less_wb':
  "pageBitsForSize sz < word_bits"by (cases sz, simp_all add: word_bits_conv pageBits_def)

lemma delete_objects_rewrite[Untyped_AI_assms]:
  "\<lbrakk>word_size_bits \<le> sz; sz \<le> word_bits; ptr && ~~ mask sz = ptr\<rbrakk>
    \<Longrightarrow> delete_objects ptr sz =
          do y \<leftarrow> modify (clear_um {ptr + of_nat k |k. k < 2 ^ sz});
             modify (detype {ptr && ~~ mask sz..ptr + 2 ^ sz - 1})
          od"
  apply (clarsimp simp: delete_objects_def freeMemory_def)
  apply (subgoal_tac "is_aligned (ptr &&~~ mask sz) sz")
  apply (subst mapM_storeWord_clear_um)
  apply (simp)
  apply simp
  apply (simp add:range_cover_def)
  apply clarsimp
  apply (rule is_aligned_neg_mask)
  apply simp
  done

declare store_pde_pred_tcb_at [wp]

(* nonempty_table *)
definition
  nonempty_table :: "machine_word set \<Rightarrow> Structures_A.kernel_object \<Rightarrow> bool"
where
 "nonempty_table S ko \<equiv>
    (a_type ko = AArch APageTable \<or> a_type ko = AArch APageDirectory)
       \<and> \<not> empty_table S ko"

lemma reachable_pg_cap_exst_update[simp]:
  "reachable_pg_cap x (trans_state f (s::'state_ext::state_ext state)) = reachable_pg_cap x s"
  by (simp add:reachable_pg_cap_def vs_lookup_pages_def
    vs_lookup_pages1_def obj_at_def)

lemma create_cap_valid_arch_caps[wp, Untyped_AI_assms]:
  "\<lbrace>valid_arch_caps
      and valid_cap (default_cap tp oref sz dev)
      and (\<lambda>(s::'state_ext::state_ext state). \<forall>r\<in>obj_refs (default_cap tp oref sz dev).
                (\<forall>p'. \<not> cte_wp_at (\<lambda>cap. r \<in> obj_refs cap) p' s)
              \<and> \<not> obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)
      and cte_wp_at ((=) cap.NullCap) cref
      and K (tp \<noteq> ArchObject ASIDPoolObj)\<rbrace>
     create_cap tp sz p dev (cref, oref) \<lbrace>\<lambda>rv. valid_arch_caps\<rbrace>"
  apply (simp add: create_cap_def set_cdt_def)
  apply (wp set_cap_valid_arch_caps hoare_vcg_disj_lift
      hoare_vcg_conj_lift hoare_vcg_all_lift hoare_vcg_imp_lift
    | simp add: trans_state_update[symmetric] del: trans_state_update split_paired_All split_paired_Ex imp_disjL split del: if_split)+
  apply (clarsimp simp del: split_paired_All split_paired_Ex
                            imp_disjL
                      simp: cte_wp_at_caps_of_state)
  apply (rule conjI)
   apply (clarsimp simp: no_cap_to_obj_with_diff_ref_def
                         cte_wp_at_caps_of_state)
   apply (case_tac "\<exists>x. x \<in> obj_refs cap")
    apply (clarsimp dest!: obj_ref_elemD)
    apply (case_tac cref, fastforce)
   apply (simp add: obj_ref_none_no_asid)
  apply (rule conjI)
   apply (auto simp: is_cap_simps valid_cap_def second_level_tables_def
                     obj_at_def nonempty_table_def a_type_simps)[1]
  apply (clarsimp simp del: imp_disjL)
  apply (case_tac "\<exists>x. x \<in> obj_refs cap")
   apply (clarsimp dest!: obj_ref_elemD)
   apply fastforce
  apply (auto simp: is_cap_simps)[1]
  done

lemma create_cap_cap_refs_in_kernel_window[wp, Untyped_AI_assms]:
  "\<lbrace>cap_refs_in_kernel_window and cte_wp_at (\<lambda>c. cap_range (default_cap tp oref sz dev) \<subseteq> cap_range c) p\<rbrace>
     create_cap tp sz p dev (cref, oref) \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
  apply (simp add: create_cap_def)
  apply (wp | simp)+
  apply (clarsimp simp: cte_wp_at_caps_of_state)
  apply (drule(1) cap_refs_in_kernel_windowD)
  apply blast
  done

lemma store_pde_weaken:
  "\<lbrace>\<lambda>s. page_directory_at (p && ~~ mask pd_bits) s \<longrightarrow> P s\<rbrace> store_pde p e \<lbrace>Q\<rbrace> =
   \<lbrace>P\<rbrace> store_pde p e \<lbrace>Q\<rbrace>"
  apply (rule iffI)
   apply (simp add: valid_def)
   apply (erule allEI)
   apply clarsimp
  apply (simp add: valid_def)
  apply (erule allEI)
  apply clarsimp
  apply (rule use_valid, assumption)
   apply (simp add: store_pde_def set_pd_def set_object_def)
   apply (wp get_object_wp)
  apply (clarsimp simp: obj_at_def a_type_simps vspace_bits_defs)
  apply (drule bspec, assumption)
  apply (simp add: simpler_store_pde_def obj_at_def fun_upd_def vspace_bits_defs
            split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
  done

lemma copy_global_mappings_nonempty_table: (* ARMHYP need change *)
  "is_aligned pd pd_bits \<Longrightarrow>
   \<lbrace>\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s) \<and>
        valid_arch_state s \<and> pspace_aligned s\<rbrace>
   copy_global_mappings pd
   \<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table
                        (set (second_level_tables (arch_state s)))) r s) \<and>
           valid_arch_state s \<and> pspace_aligned s\<rbrace>"
  apply (simp add: copy_global_mappings_def)
  done

lemma mapM_copy_global_mappings_nonempty_table[wp]:
  "\<lbrace>(\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)
        \<and> valid_arch_state s \<and> pspace_aligned s) and
    K (\<forall>pd\<in>set pds. is_aligned pd pd_bits)\<rbrace>
   mapM_x copy_global_mappings pds
   \<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\<rbrace>"
  apply (rule hoare_gen_asm)
  apply (rule hoare_strengthen_post)
   apply (rule mapM_x_wp', rule copy_global_mappings_nonempty_table)
   apply simp_all
  done

lemma init_arch_objects_nonempty_table[Untyped_AI_assms, wp]:
  "\<lbrace>(\<lambda>s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)
         \<and> valid_global_objs s \<and> valid_arch_state s \<and> pspace_aligned s) and
    K (\<forall>ref\<in>set refs. is_aligned ref (obj_bits_api tp us))\<rbrace>
        init_arch_objects tp ptr bits us refs
   \<lbrace>\<lambda>rv s. \<not> (obj_at (nonempty_table (set (second_level_tables (arch_state s)))) r s)\<rbrace>"
  apply (rule hoare_gen_asm)
  apply (simp add: init_arch_objects_def split del: if_split)
  apply (rule hoare_pre)
   apply (wp unless_wp | wpc | simp add: reserve_region_def)+
  apply (clarsimp simp: obj_bits_api_def default_arch_object_def pd_bits_def pageBits_def)
  done

lemma nonempty_table_caps_of[Untyped_AI_assms]:
  "nonempty_table S ko \<Longrightarrow> caps_of ko = {}"
  by (auto simp: caps_of_def cap_of_def nonempty_table_def a_type_def
          split: Structures_A.kernel_object.split if_split_asm)

lemma nonempty_default[simp, Untyped_AI_assms]:
  "tp \<noteq> Untyped \<Longrightarrow> \<not> nonempty_table S (default_object tp dev us)"
  apply (case_tac tp, simp_all add: default_object_def nonempty_table_def
                                    a_type_def)
  apply (rename_tac aobject_type)
  apply (case_tac aobject_type, simp_all add: default_arch_object_def)
   apply (simp_all add: empty_table_def pde_ref_def valid_pde_mappings_def)
  done

lemma set_pd_cte_wp_at_iin[wp]:
  "\<lbrace>\<lambda>s. P (cte_wp_at (P' (interrupt_irq_node s)) p s)\<rbrace>
   set_pd q pd
   \<lbrace>\<lambda>_ s. P (cte_wp_at (P' (interrupt_irq_node s)) p s)\<rbrace>"
  apply (simp add: set_pd_def set_object_def a_type_def)
  apply (wp get_object_wp)
  apply (clarsimp simp: obj_at_def cte_wp_at_caps_of_state
           split: Structures_A.kernel_object.splits arch_kernel_obj.splits)
  apply (subst caps_of_state_after_update)
   apply (simp add: obj_at_def)+
  done

crunch cte_wp_at_iin[wp]: init_arch_objects
  "\<lambda>s. P (cte_wp_at (P' (interrupt_irq_node s)) p s)"
  (ignore: clearMemory wp: crunch_wps)

lemmas init_arch_objects_ex_cte_cap_wp_to
    = init_arch_objects_excap

lemma obj_is_device_vui_eq[Untyped_AI_assms]:
  "valid_untyped_inv ui s
      \<Longrightarrow> case ui of Retype slot reset ptr_base ptr tp us slots dev
          \<Rightarrow> obj_is_device tp dev = dev"
  apply (cases ui, clarsimp)
  apply (clarsimp simp: obj_is_device_def
                 split: apiobject_type.split)
  apply (intro impI conjI allI, simp_all add: is_frame_type_def default_object_def)
  apply (simp add: default_arch_object_def split: aobject_type.split)
  apply (auto simp: arch_is_frame_type_def)
  done

lemma create_cap_ioports[wp, Untyped_AI_assms]:
  "\<lbrace>valid_ioports and cte_wp_at (\<lambda>_. True) cref\<rbrace> create_cap tp sz p dev (cref,oref) \<lbrace>\<lambda>rv. valid_ioports\<rbrace>"
  by wpsimp

end

global_interpretation Untyped_AI? : Untyped_AI
  where nonempty_table = ARM_HYP.nonempty_table
  proof goal_cases
    interpret Arch .
    case 1 show ?case
      by (unfold_locales; (fact Untyped_AI_assms)?)
  qed

end