fix ARM_HYP Refine for newest corres method after ARM_HYP rebase

VER-737

proof/refine/ARM_HYP/ArchAcc_R.thy

@@ -103,7 +103,7 @@ lemma asid_low_bits [simp]:
   "asidLowBits = asid_low_bits"
   by (simp add: asid_low_bits_def asidLowBits_def)
 
-lemma get_asid_pool_corres [corres]:
+lemma get_asid_pool_corres [@lift_corres_args, corres]:
   "corres (\<lambda>p p'. p = inv ASIDPool p' o ucast)
           (asid_pool_at p) (asid_pool_at' p)
           (get_asid_pool p) (getObject p)"
@@ -264,7 +264,7 @@ lemma pde_relation_aligned_simp:
   by (clarsimp simp: pde_relation_aligned_def pde_bits_def
               split: ARM_HYP_H.pde.splits if_splits)
 
-lemma get_pde_corres [corres]:
+lemma get_pde_corres [@lift_corres_args, corres]:
   "corres (pde_relation_aligned (p >> pde_bits)) (pde_at p) (pde_at' p)
      (get_pde p) (getObject p)"
   apply (simp add: getObject_def get_pde_def get_pd_def get_object_def split_def bind_assoc)
@@ -558,7 +558,7 @@ lemma valid_pde_duplicates_at'_pde_obj:
   done
 
 
-lemma get_master_pde_corres [corres]:
+lemma get_master_pde_corres [@lift_corres_args, corres]:
   "corres master_pde_relation (pde_at p)
      (pde_at' p and (\<lambda>s. vs_valid_duplicates' (ksPSpace s)) and
       pspace_aligned' and pspace_distinct')
@@ -568,7 +568,7 @@ lemma get_master_pde_corres [corres]:
    apply (rule no_fail_pre, wp)
    apply clarsimp
   apply (clarsimp simp: in_monad)
-  using get_pde_corres [of p]
+  using get_pde_corres [OF refl, of p]
   apply (clarsimp simp: corres_underlying_def)
   apply (drule bspec, assumption, clarsimp)
   apply (drule (1) bspec, clarsimp)
@@ -642,7 +642,7 @@ lemma pte_relation_aligned_simp:
   by (clarsimp simp: pte_relation_aligned_def pte_bits_def
               split: ARM_HYP_H.pte.splits if_splits)
 
-lemma get_pte_corres [corres]:
+lemma get_pte_corres [@lift_corres_args, corres]:
   "corres (pte_relation_aligned (p >> pte_bits)) (pte_at p) (pte_at' p)
      (get_pte p) (getObject p)"
   apply (simp add: getObject_def get_pte_def get_pt_def get_object_def split_def bind_assoc)
@@ -851,7 +851,7 @@ lemma get_master_pte_corres [corres]:
    apply (rule no_fail_pre, wp)
    apply clarsimp
   apply (clarsimp simp: in_monad)
-  using get_pte_corres [of p]
+  using get_pte_corres [OF refl, of p]
   apply (clarsimp simp: corres_underlying_def)
   apply (drule bspec, assumption, clarsimp)
   apply (drule (1) bspec, clarsimp)
@@ -1273,12 +1273,11 @@ lemma getPTE_wp:
 lemmas get_pde_wp_valid = hoare_add_post'[OF get_pde_valid get_pde_wp]
 
 lemma page_table_at_lift:
-  "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
+  "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow> (ptrFromPAddr ptr) = ptr' \<longrightarrow>
-  (pspace_aligned s \<and> valid_pde (ARM_A.PageTablePDE ptr) s \<and> (ptrFromPAddr ptr) = ptr') \<longrightarrow>
+  (pspace_aligned s \<and> valid_pde (ARM_A.PageTablePDE ptr) s) \<longrightarrow>
   pspace_distinct' s' \<longrightarrow> page_table_at' ptr' s'"
   by (fastforce intro!: page_table_at_state_relation)
 
-
 lemmas checkPTAt_corres [corresK] =
   corres_stateAssert_implied_frame[OF page_table_at_lift, folded checkPTAt_def]
 
@@ -1457,8 +1456,7 @@ lemma createMappingEntries_valid_slots' [wp]:
   apply (auto elim: is_aligned_weaken)
   done
 
-lemmas mapME_x_corresK_inv =
+lemmas [corresc_simp] = master_pte_relation_def master_pde_relation_def
-  mapME_x_corres_inv[OF corresK_unlift[where F=F], THEN corresK_lift[where F=F], corresK] for F
 
 lemma ensure_safe_mapping_corres [corres]:
   "mapping_map m m' \<Longrightarrow>
@@ -1470,11 +1468,9 @@ lemma ensure_safe_mapping_corres [corres]:
   apply (cases m; cases m'; simp;
          match premises in "(_ \<otimes> op =) p p'" for p p' \<Rightarrow> \<open>cases "fst p"; cases "fst p'"\<close>; clarsimp)
         by (corressimp corresK: mapME_x_corresK_inv
-                          simp: master_pte_relation_def master_pde_relation_def
                             wp: get_master_pte_wp get_master_pde_wp getPTE_wp getPDE_wp;
             auto simp add: valid_mapping_entries_def)+
 
-
 lemma asidHighBitsOf [simp]:
   "asidHighBitsOf asid = ucast (asid_high_bits_of asid)"
   apply (simp add: asidHighBitsOf_def asid_high_bits_of_def asidHighBits_def)
@@ -1483,10 +1479,10 @@ lemma asidHighBitsOf [simp]:
   done
 
 lemma page_directory_at_lift:
-  "\<forall>s s'. (s, s') \<in> state_relation \<longrightarrow>
+  "corres_inst_eq ptr ptr' \<Longrightarrow> \<forall>s s'. (s, s') \<in> state_relation \<longrightarrow> True \<longrightarrow>
   (pspace_aligned s \<and> page_directory_at ptr s) \<longrightarrow>
-  pspace_distinct' s' \<longrightarrow> page_directory_at' ptr s'"
+  pspace_distinct' s' \<longrightarrow> page_directory_at' ptr' s'"
-  by (fastforce intro!: page_directory_at_state_relation)
+  by (fastforce simp: corres_inst_eq_def intro!: page_directory_at_state_relation )
 
 lemmas checkPDAt_corres =
   corres_stateAssert_implied_frame[OF page_directory_at_lift, folded checkPDAt_def]
@@ -1501,9 +1497,7 @@ lemma ko_at_typ_at_asidpool:
   "ko_at (ArchObj (arch_kernel_obj.ASIDPool pool)) x s \<Longrightarrow> typ_at (AArch AASIDPool) x s"
   by (clarsimp simp: obj_at_def a_type_simps)
 
-lemma find_pd_for_asid_corres [corres]:
+lemma find_pd_for_asid_corres [@lift_corres_args, corres]:
-  notes [corres del] = get_asid_pool_corres and [corres] = get_asid_pool_corres'
-  shows
   "corres (lfr \<oplus> op =) ((\<lambda>s. valid_arch_state s \<or> vspace_at_asid asid pd s)
                            and valid_vspace_objs and pspace_aligned
                            and K (0 < asid \<and> asid \<le> mask asidBits))
@@ -1544,6 +1538,7 @@ lemma find_pd_for_asid_corres [corres]:
       by (simp add: ranI)+
     apply (insert prems)
     apply (fastforce simp add: asidRange_def mask_2pm1[symmetric])
+  subgoal for x by (insert asid_pool_at[of x], auto simp: arm_asid_table_related)
   subgoal for x ko xa
    apply (cases ko; simp)
    apply (frule arm_asid_table_related[where s'=s', simplified o_def])
@@ -1562,7 +1557,7 @@ lemma find_pd_for_asid_corres':
                            and pspace_aligned and  K (0 < asid \<and> asid \<le> mask asidBits))
                        (pspace_aligned' and pspace_distinct' and no_0_obj')
                        (find_pd_for_asid asid) (findPDForASID asid)"
-  apply (rule corres_guard_imp, rule find_pd_for_asid_corres)
+  apply (rule corres_guard_imp, rule find_pd_for_asid_corres[OF refl])
    apply fastforce
   apply simp
   done

proof/refine/ARM_HYP/Arch_R.thy

@@ -567,7 +567,7 @@ lemma resolve_vaddr_corres:
        apply (clarsimp simp: page_table_pte_at_lookupI' page_table_at_state_relation)
       apply clarsimp
       apply (erule(3) page_table_at_state_relation)
-     apply wp+
+     apply wpsimp+
    apply (clarsimp simp: page_directory_pde_at_lookupI)
   apply (clarsimp simp: page_directory_pde_at_lookupI' page_directory_at_state_relation)
   done
@@ -622,7 +622,7 @@ lemma dec_arch_inv_page_flush_corres:
     apply (rule corres_splitEE)
        prefer 2
        apply (rule corres_lookup_error)
-       apply (rule find_pd_for_asid_corres)
+       apply (rule find_pd_for_asid_corres[OF refl])
       apply (rule whenE_throwError_corres, simp)
        apply simp
       apply (rule whenE_throwError_corres, simp)
@@ -908,8 +908,7 @@ lemma dec_vcpu_inv_corres:
     apply (cases args; clarsimp)
     apply (case_tac list; clarsimp simp add: rangeCheck_def range_check_def unlessE_whenE)
     apply (clarsimp simp: shiftL_nat whenE_bindE_throwError_to_if)
-    supply corresK(7)[corresK del]
+    apply (corressimp wp: get_vcpu_wp)
-    apply (corressimp corresK: corresK_if wp: get_vcpu_wp corres_rv_defer_left)
     apply (clarsimp simp: archinv_relation_def vcpu_invocation_map_def ucast_id
                        valid_cap'_def valid_cap_def
                        make_virq_def makeVIRQ_def split:if_split)
@@ -1119,7 +1118,7 @@ shows
                              valid_cap (cap.ArchObjectCap
                                          (arch_cap.PageDirectoryCap wd (Some optv)))"
                      in corres_guard_imp)
-            apply (rule find_pd_for_asid_corres)
+            apply (rule find_pd_for_asid_corres[OF refl])
            apply (clarsimp simp: valid_cap_def)
            apply (simp add: mask_def)
           apply assumption
@@ -1198,7 +1197,7 @@ shows
          apply (rule corres_splitEE)
             prefer 2
             apply (rule corres_lookup_error)
-            apply (rule find_pd_for_asid_corres)
+            apply (rule find_pd_for_asid_corres[OF refl])
            apply (rule whenE_throwError_corres)
              apply simp
             apply simp
@@ -1270,7 +1269,7 @@ shows
       apply (rule corres_splitEE)
          prefer 2
          apply (rule corres_lookup_error)
-         apply (rule find_pd_for_asid_corres)
+         apply (rule find_pd_for_asid_corres [OF refl])
         apply (rule whenE_throwError_corres, simp, simp)
         apply (rule corres_splitEE)
            prefer 2
@@ -1347,7 +1346,7 @@ shows
      apply (rule corres_splitEE)
         prefer 2
         apply (rule corres_lookup_error)
-        apply (rule find_pd_for_asid_corres)
+        apply (rule find_pd_for_asid_corres [OF refl])
        apply (rule whenE_throwError_corres, simp)
         apply clarsimp
        apply (simp add: liftE_bindE)
@@ -1389,6 +1388,7 @@ shows
   apply (simp, rule corres_guard_imp[OF dec_vcpu_inv_corres]; simp)
   done
 
+
 lemma invokeVCPUInjectIRQ_corres:
   "corres (op =) (vcpu_at v) (vcpu_at' v)
         (do y \<leftarrow> invoke_vcpu_inject_irq v index virq;
@@ -1397,12 +1397,7 @@ lemma invokeVCPUInjectIRQ_corres:
         (invokeVCPUInjectIRQ v index virq)"
   unfolding invokeVCPUInjectIRQ_def invoke_vcpu_inject_irq_def
   apply (clarsimp simp: bind_assoc)
-  apply (corressimp corres: corres_get_vcpu set_vcpu_corres wp: corres_rv_wp_left get_vcpu_wp)
+  apply (corressimp corres: corres_get_vcpu set_vcpu_corres wp: get_vcpu_wp)
-      apply (rule corresK_split)
-          apply (rule corresK_if[where F=True])
-           apply (corressimp corres: corres_get_vcpu set_vcpu_corres
-                            corresK: corresK_machine_op
-                                 wp: corres_rv_wp_left wp_post_taut get_vcpu_wp)+
   apply clarsimp
   apply (safe
         ; case_tac "vcpuVGIC rv'"
@@ -1416,7 +1411,7 @@ lemmas corres_discard_r =
 
 lemma dmo_gets_corres:
   "corres (op =) P P' (do_machine_op (gets f)) (doMachineOp (gets f))"
-  apply (corres corresK: corresK_machine_op)
+  apply (corres)
   apply (auto simp : corres_underlyingK_def)
   done
 
@@ -1431,14 +1426,7 @@ lemma invoke_vcpu_read_register_corres:
                  (invokeVCPUReadReg v r)"
   unfolding invoke_vcpu_read_register_def invokeVCPUReadReg_def read_vcpu_register_def readVCPUReg_def
   apply (rule corres_discard_r)
-  apply corres
+  apply (corressimp corres: corres_get_vcpu wp: get_vcpu_wp)
-  apply (corres_once corresK: corresK_if)
-  apply (corresc)
-  apply (corressimp corres: corres_get_vcpu
-                   corresK: corresK_machine_op corresK_if
-                        wp: corres_rv_defer_left)+
-  apply (rule conjI)
-  apply (intro allI impI conjI; rule TrueI) (* FIXME where is this coming from? *)
   apply (clarsimp simp: vcpu_relation_def split: option.splits)
   apply (wpsimp simp: getCurThread_def)+
   done
@@ -1465,15 +1453,8 @@ lemma invoke_vcpu_write_register_corres:
   unfolding invokeVCPUWriteReg_def invoke_vcpu_write_register_def write_vcpu_register_def
             writeVCPUReg_def
   apply (rule corres_discard_r)
-  apply corres
+  apply (corressimp corres: set_vcpu_corres corres_get_vcpu wp: get_vcpu_wp)
-  apply (corres_once corresK: corresK_if)
+  subgoal by (auto simp: vcpu_relation_def split: option.splits)
-  apply (corresc)
-  apply (corressimp corres: set_vcpu_corres corres_get_vcpu
-                   corresK: corresK_if corresK_machine_op
-                        wp: corres_rv_defer_left)+
-  apply (rule conjI)
-  apply (intro allI impI conjI; rule TrueI) (* FIXME where is this coming from? *)
-  apply (auto simp: vcpu_relation_def split: option.splits)[1]
   apply (wpsimp simp: getCurThread_def)+
   done
 
@@ -1504,8 +1485,9 @@ lemma associate_vcpu_tcb_corres:
                (associateVCPUTCB v t)"
   unfolding associate_vcpu_tcb_def associateVCPUTCB_def
   apply (clarsimp simp: bind_assoc)
-  apply (corressimp search: corres_get_vcpu set_vcpu_corres simp: vcpu_relation_def)
+  apply (corressimp search: corres_get_vcpu set_vcpu_corres
-              apply (wpsimp wp: get_vcpu_wp getVCPU_wp)+
+                       wp: get_vcpu_wp getVCPU_wp
+                     simp: vcpu_relation_def)
       apply (rule_tac Q="\<lambda>_. invs and tcb_at t" in hoare_strengthen_post)
        apply wp
       apply clarsimp
@@ -1524,15 +1506,15 @@ lemma associate_vcpu_tcb_corres:
       apply (simp add: valid_vcpu'_def typ_at_tcb')
       apply (clarsimp simp: typ_at_to_obj_at_arches obj_at'_def)
      apply (clarsimp simp: typ_at_to_obj_at_arches obj_at'_def)
-    apply (rule corres_rv_proveT, clarsimp)
+    apply (corressimp wp: arch_thread_get_wp getObject_tcb_wp
-    apply (wpsimp wp: arch_thread_get_wp getObject_tcb_wp simp: archThreadGet_def)+
+                    simp: archThreadGet_def)+
   apply (rule conjI)
    apply clarsimp
    apply (rule conjI)
     apply clarsimp
     apply (frule (1) sym_refs_tcb_vcpu, fastforce)
     apply (clarsimp simp: obj_at_def)
-   apply clarsimp
+   apply (clarsimp simp: vcpu_relation_def)
    apply (frule (1) sym_refs_vcpu_tcb, fastforce)
    apply (clarsimp simp: obj_at_def)
   apply normalise_obj_at'

proof/refine/ARM_HYP/CSpace1_R.thy

@@ -558,7 +558,6 @@ lemma getSlotCap_valid:
    apply (clarsimp)
   apply (clarsimp simp add: valid_def)
   done
-
 lemma rab_corres':
   "\<lbrakk> cap_relation (fst a) c'; drop (32-bits) (to_bl cref') = snd a;
      bits = length (snd a) \<rbrakk> \<Longrightarrow>
@@ -599,7 +598,7 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
         apply (clarsimp simp: in_monad)
         apply (rule get_cap_success)
       by (auto simp: in_monad intro!: get_cap_success) (* takes time *)
-    note if_split [split del] isCNodeCap_cap_map[simp del] drop_append[simp del]
+    note if_split [split del]
     { assume "cbits + length guard = 0 \<or> cbits = 0 \<and> guard = []"
       hence ?thesis
         apply (simp add: caps isCap_defs
@@ -613,7 +612,7 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
       hence [simp]: "((cbits + length guard = 0) = False) \<and>
                      ((cbits = 0 \<and> guard = []) = False) \<and>
                     (0 < cbits \<or> guard \<noteq> []) " by simp
-      note if_split [split del]
+      note if_split [split del] drop_append[simp del]
       from "1.prems"
       have ?thesis
         apply -
@@ -624,40 +623,18 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
         apply (subst cnode_cap_case_if)
         apply (corressimp search: getSlotCap_corres IH
                               wp: get_cap_wp getSlotCap_valid no_fail_stateAssert
-                                  corres_rv_defer_right
                             simp: locateSlot_conv)
-        supply isCNodeCap_cap_map[simp]
         apply (simp add: drop_postfix_eq)
         apply clarsimp
         apply (prove "is_aligned ptr (4 + cbits) \<and> cbits \<le> word_bits - cte_level_bits")
         apply (erule valid_CNodeCapE; fastforce)
         subgoal premises prems for s s' x
           apply (insert prems)
+          apply (rule context_conjI)
+            apply (simp add: guard_mask_shift[OF \<open>to_bl _ = _\<close>, where guard=guard,symmetric])
+            apply (simp add: caps lookup_failure_map_def)
             apply (rule conjI)
             apply (clarsimp split: if_splits)
-           apply safe[1]
-            apply (clarsimp simp: valid_cap_def)
-            apply (erule cap_table_at_cte_at)
-            subgoal by simp
-           apply (frule (1) cte_wp_valid_cap)
-           subgoal for cap by (cases cap; simp)
-          apply (simp add: caps lookup_failure_map_def)
-          apply (frule guard_mask_shift[where guard=guard])
-           apply (intro conjI)
-              apply fastforce
-             apply clarsimp
-             apply (rule conjI)
-              apply (clarsimp simp add: objBits_simps cte_level_bits_def)
-              apply (erule (2) valid_CNodeCapE)
-              apply (erule (3) cte_map_shift')
-             subgoal by simp
-             apply (clarsimp simp add: objBits_simps cte_level_bits_def)
-             apply (erule (1) cte_map_shift; assumption?)
-             subgoal by simp
-             apply (clarsimp simp: cte_level_bits_def)
-            apply (clarsimp simp: valid_cap_def cap_table_at_gsCNodes isCap_simps)
-            apply (rule and_mask_less_size, simp add: word_bits_def word_size cte_level_bits_def)
-           apply (clarsimp simp: isCap_simps caps split: if_splits)
             apply (intro conjI impI allI;clarsimp?)
             apply (subst \<open>to_bl _ = _\<close>[symmetric])
             apply (drule postfix_dropD)
@@ -668,10 +645,24 @@ proof (induct a arbitrary: c' cref' bits rule: resolve_address_bits'.induct)
             apply simp
             apply (subst drop_drop [symmetric])
            subgoal by simp
-           apply (simp add: objBits_simps cte_level_bits_def)
+              apply (erule (2) valid_CNodeCapE)
+              apply (rule cap_table_at_cte_at[OF _ refl])
+              apply (simp add: obj_at_def is_cap_table_def well_formed_cnode_n_def)
+             apply (frule (2) cte_wp_valid_cap)
+           apply (rule context_conjI)
+           apply (intro conjI impI allI;clarsimp?)
+           apply (clarsimp simp add: objBits_simps cte_level_bits_def)
+            apply (erule (2) valid_CNodeCapE)
+            apply (erule (3) cte_map_shift')
+            apply simp
+              apply (clarsimp simp add: objBits_simps cte_level_bits_def)
               apply (erule (1) cte_map_shift; assumption?)
-            apply clarsimp
+              subgoal by simp
-           subgoal by (simp add: cte_level_bits_def)
+              apply (clarsimp simp: cte_level_bits_def)
+           apply (rule conjI)
+             apply (clarsimp simp: valid_cap_def cap_table_at_gsCNodes isCap_simps)
+             apply (rule and_mask_less_size, simp add: word_bits_def word_size cte_level_bits_def)
+           apply (clarsimp split: if_splits)
            done
          done
     }

proof/refine/ARM_HYP/Corres.thy

@@ -9,7 +9,7 @@
  *)
 
 theory Corres
-imports StateRelation "../../../lib/Corres_Method"
+imports StateRelation "../../../lib/CorresK_Lemmas"
 begin
 
 text {* Instantiating the corres framework to this particular state relation. *}

proof/refine/ARM_HYP/Finalise_R.thy

@@ -4753,27 +4753,6 @@ lemma cteDeleteOne_ct_not_ksQ:
   apply (clarsimp)
   done
 
-(* FIXME move to Corres_Method? *)
-
-lemma corres_underlying_equiv_raw: "(nf \<Longrightarrow> no_fail P f) \<Longrightarrow> (nf' \<Longrightarrow> no_fail P' f) \<Longrightarrow>
-    corres_underlyingK Id nf nf' True (op =) P P' f f"
-  apply (simp add: corres_underlyingK_def corres_underlying_def Id_def)
-   by (auto simp: no_fail_def)
-
-lemma corres_underlying_equiv_dc_raw: "(nf \<Longrightarrow> no_fail P f) \<Longrightarrow> (nf' \<Longrightarrow> no_fail P' f) \<Longrightarrow>
-    corres_underlyingK Id nf nf' True dc P P' f f"
-  apply (simp add: corres_underlyingK_def corres_underlying_def Id_def)
-  by (auto simp: no_fail_def)
-(* FIXME cleanup *)
-
-lemmas corres_underlying_equiv [corresK] =
-  corres_underlying_equiv_raw[where nf=False and nf'=True and P=\<top>, simplified]
-
-lemmas corres_underlying_equiv_dc [corresK] =
-  corres_underlying_equiv_dc_raw[where nf=False and nf'=True and P=\<top>, simplified]
-
-(* end of move to Corres_Method *)
-
 (* FIXME Move to Machine_AI? *)
 lemma no_fail_set_gic_vcpu_ctrl_lr[wp]: "no_fail \<top> (set_gic_vcpu_ctrl_lr w p)"
   by (wpsimp simp: set_gic_vcpu_ctrl_lr_def)

proof/refine/ARM_HYP/Interrupt_R.thy

@@ -627,6 +627,46 @@ crunch ex_nonz_cap_to' [wp]: doMachineOp "\<lambda>s. P (ex_nonz_cap_to' (ksCurT
 lemma runnable_not_halted: "runnable st \<Longrightarrow> \<not> halted st"
   by (auto simp: runnable_eq)
 
+lemma dmo_wp_no_rest:
+  "\<lbrace>K((\<forall>s f. P s = (P (machine_state_update (machine_state_rest_update f) s)))) and P\<rbrace> do_machine_op (machine_op_lift f) \<lbrace>\<lambda>_. P\<rbrace>"
+  apply (simp add: do_machine_op_def machine_op_lift_def bind_assoc)
+  apply wpsimp
+  apply (clarsimp simp add: machine_rest_lift_def in_monad select_f_def ignore_failure_def)
+  apply (clarsimp split: if_splits)
+  apply (drule_tac x=s in spec)
+  apply (drule_tac x="\<lambda>_. b" in spec)
+  apply simp
+  apply (erule rsubst[OF _ arg_cong[where f=P]])
+  apply clarsimp
+  done
+
+lemma dmo_gets_wp:
+  "\<lbrace>\<lambda>s. P (f (machine_state s)) s\<rbrace> do_machine_op (gets f) \<lbrace>P\<rbrace>"
+  apply (simp add: submonad_do_machine_op.gets)
+  apply wpsimp
+  done
+
+lemma thread_state_relation_frame:
+  "thread_state_relation st'' st' \<Longrightarrow>
+     thread_state_relation st st' = (st = st'')"
+  by (cases st''; cases st'; cases st; fastforce)
+
+lemma thread_state_relation_send_rev_simp:
+  "thread_state_relation st (BlockedOnSend a b c d) =
+  (\<exists>y. (st = (Structures_A.BlockedOnSend a y)) \<and> b = sender_badge y \<and> c = sender_can_grant y \<and> d = sender_is_call y)"
+  by (cases st; fastforce)
+
+lemmas thread_state_rev_simps'[#\<open>solves \<open>simp\<close>\<close>] =
+  thread_state_relation_frame[of Structures_A.thread_state.Running Structures_H.thread_state.Running]
+  thread_state_relation_frame[of Structures_A.thread_state.Inactive Structures_H.thread_state.Inactive]
+  thread_state_relation_frame[of "Structures_A.thread_state.BlockedOnReceive x" "Structures_H.thread_state.BlockedOnReceive x" for x]
+  thread_state_relation_frame[of Structures_A.thread_state.Restart Structures_H.thread_state.Restart]
+  thread_state_relation_frame[of "Structures_A.thread_state.BlockedOnNotification x" "Structures_H.thread_state.BlockedOnNotification x" for x]
+  thread_state_relation_frame[of Structures_A.thread_state.IdleThreadState Structures_H.thread_state.IdleThreadState]
+  thread_state_relation_frame[of "Structures_A.thread_state.BlockedOnReply" "Structures_H.thread_state.BlockedOnReply"]
+
+lemmas thread_state_rev_simps = thread_state_rev_simps' thread_state_relation_send_rev_simp
+
 lemma vgic_maintenance_corres [corres]:
   "corres dc einvs
     (\<lambda>s. invs' s \<and> sch_act_not (ksCurThread s) s \<and> (\<forall>p. ksCurThread s \<notin> set (ksReadyQueues s p)))
@@ -638,26 +678,19 @@ lemma vgic_maintenance_corres [corres]:
                    get_gic_vcpu_ctrl_misr_def
                    get_gic_vcpu_ctrl_lr_def set_gic_vcpu_ctrl_lr_def
              cong: if_cong)
-  apply (corres corres: gct_corres[unfolded getCurThread_def] gts_corres
+  apply (corressimp corres: gct_corres[unfolded getCurThread_def]
-               corresK: corresK_if)
+                        gts_corres[@lift_corres_args]
-  (* 33 subgoals; the following solves all but one. *)
+                     wp: no_fail_machine_op_lift dmo_wp_no_rest)
-  apply (corres corres: hf_corres
+  apply (corressimp corres: hf_corres[@lift_corres_args]
-         | (rule corres_rv_weaken[OF _ corres_rv_trivial]; fastforce)
+                        wp: dmo_gets_wp dmo'_gets_wp gts_wp gts_wp')+
-         | (rule corres_rv_weaken[OF _ corres_rv_trivial]; case_tac rv; case_tac rv';
+  apply safe
-            fastforce simp: runnable_eq)
+  by (auto simp: valid_fault_def thread_state_rev_simps
-         | unfold valid_fault_def
-         | solves \<open>wp dmo'_gets_wp gts_wp gts_wp'\<close>
-         | solves \<open>simp; intro conjI impI; wp\<close>
-         | solves \<open>simp only: submonad_do_machine_op.gets; wp\<close>
-         )+
-  apply (auto simp: valid_fault_def
               elim: ct_active_st_tcb_at_weaken
                       [OF _ iffD1[OF runnable_eq], simplified ct_in_state_def]
                     st_tcb_ex_cap'[OF _ _ runnable_not_halted]
                     st_tcb_ex_cap''
                     pred_tcb'_weakenE
              split: Structures_H.thread_state.splits)
-  done
 
 lemma handle_reserved_irq_corres[corres]:
   "corres dc einvs
@@ -725,8 +758,7 @@ lemma handle_interrupt_corres:
          apply wp+
     apply clarsimp
    apply clarsimp
-  apply (corres corresK: corresK_machine_op)
+  apply corressimp
-      apply (wpsimp simp: no_fail_ackInterrupt)+
   done
 
 lemma invs_ChooseNewThread:

proof/refine/ARM_HYP/IpcCancel_R.thy

@@ -1433,15 +1433,8 @@ lemma archThreadGet_corres:
   "(\<And>a a'. arch_tcb_relation a a' \<Longrightarrow> f a = f' a') \<Longrightarrow>
    corres (op =) (tcb_at t) (tcb_at' t) (arch_thread_get f t) (archThreadGet f' t)"
   unfolding arch_thread_get_def archThreadGet_def
-  apply corres
+  apply (corressimp corres: get_tcb_corres)
-   apply (rule corresK_drop)
-   apply (rule corres_bind_return2)
-   apply (rule corres_split)
-      prefer 2
-      apply (rule get_tcb_corres)
-     apply (rule corres_return[where P=\<top> and P'=\<top>,THEN iffD2])
   apply (clarsimp simp: tcb_relation_def)
-    apply wpsimp+
   done
 
 lemma tcb_vcpu_relation:
@@ -1469,11 +1462,10 @@ lemma corres_gets_current_vcpu[corres]:
 lemma vcpuInvalidateActive_corres[corres]:
   "corres dc \<top> \<top> vcpu_invalidate_active vcpuInvalidateActive"
   unfolding vcpuInvalidateActive_def vcpu_invalidate_active_def
-  apply (corressimp corres: vcpuDisable_corres simp: modifyArchState_def)
+  apply (corressimp  corres: vcpuDisable_corres
-  apply (rule corresK_assume_guard)
+                    corresK: corresK_modifyT
-      apply (rule corres_modify[where P=\<top> and P'=\<top>])
+                       simp: modifyArchState_def)
   apply (clarsimp simp: state_relation_def arch_state_relation_def)
-     apply wpsimp+
   done
 
 lemma tcb_ko_at':
@@ -1484,17 +1476,15 @@ lemma archThreadSet_corres:
   "(\<And>a a'. arch_tcb_relation a a' \<Longrightarrow> arch_tcb_relation (f a) (f' a')) \<Longrightarrow>
   corres dc (tcb_at t) (tcb_at' t) (arch_thread_set f t) (archThreadSet f' t)"
   apply (simp add: arch_thread_set_def archThreadSet_def)
-  apply (corres corres: get_tcb_corres)
+  apply (corres corres: get_tcb_corres tcb_update_corres')
-     apply (rule corresK_drop)
-     apply (rename_tac tcb tcb')
-     apply (rule_tac tcb=tcb and tcb'=tcb' in tcb_update_corres')
-         apply (simp add: tcb_relation_def tcb_cap_cases_def tcb_cte_cases_def exst_same_def)+
   apply wpsimp+
+  apply (auto simp add: tcb_relation_def tcb_cap_cases_def tcb_cte_cases_def exst_same_def)+
   done
 
 lemma archThreadSet_corres_vcpu_None[corres]:
-  "corres dc (tcb_at t) (tcb_at' t)
+  "t = t' \<Longrightarrow> corres dc (tcb_at t) (tcb_at' t')
-    (arch_thread_set (tcb_vcpu_update Map.empty) t) (archThreadSet (atcbVCPUPtr_update Map.empty) t)"
+    (arch_thread_set (tcb_vcpu_update Map.empty) t) (archThreadSet (atcbVCPUPtr_update Map.empty) t')"
+  apply simp
   apply (rule archThreadSet_corres)
   apply (simp add: arch_tcb_relation_def)
   done
@@ -1505,19 +1495,19 @@ lemma no_fail_getRegister[wp]: "no_fail \<top> (getRegister r)"
 lemma no_fail_setRegister[wp]: "no_fail \<top> (setRegister r v)"
   by (simp add: setRegister_def)
 
+lemmas corresK_as_user' =
+  corres_as_user'[atomized, THEN corresK_lift_rule, THEN mp]
+
 lemma asUser_sanitise_corres[corres]:
-  "b=b' \<Longrightarrow> corres dc (tcb_at t) (tcb_at' t)
+  "b=b' \<Longrightarrow> t = t' \<Longrightarrow> corres dc (tcb_at t) (tcb_at' t')
             (as_user t (do cpsr \<leftarrow> getRegister CPSR;
                            setRegister CPSR (sanitise_register b CPSR cpsr)
                         od))
-            (asUser t (do cpsr \<leftarrow> getRegister CPSR;
+            (asUser t' (do cpsr \<leftarrow> getRegister CPSR;
                           setRegister CPSR (sanitiseRegister b' CPSR cpsr)
                        od))"
   unfolding sanitiseRegister_def sanitise_register_def
-  apply (corres corres: corres_as_user')
+  apply (corressimp corresK: corresK_as_user')
-   apply (clarsimp simp: tcb_relation_def arch_tcb_relation_def)
-   apply (rule corres_Id, simp, simp)
-   apply wpsimp
   done
 
 crunch typ_at'[wp]: vcpuInvalidateActive "\<lambda>s. P (typ_at' T p s)"
@@ -1553,7 +1543,7 @@ lemma helper: "vcpu_relation v1 v2 \<Longrightarrow> vcpu_relation v1 v3 \<Longr
   apply (cases v2; cases v3; clarsimp)
   done
 
-lemma dissociateVCPUTCB_corres [corres]:
+lemma dissociateVCPUTCB_corres [@lift_corres_args, corres]:
   "corres dc (obj_at (\<lambda>ko. \<exists>tcb. ko = TCB tcb \<and> tcb_vcpu (tcb_arch tcb) = Some v) t and
               obj_at (\<lambda>ko. \<exists>vcpu. ko = ArchObj (VCPU vcpu) \<and> vcpu_tcb vcpu = Some t) v)
              (tcb_at' t and vcpu_at' v)
@@ -1565,7 +1555,7 @@ lemma dissociateVCPUTCB_corres [corres]:
       simp: archThreadSet_def tcb_ko_at' tcb_at_typ_at'
       | strengthen imp_drop_strg[where Q="tcb_at t s" for s]
         imp_drop_strg[where Q="vcpu_at' v s \<and> typ_at' TCBT t s" for s]
-      | (rule corres_rv_proveT, fastforce simp: vcpu_relation_def ))+
+      | corres_rv)+
   apply (corressimp wp: get_vcpu_wp getVCPU_wp getObject_tcb_wp arch_thread_get_wp corres_rv_wp_left
       simp: archThreadGet_def tcb_ko_at')+
   apply (clarsimp simp: typ_at_tcb' typ_at_to_obj_at_arches)
@@ -1593,8 +1583,6 @@ lemma prepareThreadDelete_corres:
     apply (wp arch_thread_get_wp)
    apply (wpsimp wp: getObject_tcb_wp simp: archThreadGet_def)
   apply clarsimp
-  apply (rule corres_rv_proveT, simp)
-  apply clarsimp
   apply (rule conjI)
    apply clarsimp
    apply (frule (1) sym_refs_tcb_vcpu, fastforce)

proof/refine/ARM_HYP/KHeap_R.thy

@@ -1142,7 +1142,7 @@ lemma set_ep_corres [corres]:
             (set_endpoint ptr e) (setEndpoint ptr e')"
   apply (simp add: set_endpoint_def setEndpoint_def is_ep_def[symmetric])
     apply (corres_search search: set_other_obj_corres[where P="\<lambda>_. True"])
-  apply (wp get_object_ret get_object_wp)+
+  apply (corressimp wp: get_object_ret get_object_wp)+
   by (clarsimp simp: is_ep obj_at_simps)
 
 lemma set_ntfn_corres [corres]:
@@ -1151,7 +1151,7 @@ lemma set_ntfn_corres [corres]:
             (set_notification ptr ae) (setNotification ptr ae')"
   apply (simp add: set_notification_def setNotification_def is_ntfn_def[symmetric])
        apply (corres_search search: set_other_obj_corres[where P="\<lambda>_. True"])
-  apply (wp get_object_ret get_object_wp)+
+  apply (corressimp wp: get_object_ret get_object_wp)+
   by (clarsimp simp: is_ntfn obj_at_simps)
 
 lemma no_fail_getNotification [wp]:

proof/refine/ARM_HYP/Refine.thy

@@ -535,8 +535,12 @@ proof -
      pointerInDeviceData_relation[OF rel valid' valid])
 qed
 
-definition
+abbreviation
+  "ex_abs G \<equiv> ex_abs_underlying state_relation G"
+
+lemma ex_abs_def:
   "ex_abs G \<equiv> \<lambda>s'. \<exists>s. ((s :: (det_ext) state),s') \<in> state_relation \<and> G s"
+  by (auto simp add: ex_abs_underlying_def[abs_def])
 
 lemma device_update_invs':
   "\<lbrace>invs'\<rbrace>doMachineOp (device_memory_update ds)

proof/refine/ARM_HYP/Schedule_R.thy

@@ -1068,7 +1068,7 @@ lemma arch_switch_idle_thread_corres:
           arch_switch_to_idle_thread
           Arch.switchToIdleThread"
   unfolding arch_switch_to_idle_thread_def ARM_HYP_H.switchToIdleThread_def
-  apply (corressimp corres: git_corres set_vm_root_corres vcpuSwitch_corres[where vcpu=None, simplified]
+  apply (corressimp corres: git_corres set_vm_root_corres[@lift_corres_args] vcpuSwitch_corres[where vcpu=None, simplified]
                         wp: tcb_at_idle_thread_lift tcb_at'_ksIdleThread_lift vcpuSwitch_it')
   apply (clarsimp simp: invs_valid_objs invs_arch_state invs_valid_asid_map invs_valid_vs_lookup
                         invs_psp_aligned invs_distinct invs_unique_refs invs_vspace_objs)

proof/refine/ARM_HYP/SubMonad_R.thy

@@ -32,7 +32,7 @@ lemma corres_machine_op:
   done
 
 lemmas corresK_machine_op =
-  corres_machine_op[atomized, THEN corresK_lift_rule, rule_format]
+  corres_machine_op[atomized, THEN corresK_lift_rule, rule_format, corresK]
 
 lemma doMachineOp_mapM:
   assumes "\<And>x. empty_fail (m x)"

proof/refine/ARM_HYP/VSpace_R.thy

@@ -2110,7 +2110,7 @@ lemma unmap_page_corres:
   apply (rule corres_guard_imp)
     apply (rule corres_split_catch [where E="\<lambda>_. \<top>" and E'="\<lambda>_. \<top>"], simp)
       apply (rule corres_split_strengthen_ftE[where ftr'=dc],
-             rule find_pd_for_asid_corres)
+             rule find_pd_for_asid_corres[OF refl])
         apply (rule corres_splitEE)
            apply clarsimp
            apply (rule flush_page_corres)