(*
 * 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)
 *)

(* Proofs about untyped invocations. *)

theory Untyped_R
imports Detype_R Invocations_R
begin

primrec
  untypinv_relation :: "Invocations_A.untyped_invocation \<Rightarrow>
                        Invocations_H.untyped_invocation \<Rightarrow> bool"
where
  "untypinv_relation
     (Invocations_A.Retype c ob n ao n2 cl) x = (\<exists>ao'. x =
     (Invocations_H.Retype (cte_map c) ob n ao' n2
       (map cte_map cl))
           \<and> ao = APIType_map2 (Inr ao'))"

primrec
  valid_untyped_inv' :: "Invocations_H.untyped_invocation \<Rightarrow> kernel_state \<Rightarrow> bool"
where
 "valid_untyped_inv' (Invocations_H.Retype slot ptr_base ptr ty us slots)
   = (\<lambda>s. \<exists>sz idx. (cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap ptr_base sz idx) slot s
          \<and> range_cover ptr sz (APIType_capBits ty us) (length slots)
          \<and> (idx \<le> unat (ptr - ptr_base) \<or> ptr = ptr_base ) \<and> (ptr && ~~ mask sz) = ptr_base)
          \<and> (ptr = ptr_base \<longrightarrow> descendants_range_in' {ptr_base..ptr_base + 2^sz - 1} slot (ctes_of s))
          \<and> distinct (slot # slots)
          \<and> (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> us > 0)
          \<and> (ty = APIObjectType ArchTypes_H.Untyped \<longrightarrow> 4\<le> us \<and> us \<le> 30)
          \<and> (\<forall>slot \<in> set slots. cte_wp_at' (\<lambda>c. cteCap c = NullCap) slot s)
          \<and> (\<forall>slot \<in> set slots. ex_cte_cap_to' slot s)
          \<and> sch_act_simple s \<and> 0 < length slots)"

lemma whenE_rangeCheck_eq:
  "(rangeCheck (x :: 'a :: {linorder, integral}) y z) =
    (whenE (x < fromIntegral y \<or> fromIntegral z < x)
      (throwError (RangeError (fromIntegral y) (fromIntegral z))))"
  by (simp add: rangeCheck_def unlessE_whenE ucast_id linorder_not_le[symmetric])

lemma APIType_map2_CapTable[simp]:
  "(APIType_map2 ty = Structures_A.CapTableObject)
    = (ty = Inr (APIObjectType ArchTypes_H.CapTableObject))"
  by (simp add: APIType_map2_def
         split: sum.split ArchTypes_H.object_type.split
                ArchTypes_H.apiobject_type.split
                kernel_object.split arch_kernel_object.splits)

lemma alignUp_H[simp]:
  "Untyped_H.alignUp = WordSetup.alignUp"
  apply (rule ext)+
  apply (clarsimp simp:Untyped_H.alignUp_def WordSetup.alignUp_def mask_def)
  done

(* MOVE *)
lemma corres_compute_free_index:
  "corres (\<lambda>x y. x = y) (cte_at slot)
     (pspace_aligned' and pspace_distinct' and valid_mdb' and
      cte_wp_at' (\<lambda>_. True) (cte_map slot))
     (const_on_failure idx
        (doE y \<leftarrow> ensure_no_children slot;
             returnOk (0::nat)
         odE))
     (constOnFailure idx
        (doE y \<leftarrow> ensureNoChildren (cte_map slot);
             returnOk (0::nat)
         odE))"
  apply (clarsimp simp:const_on_failure_def constOnFailure_def)
  apply (rule corres_guard_imp)
    apply (rule corres_split_catch[where E = dc and E'=dc])
      apply simp
     apply (rule corres_guard_imp[OF corres_splitEE])
         apply (rule corres_returnOkTT)
         apply simp
        apply (rule ensure_no_children_corres)
        apply simp
       apply wp
      apply simp+
     apply (clarsimp simp:dc_def,wp)+
   apply simp
  apply simp
  done

lemma mapM_x_stateAssert:
  "mapM_x (\<lambda>x. stateAssert (f x) (ss x)) xs
    = stateAssert (\<lambda>s. \<forall>x \<in> set xs. f x s) []"
  apply (induct xs)
   apply (simp add: mapM_x_Nil)
  apply (simp add: mapM_x_Cons)
  apply (simp add: fun_eq_iff stateAssert_def bind_assoc exec_get assert_def)
  done

lemma mapM_locate_eq:
    "isCNodeCap cap
    \<Longrightarrow> mapM (\<lambda>x. locateSlotCap cap x) xs
        = (do stateAssert (\<lambda>s. case gsCNodes s (capUntypedPtr cap) of None \<Rightarrow> xs = [] | Some n
                \<Rightarrow> \<forall>x \<in> set xs. n = capCNodeBits cap \<and> x < 2 ^ n) [];
            return (map (\<lambda>x. (capCNodePtr cap) + 2 ^ cte_level_bits * x) xs) od)"
  apply (clarsimp simp: isCap_simps)
  apply (simp add: locateSlot_conv objBits_simps cte_level_bits_def
                   liftM_def[symmetric] mapM_liftM_const isCap_simps)
  apply (simp add: liftM_def mapM_discarded mapM_x_stateAssert)
  apply (intro bind_cong refl arg_cong2[where f=stateAssert] ext)
  apply (simp add: isCap_simps split: option.split)
  done

lemma dec_untyped_inv_corres:
  assumes cap_rel: "list_all2 cap_relation cs cs'"
  shows "corres
        (ser \<oplus> untypinv_relation)
        (invs and cte_wp_at (op = (cap.UntypedCap w n idx)) slot and (\<lambda>s. \<forall>x \<in> set cs. s \<turnstile> x))
        (invs'
          and (\<lambda>s. \<forall>x \<in> set cs'. s \<turnstile>' x))
        (decode_untyped_invocation label args slot (cap.UntypedCap w n idx) cs)
        (decodeUntypedInvocation label args (cte_map slot)
          (capability.UntypedCap w n idx) cs')"
proof (cases "6 \<le> length args \<and> cs \<noteq> []
                \<and> invocation_type label = UntypedRetype")
  case False
  show ?thesis using False cap_rel
    apply (clarsimp simp: decode_untyped_invocation_def
                          decodeUntypedInvocation_def
                          whenE_whenE_body unlessE_whenE
               split del: split_if cong: list.case_cong)
    apply (auto split: list.split)
    done
next
  case True
  have val_le_length_Cons: (* clagged from Tcb_R *)
    "\<And>n xs. n \<noteq> 0 \<Longrightarrow> (n \<le> length xs) = (\<exists>y ys. xs = y # ys \<and> (n - 1) \<le> length ys)"
    apply (case_tac xs, simp_all)
    apply (case_tac n, simp_all)
    done

  obtain arg0 arg1 arg2 arg3 arg4 arg5 argsmore cap cap' csmore csmore'
    where args: "args = arg0 # arg1 # arg2 # arg3 # arg4 # arg5 # argsmore"
      and   cs: "cs = cap # csmore"
      and  cs': "cs' = cap' # csmore'"
      and crel: "cap_relation cap cap'"
    using True cap_rel
    by (clarsimp simp: neq_Nil_conv list_all2_Cons1 val_le_length_Cons)

  have il: "invocation_type label = UntypedRetype"
    using True by simp

  have word_unat_power2:
    "\<And>bits. \<lbrakk> bits < 32 \<or> bits < word_bits \<rbrakk> \<Longrightarrow> unat (2 ^ bits :: word32) = 2 ^ bits"
    by (simp add: word_bits_def)

  have P: "\<And>P. corres (ser \<oplus> dc) \<top> \<top>
                  (whenE P (throwError ExceptionTypes_A.syscall_error.TruncatedMessage))
                  (whenE P (throwError Fault_H.syscall_error.TruncatedMessage))"
    by (simp add: whenE_def returnOk_def)
  have Q: "\<And>v. corres (ser \<oplus> (\<lambda>a b. APIType_map2 (Inr (toEnum (unat v))) = a)) \<top> \<top>
                  (data_to_obj_type v)
                  (whenE (fromEnum (maxBound :: ArchTypes_H.object_type) < unat v)
                       (throwError (Fault_H.syscall_error.InvalidArgument 0)))"
    apply (simp only: data_to_obj_type_def returnOk_bindE fun_app_def)
    apply (simp add: maxBound_def enum_apiobject_type
                     fromEnum_def whenE_def)
    apply (simp add: returnOk_def APIType_map2_def toEnum_def
                     enum_apiobject_type enum_object_type)
    apply (intro conjI impI)
     apply (subgoal_tac "unat v - 5 > 5")
      apply (simp add: arch_data_to_obj_type_def)
     apply simp
    apply (subgoal_tac "\<exists>n. unat v = n + 5")
     apply (clarsimp simp: arch_data_to_obj_type_def returnOk_def)
    apply (rule_tac x="unat v - 5" in exI)
    apply arith
    done
  have S: "\<And>x (y :: ('g :: len) word) (z :: 'g word) bits. \<lbrakk> bits < len_of TYPE('g); x < 2 ^ bits \<rbrakk> \<Longrightarrow> toEnum x = (of_nat x :: 'g word)"
    apply (rule toEnum_of_nat)
    apply (erule order_less_trans)
    apply simp
    done
  obtain xs where xs: "xs = [unat arg4..<unat arg4 + unat arg5]"
    by simp
  have YUCK: "\<And>ref bits.
                  \<lbrakk> is_aligned ref bits;
                    Suc (unat arg4 + unat arg5 - Suc 0) \<le> 2 ^ bits;
                    bits < 32; 1 \<le> arg4 + arg5;
                    arg4 \<le> arg4 + arg5 \<rbrakk> \<Longrightarrow>
              (map (\<lambda>x. ref + 2 ^ cte_level_bits * x) [arg4 .e. arg4 + arg5 - 1])
              = map cte_map
               (map (Pair ref)
                 (map (nat_to_cref bits) xs))"
    apply (subgoal_tac "Suc (unat (arg4 + arg5 - 1)) = unat arg4 + unat arg5")
     apply (simp add: upto_enum_def xs del: upt.simps)
     apply (clarsimp simp: cte_map_def)
     apply (subst of_bl_nat_to_cref)
       apply simp
      apply simp
     apply (subst S)
       apply simp
      apply simp
     apply (simp add: cte_level_bits_def)
    apply unat_arith
    done
  have another:
    "\<And>bits a. \<lbrakk> (a::word32) \<le> 2 ^ bits; bits < word_bits\<rbrakk>
       \<Longrightarrow> 2 ^ bits - a = of_nat (2 ^ bits - unat a)"
    apply (subst of_nat_diff)
     apply (subst (asm) word_le_nat_alt)
     apply (simp add: word_unat_power2)
    apply simp
    done
   have ty_size:
   "\<And>x y. (obj_bits_api (APIType_map2 (Inr x)) y) = (Types_H.getObjectSize x y)"
      apply (clarsimp simp:obj_bits_api_def APIType_map2_def getObjectSize_def ArchTypes_H.getObjectSize_def)
      apply (case_tac x)
       apply (simp_all add:arch_kobj_size_def default_arch_object_def
         pageBits_def pdBits_def ptBits_def)
      apply (rename_tac apiobject_type)
      apply (case_tac apiobject_type)
       apply (simp_all add:apiGetObjectSize_def tcbBlockSizeBits_def epSizeBits_def
         ntfnSizeBits_def slot_bits_def cteSizeBits_def)
      done
  note word_unat_power [symmetric, simp del]
  show ?thesis
    apply (rule corres_name_pre)
    apply clarsimp
    apply (subgoal_tac "cte_wp_at' (\<lambda>cte. cteCap cte = (capability.UntypedCap w n idx)) (cte_map slot) s'")
    prefer 2
     apply (drule state_relation_pspace_relation)
      apply (case_tac slot)
      apply simp
     apply (drule(1) pspace_relation_cte_wp_at)
      apply fastforce+
    apply (clarsimp simp:cte_wp_at_caps_of_state)
    apply (frule caps_of_state_valid_cap[unfolded valid_cap_def])
     apply fastforce
    apply (clarsimp simp:cap_aligned_def)
(* ugh yuck. who likes a word proof? furthermore, some more restriction of
   the returnOk_bindE stuff needs to be done in order to give you a single
   target to do the word proof against or else it needs repeating. ugh.
   maybe could seperate out the equality Isar-style? *)
    apply (simp add: decodeUntypedInvocation_def decode_untyped_invocation_def
                     args cs cs' xs[symmetric] il whenE_rangeCheck_eq
                     cap_case_CNodeCap unlessE_whenE case_bool_If
                     lookup_target_slot_def lookupTargetSlot_def
                split del: split_if cong: if_cong list.case_cong del: upt.simps)
    apply (rule corres_guard_imp)
      apply (rule corres_splitEE [OF _ Q])
        apply (rule whenE_throwError_corres)
          apply (simp add: word_bits_def word_size)
         apply (simp add: word_size word_bits_def fromIntegral_def
                          toInteger_nat fromInteger_nat linorder_not_less)
         apply fastforce
        apply (rule whenE_throwError_corres, simp)
         apply (clarsimp simp: fromAPIType_def ArchTypes_H.fromAPIType_def)
        apply (rule whenE_throwError_corres, simp)
         apply (clarsimp simp: fromAPIType_def ArchTypes_H.fromAPIType_def)
        apply (rule_tac r' = "\<lambda>cap cap'. cap_relation cap cap'" in corres_splitEE[OF _ corres_if])
             apply (rule_tac corres_split_norE)
                prefer 2
                apply (rule corres_if)
                  apply simp
                 apply (rule corres_returnOk,clarsimp)
                apply (rule corres_trivial)
                apply (clarsimp simp: fromAPIType_def lookup_failure_map_def)
               apply (rule_tac F="is_cnode_cap rva \<and> cap_aligned rva" in corres_gen_asm)
               apply (subgoal_tac "is_aligned (obj_ref_of rva) (bits_of rva) \<and> bits_of rva < 32")
                prefer 2
                apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def word_bits_def
                                      is_aligned_weaken)
               apply (rule whenE_throwError_corres)
                 apply (clarsimp simp:retypeFanOutLimit_def is_cap_simps bits_of_def ucast_id)+
                apply (simp add: unat_arith_simps(2) unat_2p_sub_1 word_bits_def)
               apply (rule whenE_throwError_corres)
                 apply (clarsimp simp:retypeFanOutLimit_def is_cap_simps bits_of_def ucast_id)+
                apply (simp add: unat_eq_0 word_less_nat_alt)
               apply (rule whenE_throwError_corres)
                 apply (clarsimp simp:retypeFanOutLimit_def is_cap_simps bits_of_def ucast_id)+
                apply (clarsimp simp:toInteger_word ucast_id unat_arith_simps(2) cap_aligned_def)
                apply (subst unat_sub)
                 apply (simp add: linorder_not_less word_le_nat_alt)
                apply (fold neq0_conv)
                apply (simp add: unat_eq_0 cap_aligned_def)
               apply (clarsimp simp:fromAPIType_def)
               apply (clarsimp simp:liftE_bindE mapM_locate_eq)
               apply (subgoal_tac "unat (arg4 + arg5) = unat arg4 + unat arg5")
                prefer 2
                apply (clarsimp simp:not_less)
                apply (subst unat_word_ariths(1))
                apply (rule mod_less)
                apply (unfold word_bits_len_of)[1]
                apply (subgoal_tac "2 ^ bits_of rva < (2 :: nat) ^ word_bits")
                 apply arith
                apply (rule power_strict_increasing, simp add: word_bits_conv)
                apply simp
               apply (rule_tac P'="valid_cap rva" in corres_stateAssert_implied)
                apply (frule_tac bits2 = "bits_of rva" in YUCK)
                    apply (simp)
                   apply (simp add: word_bits_conv)
                  apply (simp add: word_le_nat_alt)
                 apply (simp add: word_le_nat_alt)
                apply (simp add:liftE_bindE[symmetric] free_index_of_def)
                apply (rule corres_split_norE)
                   apply (subst liftE_bindE)+
                   apply (rule corres_split[OF _ corres_compute_free_index])
                     apply (rule_tac F ="free_index \<le> 2 ^ n" in corres_gen_asm)
                     apply (rule whenE_throwError_corres)
                       apply (clarsimp simp:shiftL_nat word_less_nat_alt shiftr_div_2n')+
                      apply (simp add: word_of_nat_le another)
                      apply (drule_tac x = freeIndex in unat_of_nat32[OF le_less_trans])
                       apply (simp add:ty_size shiftR_nat)+
                      apply (simp add:unat_of_nat32 le_less_trans[OF div_le_dividend]
                          le_less_trans[OF diff_le_self])
                     apply (rule corres_returnOkTT)
                     apply (clarsimp simp:ty_size getFreeRef_def get_free_ref_def is_cap_simps)
                    apply (rule hoare_strengthen_post[OF compute_free_index_wp])
                    apply simp
                   apply simp
                   apply wp
                  apply (clarsimp simp:is_cap_simps  simp del:ser_def)
                  apply (simp add: mapME_x_map_simp  del: ser_def)
                  apply (rule_tac P = "valid_cap (cap.CNodeCap r bits g) and invs" in corres_guard_imp [where P' = invs'])
                    apply (rule mapME_x_corres_inv [OF _ _ _ refl])
                      apply (simp del: ser_def)
                      apply (rule ensure_empty_corres)
                      apply (clarsimp simp: is_cap_simps)
                     apply (simp, wp)
                    apply (simp, wp)
                    apply clarsimp
                   apply (clarsimp simp add: xs is_cap_simps bits_of_def valid_cap_def)
                   apply (erule cap_table_at_cte_at)
                   apply (simp add: nat_to_cref_def word_bits_conv)
                  apply simp
                 apply (wp mapME_x_inv_wp
                           validE_R_validE[OF valid_validE_R[OF ensure_empty_inv]]
                           validE_R_validE[OF valid_validE_R[OF ensureEmpty_inv]])
               apply (clarsimp simp: is_cap_simps valid_cap_simps
                                     cap_table_at_gsCNodes bits_of_def
                                     linorder_not_less)
               apply (erule order_le_less_trans)
               apply (rule minus_one_helper)
                apply (simp add: word_le_nat_alt)
               apply (simp add: unat_arith_simps)
              apply wp
            apply simp
           apply (rule corres_returnOkTT)
           apply (rule crel)
          apply simp
          apply (rule corres_splitEE[OF _ lsfc_corres])
              apply simp
              apply (rule getSlotCap_corres,simp)
             apply (rule crel)
            apply simp
           apply (wp lookup_slot_for_cnode_op_inv
                     hoare_drop_impE_R hoare_vcg_all_lift_R
                | clarsimp)+
          apply (rule hoare_strengthen_post [where Q = "\<lambda>r. invs and valid_cap r and cte_at slot"])
           apply wp
          apply (clarsimp simp: is_cap_simps bits_of_def cap_aligned_def
                                valid_cap_def word_bits_def)
          apply (rule TrueI conjI impI)+
         apply wp
         apply (rule hoare_strengthen_post [where Q = "\<lambda>r. invs' and cte_at' (cte_map slot)"])
          apply wp
         apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' )
         apply auto[1]
      apply (wp whenE_throwError_wp | wp_once hoare_drop_imps)+
   apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct'
                         cte_wp_at_caps_of_state cte_wp_at_ctes_of )
   apply (clarsimp simp: invs_valid_objs invs_psp_aligned)
   apply (clarsimp simp: is_cap_simps valid_cap_def bits_of_def cap_aligned_def
                         cte_level_bits_def word_bits_conv)
  apply (clarsimp simp: invs_valid_objs' invs_pspace_aligned' invs_pspace_distinct'
                        cte_wp_at_caps_of_state cte_wp_at_ctes_of )
  done
qed

crunch inv[wp]: ensureEmptySlot "P"

lemma decodeUntyped_inv[wp]:
  "\<lbrace>P\<rbrace> decodeUntypedInvocation label args slot
       (UntypedCap w n idx) cs \<lbrace>\<lambda>rv. P\<rbrace>"
  apply (simp add: decodeUntypedInvocation_def whenE_def
                   split_def unlessE_def Let_def
              split del: split_if cong: if_cong list.case_cong)
  apply (rule hoare_pre)
   apply (wp mapME_x_inv_wp hoare_drop_imps constOnFailure_wp
             mapM_wp'
               | wpcw
               | simp add: lookupTargetSlot_def locateSlot_conv)+
  done


declare inj_Pair[simp]

declare upt_Suc[simp del]

lemma descendants_of_cte_at':
  "\<lbrakk>p \<in> descendants_of' x (ctes_of s); valid_mdb' s\<rbrakk>
   \<Longrightarrow> cte_wp_at' (\<lambda>_. True) p s"
  by (clarsimp simp:descendants_of'_def cte_wp_at_ctes_of
    dest!:subtree_target_Some)

lemma ctes_of_ko:
  "valid_cap' cap s \<Longrightarrow>
   isUntypedCap cap \<or>
   (\<forall>ptr\<in>capRange cap. \<exists>optr ko. ksPSpace s optr = Some ko \<and>
                                  ptr \<in> obj_range' optr ko)"
  apply (case_tac cap)
             -- "TCB case"
             apply (simp_all add: isCap_simps capRange_def)
       apply (clarsimp simp: valid_cap'_def obj_at'_def)
       apply (intro exI conjI, assumption)
       apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def
                       dest!: projectKO_opt_tcbD simp: objBitsKO_def)
      -- "NTFN case"
      apply (clarsimp simp: valid_cap'_def obj_at'_def)
      apply (intro exI conjI, assumption)
      apply (clarsimp simp: projectKO_eq objBits_def
     obj_range'_def projectKO_ntfn objBitsKO_def)
     -- "EP case"
     apply (clarsimp simp: valid_cap'_def obj_at'_def)
     apply (intro exI conjI, assumption)
     apply (clarsimp simp: projectKO_eq objBits_def
    obj_range'_def projectKO_ep objBitsKO_def)
    -- "Zombie case"
    apply (rename_tac word zombie_type nat)
    apply (case_tac zombie_type)
     apply (clarsimp simp: valid_cap'_def obj_at'_def)
     apply (intro exI conjI, assumption)
     apply (clarsimp simp: projectKO_eq objBits_def obj_range'_def dest!:projectKO_opt_tcbD simp: objBitsKO_def)
    apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def
                          objBits_simps projectKOs)
    apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
    apply clarsimp
    apply (drule_tac x=idx in spec)
    apply (clarsimp simp: less_mask_eq)
    apply (fastforce simp: obj_range'_def projectKOs objBits_simps field_simps)[1]
   -- "Arch cases"
   apply (rename_tac arch_capability)
   apply (case_tac arch_capability)
       -- "ASID case"
       apply (clarsimp simp: valid_cap'_def  typ_at'_def ko_wp_at'_def)
       apply (intro exI conjI, assumption)
       apply (clarsimp simp: obj_range'_def archObjSize_def objBitsKO_def)
       apply (case_tac ko, simp+)[1]
       apply (rename_tac arch_kernel_object)
       apply (case_tac arch_kernel_object;
              simp add: archObjSize_def asid_low_bits_def pageBits_def)
      apply simp
     -- "Page case"
     apply (rename_tac word vmrights vmpage_size option)
     apply (clarsimp simp: valid_cap'_def typ_at'_def ko_wp_at'_def capAligned_def)
     apply (frule_tac ptr = ptr and sz = "pageBits" in nasty_range [where 'a=32, folded word_bits_def])
        apply assumption
       apply (simp add: pbfs_atleast_pageBits)+
     apply (clarsimp)
     apply (drule_tac x = idx in spec)
     apply (clarsimp simp: objBitsT_koTypeOf [symmetric] objBitsT_simps)
     apply (intro exI conjI,assumption)
     apply (clarsimp simp:obj_range'_def)
     apply (case_tac ko, simp_all)
     apply (simp add: objBitsKO_def archObjSize_def field_simps shiftl_t2n)
    -- "PT case"
    apply (rename_tac word option)
    apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def
                          page_table_at'_def typ_at'_def ko_wp_at'_def ptBits_def)
    apply (frule_tac ptr=ptr and sz=2 in
                     nasty_range[where 'a=32 and bz="ptBits", folded word_bits_def,
                                 simplified ptBits_def pageBits_def word_bits_def, simplified])
      apply simp
     apply simp
    apply clarsimp
    apply (drule_tac x=idx in spec)
    apply clarsimp
    apply (intro exI conjI,assumption)
    apply (clarsimp simp:obj_range'_def)
    apply (case_tac ko; simp)
    apply (rename_tac arch_kernel_object)
    apply (case_tac arch_kernel_object; simp)
    apply (simp add:objBitsKO_def archObjSize_def field_simps shiftl_t2n)
   -- "PD case"
   apply (clarsimp simp: valid_cap'_def obj_at'_def pageBits_def pdBits_def
                         page_directory_at'_def typ_at'_def ko_wp_at'_def)
   apply (frule_tac ptr=ptr and sz=2 in 
                    nasty_range[where 'a=32 and bz="pdBits", folded word_bits_def,
                                simplified pdBits_def pageBits_def word_bits_def, simplified])
     apply simp
    apply simp
   apply clarsimp
   apply (drule_tac x="idx" in spec)
   apply clarsimp
   apply (intro exI conjI, assumption)
   apply (clarsimp simp: obj_range'_def objBitsKO_def field_simps)
   apply (case_tac ko; simp)
   apply (rename_tac arch_kernel_object) 
   apply (case_tac arch_kernel_object; simp)
   apply (simp add: field_simps archObjSize_def shiftl_t2n)
  -- "CNode case"
  apply (clarsimp simp: valid_cap'_def obj_at'_def capAligned_def
                        objBits_simps projectKOs)
  apply (frule_tac ptr=ptr and sz=4 in nasty_range [where 'a=32, folded word_bits_def], simp+)
  apply clarsimp
  apply (drule_tac x=idx in spec)
  apply (clarsimp simp: less_mask_eq)
  apply (fastforce simp: obj_range'_def projectKOs objBits_simps field_simps)[1]
  done

lemma untypedCap_descendants_range':
  "\<lbrakk>valid_pspace' s; (ctes_of s) p = Some cte;
    isUntypedCap (cteCap cte);valid_mdb' s;
    q \<in> descendants_of' p (ctes_of s)\<rbrakk>
   \<Longrightarrow> cte_wp_at' (\<lambda>c. (capRange (cteCap c) \<inter>
                        usableUntypedRange (cteCap cte) = {})) q s"
  apply (clarsimp simp: valid_pspace'_def)
  apply (frule(1) descendants_of_cte_at')
  apply (clarsimp simp:cte_wp_at_ctes_of)
  apply (clarsimp simp:valid_mdb'_def)
  apply (frule valid_mdb_no_loops)
  apply (case_tac "isUntypedCap (cteCap ctea)")
   apply (case_tac ctea)
   apply (rename_tac cap node)
   apply (case_tac cte)
   apply (rename_tac cap' node')
   apply clarsimp
   apply (frule(1) valid_capAligned[OF ctes_of_valid_cap'])
   apply (frule_tac c = cap in valid_capAligned[OF ctes_of_valid_cap'])
    apply (simp add:untypedCapRange)+
   apply (frule_tac c = cap' in aligned_untypedRange_non_empty)
    apply simp
   apply (frule_tac c = cap in aligned_untypedRange_non_empty)
    apply simp
   apply (clarsimp simp:valid_mdb'_def valid_mdb_ctes_def)
   apply (drule untyped_incD')
       apply simp+
   apply clarify
   apply (erule subset_splitE)
      apply simp
      apply (thin_tac "P \<longrightarrow> Q" for P Q)+
      apply (elim conjE)
      apply (simp add:descendants_of'_def)
      apply (drule(1) subtree_trans)
      apply (simp add:no_loops_no_subtree)
     apply simp
    apply (clarsimp simp:descendants_of'_def | erule disjE)+
     apply (drule(1) subtree_trans)
     apply (simp add:no_loops_no_subtree)+
   apply (thin_tac "P \<longrightarrow> Q" for P Q)+
   apply (erule(1) disjoint_subset2[OF usableRange_subseteq])
   apply (simp add:Int_ac)
  apply (case_tac ctea)
  apply (rename_tac cap node)
  apply (case_tac cte)
  apply clarsimp
  apply (drule(1) ctes_of_valid_cap')+
  apply (frule_tac cap = cap in ctes_of_ko)
  apply (elim disjE)
   apply clarsimp+
  apply (thin_tac "s \<turnstile>' cap")
  apply (clarsimp simp: valid_cap'_def isCap_simps valid_untyped'_def
                  simp del: usableUntypedRange.simps untypedRange.simps)
  apply (thin_tac "\<forall>x y z. P x y z" for P)
  apply (rule ccontr)
  apply (clarsimp dest!: WordLemmaBucket.int_not_emptyD
                  simp del: usableUntypedRange.simps untypedRange.simps)
  apply (drule(1) bspec)
  apply (clarsimp simp: ko_wp_at'_def simp del: usableUntypedRange.simps untypedRange.simps)
  apply (drule_tac x = optr in spec)
  apply (clarsimp simp: ko_wp_at'_def simp del: usableUntypedRange.simps untypedRange.simps)
  apply (frule(1) pspace_alignedD')
  apply (frule(1) pspace_distinctD')
  apply (erule(1) impE)
  apply (clarsimp simp del: usableUntypedRange.simps untypedRange.simps)
  apply blast
  done

lemma cte_wp_at_caps_descendants_range_inI':
  "\<lbrakk>invs' s; cte_wp_at' (\<lambda>c. (cteCap c) = capability.UntypedCap
                                            (ptr && ~~ mask sz) sz idx) cref s;
    idx \<le> unat (ptr && mask sz); sz < word_bits\<rbrakk>
   \<Longrightarrow> descendants_range_in' {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}
         cref (ctes_of s)"
  apply (frule invs_mdb')
  apply (frule(1) le_mask_le_2p)
  apply (clarsimp simp: descendants_range_in'_def cte_wp_at_ctes_of)
  apply (drule untypedCap_descendants_range'[rotated])
      apply (simp add: isCap_simps)+
   apply (simp add: invs_valid_pspace')
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (erule disjoint_subset2[rotated])
  apply clarsimp
  apply (rule le_plus'[OF word_and_le2])
  apply simp
  apply (erule word_of_nat_le)
  done

lemma checkFreeIndex_wp:
  "\<lbrace>\<lambda>s. if descendants_of' slot (ctes_of s) = {} then Q 0 s else Q idx s\<rbrace>
   constOnFailure idx (doE y \<leftarrow> ensureNoChildren slot; returnOk (0::nat) odE)
   \<lbrace>Q\<rbrace>"
  apply (clarsimp simp:constOnFailure_def const_def)
  apply wp
  apply (simp add: ensureNoChildren_def whenE_def)
  apply (wp getCTE_wp')
  apply (intro allI impI conjI)
        apply simp_all
    apply (drule conjunct2)
    apply (erule impE)
     apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def descendants_of'_def)
     apply (rule_tac x = "(mdbNext (cteMDBNode cte))" in exI)
     apply (rule subtree.direct_parent)
       apply (simp add:mdb_next_rel_def mdb_next_def)
      apply simp
     apply (simp add:parentOf_def)+
   apply (drule conjunct1)
   apply (erule impE)
    apply (clarsimp simp: cte_wp_at_ctes_of nullPointer_def descendants_of'_def)
    apply (erule (4) subtree_no_parent)
   apply clarsimp
  apply (drule conjunct1)
  apply (clarsimp simp:nullPointer_def cte_wp_at_ctes_of descendants_of'_def)
  apply (erule(2) subtree_next_0)
  done

declare upt_Suc[simp]

lemma ensureNoChildren_sp:
  "\<lbrace>P\<rbrace> ensureNoChildren sl \<lbrace>\<lambda>rv s. P s \<and> descendants_of' sl (ctes_of s) = {}\<rbrace>,-"
  by (rule hoare_pre, wp ensureNoChildren_wp, simp)

declare isPDCap_PD [simp]

declare diminished_Untyped' [simp]

lemma dui_sp_helper':
  "\<lbrace>P\<rbrace> if Q then returnOk root_cap
       else doE slot \<leftarrow>
                  lookupTargetSlot root_cap cref dpth;
                  liftE (getSlotCap slot)
            odE \<lbrace>\<lambda>rv s. (rv = root_cap \<or> (\<exists>slot. cte_wp_at' (diminished' rv o cteCap) slot s)) \<and> P s\<rbrace>, -"
  apply (cases Q, simp_all add: lookupTargetSlot_def)
   apply (rule hoare_pre, wp, simp)
  apply (simp add: getSlotCap_def split_def)
  apply wp
   apply (rule hoare_strengthen_post [OF getCTE_sp[where P=P]])
   apply (clarsimp simp: cte_wp_at_ctes_of diminished'_def)
   apply (elim allE, drule(1) mp)
   apply (erule allE, subst(asm) maskCapRights_allRights)
   apply simp
  apply (rule hoare_pre, wp)
  apply simp
  done

lemma map_ensure_empty':
  "\<lbrace>\<lambda>s. (\<forall>slot \<in> set slots. cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) slot s) \<longrightarrow> P s\<rbrace>
     mapME_x ensureEmptySlot slots
   \<lbrace>\<lambda>rv s. P s \<rbrace>,-"
  apply (induct slots arbitrary: P)
   apply (simp add: mapME_x_def sequenceE_x_def)
   apply wp
  apply (simp add: mapME_x_def sequenceE_x_def)
  apply (rule_tac Q="\<lambda>rv s. (\<forall>slot\<in>set slots. cte_wp_at' (\<lambda>cte. cteCap cte = capability.NullCap) slot s) \<longrightarrow> P s"
    in validE_R_sp)
   apply (simp add: ensureEmptySlot_def unlessE_def)
   apply (wp getCTE_wp')
   apply (clarsimp elim!: cte_wp_at_weakenE')
  apply (erule meta_allE)
  apply (erule hoare_post_imp_R)
  apply clarsimp
  done

lemma irq_nodes_global:
  "\<forall>irq :: word8. irq_node' s + (ucast irq) * 16 \<in> global_refs' s"
  by (simp add: global_refs'_def mult.commute mult.left_commute)

lemma valid_global_refsD2':
  "\<lbrakk>ctes_of s p = Some cte; valid_global_refs' s\<rbrakk> \<Longrightarrow>
  global_refs' s \<inter> capRange (cteCap cte) = {}"
  by (blast dest: valid_global_refsD')

lemma cte_cap_in_untyped_range:
  "\<lbrakk> ptr \<le> x; x \<le> ptr + 2 ^ bits - 1; cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap ptr bits idx) cref s;
     descendants_of' cref (ctes_of s) = {}; invs' s;
     ex_cte_cap_to' x s; valid_global_refs' s \<rbrakk> \<Longrightarrow> False"
  apply (clarsimp simp: ex_cte_cap_to'_def cte_wp_at_ctes_of)
  apply (case_tac ctea, simp)
  apply (rename_tac cap node)
  apply (frule ctes_of_valid_cap', clarsimp)
  apply (case_tac "\<exists>irq. cap = IRQHandlerCap irq")
   apply (drule (1) equals0D[where a=x, OF valid_global_refsD2'[where p=cref]])
   apply (clarsimp simp: irq_nodes_global)
  apply (frule_tac p=crefa and p'=cref in caps_containedD', assumption)
     apply (clarsimp dest!: isCapDs)
    apply (rule_tac x=x in notemptyI)
    apply (simp add: subsetD [OF cte_refs_capRange])
   apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
  apply (frule_tac p=cref and p'=crefa in untyped_mdbD', assumption)
      apply (simp_all add: isUntypedCap_def)
    apply (frule valid_capAligned)
    apply (frule capAligned_capUntypedPtr)
     apply (case_tac cap; simp)
    apply blast
   apply (case_tac cap; simp)
  apply (clarsimp simp: invs'_def valid_state'_def valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
  done
  
lemma cap_case_CNodeCap_True_throw:
  "(case cap of CNodeCap a b c d \<Rightarrow> returnOk ()
         |  _ \<Rightarrow> throw $ e)
          = (whenE (\<not>isCNodeCap cap) (throwError e))"
  by (simp split: capability.split bool.split
             add: whenE_def isCNodeCap_def)

lemma empty_descendants_range_in':
  "\<lbrakk>descendants_of' slot m = {}\<rbrakk> \<Longrightarrow> descendants_range_in' S slot m "
  by (clarsimp simp:descendants_range_in'_def)

lemma liftE_validE_R:
  "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> liftE f \<lbrace>Q\<rbrace>,-"
  by (wp, simp)

lemma decodeUntyped_wf[wp]:
  "\<lbrace>invs' and cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap w sz idx) slot
          and sch_act_simple
          and (\<lambda>s. \<forall>x \<in> set cs. s \<turnstile>' x)
          and (\<lambda>s. \<forall>x \<in> set cs. \<forall>r \<in> cte_refs' x (irq_node' s). ex_cte_cap_to' r s)\<rbrace>
     decodeUntypedInvocation label args slot
       (UntypedCap w sz idx) cs
   \<lbrace>valid_untyped_inv'\<rbrace>,-"
  using [[ hypsubst_thin = true ]]
  apply (simp add: decodeUntypedInvocation_def unlessE_def[symmetric]
                   unlessE_whenE rangeCheck_def whenE_def[symmetric]
                   returnOk_liftE[symmetric] Let_def
                   cap_case_CNodeCap_True_throw
                split del: split_if cong: if_cong list.case_cong)
  apply (rule list_case_throw_validE_R)
  apply (clarsimp split del: split_if split: list.splits)
  apply (intro conjI impI allI)
   apply ((rule hoare_pre,wp)+)[6]
  apply clarify
  apply (rule validE_R_sp[OF map_ensure_empty'] validE_R_sp[OF whenE_throwError_sp]
     validE_R_sp[OF dui_sp_helper'])+
  apply (case_tac "\<not> isCNodeCap nodeCap")
   apply (simp add: validE_R_def)
  apply (simp add: mapM_locate_eq bind_liftE_distrib bindE_assoc
                         returnOk_liftE[symmetric])
  apply (rule validE_R_sp, rule liftE_validE_R, rule stateAssert_sp)
  apply (rule hoare_pre, wp whenE_throwError_wp checkFreeIndex_wp map_ensure_empty')
  apply (clarsimp simp:cte_wp_at_ctes_of not_less shiftL_nat)
   apply (rename_tac ty us b e srcNode list dimNode s cte)
   apply (case_tac cte)
   apply clarsimp
   apply (frule(1) valid_capAligned[OF ctes_of_valid_cap'[OF _ invs_valid_objs']])
   apply (clarsimp simp:capAligned_def)
   apply (subgoal_tac "idx \<le> 2^ sz")
    prefer 2
    apply (frule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
    apply (clarsimp simp:valid_cap'_def valid_untyped_def)
   apply (subgoal_tac "(2 ^ sz - idx) < 2^ word_bits")
    prefer 2
    apply (rule le_less_trans[where y = "2^sz"])
    apply simp+
   apply (subgoal_tac "of_nat (2 ^ sz - idx) = (2::word32)^sz - of_nat idx")
    prefer 2
    apply (simp add:word_of_nat_minus)
   apply (subgoal_tac "valid_cap' dimNode s")
    prefer 2
    apply (erule disjE)
     apply (fastforce dest: cte_wp_at_valid_objs_valid_cap')
    apply clarsimp
    apply (case_tac cte)
    apply clarsimp
    apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])+
    apply (drule diminished_valid')
    apply simp
  apply (clarsimp simp: toEnum_of_nat [OF less_Suc_unat_less_bound] ucast_id)
  apply (subgoal_tac "b \<le> 2 ^ capCNodeBits dimNode")
   prefer 2
   apply (clarsimp simp: isCap_simps)
   apply (subst (asm) le_m1_iff_lt[THEN iffD1])
    apply (clarsimp simp:valid_cap'_def isCap_simps p2_gt_0 capAligned_def word_bits_def)
   apply (erule less_imp_le)
  apply (subgoal_tac
    "distinct (map (\<lambda>y. capCNodePtr dimNode + y * 0x10) [b .e. b + e - 1])")
   prefer 2
   apply (simp add: distinct_map upto_enum_def del: upt_Suc)
   apply (rule comp_inj_on)
    apply (rule inj_onI)
    apply (clarsimp simp: toEnum_of_nat dest!: less_Suc_unat_less_bound)
    apply (erule word_unat.Abs_eqD)
     apply (simp add: unats_def)
    apply (simp add: unats_def)
   apply (rule inj_onI)
   apply (clarsimp simp: toEnum_of_nat[OF less_Suc_unat_less_bound]
                         ucast_id isCap_simps)
   apply (erule(2) inj_16)
   apply (subst Suc_unat_diff_1)
    apply (rule word_le_plus_either,simp)
    apply (subst olen_add_eqv)
    apply (subst add.commute)
    apply (erule(1) plus_minus_no_overflow_ab)
   apply (drule(1) le_plus)
   apply (rule unat_le_helper)
   apply (erule order_trans)
   apply (subst unat_power_lower32[symmetric], simp add: word_bits_def)
   apply (simp add: word_less_nat_alt[symmetric])
   apply (rule two_power_increasing)
    apply (clarsimp dest!:valid_capAligned
                     simp:capAligned_def objBits_def objBitsKO_def)
    apply (simp_all add: word_bits_def)[2]
  apply (clarsimp simp: Types_H.fromAPIType_def ArchTypes_H.fromAPIType_def)
  apply (subgoal_tac "Suc (unat (b + e - 1)) = unat b + unat e")
   prefer 2
   apply (subst Suc_unat_diff_1)
    apply (rule word_le_plus_either,simp)
    apply (subst olen_add_eqv)
    apply (subst add.commute)
    apply (erule(1) plus_minus_no_overflow_ab)
    apply (rule unat_plus_simple[THEN iffD1])
    apply (subst olen_add_eqv)
    apply (subst add.commute)
    apply (erule(1) plus_minus_no_overflow_ab)
  apply clarsimp
  apply (subgoal_tac "(\<forall>x. b \<le> x \<and> x \<le> b + e - 1 \<longrightarrow>
    ex_cte_cap_wp_to' (\<lambda>_. True) (capCNodePtr dimNode + x * 0x10) s)")
   prefer 2
   apply clarsimp
   apply (erule disjE)
   apply (erule bspec)
    apply (clarsimp simp:isCap_simps image_def)
    apply (rule_tac x = x in bexI,simp)
    apply simp
    apply (erule order_trans)
    apply (frule(1) le_plus)
    apply (rule word_l_diffs,simp+)
    apply (rule word_le_plus_either,simp)
    apply (subst olen_add_eqv)
    apply (subst add.commute)
    apply (erule(1) plus_minus_no_overflow_ab)
   apply (clarsimp simp:ex_cte_cap_wp_to'_def)
   apply (rule_tac x = nodeSlot in exI)
   apply (case_tac cte)
   apply (clarsimp simp:cte_wp_at_ctes_of diminished_cte_refs'[symmetric]
     isCap_simps image_def)
   apply (rule_tac x = x in bexI,simp)
   apply simp
   apply (erule order_trans)
   apply (frule(1) le_plus)
   apply (rule word_l_diffs,simp+)
   apply (rule word_le_plus_either,simp)
   apply (subst olen_add_eqv)
   apply (subst add.commute)
   apply (erule(1) plus_minus_no_overflow_ab)
  apply (intro conjI)
   apply (clarsimp simp:of_nat_shiftR fromIntegral_def toInteger_nat
     fromInteger_nat word_le_nat_alt of_nat_shiftR)
   apply (frule_tac n = "unat e" and bits = "(APIType_capBits (toEnum (unat ty)) (unat us))"
       in range_cover_stuff[where rv = 0,rotated -1])
         apply (simp add:unat_1_0)
        apply (erule le_trans[OF _ word_le_nat_alt[THEN iffD1],OF _ le_shiftr])
        apply (simp add:word_sub_le_iff word_of_nat_le)
       apply simp+
   apply (clarsimp simp:getFreeRef_def)
   apply (frule alignUp_idem[OF is_aligned_weaken,where a = w])
     apply (erule range_cover.sz)
    apply (simp add:range_cover_def)
   apply (simp add:empty_descendants_range_in')
   apply (clarsimp simp:image_def isCap_simps nullPointer_def word_size
                        cte_level_bits_def field_simps)
   apply (drule_tac x = x in spec)+
   apply simp
  apply (clarsimp simp:of_nat_shiftR fromIntegral_def toInteger_nat
     fromInteger_nat word_le_nat_alt of_nat_shiftR)
  apply (frule_tac n = "unat e" and bits = "(APIType_capBits (toEnum (unat ty)) (unat us))"
       in range_cover_stuff[rotated -1])
   apply (simp add:unat_1_0)+
  apply (clarsimp simp:getFreeRef_def
                        cte_level_bits_def field_simps)
  apply (intro conjI)
   apply clarsimp
    apply (drule cte_wp_at_caps_descendants_range_inI'
      [where ptr = w and sz = sz and idx = 0 and cref=slot])
       apply (clarsimp simp:cte_wp_at_ctes_of is_aligned_neg_mask_eq)
      apply simp
     apply (simp add:range_cover_def)
    apply (simp add:is_aligned_neg_mask_eq)
   apply (clarsimp simp:image_def isCap_simps)
   apply (drule_tac x = x in spec)+
  apply (simp add:nullPointer_def word_size)+
  done

lemma getCTE_known_cap:
  "\<lbrace>cte_wp_at' (\<lambda>c. cteCap c = cap) p\<rbrace> getCTE p \<lbrace>\<lambda>rv s. cteCap rv = cap\<rbrace>"
  by (rule getCTE_get)

lemma corres_list_all2_mapM_':
  assumes w: "suffixeq xs oxs" "suffixeq ys oys"
  assumes y: "\<And>x xs y ys. \<lbrakk> F x y; suffixeq (x # xs) oxs; suffixeq (y # ys) oys \<rbrakk>
               \<Longrightarrow> corres dc (P (x # xs)) (P' (y # ys)) (f x) (g y)"
  assumes z: "\<And>x y xs. \<lbrakk> F x y; suffixeq (x # xs) oxs \<rbrakk> \<Longrightarrow> \<lbrace>P (x # xs)\<rbrace> f x \<lbrace>\<lambda>rv. P xs\<rbrace>"
             "\<And>x y ys. \<lbrakk> F x y; suffixeq (y # ys) oys \<rbrakk> \<Longrightarrow> \<lbrace>P' (y # ys)\<rbrace> g y \<lbrace>\<lambda>rv. P' ys\<rbrace>"
  assumes x: "list_all2 F xs ys"
  shows "corres dc (P xs) (P' ys) (mapM_x f xs) (mapM_x g ys)"
  apply (insert x w)
  apply (induct xs arbitrary: ys)
   apply (simp add: mapM_x_def sequence_x_def)
  apply (case_tac ys)
   apply simp
  apply (clarsimp simp add: mapM_x_def sequence_x_def)
  apply (rule corres_guard_imp)
    apply (rule corres_split [OF _ y])
         apply (clarsimp dest!: suffixeq_ConsD)
         apply (erule meta_allE, (drule(1) meta_mp)+)
         apply assumption
        apply assumption
       apply assumption
      apply assumption
     apply (erule(1) z)+
   apply simp+
  done

lemmas corres_list_all2_mapM_
     = corres_list_all2_mapM_' [OF suffixeq_refl suffixeq_refl]

declare modify_map_id[simp]

lemma valid_mdbD3':
  "\<lbrakk> ctes_of s p = Some cte; valid_mdb' s \<rbrakk> \<Longrightarrow> p \<noteq> 0"
  by (clarsimp simp add: valid_mdb'_def valid_mdb_ctes_def no_0_def)

lemma capRange_sameRegionAs:
  "\<lbrakk> sameRegionAs x y; s \<turnstile>' y; capClass x = PhysicalClass \<or> capClass y = PhysicalClass \<rbrakk>
   \<Longrightarrow> capRange x \<inter> capRange y \<noteq> {}"
  apply (erule sameRegionAsE)
     apply (subgoal_tac "capClass x = capClass y \<and> capRange x = capRange y")
      apply simp
      apply (drule valid_capAligned)
      apply (drule(1) capAligned_capUntypedPtr)
      apply clarsimp
     apply (rule conjI)
      apply (rule master_eqI, rule capClass_Master, simp)
     apply (rule master_eqI, rule capRange_Master, simp)
    apply blast
   apply blast
  apply (clarsimp simp: isCap_simps)
  done

locale mdb_insert_again =
  mdb_ptr_parent: mdb_ptr m _ _ parent parent_cap parent_node +
  mdb_ptr_site: mdb_ptr m _ _ site site_cap site_node
    for m parent parent_cap parent_node site site_cap site_node +

  fixes c'

  assumes site_cap: "site_cap = NullCap"
  assumes site_prev: "mdbPrev site_node = 0"
  assumes site_next: "mdbNext site_node = 0"

  assumes is_untyped: "isUntypedCap parent_cap"
  assumes same_region: "sameRegionAs parent_cap c'"

  assumes range: "descendants_range' c' parent m"
  assumes phys: "capClass c' = PhysicalClass"

  fixes s
  assumes valid_capI': "m p = Some (CTE cap node) \<Longrightarrow> s \<turnstile>' cap"

  assumes ut_rev: "ut_revocable' m"

  fixes n
  defines "n \<equiv>
           (modify_map
             (\<lambda>x. if x = site
                  then Some (CTE c' (MDB (mdbNext parent_node) parent True True))
                  else m x)
             parent (cteMDBNode_update (mdbNext_update (\<lambda>x. site))))"

  assumes neq: "parent \<noteq> site"

context mdb_insert_again
begin

lemmas parent = mdb_ptr_parent.m_p
lemmas site = mdb_ptr_site.m_p

lemma next_wont_bite:
  "\<lbrakk> mdbNext parent_node \<noteq> 0; m (mdbNext parent_node) = Some cte \<rbrakk>
  \<Longrightarrow> \<not> sameRegionAs c' (cteCap cte)"
  using range ut_rev
  apply (cases cte)
  apply clarsimp
  apply (cases "m \<turnstile> parent \<rightarrow> mdbNext parent_node")
   apply (drule (2) descendants_rangeD')
   apply (drule capRange_sameRegionAs)
     apply (erule valid_capI')
    apply (simp add: phys)
   apply blast
  apply (erule notE, rule direct_parent)
    apply (clarsimp simp: mdb_next_unfold parent)
   apply assumption
  apply (simp add: parentOf_def parent)
  apply (insert is_untyped same_region)
  apply (clarsimp simp: isMDBParentOf_CTE)
  apply (rule conjI)
   apply (erule (1) sameRegionAs_trans)
  apply (simp add: ut_revocable'_def)
  apply (insert parent)
  apply simp
  apply (clarsimp simp: isCap_simps)
  done

lemma no_0_helper: "no_0 m \<Longrightarrow> no_0 n"
  by (simp add: n_def, simp add: no_0_def)

lemma no_0_n [intro!]: "no_0 n" by (auto intro: no_0_helper)

lemmas n_0_simps [iff] = no_0_simps [OF no_0_n]

lemmas neqs [simp] = neq neq [symmetric]

definition
  "new_site \<equiv> CTE c' (MDB (mdbNext parent_node) parent True True)"

definition
  "new_parent \<equiv> CTE parent_cap (mdbNext_update (\<lambda>a. site) parent_node)"

lemma n: "n = m (site \<mapsto> new_site, parent \<mapsto> new_parent)"
  using parent site
  by (simp add: n_def modify_map_apply new_site_def new_parent_def
                fun_upd_def[symmetric])

lemma site_no_parent [iff]:
  "m \<turnstile> site \<rightarrow> x = False" using site site_next
  by (auto dest: subtree_next_0)

lemma site_no_child [iff]:
  "m \<turnstile> x \<rightarrow> site = False" using site site_prev
  by (auto dest: subtree_prev_0)

lemma site_no_descendants: "descendants_of' site m = {}"
  by (simp add: descendants_of'_def)

lemma descendants_not_site: "site \<in> descendants_of' p m \<Longrightarrow> False"
  by (simp add: descendants_of'_def)

lemma parent_next: "m \<turnstile> parent \<leadsto> mdbNext parent_node"
  by (simp add: parent mdb_next_unfold)

lemma parent_next_rtrancl_conv [simp]:
  "m \<turnstile> mdbNext parent_node \<leadsto>\<^sup>* site = m \<turnstile> parent \<leadsto>\<^sup>+ site"
  apply (rule iffI)
   apply (insert parent_next)
   apply (fastforce dest: rtranclD)
  apply (drule tranclD)
  apply (clarsimp simp: mdb_next_unfold)
  done

lemma site_no_next [iff]:
  "m \<turnstile> x \<leadsto> site = False" using site site_prev dlist
  apply clarsimp
  apply (simp add: mdb_next_unfold)
  apply (elim exE conjE)
  apply (case_tac z)
  apply simp
  apply (rule dlistEn [where p=x], assumption)
   apply clarsimp
  apply clarsimp
  done

lemma site_no_next_trans [iff]:
  "m \<turnstile> x \<leadsto>\<^sup>+ site = False"
  by (clarsimp dest!: tranclD2)

lemma site_no_prev [iff]:
  "m \<turnstile> site \<leadsto> p = (p = 0)" using site site_next
  by (simp add: mdb_next_unfold)

lemma site_no_prev_trancl [iff]:
  "m \<turnstile> site \<leadsto>\<^sup>+ p = (p = 0)"
  apply (rule iffI)
   apply (drule tranclD)
   apply clarsimp
  apply simp
  apply (insert chain site)
  apply (simp add: mdb_chain_0_def)
  apply auto
  done

lemma chain_n:
  "mdb_chain_0 n"
proof -
  from chain
  have "m \<turnstile> mdbNext parent_node \<leadsto>\<^sup>* 0" using dlist parent
    apply (cases "mdbNext parent_node = 0")
     apply simp
    apply (erule dlistEn, simp)
    apply (auto simp: mdb_chain_0_def)
    done
  moreover
  have "\<not>m \<turnstile> mdbNext parent_node \<leadsto>\<^sup>* parent"
    using parent_next
    apply clarsimp
    apply (drule (1) rtrancl_into_trancl2)
    apply simp
    done
  moreover
  have "\<not> m \<turnstile> 0 \<leadsto>\<^sup>* site" using no_0 site
    by (auto elim!: next_rtrancl_tranclE dest!: no_0_lhs_trancl)
  moreover
  have "\<not> m \<turnstile> 0 \<leadsto>\<^sup>* parent" using no_0 parent
    by (auto elim!: next_rtrancl_tranclE dest!: no_0_lhs_trancl)
  moreover
  note chain
  ultimately show "mdb_chain_0 n" using no_0 parent site
    apply (simp add: n new_parent_def new_site_def)
    apply (auto intro!: mdb_chain_0_update no_0_update simp: next_update_lhs_rtrancl)
    done
qed

lemma no_loops_n: "no_loops n" using chain_n no_0_n
  by (rule mdb_chain_0_no_loops)

lemma irrefl_direct_simp_n [iff]:
  "n \<turnstile> x \<leadsto> x = False"
  using no_loops_n by (rule no_loops_direct_simp)

lemma irrefl_trancl_simp [iff]:
  "n \<turnstile> x \<leadsto>\<^sup>+ x = False"
  using no_loops_n by (rule no_loops_trancl_simp)

lemma n_direct_eq:
  "n \<turnstile> p \<leadsto> p' = (if p = parent then p' = site else
                 if p = site then m \<turnstile> parent \<leadsto> p'
                 else m \<turnstile> p \<leadsto> p')"
  using parent site site_prev
  by (auto simp: mdb_next_update n new_parent_def new_site_def
                 parent_next mdb_next_unfold)

lemma n_site:
  "n site = Some new_site"
  by (simp add: n)

lemma next_not_parent:
  "\<lbrakk> mdbNext parent_node \<noteq> 0; m (mdbNext parent_node) = Some cte \<rbrakk>
      \<Longrightarrow> \<not> isMDBParentOf new_site cte"
  apply (drule(1) next_wont_bite)
  apply (cases cte)
  apply (simp add: isMDBParentOf_def new_site_def)
  done

lemma parent_not_loop:
  "mdbNext parent_node \<noteq> parent"
  apply (insert no_loops)
  apply (simp add: no_loops_def)
  done

(* The newly inserted cap should never have children. *)
lemma site_no_parent_n:
  "n \<turnstile> site \<rightarrow> p = False" using parent valid_badges
  apply clarsimp
  apply (erule subtree.induct)
   prefer 2
   apply simp
  apply (clarsimp simp: parentOf_def mdb_next_unfold n_site new_site_def n)
  apply (cases "mdbNext parent_node = site")
   apply (subgoal_tac "m \<turnstile> parent \<leadsto> site")
    apply simp
   apply (subst mdb_next_unfold)
   apply (simp add: parent)
  apply clarsimp
  apply (erule notE[rotated], erule(1) next_not_parent[unfolded new_site_def])
  done

end

locale mdb_insert_again_child = mdb_insert_again +
  assumes child:
  "isMDBParentOf
   (CTE parent_cap parent_node)
   (CTE c' (MDB (mdbNext parent_node) parent True True))"

context mdb_insert_again_child
begin

lemma new_child [simp]:
  "isMDBParentOf new_parent new_site"
  by (simp add: new_parent_def new_site_def) (rule child)

lemma n_site_child:
  "n \<turnstile> parent \<rightarrow> site"
  apply (rule subtree.direct_parent)
    apply (simp add: n_direct_eq)
   apply simp
  apply (clarsimp simp: parentOf_def parent site n)
  done

lemma parent_m_n:
  assumes "m \<turnstile> p \<rightarrow> p'"
  shows "if p' = parent then n \<turnstile> p \<rightarrow> site \<and> n \<turnstile> p \<rightarrow> p' else n \<turnstile> p \<rightarrow> p'" using assms
proof induct
  case (direct_parent c)
  thus ?case
    apply (cases "p = parent")
     apply simp
     apply (rule conjI, clarsimp)
     apply clarsimp
     apply (rule subtree.trans_parent [where c'=site])
        apply (rule n_site_child)
       apply (simp add: n_direct_eq)
      apply simp
     apply (clarsimp simp: parentOf_def n)
     apply (clarsimp simp: new_parent_def parent)
    apply simp
    apply (subgoal_tac "n \<turnstile> p \<rightarrow> c")
     prefer 2
     apply (rule subtree.direct_parent)
       apply (clarsimp simp add: n_direct_eq)
      apply simp
     apply (clarsimp simp: parentOf_def n)
     apply (fastforce simp: new_parent_def parent)
    apply clarsimp
    apply (erule subtree_trans)
    apply (rule n_site_child)
    done
next
  case (trans_parent c d)
  thus ?case
    apply -
    apply (cases "c = site", simp)
    apply (cases "d = site", simp)
    apply (cases "c = parent")
     apply clarsimp
     apply (erule subtree.trans_parent [where c'=site])
       apply (clarsimp simp add: n_direct_eq)
      apply simp
     apply (clarsimp simp: parentOf_def n)
     apply (rule conjI, clarsimp)
     apply (clarsimp simp: new_parent_def parent)
    apply clarsimp
    apply (subgoal_tac "n \<turnstile> p \<rightarrow> d")
     apply clarsimp
     apply (erule subtree_trans, rule n_site_child)
    apply (erule subtree.trans_parent)
      apply (simp add: n_direct_eq)
     apply simp
    apply (clarsimp simp: parentOf_def n)
    apply (fastforce simp: parent new_parent_def)
    done
qed

lemma n_to_site [simp]:
  "n \<turnstile> p \<leadsto> site = (p = parent)"
  by (simp add: n_direct_eq)

lemma parent_n_m:
  assumes "n \<turnstile> p \<rightarrow> p'"
  shows "if p' = site then p \<noteq> parent \<longrightarrow> m \<turnstile> p \<rightarrow> parent else m \<turnstile> p \<rightarrow> p'"
proof -
  from assms have [simp]: "p \<noteq> site" by (clarsimp simp: site_no_parent_n)
  from assms
  show ?thesis
  proof induct
    case (direct_parent c)
    thus ?case
      apply simp
      apply (rule conjI)
       apply clarsimp
      apply clarsimp
      apply (rule subtree.direct_parent)
        apply (simp add: n_direct_eq split: split_if_asm)
       apply simp
      apply (clarsimp simp: parentOf_def n parent new_parent_def split: split_if_asm)
      done
  next
    case (trans_parent c d)
    thus ?case
      apply clarsimp
      apply (rule conjI, clarsimp)
      apply (clarsimp split: split_if_asm)
      apply (simp add: n_direct_eq)
      apply (cases "p=parent")
       apply simp
       apply (rule subtree.direct_parent, assumption, assumption)
       apply (clarsimp simp: parentOf_def n parent new_parent_def split: split_if_asm)
      apply clarsimp
      apply (erule subtree.trans_parent, assumption, assumption)
      apply (clarsimp simp: parentOf_def n parent new_parent_def split: split_if_asm)
     apply (erule subtree.trans_parent)
       apply (simp add: n_direct_eq split: split_if_asm)
      apply assumption
     apply (clarsimp simp: parentOf_def n parent new_parent_def split: split_if_asm)
     done
 qed
qed

lemma descendants:
  "descendants_of' p n =
   (if parent \<in> descendants_of' p m \<or> p = parent
   then descendants_of' p m \<union> {site} else descendants_of' p m)"
  apply (rule set_eqI)
  apply (simp add: descendants_of'_def)
  apply (fastforce dest!: parent_n_m dest: parent_m_n simp: n_site_child split: split_if_asm)
  done

end

lemma blarg_descendants_of':
  "descendants_of' x (modify_map m p (if P then id else cteMDBNode_update (mdbPrev_update f)))
     = descendants_of' x m"
  by (simp add: descendants_of'_def)

lemma bluhr_descendants_of':
  "mdb_insert_again_child (ctes_of s') parent parent_cap pmdb site site_cap site_node cap s
   \<Longrightarrow>
   descendants_of' x
           (modify_map
             (modify_map
               (\<lambda>c. if c = site
                    then Some (CTE cap (MDB (mdbNext pmdb) parent True True))
                    else ctes_of s' c)
               (mdbNext pmdb)
               (if mdbNext pmdb = 0 then id
                else cteMDBNode_update (mdbPrev_update (\<lambda>x. site))))
             parent (cteMDBNode_update (mdbNext_update (\<lambda>x. site))))
     = (if parent \<in> descendants_of' x (ctes_of s') \<or> x = parent
        then descendants_of' x (ctes_of s') \<union> {site}
        else descendants_of' x (ctes_of s'))"
  apply (subst modify_map_com)
  apply (case_tac x, rename_tac node, case_tac node, clarsimp)
  apply (subst blarg_descendants_of')
  apply (erule mdb_insert_again_child.descendants)
  done

lemma mdb_relation_simp:
  "\<lbrakk> (s, s') \<in> state_relation; cte_at p s \<rbrakk>
    \<Longrightarrow> descendants_of' (cte_map p) (ctes_of s') = cte_map ` descendants_of p (cdt s)"
  by (cases p, clarsimp simp: state_relation_def cdt_relation_def)

lemma in_getCTE2:
  "((cte, s') \<in> fst (getCTE p s)) = (s' = s \<and> cte_wp_at' (op = cte) p s)"
  apply (safe dest!: in_getCTE)
  apply (clarsimp simp: cte_wp_at'_def getCTE_def)
  done

declare wrap_ext_op_det_ext_ext_def[simp]

lemma do_ext_op_update_cdt_list_symb_exec_l:
  "corres_underlying {(s :: det_ext state, s'). f (kheap s) s'} nf dc P P' (update_cdt_list g) (return x)"
  by (simp add: corres_underlying_def
  update_cdt_list_def set_cdt_list_def bind_def put_def get_def gets_def return_def)

lemma do_ext_op_update_cdt_list_symb_exec_l':
  "corres_underlying {(s::det_state, s'). f (kheap s) (ekheap s) s'} nf dc P P' (create_cap_ext p z a) (return x)"
  apply (simp add: corres_underlying_def create_cap_ext_def
  update_cdt_list_def set_cdt_list_def bind_def put_def get_def gets_def return_def)
  done

crunch it'[wp]: updateMDB "\<lambda>s. P (ksIdleThread s)"
crunch ups'[wp]: updateMDB "\<lambda>s. P (gsUserPages s)"
crunch cns'[wp]: updateMDB "\<lambda>s. P (gsCNodes s)"
crunch ksDomainTime[wp]: updateMDB "\<lambda>s. P (ksDomainTime s)"
crunch ksDomScheduleIdx[wp]: updateMDB "\<lambda>s. P (ksDomScheduleIdx s)"
crunch irq_node[wp]: update_cdt "\<lambda>s. P (interrupt_irq_node s)"
crunch ksWorkUnitsCompleted[wp]: updateMDB "\<lambda>s. P (ksWorkUnitsCompleted s)"

crunch exst[wp]: set_cdt "\<lambda>s. P (exst s)"

(*FIXME: Move to StateRelation*)
lemma state_relation_schact[elim!]:
  "(s,s') \<in> state_relation \<Longrightarrow> sched_act_relation (scheduler_action s) (ksSchedulerAction s')"
  apply (simp add: state_relation_def)
  done

lemma state_relation_queues[elim!]: "(s,s') \<in> state_relation \<Longrightarrow> ready_queues_relation (ready_queues s) (ksReadyQueues s')"
  apply (simp add: state_relation_def)
  done

lemma set_original_symb_exec_l:
  "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf dc P P' (set_original p b) (return x)"
  by (simp add: corres_underlying_def return_def set_original_def in_monad Bex_def)

lemma set_cdt_symb_exec_l:
  "corres_underlying {(s, s'). f (kheap s) (exst s) s'} nf dc P P' (set_cdt g) (return x)"
  by (simp add: corres_underlying_def return_def set_cdt_def in_monad Bex_def)

crunch domain_index[wp]: create_cap_ext "\<lambda>s. P (domain_index s)"
crunch domain_list[wp]: create_cap_ext "\<lambda>s. P (domain_list s)"
crunch domain_time[wp]: create_cap_ext "\<lambda>s. P (domain_time s)"
crunch work_units_completed[wp]: create_cap_ext "\<lambda>s. P (work_units_completed s)"

lemma create_cap_corres:
notes if_cong[cong del] if_weak_cong[cong]
shows
  "\<lbrakk> cref' = cte_map (fst tup)
     \<and> cap_relation (default_cap tp (snd tup) sz) cap \<rbrakk> \<Longrightarrow>
   corres dc
     (cte_wp_at (op = cap.NullCap) (fst tup) and pspace_aligned
        and pspace_distinct and valid_objs and valid_mdb and valid_list
        and cte_wp_at (op \<noteq> cap.NullCap) p)
     (cte_wp_at' (\<lambda>c. cteCap c = NullCap) cref' and
      cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and> sameRegionAs (cteCap cte) cap) (cte_map p)
       and valid_mdb' and pspace_aligned' and pspace_distinct' and valid_objs'
       and (\<lambda>s. descendants_range' cap (cte_map p) (ctes_of s)))
     (create_cap tp sz p tup)
     (insertNewCap (cte_map p) cref' cap)"
  apply (cases tup,
         clarsimp simp add: create_cap_def insertNewCap_def
                            liftM_def)
  apply (rule corres_symb_exec_r [OF _ getCTE_sp])+
      prefer 3
      apply (rule no_fail_pre, wp)
      apply (clarsimp elim!: cte_wp_at_weakenE')
     prefer 4
     apply (rule no_fail_pre, wp)
     apply (clarsimp elim!: cte_wp_at_weakenE')
    apply (rule corres_assert_assume)
     prefer 2
     apply (case_tac oldCTE)
     apply (clarsimp simp: cte_wp_at_ctes_of valid_mdb'_def valid_mdb_ctes_def
                           valid_nullcaps_def)
     apply (erule allE)+
     apply (erule (1) impE)
     apply (simp add: initMDBNode_def)
    apply clarsimp
    apply (rule_tac F="capClass cap = PhysicalClass" in corres_req)
     apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
     apply (drule sameRegionAs_classes, simp)
    apply (rule corres_caps_decomposition)
                                              prefer 3
                                              apply wp+
                                                 apply (rule hoare_post_imp, simp)
                                                 apply wp
                                             defer
                                             apply ((wp | simp)+)[1]
                                            apply (simp add: create_cap_ext_def set_cdt_list_def update_cdt_list_def bind_assoc)
                                            apply ((wp | simp)+)[1]
                                           apply (wp updateMDB_ctes_of_cases getCTE_ctes_of_weakened
                                                  | simp add: o_def split del: split_if)+
            apply (clarsimp simp: cdt_relation_def cte_wp_at_ctes_of
                     split del: split_if cong: if_cong simp del: id_apply)
            apply (subst if_not_P, erule(1) valid_mdbD3')
            apply (case_tac x, case_tac oldCTE)
            apply (subst bluhr_descendants_of')
             apply (rule mdb_insert_again_child.intro)
              apply (rule mdb_insert_again.intro)
                apply (rule mdb_ptr.intro)
                 apply (simp add: valid_mdb'_def vmdb_def)
                apply (rule mdb_ptr_axioms.intro)
                apply simp
               apply (rule mdb_ptr.intro)
                apply (simp add: valid_mdb'_def vmdb_def)
               apply (rule mdb_ptr_axioms.intro)
               apply fastforce
              apply (rule mdb_insert_again_axioms.intro)
                       apply (clarsimp simp: nullPointer_def)+
                apply (erule (1) ctes_of_valid_cap')
               apply (simp add: valid_mdb'_def valid_mdb_ctes_def)
              apply clarsimp
             apply (rule mdb_insert_again_child_axioms.intro)
             apply (clarsimp simp: isMDBParentOf_def)
             apply (clarsimp simp: isCap_simps)
             apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def
                                   ut_revocable'_def)
             apply (erule_tac x="cte_map p" in allE)
             apply (simp add: isCap_simps)
            apply (fold fun_upd_def)
            apply (subst descendants_of_insert_child')
               apply (erule(1) mdb_Null_descendants)
              apply (clarsimp simp: cte_wp_at_def)
             apply (erule(1) mdb_Null_None)
            apply (subgoal_tac "cte_at (aa, bb) s")
             prefer 2
             apply (drule not_sym, clarsimp simp: cte_wp_at_caps_of_state split: split_if_asm)
            apply (subst descendants_of_eq' [OF _ cte_wp_at_cte_at], assumption+)
                 apply (clarsimp simp: state_relation_def)
                apply assumption+
            apply (subst cte_map_eq_subst [OF _ cte_wp_at_cte_at], assumption+)
            apply (simp add: mdb_relation_simp)
           defer
           apply (clarsimp split del: split_if)+
         apply (clarsimp simp add: revokable_relation_def cte_wp_at_ctes_of
                        split del: split_if)
         apply simp
         apply (rule conjI)
          apply clarsimp
          apply (elim modify_map_casesE)
             apply ((clarsimp split: split_if_asm cong: conj_cong
                              simp: cte_map_eq_subst cte_wp_at_cte_at
                                    revokable_relation_simp)+)[4]
         apply clarsimp
         apply (subgoal_tac "null_filter (caps_of_state s) (aa, bb) \<noteq> None")
          prefer 2
          apply (clarsimp simp: null_filter_def cte_wp_at_caps_of_state split: split_if_asm)
         apply (subgoal_tac "cte_at (aa,bb) s")
          prefer 2
          apply clarsimp
          apply (drule null_filter_caps_of_stateD)
          apply (erule cte_wp_cte_at)
         apply (elim modify_map_casesE)
            apply (clarsimp split: split_if_asm cong: conj_cong
                            simp: cte_map_eq_subst cte_wp_at_cte_at revokable_relation_simp)+
        apply (clarsimp simp: state_relation_def ghost_relation_of_heap)+
     apply wp
   apply (rule corres_guard_imp)
     apply (rule corres_underlying_symb_exec_l [OF gets_symb_exec_l])
      apply (rule corres_underlying_symb_exec_l [OF gets_symb_exec_l])
       apply (rule corres_underlying_symb_exec_l [OF set_cdt_symb_exec_l])
        apply (rule corres_underlying_symb_exec_l [OF do_ext_op_update_cdt_list_symb_exec_l'])
         apply (rule corres_underlying_symb_exec_l [OF set_original_symb_exec_l])
          apply (rule corres_cong[OF refl refl _ refl refl, THEN iffD1])
           apply (rule bind_return[THEN fun_cong])
          apply (rule corres_split [OF _ set_cap_pspace_corres])
             apply (subst bind_return[symmetric],
                    rule corres_split)
                prefer 2
                apply (simp add: dc_def[symmetric])
                apply (rule updateMDB_symb_exec_r)
               apply (simp add: dc_def[symmetric])
               apply (rule updateMDB_symb_exec_r)
              apply (wp getCTE_wp set_cdt_valid_objs set_cdt_cte_at
                        hoare_weak_lift_imp | simp add: o_def)+
    apply (clarsimp simp: cte_wp_at_cte_at)
   apply (clarsimp simp: cte_wp_at_ctes_of no_0_def valid_mdb'_def
                         valid_mdb_ctes_def)
   apply (rule conjI, clarsimp)
   apply clarsimp
   apply (erule (2) valid_dlistEn)
   apply simp
  apply(simp only: cdt_list_relation_def valid_mdb_def2
              del: split_paired_All split_paired_Ex split del: split_if)
  apply(subgoal_tac "finite_depth (cdt s)")
   prefer 2
   apply(simp add: finite_depth valid_mdb_def2[symmetric])
  apply(intro impI allI)
  apply(subgoal_tac "mdb_insert_abs (cdt s) p (a, b)")
   prefer 2
   apply(clarsimp simp: cte_wp_at_caps_of_state)
   apply(rule mdb_insert_abs.intro)
     apply(clarsimp)
    apply(erule (1) mdb_cte_at_Null_None)
   apply (erule (1) mdb_cte_at_Null_descendants)
  apply(subgoal_tac "no_0 (ctes_of s')")
   prefer 2
   apply(simp add: valid_mdb_ctes_def valid_mdb'_def)
  apply simp
  apply (elim conjE)
  apply (case_tac "cdt s (a,b)")
   prefer 2
   apply (simp add: mdb_insert_abs_def)
  apply simp
  apply(case_tac x)
  apply(simp add: cte_wp_at_ctes_of)
  apply(simp add: mdb_insert_abs.next_slot split del: split_if)
  apply(case_tac "c=p")
   apply(simp)
   apply(clarsimp simp: modify_map_def)
   apply(case_tac z)
   apply(fastforce split: split_if_asm)
  apply(case_tac "c = (a, b)")
   apply(simp)
   apply(case_tac "next_slot p (cdt_list s) (cdt s)")
    apply(simp)
   apply(simp)
   apply(clarsimp simp: modify_map_def const_def)
   apply(clarsimp split: split_if_asm)
    apply(drule_tac p="cte_map p" in valid_mdbD1')
      apply(simp)
     apply(simp add: valid_mdb'_def valid_mdb_ctes_def)
    apply(clarsimp simp: nullPointer_def no_0_def)
    apply(clarsimp simp: state_relation_def)
    apply(clarsimp simp: cte_wp_at_caps_of_state)
    apply(drule_tac slot=p in pspace_relation_ctes_ofI)
       apply(simp add: cte_wp_at_caps_of_state)
      apply(simp)
     apply(simp)
    apply(simp)
   apply(clarsimp simp: state_relation_def cdt_list_relation_def)
   apply(erule_tac x="fst p" in allE, erule_tac x="snd p" in allE)
   apply(fastforce)
  apply(simp)
  apply(case_tac "next_slot c (cdt_list s) (cdt s)")
   apply(simp)
  apply(simp)
  apply(subgoal_tac "cte_at c s")
   prefer 2
   apply(rule cte_at_next_slot)
      apply(simp_all add: valid_mdb_def2)[4]
  apply(clarsimp simp: modify_map_def const_def)
  apply(simp split: split_if_asm)
       apply(simp add: valid_mdb'_def)
       apply(drule_tac ptr="cte_map p" in no_self_loop_next)
        apply(simp)
       apply(simp)
      apply(drule_tac p="(aa, bb)" in cte_map_inj)
           apply(simp_all add: cte_wp_at_caps_of_state)[5]
       apply(clarsimp)
      apply(simp)
     apply(clarsimp)
     apply(drule cte_map_inj_eq; simp add: cte_wp_at_caps_of_state)
    apply(clarsimp)
    apply(case_tac z)
    apply(clarsimp simp: state_relation_def cdt_list_relation_def)
    apply(erule_tac x=aa in allE, erule_tac x=bb in allE)
    apply(fastforce)
   apply(clarsimp)
   apply(drule cte_map_inj_eq)
        apply(simp_all add: cte_wp_at_caps_of_state)[6]
  apply(clarsimp simp: state_relation_def cdt_list_relation_def)
  apply(erule_tac x=aa in allE, erule_tac x=bb in allE, fastforce)
  done

lemma insertNewCap_mdbNext:
  "\<lbrace>\<lambda>s. \<not> sameRegionAs cap' cap \<and> parent \<noteq> slot \<and> valid_mdb' s
         \<and> parent \<noteq> 0 \<and> slot \<noteq> 0\<rbrace> insertNewCap parent slot cap
   \<lbrace>\<lambda>rv s. \<forall>next. cte_wp_at' (\<lambda>cte. mdbNext (cteMDBNode cte) = next) parent s \<and> next \<noteq> 0
                        \<longrightarrow> cte_wp_at' (\<lambda>cte. \<not> sameRegionAs cap' (cteCap cte)) next s\<rbrace>"
  apply (simp add: insertNewCap_def cte_wp_at_ctes_of)
  apply (wp getCTE_ctes_of updateMDB_ctes_of_cases | simp add: o_def split del: split_if)+
  apply (clarsimp split del: split_if simp: nullPointer_def)
  apply (erule modify_map_casesE, simp_all split del: split_if)
  apply (subst modify_map_other)
   apply assumption
  apply (subst modify_map_other)
   defer
   apply simp
  apply clarsimp
  apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def)
  apply (erule(2) valid_dlistE(1))
  apply simp
  done

lemma setCTE_cteCaps_of[wp]:
  "\<lbrace>\<lambda>s. P ((cteCaps_of s)(p \<mapsto> cteCap cte))\<rbrace>
      setCTE p cte
   \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
  apply (simp add: cteCaps_of_def)
  apply wp
  apply (clarsimp elim!: rsubst[where P=P] intro!: ext)
  done

lemma insertNewCap_wps[wp]:
  "\<lbrace>pspace_aligned'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
  "\<lbrace>pspace_distinct'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
  "\<lbrace>\<lambda>s. P ((cteCaps_of s)(slot \<mapsto> cap))\<rbrace>
      insertNewCap parent slot cap
   \<lbrace>\<lambda>rv s. P (cteCaps_of s)\<rbrace>"
  apply (simp_all add: insertNewCap_def)
   apply (wp hoare_drop_imps
            | simp add: o_def)+
  apply (clarsimp elim!: rsubst[where P=P] intro!: ext)
  done

definition apitype_of :: "cap \<Rightarrow> apiobject_type option"
where
  "apitype_of c \<equiv> case c of
    Structures_A.UntypedCap p b idx \<Rightarrow> Some ArchTypes_H.Untyped
  | Structures_A.EndpointCap r badge rights \<Rightarrow> Some EndpointObject
  | Structures_A.NotificationCap r badge rights \<Rightarrow> Some NotificationObject
  | Structures_A.CNodeCap r bits guard \<Rightarrow> Some ArchTypes_H.CapTableObject
  | Structures_A.ThreadCap r \<Rightarrow> Some TCBObject
  | _ \<Rightarrow> None"

lemma sameRegion_untyped_imp_subseteq:
  "\<lbrakk>RetypeDecls_H.sameRegionAs cap c; isUntypedCap cap\<rbrakk>
   \<Longrightarrow> capRange c \<subseteq> untypedRange cap"
   apply (simp add:sameRegionAs_def3)
   apply (elim disjE)
     apply (clarsimp simp:capRange_of_untyped isCap_simps)
     apply (drule(1) subsetD)
     apply simp
   apply (simp add:isCap_simps)
  done

lemma cteCaps_of_ran_Ball:
  "(\<forall>x \<in> ran (cteCaps_of s). P x) = (\<forall>x \<in> ran (ctes_of s). P (cteCap x))"
  apply (simp add: cteCaps_of_def ran_def)
  apply fastforce
  done

lemma cteCaps_of_ran_Ball_upd:
  "(\<forall>x \<in> ran (\<lambda>x. if x = p then None else cteCaps_of s x). P x)
     = (\<forall>x \<in> ran (\<lambda>x. if x = p then None else ctes_of s x). P (cteCap x))"
  apply (simp add: cteCaps_of_def ran_def)
  apply fastforce
  done

lemma cte_wp_at_cteCaps_of:
  "cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s
    = (\<exists>cap. cteCaps_of s p = Some cap \<and> P cap)"
  apply (subst tree_cte_cteCap_eq[unfolded o_def])
  apply (clarsimp split: option.splits)
  done

lemma caps_contained_modify_mdb_helper[simp]:
  "(\<exists>n. modify_map m p (cteMDBNode_update f) x = Some (CTE c n))
    = (\<exists>n. m x = Some (CTE c n))"
  apply (cases "m p", simp_all add: modify_map_def)
  apply (case_tac a, simp_all)
  done

lemma caps_contained_modify_mdb[simp]:
  "caps_contained' (modify_map m p (cteMDBNode_update f))
    = caps_contained' m"
  by (simp add: caps_contained'_def)

lemma sameRegionAs_capRange_subset:
  "\<lbrakk> sameRegionAs c c'; capClass c = PhysicalClass \<rbrakk> \<Longrightarrow> capRange c' \<subseteq> capRange c"
  apply (erule sameRegionAsE)
     apply (rule equalityD1)
     apply (rule master_eqI, rule capRange_Master)
     apply simp
    apply assumption+
  apply (clarsimp simp: isCap_simps)
  done


definition
  is_end_chunk :: "cte_heap \<Rightarrow> capability \<Rightarrow> word32 \<Rightarrow> bool"
where
 "is_end_chunk ctes cap p \<equiv> \<exists>p'. ctes \<turnstile> p \<leadsto> p'
       \<and> (\<exists>cte. ctes p = Some cte \<and> sameRegionAs cap (cteCap cte))
       \<and> (\<forall>cte'. ctes p' = Some cte' \<longrightarrow> \<not> sameRegionAs cap (cteCap cte'))"

lemma chunk_end_chunk:
  "\<lbrakk> is_chunk ctes cap p p'; ctes \<turnstile> p \<leadsto>\<^sup>+ p'; is_end_chunk ctes cap p \<rbrakk>
     \<Longrightarrow> P"
  apply (clarsimp simp add: is_chunk_def is_end_chunk_def)
  apply (drule_tac x=p'a in spec)
  apply (drule mp)
   apply (erule trancl.intros)
  apply (drule mp)
   apply (drule tranclD, clarsimp)
   apply (simp add: mdb_next_unfold)
  apply clarsimp
  done

lemma end_chunk_site:
  "is_end_chunk ctes cap p
    \<Longrightarrow> \<exists>pcap pnode. ctes p = Some (CTE pcap pnode)
            \<and> sameRegionAs cap pcap"
  apply (clarsimp simp: is_end_chunk_def)
  apply (case_tac cte, simp)
  done

lemma chunk_region_trans:
  "\<lbrakk> sameRegionAs cap cap'; is_chunk ctes cap' p p' \<rbrakk>
      \<Longrightarrow> is_chunk ctes cap p p'"
  apply (simp add: is_chunk_def)
  apply (erule allEI)
  apply clarsimp
  apply (erule(1) sameRegionAs_trans)
  done

lemma sameRegionAs_refl:
  "sameRegionAs cap cap' \<Longrightarrow> sameRegionAs cap cap"
  apply (simp add: sameRegionAs_def3)
  apply (elim disjE exE)
    apply simp
   apply fastforce
  apply (clarsimp simp: isCap_simps)
  done

definition
  mdb_chunked2 :: "cte_heap \<Rightarrow> bool"
where
 "mdb_chunked2 ctes \<equiv> (\<forall>x p p' cte. ctes x = Some cte
         \<and> is_end_chunk ctes (cteCap cte) p \<and> is_end_chunk ctes (cteCap cte) p'
             \<longrightarrow> p = p')
      \<and> (\<forall>p p' cte cte'. ctes p = Some cte \<and> ctes p' = Some cte'
                 \<and> ctes \<turnstile> p \<leadsto> p' \<and> sameRegionAs (cteCap cte') (cteCap cte)
                      \<longrightarrow> sameRegionAs (cteCap cte) (cteCap cte'))"

lemma mdb_chunked2_endD:
  "\<lbrakk> is_end_chunk ctes cap p; is_end_chunk ctes cap p';
      mdb_chunked2 ctes; ctes x = Some (CTE cap node) \<rbrakk> \<Longrightarrow> p = p'"
  by (fastforce simp add: mdb_chunked2_def)

lemma mdb_chunked2_revD:
  "\<lbrakk> ctes p = Some cte; ctes p' = Some cte'; ctes \<turnstile> p \<leadsto> p';
      mdb_chunked2 ctes; sameRegionAs (cteCap cte') (cteCap cte) \<rbrakk>
       \<Longrightarrow> sameRegionAs (cteCap cte) (cteCap cte')"
  by (fastforce simp add: mdb_chunked2_def)

lemma valid_dlist_step_back:
  "\<lbrakk> ctes \<turnstile> p \<leadsto> p''; ctes \<turnstile> p' \<leadsto> p''; valid_dlist ctes; p'' \<noteq> 0 \<rbrakk>
      \<Longrightarrow> p = p'"
  apply (simp add: mdb_next_unfold valid_dlist_def)
  apply (frule_tac x=p in spec)
  apply (drule_tac x=p' in spec)
  apply (clarsimp simp: Let_def)
  done

lemma valid_dlist_step_back_trans:
  "\<lbrakk> valid_dlist ctes; ctes \<turnstile> p \<leadsto>\<^sup>+ p''; ctes \<turnstile> p' \<leadsto> p''; p'' \<noteq> 0 \<rbrakk>
      \<Longrightarrow> ctes \<turnstile> p \<leadsto>\<^sup>* p'"
  apply (erule tranclE)
   apply (drule(3) valid_dlist_step_back)
   apply simp
  apply (drule(3) valid_dlist_step_back)
  apply simp
  done

lemma chunk_sameRegionAs_step1:
  "\<lbrakk> ctes \<turnstile> p' \<leadsto>\<^sup>* p''; ctes p'' = Some cte;
      is_chunk ctes (cteCap cte) p p'';
      mdb_chunked2 ctes; valid_dlist ctes \<rbrakk> \<Longrightarrow>
     \<forall>cte'. ctes p' = Some cte'
     \<longrightarrow> ctes \<turnstile> p \<leadsto>\<^sup>+ p'
     \<longrightarrow> sameRegionAs (cteCap cte') (cteCap cte)"
  apply (erule converse_rtrancl_induct)
   apply (clarsimp simp: is_chunk_def)
   apply (drule_tac x=p'' in spec, clarsimp)
   apply (clarsimp simp: is_chunk_def)
  apply (frule_tac x=y in spec)
  apply (drule_tac x=z in spec)
  apply ((drule mp, erule(1) transitive_closure_trans)
              | clarsimp)+
  apply (rule sameRegionAs_trans[rotated], assumption)
  apply (drule(3) mdb_chunked2_revD)
   apply simp
   apply (erule(1) sameRegionAs_trans)
  apply simp
  done

lemma chunk_sameRegionAs:
  "\<lbrakk> ctes \<turnstile> p \<leadsto>\<^sup>+ p';
     ctes p = Some cte; ctes p' = Some cte';
     is_chunk ctes (cteCap cte') p p';
     mdb_chunked2 ctes; valid_dlist ctes;
     sameRegionAs (cteCap cte') (cteCap cte) \<rbrakk> \<Longrightarrow>
      sameRegionAs (cteCap cte) (cteCap cte')"
  apply (erule tranclE2)
   apply (erule(4) mdb_chunked2_revD)
  apply (frule(4) chunk_sameRegionAs_step1[OF trancl_into_rtrancl])
  apply (case_tac "ctes c")
   apply (erule tranclE2, (clarsimp simp: mdb_next_unfold)+)[1]
  apply (clarsimp simp: trancl.intros(1))
  apply (rule sameRegionAs_trans[rotated], assumption)
  apply (erule(3) mdb_chunked2_revD)
  apply (erule(1) sameRegionAs_trans)
  done

locale mdb_insert_again_all = mdb_insert_again_child +
  assumes valid_c': "s \<turnstile>' c'"

  fixes n'
  defines "n' \<equiv> modify_map n (mdbNext parent_node) (cteMDBNode_update (mdbPrev_update (\<lambda>a. site)))"
begin

lemma no_0_n' [simp]: "no_0 n'"
  using no_0_n by (simp add: n'_def)

lemma dom_n' [simp]: "dom n' = dom n"
  apply (simp add: n'_def)
  apply (simp add: modify_map_if dom_def)
  apply (rule set_eqI)
  apply simp
  apply (rule iffI)
   apply auto[1]
  apply clarsimp
  apply (case_tac y)
  apply (case_tac "mdbNext parent_node = x")
   apply auto
  done

lemma mdb_chain_0_n' [simp]: "mdb_chain_0 n'"
  using chain_n
  apply (simp add: mdb_chain_0_def)
  apply (simp add: n'_def  trancl_prev_update)
  done

lemma parency_n':
  "n' \<turnstile> p \<rightarrow> p' = (if m \<turnstile> p \<rightarrow> parent \<or> p = parent
                 then m \<turnstile> p \<rightarrow> p' \<or> p' = site
                  else m \<turnstile> p \<rightarrow> p')"
  using descendants [of p]
  unfolding descendants_of'_def
  by (auto simp add: set_eq_iff n'_def)

lemma n'_direct_eq:
  "n' \<turnstile> p \<leadsto> p' = (if p = parent then p' = site else
                  if p = site then m \<turnstile> parent \<leadsto> p'
                  else m \<turnstile> p \<leadsto> p')"
  by (simp add: n'_def n_direct_eq)

lemma n'_tranclD:
  "n' \<turnstile> p \<leadsto>\<^sup>+ p' \<Longrightarrow>
  (if p = site then m \<turnstile> parent \<leadsto>\<^sup>+ p'
   else if m \<turnstile> p \<leadsto>\<^sup>+ parent \<or> p = parent  then m \<turnstile> p \<leadsto>\<^sup>+ p' \<or> p' = site
   else m \<turnstile> p \<leadsto>\<^sup>+ p')"
  apply (erule trancl_induct)
   apply (fastforce simp: n'_direct_eq split: split_if_asm)
  apply (fastforce simp: n'_direct_eq split: split_if_asm elim: trancl_trans)
  done

lemma site_in_dom: "site \<in> dom n"
  by (simp add: n)

lemma m_tranclD:
  assumes m: "m \<turnstile> p \<leadsto>\<^sup>+ p'"
  shows "p' \<noteq> site \<and> n' \<turnstile> p \<leadsto>\<^sup>+ p'"
proof -
  from m have "p = site \<longrightarrow> p' = 0" by clarsimp
  with mdb_chain_0_n' m
  show ?thesis
  apply -
  apply (erule trancl_induct)
   apply (rule context_conjI)
    apply clarsimp
   apply (cases "p = site")
    apply (simp add: mdb_chain_0_def site_in_dom)
   apply (cases "p = parent")
    apply simp
    apply (rule trancl_trans)
     apply (rule r_into_trancl)
     apply (simp add: n'_direct_eq)
    apply (rule r_into_trancl)
    apply (simp add: n'_direct_eq)
   apply (rule r_into_trancl)
   apply (simp add: n'_direct_eq)
  apply (rule context_conjI)
   apply clarsimp
  apply clarsimp
  apply (erule trancl_trans)
  apply (case_tac "y = parent")
   apply simp
   apply (rule trancl_trans)
    apply (rule r_into_trancl)
    apply (simp add: n'_direct_eq)
   apply (rule r_into_trancl)
   apply (simp add: n'_direct_eq)
  apply (rule r_into_trancl)
  apply (simp add: n'_direct_eq)
  done
qed

lemma n'_trancl_eq:
  "n' \<turnstile> p \<leadsto>\<^sup>+ p' =
  (if p = site then m \<turnstile> parent \<leadsto>\<^sup>+ p'
   else if m \<turnstile> p \<leadsto>\<^sup>+ parent \<or> p = parent  then m \<turnstile> p \<leadsto>\<^sup>+ p' \<or> p' = site
   else m \<turnstile> p \<leadsto>\<^sup>+ p')"
  apply simp
  apply (intro conjI impI iffI)
           apply (drule n'_tranclD)
           apply simp
          apply simp
         apply (drule n'_tranclD)
         apply simp
        apply (erule disjE)
         apply (drule m_tranclD)+
         apply simp
        apply (drule m_tranclD)
        apply simp
        apply (erule trancl_trans)
        apply (rule r_into_trancl)
        apply (simp add: n'_direct_eq)
       apply (drule n'_tranclD, simp)
      apply (erule disjE)
       apply (drule m_tranclD)
       apply simp
      apply simp
      apply (rule r_into_trancl)
      apply (simp add: n'_direct_eq)
     apply (drule n'_tranclD, simp)
    apply simp
    apply (cases "p' = site", simp)
    apply (drule m_tranclD)
    apply clarsimp
    apply (drule tranclD)
    apply (clarsimp simp: n'_direct_eq)
    apply (simp add: rtrancl_eq_or_trancl)
   apply (drule n'_tranclD, simp)
  apply clarsimp
  apply (drule m_tranclD, simp)
  done

lemma n'_rtrancl_eq:
  "n' \<turnstile> p \<leadsto>\<^sup>* p' =
   (if p = site then p' \<noteq> site \<and> m \<turnstile> parent \<leadsto>\<^sup>+ p' \<or> p' = site
    else if m \<turnstile> p \<leadsto>\<^sup>* parent then m \<turnstile> p \<leadsto>\<^sup>* p' \<or> p' = site
    else m \<turnstile> p \<leadsto>\<^sup>* p')"
  by (auto simp: rtrancl_eq_or_trancl n'_trancl_eq split)

lemma mdbNext_parent_site [simp]:
  "mdbNext parent_node \<noteq> site"
proof
  assume "mdbNext parent_node = site"
  hence "m \<turnstile> parent \<leadsto> site"
    using parent
    by (unfold mdb_next_unfold) simp
  thus False by simp
qed

lemma mdbPrev_parent_site [simp]:
  "site \<noteq> mdbPrev parent_node"
proof
  assume "site = mdbPrev parent_node"
  with parent site
  have "m \<turnstile> site \<leadsto> parent"
    apply (unfold mdb_next_unfold)
    apply simp
    apply (erule dlistEp)
     apply clarsimp
    apply clarsimp
    done
  with p_0 show False by simp
qed

lemma parent_prev:
  "(m \<turnstile> parent \<leftarrow> p) = (p = mdbNext parent_node \<and> p \<noteq> 0)"
  apply (rule iffI)
   apply (frule dlist_prevD, rule parent)
   apply (simp add: mdb_next_unfold parent)
   apply (clarsimp simp: mdb_prev_def)
  apply clarsimp
  apply (rule dlist_nextD0)
   apply (rule parent_next)
  apply assumption
  done

lemma parent_next_prev:
  "(m \<turnstile> p \<leftarrow> mdbNext parent_node) = (p = parent \<and> mdbNext parent_node \<noteq> 0)"
  using parent
  apply -
  apply (rule iffI)
   apply (clarsimp simp add: mdb_prev_def)
   apply (rule conjI)
    apply (erule dlistEn)
     apply clarsimp
    apply simp
   apply clarsimp
  apply clarsimp
  apply (rule dlist_nextD0)
   apply (rule parent_next)
  apply assumption
  done


lemma n'_prev_eq:
  notes if_cong[cong del] if_weak_cong[cong]
  shows "n' \<turnstile> p \<leftarrow> p' = (if p' = site then p = parent
                         else if p = site then m \<turnstile> parent \<leftarrow> p'
                         else if p = parent then p' = site
                         else m \<turnstile> p \<leftarrow> p')"
  using parent site site_prev
  apply (simp add: n'_def n mdb_prev_def new_parent_def new_site_def split del: split_if)
  apply (clarsimp simp add: modify_map_if cong: if_cong split del: split_if)
  apply (cases "p' = site", simp)
  apply (simp cong: if_cong split del: split_if)
  apply (cases "p' = parent")
   apply clarsimp
   apply (rule conjI, clarsimp simp: mdb_prev_def)
   apply (clarsimp simp: mdb_prev_def)
  apply (simp cong: if_cong split del: split_if)
  apply (cases "p = site")
   apply (simp add: parent_prev)
   apply (cases "mdbNext parent_node = p'")
    apply simp
    apply (rule iffI)
     prefer 2
     apply clarsimp
     apply (erule dlistEn)
      apply simp
     apply clarsimp
     apply (case_tac cte')
     apply clarsimp
    apply clarsimp
   apply clarsimp
   apply (insert site_next)[1]
   apply (rule valid_dlistEp [OF dlist, where p=p'], assumption)
    apply clarsimp
   apply clarsimp
  apply (simp cong: if_cong split del: split_if)
  apply (cases "p = parent")
   apply clarsimp
   apply (insert site_next)
   apply (cases "mdbNext parent_node = p'", clarsimp)
   apply clarsimp
   apply (rule valid_dlistEp [OF dlist, where p=p'], assumption)
    apply clarsimp
   apply clarsimp
  apply simp
  apply (cases "mdbNext parent_node = p'")
   prefer 2
   apply (clarsimp simp: mdb_prev_def)
   apply (rule iffI, clarsimp)
   apply clarsimp
   apply (case_tac z)
   apply simp
  apply (rule iffI)
   apply (clarsimp simp: mdb_prev_def)
  apply (drule sym [where t=p'])
  apply (simp add: parent_next_prev)
  done

lemma dlist_n' [simp]:
  notes if_cong[cong del] if_weak_cong[cong]
  shows "valid_dlist n'"
  using no_0_n'
  by (clarsimp simp: valid_dlist_def2 n'_direct_eq
                     n'_prev_eq Invariants_H.valid_dlist_prevD [OF dlist])

lemma n'_cap:
  "n' p = Some (CTE c node) \<Longrightarrow>
  if p = site then c = c' \<and> m p = Some (CTE NullCap site_node)
  else \<exists>node'. m p = Some (CTE c node')"
  by (auto simp: n'_def n modify_map_if new_parent_def parent
                 new_site_def site site_cap split: split_if_asm)

lemma m_cap:
  "m p = Some (CTE c node) \<Longrightarrow>
  if p = site
  then \<exists>node'. n' site = Some (CTE c' node')
  else \<exists>node'. n' p = Some (CTE c node')"
  by (clarsimp simp: n n'_def new_parent_def new_site_def parent)

lemma n'_badged:
  "n' p = Some (CTE c node) \<Longrightarrow>
  if p = site then c = c' \<and> mdbFirstBadged node
  else \<exists>node'. m p = Some (CTE c node') \<and> mdbFirstBadged node = mdbFirstBadged node'"
  by (auto simp: n'_def n modify_map_if new_parent_def parent
                 new_site_def site site_cap split: split_if_asm)

lemma no_next_region:
  "\<lbrakk> m \<turnstile> parent \<leadsto> p'; m p' = Some (CTE cap' node) \<rbrakk> \<Longrightarrow> \<not>sameRegionAs c' cap'"
  apply (clarsimp simp: mdb_next_unfold parent)
  apply (frule next_wont_bite [rotated], clarsimp)
  apply simp
  done

lemma valid_badges_n' [simp]: "valid_badges n'"
  using valid_badges
  apply (clarsimp simp: valid_badges_def)
  apply (simp add: n'_direct_eq)
  apply (drule n'_badged)+
  apply (clarsimp split: split_if_asm)
   apply (drule (1) no_next_region)
   apply simp
  apply (erule_tac x=p in allE)
  apply (erule_tac x=p' in allE)
  apply simp
  done

lemma c'_not_Null: "c' \<noteq> NullCap"
  using same_region by clarsimp

lemma valid_nullcaps_n' [simp]:
  "valid_nullcaps n'"
  using nullcaps is_untyped c'_not_Null
  apply (clarsimp simp: valid_nullcaps_def n'_def n modify_map_if new_site_def
                        new_parent_def isCap_simps)
  apply (erule allE)+
  apply (erule (1) impE)
  apply (simp add: nullMDBNode_def)
  apply (insert parent)
  apply (rule dlistEn, rule parent)
   apply clarsimp
  apply (clarsimp simp: nullPointer_def)
  done

lemma phys': "capClass parent_cap = PhysicalClass"
  using sameRegionAs_classes [OF same_region] phys
  by simp

lemma capRange_c': "capRange c' \<subseteq> capRange parent_cap"
  apply (rule sameRegionAs_capRange_subset)
   apply (rule same_region)
  apply (rule phys')
  done

lemma untypedRange_c':
  assumes ut: "isUntypedCap c'"
  shows "untypedRange c' \<subseteq> untypedRange parent_cap"
  using ut is_untyped capRange_c'
  by (auto simp: isCap_simps)

lemma sameRegion_parentI:
  "sameRegionAs c' cap \<Longrightarrow> sameRegionAs parent_cap cap"
  using same_region
  apply -
  apply (erule (1) sameRegionAs_trans)
  done

lemma no_loops_n': "no_loops n'"
  using mdb_chain_0_n' no_0_n'
  by (rule mdb_chain_0_no_loops)

lemmas no_loops_simps' [simp]=
  no_loops_trancl_simp [OF no_loops_n']
  no_loops_direct_simp [OF no_loops_n']

lemma rangeD:
  "\<lbrakk> m \<turnstile> parent \<rightarrow> p; m p = Some (CTE cap node) \<rbrakk> \<Longrightarrow>
  capRange cap \<inter> capRange c' = {}"
  using range by (rule descendants_rangeD')

lemma capAligned_c': "capAligned c'"
  using valid_c' by (rule valid_capAligned)

lemma capRange_ut:
  "capRange c' \<subseteq> untypedRange parent_cap"
  using capRange_c' is_untyped
  by (clarsimp simp: isCap_simps del: subsetI)

lemma untyped_mdb_n' [simp]: "untyped_mdb' n'"
  using untyped_mdb capRange_ut untyped_inc
  apply (clarsimp simp: untyped_mdb'_def descendants_of'_def)
  apply (drule n'_cap)+
  apply (simp add: parency_n')
  apply (simp split: split_if_asm)
    apply clarsimp
    apply (erule_tac x=parent in allE)
    apply (simp add: parent is_untyped)
    apply (erule_tac x=p' in allE)
    apply simp
    apply (frule untypedCapRange)
    apply (drule untypedRange_c')
    apply (erule impE, blast)
    apply (drule (1) rangeD)
    apply simp
   apply clarsimp
   apply (thin_tac "All P" for P)
   apply (simp add: untyped_inc'_def)
   apply (erule_tac x=parent in allE)
   apply (erule_tac x=p in allE)
   apply (simp add: parent is_untyped)
   apply (clarsimp simp: descendants_of'_def)
   apply (case_tac "untypedRange parent_cap = untypedRange c")
    apply simp
    apply (elim disjE conjE)
     apply (drule (1) rangeD)
     apply (drule untypedCapRange)
     apply simp
     apply blast
    apply simp
   apply (erule disjE)
    apply clarsimp
   apply (erule disjE)
    apply (simp add: psubsetI)
    apply (elim conjE)
    apply (drule (1) rangeD)
    apply (drule untypedCapRange)
    apply simp
    apply blast
   apply blast
  apply clarsimp
  done

lemma site':
  "n' site = Some new_site"
  by (simp add: n n'_def modify_map_if new_site_def)

lemma loopE: "m \<turnstile> x \<leadsto>\<^sup>+ x \<Longrightarrow> P"
  by simp

lemma capRange_parent_inter:
  "capRange c' \<inter> untypedRange parent_cap \<noteq> {}"
  using capAligned_capUntypedPtr [OF valid_capAligned [OF valid_c'] phys] capRange_ut
  by blast

lemma n'_ex_cteCap:
  "(\<exists>cte. n' p = Some cte \<and> P (cteCap cte))
     = (if p = site then P c' else (\<exists>cte. m p = Some cte \<and> P (cteCap cte)))"
  apply (simp add: n'_def n_def modify_map_def)
  apply fastforce
  done

lemma n'_all_cteCap:
  "(\<forall>cte. n' p = Some cte \<longrightarrow> P (cteCap cte))
     = (if p = site then P c' else (\<forall>cte. m p = Some cte \<longrightarrow> P (cteCap cte)))"
  apply (simp add: n'_def n_def modify_map_def)
  apply fastforce
  done

lemma is_end_chunk_n':
  "is_end_chunk n' cap x
      = (if x = site \<and> sameRegionAs cap c' then
           is_end_chunk m cap parent
         else if x = parent \<and> sameRegionAs cap parent_cap then False
         else is_end_chunk m cap x)"
  apply (simp add: is_end_chunk_def n'_direct_eq site' new_site_def
                   mdb_ptr_parent.p_next
                   mdb_ptr_parent.m_p
             cong: conj_cong)
  apply (subst n'_all_cteCap n'_ex_cteCap)+
  apply simp
  oops

lemma m_loop_trancl_rtrancl:
  "m \<turnstile> y \<leadsto>\<^sup>* x \<Longrightarrow> \<not> m \<turnstile> x \<leadsto>\<^sup>+ y"
  apply clarsimp
  apply (drule(1) transitive_closure_trans)
  apply (erule loopE)
  done

lemma m_rtrancl_to_site:
  "m \<turnstile> p \<leadsto>\<^sup>* site = (p = site)"
  apply (rule iffI)
   apply (erule rtranclE)
    apply assumption
   apply simp
  apply simp
  done

lemma descendants_of'_D: "p' \<in> descendants_of' p ctes \<Longrightarrow> ctes \<turnstile> p \<rightarrow> p' "
  by (clarsimp simp:descendants_of'_def)

lemma untyped_inc_mdbD:
  "\<lbrakk> sameRegionAs cap cap'; isUntypedCap cap;
      ctes p = Some (CTE cap node); ctes p' = Some (CTE cap' node');
        untyped_inc' ctes; untyped_mdb' ctes; no_loops ctes \<rbrakk>
     \<Longrightarrow> ctes \<turnstile> p \<rightarrow> p' \<or> p = p' \<or>
          (isUntypedCap cap' \<and> untypedRange cap \<subseteq> untypedRange cap'
                  \<and> sameRegionAs cap' cap
                  \<and> ctes \<turnstile> p' \<rightarrow> p)"
  apply (subgoal_tac "untypedRange cap \<subseteq> untypedRange cap' \<longrightarrow> sameRegionAs cap' cap")
   apply (cases "isUntypedCap cap'")
    apply (drule(4) untyped_incD'[where p=p and p'=p'])
    apply (erule sameRegionAsE, simp_all add: untypedCapRange)[1]
      apply (cases "untypedRange cap = untypedRange cap'")
       apply simp
       apply (elim disjE conjE)
      apply (simp only: simp_thms descendants_of'_D)+
     apply (elim disjE conjE)
     apply (simp add: subset_iff_psubset_eq)
     apply (elim disjE)
      apply (simp add:descendants_of'_D)+
     apply (clarsimp simp:descendants_of'_def)
    apply (clarsimp simp: isCap_simps)
  apply clarsimp
  apply (erule sameRegionAsE)
      apply simp
     apply (drule(1) untyped_mdbD',simp)
         apply (simp add:untypedCapRange)
         apply blast
        apply simp
       apply assumption
      apply (simp add:descendants_of'_def)
     apply (clarsimp simp:isCap_simps)
    apply (simp add:isCap_simps)
  apply (clarsimp simp:sameRegionAs_def3)
  apply (erule disjE)
   apply (intro conjI)
     apply blast
    apply (simp add:untypedCapRange)
    apply (erule subset_trans[OF _ untypedRange_in_capRange])
   apply clarsimp
   apply (rule untypedRange_not_emptyD)
   apply (simp add:untypedCapRange)
    apply blast
  apply (clarsimp simp:isCap_simps)
done

lemma parent_chunk:
  "is_chunk n' parent_cap parent site"
  by (clarsimp simp: is_chunk_def
                     n'_trancl_eq n'_rtrancl_eq site' new_site_def same_region
                     m_loop_trancl_rtrancl m_rtrancl_to_site)

lemma mdb_chunked_n' [simp]:
  notes if_cong[cong del] if_weak_cong[cong]
  shows "mdb_chunked n'"
  using chunked untyped_mdb untyped_inc
  apply (clarsimp simp: mdb_chunked_def)
  apply (drule n'_cap)+
  apply (simp add: n'_trancl_eq split del: split_if)
  apply (simp split: split_if_asm)
    apply clarsimp
    apply (frule sameRegion_parentI)
    apply (frule(1) untyped_inc_mdbD [OF _ is_untyped _ _ untyped_inc untyped_mdb no_loops, OF _ parent])
    apply (elim disjE)
      apply (frule sameRegionAs_capRange_Int)
         apply (simp add: phys)
        apply (rule valid_capAligned [OF valid_c'])
       apply (rule valid_capAligned)
       apply (erule valid_capI')
      apply (erule notE, erule(1) descendants_rangeD' [OF range, rotated])
     apply (clarsimp simp: parent parent_chunk)
    apply clarsimp
    apply (frule subtree_mdb_next)
    apply (simp add: m_loop_trancl_rtrancl [OF trancl_into_rtrancl, where x=parent])
    apply (case_tac "p' = parent")
     apply (clarsimp simp: parent)
    apply (drule_tac x=p' in spec)
    apply (drule_tac x=parent in spec)
    apply (frule sameRegionAs_trans [OF _ same_region])
    apply (clarsimp simp: parent is_chunk_def n'_trancl_eq n'_rtrancl_eq
                          m_rtrancl_to_site site' new_site_def)
    apply (drule_tac x=p'' in spec)
    apply clarsimp
    apply (drule_tac p=p'' in m_cap, clarsimp)
   apply clarsimp
   apply (erule_tac x=p in allE)
   apply (erule_tac x=parent in allE)
   apply (insert parent is_untyped)[1]
   apply simp
   apply (case_tac "p = parent")
    apply (simp add: parent)
    apply (clarsimp simp add: is_chunk_def)
    apply (simp add: rtrancl_eq_or_trancl)
    apply (erule disjE)
     apply (clarsimp simp: site' new_site_def)
    apply clarsimp
    apply (drule tranclD)
    apply (clarsimp simp: n'_direct_eq)
    apply (drule (1) transitive_closure_trans)
    apply simp
   apply simp
   apply (case_tac "isUntypedCap cap")
    prefer 2
    apply (simp add: untyped_mdb'_def)
    apply (erule_tac x=parent in allE)
    apply simp
    apply (erule_tac x=p in allE)
    apply (simp add: descendants_of'_def)
    apply (drule mp[where P="S \<inter> T \<noteq> {}" for S T])
     apply (frule sameRegionAs_capRange_Int, simp add: phys)
       apply (rule valid_capAligned, erule valid_capI')
      apply (rule valid_capAligned, rule valid_c')
     apply (insert capRange_ut)[1]
     apply blast
    apply (drule (1) rangeD)
    apply (drule capRange_sameRegionAs, rule valid_c')
     apply (simp add: phys)
    apply simp
   apply (case_tac "untypedRange parent_cap \<subseteq> untypedRange cap")
    apply (erule impE)
     apply (clarsimp simp only: isCap_simps untypedRange.simps)
     apply (subst (asm) range_subset_eq)
      apply (drule valid_capI')+
      apply (drule valid_capAligned)+
      apply (clarsimp simp: capAligned_def)
      apply (erule is_aligned_no_overflow)
     apply (simp(no_asm) add: sameRegionAs_def3 isCap_simps)
     apply (drule valid_capI')+
     apply (drule valid_capAligned)+
     apply (clarsimp simp: capAligned_def is_aligned_no_overflow interval_empty)
    apply clarsimp
    apply (erule disjE)
     apply simp
     apply (rule conjI)
      prefer 2
      apply clarsimp
      apply (drule (1) trancl_trans, erule loopE)
     apply (thin_tac "P \<longrightarrow> Q" for P Q)
     apply (clarsimp simp: is_chunk_def)
     apply (simp add: n'_trancl_eq n'_rtrancl_eq split: split_if_asm)
       apply (simp add: site' new_site_def)
      apply (erule_tac x=p'' in allE)
      apply clarsimp
      apply (drule_tac p=p'' in m_cap)
      apply clarsimp
     apply (simp add: rtrancl_eq_or_trancl)
    apply simp
    apply (rule conjI)
     apply clarsimp
     apply (drule (1) trancl_trans, erule loopE)
    apply clarsimp
    apply (clarsimp simp: is_chunk_def)
    apply (simp add: n'_trancl_eq n'_rtrancl_eq split: split_if_asm)
     apply (drule (1) transitive_closure_trans, erule loopE)
    apply (subgoal_tac "m \<turnstile> p \<rightarrow> parent")
     apply (drule subtree_mdb_next)
     apply (drule (1) trancl_trans, erule loopE)
    apply (thin_tac "All P" for P)
    apply (drule_tac p=parent and p'=p in untyped_incD'[rotated], assumption+)
    apply simp
    apply (subgoal_tac "\<not> m \<turnstile> parent \<rightarrow> p")
     prefer 2
     apply clarsimp
     apply (drule (1) rangeD)
     apply (drule capRange_sameRegionAs, rule valid_c')
      apply (simp add: phys)
     apply simp
    apply (clarsimp simp: descendants_of'_def subset_iff_psubset_eq)
    apply (erule disjE,simp,simp)
   apply (drule_tac p=parent and p'=p in untyped_incD'[rotated], assumption+)
   apply (simp add:subset_iff_psubset_eq descendants_of'_def)
    apply (elim disjE conjE| simp )+
      apply (drule(1) rangeD)
      apply (drule capRange_sameRegionAs[OF _ valid_c'])
       apply (simp add:phys)+
   apply (insert capRange_c' is_untyped)[1]
   apply (simp add: untypedCapRange [symmetric])
   apply (drule(1) disjoint_subset)
   apply (drule capRange_sameRegionAs[OF _ valid_c'])
    apply (simp add:phys)
   apply (simp add:Int_ac)
  apply clarsimp
  apply (erule_tac x=p in allE)
  apply (erule_tac x=p' in allE)
  apply clarsimp
  apply (erule disjE)
   apply simp
   apply (thin_tac "P \<longrightarrow> Q" for P Q)
   apply (subgoal_tac "is_chunk n' cap p p'")
    prefer 2
    apply (clarsimp simp: is_chunk_def)
    apply (simp add: n'_trancl_eq n'_rtrancl_eq split: split_if_asm)
        apply (erule disjE)
         apply (erule_tac x=parent in allE)
         apply clarsimp
         apply (erule impE, fastforce)
         apply (clarsimp simp: parent)
         apply (simp add: site' new_site_def)
         apply (erule sameRegionAs_trans, rule same_region)
        apply (clarsimp simp add: parent)
        apply (simp add: site' new_site_def)
        apply (rule same_region)
       apply (erule_tac x=p'' in allE)
       apply clarsimp
       apply (drule_tac p=p'' in m_cap)
       apply clarsimp
      apply (erule_tac x=p'' in allE)
      apply clarsimp
      apply (drule_tac p=p'' in m_cap)
      apply clarsimp
     apply (erule_tac x=p'' in allE)
     apply clarsimp
     apply (drule_tac p=p'' in m_cap)
     apply clarsimp
    apply (erule_tac x=p'' in allE)
    apply clarsimp
    apply (drule_tac p=p'' in m_cap)
    apply clarsimp
   apply simp
   apply (rule conjI)
    apply clarsimp
    apply (rule conjI)
     apply clarsimp
     apply (drule (1) trancl_trans, erule loopE)
    apply (rule conjI, clarsimp)
     apply (drule (1) trancl_trans, erule loopE)
    apply clarsimp
    apply (drule (1) trancl_trans, erule loopE)
   apply (rule conjI)
    apply clarsimp
    apply (drule (1) trancl_trans, erule loopE)
   apply clarsimp
   apply (rule conjI)
    apply clarsimp
    apply (drule (1) trancl_trans, erule loopE)
   apply (rule conjI, clarsimp)
   apply clarsimp
   apply (drule (1) trancl_trans, erule loopE)
  apply simp
  apply (thin_tac "P \<longrightarrow> Q" for P Q)
  apply (subgoal_tac "is_chunk n' cap' p' p")
   prefer 2
   apply (clarsimp simp: is_chunk_def)
   apply (simp add: n'_trancl_eq n'_rtrancl_eq split: split_if_asm)
       apply (erule disjE)
        apply (erule_tac x=parent in allE)
        apply clarsimp
        apply (erule impE, fastforce)
        apply (clarsimp simp: parent)
        apply (simp add: site' new_site_def)
        apply (erule sameRegionAs_trans, rule same_region)
       apply (clarsimp simp add: parent)
       apply (simp add: site' new_site_def)
       apply (rule same_region)
      apply (erule_tac x=p'' in allE)
      apply clarsimp
      apply (drule_tac p=p'' in m_cap)
      apply clarsimp
     apply (erule_tac x=p'' in allE)
     apply clarsimp
     apply (drule_tac p=p'' in m_cap)
     apply clarsimp
    apply (erule_tac x=p'' in allE)
    apply clarsimp
    apply (drule_tac p=p'' in m_cap)
    apply clarsimp
   apply (erule_tac x=p'' in allE)
   apply clarsimp
   apply (drule_tac p=p'' in m_cap)
   apply clarsimp
  apply simp
  apply (rule conjI)
   apply clarsimp
   apply (rule conjI)
    apply clarsimp
    apply (drule (1) trancl_trans, erule loopE)
   apply (rule conjI, clarsimp)
    apply (drule (1) trancl_trans, erule loopE)
   apply clarsimp
   apply (drule (1) trancl_trans, erule loopE)
  apply (rule conjI)
   apply clarsimp
   apply (drule (1) trancl_trans, erule loopE)
  apply clarsimp
  apply (rule conjI)
   apply clarsimp
   apply (drule (1) trancl_trans, erule loopE)
  apply (rule conjI, clarsimp)
  apply clarsimp
  apply (drule (1) trancl_trans, erule loopE)
  done

lemma caps_contained_n' [simp]: "caps_contained' n'"
  using caps_contained untyped_mdb untyped_inc
  apply (clarsimp simp: caps_contained'_def)
  apply (drule n'_cap)+
  apply (clarsimp split: split_if_asm)
     apply (drule capRange_untyped)
     apply simp
    apply (frule capRange_untyped)
    apply (frule untypedRange_c')
    apply (erule_tac x=parent in allE)
    apply (erule_tac x=p' in allE)
    apply (simp add: parent)
    apply (erule impE, blast)
    apply (simp add: untyped_mdb'_def)
    apply (erule_tac x=parent in allE)
    apply (erule_tac x=p' in allE)
    apply (simp add: parent is_untyped descendants_of'_def)
    apply (erule impE)
     apply (thin_tac "m site = t" for t)
     apply (drule valid_capI')
     apply (frule valid_capAligned)
     apply blast
    apply (drule (1) rangeD)
    apply (frule capRange_untyped)
    apply (drule untypedCapRange)
    apply simp
   apply (thin_tac "All P" for P)
   apply (insert capRange_c')[1]
   apply (simp add: untypedCapRange is_untyped)
   apply (subgoal_tac "untypedRange parent_cap \<inter> untypedRange c \<noteq> {}")
    prefer 2
    apply blast
   apply (frule untyped_incD'[OF _ capRange_untyped _ is_untyped])
    apply (case_tac c)
      apply simp_all
    apply (simp add:isCap_simps)
    apply (rule parent)
   apply clarsimp
   apply (case_tac "untypedRange c = untypedRange parent_cap")
    apply blast
   apply simp
   apply (elim disjE)
     apply (drule_tac A = "untypedRange c" in psubsetI)
      apply simp+
     apply (thin_tac "P\<longrightarrow>Q" for P Q)
     apply (elim conjE)
     apply (simp add:descendants_of'_def)
     apply (drule(1) rangeD)
     apply (frule capRange_untyped)
     apply (simp add:untypedCapRange Int_ac)
    apply blast
   apply (simp add:descendants_of'_def)
   apply blast
  apply blast
  done

lemma untyped_inc_n' [simp]: "untypedRange c' \<inter> usableUntypedRange parent_cap = {} \<Longrightarrow> untyped_inc' n'"
  using untyped_inc
  apply (clarsimp simp: untyped_inc'_def)
  apply (drule n'_cap)+
  apply (clarsimp simp: descendants_of'_def parency_n' split: split_if_asm)
    apply (frule untypedRange_c')
    apply (insert parent is_untyped)[1]
    apply (erule_tac x=parent in allE)
    apply (erule_tac x=p' in allE)
    apply clarsimp
    apply (case_tac "untypedRange parent_cap = untypedRange c'a")
     apply simp
     apply (intro conjI)
       apply (intro impI)
       apply (elim disjE conjE)
         apply (drule(1) subtree_trans,simp)
        apply (simp add:subset_not_psubset)
       apply simp
      apply (clarsimp simp:subset_not_psubset)
      apply (drule valid_capI')+
      apply (drule(2) disjoint_subset[OF usableRange_subseteq[OF valid_capAligned],rotated -1])
      apply simp
     apply (clarsimp)
     apply (rule int_not_emptyD)
       apply (drule(1) rangeD)
       apply (simp add:untypedCapRange Int_ac)
      apply (erule aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_c']])
     apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
    apply simp
    apply (erule subset_splitE)
       apply (simp|elim conjE)+
       apply (thin_tac "P \<longrightarrow> Q" for P Q)+
       apply blast
      apply (simp|elim conjE)+
      apply (thin_tac "P \<longrightarrow> Q" for P Q)+
      apply (intro conjI,intro impI,drule(1) subtree_trans,simp)
       apply clarsimp
      apply (intro impI)
      apply (drule(1) rangeD)
      apply (simp add:untypedCapRange Int_ac)
      apply (rule int_not_emptyD)
        apply (simp add:Int_ac)
       apply (erule aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_c']])
      apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
     apply simp
    apply (thin_tac "P \<longrightarrow> Q" for P Q)+
    apply (drule(1) disjoint_subset[rotated])
    apply simp
    apply (drule_tac B = "untypedRange c'a" in int_not_emptyD)
      apply (erule aligned_untypedRange_non_empty[OF capAligned_c'])
     apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
    apply simp
   apply (frule untypedRange_c')
   apply (insert parent is_untyped)[1]
   apply (erule_tac x=p in allE)
   apply (erule_tac x=parent in allE)
   apply clarsimp
   apply (case_tac "untypedRange parent_cap = untypedRange c")
    apply simp
    apply (intro conjI)
      apply (intro impI)
      apply (elim disjE conjE)
        apply (clarsimp simp:subset_not_psubset )+
       apply (drule(1) subtree_trans,simp)
      apply simp
     apply (clarsimp simp:subset_not_psubset)
     apply (drule disjoint_subset[OF usableRange_subseteq[OF valid_capAligned[OF valid_capI']],rotated])
       apply simp
      apply assumption
     apply simp
    apply clarsimp
    apply (rule int_not_emptyD)
      apply (drule(1) rangeD)
      apply (simp add:untypedCapRange Int_ac)
     apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
    apply (erule aligned_untypedRange_non_empty[OF capAligned_c'])
   apply simp
   apply (erule subset_splitE)
      apply (simp|elim conjE)+
      apply (thin_tac "P \<longrightarrow> Q" for P Q)+
      apply (intro conjI,intro impI,drule(1) subtree_trans,simp)
       apply clarsimp
      apply (intro impI)
      apply (drule(1) rangeD)
      apply (simp add:untypedCapRange Int_ac)
      apply (rule int_not_emptyD)
        apply (simp add:Int_ac)
       apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
      apply (erule aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_c']])
     apply simp
     apply (thin_tac "P\<longrightarrow>Q" for P Q)+
     apply blast
    apply (thin_tac "P\<longrightarrow>Q" for P Q)+
    apply simp
   apply (drule(1) disjoint_subset2[rotated])
   apply simp
   apply (drule_tac B = "untypedRange c'" in int_not_emptyD)
     apply (erule(1) aligned_untypedRange_non_empty[OF valid_capAligned[OF valid_capI']])
    apply (erule aligned_untypedRange_non_empty[OF capAligned_c'])
   apply simp
  apply (erule_tac x=p in allE)
  apply (erule_tac x=p' in allE)
  apply simp
  apply blast
  done

lemma ut_rev_n' [simp]: "ut_revocable' n'"
  using ut_rev
  apply (clarsimp simp: ut_revocable'_def n'_def n_def)
  apply (clarsimp simp: modify_map_if split: split_if_asm)
  done

lemma class_links_m: "class_links m"
  using valid
  by (simp add: valid_mdb_ctes_def)

lemma parent_phys: "capClass parent_cap = PhysicalClass"
  using is_untyped
  by (clarsimp simp: isCap_simps)

lemma class_links [simp]: "class_links n'"
  using class_links_m
  apply (clarsimp simp add: class_links_def)
  apply (simp add: n'_direct_eq
            split: split_if_asm)
    apply (case_tac cte,
           clarsimp dest!: n'_cap simp: site' parent new_site_def phys parent_phys)
   apply (drule_tac x=parent in spec)
   apply (drule_tac x=p' in spec)
   apply (case_tac cte')
   apply (clarsimp simp: site' new_site_def parent parent_phys phys dest!: n'_cap
                  split: split_if_asm)
  apply (case_tac cte, case_tac cte')
  apply (clarsimp dest!: n'_cap split: split_if_asm)
  apply fastforce
  done

lemma irq_control_n' [simp]:
  "irq_control n'"
  using irq_control phys
  apply (clarsimp simp: irq_control_def)
  apply (clarsimp simp: n'_def n_def)
  apply (clarsimp simp: modify_map_if split: split_if_asm)
  done

lemma dist_z_m:
  "distinct_zombies m"
  using valid by auto

lemma dist_z [simp]:
  "distinct_zombies n'"
  using dist_z_m
  apply (simp add: n'_def distinct_zombies_nonCTE_modify_map)
  apply (simp add: n_def distinct_zombies_nonCTE_modify_map
                   fun_upd_def[symmetric])
  apply (erule distinct_zombies_seperateE, simp)
  apply (case_tac cte, clarsimp)
  apply (rename_tac cap node)
  apply (subgoal_tac "capRange cap \<inter> capRange c' \<noteq> {}")
   apply (frule untyped_mdbD' [OF _ _ _ _ _ untyped_mdb, OF parent])
      apply (simp add: is_untyped)
     apply (clarsimp simp add: untypedCapRange[OF is_untyped, symmetric])
     apply (drule disjoint_subset2 [OF capRange_c'])
     apply simp
    apply simp
   apply (simp add: descendants_of'_def)
   apply (drule(1) rangeD)
   apply simp
  apply (drule capAligned_capUntypedPtr [OF capAligned_c'])
  apply (frule valid_capAligned [OF valid_capI'])
  apply (drule(1) capAligned_capUntypedPtr)
  apply auto
  done

lemma reply_masters_rvk_fb_m:
  "reply_masters_rvk_fb m"
  using valid by auto

lemma reply_masters_rvk_fb_n[simp]:
  "reply_masters_rvk_fb n'"
  using reply_masters_rvk_fb_m
  apply (simp add: reply_masters_rvk_fb_def n'_def ball_ran_modify_map_eq
                   n_def fun_upd_def[symmetric])
  apply (rule ball_ran_fun_updI, assumption)
  apply clarsimp
  done

lemma valid_n':
  "untypedRange c' \<inter> usableUntypedRange parent_cap = {} \<Longrightarrow> valid_mdb_ctes n'"
  by auto

end

lemma caps_overlap_reserved'_D:
  "\<lbrakk>caps_overlap_reserved' S s; ctes_of s p = Some cte;isUntypedCap (cteCap cte)\<rbrakk> \<Longrightarrow> usableUntypedRange (cteCap cte) \<inter> S = {}"
  apply (simp add:caps_overlap_reserved'_def)
  apply (erule ballE)
   apply (erule(2) impE)
  apply fastforce
  done

lemma insertNewCap_valid_mdb:
  "\<lbrace>valid_mdb' and valid_objs' and K (slot \<noteq> p) and
    caps_overlap_reserved' (untypedRange cap) and
    cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                      sameRegionAs (cteCap cte) cap) p and
    K (\<not>isZombie cap) and valid_cap' cap and
    (\<lambda>s. descendants_range' cap p (ctes_of s))\<rbrace>
  insertNewCap p slot cap
  \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
  apply (clarsimp simp: insertNewCap_def valid_mdb'_def)
  apply (wp getCTE_ctes_of | simp add: o_def)+
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (rule conjI)
   apply (clarsimp simp: no_0_def valid_mdb_ctes_def)
  apply (case_tac cte)
  apply (rename_tac p_cap p_node)
  apply (clarsimp cong: if_cong)
  apply (case_tac ya)
  apply (rename_tac node)
  apply (clarsimp simp: nullPointer_def)
  apply (rule mdb_insert_again_all.valid_n')
   apply unfold_locales[1]
                apply (assumption|rule refl)+
        apply (frule sameRegionAs_classes, clarsimp simp: isCap_simps)
       apply (erule (1) ctes_of_valid_cap')
      apply (simp add: valid_mdb_ctes_def)
     apply simp
    apply (clarsimp simp: isMDBParentOf_CTE)
    apply (clarsimp simp: isCap_simps valid_mdb_ctes_def ut_revocable'_def)
   apply assumption
  apply (drule(1) caps_overlap_reserved'_D)
    apply simp
  apply (simp add:Int_ac)
  done

(* FIXME: move *)
lemma no_default_zombie:
  "cap_relation (default_cap tp p sz) cap \<Longrightarrow> \<not>isZombie cap"
  by (cases tp, auto simp: isCap_simps)

lemma insertNewCap_valid_objs [wp]:
  "\<lbrace> valid_objs' and valid_cap' cap and pspace_aligned' and pspace_distinct'\<rbrace>
  insertNewCap parent slot cap
  \<lbrace>\<lambda>_. valid_objs'\<rbrace>"
  apply (simp add: insertNewCap_def)
  apply (wp setCTE_valid_objs getCTE_wp')
  apply clarsimp
  done

lemma insertNewCap_valid_cap [wp]:
  "\<lbrace> valid_cap' c \<rbrace>
  insertNewCap parent slot cap
  \<lbrace>\<lambda>_. valid_cap' c\<rbrace>"
  apply (simp add: insertNewCap_def)
  apply (wp getCTE_wp')
  apply clarsimp
  done

lemmas descendants_of'_mdbPrev = descendants_of_prev_update

lemma insertNewCap_ranges:
  "\<lbrace>\<lambda>s. descendants_range' c p (ctes_of s) \<and>
   descendants_range' cap p (ctes_of s) \<and>
   capRange c \<inter> capRange cap = {} \<and>
   cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                     sameRegionAs (cteCap cte) cap) p s \<and>
   valid_mdb' s \<and> valid_objs' s\<rbrace>
  insertNewCap p slot cap
  \<lbrace>\<lambda>_ s. descendants_range' c p (ctes_of s)\<rbrace>"
  apply (simp add: insertNewCap_def)
  apply (wp getCTE_wp')
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (rule conjI)
   apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
  apply (case_tac ctea)
  apply (case_tac cteb)
  apply (clarsimp simp: nullPointer_def cong: if_cong)
  apply (simp (no_asm) add: descendants_range'_def descendants_of'_mdbPrev)
  apply (subst mdb_insert_again_child.descendants)
   apply unfold_locales[1]
               apply (simp add: valid_mdb'_def)
              apply (assumption|rule refl)+
       apply (frule sameRegionAs_classes, clarsimp simp: isCap_simps)
      apply (erule (1) ctes_of_valid_cap')
     apply (simp add: valid_mdb'_def valid_mdb_ctes_def)
    apply clarsimp
   apply (clarsimp simp: isMDBParentOf_def)
   apply (clarsimp simp: isCap_simps valid_mdb'_def
                         valid_mdb_ctes_def ut_revocable'_def)
  apply clarsimp
  apply (rule context_conjI, blast)
  apply (clarsimp simp: descendants_range'_def)
  done

lemma insertNewCap_overlap_reserved'[wp]:
  "\<lbrace>\<lambda>s. caps_overlap_reserved' (capRange c) s\<and>
   capRange c \<inter> capRange cap = {} \<and> capAligned cap \<and>
   cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                     sameRegionAs (cteCap cte) cap) p s \<and>
   valid_mdb' s \<and> valid_objs' s\<rbrace>
  insertNewCap p slot cap
  \<lbrace>\<lambda>_ s. caps_overlap_reserved' (capRange c) s\<rbrace>"
  apply (simp add: insertNewCap_def caps_overlap_reserved'_def)
  apply (wp getCTE_wp')
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (rule conjI)
   apply (clarsimp simp: valid_mdb'_def valid_mdb_ctes_def no_0_def)
  apply (case_tac ctea)
  apply (case_tac cteb)
  apply (clarsimp simp: nullPointer_def ball_ran_modify_map_eq
                        caps_overlap_reserved'_def[symmetric])
  apply (clarsimp simp: ran_def split: if_splits)
  apply (case_tac "slot = a")
   apply clarsimp
   apply (rule disjoint_subset)
    apply (erule(1) usableRange_subseteq)
   apply (simp add:untypedCapRange Int_ac)+
  apply (subst Int_commute)
  apply (erule(2) caps_overlap_reserved'_D)
  done

crunch typ_at'[wp]: insertNewCap "\<lambda>s. P (typ_at' T p s)"
  (wp: crunch_wps)
crunch ksArch[wp]: insertNewCap "\<lambda>s. P (ksArchState s)"
  (wp: crunch_wps)

lemma inv_untyped_corres_helper1:
  "list_all2 cap_relation (map (\<lambda>ref. default_cap tp ref sz) orefs) cps
   \<Longrightarrow>
   corres dc
      (\<lambda>s. pspace_aligned s \<and> pspace_distinct s
          \<and> valid_objs s \<and> valid_mdb s \<and> valid_list s
          \<and> cte_wp_at is_untyped_cap p s
          \<and> (\<forall>tup \<in> set (zip crefs orefs).
              cte_wp_at (\<lambda>c. cap_range (default_cap tp (snd tup) sz) \<subseteq> untyped_range c) p s)
          \<and> (\<forall>tup \<in> set (zip crefs orefs).
              descendants_range (default_cap tp (snd tup) sz) p s)
          \<and> (\<forall>tup \<in> set (zip crefs orefs).
              caps_overlap_reserved (untyped_range (default_cap tp (snd tup) sz)) s)
          \<and> (\<forall>tup \<in> set (zip crefs orefs). real_cte_at (fst tup) s)
          \<and> (\<forall>tup \<in> set (zip crefs orefs).
              cte_wp_at (op = cap.NullCap) (fst tup) s)
          \<and> distinct (p # (map fst (zip crefs orefs)))
          \<and> distinct_sets (map (\<lambda>tup. cap_range (default_cap tp (snd tup) sz)) (zip crefs orefs))
          \<and> (\<forall>tup \<in> set (zip crefs orefs).
              valid_cap (default_cap tp (snd tup) sz) s))
      (\<lambda>s. (\<forall>tup \<in> set (zip (map cte_map crefs) cps). valid_cap' (snd tup) s)
         \<and> (\<forall>tup \<in> set (zip (map cte_map crefs) cps). cte_wp_at' (\<lambda>c. cteCap c = NullCap) (fst tup) s)
         \<and> cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                         (\<forall>tup \<in> set (zip (map cte_map crefs) cps).
                               sameRegionAs (cteCap cte) (snd tup)))
              (cte_map p) s
         \<and> distinct ((cte_map p) # (map fst (zip (map cte_map crefs) cps)))
         \<and> valid_mdb' s \<and> valid_objs' s \<and> pspace_aligned' s \<and> pspace_distinct' s
         \<and> (\<forall>tup \<in> set (zip (map cte_map crefs) cps). descendants_range' (snd tup) (cte_map p) (ctes_of s))
         \<and> (\<forall>tup \<in> set (zip (map cte_map crefs) cps).
              caps_overlap_reserved' (capRange (snd tup)) s)
         \<and> distinct_sets (map capRange (map snd (zip (map cte_map crefs) cps))))
      (sequence_x (map (create_cap tp sz p) (zip crefs orefs)))
      (zipWithM_x (insertNewCap (cte_map p))
             ((map cte_map crefs)) cps)"
  apply (simp add: zipWithM_x_def zipWith_def split_def)
  apply (fold mapM_x_def)
  apply (rule corres_list_all2_mapM_)
     apply (rule corres_guard_imp)
       apply (erule create_cap_corres)
      apply (clarsimp simp: cte_wp_at_def is_cap_simps)
     apply (clarsimp simp: cteCaps_of_ran_Ball_upd fun_upd_def cte_wp_at_ctes_of)
    apply clarsimp
    apply (rule hoare_pre, wp hoare_vcg_const_Ball_lift)
    apply clarsimp
    apply (rule conjI)
     apply (clarsimp simp: cte_wp_at_caps_of_state
                           cap_range_def[where c="default_cap a b c" for a b c])
     apply (drule(2) caps_overlap_reservedD[rotated])
     apply (simp add:Int_ac)
    apply (rule conjI)
     apply (clarsimp simp: valid_cap_def)
    apply (rule conjI)
     apply (clarsimp simp: cte_wp_at_caps_of_state)
    apply (rule conjI)
     apply (clarsimp simp:Int_ac)
     apply (erule disjoint_subset2[rotated])
     apply fastforce
    apply clarsimp
    apply (rule conjI)
     apply clarsimp
     apply (rule conjI)
      subgoal by fastforce
     apply (clarsimp simp: cte_wp_at_caps_of_state is_cap_simps valid_cap_def)
    apply (fastforce simp: image_def)
   apply (rule hoare_pre)
    apply (wp
              hoare_vcg_const_Ball_lift hoare_vcg_const_imp_lift [OF insertNewCap_mdbNext]
              insertNewCap_valid_mdb hoare_vcg_all_lift insertNewCap_ranges
               | subst cte_wp_at_cteCaps_of)+
   apply (subst(asm) cte_wp_at_cteCaps_of)+
   apply (clarsimp simp only:)
   apply simp
   apply (rule conjI)
    apply clarsimp
    apply (thin_tac "cte_map p \<notin> S" for S)
    apply (erule notE, erule rev_image_eqI)
    apply simp
   apply (rule conjI,clarsimp+)
   apply (rule conjI,erule caps_overlap_reserved'_subseteq)
   apply (rule untypedRange_in_capRange)
   apply (rule conjI,erule no_default_zombie)
   apply (rule conjI, clarsimp simp:Int_ac)
    apply fastforce
   apply (clarsimp simp:Int_ac valid_capAligned )
    apply fastforce
  apply (rule list_all2_zip_split)
   apply (simp add: list_all2_map2 list_all2_refl)
  apply (simp add: list_all2_map1)
  done

lemma createNewCaps_valid_pspace_extras:
  "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
          \<and> pspace_no_overlap' ptr sz s
          \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
          \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
          \<and> ksCurDomain s \<le> maxDomain
   )\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. pspace_aligned'\<rbrace>"
  "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
          \<and> pspace_no_overlap' ptr sz s
          \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
          \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
          \<and> ksCurDomain s \<le> maxDomain
   )\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. pspace_distinct'\<rbrace>"
  "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
          \<and> pspace_no_overlap' ptr sz s
          \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
          \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
          \<and> ksCurDomain s \<le> maxDomain
   )\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
  "\<lbrace>(\<lambda>s.    n \<noteq> 0 \<and> ptr \<noteq> 0 \<and> range_cover ptr sz (APIType_capBits ty us) n
          \<and> pspace_no_overlap' ptr sz s
          \<and> valid_pspace' s \<and> caps_no_overlap'' ptr sz s
          \<and> caps_overlap_reserved' {ptr .. ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s
          \<and> ksCurDomain s \<le> maxDomain
   )\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
  apply (rule hoare_grab_asm)+
    apply (rule hoare_pre,rule hoare_strengthen_post[OF createNewCaps_valid_pspace])
    apply (simp add:valid_pspace'_def)+
  apply (rule hoare_grab_asm)+
    apply (rule hoare_pre,rule hoare_strengthen_post[OF createNewCaps_valid_pspace])
    apply (simp add:valid_pspace'_def)+
  apply (rule hoare_grab_asm)+
    apply (rule hoare_pre,rule hoare_strengthen_post[OF createNewCaps_valid_pspace])
    apply (simp add:valid_pspace'_def)+
  apply (rule hoare_grab_asm)+
    apply (rule hoare_pre,rule hoare_strengthen_post[OF createNewCaps_valid_pspace])
    apply (simp add:valid_pspace'_def)+
  done

declare map_fst_zip_prefix[simp]

declare map_snd_zip_prefix[simp]

declare word_unat_power [symmetric, simp del]

lemma createWordObjects_ret2:
  "\<lbrace>(\<lambda>s. P (map (\<lambda>p. ptr_add y (p * 2 ^ (pageBits + us)))
                         [0 ..< n]))
      and K ( n < 2 ^ word_bits \<and> n \<noteq> 0)\<rbrace>
     createWordObjects y n us
   \<lbrace>\<lambda>rv s. P rv\<rbrace>"
  apply (simp add: createWordObjects_def split del: split_if)
  apply (rule hoare_pre, wp)
   apply (wp createObjects_ret2)
  apply (simp add: objBits_simps)
  done

lemma createNewCaps_range_helper:
  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
     createNewCaps tp ptr n us
   \<lbrace>\<lambda>rv s. \<exists>capfn.
        rv = map capfn (map (\<lambda>p. ptr_add ptr (p * 2 ^ (APIType_capBits tp us)))
                               [0 ..< n])
          \<and> (\<forall>p. capClass (capfn p) = PhysicalClass
                 \<and> capUntypedPtr (capfn p) = p
                 \<and> capBits (capfn p) = (APIType_capBits tp us))\<rbrace>"
  apply (simp add: createNewCaps_def toAPIType_def
                   ArchTypes_H.toAPIType_def
                   createNewCaps_def Arch_createNewCaps_def
               split del: split_if cong: option.case_cong)
  apply (rule hoare_grab_asm)+
  apply (frule range_cover.range_cover_n_less)
  apply (frule range_cover.unat_of_nat_n)
  apply (cases tp, simp_all split del: split_if)
          apply (rename_tac apiobject_type)
          apply (case_tac apiobject_type, simp_all split del: split_if)
              apply (rule hoare_pre, wp)
              apply (frule range_cover_not_zero[rotated -1],simp)
              apply (clarsimp simp: APIType_capBits_def
                objBits_simps archObjSize_def ptr_add_def o_def)
              apply (subst upto_enum_red')
               apply unat_arith
              apply (clarsimp simp: o_def fromIntegral_def toInteger_nat fromInteger_nat)
              apply fastforce
             apply (rule hoare_pre,wp createObjects_ret2)
             apply (clarsimp simp: APIType_capBits_def word_bits_def
                objBits_simps archObjSize_def ptr_add_def o_def)
             apply (fastforce simp: objBitsKO_def objBits_def)
            apply (rule hoare_pre,wp createObjects_ret2)
            apply (clarsimp simp: APIType_capBits_def word_bits_def
                                  objBits_simps archObjSize_def ptr_add_def o_def)
            apply (fastforce simp: objBitsKO_def  objBits_def)
           apply (rule hoare_pre,wp createObjects_ret2)
           apply (clarsimp simp:  APIType_capBits_def word_bits_def
              objBits_simps archObjSize_def ptr_add_def o_def)
           apply (fastforce simp: objBitsKO_def  objBits_def)
          apply (rule hoare_pre,wp createObjects_ret2)
          apply (clarsimp simp: APIType_capBits_def word_bits_def
             objBits_simps archObjSize_def ptr_add_def o_def)
          apply (fastforce simp: objBitsKO_def  objBits_def)
        apply (wp createWordObjects_ret2 createObjects_ret2,
          clarsimp simp: APIType_capBits_def objBits_simps archObjSize_def
                        word_bits_def pdBits_def pageBits_def ptBits_def
          ,rule exI,fastforce)+
  done

lemma createNewCaps_range_helper2:
  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
     createNewCaps tp ptr n us
   \<lbrace>\<lambda>rv s. \<forall>cp \<in> set rv. capRange cp \<noteq> {} \<and> capRange cp \<subseteq> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}\<rbrace>"
  apply (rule hoare_assume_pre)
  apply (rule hoare_strengthen_post)
   apply (rule createNewCaps_range_helper)
  apply (clarsimp simp: capRange_def interval_empty ptr_add_def
                        word_unat_power[symmetric]
                  simp del: atLeastatMost_subset_iff
                 dest!: less_two_pow_divD)
  apply (rule conjI)
   apply (rule is_aligned_no_overflow)
   apply (rule is_aligned_add_multI [OF _ _ refl])
    apply (fastforce simp:range_cover_def)
   apply simp
  apply (rule range_subsetI)
   apply (rule word32_plus_mono_right_split[OF range_cover.range_cover_compare])
     apply (assumption)+
   apply (simp add:range_cover_def word_bits_def)
  apply (frule range_cover_cell_subset)
   apply (erule of_nat_mono_maybe[rotated])
   apply (drule (1) range_cover.range_cover_n_less )
  apply (clarsimp)
  apply (erule impE)
   apply (simp add:range_cover_def)
   apply (rule is_aligned_no_overflow)
   apply (rule is_aligned_add_multI[OF _ le_refl refl])
   apply (fastforce simp:range_cover_def)
  apply simp
  done

lemma createNewCaps_children:
  "\<lbrace>\<lambda>s. cap = UntypedCap (ptr && ~~ mask sz) sz idx
     \<and> range_cover ptr sz (APIType_capBits tp us) n \<and> 0 < n\<rbrace>
     createNewCaps tp ptr n us
   \<lbrace>\<lambda>rv s. \<forall>y \<in> set rv. sameRegionAs cap y\<rbrace>"
  apply (rule hoare_assume_pre)
  apply (rule hoare_chain [OF createNewCaps_range_helper2])
   apply fastforce
  apply clarsimp
  apply (drule(1) bspec)
  apply (clarsimp simp: sameRegionAs_def3 isCap_simps)
  apply (drule(1) subsetD)
  apply clarsimp
  apply (erule order_trans[rotated])
  apply (rule word_and_le2)
  done

lemma createObjects_null_filter':
  "\<lbrace>\<lambda>s. P (null_filter' (ctes_of s)) \<and> makeObjectKO ty = Some val \<and>
        range_cover ptr sz (objBitsKO val + gbits) n \<and> n \<noteq> 0 \<and>
        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createObjects' ptr n val gbits
   \<lbrace>\<lambda>addrs a. P (null_filter' (ctes_of a))\<rbrace>"
   apply (clarsimp simp: createObjects'_def split_def)
   apply (wp hoare_unless_wp|wpc
          | clarsimp simp:haskell_assert_def alignError_def
            split del: if_splits simp del:fun_upd_apply)+
   apply (subst new_cap_addrs_fold')
     apply (simp add:unat_1_0 unat_gt_0)
     apply (rule range_cover_not_zero_shift)
     apply fastforce+
   apply (subst new_cap_addrs_fold')
    apply (simp add:unat_1_0 unat_gt_0)
    apply (rule range_cover_not_zero_shift)
      apply simp
     apply assumption
    apply simp
   apply (subst data_map_insert_def[symmetric])+
   apply (frule(2) retype_aligned_distinct'[where ko = val])
    apply (erule range_cover_rel)
     apply simp+
   apply (frule(2) retype_aligned_distinct'(2)[where ko = val])
    apply (erule range_cover_rel)
     apply simp+
   apply (frule null_filter_ctes_retype
     [where addrs = "(new_cap_addrs (unat (((of_nat n)::word32) << gbits)) ptr val)"])
          apply assumption+
     apply (clarsimp simp:field_simps foldr_upd_app_if[folded data_map_insert_def] shiftl_t2n range_cover.unat_of_nat_shift)+
    apply (rule new_cap_addrs_aligned[THEN bspec])
    apply (erule range_cover.aligned[OF range_cover_rel])
     apply simp+
   apply (clarsimp simp:shiftl_t2n field_simps range_cover.unat_of_nat_shift)
   apply (drule subsetD[OF new_cap_addrs_subset,rotated])
    apply (erule range_cover_rel)
     apply simp
    apply simp
   apply (rule ccontr)
   apply clarify
   apply (frule(1) pspace_no_overlapD')
   apply (erule_tac B = "{x..x+2^objBitsKO y - 1}" in in_empty_interE[rotated])
    apply (drule(1) pspace_alignedD')
    apply (clarsimp)
    apply (erule is_aligned_no_overflow)
    apply (simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
        Int_atLeastAtMost atLeastatMost_empty_iff add:Int_ac ptr_add_def p_assoc_help)
  apply (simp add:field_simps foldr_upd_app_if[folded data_map_insert_def] shiftl_t2n)
  apply auto
  done

lemma createNewCaps_null_filter':
  "\<lbrace>(\<lambda>s. P (null_filter' (ctes_of s)))
      and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz
      and K (range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0) \<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>_ s. P (null_filter' (ctes_of s))\<rbrace>"
  apply (rule hoare_gen_asm)
  apply (simp add: createNewCaps_def toAPIType_def
                   ArchTypes_H.toAPIType_def
                   createNewCaps_def Arch_createNewCaps_def
               split del: split_if cong: option.case_cong)
  apply (cases ty, simp_all split del: split_if)
          apply (rename_tac apiobject_type)
          apply (case_tac apiobject_type, simp_all split del: split_if)
              apply (rule hoare_pre, wp,simp)
             apply (simp add: createWordObjects_def createObjects_def
                              objBitsKO_def makeObjectKO_def
                              APIType_capBits_def objBits_def pageBits_def
                              archObjSize_def ptBits_def pdBits_def curDomain_def
                    | wp createObjects_null_filter'[where ty = "Inr ty" and sz = sz]
                         copyGlobalMappings_ctes_of threadSet_ctes_of mapM_x_wp'
                    | fastforce)+
  done

lemma createNewCaps_descendants_range':
  "\<lbrace>\<lambda>s. descendants_range' p q (ctes_of s) \<and>
        range_cover ptr sz (APIType_capBits ty us) n \<and> n \<noteq> 0 \<and>
        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s\<rbrace>
   createNewCaps ty ptr n us
   \<lbrace> \<lambda>rv s. descendants_range' p q (ctes_of s)\<rbrace>"
  apply (clarsimp simp:descendants_range'_def2 descendants_range_in'_def2)
  apply (wp createNewCaps_null_filter')
  apply fastforce
  done

lemma caps_overlap_reserved'_def2:
  "caps_overlap_reserved' S =
   (\<lambda>s. (\<forall>cte \<in> ran (null_filter' (ctes_of s)).
        isUntypedCap (cteCap cte) \<longrightarrow>
        usableUntypedRange (cteCap cte) \<inter> S = {}))"
  apply (rule ext)
  apply (clarsimp simp:caps_overlap_reserved'_def)
  apply (intro iffI ballI impI)
    apply (elim ballE impE)
      apply simp
     apply simp
    apply (simp add:ran_def null_filter'_def split:split_if_asm option.splits)
  apply (elim ballE impE)
    apply simp
   apply simp
  apply (clarsimp simp: ran_def null_filter'_def is_cap_simps
                  simp del: split_paired_All split_paired_Ex split: if_splits)
  apply (drule_tac x = a in spec)
  apply simp
  done

lemma createNewCaps_caps_overlap_reserved':
  "\<lbrace>\<lambda>s. caps_overlap_reserved' S s \<and> pspace_aligned' s \<and> pspace_distinct' s \<and>
        pspace_no_overlap' ptr sz s \<and> 0 < n \<and>
        range_cover ptr sz (APIType_capBits ty us) n\<rbrace>
   createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv s. caps_overlap_reserved' S s\<rbrace>"
  apply (clarsimp simp: caps_overlap_reserved'_def2)
  apply (wp createNewCaps_null_filter')
  apply fastforce
  done

lemma createNewCaps_caps_overlap_reserved_ret':
  "\<lbrace>\<lambda>s. caps_overlap_reserved'
          {ptr..ptr + of_nat n * 2 ^ APIType_capBits ty us - 1} s \<and>
        pspace_aligned' s \<and> pspace_distinct' s \<and> pspace_no_overlap' ptr sz s \<and>
        0 < n \<and> range_cover ptr sz (APIType_capBits ty us) n\<rbrace>
   createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv s. \<forall>y\<in>set rv. caps_overlap_reserved' (capRange y) s\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp:valid_def)
  apply (frule use_valid[OF _ createNewCaps_range_helper])
   apply fastforce
  apply clarsimp
  apply (erule use_valid[OF _ createNewCaps_caps_overlap_reserved'])
  apply (intro conjI,simp_all)
  apply (erule caps_overlap_reserved'_subseteq)
  apply (drule(1) range_cover_subset)
   apply simp
  apply (clarsimp simp: ptr_add_def capRange_def
                  simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
                            Int_atLeastAtMost atLeastatMost_empty_iff)
  done

lemma createNewCaps_descendants_range_ret':
 "\<lbrace>\<lambda>s.  (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)
        \<and> pspace_aligned' s \<and> pspace_distinct' s
        \<and> pspace_no_overlap' ptr sz s
        \<and> descendants_range_in' {ptr..ptr + of_nat n * 2^(APIType_capBits ty us) - 1} cref (ctes_of s)\<rbrace>
   createNewCaps ty ptr n us
  \<lbrace> \<lambda>rv s. \<forall>y\<in>set rv. descendants_range' y cref (ctes_of s)\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp: valid_def)
  apply (frule use_valid[OF _ createNewCaps_range_helper])
   apply simp
  apply (erule use_valid[OF _ createNewCaps_descendants_range'])
  apply (intro conjI,simp_all)
  apply (clarsimp simp:descendants_range'_def descendants_range_in'_def)
  apply (drule(1) bspec)+
  apply (clarsimp simp:cte_wp_at_ctes_of)
  apply (erule disjoint_subset2[rotated])
  apply (drule(1) range_cover_subset)
   apply simp
  apply (simp add:capRange_def ptr_add_def)
  done

lemma createNewCaps_not_parents:
  "\<lbrace>\<lambda>s. (\<forall>cap \<in> ran (cteCaps_of s). \<not> sameRegionAs (UntypedCap ptr_base sz idx) cap)
      \<and> pspace_no_overlap' ptr sz s \<and> pspace_aligned' s \<and> pspace_distinct' s
      \<and> 0 < n \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> ptr_base = ptr && ~~ mask sz\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv s. \<forall>cap \<in> ran (cteCaps_of s). \<forall>tup \<in> set (zip xs rv). \<not> sameRegionAs (snd tup) cap\<rbrace>"
  apply (rule_tac Q="\<lambda>rv s. (\<forall>y\<in>set rv. sameRegionAs (UntypedCap ptr_base sz idx) y)
                          \<and> (\<forall>p. \<not> cte_wp_at' (sameRegionAs (UntypedCap ptr_base sz idx) \<circ> cteCap) p s)"
                 in hoare_post_imp)
   apply (clarsimp dest!: set_zip_helper)
   apply (drule(1) bspec)+
   apply (drule(1) sameRegionAs_trans)
   apply (erule ranE)
   apply (clarsimp simp: tree_cte_cteCap_eq)
   apply (erule_tac x=x in allE)
   apply simp
  apply (wp createNewCaps_children hoare_vcg_all_lift createNewCaps_cte_wp_at2)
   apply (clarsimp simp: tree_cte_cteCap_eq simp del: o_apply)
   apply (rule conjI)
    apply (clarsimp split: option.splits)
    apply (erule notE[rotated], erule bspec, erule ranI)
   apply (simp add: makeObject_cte)
  apply fastforce
  done

lemma createObjects_distinct:
  "\<lbrace>\<lambda>s. 0<n \<and> range_cover ptr sz ((objBitsKO (injectKO obj)) + us) n\<rbrace> createObjects ptr n obj us \<lbrace>\<lambda>rv s. distinct_prop op \<noteq> rv\<rbrace>"
  apply (simp add: createObjects_def unless_def alignError_def split_def
                   lookupAround2_pspace_no createObjects'_def
             cong: if_cong split del: split_if)
  apply (wp | simp only: o_def)+
  apply (clarsimp simp: upto_enum_def distinct_prop_map
              simp del: upt_Suc)
  apply (rule distinct_prop_distinct)
   apply simp
  apply (clarsimp simp: unat_minus_one)
  apply (subgoal_tac "x<2^word_bits")
   prefer 2
   apply (rule range_cover.range_cover_le_n_less(1) [where 'a=32, folded word_bits_def], assumption)
   apply (drule unat_of_nat_minus_1[OF range_cover.range_cover_n_less(1),where 'a=32, folded word_bits_def])
    apply simp
   apply arith
  apply (subgoal_tac "y< 2^word_bits")
   prefer 2
   apply (rule range_cover.range_cover_le_n_less(1) [where 'a=32, folded word_bits_def],assumption)
   apply (drule unat_of_nat_minus_1[OF range_cover.range_cover_n_less(1)])
    apply simp
   apply arith
  apply (subst(asm) toEnum_of_nat)
   apply (simp add:word_bits_def)
  apply (subst(asm) toEnum_of_nat)
   apply (simp add:word_bits_def)
  apply (drule_tac f = "\<lambda>x. x >> (objBitsKO (injectKOS obj) + us)" and x= "x << l" for x l in arg_cong)
  apply (subst (asm) shiftl_shiftr_id)
    apply (simp add:range_cover_def)
   apply (rule of_nat_power[OF range_cover.range_cover_le_n_less(2)])
     apply assumption
    apply (drule unat_of_nat_minus_1[OF range_cover.range_cover_n_less(1)])
     apply simp
    apply arith
   apply (simp add:word_bits_def objBitsKO_bounded_low)
  apply (subst (asm) shiftl_shiftr_id)
    apply (simp add:range_cover_def)
   apply (rule of_nat_power[OF range_cover.range_cover_le_n_less(2)])
     apply assumption
    apply (drule unat_of_nat_minus_1[OF range_cover.range_cover_n_less(1)])
     apply simp
    apply arith
   apply (simp add:word_bits_def objBitsKO_bounded_low)
  apply (simp add:of_nat_inj32)
  done

lemma createNewCaps_distinct:
  "\<lbrace>K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv s. distinct_prop (\<lambda>x y. \<not> RetypeDecls_H.sameRegionAs x y \<and> \<not> RetypeDecls_H.sameRegionAs y x)
                  (map snd (zip xs rv))\<rbrace>"
  apply (rule hoare_gen_asm[where P'=\<top>, simplified pred_and_true_var])
  apply (rule hoare_strengthen_post)
   apply (rule hoare_pre)
    apply (rule hoare_vcg_conj_lift)
     apply (rule createNewCaps_range_helper)
    apply (rule createNewCaps_children)
   apply fastforce
  apply clarsimp
  apply (rule distinct_prop_prefixE [OF _ map_snd_zip_prefix [unfolded less_eq_list_def]])
  apply (simp add: distinct_prop_map)
  apply (rule distinct_prop_distinct)
   apply simp
  apply clarsimp
  apply (subgoal_tac "capRange (capfn (ptr_add ptr (x * 2^APIType_capBits ty us)))
                       \<inter> capRange (capfn (ptr_add ptr (y * 2 ^ APIType_capBits ty us))) = {}")
   apply (subgoal_tac "\<forall>x < n. capAligned (capfn (ptr_add ptr (x * 2 ^ APIType_capBits ty us)))")
    apply (rule conjI)
     apply (rule notI, drule sameRegionAs_capRange_Int, simp+)
     apply (simp add: Int_commute)
    apply (rule notI, drule sameRegionAs_capRange_Int, simp+)
   apply (clarsimp simp: capAligned_def ptr_add_def word_unat_power[symmetric]
                  dest!: less_two_pow_divD)
   apply (intro conjI)
    apply (rule is_aligned_add_multI [OF _ le_refl refl])
      apply ((simp add:range_cover_def word_bits_def)+)[2]
  apply (simp add: capRange_def del: Int_atLeastAtMost)
  apply (rule aligned_neq_into_no_overlap[simplified field_simps])
     apply (rule notI)
     apply (erule(3) ptr_add_distinct_helper)
      apply (simp add:range_cover_def word_bits_def)
     apply (erule range_cover.range_cover_n_le(1)
       [where 'a=32, folded word_bits_def])
    apply (clarsimp simp: ptr_add_def word_unat_power[symmetric])
    apply (rule is_aligned_add_multI[OF _ le_refl refl])
     apply (simp add:range_cover_def)
    apply (simp add:range_cover_def)
   apply (clarsimp simp: ptr_add_def word_unat_power[symmetric])
   apply (rule is_aligned_add_multI[OF _ le_refl refl])
  apply (simp add:range_cover_def)+
  done

lemma getCTE_Ex_valid:
  "\<lbrace>valid_pspace'\<rbrace> getCTE p \<lbrace>\<lambda>rv s. \<exists>s'. s' \<turnstile>' cteCap rv\<rbrace>"
  apply (rule hoare_pre)
   apply (rule hoare_strengthen_post [OF getCTE_valid_cap'])
   apply fastforce
  apply (clarsimp simp: valid_pspace'_def)
  done

lemma createNewCaps_parent_helper:
  "\<lbrace>\<lambda>s. cte_wp_at' (\<lambda>cte. cteCap cte = UntypedCap ptr_base sz idx) p s
      \<and> pspace_aligned' s \<and> pspace_distinct' s
      \<and> pspace_no_overlap' ptr sz s
      \<and> (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> 0 < us)
      \<and> range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n \<and> ptr_base = ptr && ~~ mask sz \<rbrace>
    createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                       (\<forall>tup\<in>set (zip (xs rv) rv).
                                sameRegionAs (cteCap cte) (snd tup)))
    p\<rbrace>"
  apply (rule hoare_post_imp [where Q="\<lambda>rv s. \<exists>cte. cte_wp_at' (op = cte) p s
                                           \<and> isUntypedCap (cteCap cte)
                                           \<and> (\<forall>tup\<in>set (zip (xs rv) rv).
                                sameRegionAs (cteCap cte) (snd tup))"])
   apply (clarsimp elim!: cte_wp_at_weakenE')
  apply (rule hoare_pre)
  apply (wp hoare_vcg_ex_lift createNewCaps_cte_wp_at'
            set_tuple_pick createNewCaps_children)
  apply (auto simp:cte_wp_at'_def isCap_simps)
  done

lemma createNewCaps_valid_cap':
  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and>
        valid_pspace' s \<and> n \<noteq> 0 \<and>
        range_cover ptr sz (APIType_capBits ty us) n \<and>
        (ty = APIObjectType ArchTypes_H.CapTableObject \<longrightarrow> 0 < us) \<and>
        (ty = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> 4\<le> us \<and> us \<le> 30) \<and>
       ptr \<noteq> 0 \<rbrace>
    createNewCaps ty ptr n us
  \<lbrace>\<lambda>r s. \<forall>cap\<in>set r. s \<turnstile>' cap\<rbrace>"
  apply (rule hoare_assume_pre)
  apply clarsimp
  apply (erule createNewCaps_valid_cap)
  apply simp+
  done

lemma dmo_ctes_of[wp]:
  "\<lbrace>\<lambda>s. P (ctes_of s)\<rbrace> doMachineOp mop \<lbrace>\<lambda>rv s. P (ctes_of s)\<rbrace>"
  by (simp add: doMachineOp_def split_def | wp select_wp)+

lemma createNewCaps_ranges:
  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0<n \<rbrace>
  createNewCaps ty ptr n us
  \<lbrace>\<lambda>rv s. distinct_sets (map capRange rv)\<rbrace>"
  apply (rule hoare_assume_pre)
  apply (rule hoare_chain)
    apply (rule createNewCaps_range_helper)
   apply fastforce
  apply (clarsimp simp: distinct_sets_prop distinct_prop_map)
  apply (rule distinct_prop_distinct)
   apply simp
  apply (clarsimp simp: capRange_def simp del: Int_atLeastAtMost
                  dest!: less_two_pow_divD)
  apply (rule aligned_neq_into_no_overlap[simplified field_simps])
     apply (rule notI)
     apply (erule(3) ptr_add_distinct_helper)
      apply (simp add:range_cover_def word_bits_def)
     apply (erule range_cover.range_cover_n_le(1)
       [where 'a=32, folded word_bits_def])
    apply (clarsimp simp: ptr_add_def word_unat_power[symmetric])
    apply (rule is_aligned_add_multI[OF _ le_refl refl])
     apply (simp add:range_cover_def)+
   apply (clarsimp simp: ptr_add_def word_unat_power[symmetric])
   apply (rule is_aligned_add_multI[OF _ le_refl refl])
  apply (simp add:range_cover_def)+
  done

lemma createNewCaps_ranges':
  "\<lbrace>\<lambda>s. range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n\<rbrace>
  createNewCaps ty ptr n us
  \<lbrace>\<lambda>rv s. distinct_sets (map capRange (map snd (zip xs rv)))\<rbrace>"
  apply (rule hoare_strengthen_post)
   apply (rule createNewCaps_ranges)
  apply (simp add: distinct_sets_prop del: map_map)
  apply (erule distinct_prop_prefixE)
  apply (rule map_prefixeqI)
  apply (rule map_snd_zip_prefix [unfolded less_eq_list_def])
  done

lemmas corres_split_retype_createNewCaps
   = corres_split [OF _ corres_retype_region_createNewCaps,
                   simplified bind_assoc, simplified]

crunch cte_wp_at[wp]: do_machine_op "\<lambda>s. P (cte_wp_at P' p s)"

lemma retype_region_caps_overlap_reserved:
  "\<lbrace>valid_pspace and valid_mdb and
    pspace_no_overlap ptr sz and caps_no_overlap ptr sz and
    caps_overlap_reserved
      {ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
    K (APIType_map2 (Inr ao') = Invariants_AI.CapTableObject \<longrightarrow> 0 < us) and
    K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n) and
    K (S \<subseteq> {ptr..ptr + of_nat n *
                  2 ^ obj_bits_api (APIType_map2 (Inr ao')) us - 1})\<rbrace>
   retype_region ptr n us (APIType_map2 (Inr ao'))
   \<lbrace>\<lambda>rv s. caps_overlap_reserved S s\<rbrace>"
  apply (rule hoare_gen_asm)+
  apply (simp (no_asm) add:caps_overlap_reserved_def2)
  apply (rule hoare_pre)
  apply (wp retype_region_caps_of)
   apply simp+
  apply (simp add:caps_overlap_reserved_def2)
  apply (intro conjI,simp+)
  apply clarsimp
  apply (drule bspec)
   apply simp+
  apply (erule(1) disjoint_subset2)
  done

lemma retype_region_caps_overlap_reserved_ret:
  "\<lbrace>valid_pspace and valid_mdb and caps_no_overlap ptr sz and
    pspace_no_overlap ptr sz and
    caps_overlap_reserved
      {ptr..ptr + of_nat n * 2^obj_bits_api (APIType_map2 (Inr ao')) us - 1} and
    K (APIType_map2 (Inr ao') = Invariants_AI.CapTableObject \<longrightarrow> 0 < us) and
    K (range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) n)\<rbrace>
   retype_region ptr n us (APIType_map2 (Inr ao'))
   \<lbrace>\<lambda>rv s. \<forall>y\<in>set rv. caps_overlap_reserved (untyped_range (default_cap
                            (APIType_map2 (Inr ao')) y us)) s\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp:valid_def)
  apply (frule retype_region_ret[unfolded valid_def,simplified,THEN spec,THEN bspec])
  apply clarsimp
  apply (erule use_valid[OF _ retype_region_caps_overlap_reserved])
  apply clarsimp
  apply (intro conjI,simp_all)
  apply (case_tac ao')
        apply (simp_all add:APIType_map2_def)
  apply (rename_tac apiobject_type)
  apply (case_tac apiobject_type)
      apply (simp_all add:obj_bits_api_def ptr_add_def)
  apply (drule(1) range_cover_subset)
   apply clarsimp+
  done

lemma getObjectSize_def_eq:
  "Types_H.getObjectSize va us = obj_bits_api (APIType_map2 (Inr va)) us"
  apply (case_tac va)
        apply (rename_tac apiobject_type)
        apply (case_tac apiobject_type)
            apply (clarsimp simp: getObjectSize_def apiGetObjectSize_def APIType_map2_def
                                  ArchTypes_H.getObjectSize_def obj_bits_api_def tcbBlockSizeBits_def
                                  epSizeBits_def ntfnSizeBits_def cteSizeBits_def slot_bits_def
                                  arch_kobj_size_def default_arch_object_def ptBits_def pageBits_def
                                  pdBits_def)+
  done

lemma updateFreeIndex_pspace_no_overlap':
  "\<lbrace>\<lambda>s. pspace_no_overlap' ptr sz s \<and>
        valid_pspace' s \<and> cte_wp_at' (\<lambda>c. cteCap c = cap) src s\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. pspace_no_overlap' ptr sz s\<rbrace>"
  apply (rule hoare_pre)
   apply (wp pspace_no_overlap'_lift)
  apply (clarsimp simp:valid_pspace'_def)
  done

lemma updateFreeIndex_caps_overlap_reserved':
  "\<lbrace>\<lambda>s. invs' s \<and> S \<subseteq> untypedRange cap \<and>
        usableUntypedRange (capFreeIndex_update (\<lambda>_. index) cap) \<inter> S = {} \<and>
        isUntypedCap cap \<and> descendants_range_in' S src (ctes_of s) \<and>
        cte_wp_at' (\<lambda>c. cteCap c = cap) src s\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. caps_overlap_reserved' S s\<rbrace>"
  apply (clarsimp simp:caps_overlap_reserved'_def)
  apply (wp updateCap_ctes_of_wp)
  apply (clarsimp simp:modify_map_def cte_wp_at_ctes_of)
  apply (erule ranE)
  apply (frule invs_mdb')
  apply (clarsimp split:split_if_asm simp:valid_mdb'_def valid_mdb_ctes_def)
  apply (case_tac cte)
  apply (case_tac ctea)
  apply simp
  apply (drule untyped_incD')
      apply (simp+)[4]
  apply clarify
  apply (erule subset_splitE)
     apply (simp del:usable_untyped_range.simps)
     apply (thin_tac "P \<longrightarrow> Q" for P Q)+
     apply (elim conjE)
     apply blast
    apply (simp)
    apply (thin_tac "P\<longrightarrow>Q" for P Q)+
    apply (elim conjE)
    apply (drule(2) descendants_range_inD')
    apply simp
    apply (rule disjoint_subset[OF usableRange_subseteq])
      apply (rule valid_capAligned)
      apply (erule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
     apply (simp add:untypedCapRange)+
   apply (elim disjE)
    apply clarsimp
    apply (drule(2) descendants_range_inD')
    apply simp
    apply (rule disjoint_subset[OF usableRange_subseteq])
      apply (rule valid_capAligned)
      apply (erule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
     apply (simp add:untypedCapRange)+
  apply (thin_tac "P\<longrightarrow>Q" for P Q)+
  apply (rule disjoint_subset[OF usableRange_subseteq])
    apply (rule valid_capAligned)
    apply (erule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
   apply simp+
  apply blast
  done

lemma updateFreeIndex_caps_no_overlap'':
  "\<lbrace>\<lambda>s. isUntypedCap cap \<and> caps_no_overlap'' ptr sz s \<and>
        cte_wp_at' (\<lambda>c. cteCap c = cap) src s\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. caps_no_overlap'' ptr sz s\<rbrace>"
  apply (clarsimp simp:caps_no_overlap''_def)
  apply (wp updateCap_ctes_of_wp)
  apply (clarsimp simp: modify_map_def ran_def cte_wp_at_ctes_of
              simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
                        Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
  apply (case_tac "a = src")
   apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
   apply (erule subsetD[rotated])
   apply (elim allE impE)
     apply fastforce
    apply (clarsimp simp:isCap_simps)
   apply (erule subset_trans)
   apply (clarsimp simp:isCap_simps)
  apply (clarsimp simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
     Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex)
   apply (erule subsetD[rotated])
  apply (elim allE impE)
   prefer 2
    apply assumption
  apply fastforce+
  done

lemma updateCap_ct_active':
  "\<lbrace>ct_active'\<rbrace> updateCap slot newCap \<lbrace>\<lambda>_. ct_active'\<rbrace>"
apply (simp add: updateCap_def ct_in_state'_def)
apply wp
apply (wps setCTE_ct)
apply (wp setCTE_pred_tcb_at')
done

(* FIXME: move to CSpace_R *)
lemma mdb_preserve_refl: "mdb_inv_preserve m m"
  by (simp add:mdb_inv_preserve_def)

(* FIXME: move to CSpace_R *)
lemma mdb_preserve_sym: "mdb_inv_preserve m m' \<Longrightarrow> mdb_inv_preserve m' m"
  by (simp add:mdb_inv_preserve_def)

lemma updateFreeIndex_descendants_of':
  "\<lbrace>\<lambda>s. cte_wp_at' (\<lambda>c. cteCap c = cap) ptr s \<and> isUntypedCap cap \<and>
        P ((swp descendants_of') (null_filter' (ctes_of s)))\<rbrace>
   updateCap ptr (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. P ((swp descendants_of') (null_filter' (ctes_of s)))\<rbrace>"
  apply (wp updateCap_ctes_of_wp)
  apply clarsimp
  apply (erule subst[rotated,where P = P])
  apply (rule ext)
  apply (clarsimp simp:null_filter_descendants_of'[OF null_filter_simp'])
  apply (rule mdb_inv_preserve.descendants_of)
  apply (clarsimp simp:cte_wp_at_ctes_of)
  apply (erule(1) mdb_inv_preserve_updateCap)
  done

lemma updateFreeIndex_descendants_range_in':
  "\<lbrace>\<lambda>s. cte_wp_at' (\<lambda>c. cteCap c = cap) slot s \<and> isUntypedCap cap \<and>
        descendants_range_in' S slot (ctes_of s)\<rbrace>
   updateCap slot (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. descendants_range_in' S slot (ctes_of s)\<rbrace>"
  apply (rule hoare_pre)
   apply (wp descendants_range_in_lift'
     [where Q'="\<lambda>s. cte_wp_at' (\<lambda>c. cteCap c = cap) slot s \<and> isUntypedCap cap" and
       Q = "\<lambda>s. cte_wp_at' (\<lambda>c. cteCap c = cap) slot s \<and> isUntypedCap cap "] )
    apply (wp updateFreeIndex_descendants_of')
    apply (elim conjE)
   apply (intro conjI,assumption+)
   apply clarsimp
  apply (simp add:updateCap_def)
  apply (wp setCTE_weak_cte_wp_at getCTE_wp)
   apply (fastforce simp:cte_wp_at_ctes_of isCap_simps)
  apply (clarsimp)
  done

lemma caps_no_overlap''_def2:
  "caps_no_overlap'' ptr sz =
   (\<lambda>s. \<forall>cte\<in>ran (null_filter' (ctes_of s)).
            untypedRange (cteCap cte) \<inter>
            {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1} \<noteq> {} \<longrightarrow>
            {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1} \<subseteq>
            untypedRange (cteCap cte))"
  apply (intro ext iffI)
    apply (clarsimp simp:caps_no_overlap''_def null_filter'_def ran_def)
    apply (drule_tac x = cte in spec)
    apply fastforce
  apply (clarsimp simp:caps_no_overlap''_def null_filter'_def)
  apply (case_tac "cte = CTE capability.NullCap nullMDBNode")
   apply clarsimp
  apply (drule_tac x = cte in  bspec)
   apply (clarsimp simp:ran_def)
   apply (rule_tac x= a in exI)
   apply clarsimp
  apply clarsimp
  apply (erule subsetD)
  apply simp
  done

lemma caps_no_overlapI'':
  "\<lbrakk>cte_wp_at' (\<lambda>c. cteCap c = capability.UntypedCap ptr_base sz idx) slot s;
    valid_pspace' s;idx < 2^sz;ptr = ptr_base + of_nat idx\<rbrakk>
   \<Longrightarrow> caps_no_overlap'' ptr sz s"
  apply (unfold caps_no_overlap''_def)
  apply (intro ballI impI)
  apply (erule ranE)
  apply (subgoal_tac "isUntypedCap (cteCap cte)")
   apply (clarsimp simp:cte_wp_at_ctes_of
          simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff )
   apply (case_tac cte,case_tac ctea)
   apply clarify
   apply (drule untyped_incD')
      apply (simp add:isCap_simps)+
    apply (clarsimp simp:valid_pspace'_def valid_mdb'_def valid_mdb_ctes_def)
   apply (clarsimp simp:cte_wp_at_ctes_of valid_pspace'_def valid_cap'_def capAligned_def
                        of_nat_less_pow is_aligned_add_helper
          simp del: atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff
          dest!:ctes_of_valid_cap')
   apply (erule subset_splitE)
       apply (simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff)+
     apply (erule subsetD[OF psubset_imp_subset])
     apply (erule subsetD[rotated])
     apply clarsimp
     apply (erule is_aligned_no_wrap')
     apply (simp add:of_nat_less_pow)
    apply (simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
        Int_atLeastAtMost atLeastatMost_empty_iff)+
    apply (erule subsetD[rotated])
    apply clarsimp
    apply (erule is_aligned_no_wrap')
    apply (simp add:of_nat_less_pow)
   apply (thin_tac "P \<longrightarrow> Q" for P Q)+
   apply (drule disjoint_subset2[rotated,where B'="{ptr_base + of_nat idx..ptr_base + 2 ^ sz - 1}"])
    apply clarsimp
    apply (erule is_aligned_no_wrap')
    apply (simp add:of_nat_less_pow)
   apply simp
  apply (case_tac "cteCap cte")
  apply (simp_all add:isCap_simps)
  done

lemma caps_no_overlap'_def2:
  "caps_no_overlap' =
   (\<lambda>ms S. \<forall>p c. (\<exists>n. (null_filter' ms) p = Some (CTE c n)) \<longrightarrow>
                 capRange c \<inter> S = {})"
  apply (intro iffI ext allI)
  apply (clarsimp simp:caps_no_overlap'_def null_filter'_def
    dest!:bspec split:if_splits)+
  apply (drule_tac x = p in spec)
  apply auto
  done

lemma deleteObjects_caps_no_overlap'':
  "\<lbrace>\<lambda>s. invs' s \<and> ct_active' s \<and> sch_act_simple s \<and>
        cte_wp_at' (\<lambda>c. cteCap c = capability.UntypedCap ptr sz idx) slot s \<and>
        caps_no_overlap'' ptr sz s \<and>
        descendants_range' (capability.UntypedCap ptr sz idx) slot (ctes_of s)\<rbrace>
   deleteObjects ptr sz
   \<lbrace>\<lambda>rv s. caps_no_overlap'' ptr sz s\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp split:if_splits)
  apply (clarsimp simp:caps_no_overlap''_def2 deleteObjects_def2 capAligned_def valid_cap'_def
    dest!:ctes_of_valid_cap')
  apply (wp deleteObjects_null_filter[where idx = idx and p = slot])
  apply (clarsimp simp:cte_wp_at_ctes_of invs_def)
  apply (case_tac cte)
  apply clarsimp
  apply (frule ctes_of_valid_cap')
   apply (simp add:invs_valid_objs')
  apply (simp add:valid_cap'_def capAligned_def)
  done

lemma descendants_range_in_subseteq':
  "\<lbrakk>descendants_range_in' A p ms ;B\<subseteq> A\<rbrakk> \<Longrightarrow> descendants_range_in' B p ms"
  by (auto simp:descendants_range_in'_def cte_wp_at_ctes_of dest!:bspec)

lemma deleteObjects_caps_overlap_reserved':
  "\<lbrace>\<lambda>s. valid_pspace' s \<and>
        cte_wp_at' (\<lambda>c. cteCap c = capability.UntypedCap ptr sz idx) slot s \<and>
        caps_overlap_reserved' S s\<rbrace>
   deleteObjects ptr sz
   \<lbrace>\<lambda>rv s. caps_overlap_reserved' S s\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp: cte_wp_at_ctes_of valid_pspace'_def isCap_simps capAligned_def)
  apply (case_tac cte)
  apply (clarsimp simp: caps_no_overlap''_def deleteObjects_def2 capAligned_def valid_cap'_def
                  dest!: ctes_of_valid_cap')
  apply (wp hoare_drop_imps)+
   apply (rule_tac Q = "\<lambda>r. caps_overlap_reserved' S and pspace_distinct' and Q" for Q in  hoare_strengthen_post)
    prefer 2
    apply (cut_tac s = sa in  map_to_ctes_delete[where base = ptr and magnitude = sz and idx = idx])
      apply clarsimp
      apply assumption
     apply simp
    apply (simp add:valid_cap'_def capAligned_def p_assoc_help caps_overlap_reserved'_def)+
    apply (intro ballI)
    apply (erule ranE)
    apply (fastforce split:if_splits)
   apply (clarsimp simp:caps_overlap_reserved'_def2)
   apply wp
    apply (clarsimp simp:caps_overlap_reserved'_def2 valid_cap'_def capAligned_def)+
  done

lemma updateFreeIndex_mdb_simple':
  "\<lbrace>\<lambda>s. descendants_range_in' (capRange cap) src (ctes_of s) \<and>
        pspace_no_overlap' (capPtr cap) (capBlockSize cap) s \<and>
        valid_pspace' s \<and> cte_wp_at' (\<lambda>c. cteCap c = cap) src s \<and>
        isUntypedCap cap\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. idx) cap)
   \<lbrace>\<lambda>rv. valid_mdb'\<rbrace>"
  apply (clarsimp simp:valid_mdb'_def updateCap_def valid_pspace'_def)
  apply (wp getCTE_wp)
  apply (clarsimp simp:cte_wp_at_ctes_of simp del:fun_upd_apply)
  apply (subgoal_tac
    "mdb_inv_preserve (ctes_of s)
    (ctes_of s(src \<mapsto> cteCap_update (\<lambda>_. capFreeIndex_update (\<lambda>_. idx) (cteCap cte)) cte))")
  prefer 2
    apply (frule mdb_inv_preserve_updateCap)
     apply (simp add: modify_map_apply)+
    apply (clarsimp simp:valid_mdb_ctes_def mdb_inv_preserve.preserve_stuff mdb_inv_preserve.by_products)
  apply (clarsimp simp:isCap_simps)
  proof -
  fix s cte v0 v1 f
  assume descendants_range: "descendants_range_in' {v0..v0 + 2 ^ v1 - 1} src (ctes_of s)"
  and    cte_wp_at' :"ctes_of s src = Some cte" "cteCap cte = capability.UntypedCap v0 v1 f"
  and      unt_inc' :"untyped_inc' (ctes_of s)"
  and   valid_objs' :"valid_objs' s"
  have descendants_of_simp:
    "\<And>p. descendants_of' p  (ctes_of s(src \<mapsto> cteCap_update (\<lambda>_. capability.UntypedCap v0 v1 idx) cte))
    = descendants_of' p (ctes_of s)"
    using cte_wp_at'
    apply -
    apply (drule updateUntypedCap_descendants_of)
      apply (clarsimp simp:isCap_simps)+
    apply simp
    done
  note drangeD = descendants_range_inD'[OF descendants_range]
  note valid_capD = ctes_of_valid_cap'[OF _ valid_objs']
  note blah[simp del] = usableUntypedRange.simps atLeastAtMost_iff
          atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex
          order_class.Icc_eq_Icc
  show  "untyped_inc' (ctes_of s(src \<mapsto> cteCap_update (\<lambda>_. capability.UntypedCap v0 v1 idx) cte))"
  using unt_inc' cte_wp_at'
  apply (clarsimp simp:untyped_inc'_def descendants_of_simp)
  apply (case_tac cte)
  apply clarsimp
  apply (intro conjI)
    apply clarsimp
    apply (drule_tac x = src in spec)
    apply (drule_tac x = p' in spec)
    apply (clarsimp simp: isCap_simps)
    apply (intro conjI impI)
       apply simp
       apply (elim conjE)
       apply (thin_tac "P\<longrightarrow>Q" for P Q)+
       apply (drule(1) drangeD)
       apply (drule valid_capAligned[OF valid_capD])+
       apply (drule aligned_untypedRange_non_empty,simp add:isCap_simps)+
       apply simp
       apply blast
    apply clarsimp
    apply (drule(1) drangeD)
    apply (drule valid_capAligned[OF valid_capD])+
    apply (drule aligned_untypedRange_non_empty,simp add:isCap_simps)+
    apply simp
  apply clarsimp
  apply (drule_tac x = src in spec)
  apply (drule_tac x = p in spec)
  apply (clarsimp simp:isCap_simps)
  apply (intro conjI impI)
    apply (elim disjE)
      apply (simp add:Int_ac)+
   apply (thin_tac "P\<longrightarrow>Q" for P Q)+
   apply (elim conjE)
   apply (drule(1) drangeD)
   apply (drule valid_capAligned[OF valid_capD])+
   apply (drule aligned_untypedRange_non_empty,simp add:isCap_simps)+
   apply simp
   apply blast
  apply simp
  apply (elim disjE conjE,simp_all)
  apply (drule(1) drangeD)
  apply (drule valid_capAligned[OF valid_capD])+
  apply (drule aligned_untypedRange_non_empty,simp add:isCap_simps)+
  apply simp
  done
qed

lemma updateFreeIndex_pspace_simple':
  "\<lbrace>\<lambda>s. descendants_range_in' (capRange cap) src (ctes_of s) \<and>
        pspace_no_overlap' (capPtr cap) (capBlockSize cap) s \<and>
        valid_pspace' s \<and> cte_wp_at' (\<lambda>c. cteCap c = cap) src s \<and>
        isUntypedCap cap \<and> is_aligned (of_nat idx :: word32) 4 \<and>
        idx \<le> 2 ^ (capBlockSize cap)\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. idx) cap)
   \<lbrace>\<lambda>r s. valid_pspace' s\<rbrace>"
   apply (clarsimp simp:valid_pspace'_def)
   apply (rule hoare_pre)
    apply (rule hoare_vcg_conj_lift)
     apply (clarsimp simp:updateCap_def)
     apply (wp getCTE_wp)
    apply (wp updateFreeIndex_mdb_simple')
    apply (simp)+
  apply (clarsimp simp:cte_wp_at_ctes_of valid_pspace'_def)
  apply (case_tac cte,simp add:isCap_simps)
  apply (frule(1) ctes_of_valid_cap')
  apply (clarsimp simp:valid_cap'_def capAligned_def valid_untyped'_def
          simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff usableUntypedRange.simps
          split del:if_splits)
  apply (drule_tac x = ptr' in spec)
  apply (clarsimp simp:ko_wp_at'_def valid_mdb'_def obj_range'_def valid_mdb_ctes_def
          simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff usableUntypedRange.simps
          split del:if_splits)
  apply (drule(1) pspace_no_overlapD')
  apply (cut_tac c' = "capability.UntypedCap v0 v1 idx" in usableRange_subseteq)
    apply (simp add:capAligned_def)
   apply (simp add:isCap_simps)
  apply (clarsimp simp:ko_wp_at'_def valid_mdb'_def is_aligned_neg_mask is_aligned_neg_mask_eq
          simp del:atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff usableUntypedRange.simps)
  apply blast
  done

lemma updateCap_vms'[wp]:
  "\<lbrace>valid_machine_state'\<rbrace> updateCap src cap' \<lbrace>\<lambda>rv s. valid_machine_state' s\<rbrace>"
  by (clarsimp simp:updateCap_def,wp)

(* FIXME: move *)
lemma setCTE_tcbDomain_inv[wp]:
  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbState tcb)) t\<rbrace> setCTE ptr v \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbState tcb)) t\<rbrace>"
  apply (simp add: setCTE_def)
  apply (rule setObject_cte_obj_at_tcb', simp_all)
  done

(* FIXME: move *)
crunch tcbState_inv[wp]: cteInsert "obj_at' (\<lambda>tcb. P (tcbState tcb)) t"
  (wp: crunch_simps hoare_drop_imps)

lemma updateCap_ct_idle_or_in_cur_domain'[wp]:
  "\<lbrace>ct_idle_or_in_cur_domain' and ct_active'\<rbrace> updateCap src cap \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
apply (wp ct_idle_or_in_cur_domain'_lift_futz[where Q=\<top>])
apply (rule_tac Q="\<lambda>_. obj_at' (\<lambda>tcb. tcbState tcb \<noteq> Structures_H.thread_state.Inactive) t and obj_at' (\<lambda>tcb. d = tcbDomain tcb) t"
             in hoare_strengthen_post)
apply (wp | clarsimp elim: obj_at'_weakenE)+
apply (auto simp: obj_at'_def)
done

lemma updateFreeIndex_invs_simple':
  "\<lbrace>\<lambda>s. ct_active' s \<and> descendants_range_in' (capRange cap) src (ctes_of s) \<and>
        pspace_no_overlap' (capPtr cap) (capBlockSize cap) s \<and> invs' s \<and>
        cte_wp_at' (\<lambda>c. cteCap c = cap) src s \<and> isUntypedCap cap \<and>
        is_aligned (of_nat index :: word32) 4 \<and> index \<le> 2 ^ capBlockSize cap\<rbrace>
   updateCap src (capFreeIndex_update (\<lambda>_. index) cap)
   \<lbrace>\<lambda>r s. invs' s\<rbrace>"
   apply (clarsimp simp:invs'_def valid_state'_def )
   apply (wp updateFreeIndex_pspace_simple' sch_act_wf_lift valid_queues_lift updateCap_iflive' tcb_in_cur_domain'_lift)
        apply (rule hoare_pre)
         apply (rule hoare_vcg_conj_lift)
         apply (simp add: ifunsafe'_def3 cteInsert_def setUntypedCapAsFull_def
               split del: split_if)
         apply (wp getCTE_wp)
       apply (rule hoare_vcg_conj_lift)
        apply (simp add:updateCap_def)
        apply wp
       apply (wp valid_irq_node_lift)
       apply (rule hoare_vcg_conj_lift)
        apply (simp add:updateCap_def)
        apply (wp setCTE_irq_handlers' getCTE_wp)
       apply (wp irqs_masked_lift valid_queues_lift' cur_tcb_lift)
      apply (clarsimp simp:cte_wp_at_ctes_of)
      apply (intro conjI allI impI)
         apply (clarsimp simp: modify_map_def cteCaps_of_def ifunsafe'_def3 split:if_splits)
          apply (drule_tac x=src in spec)
          apply (clarsimp simp:isCap_simps)
          apply (rule_tac x = cref' in exI)
          apply clarsimp
         apply (drule_tac x = cref in spec)
         apply clarsimp
         apply (rule_tac x = cref' in exI)
         apply clarsimp
        apply (drule(1) valid_global_refsD_with_objSize)
        apply (clarsimp simp: isCap_simps)
       apply (drule(1) valid_global_refsD_with_objSize)
  apply (clarsimp simp:isCap_simps cte_wp_at_ctes_of)+
  done

lemma cte_wp_at_pspace_no_overlapI':
  "\<lbrakk>invs' s; cte_wp_at' (\<lambda>c. cteCap c = capability.UntypedCap
                                          (ptr && ~~ mask sz) sz idx) cref s;
    idx \<le> unat (ptr && mask sz); sz < word_bits\<rbrakk>
   \<Longrightarrow> pspace_no_overlap' ptr sz s"
  apply (clarsimp simp:cte_wp_at_ctes_of)
  apply (case_tac cte,clarsimp)
  apply (frule ctes_of_valid_cap')
    apply (simp add:invs_valid_objs')
  apply (clarsimp simp:valid_cap'_def invs'_def valid_state'_def valid_pspace'_def
    valid_untyped'_def simp del:usableUntypedRange.simps)
  apply (unfold pspace_no_overlap'_def)
  apply (intro allI impI)
  apply (unfold ko_wp_at'_def)
  apply (clarsimp simp del: atLeastAtMost_iff
          atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff  usableUntypedRange.simps)
  apply (drule spec)+
  apply (frule(1) pspace_distinctD')
  apply (frule(1) pspace_alignedD')
  apply (erule(1) impE)+
  apply (clarsimp simp: obj_range'_def simp del: atLeastAtMost_iff
          atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff  usableUntypedRange.simps)
  apply (erule disjoint_subset2[rotated])
  apply (frule(1) le_mask_le_2p)
  apply (clarsimp simp:p_assoc_help)
  apply (rule le_plus'[OF word_and_le2])
  apply simp
  apply (erule word_of_nat_le)
  done

lemma descendants_range_caps_no_overlapI':
  "\<lbrakk>invs' s; cte_wp_at' (\<lambda>c. cteCap c = capability.UntypedCap
                                          (ptr && ~~ mask sz) sz idx) cref s;
    descendants_range_in' {ptr .. (ptr && ~~ mask sz) +2^sz - 1} cref
                          (ctes_of s)\<rbrakk>
   \<Longrightarrow> caps_no_overlap'' ptr sz s"
  apply (frule invs_mdb')
  apply (clarsimp simp:valid_mdb'_def valid_mdb_ctes_def cte_wp_at_ctes_of
         simp del:usableUntypedRange.simps untypedRange.simps)
  apply (unfold caps_no_overlap''_def)
  apply (intro ballI impI)
  apply (erule ranE)
  apply (subgoal_tac "isUntypedCap (cteCap ctea)")
  prefer 2
   apply (rule untypedRange_not_emptyD)
    apply blast
  apply (case_tac ctea,case_tac cte)
  apply simp
  apply (drule untyped_incD')
     apply ((simp add:isCap_simps del:usableUntypedRange.simps untypedRange.simps)+)[4]
  apply (elim conjE subset_splitE)
     apply (erule subset_trans[OF _ psubset_imp_subset,rotated])
     apply (clarsimp simp:word_and_le2)
    apply simp
    apply (elim conjE)
    apply (thin_tac "P\<longrightarrow>Q" for P Q)+
    apply (drule(2) descendants_range_inD')
    apply (simp add:untypedCapRange)+
   apply (erule subset_trans[OF _  equalityD1,rotated])
   apply (clarsimp simp:word_and_le2)
  apply (thin_tac "P\<longrightarrow>Q" for P Q)+
  apply (drule disjoint_subset[rotated,
       where A' = "{ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}"])
  apply (clarsimp simp:word_and_le2 Int_ac)+
  done

lemma cte_wp_at_caps_no_overlapI':
  "\<lbrakk>invs' s; cte_wp_at' (\<lambda>c. (cteCap c) = capability.UntypedCap
                                            (ptr && ~~ mask sz) sz idx) cref s;
    idx \<le> unat (ptr && mask sz); sz < word_bits\<rbrakk>
   \<Longrightarrow> caps_no_overlap'' ptr sz s"
  apply (frule invs_mdb')
  apply (frule(1) le_mask_le_2p)
  apply (clarsimp simp:valid_mdb'_def valid_mdb_ctes_def cte_wp_at_ctes_of)
  apply (case_tac cte)
  apply simp
  apply (frule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
  apply (unfold caps_no_overlap''_def)
  apply (intro ballI impI)
  apply (erule ranE)
  apply (subgoal_tac "isUntypedCap (cteCap ctea)")
  prefer 2
   apply (rule untypedRange_not_emptyD)
   apply blast
  apply (case_tac ctea)
  apply simp
  apply (drule untyped_incD')
     apply (simp add:isCap_simps)+
  apply (elim conjE)
  apply (erule subset_splitE)
      apply (erule subset_trans[OF _ psubset_imp_subset,rotated])
       apply (clarsimp simp: word_and_le2)
     apply simp
     apply (thin_tac "P\<longrightarrow>Q" for P Q)+
     apply (elim conjE)
     apply (drule disjoint_subset2[rotated,
       where B' = "{ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}"])
      apply clarsimp
      apply (rule le_plus'[OF word_and_le2])
      apply simp
      apply (erule word_of_nat_le)
     apply simp
    apply simp
   apply (erule subset_trans[OF _  equalityD1,rotated])
   apply (clarsimp simp:word_and_le2)
  apply (thin_tac "P\<longrightarrow>Q" for P Q)+
  apply (drule disjoint_subset[rotated,
       where A' = "{ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}"])
  apply (clarsimp simp:word_and_le2 Int_ac)+
  done


lemma descendants_range_ex_cte':
  "\<lbrakk>descendants_range_in' S p (ctes_of s');ex_cte_cap_wp_to' P q s'; S \<subseteq> capRange (cteCap cte);
    invs' s';ctes_of s' p = Some cte;isUntypedCap (cteCap cte)\<rbrakk> \<Longrightarrow> q \<notin> S"
   apply (frule invs_valid_objs')
   apply (frule invs_mdb')
   apply (clarsimp simp:invs'_def valid_state'_def)
   apply (clarsimp simp: ex_cte_cap_to'_def cte_wp_at_ctes_of)
    apply (frule_tac cte = "cte" in  valid_global_refsD')
    apply simp
   apply (case_tac "\<exists>irq. cteCap ctea = IRQHandlerCap irq")
     apply clarsimp
   apply (erule(1) in_empty_interE[OF _ _ subsetD,rotated -1])
     apply (clarsimp simp:global_refs'_def)
     apply (erule_tac A = "range P" for P in subsetD)
     apply (simp add:range_eqI field_simps)
   apply (case_tac ctea)
   apply clarsimp
  apply (case_tac ctea)
  apply (drule_tac cte = "cte" and cte' = ctea in untyped_mdbD')
       apply assumption
      apply (clarsimp simp:isCap_simps)
     apply (drule_tac B = "untypedRange (cteCap cte)" in subsetD[rotated])
      apply (clarsimp simp:untypedCapRange)
     apply clarsimp
     apply (drule_tac x = " (irq_node' s')" in cte_refs_capRange[rotated])
      apply (erule(1) ctes_of_valid_cap')
     apply blast
   apply (clarsimp simp:isCap_simps)
  apply (simp add:valid_mdb'_def valid_mdb_ctes_def)
  apply (drule(2) descendants_range_inD')
  apply clarsimp
  apply (drule_tac x = " (irq_node' s')" in cte_refs_capRange[rotated])
   apply (erule(1) ctes_of_valid_cap')
  apply blast
  done

lemma update_untyped_cap_corres:
  "\<lbrakk>is_untyped_cap cap; isUntypedCap cap'; cap_relation cap cap'\<rbrakk>
   \<Longrightarrow> corres dc
         (cte_wp_at (\<lambda>c. is_untyped_cap c \<and> obj_ref_of c = obj_ref_of cap \<and>
          cap_bits c = cap_bits cap) src and valid_objs and
          pspace_aligned and pspace_distinct)
         (cte_at' (cte_map src) and pspace_distinct' and pspace_aligned')
         (set_cap cap src) (updateCap (cte_map src) cap')"
  apply (rule corres_name_pre)
  apply (simp add:updateCap_def)
  apply (frule state_relation_pspace_relation)
  apply (clarsimp simp:cte_wp_at_ctes_of)
  apply (frule pspace_relation_cte_wp_atI)
    apply (fastforce simp:cte_wp_at_ctes_of)
   apply simp
  apply clarify
  apply (frule cte_map_inj_eq)
       apply (fastforce simp:cte_wp_at_ctes_of cte_wp_at_caps_of_state)+
  apply (clarsimp simp:isCap_simps is_cap_simps)
  apply (rule corres_guard_imp)
    apply (rule corres_symb_exec_r)
      apply (rule_tac F = "cteCap_update (\<lambda>_. capability.UntypedCap r bits f) ctea
        = cteCap_update (\<lambda>cap. capFreeIndex_update (\<lambda>_. f) (cteCap cte)) cte" in corres_gen_asm2)
       apply (rule_tac F = " (cap.UntypedCap r bits f) = free_index_update (\<lambda>_. f) c"
                      in corres_gen_asm)
       apply simp
       apply (rule set_untyped_cap_corres)
         apply (clarsimp simp:cte_wp_at_caps_of_state cte_wp_at_ctes_of)+
      apply (subst identity_eq)
      apply (wp getCTE_sp getCTE_get)
    apply (rule no_fail_pre[OF no_fail_getCTE])
    apply (clarsimp simp:cte_wp_at_ctes_of cte_wp_at_caps_of_state)+
  done


locale invokeUntyped_proofs =
 fixes s cref ptr tp us slots sz idx
    assumes cte_wp_at': "cte_wp_at' (\<lambda>cte. cteCap cte = capability.UntypedCap (ptr && ~~ mask sz) sz idx) cref s"
    assumes cover     : "range_cover ptr sz (APIType_capBits tp us) (length (slots::word32 list))"
    assumes  misc     : "distinct slots" "idx \<le> unat (ptr && mask sz) \<or> ptr = ptr && ~~ mask sz"
      "invs' s" "slots \<noteq> []"
      "\<forall>slot\<in>set slots. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) slot s"
      "\<forall>x\<in>set slots. ex_cte_cap_wp_to' (\<lambda>_. True) x s"
    assumes desc_range: "ptr = ptr && ~~ mask sz \<longrightarrow> descendants_range_in' {ptr..ptr + 2 ^ sz - 1} (cref) (ctes_of s)"
begin

abbreviation(input)
  "retype_range == {ptr..ptr + of_nat (length slots) * 2 ^ APIType_capBits tp us - 1}"

abbreviation(input)
  "usable_range ==  {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}"

   lemma not_0_ptr[simp]: "ptr\<noteq> 0"
      using misc cte_wp_at'
      apply (clarsimp simp:cte_wp_at_ctes_of)
      apply (case_tac cte)
      apply clarsimp
      apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
      apply (simp add:valid_cap'_def)
      done

   lemma subset_stuff[simp]:
      "retype_range \<subseteq> usable_range"
      apply (rule range_cover_subset'[OF cover])
      apply (simp add:misc)
      done

    lemma descendants_range[simp]:
      "descendants_range_in' usable_range cref (ctes_of s)"
      "descendants_range_in' retype_range cref (ctes_of s)"
      proof -
        have "descendants_range_in' usable_range cref (ctes_of s)"
          using misc cte_wp_at' cover
          apply -
          apply (erule disjE)
           apply (erule cte_wp_at_caps_descendants_range_inI'
             [OF _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
           apply simp+
          using desc_range
          apply simp
          done
        thus "descendants_range_in' usable_range cref (ctes_of s)"
           by simp
        thus "descendants_range_in' retype_range cref (ctes_of s)"
           by (rule descendants_range_in_subseteq'[OF _ subset_stuff])
        qed

    lemma vc'[simp] : "s \<turnstile>' capability.UntypedCap (ptr && ~~ mask sz) sz idx"
      using misc cte_wp_at'
      apply (clarsimp simp:cte_wp_at_ctes_of)
      apply (case_tac cte)
      apply clarsimp
      apply (erule ctes_of_valid_cap')
      apply (simp add:invs_valid_objs')
      done

    lemma ps_no_overlap'[simp]: "ptr && ~~ mask sz \<noteq> ptr \<Longrightarrow> pspace_no_overlap' ptr sz s"
      using misc cte_wp_at' cover
      apply clarsimp
      apply (erule(3) cte_wp_at_pspace_no_overlapI'
        [OF  _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
      done

    lemma caps_no_overlap'[simp]: "caps_no_overlap'' ptr sz s"
      using cte_wp_at' misc cover desc_range
      apply -
      apply (erule disjE)
       apply (erule cte_wp_at_caps_no_overlapI'
         [OF  _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
        apply simp+
      apply (erule descendants_range_caps_no_overlapI')
       apply simp+
      done

    lemma idx_compare'[simp]:"unat ((ptr && mask sz) + (of_nat (length slots)<< (APIType_capBits tp us))) \<le> 2 ^ sz"
      apply (rule le_trans[OF unat_plus_gt])
      apply (simp add:range_cover.unat_of_nat_n_shift[OF cover] range_cover_unat)
      apply (insert range_cover.range_cover_compare_bound[OF cover])
      apply simp
      done

    lemma ex_cte_no_overlap': "\<And>P p. ex_cte_cap_wp_to' P p s \<Longrightarrow> p \<notin> usable_range"
      using cte_wp_at' misc
      apply (clarsimp simp:cte_wp_at_ctes_of)
        apply (drule_tac cte = cte in descendants_range_ex_cte'[OF descendants_range(1)])
        apply (clarsimp simp:word_and_le2 isCap_simps)+
      done

    lemma cref_inv: "cref \<notin> usable_range"
      apply (insert misc cte_wp_at')
      apply (drule if_unsafe_then_capD')
        apply (simp add:invs'_def valid_state'_def)
       apply simp
      apply (erule ex_cte_no_overlap')
      done

    lemma slots_invD: "\<And>x. x \<in> set slots \<Longrightarrow>
      x \<noteq> cref \<and> x \<notin> usable_range \<and>  ex_cte_cap_wp_to' (\<lambda>_. True) x s"
      using misc cte_wp_at'
      apply -
      apply simp
      apply (drule(1) bspec)+
      apply (drule ex_cte_no_overlap')
       apply simp
      apply (clarsimp simp:cte_wp_at_ctes_of)
      done

    lemma usableRange_disjoint:
      "usableUntypedRange (capability.UntypedCap (ptr && ~~ mask sz) sz
       (unat ((ptr && mask sz) + of_nat (length slots) * 2 ^ APIType_capBits tp us))) \<inter>
       {ptr..ptr + of_nat (length slots) * 2 ^ APIType_capBits tp us - 1} = {}"
      proof -
      have idx_compare''[simp]:
       "unat ((ptr && mask sz) + (of_nat (length slots) * (2::word32) ^ APIType_capBits tp us)) < 2 ^ sz
        \<Longrightarrow> ptr + of_nat (length slots) * 2 ^ APIType_capBits tp us - 1
        < ptr + of_nat (length slots) * 2 ^ APIType_capBits tp us"
      apply (rule minus_one_helper,simp)
      apply (rule neq_0_no_wrap)
      apply (rule word32_plus_mono_right_split)
      apply (simp add:shiftl_t2n range_cover_unat[OF cover] field_simps)
      apply (simp add:range_cover.sz(1)
        [where 'a=32, folded word_bits_def, OF cover])+
      done
      show ?thesis
       apply (clarsimp simp:mask_out_sub_mask)
       apply (drule idx_compare'')
       apply simp
       done
     qed
end

lemma and_distrib:
  "(P and (\<lambda>x. Q x)) = (\<lambda>x. P x \<and> Q x)"
  by (rule ext,simp)

lemma valid_sched_etcbs[elim!]: "valid_sched_2 queues ekh sa cdom kh ct it \<Longrightarrow> valid_etcbs_2 ekh kh"
  by (simp add: valid_sched_def)

lemma valid_etcbs_detype: "valid_etcbs s \<Longrightarrow> valid_etcbs (detype S s)"
  by (clarsimp simp add: detype_def detype_ext_def valid_etcbs_def
                            st_tcb_at_kh_def is_etcb_at_def obj_at_kh_def
                            obj_at_def)

crunch ksIdleThread[wp]: deleteObjects "\<lambda>s. P (ksIdleThread s)"
  (simp: crunch_simps wp: hoare_drop_imps hoare_unless_wp ignore:freeMemory)
crunch ksCurDomain[wp]: deleteObjects "\<lambda>s. P (ksCurDomain s)"
  (simp: crunch_simps wp: hoare_drop_imps hoare_unless_wp ignore:freeMemory)
crunch irq_node[wp]: deleteObjects "\<lambda>s. P (irq_node' s)"
  (simp: crunch_simps wp: hoare_drop_imps hoare_unless_wp ignore:freeMemory)

lemma deleteObjects_ksCurThread[wp]:
  "\<lbrace>\<lambda>s. P (ksCurThread s)\<rbrace> deleteObjects ptr sz \<lbrace>\<lambda>_ s. P (ksCurThread s)\<rbrace>"
apply (simp add: deleteObjects_def3)
apply (wp | simp add: doMachineOp_def split_def)+
done

lemma deleteObjects_ct_active':
  "\<lbrace>invs' and sch_act_simple and ct_active'
      and cte_wp_at' (\<lambda>c. cteCap c = UntypedCap ptr sz idx) cref
      and (\<lambda>s. descendants_range' (UntypedCap ptr sz idx) cref (ctes_of s))
      and K (sz < word_bits \<and> is_aligned ptr sz)\<rbrace>
     deleteObjects ptr sz
   \<lbrace>\<lambda>_. ct_active'\<rbrace>"
  apply (simp add: ct_in_state'_def)
  apply (rule hoare_pre)
  apply wps
  apply (wp deleteObjects_st_tcb_at')
  apply (auto simp: ct_in_state'_def elim: pred_tcb'_weakenE)
done

defs cNodeOverlap_def:
  "cNodeOverlap \<equiv> \<lambda>cns inRange. \<exists>p n. cns p = Some n
    \<and> (\<not> is_aligned p (cte_level_bits + n)
      \<or> cte_level_bits + n \<ge> word_bits
      \<or> ({p .. p + 2 ^ (cte_level_bits + n) - 1} \<inter> {p. inRange p} \<noteq> {}))"

lemma cNodeNoOverlap:
  notes Int_atLeastAtMost[simp del]
  shows
  "corres dc (\<lambda>s. \<exists>cref. cte_wp_at (\<lambda>cap. is_untyped_cap cap
                  \<and> Collect R \<subseteq> usable_untyped_range cap) cref s
              \<and> valid_objs s \<and> pspace_aligned s)
     \<top>
    (return x) (stateAssert (\<lambda>s. \<not> cNodeOverlap (gsCNodes s) R) [])"
  apply (simp add: stateAssert_def assert_def)
  apply (rule corres_symb_exec_r[OF _ get_sp])
    apply (rule corres_req[rotated], subst if_P, assumption)
     apply simp
    apply (clarsimp simp: cNodeOverlap_def cte_wp_at_caps_of_state)
    apply (frule(1) caps_of_state_valid_cap)
    apply (frule usable_range_subseteq[rotated], simp add: valid_cap_def)
    apply (clarsimp simp: valid_cap_def valid_untyped_def cap_table_at_gsCNodes_eq
                          obj_at_def is_cap_table is_cap_simps)
    apply (frule(1) pspace_alignedD)
    apply simp
    apply (elim allE, drule(1) mp, simp add: obj_range_def valid_obj_def cap_aligned_def)
    apply (erule is_aligned_get_word_bits[where 'a=32, folded word_bits_def])
     apply (clarsimp simp: is_aligned_no_overflow simp del: )
     apply blast
    apply (simp add: is_aligned_no_overflow power_overflow word_bits_def
                     Int_atLeastAtMost)
   apply wp
  done

lemma cNodeNoOverlap_empty:
  notes Int_atLeastAtMost[simp del]
  shows
  "corres dc (\<lambda>s. pspace_no_overlap ptr bits s
                  \<and> Collect R \<subseteq> {ptr .. (ptr && ~~ mask bits) + 2 ^ bits - 1}
                  \<and> pspace_aligned s \<and> valid_objs s)
     \<top>
    (return x) (stateAssert (\<lambda>s. \<not> cNodeOverlap (gsCNodes s) R) [])"
  apply (simp add: stateAssert_def assert_def)
  apply (rule corres_symb_exec_r[OF _ get_sp])
    apply (rule corres_req[rotated], subst if_P, assumption)
     apply simp
    apply (clarsimp simp: cNodeOverlap_def)
    apply (clarsimp simp: cap_table_at_gsCNodes_eq
                          obj_at_def is_cap_table is_cap_simps
                          pspace_no_overlap_def)
    apply (erule(1) valid_objsE)
    apply (frule(1) pspace_alignedD)
    apply (elim allE, drule(1) mp)
    apply (clarsimp simp: valid_obj_def valid_cs_def valid_cs_size_def)
    apply (simp add: cte_level_bits_def word_bits_def field_simps)
    apply blast
   apply wp
  done

lemma inv_untyped_corres':
  "\<lbrakk> ui = (Invocations_A.Retype cref ptr_base ptr tp us slots);
     untypinv_relation ui ui' \<rbrakk> \<Longrightarrow>
   corres (op =)
     (einvs and valid_untyped_inv ui and ct_active)
     (invs' and valid_untyped_inv' ui' and ct_active')
     (invoke_untyped ui) (invokeUntyped ui')"
  apply (rule corres_name_pre)
  apply (clarsimp simp del:invoke_untyped.simps)
  proof -
    fix s s' ao' sz idx sza idxa
    assume cte_wp_at : "cte_wp_at (\<lambda>c. c = cap.UntypedCap (ptr && ~~ mask sz) sz idx) cref (s::det_state)"
     have cte_at: "cte_wp_at (op = (cap.UntypedCap (ptr && ~~ mask sz) sz idx)) cref s" (is "?cte_cond s")
       using cte_wp_at by (simp add:cte_wp_at_caps_of_state)
    assume cte_wp_at': "cte_wp_at' (\<lambda>cte. cteCap cte = capability.UntypedCap (ptr && ~~ mask sz) sza idxa) (cte_map cref) s'"
    assume cover     : "range_cover ptr sz (obj_bits_api (APIType_map2 (Inr ao')) us) (length slots)"
    assume vslot     : "slots \<noteq> []"
    assume cap_table : "\<forall>slot\<in>set slots. cte_wp_at (op = cap.NullCap) slot s
                         \<and> ex_cte_cap_wp_to is_cnode_cap slot s \<and> real_cte_at slot s"
    assume desc_range: "ptr = ptr && ~~ mask sz \<longrightarrow> descendants_range_in {ptr..ptr + 2 ^ sz - 1} cref s"
                       "ptr = ptr && ~~ mask sz \<longrightarrow> descendants_range_in' {ptr..ptr + 2 ^ sza - 1} (cte_map cref) (ctes_of s')"
    assume  misc     : "distinct slots" "cte_map cref \<notin> cte_map ` set slots" "cref \<notin> set slots" "distinct (map cte_map slots)"
      " ao' = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> 0 < us" "idx \<le> unat (ptr && mask sz) \<or> ptr = ptr && ~~ mask sz"
      " ao' = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> 4 \<le> us"
      " ao' = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> us \<le> 30" "invs s" "invs' s'"  "valid_list s" "valid_sched s"
      " APIType_map2 (Inr ao') \<noteq> ArchObject ASIDPoolObj "
      " \<forall>slot\<in>set slots. ex_cte_cap_wp_to' (\<lambda>_. True) (cte_map slot) s'"
      " \<forall>slot\<in>set slots. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) (cte_map slot) s'"
      " \<forall>slot\<in>set slots. cte_wp_at (op = cap.NullCap) slot s \<and> ex_cte_cap_wp_to is_cnode_cap slot s \<and> real_cte_at slot s"
      " ct_active s" "ct_active' s'" "(s, s') \<in> state_relation" "sch_act_simple s'"
    have sz_simp[simp]: "sza = sz \<and> idxa = idx \<and> 2 \<le> sz"
       using misc cte_at cte_wp_at'
       apply -
       apply (clarsimp simp:cte_wp_at_ctes_of)
       apply (drule pspace_relation_cte_wp_atI'[OF state_relation_pspace_relation])
         apply (simp add:cte_wp_at_ctes_of)
        apply (simp add:invs_valid_objs)
       apply (clarsimp simp:is_cap_simps isCap_simps)
       apply (frule cte_map_inj_eq)
        apply ((fastforce simp:cte_wp_at_caps_of_state cte_wp_at_ctes_of)+)[5]
       apply (clarsimp simp:cte_wp_at_caps_of_state cte_wp_at_ctes_of)
       apply (drule caps_of_state_valid_cap,fastforce)
       apply (clarsimp simp:valid_cap_def)
       done

    have obj_bits_low_bound[simp]:
      "4 \<le> obj_bits_api (APIType_map2 (Inr ao')) us"
       using misc
       apply (case_tac ao')
       apply (simp_all add:obj_bits_api_def slot_bits_def arch_kobj_size_def default_arch_object_def
         APIType_map2_def split: ArchTypes_H.apiobject_type.splits)
       done

    have intvl_eq[simp]:
    "ptr && ~~ mask sz = ptr \<Longrightarrow> {ptr + of_nat k |k. k < 2 ^ sz} = {ptr..ptr + 2 ^ sz - 1}"
      using cover
      apply (subgoal_tac "is_aligned (ptr &&~~ mask sz) sz")
       apply (rule intvl_range_conv)
        apply (simp)
       apply (drule range_cover.sz)
       apply simp
      apply (rule is_aligned_neg_mask,simp)
      done

    have delete_objects_rewrite:
      "ptr && ~~ mask sz = ptr \<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"
      using cover
      apply (clarsimp simp:delete_objects_def freeMemory_def word_size_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 word_bits_def)
       apply clarsimp
      apply (rule is_aligned_neg_mask)
      apply simp
      done

    have of_nat_length: "(of_nat (length slots)::word32) - (1::word32) < (of_nat (length slots)::word32)"
       using vslot
       using range_cover.range_cover_le_n_less(1)[OF cover,where p = "length slots"]
       apply -
       apply (case_tac slots)
       apply clarsimp+
       apply (subst add.commute)
       apply (subst word_le_make_less[symmetric])
       apply (rule less_imp_neq)
       apply (simp add:word_bits_def minus_one_norm)
       apply (rule word_of_nat_less)
       apply auto
       done
    have not_0_ptr[simp]: "ptr\<noteq> 0"
      using misc cte_wp_at'
      apply (clarsimp simp:cte_wp_at_ctes_of)
      apply (case_tac cte)
      apply clarsimp
      apply (drule(1) ctes_of_valid_cap'[OF _ invs_valid_objs'])
      apply (simp add:valid_cap'_def)
      done
    have size_eq[simp]: "APIType_capBits ao' us = obj_bits_api (APIType_map2 (Inr ao')) us"
      apply (case_tac ao')
        apply (rename_tac apiobject_type)
        apply (case_tac apiobject_type)
        apply (clarsimp simp: APIType_capBits_def objBits_def arch_kobj_size_def default_arch_object_def
          obj_bits_api_def APIType_map2_def objBitsKO_def slot_bits_def pageBitsForSize_def)+
      done

   have subset_stuff[simp]:
       "{ptr..ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us - 1}
       \<subseteq> {ptr..(ptr && ~~ mask sz) + 2 ^ sz - 1}" (is "?retype_range \<subseteq> ?usable_range")
      apply (rule range_cover_subset'[OF cover])
      apply (simp add:vslot)
      done

    have non_detype_idx_le[simp]: "ptr \<noteq>  ptr && ~~ mask sz \<Longrightarrow> idx < 2^sz"
       using misc
       apply clarsimp
       apply (erule le_less_trans)
       apply (rule unat_less_helper)
       apply simp
       apply (rule le_less_trans)
       apply (rule word_and_le1)
       apply (simp add:mask_def)
       apply (rule minus_one_helper)
       apply simp
       using cover
       apply (clarsimp simp:range_cover_def)
       done

    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex usableUntypedRange.simps

    have descendants_range[simp]:
      "descendants_range_in ?usable_range cref s"
      "descendants_range_in ?retype_range cref s"
      "descendants_range_in' ?usable_range (cte_map cref) (ctes_of s')"
      "descendants_range_in' ?retype_range (cte_map cref) (ctes_of s')"
      proof -
        have "descendants_range_in ?usable_range cref s"
          using misc cte_at cover cte_wp_at
          apply -
          apply (erule disjE)
           apply (erule cte_wp_at_caps_descendants_range_inI
             [OF _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
           apply simp+
          using desc_range
          apply simp
          done
        thus
          "descendants_range_in ?usable_range cref s"
           by simp
        thus "descendants_range_in ?retype_range cref s"
           by (rule descendants_range_in_subseteq[OF _ subset_stuff])
        have "descendants_range_in' ?usable_range (cte_map cref) (ctes_of s')"
          using misc cte_wp_at' cover
          apply -
          apply (erule disjE)
           apply (erule cte_wp_at_caps_descendants_range_inI'
             [OF _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
           apply simp+
          using desc_range
          apply simp
          done
        thus "descendants_range_in' ?usable_range (cte_map cref) (ctes_of s')"
           by simp
        thus "descendants_range_in' ?retype_range (cte_map cref) (ctes_of s')"
           by (rule descendants_range_in_subseteq'[OF _ subset_stuff])
        qed

    have vc'[simp] : "s' \<turnstile>' capability.UntypedCap (ptr && ~~ mask sz) sz idx"
      using misc cte_wp_at'
      apply (clarsimp simp:cte_wp_at_ctes_of)
      apply (case_tac cte)
      apply clarsimp
      apply (erule ctes_of_valid_cap')
      apply (simp add:invs_valid_objs')
      done

-- "pspace_no_overlap on both side :"
    have ps_no_overlap[simp]: "ptr && ~~ mask sz \<noteq> ptr \<Longrightarrow> pspace_no_overlap ptr sz s"
      using misc cte_wp_at cover
      apply clarsimp
      apply (erule(3) cte_wp_at_pspace_no_overlapI
        [OF _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
      done

    have ps_no_overlap'[simp]: "ptr && ~~ mask sz \<noteq> ptr \<Longrightarrow> pspace_no_overlap' ptr sz s'"
      using misc cte_wp_at' cover
      apply clarsimp
      apply (erule(3) cte_wp_at_pspace_no_overlapI'
        [OF  _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
      done


-- "caps_no_overlap on both side :"
    have caps_no_overlap[simp]: "caps_no_overlap ptr sz s"
      using cte_wp_at misc cover desc_range cte_at
      apply -
      apply (erule disjE)
       apply (erule(3) cte_wp_at_caps_no_overlapI
         [OF _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
      apply clarsimp
      apply (erule descendants_range_caps_no_overlapI)
       apply simp
      apply simp
      done

    have caps_no_overlap'[simp]: "caps_no_overlap'' ptr sz s'"
      using cte_wp_at' misc cover desc_range
      apply -
      apply (erule disjE)
       apply (erule cte_wp_at_caps_no_overlapI'
         [OF  _ _ _ range_cover.sz(1)[where 'a=32, folded word_bits_def]])
        apply simp+
      apply (erule descendants_range_caps_no_overlapI')
       apply simp+
      done

    have ex_cte_no_overlap:
      "\<And>P slot. ex_cte_cap_wp_to P slot s \<Longrightarrow> fst slot \<notin> ?usable_range"
       using cte_at
       apply clarsimp
       apply (drule ex_cte_cap_to_obj_ref_disj,erule disjE)
        using misc
        apply clarsimp
        apply (rule_tac ptr' = "(aa,b)" in untyped_children_in_mdbEE[OF invs_untyped_children])
             apply simp+
         apply (clarsimp simp:untyped_range.simps)
         apply (drule_tac B'="?usable_range" in disjoint_subset2[rotated])
           apply (clarsimp simp:blah word_and_le2)
         apply blast
        apply (clarsimp simp:cte_wp_at_caps_of_state)
        apply (drule(1) descendants_range_inD[OF descendants_range(1)])
        apply (clarsimp simp:cap_range_def)
        apply blast
       apply clarsimp
       apply (drule_tac irq = irq in valid_globals_irq_node[rotated])
        using misc
        apply (clarsimp simp: invs_def valid_state_def )
       apply (clarsimp simp:untyped_range.simps)
       apply (drule_tac B = "{ptr && ~~ mask sz..(ptr && ~~ mask sz) + 2 ^ sz - 1}" in subsetD[rotated])
        apply (clarsimp simp:blah word_and_le2)
       apply simp
       done

    have ex_cte_no_overlap': "\<And>P p. ex_cte_cap_wp_to' P p s' \<Longrightarrow> p \<notin> ?usable_range"
      using cte_wp_at' misc
      apply (clarsimp simp:cte_wp_at_ctes_of)
        apply (drule_tac cte = cte in descendants_range_ex_cte'[OF descendants_range(3)])
        apply (clarsimp simp:blah word_and_le2 isCap_simps)+
      done

    have cref_inv: "fst cref \<notin> ?usable_range" "cte_map cref \<notin> ?usable_range"
      apply (insert misc cte_wp_at cte_wp_at')
       apply (drule if_unsafe_then_capD)
         apply (simp add:invs_def valid_state_def)
        apply simp
       apply (erule ex_cte_no_overlap)
      apply (drule if_unsafe_then_capD')
        apply (simp add:invs'_def valid_state'_def)
       apply simp
      apply (erule ex_cte_no_overlap')
      done

    have slots_invD: "\<And>x. x \<in> set slots
      \<Longrightarrow> fst x \<notin> ?usable_range \<and> caps_of_state s x = Some cap.NullCap
          \<and> ex_cte_cap_wp_to is_cnode_cap x s
          \<and> real_cte_at x s
          \<and> cte_map x \<noteq> cte_map cref
          \<and> cte_map x \<notin> ?usable_range"
      using cte_at misc cte_wp_at'
      apply -
      apply (drule(1) bspec)+
      apply (frule_tac p = cref and p' = x in cte_map_inj_ps[rotated -1,OF invs_valid_pspace])
       apply (clarsimp simp: cte_wp_at_caps_of_state)+
      apply (drule ex_cte_no_overlap)
       apply simp
      apply (drule ex_cte_no_overlap')
       apply simp
      done

    have kernel_window_inv[simp]: "\<forall>x\<in>?usable_range.
      arm_kernel_vspace (arch_state s) x = ArmVSpaceKernelWindow"
      using cte_at misc
      apply (clarsimp simp:cte_wp_at_caps_of_state invs_def valid_state_def)
      apply (erule(1) cap_refs_in_kernel_windowD[THEN bspec])
      apply (simp add:blah cap_range_def)
      apply clarsimp
      apply (erule order_trans[OF word_and_le2])
      done

    have nidx[simp]: "ptr + (of_nat (length slots) * 2^obj_bits_api (APIType_map2 (Inr ao')) us) - (ptr && ~~ mask sz)
      = (ptr && mask sz) + (of_nat (length slots) * 2^obj_bits_api (APIType_map2 (Inr ao')) us)"
       apply (subst word_plus_and_or_coroll2[symmetric,where w = "mask sz" and t = ptr])
       apply simp
       done

    have idx_compare:
      "\<lbrakk>unat ((ptr && mask sz) + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us) < 2^ sz;
        ptr \<noteq> ptr && ~~ mask sz \<rbrakk>
      \<Longrightarrow> (ptr && ~~ mask sz) + of_nat idx
      \<le> ptr + (of_nat (length slots) << obj_bits_api (APIType_map2 (Inr ao')) us)"
       apply (rule range_cover_idx_compare[OF cover ])
         apply assumption+
       apply (frule non_detype_idx_le)
       apply (erule less_imp_le)
       using misc
       apply simp
       done
    have idx_compare'[simp]:"unat ((ptr && mask sz) + (of_nat (length slots)<< obj_bits_api (APIType_map2 (Inr ao')) us)) \<le> 2 ^ sz"
      apply (rule le_trans[OF unat_plus_gt])
      apply (simp add:range_cover.unat_of_nat_n_shift[OF cover] range_cover_unat)
      apply (insert range_cover.range_cover_compare_bound[OF cover])
      apply simp
      done

    have usable_range_subset:
      "ptr && ~~ mask sz \<noteq> ptr
      \<Longrightarrow> usableUntypedRange (capability.UntypedCap (ptr &&~~ mask sz) sz
                       (getFreeIndex (ptr &&~~ mask sz) (ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us)))
                      \<subseteq> usableUntypedRange (capability.UntypedCap (ptr&&~~ mask sz) sz idx)"
      "ptr && ~~ mask sz \<noteq> ptr
      \<Longrightarrow>usable_untyped_range
                     (cap.UntypedCap (ptr && ~~ mask sz) sz
                       (unat (ptr + (of_nat (length slots) << obj_bits_api (APIType_map2 (Inr ao')) us) - (ptr && ~~ mask sz))))
                    \<subseteq> usable_untyped_range (cap.UntypedCap (ptr && ~~ mask sz) sz idx)"
      apply (simp_all add:blah getFreeIndex_def field_simps nidx)
      apply (clarsimp)
       apply (subst add.commute)
       apply (erule order_trans[OF idx_compare])
        apply simp
       apply (subst word_plus_and_or_coroll2[symmetric,where w = "mask sz"])
       apply (simp add:shiftl_t2n field_simps)
      apply (clarsimp simp:shiftl_t2n nidx field_simps)
       apply (subst add.commute)
       apply (erule order_trans[OF idx_compare])
        apply simp
       apply (simp add:shiftl_t2n field_simps)
      done

    have idx_compare''[simp]:
       "unat ((ptr && mask sz) + (of_nat (length slots) * (2::word32) ^ obj_bits_api (APIType_map2 (Inr ao')) us)) < 2 ^ sz
        \<Longrightarrow> ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us - 1
        < ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us"
      apply (rule minus_one_helper,simp)
      apply (rule neq_0_no_wrap)
      apply (rule word32_plus_mono_right_split)
      apply (simp add:shiftl_t2n range_cover_unat[OF cover] field_simps)
      apply (simp add:range_cover.sz[where 'a=32, folded word_bits_def, OF cover])+
      done

    note neg_mask_add_mask = word_plus_and_or_coroll2[symmetric,where w = "mask sz" and t = ptr,symmetric]

    have idx_compare'''[simp]:
      "\<lbrakk>unat (of_nat (length slots) * (2::word32) ^ obj_bits_api (APIType_map2 (Inr ao')) us) < 2 ^ sz;
       ptr && ~~ mask sz = ptr\<rbrakk>
      \<Longrightarrow> ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us - 1
      < ptr + of_nat (length slots) * 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us "
      apply (rule minus_one_helper,simp)
      apply (simp add:is_aligned_neg_mask_eq'[symmetric])
      apply (rule neq_0_no_wrap)
      apply (rule word32_plus_mono_right_split[where sz = sz])
       apply (simp add:is_aligned_mask)+
      apply (simp add:range_cover.sz[where 'a=32, folded word_bits_def, OF cover])+
      done

    have detype_locale:"ptr && ~~ mask sz = ptr \<Longrightarrow> detype_locale (cap.UntypedCap (ptr && ~~ mask sz) sz idx) cref s"
      using cte_at descendants_range misc
      by (simp add:detype_locale_def cte_at descendants_range_def2 blah invs_untyped_children)

    have detype_descendants_range_in:
      "ptr && ~~ mask sz = ptr \<Longrightarrow> descendants_range_in ?usable_range cref
      (detype ?usable_range (clear_um ?usable_range s))"
      using misc cte_at
      apply -
      apply (frule detype_invariants)
          apply (simp add:isCap_simps)
         using descendants_range
         apply (clarsimp simp:blah descendants_range_def2)
         apply ((simp add:isCap_simps invs_untyped_children blah
               invs_valid_reply_caps invs_valid_reply_masters)+)[5]
      apply (subst valid_mdb_descendants_range_in)
       apply (clarsimp dest!: invs_mdb simp: untyped_range.simps)
      apply (frule detype_locale)
      apply (drule detype_locale.non_filter_detype[symmetric])
      using descendants_range(1)
      apply -
      apply (subst (asm) valid_mdb_descendants_range_in)
        apply (clarsimp simp: invs_mdb untyped_range.simps)
      apply (clarsimp simp:descendants_range_in_def untyped_range.simps clear_um_def
        cong:if_cong)
      done

    have maxDomain:"ksCurDomain s' \<le> maxDomain"
      using misc
      by (simp add:invs'_def valid_state'_def)

    have sz_mask_less:
      "unat (ptr && mask sz) < 2 ^ sz"
      using range_cover.sz[OF cover]
      by (simp add: unat_less_helper and_mask_less_size word_size)

    have invs:
      "invs s" using misc by simp

    have overlap_ranges1:
      "{x. ptr \<le> x \<and> x \<le> ptr + 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us
            * of_nat (length slots) - 1} \<subseteq> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}"
      apply (rule order_trans[rotated])
       apply (rule range_cover_subset'[OF cover], simp add: vslot)
      apply (clarsimp simp: atLeastAtMost_iff field_simps)
      done

    have overlap_ranges2:
      "idx \<le> unat (ptr && mask sz)
        \<Longrightarrow> {x. ptr \<le> x \<and> x \<le> ptr + 2 ^ obj_bits_api (APIType_map2 (Inr ao')) us
            * of_nat (length slots) - 1} \<subseteq> {(ptr && ~~ mask sz) + of_nat idx..(ptr && ~~ mask sz) + 2 ^ sz - 1}"
      apply (rule order_trans[OF overlap_ranges1])
      apply (clarsimp simp add: atLeastatMost_subset_iff)
      apply (rule order_trans, rule word_plus_mono_right)
        apply (erule word_of_nat_le)
       apply (simp add: add.commute word_plus_and_or_coroll2 word_and_le2)
      apply (simp add: add.commute word_plus_and_or_coroll2)
      done

    note set_cap_free_index_invs_spec = set_free_index_invs[where cap = "cap.UntypedCap (ptr && ~~ mask sz) sz idx"
      ,unfolded free_index_update_def free_index_of_def,simplified]

    note msimp[simp add] =  misc getObjectSize_def_eq neg_mask_add_mask
    show " corres op = (op = s) (op = s')
           (invoke_untyped (Invocations_A.untyped_invocation.Retype cref (ptr && ~~ mask sz) ptr (APIType_map2 (Inr ao')) us slots))
           (invokeUntyped (Invocations_H.untyped_invocation.Retype (cte_map cref) (ptr && ~~ mask sz) ptr ao' us (map cte_map slots)))"

  using [[ hypsubst_thin = true ]]
  apply (case_tac "ptr && ~~ mask sz \<noteq> ptr")
   using misc
   apply (clarsimp simp:invokeUntyped_def getSlotCap_def bind_assoc)
       apply (case_tac ui')
       apply (clarsimp simp: insertNewCaps_def split_def
                          bind_assoc
               split del: split_if)
       apply (insert cover)
       apply (rule corres_guard_imp)
         apply (rule corres_split[OF _ get_cap_corres])
           apply (rule_tac F = "cap = cap.UntypedCap (ptr && ~~ mask sz) sz idx" in corres_gen_asm)
           apply (rule corres_add_noop_lhs)
           apply (rule corres_split_nor[OF _ cNodeNoOverlap return_wp stateAssert_wp])
           apply (rule corres_split[OF _ update_untyped_cap_corres,rotated])
                apply (simp add:isCap_simps)+
              apply (clarsimp simp:getFreeIndex_def bits_of_def shiftL_nat shiftl_t2n)
             prefer 3
             apply (insert range_cover.range_cover_n_less[OF cover] vslot)
             apply (rule createNewObjects_corres_helper)
                  apply simp+
              apply (simp add: insertNewCaps_def)
              apply (rule corres_split_retype_createNewCaps[where sz = sz,OF corres_rel_imp])
                 apply (rule inv_untyped_corres_helper1)
                 apply simp
                apply simp
               apply ((wp retype_region_invs_extras[where sz = sz]
                   retype_region_plain_invs [where sz = sz]
                   retype_region_descendants_range_ret[where sz = sz]
                   retype_region_caps_overlap_reserved_ret[where sz = sz]
                   retype_region_cte_at_other[where sz = sz]
                   retype_region_distinct_sets[where sz = sz]
                 (* retype_region_ranges[where p=cref and sz = sz] *)
                   retype_region_ranges[where ptr=ptr and sz=sz and
                      ptr_base="ptr && ~~ mask sz", where p=cref]
                   retype_ret_valid_caps [where sz = sz]
                   retype_region_arch_objs [where sza = "\<lambda>_. sz"]
                   hoare_vcg_const_Ball_lift
                   set_tuple_pick distinct_tuple_helper
                   retype_region_obj_at_other3[where sz = sz]
                 | assumption)+)[1]
              apply (wp set_tuple_pick createNewCaps_cte_wp_at'[where sz= sz]
                 hoare_vcg_ex_lift distinct_tuple_helper
                 createNewCaps_parent_helper [where p="cte_map cref" and sz = sz]
                 createNewCaps_valid_pspace_extras [where ptr=ptr and sz = sz]
                 createNewCaps_not_parents[where sz = sz] createNewCaps_distinct[where sz = sz]
                 createNewCaps_ranges'[where sz = sz]
                 hoare_vcg_const_Ball_lift createNewCaps_valid_cap'[where sz = sz]
                 createNewCaps_descendants_range_ret'[where sz = sz]
                 createNewCaps_caps_overlap_reserved_ret'[where sz = sz])
             apply clarsimp
             apply (erule cte_wp_at_weakenE')
             apply (case_tac c, simp)
             apply hypsubst
             apply (case_tac c,clarsimp simp:isCap_simps)
            apply (clarsimp simp: getObjectSize_def_eq
               getFreeIndex_def is_cap_simps bits_of_def shiftL_nat shiftl_t2n)
            apply (clarsimp simp:conj_comms)
            apply (strengthen invs_mdb invs_valid_objs
              invs_valid_pspace invs_arch_state invs_psp_aligned)
            apply (clarsimp simp:conj_comms bits_of_def region_in_kernel_window_def)
            apply (wp set_cap_free_index_invs_spec set_cap_caps_no_overlap set_cap_no_overlap)
            apply (rule hoare_vcg_conj_lift)
             apply (rule hoare_strengthen_post[OF set_cap_sets])
             apply (clarsimp simp:cte_wp_at_caps_of_state)
            apply (wp set_cap_no_overlap hoare_vcg_ball_lift
              set_cap_free_index_invs_spec
              set_cap_cte_wp_at set_cap_descendants_range_in
              set_untyped_cap_caps_overlap_reserved)
           apply (clarsimp simp:conj_comms ball_conj_distrib simp del:capFreeIndex_update.simps)
           apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
               invs_valid_pspace' invs_arch_state'
               imp_consequent[where Q = "(\<exists>x. x \<in> cte_map ` set slots)"]
             | clarsimp simp:conj_comms not_0_ptr simp del:capFreeIndex_update.simps)+
           apply (wp updateFreeIndex_invs' updateFreeIndex_caps_overlap_reserved'
             updateFreeIndex_caps_no_overlap'' updateFreeIndex_pspace_no_overlap')
           apply (rule hoare_vcg_conj_lift[OF hoare_vcg_ball_lift])
            apply (simp add:updateCap_def)
            apply (wp setCTE_weak_cte_wp_at getCTE_wp)
           apply (wp updateFreeIndex_caps_overlap_reserved' updateFreeIndex_descendants_range_in' )
           apply (simp add:updateCap_def)
           apply (wp setCTE_weak_cte_wp_at,simp)
           apply (rule hoare_strengthen_post[OF hoare_TrueI[where P = \<top>]])
           apply fastforce
          apply (clarsimp simp:conj_comms ball_conj_distrib and_distrib)
          apply (strengthen invs_mdb invs_valid_objs imp_consequent
                invs_valid_pspace invs_arch_state invs_psp_aligned
                invs_distinct)
          apply (clarsimp simp:conj_comms)
          apply (wp get_cap_wp)[1]
         apply (clarsimp simp:conj_comms and_distrib split del:if_splits)
         apply (strengthen invs_pspace_aligned' invs_valid_pspace' imp_consequent
           invs_pspace_distinct' invs_arch_state invs_psp_aligned)
         apply (clarsimp simp:conj_comms not_0_ptr isCap_simps
           shiftL_nat field_simps range_cover.unat_of_nat_shift[OF cover le_refl,simplified])
         apply (wp get_cap_wp)
        using kernel_window_inv cte_at ps_no_overlap caps_no_overlap
        apply (clarsimp simp:cte_wp_at_caps_of_state cap_master_cap_def bits_of_def
                             is_cap_simps shiftl_t2n untyped_range.simps valid_sched_etcbs[OF misc(12)]
                             invs_valid_objs[OF invs] invs_psp_aligned[OF invs])
        apply (subst exI[where x=cref])
         apply (simp add: usable_untyped_range_def shiftL_nat overlap_ranges2)
        apply simp
        apply (intro conjI impI)
             apply clarsimp
             apply (drule slots_invD)
             apply (clarsimp simp: cte_wp_at_caps_of_state ex_cte_cap_wp_to_def)
            apply (clarsimp dest!:slots_invD)
           apply (clarsimp simp:field_simps range_cover_unat[OF cover]
             range_cover.unat_of_nat_shift[OF cover le_refl le_refl])+
          apply (subst add.commute)
          apply (rule range_cover.range_cover_compare_bound[OF cover])
         apply (rule subset_trans[OF subset_stuff])
         apply (clarsimp simp:blah word_and_le2)
        apply (clarsimp simp:usable_untyped_range.simps blah add.assoc[symmetric] add.commute
                        dest!:idx_compare'')
        apply (metis idx_compare'' mult.commute nidx word_arith_nat_mult word_not_le)
       apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' 
         invs_valid_pspace' maxDomain)
       apply (insert cte_wp_at')
       apply (intro conjI impI)
              apply (clarsimp simp:cte_wp_at_ctes_of isCap_simps dest!:usable_range_subset(1))+
            apply (clarsimp simp:getFreeIndex_def field_simps range_cover_unat[OF cover]
              range_cover.unat_of_nat_shift[OF cover le_refl le_refl])+
           apply (subst add.commute)
           apply (rule range_cover.range_cover_compare_bound[OF cover])
          apply (simp add:getFreeIndex_def field_simps)
          apply (rule aligned_add_aligned[OF aligned_after_mask])
            apply (erule range_cover.aligned)
           apply (rule is_aligned_weaken)
            apply (subst mult.commute)
            apply (rule is_aligned_shiftl_self[unfolded shiftl_t2n])
           apply (simp)
          apply (simp add: range_cover_def)
         apply (rule subset_trans[OF subset_stuff])
         apply (clarsimp simp:blah word_and_le2)
        apply clarsimp+
        apply (drule slots_invD,clarsimp simp:cte_wp_at_ctes_of)
       apply simp
       apply (clarsimp simp: add.assoc[symmetric] getFreeIndex_def blah add.commute dest!:idx_compare'')
       apply simp
      apply (clarsimp simp:invokeUntyped_def getSlotCap_def bind_assoc)
      apply (case_tac ui')
      apply (clarsimp simp: insertNewCaps_def split_def
                            bind_assoc
                 split del: split_if)
      apply (rule corres_guard_imp)
        apply (rule corres_split[OF _ get_cap_corres])
          apply (rule_tac F = "cap = cap.UntypedCap (ptr && ~~ mask sz) sz idx" in corres_gen_asm)
          apply (clarsimp simp:bits_of_def simp del:capFreeIndex_update.simps)
          apply (rule corres_split[OF _ detype_corres])
              apply (rule corres_add_noop_lhs)
              apply (rule corres_split_nor[OF _ cNodeNoOverlap_empty[where ptr=ptr and bits=sz] return_wp stateAssert_wp])
              apply (rule corres_split[OF _ update_untyped_cap_corres,rotated])
                   apply (simp add:isCap_simps)+
                 apply (clarsimp simp:shiftl_t2n shiftL_nat getFreeIndex_def)
                prefer 3
                apply (insert range_cover.range_cover_n_less[OF cover] vslot)
                apply (rule createNewObjects_corres_helper)
                     apply simp+
                 apply (simp add: insertNewCaps_def)
                 apply (rule corres_split_retype_createNewCaps[where sz = sz,OF corres_rel_imp])
                    apply (rule inv_untyped_corres_helper1)
                    apply simp
                   apply simp
                  apply ((wp retype_region_invs_extras[where sz = sz]
                       retype_region_plain_invs [where sz = sz]
                       retype_region_descendants_range_ret[where sz = sz]
                       retype_region_caps_overlap_reserved_ret[where sz = sz]
                       retype_region_cte_at_other[where sz = sz]
                       retype_region_distinct_sets[where sz = sz]
                       retype_region_ranges[where p=cref and sz = sz]
                       retype_ret_valid_caps [where sz = sz]
                       retype_region_arch_objs [where sza = "\<lambda>_. sz"]
                      hoare_vcg_const_Ball_lift
                       set_tuple_pick distinct_tuple_helper
                       retype_region_obj_at_other3[where sz = sz]
                     | assumption)+)[1]
                 apply (wp set_tuple_pick createNewCaps_cte_wp_at'[where sz= sz]
                    hoare_vcg_ex_lift distinct_tuple_helper
                    createNewCaps_parent_helper [where p="cte_map cref"
                       and sz = sz and ptr_base = "ptr && ~~ mask sz"]
                    createNewCaps_valid_pspace_extras [where ptr=ptr and sz = sz]
                    createNewCaps_not_parents[where sz = sz] createNewCaps_distinct[where sz = sz]
                    createNewCaps_ranges'[where sz = sz]
                    hoare_vcg_const_Ball_lift createNewCaps_valid_cap'[where sz = sz]
                    createNewCaps_descendants_range_ret'[where sz = sz]
                    createNewCaps_caps_overlap_reserved_ret'[where sz = sz])
                apply clarsimp
                apply (erule cte_wp_at_weakenE')
                apply (case_tac c,clarsimp simp:cte_wp_at_ctes_of isCap_simps)
               apply (clarsimp simp:
                  getFreeIndex_def is_cap_simps bits_of_def shiftL_nat shiftl_t2n)
               apply (clarsimp simp:conj_comms)
               apply (strengthen invs_mdb invs_valid_objs
                 invs_valid_pspace invs_arch_state invs_psp_aligned)
               apply (clarsimp simp:conj_comms bits_of_def region_in_kernel_window_def)
               apply (wp set_cap_caps_no_overlap set_untyped_cap_invs_simple set_cap_no_overlap)
               apply (rule hoare_vcg_conj_lift)
                apply (rule hoare_strengthen_post[OF set_cap_sets])
                apply (clarsimp simp:cte_wp_at_caps_of_state)
               apply (wp set_cap_no_overlap hoare_vcg_ball_lift
                        set_untyped_cap_invs_simple
                        set_cap_cte_wp_at
                        set_cap_descendants_range_in
                        set_untyped_cap_caps_overlap_reserved)
              apply (clarsimp simp:conj_comms ball_conj_distrib simp del:capFreeIndex_update.simps)
              apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
                  invs_valid_pspace' invs_arch_state'
                  imp_consequent[where Q = "(\<exists>x. x \<in> cte_map ` set slots)"]
                | clarsimp simp:conj_comms simp del:capFreeIndex_update.simps)+
              apply (wp updateFreeIndex_invs_simple' updateFreeIndex_caps_overlap_reserved'
                updateFreeIndex_caps_no_overlap'' updateFreeIndex_pspace_no_overlap')
              apply (rule hoare_vcg_conj_lift[OF hoare_vcg_ball_lift])
               apply (simp add:updateCap_def)
               apply (wp setCTE_weak_cte_wp_at getCTE_wp)
              apply (rule hoare_vcg_conj_lift)
               apply (simp add:updateCap_def)
               apply (wp setCTE_weak_cte_wp_at getCTE_wp)
              apply (wp updateFreeIndex_caps_overlap_reserved' updateFreeIndex_descendants_range_in' )
             apply (simp add:is_aligned_neg_mask_eq')
            apply simp
           apply (simp add:delete_objects_rewrite)
           apply wp
          apply (clarsimp simp:conj_comms split del: split_if)
          apply (wp_once hoare_drop_imps)
          apply (strengthen invs_pspace_aligned' invs_valid_pspace' imp_consequent
             invs_pspace_distinct' invs_arch_state invs_psp_aligned)
          apply (clarsimp simp:conj_comms isCap_simps
            shiftL_nat field_simps range_cover.unat_of_nat_shift[OF cover le_refl,simplified])
          apply (wp deleteObjects_invs'[where idx = idx and p = "cte_map cref"]
                 deleteObjects_caps_no_overlap''[where idx = idx and slot = "cte_map cref"]
                 deleteObject_no_overlap[where idx = idx]
                 deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz]
                 deleteObjects_caps_overlap_reserved'[where idx = idx and slot = "cte_map cref"]
                 deleteObjects_descendants[where idx = idx and p = "cte_map cref"]
                 hoare_vcg_ball_lift hoare_drop_imp hoare_vcg_ex_lift
                 deleteObjects_ct_active'[where sz = sz and ptr = ptr and idx = idx and cref = "cte_map cref"]
                 deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz])[1]
         apply (clarsimp simp:conj_comms ball_conj_distrib pred_conj_def)
         apply (strengthen invs_mdb invs_valid_objs imp_consequent
                  invs_valid_pspace invs_arch_state invs_psp_aligned
                  invs_distinct | clarsimp simp: conj_comms)+
         apply (wp get_cap_wp)
       using kernel_window_inv cte_at ps_no_overlap caps_no_overlap
            caps_no_overlap_detype descendants_range
       apply (clarsimp simp:cte_wp_at_caps_of_state cap_master_cap_def descendants_range_def2
         invs_mdb valid_state_def invs_untyped_children bits_of_def is_cap_simps untyped_range.simps)
       apply (frule detype_descendants_range_in)
       apply (subgoal_tac "pspace_no_overlap ptr sz (detype {ptr..ptr + 2 ^ sz - 1} s)")
        prefer 2
        apply (cut_tac misc cte_at)
        apply (erule pspace_no_overlap_detype[OF caps_of_state_valid])
          apply (simp add:invs_psp_aligned invs_valid_objs cte_wp_at_caps_of_state)+
       apply (subgoal_tac "invs (detype {ptr..ptr + 2 ^ sz - 1} (clear_um {ptr..ptr + 2 ^ sz - 1} s))")
        prefer 2
        apply (cut_tac misc cte_at)
        apply (frule detype_invariants)
               apply (simp add:isCap_simps)
              apply (clarsimp simp:blah descendants_range_def2)
             apply ((simp add:isCap_simps invs_untyped_children blah
                    invs_valid_reply_caps invs_valid_reply_masters)+)[6]
       apply (clarsimp simp: detype_clear_um_independent)
       apply (intro conjI impI)
                         apply (insert misc cte_at cref_inv)
                         apply ((clarsimp simp:invs_def valid_state_def)+)[2]
                       apply (erule caps_of_state_valid,simp)
                      apply simp+
                    apply (clarsimp dest!:slots_invD)
                   apply simp
                   apply (rule_tac x = cref in exI,simp)
                  apply simp
                 apply (clarsimp dest!:slots_invD)
                apply (clarsimp simp:field_simps
                 range_cover.unat_of_nat_shift[OF cover le_refl le_refl])
                apply (subst mult.commute)
                apply (rule nat_le_power_trans)
                 apply (rule range_cover.range_cover_n_le(2)[OF cover])
                apply (erule range_cover.sz)
               apply (simp add:caps_no_overlap_detype)
              apply (simp add:range_cover.unat_of_nat_n_shift[OF cover] field_simps)
              apply (rule subset_trans[OF subset_stuff],simp)
             apply (cut_tac kernel_window_inv)
             apply (simp add:detype_def clear_um_def)
            apply (simp add: shiftL_nat)
            apply (rule order_trans, rule overlap_ranges1)
            apply simp
           apply (clarsimp simp:blah field_simps dest!:idx_compare''')
           apply (simp)
          apply (simp add:clear_um_def detype_def detype_ext_def)
         apply (erule descendants_range_in_subseteq)
         apply (rule subset_trans[OF subset_stuff],simp)
        apply (simp add: clear_um_def)
        apply (rule valid_etcbs_detype[OF valid_sched_etcbs[OF misc(12)]])
       apply (clarsimp,drule slots_invD,simp)
       apply (clarsimp simp:field_simps range_cover.unat_of_nat_shift[OF cover le_refl le_refl])
       apply (subst mult.commute)
       apply (rule nat_le_power_trans)
        apply (rule range_cover.range_cover_n_le(2)[OF cover])
       apply (erule range_cover.sz)
      apply (clarsimp simp:conj_comms invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace')
      apply (insert cte_wp_at' vc' descendants_range)
      apply (intro conjI impI)
                  apply (simp add: is_aligned_neg_mask_eq' range_cover.sz
                      [where 'a=32, folded word_bits_def, OF cover])+
                apply (clarsimp simp:cte_wp_at_ctes_of isCap_simps maxDomain)+
             apply (clarsimp simp:descendants_range'_def2)
            apply simp
           apply (simp add:getFreeIndex_def)+
          apply (clarsimp simp:range_cover.unat_of_nat_shift field_simps)
          apply (subst mult.commute)
          apply (rule nat_le_power_trans[OF range_cover.range_cover_n_le(2)[OF cover]])
          apply (rule range_cover.sz(2)[OF cover])
         apply (simp add:getFreeIndex_def)
         apply (rule is_aligned_weaken)
          apply (subst mult.commute)
          apply (rule is_aligned_shiftl_self[unfolded shiftl_t2n])
         apply simp
        apply (rule subset_trans[OF subset_stuff],simp)
       apply (clarsimp simp:cte_wp_at_ctes_of)
       apply (drule slots_invD)
       apply simp
      apply (clarsimp simp:blah getFreeIndex_def dest!:idx_compare''')
      apply simp
  done
qed

lemma inv_untyped_corres:
  "untypinv_relation ui ui' \<Longrightarrow>
   corres (op=)
     (einvs and valid_untyped_inv ui and ct_active)
     (invs' and valid_untyped_inv' ui' and ct_active')
     (invoke_untyped ui) (invokeUntyped ui')"
  by (case_tac ui, erule(1) inv_untyped_corres')

crunch pred_tcb_at'[wp]: insertNewCap "pred_tcb_at' proj P t"
  (wp: crunch_wps)

crunch pred_tcb_at'[wp]: doMachineOp "pred_tcb_at' proj P t"
  (wp: crunch_wps)


(* FIXME: move *)
lemma deleteObjects_real_cte_at':
  "\<lbrace>\<lambda>s. real_cte_at' p s \<and> p \<notin> {ptr .. ptr + 2 ^ bits - 1}
         \<and> s \<turnstile>' (UntypedCap ptr bits idx) \<and> valid_pspace' s\<rbrace>
     deleteObjects ptr bits
   \<lbrace>\<lambda>_. real_cte_at' p\<rbrace>"
  apply (simp add: deleteObjects_def3 doMachineOp_def split_def)
  apply wp
  apply (clarsimp simp: valid_pspace'_def cong:if_cong)
  apply (subgoal_tac
     "s\<lparr>ksMachineState := b,
        ksPSpace := \<lambda>x. if ptr \<le> x \<and> x \<le> ptr + 2 ^ bits - 1 then None
                        else ksPSpace s x\<rparr> =
      ksMachineState_update (\<lambda>_. b)
      (s\<lparr>ksPSpace := \<lambda>x. if ptr \<le> x \<and> x \<le> ptr + 2 ^ bits - 1 then None
                         else ksPSpace s x\<rparr>)", erule ssubst)
   apply (simp add: obj_at_delete' x_power_minus_1)
  apply (case_tac s, simp)
  done

lemma inv_untyp_st_tcb_at'[wp]:
  "\<lbrace>invs' and st_tcb_at' (P and (op \<noteq> Inactive) and (op \<noteq> IdleThreadState)) tptr
         and valid_untyped_inv' ui and ct_active'\<rbrace>
     invokeUntyped ui
   \<lbrace>\<lambda>rv. st_tcb_at' P tptr\<rbrace>"
  apply (rule hoare_name_pre_state)
  apply (cases ui)
  apply (clarsimp)
  apply (rename_tac s cref ptr tp us slots sz idx)
proof -
 fix s cref ptr tp us slots sz idx
    assume cte_wp_at': "cte_wp_at' (\<lambda>cte. cteCap cte = capability.UntypedCap (ptr && ~~ mask sz) sz idx) cref s"
    assume cover     : "range_cover ptr sz (APIType_capBits tp us) (length (slots::word32 list))"
    assume  misc     : "distinct slots" "idx \<le> unat (ptr && mask sz) \<or> ptr = ptr && ~~ mask sz"
      "invs' s" "slots \<noteq> []" "sch_act_simple s"
      "\<forall>slot\<in>set slots. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) slot s"
      "\<forall>x\<in>set slots. ex_cte_cap_wp_to' (\<lambda>_. True) x s" "ct_active' s"
      "tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> 4 \<le> us \<and> us \<le> 30"
    assume desc_range: "ptr = ptr && ~~ mask sz \<longrightarrow> descendants_range_in' {ptr..ptr + 2 ^ sz - 1} (cref) (ctes_of s)"

    assume st_tcb:
      "st_tcb_at' (P and op \<noteq> Structures_H.thread_state.Inactive and op \<noteq> Structures_H.thread_state.IdleThreadState) tptr s"

  have pf: "invokeUntyped_proofs s cref ptr tp us slots sz idx"
    using cte_wp_at' cover misc desc_range
    by (simp add:invokeUntyped_proofs_def)

  have us_align[simp]: "is_aligned ((ptr && mask sz) + of_nat (length slots) * 2 ^ APIType_capBits tp us) 4"
    using misc cover
    apply -
    apply (rule aligned_add_aligned[OF aligned_after_mask])
       apply (rule range_cover.aligned[OF cover])
      apply (subst mult.commute)
      apply (rule is_aligned_weaken)
       apply (rule is_aligned_shiftl_self[unfolded shiftl_t2n])
      apply (case_tac tp,(clarsimp simp:APIType_capBits_def objBits_simps
         split: ArchTypes_H.apiobject_type.splits)+)[1]
     apply (simp add:range_cover_def)
    apply (case_tac tp,(clarsimp simp:APIType_capBits_def objBits_simps
      split: ArchTypes_H.apiobject_type.splits)+)[1]
    done

  note nidx[simp] = add_minus_neg_mask[where ptr = ptr]
  note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff
          atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex usableUntypedRange.simps

  note if_cong[cong del] if_weak_cong[cong]
  show "\<lbrace>op = s\<rbrace> invokeUntyped (Invocations_H.untyped_invocation.Retype cref (ptr && ~~ mask sz) ptr tp us slots)
          \<lbrace>\<lambda>rv. st_tcb_at' P tptr\<rbrace>"
    using misc cover cte_wp_at' invokeUntyped_proofs.not_0_ptr[OF pf]
          invokeUntyped_proofs.caps_no_overlap'[OF pf]
          invokeUntyped_proofs.descendants_range[OF pf]
          invokeUntyped_proofs.idx_compare'[OF pf]
    
  apply (simp add:invokeUntyped_def)
  apply (case_tac "\<not> ptr && ~~ mask sz = ptr")
   apply (frule invokeUntyped_proofs.ps_no_overlap'[OF pf])
   apply (rule hoare_pre)
    apply wp
       apply (rule createNewObjects_wp_helper)
           apply simp+
       apply (simp add: insertNewCaps_def split_def bind_assoc zipWithM_x_mapM
             cong: capability.case_cong)
         apply (wp mapM_wp' createNewCaps_pred_tcb_at'
        deleteObjects_st_tcb_at' createNewObjects_wp_helper
        updateFreeIndex_pspace_no_overlap'[where sz = sz] | wpc)+
      apply (rule hoare_vcg_conj_lift)
       apply (simp add:updateCap_def)
       apply (wp setCTE_weak_cte_wp_at getCTE_wp)
      apply (wp hoare_vcg_const_Ball_lift)
       apply (simp add:updateCap_def)
       apply (wp setCTE_weak_cte_wp_at getCTE_wp)
      apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
          invs_valid_pspace' invs_arch_state')
      apply (clarsimp simp:conj_comms)
      apply (wp updateFreeIndex_invs' updateFreeIndex_caps_overlap_reserved'
         updateFreeIndex_caps_no_overlap''[where sz = sz]
         updateFreeIndex_pspace_no_overlap'[where sz = sz]
         hoare_vcg_const_Ball_lift)
     apply simp
    apply simp
    apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
           invs_valid_pspace')
    apply (clarsimp simp:conj_comms isCap_simps getFreeIndex_def split del:if_splits)
    apply (wp getSlotCap_wp)
   apply (strengthen imp_consequent[where Q="\<not> cNodeOverlap A B" for A B])
   apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace'
       cte_wp_at_ctes_of conj_comms field_simps shiftl_t2n shiftL_nat invs_ksCurDomain_maxDomain')
   apply (intro conjI)
         apply (rule pred_tcb'_weakenE[OF st_tcb])
       apply simp
      apply (clarsimp dest!:invokeUntyped_proofs.slots_invD[OF pf])
     apply (simp add:range_cover_unat[OF cover]
         range_cover.unat_of_nat_shift field_simps)
    apply (rule subset_trans[OF invokeUntyped_proofs.subset_stuff[OF pf]])
    apply (clarsimp simp:blah word_and_le2)
   apply (rule invokeUntyped_proofs.usableRange_disjoint[OF pf])
  apply (rule hoare_pre)
   apply wp
      apply (rule createNewObjects_wp_helper)
          apply simp+
      apply (simp add: insertNewCaps_def split_def bind_assoc zipWithM_x_mapM
             cong: capability.case_cong)
        apply (wp mapM_wp' createNewCaps_pred_tcb_at'
        deleteObjects_st_tcb_at' createNewObjects_wp_helper
        updateFreeIndex_pspace_no_overlap'[where sz = sz] | wpc)+
     apply (rule hoare_vcg_conj_lift)
      apply (simp add:updateCap_def)
      apply (wp setCTE_weak_cte_wp_at getCTE_wp)
     apply (wp hoare_vcg_const_Ball_lift)
      apply (simp add:updateCap_def)
      apply (wp setCTE_weak_cte_wp_at getCTE_wp)
     apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
         invs_valid_pspace' invs_arch_state')
     apply (clarsimp simp:conj_comms)
     apply (wp updateFreeIndex_invs_simple'  updateFreeIndex_caps_overlap_reserved'
         updateFreeIndex_caps_no_overlap''[where sz = sz]
         updateFreeIndex_pspace_no_overlap'[where sz = sz]
         hoare_vcg_const_Ball_lift)
    apply (strengthen imp_consequent[where Q="\<not> cNodeOverlap A B" for A B])
    apply (clarsimp simp:conj_comms split del:if_splits)
    apply (strengthen invs_pspace_aligned' invs_valid_pspace' imp_consequent
          invs_pspace_distinct' invs_arch_state invs_psp_aligned)
    apply (clarsimp simp:conj_comms isCap_simps
         shiftL_nat field_simps range_cover.unat_of_nat_shift[OF cover le_refl,simplified])
    apply (rule_tac P = "cap = capability.UntypedCap (ptr && ~~ mask sz) sz idx"
       in hoare_gen_asm)
    apply (clarsimp simp: conj_comms)
    apply (wp deleteObjects_invs'[where idx = idx and p = "cref"]
              deleteObjects_caps_no_overlap''[where idx = idx and slot = "cref"]
              deleteObject_no_overlap[where idx = idx]
              deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_caps_overlap_reserved'[where idx = idx and slot = "cref"]
              deleteObjects_descendants[where idx = idx and p = "cref"]
              hoare_vcg_ball_lift hoare_drop_imp hoare_vcg_ex_lift
              deleteObjects_st_tcb_at'[where p = cref]
              deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_real_cte_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_ct_active'[where cref=cref and idx=idx])
  apply (clarsimp simp:conj_comms ball_conj_distrib descendants_range'_def2
                       is_aligned_neg_mask_eq pred_conj_def)
  apply (strengthen invs_mdb' invs_valid_objs' imp_consequent
                invs_valid_pspace' invs_arch_state' invs_pspace_aligned'
                invs_pspace_distinct')
  apply (wp getSlotCap_wp)
  apply (rule_tac x = "capability.UntypedCap ptr sz idx" in exI)
  apply (clarsimp simp:invs_pspace_aligned' invs_pspace_distinct' invs_valid_pspace'
       cte_wp_at_ctes_of conj_comms field_simps shiftl_t2n shiftL_nat invs_ksCurDomain_maxDomain')
  apply (rule conjI)
   apply (erule range_cover.sz(1)[where 'a=32, folded word_bits_def])
   using invokeUntyped_proofs.usableRange_disjoint[OF pf]
         invokeUntyped_proofs.vc'[OF pf]
         invokeUntyped_proofs.cref_inv[OF pf]
         invokeUntyped_proofs.subset_stuff[OF pf]
         us_align
   apply (simp add: is_aligned_neg_mask_eq'[symmetric]
                    pred_tcb'_weakenE[OF st_tcb, simplified]
     is_aligned_neg_mask_eq is_aligned_mask getFreeIndex_def)
   apply (rule conjI)
   apply (clarsimp dest!:invokeUntyped_proofs.slots_invD[OF pf]
       simp:is_aligned_mask[symmetric] is_aligned_neg_mask_eq)+
   done
qed

lemma inv_untyp_tcb'[wp]:
  "\<lbrace>invs' and st_tcb_at' active' tptr
         and valid_untyped_inv' ui and ct_active'\<rbrace>
     invokeUntyped ui
   \<lbrace>\<lambda>rv. tcb_at' tptr\<rbrace>"
  apply (rule hoare_chain [OF inv_untyp_st_tcb_at'[where tptr=tptr and P="\<top>"]])
   apply (clarsimp elim!: pred_tcb'_weakenE)
   apply fastforce
  apply (clarsimp simp: pred_tcb_at'_def)
  done

crunch irq_node[wp]: set_thread_state "\<lambda>s. P (interrupt_irq_node s)"
crunch ctes_of [wp]: setQueue "\<lambda>s. P (ctes_of s)"
crunch cte_wp_at [wp]: setQueue "cte_wp_at' P p"
  (simp: cte_wp_at_ctes_of)

lemma sts_valid_untyped_inv':
  "\<lbrace>valid_untyped_inv' ui\<rbrace> setThreadState st t \<lbrace>\<lambda>rv. valid_untyped_inv' ui\<rbrace>"
  apply (cases ui, simp add: ex_cte_cap_to'_def)
  apply (rule hoare_pre)
   apply (rule hoare_use_eq_irq_node' [OF setThreadState_ksInterruptState])
   apply (wp hoare_vcg_const_Ball_lift hoare_vcg_ex_lift | simp)+
  done

crunch nosch[wp]: insertNewCaps "\<lambda>s. P (ksSchedulerAction s)"
  (simp: crunch_simps zipWithM_x_mapM wp: crunch_wps)

crunch nosch[wp]: createNewObjects "\<lambda>s. P (ksSchedulerAction s)"
  (simp: crunch_simps zipWithM_x_mapM wp: crunch_wps hoare_unless_wp)

lemma invokeUntyped_nosch[wp]:
  "\<lbrace>\<lambda>s. P (ksSchedulerAction s)\<rbrace>
     invokeUntyped invok
   \<lbrace>\<lambda>rv s. P (ksSchedulerAction s)\<rbrace>"
  apply (cases invok, simp add: invokeUntyped_def)
  apply (wp deleteObjects_nosch zipWithM_x_inv hoare_drop_imps)
  apply clarsimp
  done

crunch no_0_obj'[wp]: insertNewCap no_0_obj'
  (wp: crunch_wps)

lemma insertNewCap_valid_pspace':
  "\<lbrace>\<lambda>s. valid_pspace' s \<and> s \<turnstile>' cap
          \<and> slot \<noteq> parent \<and> caps_overlap_reserved' (untypedRange cap) s
          \<and> cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                              sameRegionAs (cteCap cte) cap) parent s
          \<and> \<not> isZombie cap \<and> descendants_range' cap parent (ctes_of s)\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv. valid_pspace'\<rbrace>"
  apply (simp add: valid_pspace'_def)
  apply (wp insertNewCap_valid_mdb)
     apply simp_all
  done

crunch tcb'[wp]: insertNewCap "tcb_at' t"
  (wp: crunch_wps)
crunch inQ[wp]: insertNewCap "obj_at' (inQ d p) t"
  (wp: crunch_wps)
crunch norq[wp]: insertNewCap "\<lambda>s. P (ksReadyQueues s)"
  (wp: crunch_wps)
crunch norqL1[wp]: insertNewCap "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
  (wp: crunch_wps)
crunch norqL2[wp]: insertNewCap "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
  (wp: crunch_wps)
crunch ct[wp]: insertNewCap "\<lambda>s. P (ksCurThread s)"
  (wp: crunch_wps)
crunch state_refs_of'[wp]: insertNewCap "\<lambda>s. P (state_refs_of' s)"
  (wp: crunch_wps)

lemma insertNewCap_ifunsafe'[wp]:
  "\<lbrace>if_unsafe_then_cap' and ex_cte_cap_to' slot\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv s. if_unsafe_then_cap' s\<rbrace>"
  apply (simp add: ifunsafe'_def3 insertNewCap_def)
  apply (wp getCTE_wp')
  apply (clarsimp simp: ex_cte_cap_to'_def cte_wp_at_ctes_of cteCaps_of_def)
  apply (drule_tac x=crefa in spec)
  apply (rule conjI)
   apply clarsimp
   apply (rule_tac x=cref in exI, fastforce)
  apply clarsimp
  apply (rule_tac x=cref' in exI, fastforce)
  done

lemma insertNewCap_iflive'[wp]:
  "\<lbrace>if_live_then_nonz_cap'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. if_live_then_nonz_cap'\<rbrace>"
  apply (simp add: insertNewCap_def)
  apply (wp setCTE_iflive' getCTE_wp')
  apply (clarsimp elim!: cte_wp_at_weakenE')
  done

lemma insertNewCap_cte_wp_at'':
  "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteCap cte)) p and K (\<not> P NullCap)\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv s. cte_wp_at' (P \<circ> cteCap) p s\<rbrace>"
  apply (simp add: insertNewCap_def tree_cte_cteCap_eq)
  apply (wp getCTE_wp')
  apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def)
  done

lemmas insertNewCap_cte_wp_at' = insertNewCap_cte_wp_at''[unfolded o_def]

crunch irq_node'[wp]: insertNewCap "\<lambda>s. P (irq_node' s)"
  (wp: crunch_wps)

lemma insertNewCap_cap_to'[wp]:
  "\<lbrace>ex_cte_cap_to' p\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. ex_cte_cap_to' p\<rbrace>"
  apply (simp add: ex_cte_cap_to'_def)
  apply (rule hoare_pre)
   apply (rule hoare_use_eq_irq_node'[OF insertNewCap_irq_node'])
   apply (wp hoare_vcg_ex_lift insertNewCap_cte_wp_at')
  apply clarsimp
  done

lemma insertNewCap_nullcap:
  "\<lbrace>P and cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) slot\<rbrace> insertNewCap parent slot cap \<lbrace>Q\<rbrace>
    \<Longrightarrow> \<lbrace>P\<rbrace> insertNewCap parent slot cap \<lbrace>Q\<rbrace>"
  apply (clarsimp simp: valid_def)
  apply (subgoal_tac "cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) slot s")
   apply fastforce
  apply (clarsimp simp: insertNewCap_def in_monad cte_wp_at_ctes_of liftM_def
                 dest!: use_valid [OF _ getCTE_sp[where P="op = s" for s], OF _ refl])
  done

crunch idle'[wp]: getCTE "valid_idle'"

lemma insertNewCap_idle'[wp]:
  "\<lbrace>valid_idle' and (\<lambda>s. ksIdleThread s \<notin> capRange cap)\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv. valid_idle'\<rbrace>"
  apply (simp add: insertNewCap_def)
  apply (wp getCTE_no_idle_cap
          | simp add: o_def
          | rule hoare_drop_imp)+
  done

crunch global_refs': insertNewCap "\<lambda>s. P (global_refs' s)"
  (wp: crunch_wps simp: crunch_simps)
crunch gsMaxObjectSize[wp]: insertNewCap "\<lambda>s. P (gsMaxObjectSize s)"
  (wp: crunch_wps simp: crunch_simps)

lemma insertNewCap_valid_global_refs':
  "\<lbrace>valid_global_refs' and
        cte_wp_at' (\<lambda>cte. capRange cap \<subseteq> capRange (cteCap cte)
            \<and> capBits cap \<le> capBits (cteCap cte)) parent\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv. valid_global_refs'\<rbrace>"
  apply (simp add: valid_global_refs'_def valid_refs'_cteCaps valid_cap_sizes_cteCaps)
  apply (rule hoare_pre)
   apply (rule hoare_use_eq [where f=global_refs', OF insertNewCap_global_refs'])
   apply (rule hoare_use_eq [where f=gsMaxObjectSize])
    apply wp
  apply (clarsimp simp: cte_wp_at_ctes_of cteCaps_of_def ball_ran_eq)
  apply (frule power_increasing[where a=2], simp)
  apply (blast intro: order_trans)
  done

lemma insertNewCap_valid_irq_handlers:
  "\<lbrace>valid_irq_handlers' and (\<lambda>s. \<forall>irq. cap = IRQHandlerCap irq \<longrightarrow> irq_issued' irq s)\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv. valid_irq_handlers'\<rbrace>"
  apply (simp add: insertNewCap_def valid_irq_handlers'_def irq_issued'_def)
  apply wp
     apply (simp add: cteCaps_of_def)
     apply (wp hoare_use_eq[where f=ksInterruptState, OF setCTE_ksInterruptState setCTE_ctes_of_wp]
               getCTE_wp)
  apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of ran_def)
  apply auto
  done

crunch irq_states' [wp]: insertNewCap valid_irq_states'
  (wp: getCTE_wp')

crunch pde_mappings' [wp]: insertNewCap valid_pde_mappings'
  (wp: getCTE_wp')

crunch vq'[wp]: insertNewCap valid_queues'
  (wp: crunch_wps)

crunch irqs_masked' [wp]: insertNewCap irqs_masked'
  (wp: crunch_wps lift: irqs_masked_lift)

crunch valid_machine_state'[wp]: insertNewCap valid_machine_state'
  (wp: crunch_wps)

crunch pspace_domain_valid[wp]: insertNewCap pspace_domain_valid
  (wp: crunch_wps)

crunch ct_not_inQ[wp]: insertNewCap "ct_not_inQ"
  (wp: crunch_wps)

crunch ksCurDomain[wp]: insertNewCap "\<lambda>s. P (ksCurDomain s)"
  (wp: crunch_wps)
crunch ksCurThread[wp]: insertNewCap "\<lambda>s. P (ksCurThread s)"
  (wp: crunch_wps)

crunch tcbState_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbState tcb)) t"
  (wp: crunch_simps hoare_drop_imps)
crunch tcbDomain_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbDomain tcb)) t"
  (wp: crunch_simps hoare_drop_imps)
crunch tcbPriority_inv[wp]: insertNewCap "obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t"
  (wp: crunch_simps hoare_drop_imps)
crunch ksIdleThread[wp]: insertNewCap "\<lambda>s. P (ksIdleThread s)"
  (wp: crunch_simps hoare_drop_imps)
crunch ksDomSchedule[wp]: insertNewCap "\<lambda>s. P (ksDomSchedule s)"
  (wp: crunch_simps hoare_drop_imps)
crunch ksInterrupt[wp]: insertNewCap "\<lambda>s. P (ksInterruptState s)"
  (wp: crunch_wps)

lemma insertNewCap_ct_idle_or_in_cur_domain'[wp]:
  "\<lbrace>ct_idle_or_in_cur_domain' and ct_active'\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>_. ct_idle_or_in_cur_domain'\<rbrace>"
apply (wp ct_idle_or_in_cur_domain'_lift_futz[where Q=\<top>])
apply (rule_tac Q="\<lambda>_. obj_at' (\<lambda>tcb. tcbState tcb \<noteq> Structures_H.thread_state.Inactive) t and obj_at' (\<lambda>tcb. d = tcbDomain tcb) t"
             in hoare_strengthen_post)
apply (wp | clarsimp elim: obj_at'_weakenE)+
apply (auto simp: obj_at'_def)
done

crunch ksDomScheduleIdx[wp]: insertNewCap "\<lambda>s. P (ksDomScheduleIdx s)"
  (wp: crunch_simps hoare_drop_imps)

lemma capRange_subset_capBits:
  "capAligned cap \<Longrightarrow> capAligned cap'
    \<Longrightarrow> capRange cap \<subseteq> capRange cap'
    \<Longrightarrow> capRange cap \<noteq> {}
    \<Longrightarrow> capBits cap \<le> capBits cap'"
  apply (simp add: capRange_def capAligned_def is_aligned_no_overflow
            split: split_if_asm del: atLeastatMost_subset_iff)
  apply (frule_tac c="capUntypedPtr cap" in subsetD)
   apply (simp only: mask_in_range[symmetric])
   apply (simp add: is_aligned_neg_mask_eq)
  apply (drule_tac c="(capUntypedPtr cap && ~~ mask (capBits cap))
        || (~~ capUntypedPtr cap' && mask (capBits cap))" in subsetD)
   apply (simp_all only: mask_in_range[symmetric])
   apply (simp add: word_ao_dist is_aligned_neg_mask_eq)
  apply (simp add: word_ao_dist)
  apply (cases "capBits cap = 0")
   apply simp
  apply (drule_tac f="\<lambda>x. x !! (capBits cap - 1)"
        and x="a || b" for a b in arg_cong)
  apply (simp add: word_ops_nth_size word_bits_def word_size)
  apply auto
  done

lemma insertNewCap_invs':
  "\<lbrace>invs' and ct_active'
          and valid_cap' cap
          and cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                              sameRegionAs (cteCap cte) cap) parent
          and K (\<not> isZombie cap) and (\<lambda>s. descendants_range' cap parent (ctes_of s))
          and caps_overlap_reserved' (untypedRange cap)
          and ex_cte_cap_to' slot
          and (\<lambda>s. ksIdleThread s \<notin> capRange cap)
          and (\<lambda>s. \<forall>irq. cap = IRQHandlerCap irq \<longrightarrow> irq_issued' irq s)\<rbrace>
     insertNewCap parent slot cap
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
  apply (rule insertNewCap_nullcap)
  apply (simp add: invs'_def valid_state'_def)
  apply (rule hoare_pre)
   apply (wp insertNewCap_valid_pspace' sch_act_wf_lift
             valid_queues_lift cur_tcb_lift tcb_in_cur_domain'_lift
             insertNewCap_valid_global_refs'
             valid_arch_state_lift'
             valid_irq_node_lift insertNewCap_valid_irq_handlers)
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (frule ctes_of_valid[rotated, where p=parent, OF valid_pspace_valid_objs'])
   apply (fastforce simp: cte_wp_at_ctes_of)
  apply (auto simp: isCap_simps sameRegionAs_def3 intro!: capRange_subset_capBits
              elim: valid_capAligned)
  done

lemma insertNewCap_irq_issued'[wp]:
  "\<lbrace>\<lambda>s. P (irq_issued' irq s)\<rbrace> insertNewCap parent slot cap \<lbrace>\<lambda>rv s. P (irq_issued' irq s)\<rbrace>"
  by (simp add: irq_issued'_def, wp)

lemma insertNewCap_ct_in_state'[wp]:
  "\<lbrace>ct_in_state' p\<rbrace>insertNewCap parent slot cap \<lbrace>\<lambda>rv. ct_in_state' p\<rbrace>"
  unfolding ct_in_state'_def
  apply (rule hoare_pre)
  apply wps
  apply wp
  apply simp
done

lemma zipWithM_x_insertNewCap_invs'':
  "\<lbrace>\<lambda>s. invs' s \<and> ct_active' s \<and> (\<forall>tup \<in> set ls. s \<turnstile>' snd tup)
        \<and> cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                            (\<forall>tup \<in> set ls. sameRegionAs (cteCap cte) (snd tup))) parent s
        \<and> (\<forall>tup \<in> set ls. \<not> isZombie (snd tup))
        \<and> (\<forall>tup \<in> set ls. ex_cte_cap_to' (fst tup) s)
        \<and> (\<forall>tup \<in> set ls. descendants_range' (snd tup) parent (ctes_of s))
        \<and> (\<forall>tup \<in> set ls. ksIdleThread s \<notin> capRange (snd tup))
        \<and> (\<forall>tup \<in> set ls. caps_overlap_reserved' (capRange (snd tup)) s)
        \<and> distinct_sets (map capRange (map snd ls))
        \<and> (\<forall>irq. IRQHandlerCap irq \<in> set (map snd ls) \<longrightarrow> irq_issued' irq s)
        \<and> distinct (map fst ls)\<rbrace>
    mapM (\<lambda>(x, y). insertNewCap parent x y) ls
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
  apply (induct ls)
   apply (simp add: mapM_def sequence_def)
   apply (wp, simp)
  apply (simp add: mapM_Cons)
  apply wp
   apply assumption
  apply (thin_tac "valid P f Q" for P f Q)
  apply clarsimp
  apply (rule hoare_pre)
   apply (wp insertNewCap_invs'
             hoare_vcg_const_Ball_lift
             insertNewCap_cte_wp_at' insertNewCap_ranges
             hoare_vcg_all_lift insertNewCap_pred_tcb_at')
  apply (clarsimp simp: cte_wp_at_ctes_of invs_mdb' invs_valid_objs' dest!:valid_capAligned)
  apply (drule caps_overlap_reserved'_subseteq[OF _ untypedRange_in_capRange])
  apply (auto simp:comp_def)
  done

lemma zipWithM_x_insertNewCap_invs':
  "\<lbrace>\<lambda>s. invs' s \<and> ct_active' s \<and> (\<forall>cap \<in> set cps. s \<turnstile>' cap)
        \<and> cte_wp_at' (\<lambda>cte. isUntypedCap (cteCap cte) \<and>
                            (\<forall>tup \<in> set (zip slots cps). sameRegionAs (cteCap cte) (snd tup))) parent s
        \<and> (\<forall>cap \<in> set cps. \<not> isZombie cap)
        \<and> (\<forall>slot \<in> set slots. ex_cte_cap_to' slot s)
        \<and> (\<forall>cap \<in> set cps. ksIdleThread s \<notin> capRange cap)
        \<and> (\<forall>tup \<in> set (zip slots cps). caps_overlap_reserved' (capRange (snd tup)) s)
        \<and> (\<forall>irq. IRQHandlerCap irq \<in> set cps \<longrightarrow> irq_issued' irq s)
        \<and> distinct slots
        \<and> descendants_of' parent (ctes_of s) = {}
        \<and> distinct_sets (map capRange cps)\<rbrace>
     zipWithM_x (insertNewCap parent) slots cps
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
  apply (rule hoare_pre)
   apply (simp add:zipWithM_x_mapM)
   apply wp
   apply (rule zipWithM_x_insertNewCap_invs'')
  apply (clarsimp simp: descendants_range'_def cte_wp_at_ctes_of
                        distinct_prefix [OF _ map_fst_zip_prefix]
                        distinct_sets_prop
                  simp del: map_map)
  apply (auto simp: map_snd_zip_prefix [unfolded less_eq_list_def]
              dest!: set_zip_helper
              elim!: distinct_prop_prefixE
              intro!: map_prefixeqI
              simp del: map_map)
  done

lemma createNewCaps_not_isZombie[wp]:
  "\<lbrace>\<top>\<rbrace> createNewCaps ty ptr bits sz \<lbrace>\<lambda>rv s. (\<forall>cap \<in> set rv. \<not> isZombie cap)\<rbrace>"
  apply (simp add: createNewCaps_def toAPIType_def ArchTypes_H.toAPIType_def
                   createNewCaps_def
              split del: split_if cong: option.case_cong if_cong
                                        ArchTypes_H.apiobject_type.case_cong
                                        ArchTypes_H.object_type.case_cong)
  apply (rule hoare_pre)
   apply (wp undefined_valid | wpc
            | simp add: isCap_simps)+
  apply auto?
  done

lemma createNewCaps_cap_to':
  "\<lbrace>\<lambda>s. ex_cte_cap_to' p s \<and> 0 < n
      \<and> range_cover ptr sz (APIType_capBits ty us) n
      \<and> pspace_aligned' s \<and> pspace_distinct' s
      \<and> pspace_no_overlap' ptr sz s\<rbrace>
     createNewCaps ty ptr n us
   \<lbrace>\<lambda>rv. ex_cte_cap_to' p\<rbrace>"
  apply (simp add: ex_cte_cap_to'_def)
  apply (wp hoare_vcg_ex_lift
            hoare_use_eq_irq_node' [OF createNewCaps_ksInterrupt
                                       createNewCaps_cte_wp_at'])
  apply fastforce
  done

lemma storePDE_it[wp]:
  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> storePDE ptr val \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
  by (simp add: storePDE_def | wp updateObject_default_inv)+

crunch it[wp]: copyGlobalMappings "\<lambda>s. P (ksIdleThread s)"
  (wp: mapM_x_wp' ignore: clearMemory forM_x getObject)

crunch it[wp]: createWordObjects "\<lambda>s. P (ksIdleThread s)"
  (wp: mapM_x_wp' ignore: clearMemory forM_x getObject)

lemma createNewCaps_idlethread[wp]:
  "\<lbrace>\<lambda>s. P (ksIdleThread s)\<rbrace> createNewCaps tp ptr sz us \<lbrace>\<lambda>rv s. P (ksIdleThread s)\<rbrace>"
  apply (simp add: createNewCaps_def toAPIType_def ArchTypes_H.toAPIType_def
                   createNewCaps_def
            split: ArchTypes_H.object_type.split
                   ArchTypes_H.apiobject_type.split)
  apply safe
          apply (wp mapM_x_wp' | simp)+
  done

lemma createNewCaps_idlethread_ranges[wp]:
  "\<lbrace>\<lambda>s. 0 < n \<and> range_cover ptr sz (APIType_capBits tp us) n
           \<and> ksIdleThread s \<notin> {ptr .. (ptr && ~~ mask sz) + 2 ^ sz - 1}\<rbrace>
     createNewCaps tp ptr n us
   \<lbrace>\<lambda>rv s. \<forall>cap\<in>set rv. ksIdleThread s \<notin> capRange cap\<rbrace>"
  apply (rule hoare_as_subst [OF createNewCaps_idlethread])
  apply (rule hoare_assume_pre)
  apply (rule hoare_chain, rule createNewCaps_range_helper2)
   apply fastforce
  apply blast
  done

lemma createNewCaps_IRQHandler[wp]:
  "\<lbrace>\<top>\<rbrace>
     createNewCaps tp ptr sz us
   \<lbrace>\<lambda>rv s. IRQHandlerCap irq \<in> set rv \<longrightarrow> P rv s\<rbrace>"
  apply (simp add: createNewCaps_def split del: split_if)
  apply (rule hoare_pre)
   apply (wp | wpc | simp add: image_def | rule hoare_pre_cont)+
  done

crunch ksIdleThread[wp]: updateCap "\<lambda>s. P (ksIdleThread s)"

lemma size_eq: "APIType_capBits ao' us = obj_bits_api (APIType_map2 (Inr ao')) us"
    apply (case_tac ao')
      apply (rename_tac apiobject_type)
      apply (case_tac apiobject_type)
      apply (clarsimp simp: APIType_capBits_def objBits_def arch_kobj_size_def default_arch_object_def
        obj_bits_api_def APIType_map2_def objBitsKO_def slot_bits_def pageBitsForSize_def)+
    done

lemma obj_at_in_obj_range':
  "\<lbrakk>ksPSpace s p = Some ko; pspace_aligned' s\<rbrakk>
   \<Longrightarrow> p \<in> {p.. p + 2 ^ objBitsKO ko - 1}"
  apply (drule(1) pspace_alignedD')
  apply (clarsimp)
  apply (erule is_aligned_no_overflow)
  done

lemma updateCap_weak_cte_wp_at:
  "\<lbrace>\<lambda>s. if p = ptr then P (cteCap (cteCap_update (\<lambda>_. cap) cte))
        else cte_wp_at' (\<lambda>c. P (cteCap c)) p s\<rbrace>
   updateCap ptr cap
   \<lbrace>\<lambda>uu. cte_wp_at' (\<lambda>c. P (cteCap c)) p\<rbrace>"
   apply (simp add:updateCap_def)
   apply (wp setCTE_weak_cte_wp_at getCTE_wp)
   apply (clarsimp simp:cte_wp_at'_def)
   done

lemma createNewCaps_ct_active':
  "\<lbrace>ct_active' and pspace_aligned' and pspace_distinct' and pspace_no_overlap' ptr sz and K (range_cover ptr sz (APIType_capBits ty us) n \<and> 0 < n)\<rbrace>
    createNewCaps ty ptr n us
   \<lbrace>\<lambda>_. ct_active'\<rbrace>"
apply (simp add: ct_in_state'_def)
apply (rule hoare_pre)
apply wps
apply (wp createNewCaps_pred_tcb_at'[where sz=sz])
apply simp
done

crunch gsMaxObjectSize[wp]: deleteObjects "\<lambda>s. P (gsMaxObjectSize s)"
  (simp: unless_def wp: crunch_wps)

lemma invokeUntyped_invs'':
   "ui = Retype cref ptr_base ptr tp us slots \<Longrightarrow>
   \<lbrace>invs' and valid_untyped_inv' ui and ct_active'\<rbrace>
     invokeUntyped ui
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
  apply (cases ui, simp)
  apply (rule hoare_name_pre_state)
  apply (clarsimp simp del: split_paired_All split_paired_Ex split_paired_Ball invokeUntyped_def)
  apply (rename_tac s sz idx)
  proof -
    fix s sz idx
    assume cte_wp_at': "cte_wp_at' (\<lambda>cte. cteCap cte = capability.UntypedCap (ptr && ~~ mask sz) sz idx) cref s"
    assume cover     : "range_cover ptr sz (APIType_capBits tp us) (length slots)"
    assume vslot     : "slots \<noteq> []"
    assume desc_range: "ptr = ptr && ~~ mask sz \<longrightarrow> descendants_range_in' {ptr..ptr + 2 ^ sz - 1} (cref) (ctes_of s)"
    assume misc      : "distinct slots" "cref \<notin> set slots" "ct_active' s"
      "tp = APIObjectType ArchTypes_H.apiobject_type.CapTableObject \<longrightarrow> 0 < us"
      "tp = APIObjectType ArchTypes_H.apiobject_type.Untyped \<longrightarrow> 4 \<le> us \<and> us \<le> 30"
      "idx \<le> unat (ptr && mask sz) \<or> ptr = ptr && ~~ mask sz"
      "invs' s"
      "\<forall>slot\<in>set slots. ex_cte_cap_wp_to' (\<lambda>_. True) slot s"
      "\<forall>slot\<in>set slots. cte_wp_at' (\<lambda>c. cteCap c = capability.NullCap) slot s"
      "ct_active' s" "sch_act_simple s"
    have pf: "invokeUntyped_proofs s cref ptr tp us slots sz idx"
       using cte_wp_at' cover vslot desc_range misc
       by (simp add:invokeUntyped_proofs_def)
    have of_nat_length: "(of_nat (length slots)::word32) - (1::word32) < (of_nat (length slots)::word32)"
       using vslot
       using range_cover.range_cover_le_n_less(1)[OF cover,where p = "length slots"]
       apply -
       apply (case_tac slots)
        apply clarsimp+
       apply (subst add.commute)
       apply (subst word_le_make_less[symmetric])
       apply (rule less_imp_neq)
       apply (simp add:word_bits_def minus_one_norm)
       apply (rule word_of_nat_less)
       apply auto
       done

    have us_align[simp]:"is_aligned ((ptr && mask sz) + 2 ^ APIType_capBits tp us * of_nat (length slots)) 4"
    using misc cover
    apply -
    apply (rule aligned_add_aligned[OF aligned_after_mask])
       apply (rule range_cover.aligned[OF cover])
      apply (rule is_aligned_weaken)
       apply (rule is_aligned_shiftl_self[unfolded shiftl_t2n])
      apply (case_tac tp,(clarsimp simp:APIType_capBits_def objBits_simps
         split: ArchTypes_H.apiobject_type.splits)+)[1]
     apply (simp add:range_cover_def)
    apply (case_tac tp,(clarsimp simp:APIType_capBits_def objBits_simps
      split: ArchTypes_H.apiobject_type.splits)+)[1]
    done

    note not_0_ptr[simp] = invokeUntyped_proofs.not_0_ptr [OF pf]
    note subset_stuff[simp] = invokeUntyped_proofs.subset_stuff[OF pf]

    have non_detype_idx_le[simp]: "ptr \<noteq>  ptr && ~~ mask sz \<Longrightarrow> idx < 2^sz"
       using misc
       apply clarsimp
       apply (erule le_less_trans)
       apply (rule unat_less_helper)
       apply simp
       apply (rule le_less_trans)
       apply (rule word_and_le1)
       apply (simp add:mask_def)
       apply (rule minus_one_helper)
       apply simp
       using cover
       apply (clarsimp simp:range_cover_def)
       done

    note blah[simp del] = untyped_range.simps usable_untyped_range.simps atLeastAtMost_iff atLeastatMost_subset_iff atLeastLessThan_iff
          Int_atLeastAtMost atLeastatMost_empty_iff split_paired_Ex usableUntypedRange.simps
    note descendants_range[simp] = invokeUntyped_proofs.descendants_range[OF pf]
    note vc'[simp] = invokeUntyped_proofs.vc'[OF pf]
    note ps_no_overlap'[simp] = invokeUntyped_proofs.ps_no_overlap'[OF pf]
    note caps_no_overlap'[simp] = invokeUntyped_proofs.caps_no_overlap'[OF pf]
    note ex_cte_no_overlap' = invokeUntyped_proofs.ex_cte_no_overlap'[OF pf]
    note cref_inv = invokeUntyped_proofs.cref_inv[OF pf]
    note slots_invD = invokeUntyped_proofs.slots_invD[OF pf]
    note nidx[simp] = add_minus_neg_mask[where ptr = ptr]
    note idx_compare' = invokeUntyped_proofs.idx_compare'[OF pf]

    have idx_compare :
       "\<lbrakk>unat ((ptr && mask sz) + of_nat (length slots) * 2 ^ APIType_capBits tp us) < 2 ^ sz;ptr \<noteq> ptr && ~~ mask sz\<rbrakk>
       \<Longrightarrow> (ptr && ~~ mask sz) + of_nat idx \<le> ptr + (of_nat (length slots) << APIType_capBits tp us)"
       apply (rule range_cover_idx_compare[OF cover ])
         apply assumption+
       apply (frule non_detype_idx_le)
       apply (erule less_imp_le)
       using misc
       apply simp
       done

    have usable_range_subset:
      "ptr && ~~ mask sz \<noteq> ptr
      \<Longrightarrow> usableUntypedRange (capability.UntypedCap (ptr &&~~ mask sz) sz
                       (getFreeIndex (ptr &&~~ mask sz) (ptr + of_nat (length slots) * 2 ^ APIType_capBits tp us)))
                      \<subseteq> usableUntypedRange (capability.UntypedCap (ptr&&~~ mask sz) sz idx)"
      "ptr && ~~ mask sz \<noteq> ptr
      \<Longrightarrow>usable_untyped_range
                     (cap.UntypedCap (ptr && ~~ mask sz) sz
                       (unat ((ptr && mask sz) + (of_nat (length slots) << (APIType_capBits tp us)))))
                    \<subseteq> usable_untyped_range (cap.UntypedCap (ptr && ~~ mask sz) sz idx)"
      apply (simp_all add:blah getFreeIndex_def field_simps nidx)
      apply (clarsimp)
       apply (subst add.commute)
       apply (erule order_trans[OF idx_compare])
        apply simp
       apply (subst word_plus_and_or_coroll2[symmetric,where w = "mask sz"])
       apply (simp add:shiftl_t2n field_simps)
      apply (clarsimp simp:shiftl_t2n nidx field_simps)
       apply (subst add.commute)
       apply (erule order_trans[OF idx_compare])
        apply simp
       apply (clarsimp simp:shiftl_t2n add.assoc[symmetric]
         word_plus_and_or_coroll2[where w = "mask sz"] field_simps)
      done

    have valid_global_refs': "valid_global_refs' s"
      using misc by auto

    have kernel_data_refs[simp]:
        "\<And>p2. p2 = ptr && ~~ mask sz
            \<Longrightarrow> {ptr .. p2 + 2 ^ sz - 1} \<inter> kernel_data_refs = {}"
      using cte_wp_at' valid_global_refs'
      apply (clarsimp simp: cte_wp_at_ctes_of valid_global_refs'_def
                            valid_refs'_def)
      apply (drule bspec, erule ranI)
      apply (subst Int_commute, erule disjoint_subset2[rotated])
      apply (simp add: atLeastatMost_subset_iff word_and_le2)
      done

    have gsMaxObjectSize_0: "0 < gsMaxObjectSize s"
      using cte_wp_at' valid_global_refs'
      by (clarsimp simp: valid_global_refs'_def cte_wp_at_ctes_of cte_at_valid_cap_sizes_0)

    note neg_mask_add_mask = word_plus_and_or_coroll2
    [symmetric,where w = "mask sz" and t = ptr,symmetric]
    note msimp[simp add] =  misc getObjectSize_def_eq neg_mask_add_mask
    show "\<lbrace>op = s\<rbrace> invokeUntyped
      (Invocations_H.untyped_invocation.Retype cref (ptr && ~~ mask sz) ptr tp us slots)
      \<lbrace>\<lambda>rv. invs'\<rbrace>"
    apply (clarsimp simp:invokeUntyped_def getSlotCap_def)
    apply (case_tac "ptr && ~~ mask sz \<noteq> ptr")
      apply (wp createNewObjects_wp_helper[where sz = sz])
            apply simp+
           apply (rule cover)
          apply simp
         using vslot
         apply simp
      apply (clarsimp simp:insertNewCaps_def)
      apply (insert misc cover vslot)
      apply (wp zipWithM_x_insertNewCap_invs''
                set_tuple_pick distinct_tuple_helper
                hoare_vcg_const_Ball_lift
                createNewCaps_invs'[where sz = sz]
                createNewCaps_valid_cap[where sz = sz,OF cover]
                createNewCaps_parent_helper[where sz = sz and ptr_base = "ptr && ~~ mask sz"]
                createNewCaps_cap_to'[where sz = sz]
                createNewCaps_descendants_range_ret'[where sz = sz]
                createNewCaps_caps_overlap_reserved_ret'[where sz = sz]
                createNewCaps_ranges[where sz = sz]
                createNewCaps_ranges'[where sz = sz]
                createNewCaps_IRQHandler
                createNewCaps_ct_active'[where sz=sz]
      | simp add: zipWithM_x_mapM)+
      apply (wp hoare_vcg_all_lift)
      apply (wp hoare_strengthen_post[OF createNewCaps_IRQHandler])
      apply (intro impI)
       apply (erule impE)
       apply (erule(1) snd_set_zip_in_set)
      apply (wp hoare_strengthen_post[OF createNewCaps_range_helper[where sz = sz]])
       apply clarsimp
     apply (clarsimp simp:conj_comms ball_conj_distrib pred_conj_def
                 simp del:capFreeIndex_update.simps)
     apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
                invs_valid_pspace' invs_arch_state'
                imp_consequent[where Q = "(\<exists>x. x \<in> set slots)"]
              | clarsimp simp:conj_comms not_0_ptr simp del:capFreeIndex_update.simps)+
     apply (wp updateFreeIndex_invs' updateFreeIndex_caps_overlap_reserved'
       updateFreeIndex_caps_no_overlap'' updateFreeIndex_pspace_no_overlap'
       hoare_vcg_const_Ball_lift updateCap_weak_cte_wp_at updateCap_ct_active')
      apply (simp add:ex_cte_cap_wp_to'_def)
      apply wps
      apply (rule hoare_vcg_ex_lift)
      apply (wp updateCap_weak_cte_wp_at updateCap_ct_active' getCTE_wp hoare_vcg_ball_lift)
     apply (wp updateFreeIndex_caps_overlap_reserved'
               updateFreeIndex_descendants_range_in' getCTE_wp | simp)+
    using cte_wp_at'
    apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps getFreeIndex_def
                          shiftL_nat shiftl_t2n gsMaxObjectSize_0)
     apply (intro conjI)
             apply (simp add: range_cover_unat[OF cover,unfolded size_eq]
                              range_cover.unat_of_nat_shift size_eq field_simps)+
            apply (clarsimp dest!: range_cover.range_cover_compare_bound)
           apply (simp add: invs_valid_pspace')
           using `invs' s`
           apply (simp add: invs'_def valid_state'_def)
          apply (clarsimp dest!: slots_invD
                           simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of)
          apply (rule_tac x = crefa in exI)
          apply clarsimp
         apply simp+
     apply (rule subset_trans[OF subset_stuff])
     apply (clarsimp simp:blah word_and_le2)
    apply (simp add:field_simps)
    apply (rule invokeUntyped_proofs.usableRange_disjoint[OF pf])
   apply (drule ps_no_overlap')
   using misc
   apply -
   apply (frule invs_valid_idle')
   apply (clarsimp simp:valid_idle'_def pred_tcb_at'_def obj_at'_def)
   apply (frule obj_at_in_obj_range')
     apply (simp add:invs_pspace_aligned')
   apply (drule(1) pspace_no_overlapD')
   apply blast
  apply (clarsimp simp:insertNewCaps_def)
  apply (insert misc cover vslot)
  apply (wp createNewObjects_wp_helper[where sz = sz])
      apply simp+
     apply (clarsimp simp:insertNewCaps_def)
     apply (wp zipWithM_x_insertNewCap_invs''
      set_tuple_pick distinct_tuple_helper
      hoare_vcg_const_Ball_lift
      createNewCaps_invs'[where sz = sz]
      createNewCaps_valid_cap[where sz = sz,OF cover]
      createNewCaps_parent_helper[where sz = sz]
      createNewCaps_cap_to'[where sz = sz]
      createNewCaps_descendants_range_ret'[where sz = sz]
      createNewCaps_caps_overlap_reserved_ret'[where sz = sz]
      createNewCaps_ranges[where sz = sz]
      createNewCaps_ranges'[where sz = sz]
      createNewCaps_IRQHandler
      createNewCaps_ct_active'
      | simp add:zipWithM_x_mapM)+
     apply (wp hoare_vcg_all_lift)
     apply (wp hoare_strengthen_post[OF createNewCaps_IRQHandler])
     apply (intro impI)
     apply (erule impE)
      apply (erule(1) snd_set_zip_in_set)
     apply (wp hoare_strengthen_post[OF createNewCaps_range_helper[where sz = sz]])
     apply clarsimp
    apply (clarsimp simp:conj_comms ball_conj_distrib pred_conj_def
                simp del:capFreeIndex_update.simps)
    apply (strengthen invs_pspace_aligned' invs_pspace_distinct'
                invs_valid_pspace' invs_arch_state'
                imp_consequent[where Q = "(\<exists>x. x \<in> set slots)"]
              | clarsimp simp:conj_comms not_0_ptr simp del:capFreeIndex_update.simps)+
     apply (wp updateFreeIndex_invs_simple'
       updateFreeIndex_caps_overlap_reserved'
       updateFreeIndex_caps_no_overlap''[where sz = sz]
       updateFreeIndex_pspace_no_overlap'[where sz = sz]
       hoare_vcg_const_Ball_lift updateCap_weak_cte_wp_at)
      apply (simp add:ex_cte_cap_wp_to'_def)
      apply wps
      apply (rule hoare_vcg_ex_lift)
      apply (wp updateCap_weak_cte_wp_at getCTE_wp updateCap_ct_active' hoare_vcg_ball_lift)
     apply (wp updateFreeIndex_caps_overlap_reserved'
       updateFreeIndex_descendants_range_in' getCTE_wp)
    apply (strengthen imp_consequent[where Q="\<not> cNodeOverlap A B" for A B])
    apply (clarsimp simp: conj_comms split del: split_if)
    apply (strengthen invs_pspace_aligned' invs_valid_pspace' imp_consequent
          invs_pspace_distinct' invs_arch_state invs_psp_aligned)
    apply (clarsimp simp:conj_comms isCap_simps
         shiftL_nat field_simps range_cover.unat_of_nat_shift[OF cover le_refl,simplified])
    apply (rule_tac P = "cteCap cte = capability.UntypedCap (ptr && ~~ mask sz) sz idx"
      in hoare_gen_asm)
    apply simp
    apply (wp deleteObjects_invs'[where idx = idx and p = "cref"]
              deleteObjects_caps_no_overlap''[where idx = idx and slot = "cref"]
              deleteObject_no_overlap[where idx = idx]
              deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_caps_overlap_reserved'[where idx = idx and slot = "cref"]
              deleteObjects_descendants[where idx = idx and p = "cref"]
              hoare_vcg_ball_lift hoare_drop_imp hoare_vcg_ex_lift
              deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_real_cte_at'[where idx = idx and ptr = ptr and bits = sz]
              deleteObjects_ct_active')
    apply wps
    apply (wp deleteObjects_cte_wp_at'[where idx = idx and ptr = ptr and bits = sz])[2]
  using vc'
  apply (clarsimp simp:conj_comms ball_conj_distrib descendants_range'_def2 is_aligned_neg_mask_eq)
  apply (strengthen invs_mdb invs_valid_objs imp_consequent
                invs_valid_pspace invs_arch_state invs_psp_aligned
                invs_distinct)
  apply (wp getCTE_wp)
  using cte_wp_at' cref_inv misc us_align descendants_range
  apply (clarsimp simp: is_aligned_neg_mask_eq' invs_valid_pspace' invs_ksCurDomain_maxDomain'
       cte_wp_at_ctes_of isCap_simps getFreeIndex_def shiftL_nat shiftl_t2n
       gsMaxObjectSize_0)
  apply (intro conjI)
               apply (rule range_cover.sz
                 [where 'a=32, folded word_bits_def, OF cover])
               using `invs' s` apply (simp add: invs'_def valid_state'_def)
              apply fastforce+
         apply (clarsimp dest!: slots_invD)
        apply (simp add:range_cover.unat_of_nat_shift[OF cover] size_eq field_simps)+
       apply (subst mult.commute)
       apply (rule nat_le_power_trans)
        apply (rule range_cover.range_cover_n_le[OF cover,unfolded size_eq])
       apply (rule range_cover.sz[OF cover,unfolded size_eq])
      apply (clarsimp simp: mask_out_sub_mask field_simps)
     using misc
     apply -
     apply (frule invs_valid_global')
     apply (clarsimp simp:valid_global_refs'_def valid_refs'_def)
     apply (thin_tac "\<forall>x\<in> A. P x" for A P)
     apply (drule bspec)
      apply fastforce
     apply (erule(1) in_empty_interE[OF  _ subsetD])
      prefer 2
      apply simp
     apply (clarsimp simp:global_refs'_def)
    apply (cut_tac subset_stuff,simp)
   using invokeUntyped_proofs.usableRange_disjoint[OF pf]
   apply (simp add: is_aligned_neg_mask_eq'[symmetric]
     is_aligned_neg_mask_eq is_aligned_mask getFreeIndex_def)
  apply (rule ballI)
  apply (drule(1) bspec)+
  apply (clarsimp simp: ex_cte_cap_wp_to'_def cte_wp_at_ctes_of )
  apply (rule_tac x = crefa in exI,clarsimp)
  apply (intro conjI,clarsimp)
  apply (subgoal_tac "ex_cte_cap_wp_to' (\<lambda>_. True) p s" for p s)
   apply (drule ex_cte_no_overlap')
   apply simp
  apply (rule if_unsafe_then_capD')
    apply (auto simp:cte_wp_at_ctes_of invs_unsafe_then_cap')
  done
qed

lemma invokeUntyped_invs'[wp]:
  "\<lbrace>invs' and valid_untyped_inv' ui and ct_active'\<rbrace>
     invokeUntyped ui
   \<lbrace>\<lambda>rv. invs'\<rbrace>"
  by (cases ui, erule invokeUntyped_invs'')

end